From ghc-devs at haskell.org Mon Jan 1 18:29:47 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 01 Jan 2018 18:29:47 -0000 Subject: [GHC] #11113: Type family If is too strict In-Reply-To: <050.05f921eae40f029dcaf5247a97d85ae6@haskell.org> References: <050.05f921eae40f029dcaf5247a97d85ae6@haskell.org> Message-ID: <065.61b274209aa99f9a15a4e4dc241be8a9@haskell.org> #11113: Type family If is too strict -------------------------------------+------------------------------------- Reporter: olshanskydr | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.10.2 Resolution: | Keywords: TypeFamilies Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by enolan): * cc: echo@… (added) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 1 23:38:05 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 01 Jan 2018 23:38:05 -0000 Subject: [GHC] #14624: HEAD panic in ghc:DsForeign: toCType Message-ID: <049.18489252b85eb82ec89c6d1f7eb8a625@haskell.org> #14624: HEAD panic in ghc:DsForeign: toCType -------------------------------------+------------------------------------- Reporter: tianxiaogu | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Keywords: | Operating System: Linux Architecture: x86_64 | Type of failure: Compile-time (amd64) | crash or panic Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- The following program crashes in 8.2.2 and HEAD (8.5.20171228). {{{#!hs {-# LANGUAGE ForeignFunctionInterface, CApiFFI, GHCForeignImportPrim, QuasiQuotes, TemplateHaskell, JavaScriptFFI, MagicHash, UnliftedFFITypes #-} module TH_foreignCallingConventions where import GHC.Prim import Control.Applicative import Language.Haskell.TH import System.IO import Foreign.Ptr $( do let fi cconv safety lbl name ty = ForeignD (ImportF cconv safety lbl name ty) dec1 <- fi CCall Interruptible "&" (mkName "foo") <$> [t| Ptr () |] dec2 <- fi CApi Safe "bar" (mkName "bar") <$> [t| Int# -> Int# |] -- the declarations below would result in warnings or errors when returned dec3 <- fi CApi Unsafe "baz" (mkName "baz") <$> [t| Double -> IO () |] dec4 <- fi StdCall Safe "bay" (mkName "bay") <$> [t| (Int -> Bool) -> IO Int |] dec5 <- fi JavaScript Unsafe "bax" (mkName "bax") <$> [t| Ptr Int -> IO String |] runIO $ mapM_ (putStrLn . pprint) [dec1, dec2, dec3, dec4, dec5] >> hFlush stdout return [dec1, dec2] ) }}} This program is derived by mutating test TH_foreignCallingConventions.hs. {{{#!diff diff --git a/testsuite/tests/th/TH_foreignCallingConventions.hs b/testsuite/tests/th/TH_foreignCallingConventions.hs index ee39510..16789af 100644 --- a/testsuite/tests/th/TH_foreignCallingConventions.hs +++ b/testsuite/tests/th/TH_foreignCallingConventions.hs @@ -13,7 +13,7 @@ import Foreign.Ptr $( do let fi cconv safety lbl name ty = ForeignD (ImportF cconv safety lbl name ty) dec1 <- fi CCall Interruptible "&" (mkName "foo") <$> [t| Ptr () |] - dec2 <- fi Prim Safe "bar" (mkName "bar") <$> [t| Int# -> Int# |] + dec2 <- fi CApi Safe "bar" (mkName "bar") <$> [t| Int# -> Int# |] -- the declarations below would result in warnings or errors when returned dec3 <- fi CApi Unsafe "baz" (mkName "baz") <$> [t| Double -> IO () |] dec4 <- fi StdCall Safe "bay" (mkName "bay") <$> [t| (Int -> Bool) -> IO Int |] }}} Log: {{{ foreign import capi safe "bar" bar :: GHC.Prim.Int# -> GHC.Prim.Int# foreign import capi unsafe "baz" baz :: GHC.Types.Double -> GHC.Types.IO () foreign import stdcall safe "bay" bay :: (GHC.Types.Int -> GHC.Types.Bool) -> GHC.Types.IO GHC.Types.Int foreign import javascript unsafe "bax" bax :: GHC.Ptr.Ptr GHC.Types.Int -> GHC.Types.IO GHC.Base.String ghc: panic! (the 'impossible' happened) (GHC version 8.5.20171228 for x86_64-unknown-linux): toCType Int# Call stack: CallStack (from HasCallStack): callStackDoc, called at compiler/utils/Outputable.hs:1150:37 in ghc:Outputable pprPanic, called at compiler/deSugar/DsForeign.hs:730:17 in ghc:DsForeign Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 1 23:38:26 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 01 Jan 2018 23:38:26 -0000 Subject: [GHC] #14624: HEAD panic in ghc:DsForeign: toCType In-Reply-To: <049.18489252b85eb82ec89c6d1f7eb8a625@haskell.org> References: <049.18489252b85eb82ec89c6d1f7eb8a625@haskell.org> Message-ID: <064.614c022d7efe541fd31d6e0bea6a2b49@haskell.org> #14624: HEAD panic in ghc:DsForeign: toCType -------------------------------------+------------------------------------- Reporter: tianxiaogu | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Linux | Architecture: x86_64 Type of failure: Compile-time | (amd64) crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by tianxiaogu): * Attachment "crash-ghc-TH_foreignCallingConventions.hs" added. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 2 00:36:21 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 02 Jan 2018 00:36:21 -0000 Subject: [GHC] #13032: Redundant forcing of Given dictionaries In-Reply-To: <046.811080f481e777da656f14add09b1cc8@haskell.org> References: <046.811080f481e777da656f14add09b1cc8@haskell.org> Message-ID: <061.c98098c7c2f21151c98288776dda8c25@haskell.org> #13032: Redundant forcing of Given dictionaries -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.0.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by Iceland_jack): * cc: Iceland_jack (added) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 2 00:43:30 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 02 Jan 2018 00:43:30 -0000 Subject: [GHC] #14624: HEAD panic in ghc:DsForeign: toCType In-Reply-To: <049.18489252b85eb82ec89c6d1f7eb8a625@haskell.org> References: <049.18489252b85eb82ec89c6d1f7eb8a625@haskell.org> Message-ID: <064.26063c1bbb06f45329a760db4632cfd6@haskell.org> #14624: HEAD panic in ghc:DsForeign: toCType -------------------------------------+------------------------------------- Reporter: tianxiaogu | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Linux | Architecture: x86_64 Type of failure: Compile-time | (amd64) crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): A simpler way to trigger the panic that doesn't involve any Template Haskell: {{{#!hs {-# LANGUAGE CApiFFI #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE UnliftedFFITypes #-} module Foo where import GHC.Exts (Int#) foreign import capi safe "bar" bar :: Int# -> Int# }}} {{{ $ /opt/ghc/8.2.2/bin/ghc Foo.hs [1 of 1] Compiling Foo ( Foo.hs, Foo.o ) ghc: panic! (the 'impossible' happened) (GHC version 8.2.2 for x86_64-unknown-linux): toCType Int# Call stack: CallStack (from HasCallStack): prettyCurrentCallStack, called at compiler/utils/Outputable.hs:1133:58 in ghc:Outputable callStackDoc, called at compiler/utils/Outputable.hs:1137:37 in ghc:Outputable pprPanic, called at compiler/deSugar/DsForeign.hs:726:17 in ghc:DsForeign }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 2 01:11:26 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 02 Jan 2018 01:11:26 -0000 Subject: [GHC] #14603: GHC segfaults building store with profiling In-Reply-To: <046.7db770ba92a42deacd0ed35af7d6c965@haskell.org> References: <046.7db770ba92a42deacd0ed35af7d6c965@haskell.org> Message-ID: <061.436d60aa06ae90ce7cfc62c311b35b3c@haskell.org> #14603: GHC segfaults building store with profiling -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.4.1 Component: Compiler | Version: 8.4.1-alpha1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by duog): * cc: duog (added) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 2 01:13:45 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 02 Jan 2018 01:13:45 -0000 Subject: [GHC] #9221: (super!) linear slowdown of parallel builds on 40 core machine In-Reply-To: <045.6b727a84a1bea97c8d082954a0b9425e@haskell.org> References: <045.6b727a84a1bea97c8d082954a0b9425e@haskell.org> Message-ID: <060.1a7c024340dc37c7e2064e633b6e2ce5@haskell.org> #9221: (super!) linear slowdown of parallel builds on 40 core machine -------------------------------------+------------------------------------- Reporter: carter | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 7.8.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: #910, #8224 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by duog): * cc: duog (added) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 2 01:33:28 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 02 Jan 2018 01:33:28 -0000 Subject: [GHC] #14570: Untouchable error arises from type equality, but not equivalent program with fundeps In-Reply-To: <050.b3eb3b2e82fc1ebf9259f6ac8f9d5ce9@haskell.org> References: <050.b3eb3b2e82fc1ebf9259f6ac8f9d5ce9@haskell.org> Message-ID: <065.f77e560878557a0424e3d22a63ffdb4b@haskell.org> #14570: Untouchable error arises from type equality, but not equivalent program with fundeps -------------------------------------+------------------------------------- Reporter: lexi.lambda | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.0.2 checker) | Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: GHC rejects | Unknown/Multiple valid program | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by AntC): Replying to [comment:3 dfeuer]: > At the least, this is a rather poor error message. I'm wondering if the o.p. gave the full story about the error message. I retried the Type Family version, and got `f0 is untouchable` rejection, but against the type for `f`. The message went on to give more info `f is a rigid type variable ...`; plus a suggestion to `AllowAmbiguousTypes`. Switching that on does indeed suppress the message against `f`; then it just reappears against `g`, as per the o.p., but with less helpful info. (I've put more narrative against the StackOverflow question, link above.) Simon's explanation at comment:1 tells what's going on, but not really why. The Schrijvers et al paper didn't really help: it's aiming to explain FunDep inference in terms of Type Families/System FC, so doesn't tell why/how ghc's behaviour is different in this example. Re the `rigid type variable` message, there are some reasonable explanations on StackOverflow. Re `f0 is untouchable` not so much. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 2 01:34:11 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 02 Jan 2018 01:34:11 -0000 Subject: [GHC] #14624: HEAD panic in ghc:DsForeign: toCType In-Reply-To: <049.18489252b85eb82ec89c6d1f7eb8a625@haskell.org> References: <049.18489252b85eb82ec89c6d1f7eb8a625@haskell.org> Message-ID: <064.73c38770a418dec9097ca282d5c3b848@haskell.org> #14624: HEAD panic in ghc:DsForeign: toCType -------------------------------------+------------------------------------- Reporter: tianxiaogu | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Linux | Architecture: x86_64 Type of failure: Compile-time | (amd64) crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * cc: hvr (added) Comment: That being said, I'm not terribly familiar with what requirements the `capi` calling convention imposes on its argument and result types. Is there a specification for this somewhere? All I found was [https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/ffi- chap.html?highlight=capiffi#the-capi-calling-convention this terse section] of the users' guide on `CApiFFI`, which doesn't formalize what types are accepted, much less what should happen if an //incorrect// type is provided, as what appears to be happening here. cc'ing hvr, who might have some thoughts on this. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 2 01:38:18 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 02 Jan 2018 01:38:18 -0000 Subject: [GHC] #14373: Introduce PTR-tagging for big constructor families In-Reply-To: <048.fd4e2364f8515bbd8b92613edf1e7763@haskell.org> References: <048.fd4e2364f8515bbd8b92613edf1e7763@haskell.org> Message-ID: <063.683b68052dc9c2dee10ac142e1d68b6a@haskell.org> #14373: Introduce PTR-tagging for big constructor families -------------------------------------+------------------------------------- Reporter: heisenbug | Owner: heisenbug Type: bug | Status: patch Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4267 Wiki Page: | -------------------------------------+------------------------------------- Changes (by duog): * differential: => Phab:D4267 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 2 09:31:28 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 02 Jan 2018 09:31:28 -0000 Subject: [GHC] #14609: Per-instance UndecidableInstances In-Reply-To: <048.249a939a6e76cafabb0ae79267f4d3cf@haskell.org> References: <048.249a939a6e76cafabb0ae79267f4d3cf@haskell.org> Message-ID: <063.897ae67147ac773d99074470cbb899e6@haskell.org> #14609: Per-instance UndecidableInstances -------------------------------------+------------------------------------- Reporter: ryanreich | Owner: (none) Type: feature request | Status: new Priority: low | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): I'm all for a per-instance flag, if someone would like to do the leg-work. Not hard, I think. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 2 10:06:33 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 02 Jan 2018 10:06:33 -0000 Subject: [GHC] #5927: A type-level "implies" constraint on Constraints In-Reply-To: <048.176646aa6f5f9bdf7a2953e1f3bc3e76@haskell.org> References: <048.176646aa6f5f9bdf7a2953e1f3bc3e76@haskell.org> Message-ID: <063.f47edee9cc4c1520a9e638217e0069e9@haskell.org> #5927: A type-level "implies" constraint on Constraints -------------------------------------+------------------------------------- Reporter: illissius | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 7.4.1 checker) | Keywords: Resolution: | QuantifiedContexts Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * keywords: => QuantifiedContexts -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 2 11:39:09 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 02 Jan 2018 11:39:09 -0000 Subject: [GHC] #14625: Casts get in the way of calculating unfolding discount Message-ID: <049.6994f1db20bec8e78d8ca395a91b9ee6@haskell.org> #14625: Casts get in the way of calculating unfolding discount -------------------------------------+------------------------------------- Reporter: mpickering | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): Phab:D4279 | Wiki Page: -------------------------------------+------------------------------------- The dictionary argument discount was not being applied for code such as rec_sel (dict_arg 'cast' cobox). For example, adding lots of type equality constraints increases the size of `foo` so that it will no longer be inlined into `foo1` (if specialisation is turned off). {{{ {-# LANGUAGE GADTs #-} module Small where foo :: (Num a, a ~ b, a ~ b, a ~ b, a ~ b, a ~ b) => a -> b foo x = x + x foo1 :: Int -> Int foo1 x = foo x }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 2 12:07:05 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 02 Jan 2018 12:07:05 -0000 Subject: [GHC] #9221: (super!) linear slowdown of parallel builds on 40 core machine In-Reply-To: <045.6b727a84a1bea97c8d082954a0b9425e@haskell.org> References: <045.6b727a84a1bea97c8d082954a0b9425e@haskell.org> Message-ID: <060.5e12a8b18ab978486467012d37276603@haskell.org> #9221: (super!) linear slowdown of parallel builds on 40 core machine -------------------------------------+------------------------------------- Reporter: carter | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 7.8.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: #910, #8224 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by duog): ticket:3553 discusses `sched_yield` and has a patch that tries futexes. Apparently `sched_yield` was inexplicably faster. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 2 12:45:52 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 02 Jan 2018 12:45:52 -0000 Subject: [GHC] #14068: Loopification using join points In-Reply-To: <046.e16e22cbe3c046431dc8ebed421f2e67@haskell.org> References: <046.e16e22cbe3c046431dc8ebed421f2e67@haskell.org> Message-ID: <061.9be6f3e32dd288480033155db841358b@haskell.org> #14068: Loopification using join points -------------------------------------+------------------------------------- Reporter: nomeata | Owner: nomeata Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.0.1 Resolution: | Keywords: JoinPoints Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #13966 #14067 | Differential Rev(s): Phab:D3811 Wiki Page: | -------------------------------------+------------------------------------- Description changed by simonpj: Old description: > The function > {{{ > let f x y = case y of > A -> f x' y' > B -> e2 > C -> e3 > in g f > }}} > is not turned into a recursive join point, because the call to `f` is not > in tail call position. But the recursive calls are, and these matter > performance-wise! Hence, it would be beneficial to turn this into > {{{ > let f x y = joinrec $j x y = case x y of > A -> $j x' y' > B -> e2 > C -> e3 > in $j x y > in g f > }}} > > This has the additional effect that now `f` is no longer recursive and > may get inlined. > > The idea is described under "New idea: use join points" in > [wiki:Commentary/Compiler/Loopification]. > > Some notes: > > * We should to this both at top level and for nested definitions. > > * We can remove the "loopification" code from the code generator when > this is done. > > * It came up in #13966, and might go well with #14067. > > * It might work well with #13051, which Thomas Jakway is still thinking > about. > > * Should fix #14287 too. New description: The function {{{ let f x y = case y of A -> f x' y' B -> e2 C -> e3 in g f }}} is not turned into a recursive join point, because the call to `f` is not in tail call position. But the recursive calls are, and these matter performance-wise! Hence, it would be beneficial to turn this into {{{ let f x y = joinrec $j x y = case x y of A -> $j x' y' B -> e2 C -> e3 in $j x y in g f }}} This has the additional effect that now `f` is no longer recursive and may get inlined. The idea is described under "New idea: use join points" in [wiki:Commentary/Compiler/Loopification]. Some notes: * We should to this both at top level and for nested definitions. * We can remove the "loopification" code from the code generator when this is done. * It came up in #13966, and might go well with #14067. * It might work well with #13051, which Thomas Jakway is still thinking about. * Should fix #14287 too. * See also #14620, for a wrinkle. Especially comment:6. -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 2 12:46:22 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 02 Jan 2018 12:46:22 -0000 Subject: [GHC] #14068: Loopification using join points In-Reply-To: <046.e16e22cbe3c046431dc8ebed421f2e67@haskell.org> References: <046.e16e22cbe3c046431dc8ebed421f2e67@haskell.org> Message-ID: <061.e09359bcbfee38ecd347d4de681b7f9e@haskell.org> #14068: Loopification using join points -------------------------------------+------------------------------------- Reporter: nomeata | Owner: nomeata Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.0.1 Resolution: | Keywords: JoinPoints Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #13966 #14067 | Differential Rev(s): Phab:D3811 Wiki Page: | -------------------------------------+------------------------------------- Description changed by simonpj: Old description: > The function > {{{ > let f x y = case y of > A -> f x' y' > B -> e2 > C -> e3 > in g f > }}} > is not turned into a recursive join point, because the call to `f` is not > in tail call position. But the recursive calls are, and these matter > performance-wise! Hence, it would be beneficial to turn this into > {{{ > let f x y = joinrec $j x y = case x y of > A -> $j x' y' > B -> e2 > C -> e3 > in $j x y > in g f > }}} > > This has the additional effect that now `f` is no longer recursive and > may get inlined. > > The idea is described under "New idea: use join points" in > [wiki:Commentary/Compiler/Loopification]. > > Some notes: > > * We should to this both at top level and for nested definitions. > > * We can remove the "loopification" code from the code generator when > this is done. > > * It came up in #13966, and might go well with #14067. > > * It might work well with #13051, which Thomas Jakway is still thinking > about. > > * Should fix #14287 too. > > * See also #14620, for a wrinkle. Especially comment:6. New description: The function {{{ let f x y = case y of A -> f x' y' B -> e2 C -> e3 in g f }}} is not turned into a recursive join point, because the call to `f` is not in tail call position. But the recursive calls are, and these matter performance-wise! Hence, it would be beneficial to turn this into {{{ let f x y = joinrec $j x y = case x y of A -> $j x' y' B -> e2 C -> e3 in $j x y in g f }}} This has the additional effect that now `f` is no longer recursive and may get inlined. The idea is described under "New idea: use join points" in [wiki:Commentary/Compiler/Loopification]. Some notes: * We should to this both at top level and for nested definitions. * We can remove the "loopification" code from the code generator when this is done. * It came up in #13966, and might go well with #14067. * It might work well with #13051, which Thomas Jakway is still thinking about. * Should fix #14287 too. * See also comment:6 of #14620, for a wrinkle. -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 2 12:47:23 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 02 Jan 2018 12:47:23 -0000 Subject: [GHC] #14626: No need to enter a scrutinised value Message-ID: <048.67c951c2aecb97b988badb4816dbe757@haskell.org> #14626: No need to enter a scrutinised value -------------------------------------+------------------------------------- Reporter: heisenbug | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Keywords: performance | Operating System: Unknown/Multiple Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: #13861 Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- While analysing the output of #13861 I stumbled over an unnecessary pessimisation in handling of scrutinised values. With words of Simon (from https://phabricator.haskell.org/D4267 with minor edits added): Interesting. Yes, please make a ticket! (And transfer the info below into it.) I think the issue is this. Given (the STG-ish code) {{{#!hs data Colour = Red | Green | Blue f x = case x of y Red -> Green DEFAULT -> y }}} (here `y` is the case binder) we can just return `x` rather than entering it in DEFAULT branch, because `y` will be fully evaluated and its pointer will be correctly tagged. You absolutely can't check for an `OccName` of `"wild"`!! That is neither necessary nor sufficient :-). Instead, check `isEvaldUnfolding (idUnfolding y)`. See `Note [Preserve evaluatedness]` in `CoreTidy.hs`. And be sure to augment that note if you make the change. I would expect perf benefits to be small on average, but it's simple to implement. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 2 12:48:57 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 02 Jan 2018 12:48:57 -0000 Subject: [GHC] #3553: parallel gc suffers badly if one thread is descheduled In-Reply-To: <047.48e7cf5ad32bf05ce8bca6e11b9273f8@haskell.org> References: <047.48e7cf5ad32bf05ce8bca6e11b9273f8@haskell.org> Message-ID: <062.a31fb10e2a8981bb2197b878079bff14@haskell.org> #3553: parallel gc suffers badly if one thread is descheduled -------------------------------------+------------------------------------- Reporter: simonmar | Owner: simonmar Type: bug | Status: closed Priority: normal | Milestone: 6.12.2 Component: Runtime System | Version: 6.10.4 Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by nh2): Replying to [comment:8 wuzzeb]: > There is a recent patch to the linux kernel to implement a futux which spins in the kernel, see http://thread.gmane.org/gmane.linux.kernel/970412 This link is dead now. I suspect it was "futex: FUTEX_LOCK with optional adaptive spinning" as described by LWN: https://lwn.net/Articles/387246/ There are now also two newer articles / patch sets about futexes: * https://lwn.net/Articles/704843/ (directly related to the above one) * https://lwn.net/Articles/685769/ -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 2 12:53:16 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 02 Jan 2018 12:53:16 -0000 Subject: [GHC] #14626: No need to enter a scrutinised value In-Reply-To: <048.67c951c2aecb97b988badb4816dbe757@haskell.org> References: <048.67c951c2aecb97b988badb4816dbe757@haskell.org> Message-ID: <063.80a561ef6803be00557803637df27cb3@haskell.org> #14626: No need to enter a scrutinised value -------------------------------------+------------------------------------- Reporter: heisenbug | Owner: heisenbug Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: performance Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #13861 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by heisenbug): * owner: (none) => heisenbug Comment: @spj Yes the perf changes will be small, but I hope to get more by the time #13861 is ready. Anyway this will result in better (less branchy) code, so I think it is worth it. Thanks for the `isEvaldUnfolding` hint! I ''knew'' there must be a correct way to do it. I'll test, and come back with a phabricator. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 2 12:57:50 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 02 Jan 2018 12:57:50 -0000 Subject: [GHC] #14610: newtype wrapping of a monadic stack kills performance In-Reply-To: <045.5ed9746f86f3774a95fff79094d26517@haskell.org> References: <045.5ed9746f86f3774a95fff79094d26517@haskell.org> Message-ID: <060.a1e68945ad4bce1ecc69d556b4ed5966@haskell.org> #14610: newtype wrapping of a monadic stack kills performance -------------------------------------+------------------------------------- Reporter: mrkkrp | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: #14620 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): > Maybe it is enough to relax the rule “The return type must not depend on any arguments” to “The return type must be representatoinally equal for all arguments” and that might allow us to e `cast` co to be a tail-call position Actually I think we may just be able to say that if `(f x)` is a tail call, then `(f x |> co)` is a tail call. So in this code: {{{ occAnal env (Cast expr co) = case occAnal env expr of { (usage, expr') -> let usage1 = zapDetailsIf (isRhsEnv env) usage -- usage1: if we see let x = y `cast` co -- then mark y as 'Many' so that we don't -- immediately inline y again. usage2 = addManyOccsSet usage1 (coVarsOfCo co) -- usage2: see Note [Gather occurrences of coercion variables] in (markAllNonTailCalled usage2, Cast expr' co) } }}} just remove the `markAllNonTailCalled`. That call was in Luke's original join-point patch, but it seems over-conservative to me. That said, I'm intrigued about how this happens in practice, if it really does. In the example given in comment:5, a single run of the simplifer removes the redundant casts, and for recursive join points the tail calls really must return the same type as the function itself, so the cast seems unlikely. While the change above (removing `markAllNonTailCalled`) is ok (I think), I'm surprised if it has any effect. An example would be great. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 2 12:58:07 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 02 Jan 2018 12:58:07 -0000 Subject: [GHC] #14610: newtype wrapping of a monadic stack kills performance In-Reply-To: <045.5ed9746f86f3774a95fff79094d26517@haskell.org> References: <045.5ed9746f86f3774a95fff79094d26517@haskell.org> Message-ID: <060.0ec972dc5566ee2b95d48647774e9927@haskell.org> #14610: newtype wrapping of a monadic stack kills performance -------------------------------------+------------------------------------- Reporter: mrkkrp | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: JoinPoints Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: #14620 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * keywords: => JoinPoints -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 2 14:28:35 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 02 Jan 2018 14:28:35 -0000 Subject: [GHC] #14610: newtype wrapping of a monadic stack kills performance In-Reply-To: <045.5ed9746f86f3774a95fff79094d26517@haskell.org> References: <045.5ed9746f86f3774a95fff79094d26517@haskell.org> Message-ID: <060.6de473c953a6d3ae36bab6897bd49c10@haskell.org> #14610: newtype wrapping of a monadic stack kills performance -------------------------------------+------------------------------------- Reporter: mrkkrp | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: JoinPoints Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: #14620 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by nomeata): Here is a contrived example. This code: {{{ {-# LANGUAGE KindSignatures, DataKinds, GADTs, TypeFamilies #-} module RecCast (foo) where import Data.Coerce data Nat = Z | S Nat data Sing (n :: Nat) where FZ :: Sing Z FS :: Sing n -> Sing (S n) -- The NoConst to avoid worker-wrapper data Const (y::Nat) = Const Nat | NoConst mapConst :: (Nat -> Nat) -> Const n -> Const n mapConst f (Const x) = Const (f x) mapConst f NoConst = NoConst {-# NOINLINE mapConst #-} inc :: Const n -> Const (S n) inc = coerce type family Plus n m :: Nat where Plus Z m = m Plus (S n) m = S (Plus n m) foo :: Sing n -> Const m -> Const (Plus n m) foo FZ c = c foo (FS n) c = inc (foo n (mapConst S c)) }}} produces this function that would be a join point when we consider casted expressions as tail-recursive: {{{ Rec { -- RHS size: {terms: 14, types: 25, coercions: 18, joins: 0/0} foo [Occ=LoopBreaker] :: forall (n :: Nat) (m :: Nat). Sing n -> Const m -> Const (Plus n m) [GblId, Arity=2, Caf=NoCafRefs, Str=] foo = \ (@ (n_asO :: Nat)) (@ (m_asP :: Nat)) (ds_dXH :: Sing n_asO) (c_aqe :: Const m_asP) -> case ds_dXH of { FZ cobox_asR [Dmd=] -> c_aqe `cast` ((Const )_R :: (Const m_asP :: *) ~R# (Const (Plus n_asO m_asP) :: *)); FS @ n1_asU cobox_asV [Dmd=] n2_aqf -> (foo @ n1_asU @ m_asP n2_aqf (mapConst_rnA @ m_asP S c_aqe)) `cast` ((Const )_R :: (Const (Plus n1_asU m_asP) :: *) ~R# (Const (Plus n_asO m_asP) :: *)) } end Rec } }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 2 15:06:07 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 02 Jan 2018 15:06:07 -0000 Subject: [GHC] #14610: newtype wrapping of a monadic stack kills performance In-Reply-To: <045.5ed9746f86f3774a95fff79094d26517@haskell.org> References: <045.5ed9746f86f3774a95fff79094d26517@haskell.org> Message-ID: <060.d64ed0ed6d505ffe795811e657459b70@haskell.org> #14610: newtype wrapping of a monadic stack kills performance -------------------------------------+------------------------------------- Reporter: mrkkrp | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: JoinPoints Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: #14620 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Good example. But it fails the `isValidJoinPointType` test (c.f. #14620), so even if we roped the `markAllNonTailCalled` in the `Cast` case of occurrence- analysis, we would not get `go` as a join point. And indeed that's not unreasonable. Consider {{{ case ( letrec go n m ds m2 = case ds of ) ( FX co -> m2 |> (...co..) ) ( FS ... -> (go ...) |> co2 ) ( in go t1 t2 a b ) of BLAH }}} Operationally we have a join point, but the transformation to move that case inwards would give this {{{ letrec go n m ds m2 = case ds of FX co -> case m2 |> (...co..) of BLAH FS ... -> (go ...) |> co2 in go t1 t2 a b }}} but now the outer case is scrutinising something involving n, m etc, which makes no sense. Operationally the transformation makes sense, but it's not well typed. I have no idea how to fix this. We still have no example of a program that has a cast in the return (and and hence might benefit from dropping the `makrAllNonTailCalled`) but which passes the `isValidJoinPointType` test. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 2 15:06:21 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 02 Jan 2018 15:06:21 -0000 Subject: [GHC] #14610: newtype wrapping of a monadic stack kills performance In-Reply-To: <045.5ed9746f86f3774a95fff79094d26517@haskell.org> References: <045.5ed9746f86f3774a95fff79094d26517@haskell.org> Message-ID: <060.1f31e95eb0420343fe5c0820fd381604@haskell.org> #14610: newtype wrapping of a monadic stack kills performance -------------------------------------+------------------------------------- Reporter: mrkkrp | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: JoinPoints Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: #14620 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by nomeata): That example is one where the result type depends on the parameters… but don’t see why we need that restriction – this code shows that it would be beneficial and not crash to allow it. The note `[The polymorphism rule of join points]` basically says “We need this restriction because the CPS translation would not be easily typable, but that is not very convincing. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 2 15:07:48 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 02 Jan 2018 15:07:48 -0000 Subject: [GHC] #14610: newtype wrapping of a monadic stack kills performance In-Reply-To: <045.5ed9746f86f3774a95fff79094d26517@haskell.org> References: <045.5ed9746f86f3774a95fff79094d26517@haskell.org> Message-ID: <060.0c95d07da035c7fe76238bede5d67ee0@haskell.org> #14610: newtype wrapping of a monadic stack kills performance -------------------------------------+------------------------------------- Reporter: mrkkrp | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: JoinPoints Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: #14620 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by nomeata): > Operationally the transformation makes sense, but it's not well typed. I have no idea how to fix this. So am I right to say “we forbid polymorphic return types because we cannot prove it to be sound, even though we know it would not actually crash if we did allow it”? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 2 15:13:42 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 02 Jan 2018 15:13:42 -0000 Subject: [GHC] #14610: newtype wrapping of a monadic stack kills performance In-Reply-To: <045.5ed9746f86f3774a95fff79094d26517@haskell.org> References: <045.5ed9746f86f3774a95fff79094d26517@haskell.org> Message-ID: <060.11a817eb1d2d22f10f3aeef5a994c548@haskell.org> #14610: newtype wrapping of a monadic stack kills performance -------------------------------------+------------------------------------- Reporter: mrkkrp | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: JoinPoints Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: #14620 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): > So am I right to say “we forbid polymorphic return types because we cannot prove it to be sound, even though we know it would not actually crash if we did allow it”? Yes, that's right. But be specific about what you mean by "it" in "would not crash if we did allow it". In comment:14 I show a particular transformation. I believe it is (slightly) beneficial, and will not crash, but the result is not type-correct. If you can figure out how to express the proof that it won't crash, as a coercion perhaps, maybe you could somehow express that proof in Core. You don't need casts to expose the problem: #14620 is enough. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 2 15:20:50 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 02 Jan 2018 15:20:50 -0000 Subject: [GHC] #14610: newtype wrapping of a monadic stack kills performance In-Reply-To: <045.5ed9746f86f3774a95fff79094d26517@haskell.org> References: <045.5ed9746f86f3774a95fff79094d26517@haskell.org> Message-ID: <060.eaf8c4fb9ad41b4069fc4398f7e50fbb@haskell.org> #14610: newtype wrapping of a monadic stack kills performance -------------------------------------+------------------------------------- Reporter: mrkkrp | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: JoinPoints Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: #14620 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by nomeata): Here is an idea. Consider a recursive function `foo` with type {{{ foo :: forall t, a -> r t foo @t a = E[foo @t2 x `cast` co)] -- E[_] is tail call context, and the cast prevents join-point-hood }}} But we can transform this into a form that is allowed by now, just by introducing casts: {{{ foo :: forall t, a -> r t foo @t a = go @t a refl where go :: forall t', a -> (r t ~ r t') -> r t go @t' a = E[go @t'2 co] }}} Note that now the return type does no longer depend on the arguments of `go`, so it is a join point. This transformation smells like a worker-wrapper transformation, but I am not sure. Anyways, I am not arguing that we should do this transformation in GHC, but do it in the proofs so that we can simply happily remove the restriction in `isValidJoinPointType`. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 2 15:29:03 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 02 Jan 2018 15:29:03 -0000 Subject: [GHC] #14610: newtype wrapping of a monadic stack kills performance In-Reply-To: <045.5ed9746f86f3774a95fff79094d26517@haskell.org> References: <045.5ed9746f86f3774a95fff79094d26517@haskell.org> Message-ID: <060.56aed8de8756b4922c8f90c61c3460e6@haskell.org> #14610: newtype wrapping of a monadic stack kills performance -------------------------------------+------------------------------------- Reporter: mrkkrp | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: JoinPoints Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: #14620 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by nomeata): Ah, of course you are right: If we drop `isValidJoinPointType` then we get more join points, and still no crashes. But it would indeed prevent the transformation in comment:14. That leaves two options: * Un-join-point `go` if we want to do this transformation (no regression about now) * Actually do this transformation I propose in comment:18 in GHC, which means we get a join point as before and can do that transformation. All not carefully thought out, of course, and too much distraction here right now, so I am mostly conveying my gut feeling, hoping to not make a fool out of myself here. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 2 15:50:03 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 02 Jan 2018 15:50:03 -0000 Subject: [GHC] #14610: newtype wrapping of a monadic stack kills performance In-Reply-To: <045.5ed9746f86f3774a95fff79094d26517@haskell.org> References: <045.5ed9746f86f3774a95fff79094d26517@haskell.org> Message-ID: <060.5868a13ffc63eeca3443ceee3feb5e0f@haskell.org> #14610: newtype wrapping of a monadic stack kills performance -------------------------------------+------------------------------------- Reporter: mrkkrp | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: JoinPoints Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: #14620 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): I utterly hate (1). But maybe something along the lines of (2) could work. Adding a coercion as an accumulating parameter precisely builds up the proof I referred to in comment:17. Though I have no idea how to do this in general! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 2 15:51:27 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 02 Jan 2018 15:51:27 -0000 Subject: [GHC] #14338: Simplifier fails with "Simplifier ticks exhausted" In-Reply-To: <049.819ef8e60a65cb9f3e29afb8f69166a7@haskell.org> References: <049.819ef8e60a65cb9f3e29afb8f69166a7@haskell.org> Message-ID: <064.e59c0070f2fd1e5f7f864fd632dd5996@haskell.org> #14338: Simplifier fails with "Simplifier ticks exhausted" -------------------------------------+------------------------------------- Reporter: dredozubov | Owner: bgamari Type: bug | Status: new Priority: high | Milestone: 8.4.1 Component: Compiler | Version: 8.2.1 Resolution: | Keywords: Operating System: Linux | Architecture: x86_64 Type of failure: Compile-time | (amd64) crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Going from 1,500 to 75,000 ticks is stunning. Thank you for locating the offenting patch. I spent some while digging. Here's what I learned * Discarding `(case e of co -> blah)` is indeed unsound, unless we know that `e` terminates, so Richard's patch in #11230 is right. * But his patch does not say why the remaining "optimisation" (which works for superclass selectors over a `Coercible` dictionary) is sound. And indeed, it is not; in Core I could produce a bottoming `Coercible` dictionary. This "optimsation" in `CoreOpt` is all in service of `Note [Getting the map/coerce RULE to work]`, and I'm not sure how important that is. * I was also perplexed that in the case of #11230 the coericon involved seemed to be dead. The code is {{{ testPhantom :: Phantom Char -> Phantom Bool testPhantom x = id x }}} which should generate something like {{{ data Wag x = MkWag () type role Wag phantom testPhantom x = let co :: Wag Char ~ Wag Bool = error "blah" in id @(PhantomChar) x |> co }}} so that coercion `co` certainly isn't dead! But what happens is this. We actually generate {{{ testPhantom x = let co :: Char ~# Bool = error "blah" in id @(PhantomChar) x |> mkSubCo (Wag co) }}} where the `mkSubCo` turns a nominal coercion `Char ~# Bool` into a representational one. Rather than just generate `SubCo` always, it pushes the sub inwards. Because of the role of `Wag`, we then want to turn the nominal `co` into a phantom version, via `downgradeRole`. But (currently) that dicards `co` (retaining only its kind) -- see `Coecion.toPhantomCo` -- so now `co` appears to be dead. This seems wrong to me; the (nominal- equality) evidence really is needed and should really still be free in the result. That's one set of issues. Now, returning to this ticket: * The perf changes in this ticket are presumably because of `HEq_sc` selections, as reported in #13032. * And here the evidence really is not needed! * And hence it's really wrong to force the dictionary; that makes the function stricter (in its dictionary argument) than it should be. (As well as less efficient.) Solution: do not generate all these speculative "given" bindings in the first place. Instead, in the desugarer, figure out which given bindings are needed, and only emit those ones. That will generate less code -- perhaps a lot less in some exotic programs -- and be better all round. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 2 16:16:41 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 02 Jan 2018 16:16:41 -0000 Subject: [GHC] #14610: newtype wrapping of a monadic stack kills performance In-Reply-To: <045.5ed9746f86f3774a95fff79094d26517@haskell.org> References: <045.5ed9746f86f3774a95fff79094d26517@haskell.org> Message-ID: <060.d1e9a859e0780a8e3b30541a740d07c0@haskell.org> #14610: newtype wrapping of a monadic stack kills performance -------------------------------------+------------------------------------- Reporter: mrkkrp | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: JoinPoints Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: #14620 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by nomeata): Ok, thanks for the clarification. Finally I get why that restriction is there. I will try to improve the Note about it (and pass it by you for confirmation). I think the transformation is possible, but it is somewhat non-local, as you need to move all casts inwards towards the recursive call, and then into the newly added parameter. Ff we find that there are performance gains to be won, then it might be worth it! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 2 16:36:08 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 02 Jan 2018 16:36:08 -0000 Subject: [GHC] #14610: newtype wrapping of a monadic stack kills performance In-Reply-To: <045.5ed9746f86f3774a95fff79094d26517@haskell.org> References: <045.5ed9746f86f3774a95fff79094d26517@haskell.org> Message-ID: <060.6e6c19da79e5433a307fc17d21cc6b1b@haskell.org> #14610: newtype wrapping of a monadic stack kills performance -------------------------------------+------------------------------------- Reporter: mrkkrp | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: JoinPoints Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: #14620 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by nomeata): Simon, can you briefly check that https://phabricator.haskell.org/D4281 is an improvement to the Note? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 2 17:45:54 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 02 Jan 2018 17:45:54 -0000 Subject: [GHC] #14605: Core Lint error In-Reply-To: <051.4d7eef339ce5b99337cf52694286a2a6@haskell.org> References: <051.4d7eef339ce5b99337cf52694286a2a6@haskell.org> Message-ID: <066.c7a7ae7c24a16c9086436912d16da3ea@haskell.org> #14605: Core Lint error -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: TypeInType, | DeferredTypeErrors Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #14584 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Richard and I decided that the simple way to do this is to switch off deferred type errors when inside a forall-unification. One could also imagine using the enclosing value bindings, but the necessary variables won't be in scope there. We could instead bind a bogus coercion in the outside scope, with a vanilla type like `() ~ ()` and then unsafe-corece it to the one we need. But it's more complicated and doesn't seem with the pain unless we get user pressure. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 2 17:53:59 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 02 Jan 2018 17:53:59 -0000 Subject: [GHC] #14610: newtype wrapping of a monadic stack kills performance In-Reply-To: <045.5ed9746f86f3774a95fff79094d26517@haskell.org> References: <045.5ed9746f86f3774a95fff79094d26517@haskell.org> Message-ID: <060.70f3c9ae55a885c8c71d0d35595e84c8@haskell.org> #14610: newtype wrapping of a monadic stack kills performance -------------------------------------+------------------------------------- Reporter: mrkkrp | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: JoinPoints Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: #14620 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Joachim Breitner ): In [changeset:"862c59e7bf714e6059392ea401bb0a568c959725/ghc" 862c59e/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="862c59e7bf714e6059392ea401bb0a568c959725" Rewrite Note [The polymorphism rule of join points] I found the reference to CPS unhelpful, but Simon gave me a good explanation in #14610 that I believe is going to be more enlightening for future readers. Differential Revision: https://phabricator.haskell.org/D4281 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 2 18:41:52 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 02 Jan 2018 18:41:52 -0000 Subject: [GHC] #14626: No need to enter a scrutinised value In-Reply-To: <048.67c951c2aecb97b988badb4816dbe757@haskell.org> References: <048.67c951c2aecb97b988badb4816dbe757@haskell.org> Message-ID: <063.8a83bd37e00b1750e4a75893e14d495f@haskell.org> #14626: No need to enter a scrutinised value -------------------------------------+------------------------------------- Reporter: heisenbug | Owner: heisenbug Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: performance Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #13861 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by heisenbug): * cc: simonpj (added) Comment: @simonpj: unfortunately the `isEvaldUnfolding (idUnfolding y)` criterion does not hold for case scrutinees. Any idea why? I `partake`-d them and while some traces show up, none is `wild_*`. What s going on here? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 2 18:49:27 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 02 Jan 2018 18:49:27 -0000 Subject: [GHC] #14627: qAddTopDecls: can't convert top-level declarations Message-ID: <049.485d47f57c339e482133548d02dc333a@haskell.org> #14627: qAddTopDecls: can't convert top-level declarations -------------------------------------+------------------------------------- Reporter: tianxiaogu | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Keywords: | Operating System: Linux Architecture: x86_64 | Type of failure: Compile-time (amd64) | crash or panic Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- The following program crashes 8.2.2 and HEAD (8.5.20171228). {{{#!hs {-# LANGUAGE TemplateHaskell #-} import Language.Haskell.TH.Syntax (addTopDecls) $(do ds <- [d| f = Bool |] addTopDecls ds [d| g = cab |]) }}} Output: {{{ Exception when trying to run compile-time code: ghc: panic! (the 'impossible' happened) (GHC version 8.5.20171228 for x86_64-unknown-linux): qAddTopDecls: can't convert top-level declarations Illegal variable name: ‘Bool’ When splicing a TH declaration: f_0 = Bool Call stack: CallStack (from HasCallStack): callStackDoc, called at compiler/utils/Outputable.hs:1150:37 in ghc:Outputable pprPanic, called at compiler/typecheck/TcSplice.hs:886:27 in ghc:TcSplice Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 2 20:40:46 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 02 Jan 2018 20:40:46 -0000 Subject: [GHC] #14626: No need to enter a scrutinised value In-Reply-To: <048.67c951c2aecb97b988badb4816dbe757@haskell.org> References: <048.67c951c2aecb97b988badb4816dbe757@haskell.org> Message-ID: <063.0ebe6bee96cfc5422250bab8b4d051d8@haskell.org> #14626: No need to enter a scrutinised value -------------------------------------+------------------------------------- Reporter: heisenbug | Owner: heisenbug Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: performance Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #13861 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by heisenbug): Hmm, I made a run with traces about which `Id`s the condition holds for: https://circleci.com/api/v1.1/project/github/ghc/ghc/951/output/108/0?file=true you have to `grep getCallMethod` to find them. If I treat those values as tagged, and simply return them, the `ghc-stage2` crashes. :-( So something is definitely fishy here. For completeness, this is what I changed: https://github.com/ghc/ghc/compare/92f6a671a6a8...8f627c9f25b6 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 2 22:17:41 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 02 Jan 2018 22:17:41 -0000 Subject: [GHC] #14628: Panic (No skolem Info) in GHCi Message-ID: <047.60f789bdd71208f33a8f3fb6a4a2adeb@haskell.org> #14628: Panic (No skolem Info) in GHCi -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: GHCi | Version: 8.2.2 Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: Compile-time Unknown/Multiple | crash or panic Test Case: | Blocked By: Blocking: | Related Tickets: #13393 Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- Loading the following code in GHCi causes a panic. Versions affected at least 8.2.2 and 8.0.2 {{{ module Main where import System.IO import Control.Monad.IO.Class import Control.Monad.Trans.State import Text.Printf putArrayBytes :: Handle -- ^ output file handle -> [String] -- ^ byte-strings -> IO Int -- ^ total number of bytes written putArrayBytes outfile xs = do let writeCount x = modify' (+ length x) >> liftIO (putLine x) :: MonadIO m => StateT Int m () execStateT (mapM_ writeCount xs) 0 where putLine = hPutStrLn outfile . (" "++) . concatMap (printf "0x%02X,") {- ghci: :break 12 46 :trace putArrayBytes stdout [['1'..'9'],['2'..'8'],['3'..'7']] snd $ runStateT _result 0 -} main = undefined }}} {{{ Configuring GHCi with the following packages: GHCi, version 8.2.2: http://www.haskell.org/ghc/ :? for help [1 of 1] Compiling Main ( C:\test\test.hs, interpreted ) Ok, one module loaded. Loaded GHCi configuration from C:\Users\Andi\AppData\Local\Temp\ghci34988 \ghci-script *Main> :break 12 46 Breakpoint 0 activated at C:\test\test.hs:12:46-63 *Main> :trace putArrayBytes stdout [['1'..'9'],['2'..'8'],['3'..'7']] Stopped in Main.putArrayBytes.writeCount, C:\test\test.hs:12:46-63 _result :: StateT Int m () = _ putLine :: [Char] -> IO () = _ x :: [Char] = "123456789" [C:\test\test.hs:12:46-63] [C:\test\test.hs:12:46-63] *Main> snd $ runStateT _result 0 :3:7: error:: panic! (the 'impossible' happened) (GHC version 8.2.2 for x86_64-unknown-mingw32): No skolem info: m_I5Cm[rt] Call stack: CallStack (from HasCallStack): prettyCurrentCallStack, called at compiler\utils\Outputable.hs:1133:58 in ghc:Outputable callStackDoc, called at compiler\utils\Outputable.hs:1137:37 in ghc:Outputable pprPanic, called at compiler\typecheck\TcErrors.hs:2653:5 in ghc:TcErrors Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug [C:\test\test.hs:12:46-63] [C:\test\test.hs:12:46-63] *Main> :r [1 of 1] Compiling Main ( C:\test\test.hs, interpreted ) Ok, one module loaded. *Main> :break 12 46 Breakpoint 1 activated at C:\test\test.hs:12:46-63 *Main> :trace putArrayBytes stdout [['1'..'9'],['2'..'8'],['3'..'7']] Stopped in Main.putArrayBytes.writeCount, C:\test\test.hs:12:46-63 _result :: StateT Int m () = _ putLine :: [Char] -> IO () = _ x :: [Char] = "123456789" [C:\test\test.hs:12:46-63] [C:\test\test.hs:12:46-63] *Main> snd $ runStateT _result 0 :7:7: error:: panic! (the 'impossible' happened) (GHC version 8.2.2 for x86_64-unknown-mingw32): No skolem info: m_I5Nz[rt] Call stack: CallStack (from HasCallStack): prettyCurrentCallStack, called at compiler\utils\Outputable.hs:1133:58 in ghc:Outputable callStackDoc, called at compiler\utils\Outputable.hs:1137:37 in ghc:Outputable pprPanic, called at compiler\typecheck\TcErrors.hs:2653:5 in ghc:TcErrors Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug [C:\test\test.hs:12:46-63] [C:\test\test.hs:12:46-63] *Main> }}} Maybe related to #13393. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 2 23:25:03 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 02 Jan 2018 23:25:03 -0000 Subject: [GHC] #14627: qAddTopDecls: can't convert top-level declarations In-Reply-To: <049.485d47f57c339e482133548d02dc333a@haskell.org> References: <049.485d47f57c339e482133548d02dc333a@haskell.org> Message-ID: <064.6de299e48fc5a2e62e6d8346f156e203@haskell.org> #14627: qAddTopDecls: can't convert top-level declarations -------------------------------------+------------------------------------- Reporter: tianxiaogu | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Template Haskell | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * os: Linux => Unknown/Multiple * component: Compiler => Template Haskell * architecture: x86_64 (amd64) => Unknown/Multiple -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 2 23:28:12 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 02 Jan 2018 23:28:12 -0000 Subject: [GHC] #14628: Panic (No skolem Info) in GHCi In-Reply-To: <047.60f789bdd71208f33a8f3fb6a4a2adeb@haskell.org> References: <047.60f789bdd71208f33a8f3fb6a4a2adeb@haskell.org> Message-ID: <062.66371842498eee0aa7aaad66f38af593@haskell.org> #14628: Panic (No skolem Info) in GHCi -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: GHCi | Version: 8.2.2 Resolution: | Keywords: debugger Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: #13393 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * keywords: => debugger -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 2 23:28:29 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 02 Jan 2018 23:28:29 -0000 Subject: [GHC] #8487: Debugger confuses variables In-Reply-To: <044.aa4eb9fcbb6c77f9d0eddc9c941c5acb@haskell.org> References: <044.aa4eb9fcbb6c77f9d0eddc9c941c5acb@haskell.org> Message-ID: <059.3a790d796f054c02e6bcd90b5553ec51@haskell.org> #8487: Debugger confuses variables -------------------------------------+------------------------------------- Reporter: edsko | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: GHCi | Version: 7.7 Resolution: | Keywords: debugger Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * keywords: => debugger -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 2 23:28:47 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 02 Jan 2018 23:28:47 -0000 Subject: [GHC] #10616: Panic in ghci debugger with PolyKinds and PhantomTypes In-Reply-To: <047.2301fd74ded448fa87313da3f771dc74@haskell.org> References: <047.2301fd74ded448fa87313da3f771dc74@haskell.org> Message-ID: <062.dc9eac9301bab6c995e9702f9d0e7172@haskell.org> #10616: Panic in ghci debugger with PolyKinds and PhantomTypes -------------------------------+-------------------------------------- Reporter: bjmprice | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: GHCi | Version: 7.10.1 Resolution: | Keywords: debugger Operating System: Linux | Architecture: x86_64 (amd64) Type of failure: GHCi crash | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------+-------------------------------------- Changes (by RyanGlScott): * keywords: => debugger -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 2 23:29:05 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 02 Jan 2018 23:29:05 -0000 Subject: [GHC] #10617: Panic in GHCi debugger with GADTs, PolyKinds and Phantom types In-Reply-To: <047.e5cfdcd1d6a6564527514ba8c400a822@haskell.org> References: <047.e5cfdcd1d6a6564527514ba8c400a822@haskell.org> Message-ID: <062.64ed80fdb7beb4a546cf7dcbb6026743@haskell.org> #10617: Panic in GHCi debugger with GADTs, PolyKinds and Phantom types -------------------------------+--------------------------------------- Reporter: bjmprice | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: GHCi | Version: 7.10.1 Resolution: | Keywords: GADTs, debugger Operating System: Linux | Architecture: x86_64 (amd64) Type of failure: GHCi crash | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------+--------------------------------------- Changes (by RyanGlScott): * keywords: GADTs => GADTs, debugger -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 2 23:29:25 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 02 Jan 2018 23:29:25 -0000 Subject: [GHC] #13201: Type-level naturals aren't instantiated with GHCi debugger In-Reply-To: <043.2d9b82fb9d4411fd0a29dd6e6365673f@haskell.org> References: <043.2d9b82fb9d4411fd0a29dd6e6365673f@haskell.org> Message-ID: <058.56826277c4baf45ea8655339b92f0757@haskell.org> #13201: Type-level naturals aren't instantiated with GHCi debugger -------------------------------------+------------------------------------- Reporter: konn | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: GHCi | Version: 8.0.2 Resolution: | Keywords: debugger Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * keywords: => debugger * component: Compiler => GHCi -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 2 23:29:43 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 02 Jan 2018 23:29:43 -0000 Subject: [GHC] #1377: GHCi debugger tasks In-Reply-To: <047.b3e158073b17fc81d3d320da105cad09@haskell.org> References: <047.b3e158073b17fc81d3d320da105cad09@haskell.org> Message-ID: <062.7d12d74da38317661cf2d628b1992702@haskell.org> #1377: GHCi debugger tasks -------------------------------------+------------------------------------- Reporter: simonmar | Owner: mnislaih Type: task | Status: new Priority: lowest | Milestone: Component: GHCi | Version: 6.7 Resolution: | Keywords: debugger Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * keywords: => debugger -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 2 23:29:54 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 02 Jan 2018 23:29:54 -0000 Subject: [GHC] #1379: Allow breakpoints and single-stepping for functions defined interactively In-Reply-To: <055.a65ba0520737b53c35f6b48366b0c95b@haskell.org> References: <055.a65ba0520737b53c35f6b48366b0c95b@haskell.org> Message-ID: <070.f5158bc038b0387592f11284a9bdac24@haskell.org> #1379: Allow breakpoints and single-stepping for functions defined interactively -------------------------------------+-------------------------------- Reporter: Michael D. Adams | Owner: (none) Type: feature request | Status: new Priority: lowest | Milestone: Component: GHCi | Version: 6.7 Resolution: | Keywords: debugger Operating System: Linux | Architecture: x86 Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+-------------------------------- Changes (by RyanGlScott): * keywords: => debugger -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 2 23:30:09 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 02 Jan 2018 23:30:09 -0000 Subject: [GHC] #1620: ModBreaks.modBreaks_array not initialised In-Reply-To: <044.53d725b3007e15a81cf7af24407f5869@haskell.org> References: <044.53d725b3007e15a81cf7af24407f5869@haskell.org> Message-ID: <059.fb23bc81a9c649c283304317b50419fb@haskell.org> #1620: ModBreaks.modBreaks_array not initialised -------------------------------------+------------------------------------- Reporter: guest | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: GHCi | Version: 7.8.2 Resolution: | Keywords: debugger Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * keywords: => debugger -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 2 23:56:17 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 02 Jan 2018 23:56:17 -0000 Subject: [GHC] #10731: System.IO.openTempFile is not thread safe on Windows In-Reply-To: <051.f6b2ae5c769c1cac9a336c0052f78eb7@haskell.org> References: <051.f6b2ae5c769c1cac9a336c0052f78eb7@haskell.org> Message-ID: <066.8c9f8c4ee4f1d4fd9654a5420dedd233@haskell.org> #10731: System.IO.openTempFile is not thread safe on Windows -------------------------------------+------------------------------------- Reporter: NeilMitchell | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: Component: libraries/base | Version: 7.10.1 Resolution: | Keywords: Operating System: Windows | Architecture: | Unknown/Multiple Type of failure: Runtime crash | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4278 Wiki Page: | -------------------------------------+------------------------------------- Comment (by Ben Gamari ): In [changeset:"46287af0911f7cb446c62850630f85af567ac512/ghc" 46287af0/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="46287af0911f7cb446c62850630f85af567ac512" Make System.IO.openTempFile thread-safe on Windows This calls out to the Win32 API `GetTempFileName` to generate a temporary file. Using `uUnique = 0` guarantees that the file we get back is unique and the file is "reserved" by creating it. Test Plan: ./validate I can't think of any sensible tests that shouldn't run for a while to verify. So the example in #10731 was ran for a while and no collisions in new code Reviewers: hvr, bgamari, erikd Reviewed By: bgamari Subscribers: RyanGlScott, rwbarton, thomie, carter GHC Trac Issues: #10731 Differential Revision: https://phabricator.haskell.org/D4278 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 2 23:56:17 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 02 Jan 2018 23:56:17 -0000 Subject: [GHC] #14608: Different GHCi error messages for similar scenarios In-Reply-To: <043.dc3a47548a95791f116ee7f040dff01e@haskell.org> References: <043.dc3a47548a95791f116ee7f040dff01e@haskell.org> Message-ID: <058.0affe68b4d931c5e32e158ca03cf47cd@haskell.org> #14608: Different GHCi error messages for similar scenarios -------------------------------------+------------------------------------- Reporter: mb64 | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: Component: GHCi | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Poor/confusing | Unknown/Multiple error message | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4276 Wiki Page: | -------------------------------------+------------------------------------- Comment (by Ben Gamari ): In [changeset:"ecff651fc2f6d9833131e3e7fbc9a37b5b2f84ee/ghc" ecff651f/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="ecff651fc2f6d9833131e3e7fbc9a37b5b2f84ee" Fix #14608 by restoring an unboxed tuple check Commit 714bebff44076061d0a719c4eda2cfd213b7ac3d removed a check in the bytecode compiler that caught illegal uses of unboxed tuples (and now sums) in case alternatives, which causes the program in #14608 to panic. This restores the check (using modern, levity-polymorphic vocabulary). Test Plan: make test TEST=T14608 Reviewers: hvr, bgamari, dfeuer, simonpj Reviewed By: dfeuer, simonpj Subscribers: simonpj, rwbarton, thomie, carter GHC Trac Issues: #14608 Differential Revision: https://phabricator.haskell.org/D4276 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 3 00:18:52 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 03 Jan 2018 00:18:52 -0000 Subject: [GHC] #14628: Panic (No skolem Info) in GHCi In-Reply-To: <047.60f789bdd71208f33a8f3fb6a4a2adeb@haskell.org> References: <047.60f789bdd71208f33a8f3fb6a4a2adeb@haskell.org> Message-ID: <062.718dcde4c34d37121ee0e204fcd028c4@haskell.org> #14628: Panic (No skolem Info) in GHCi -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: GHCi | Version: 8.2.2 Resolution: | Keywords: debugger Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: #13393 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): I think it's unrelated to the fix for #13393. As you point out, this is debugger-land, and we have these `RuntimeUnk` skolems, which stand for as-yet-unknown types in the debugger. In this case `_result` has type {{{ _result :: StateT Int m_I4K0[rt] () }}} but the debugger can't figure out (by looking at the heap) what this `m_I4K0` type is. So when typechecking an expression involving `_result` we should complain if this `m` gets unified with anything. And it is when you try to evalute {{{ snd $ runStateT _result 0 }}} We get a wanted constraint {{{ [WD] hole{a4SP} :: (m_I4K0[rt] :: (* -> *)) ~# ((,) a_a4SI[tau:1] :: (* -> *)) }}} The trouble is that, in reporting the error, `TcErrors.getSkolemInfo` of course cannot find an enclosing implication constraint binding that `m`. What we should do instead is: * Make `getSkolemInfo` return a `SkolemInfo` rether than an `Implic` * If `getSkolemInfo` gets a `RuntimeUnk`, just return a new data constructor in `SkolemInfo`, perhpas `RuntimeUnkSkol`. * In `TcErrors.pprSkols` print something sensible for a `RuntimeUnkSkol` It'd be most helpful to look at the top-level type envt, and display some of the in-scope Ids that have that variale free in their types. The `relevantBindings` function might be good for finding such bindings. Any volunteers? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 3 00:33:24 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 03 Jan 2018 00:33:24 -0000 Subject: [GHC] #14626: No need to enter a scrutinised value In-Reply-To: <048.67c951c2aecb97b988badb4816dbe757@haskell.org> References: <048.67c951c2aecb97b988badb4816dbe757@haskell.org> Message-ID: <063.ea485b352d5c8e8b333a0d4c1e7746af@haskell.org> #14626: No need to enter a scrutinised value -------------------------------------+------------------------------------- Reporter: heisenbug | Owner: heisenbug Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: performance Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #13861 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Puzzled by comment:2 I tried it myself. Sure enough, the evaluted-ness flags, so carefully attached by `CoreTidy` were being lost in `CorePrep`. This turned out to date back at least 7 years. * See `Note [dataToTag magic]` in `CorePrep`. It relies evaluated-ness flags. * But those flags were being killed off in `cpCloneBndr`, for reasons described in `Note [Dead code in CorePrep]`. * This was just a bug: it means that the `dataToTag magic` doesn't work properly. Sure enough we get a redundant case (after `CorePrep`) with this program {{{ data T = MkT !Bool f v = case v of MkT y -> dataToTag# y }}} After `CorePrep` we end up with {{{ f v = case v of MkT y -> case y of z -> dataToTag# z }}} which is silly. I'll fix all this and add suitable comments -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 3 00:41:10 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 03 Jan 2018 00:41:10 -0000 Subject: [GHC] #14626: No need to enter a scrutinised value In-Reply-To: <048.67c951c2aecb97b988badb4816dbe757@haskell.org> References: <048.67c951c2aecb97b988badb4816dbe757@haskell.org> Message-ID: <063.360ea0d2e54c8a29aba353dfc119d02a@haskell.org> #14626: No need to enter a scrutinised value -------------------------------------+------------------------------------- Reporter: heisenbug | Owner: heisenbug Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: performance Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #13861 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): > So something is definitely fishy here. I think that there's something different about '''top-level''' binders. Consider {{{ data T = MkT !Bool top_x = True f True (MkT local_y) = local_y f False _ = top_x }}} Here I think that `local_y` gets bound to a correctly-tagged pointer, fetched out of the `MkT` constructor. But, in contrast, I think that `top_x` is bound to the label for the top- level closure for `top_x`, which is 8-byte aligned. So the label isn't tagged; instead, the code generator has to tag it. Is that happening in your "return it instead of eantering it" path? Other than that I have no idea why it crashes. Things you might try: * Switch off the new optimisation when building stage2 and the libraries. Use it only for the test suite: these are small programs and easier to debug. * Maybe add an assertion in the Cmm: the claim is that on the "return it" path, the thing beign returned is a correctly-tagged pointer. So, the assertion can follow the pointer and check that the thing pointed to is a value, with the right tag, etc. There must be some code in the RTS (or somewhere) that checks that. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 3 02:48:30 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 03 Jan 2018 02:48:30 -0000 Subject: [GHC] #14629: Seemingly unused qualified import affects method visibility Message-ID: <046.c97961cf1fb647bcf975eb015cd431af@haskell.org> #14629: Seemingly unused qualified import affects method visibility -------------------------------------+------------------------------------- Reporter: gelisam | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: Poor/confusing Unknown/Multiple | error message Test Case: | Blocked By: Blocking: | Related Tickets: ticket:3992, | ticket:10890 Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- Here is a simple test case: {{{#!hs module MyLib where class MyClass a where myMethod :: a -> a }}} {{{#!hs module MyModule where import MyLib (MyClass) --import qualified MyLib as L data Foo = Foo instance MyClass Foo where -- error: ‘myMethod’ is not a (visible) method of class ‘MyClass’ myMethod Foo = Foo }}} Since I have only imported `MyClass` and not its methods (that would be `import MyLib (MyClass(..))`), the error is correct, `myMethod` is not visible. But if I uncomment the `import qualified MyLib as L` line, the error disappears even though I do not use `L` anywhere. Writing `L.myMethod Foo = Foo` is not even legal! ----- I filed this under "confusing error message", so let me show you the conditions under which the above behaviour was confusing. We were using [https://hackage.haskell.org/package/classy- prelude-1.3.1/docs/ClassyPrelude.html classy-prelude] instead of `Prelude`, but we were not familiar with all the differences between the two preludes. We started with code like this, which did not compile: {{{#!hs {-# LANGUAGE NoImplicitPrelude #-} module MyModule import ClassyPrelude data Foo a = Foo instance Foldable Foo where -- 'foldMap' is not a (visible) method of class 'Foldable' foldMap = undefined }}} So we clarified that we meant `Prelude.Foldable`, in case `ClassyFoldable.Foldable` meant something different. {{{#!hs {-# LANGUAGE NoImplicitPrelude #-} module MyModule import ClassyPrelude import qualified Prelude data Foo a = Foo instance Prelude.Foldable Foo where foldMap = undefined }}} This compiled, so we first thought that `Prelude.Foldable` and `ClassyPrelude.Foldable` were two different type classes, but we later discovered that `ClassyPrelude.Foldable` is a re-export of `Prelude.Foldable`. So the following means the same thing and also compiles: {{{#!hs {-# LANGUAGE NoImplicitPrelude #-} module MyModule import ClassyPrelude import qualified Prelude data Foo a = Foo instance ClassyPrelude.Foldable Foo where foldMap = undefined }}} At this point, the qualified `Prelude` import doesn't seem used anywhere, so we thought it was safe to remove it: {{{#!hs {-# LANGUAGE NoImplicitPrelude #-} import ClassyPrelude data Foo a = Foo instance ClassyPrelude.Foldable Foo where -- 'foldMap' is not a (visible) method of class 'Foldable' foldMap = undefined }}} But `ClassyPrelude.foldMap` is ''not'' the same as `Prelude.foldMap`, so this did not compile and it wasn't clear why. One way to make this less confusing would be to allow qualified method names; this way, we would have tried both `Prelude.foldMap = undefined` and `ClassyPrelude.foldMap = undefined`, and we would have discovered the source of the problem. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 3 03:25:01 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 03 Jan 2018 03:25:01 -0000 Subject: [GHC] #12022: unsafeShiftL and unsafeShiftR are not marked as INLINE In-Reply-To: <049.42a90b3c14f1511ae118c95e3415d83f@haskell.org> References: <049.42a90b3c14f1511ae118c95e3415d83f@haskell.org> Message-ID: <064.09fdf50a62191dbd2ccc3dbb1e6d93ad@haskell.org> #12022: unsafeShiftL and unsafeShiftR are not marked as INLINE -------------------------------------+------------------------------------- Reporter: Rufflewind | Owner: dfeuer Type: feature request | Status: closed Priority: normal | Milestone: Component: libraries/base | Version: 7.10.3 Resolution: invalid | Keywords: performance, | inline, bits 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: | -------------------------------------+------------------------------------- Changes (by dfeuer): * status: new => closed * resolution: => invalid Comment: I stripped out the custom code in `containers` and to the (fairly small) extent that the benchmarks changed, they ''improved''. So I'll close this. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 3 05:46:06 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 03 Jan 2018 05:46:06 -0000 Subject: [GHC] #13002: :set -O does not work in .ghci file In-Reply-To: <045.1c938219ffdaa14f896f37fe62db4c60@haskell.org> References: <045.1c938219ffdaa14f896f37fe62db4c60@haskell.org> Message-ID: <060.0b6297fcb2ee99066a1c5eb2476d9b0c@haskell.org> #13002: :set -O does not work in .ghci file -------------------------------------+------------------------------------- Reporter: George | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.0.3 Component: GHCi | Version: 8.0.1 Resolution: | Keywords: | RecompilationCheck 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: | -------------------------------------+------------------------------------- Comment (by dfeuer): I'm ''guessing'' that the allocation difference is caused by what GHCi does ''before'' it loads the module, and quite possibly even before it loads the `.ghci` file. How could I check this? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 3 06:55:45 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 03 Jan 2018 06:55:45 -0000 Subject: [GHC] #14626: No need to enter a scrutinised value In-Reply-To: <048.67c951c2aecb97b988badb4816dbe757@haskell.org> References: <048.67c951c2aecb97b988badb4816dbe757@haskell.org> Message-ID: <063.54b8e4a1e018fbc8d52d8950b94ad462@haskell.org> #14626: No need to enter a scrutinised value -------------------------------------+------------------------------------- Reporter: heisenbug | Owner: heisenbug Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: performance Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #13861 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by heisenbug): Replying to [comment:5 simonpj]: > > So something is definitely fishy here. > > I think that there's something different about '''top-level''' binders. Consider > {{{#!hs > data T = MkT !Bool > top_x = True > > f True (MkT local_y) = local_y > f False _ = top_x > }}} > Here I think that `local_y` gets bound to a correctly-tagged pointer, fetched out of the `MkT` constructor. > > But, in contrast, I think that `top_x` is bound to the label for the top-level closure for `top_x`, which is 8-byte aligned. So the label isn't tagged; instead, the code generator has to tag it. Is that happening in your "return it instead of eantering it" path? No, I am not returning top-level bindings, I would be okay with entering those. What I want is to avoid entering local bindings from the `StgCase`: {{{#!hs f = \inp -> case inp of wildBind { True -> ...; False -> wildBind } }}} `wildBind` is known to be evaled and properly tagged. I want to `ReturnIt`. > > Other than that I have no idea why it crashes. Things you might try: > > * Switch off the new optimisation when building stage2 and the libraries. Use it only for the test suite: these are small programs and easier to debug. > > * Maybe add an assertion in the Cmm: the claim is that on the "return it" path, the thing beign returned is a correctly-tagged pointer. So, the assertion can follow the pointer and check that the thing pointed to is a value, with the right tag, etc. There must be some code in the RTS (or somewhere) that checks that. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 3 07:04:42 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 03 Jan 2018 07:04:42 -0000 Subject: [GHC] #13002: :set -O does not work in .ghci file In-Reply-To: <045.1c938219ffdaa14f896f37fe62db4c60@haskell.org> References: <045.1c938219ffdaa14f896f37fe62db4c60@haskell.org> Message-ID: <060.a9b116f407661dc5a7aade89f72f351c@haskell.org> #13002: :set -O does not work in .ghci file -------------------------------------+------------------------------------- Reporter: George | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.0.3 Component: GHCi | Version: 8.0.1 Resolution: | Keywords: | RecompilationCheck 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: | -------------------------------------+------------------------------------- Comment (by dfeuer): No, my last comment was bogus. The `.o` file for the one that allocates a lot of memory is larger! The `.hi` files are identical. Very strange. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 3 07:13:25 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 03 Jan 2018 07:13:25 -0000 Subject: [GHC] #13002: :set -O does not work in .ghci file In-Reply-To: <045.1c938219ffdaa14f896f37fe62db4c60@haskell.org> References: <045.1c938219ffdaa14f896f37fe62db4c60@haskell.org> Message-ID: <060.1a412fc125b6a7d395804417f8b2d747@haskell.org> #13002: :set -O does not work in .ghci file -------------------------------------+------------------------------------- Reporter: George | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.0.3 Component: GHCi | Version: 8.0.1 Resolution: | Keywords: | RecompilationCheck 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: | -------------------------------------+------------------------------------- Comment (by dfeuer): No, no, no. I'm wrong again. The `.hi` files are only the same for my modified version. The originals are different. I'll attach them. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 3 09:23:37 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 03 Jan 2018 09:23:37 -0000 Subject: [GHC] #14629: Seemingly unused qualified import affects method visibility In-Reply-To: <046.c97961cf1fb647bcf975eb015cd431af@haskell.org> References: <046.c97961cf1fb647bcf975eb015cd431af@haskell.org> Message-ID: <061.3a531104482203f440cc41fd97aadb43@haskell.org> #14629: Seemingly unused qualified import affects method visibility -------------------------------------+------------------------------------- Reporter: gelisam | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Poor/confusing | Unknown/Multiple error message | Test Case: Blocked By: | Blocking: Related Tickets: ticket:3992, | Differential Rev(s): ticket:10890 | Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): The logic is this: * If you export (or re-export) a class without one or more of its methods, you are trying to hide the very existence of that method in the class, so no client should be able to give an implementation for it. * But if you export it (even if only qualified) you are exposing it, so an instance can use it. * It would obviously be very tiresome to say that a method must be in scope ''unqualified'' in order to use it in an instance declaration. So the test is "is the method in scope, qualified or unqualified" I think this logic makes sense. I thought it was in the Haskell Report but I can't find it. I agree, though, that allowing qualified names on the LHS of an instance decl would make perfect sense. It'd be easy to implement too. Volunteers welcome. (A short GHC proposal would be kosher.) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 3 12:42:53 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 03 Jan 2018 12:42:53 -0000 Subject: [GHC] #14605: Core Lint error In-Reply-To: <051.4d7eef339ce5b99337cf52694286a2a6@haskell.org> References: <051.4d7eef339ce5b99337cf52694286a2a6@haskell.org> Message-ID: <066.9fb5aefdb4bca6b425f68c58dbb868ab@haskell.org> #14605: Core Lint error -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: TypeInType, | DeferredTypeErrors Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #14584 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Simon Peyton Jones ): In [changeset:"298ec78c8832b391c19d662576e59c3e16bd43b0/ghc" 298ec78c/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="298ec78c8832b391c19d662576e59c3e16bd43b0" No deferred type errors under a forall As Trac #14605 showed, we can't defer a type error under a 'forall' (when unifying two forall types). The fix is simple. }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 3 12:42:53 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 03 Jan 2018 12:42:53 -0000 Subject: [GHC] #14626: No need to enter a scrutinised value In-Reply-To: <048.67c951c2aecb97b988badb4816dbe757@haskell.org> References: <048.67c951c2aecb97b988badb4816dbe757@haskell.org> Message-ID: <063.f137dbc1f80e46565a51c5b2a35227f5@haskell.org> #14626: No need to enter a scrutinised value -------------------------------------+------------------------------------- Reporter: heisenbug | Owner: heisenbug Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: performance Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #13861 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Simon Peyton Jones ): In [changeset:"bd438b2d67ec8f5d8ac8472f13b3175b569951b9/ghc" bd438b2/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="bd438b2d67ec8f5d8ac8472f13b3175b569951b9" Get evaluated-ness right in the back end See Trac #14626, comment:4. We want to maintain evaluted-ness info on Ids into the code generateor for two reasons (see Note [Preserve evaluated-ness in CorePrep] in CorePrep) - DataToTag magic - Potentially using it in the codegen (this is Gabor's current work) But it was all being done very inconsistently, and actually outright wrong -- the DataToTag magic hasn't been working for years. This patch tidies it all up, with Notes to match. }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 3 12:42:53 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 03 Jan 2018 12:42:53 -0000 Subject: [GHC] #14607: Core Lint error In-Reply-To: <051.0789d1ec4c690cec121da05b03933298@haskell.org> References: <051.0789d1ec4c690cec121da05b03933298@haskell.org> Message-ID: <066.0b7831c62c61da8e28d6a0f18d10c13e@haskell.org> #14607: Core Lint error -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: TypeInType, | DeferredTypeErrors Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #14605 #14584 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Simon Peyton Jones ): In [changeset:"9e5535ca667e060ce1431d42cdfc3a13ae080a88/ghc" 9e5535ca/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="9e5535ca667e060ce1431d42cdfc3a13ae080a88" Fix OptCoercion In the presence of -fdefer-type-errors, OptCoercion can encounter a mal-formed coerercion with type T a ~ T a b and that was causing a subsequent Lint error. This caused Trac #14607. Easily fixed by turning an ASSERT into a guard. }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 3 12:44:24 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 03 Jan 2018 12:44:24 -0000 Subject: [GHC] #14605: Core Lint error In-Reply-To: <051.4d7eef339ce5b99337cf52694286a2a6@haskell.org> References: <051.4d7eef339ce5b99337cf52694286a2a6@haskell.org> Message-ID: <066.56754f7902ac1ba0d6f6f6d417753ee0@haskell.org> #14605: Core Lint error -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: fixed | Keywords: TypeInType, | DeferredTypeErrors Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: | typecheck/should_fail/T14605 Blocked By: | Blocking: Related Tickets: #14584 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * testcase: => typecheck/should_fail/T14605 * status: new => closed * resolution: => fixed -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 3 12:44:56 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 03 Jan 2018 12:44:56 -0000 Subject: [GHC] #14626: No need to enter a scrutinised value In-Reply-To: <048.67c951c2aecb97b988badb4816dbe757@haskell.org> References: <048.67c951c2aecb97b988badb4816dbe757@haskell.org> Message-ID: <063.071d9123a15378813157c2d11d3ee7a0@haskell.org> #14626: No need to enter a scrutinised value -------------------------------------+------------------------------------- Reporter: heisenbug | Owner: heisenbug Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: performance Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #13861 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): OK I've fixed the stuff in comment:4 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 3 12:45:18 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 03 Jan 2018 12:45:18 -0000 Subject: [GHC] #14607: Core Lint error In-Reply-To: <051.0789d1ec4c690cec121da05b03933298@haskell.org> References: <051.0789d1ec4c690cec121da05b03933298@haskell.org> Message-ID: <066.1d135a7fc4b6ad6db853a6cf13093180@haskell.org> #14607: Core Lint error -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: fixed | Keywords: TypeInType, | DeferredTypeErrors Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: | typecheck/should_fail/T14607 Blocked By: | Blocking: Related Tickets: #14605 #14584 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * testcase: => typecheck/should_fail/T14607 * status: new => closed * resolution: => fixed -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 3 12:56:35 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 03 Jan 2018 12:56:35 -0000 Subject: [GHC] #14630: name shadowing warnings by record pattern synonyms + RecordWildCards or NamedFieldPuns Message-ID: <053.0838c2dcc7b95d4aed5fb595896d561b@haskell.org> #14630: name shadowing warnings by record pattern synonyms + RecordWildCards or NamedFieldPuns -------------------------------------+------------------------------------- Reporter: | Owner: (none) mizunashi_mana | Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Keywords: | Operating System: Unknown/Multiple PatternSynonyms | Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- When I use PatternSynonyms + RecordWildCards/NamedFieldPuns, I get name shadowing warnings. I am hoping that these warnings don't trigger in the below case. {{{#!hs {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE NamedFieldPuns #-} module TestPatternSynonyms where pattern Tuple :: a -> b -> (a, b) pattern Tuple{x, y} = (x, y) {-# COMPLETE Tuple #-} f :: (a, b) -> a f Tuple{x} = x {- warning: [-Wname-shadowing] This binding for ‘x’ shadows the existing binding -} g :: (Int, Int) -> Int g Tuple{..} = x + y {- warning: [-Wname-shadowing] This binding for ‘x’ shadows the existing binding This binding for ‘y’ shadows the existing binding -} }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 3 15:36:54 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 03 Jan 2018 15:36:54 -0000 Subject: [GHC] #14631: GHC 8.2.2 crashes when building the haskell-gi sample code Message-ID: <045.15a472a2467d8fc0989643d3fd91ef45@haskell.org> #14631: GHC 8.2.2 crashes when building the haskell-gi sample code -------------------------------------+------------------------------------- Reporter: muscar | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Keywords: | Operating System: Linux Architecture: x86_64 | Type of failure: Compile-time (amd64) | crash or panic Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- GHC 8.2.2 crashes while building the haskell-gi sample code in a new project created with stack (see the attached project). -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 3 15:40:56 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 03 Jan 2018 15:40:56 -0000 Subject: [GHC] #14631: GHC 8.2.2 crashes when building the haskell-gi sample code In-Reply-To: <045.15a472a2467d8fc0989643d3fd91ef45@haskell.org> References: <045.15a472a2467d8fc0989643d3fd91ef45@haskell.org> Message-ID: <060.e7e279ec9bd225e17c36e5e0f2a0bcdd@haskell.org> #14631: GHC 8.2.2 crashes when building the haskell-gi sample code -------------------------------------+------------------------------------- Reporter: muscar | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Linux | Architecture: x86_64 Type of failure: Compile-time | (amd64) crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by muscar): * Attachment "gtk-hello.tar.bz2" added. Sample project -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 3 15:41:51 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 03 Jan 2018 15:41:51 -0000 Subject: [GHC] #14631: GHC 8.2.2 crashes when building the haskell-gi sample code In-Reply-To: <045.15a472a2467d8fc0989643d3fd91ef45@haskell.org> References: <045.15a472a2467d8fc0989643d3fd91ef45@haskell.org> Message-ID: <060.aba5f255a2e3f8fc8474f2d17f70249b@haskell.org> #14631: GHC 8.2.2 crashes when building the haskell-gi sample code -------------------------------------+------------------------------------- Reporter: muscar | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Linux | Architecture: x86_64 Type of failure: Compile-time | (amd64) crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Description changed by muscar: Old description: > GHC 8.2.2 crashes while building the haskell-gi sample code in a new > project created with stack (see the attached project). New description: GHC 8.2.2 crashes while building the haskell-gi sample code in a new project created with stack (see the attached project). Steps to repro: 1. Download the attached project 2. Unarchive 3. run `stack build` in the project folder. -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 3 15:45:09 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 03 Jan 2018 15:45:09 -0000 Subject: [GHC] #14631: GHC 8.2.2 crashes when building the haskell-gi sample code In-Reply-To: <045.15a472a2467d8fc0989643d3fd91ef45@haskell.org> References: <045.15a472a2467d8fc0989643d3fd91ef45@haskell.org> Message-ID: <060.ae2899ec7859451753d140e46c07df3c@haskell.org> #14631: GHC 8.2.2 crashes when building the haskell-gi sample code -------------------------------------+------------------------------------- Reporter: muscar | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Linux | Architecture: x86_64 Type of failure: Compile-time | (amd64) crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Description changed by muscar: Old description: > GHC 8.2.2 crashes while building the haskell-gi sample code in a new > project created with stack (see the attached project). > > Steps to repro: > > 1. Download the attached project > 2. Unarchive > 3. run `stack build` in the project folder. New description: GHC 8.2.2 crashes while building the haskell-gi sample code in a new project created with stack: ghc: panic! (the 'impossible' happened) (GHC version 8.2.2 for x86_64-unknown-linux): tcIfaceGlobal (local): not found You are in a maze of twisty little passages, all alike. While forcing the thunk for TyThing Layout which was lazily initialized by initIfaceCheck typecheckLoop, I tried to tie the knot, but I couldn't find Layout in the current type environment. If you are developing GHC, please read Note [Tying the knot] and Note [Type-checking inside the knot]. Consider rebuilding GHC with profiling for a better stack trace. Contents of current type environment: [] Call stack: CallStack (from HasCallStack): prettyCurrentCallStack, called at compiler/utils/Outputable.hs:1133:58 in ghc:Outputable callStackDoc, called at compiler/utils/Outputable.hs:1137:37 in ghc:Outputable pprPanic, called at compiler/iface/TcIface.hs:1696:23 in ghc:TcIface Steps to repro: 1. Download the attached project 2. Unarchive 3. run `stack build` in the project folder. -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 3 17:24:14 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 03 Jan 2018 17:24:14 -0000 Subject: [GHC] #14632: Export typeNatDivTyCon from TcTypeNats Message-ID: <046.9a08807e882b9954423a7a486869ec2a@haskell.org> #14632: Export typeNatDivTyCon from TcTypeNats -------------------------------------+------------------------------------- Reporter: darchon | Owner: (none) Type: feature | Status: new request | Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.4.1-alpha1 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: -------------------------------------+------------------------------------- TcTypeNats exports the TyCons for all type-level natural operations, except: - typeNatDivTyCon - typeNatModTyCon - typeNatLogTyCon Could these be exported as well so I dont need ugly code like https://github.com/clash-lang/ghc-typelits- extra/blob/b46074169205945cc0ff822669436ed0b4a83c41/src/GHC/TypeLits/Extra/Solver.hs#L169-L170 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 3 19:40:32 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 03 Jan 2018 19:40:32 -0000 Subject: [GHC] #14633: -fwarn-redundant-constraints false positive Message-ID: <044.fe882f072c6ce802080bede195853a86@haskell.org> #14633: -fwarn-redundant-constraints false positive -------------------------------------+------------------------------------- Reporter: ghorn | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: Incorrect Unknown/Multiple | error/warning at compile-time Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- I had code which compiled cleanly on GHC 8.0.2 with -fwarn-redundant- constraints which now gives a warning on GHC 8.2.2. Here is the code, and my workaround: {{{#!haskell {-# OPTIONS_GHC -Wall -Werror -fwarn-redundant-constraints #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleContexts #-} module Bug ( bug , workaround ) where import GHC.Generics ( D1, Datatype, Meta, Rep, datatypeName ) import Data.Proxy ( Proxy ) -- /home/greghorn/hslibs/ghc82_bug_maybe/Bug.hs:17:1: warning: [-Wredundant-constraints] -- • Redundant constraint: Rep a ~ D1 d p -- • In the type signature for: -- bug :: forall a (d :: Meta) (p :: * -> *). -- (Datatype d, Rep a ~ D1 d p) => -- Proxy a -> String -- | -- 25 | bug :: forall a d p . (Datatype d, Rep a ~ D1 d p) => Proxy a -> String -- | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ bug :: forall a d p . (Datatype d, Rep a ~ D1 d p) => Proxy a -> String bug = const name where name = datatypeName (undefined :: D1 d p b) type family GetD a :: Meta where GetD (D1 d p) = d workaround :: forall a d p . (Datatype (GetD (Rep a)), Rep a ~ D1 d p) => Proxy a -> String workaround = const name where name = datatypeName (undefined :: D1 d p b) }}} I suspect it is a bug because if I remove the "redundant" constraint it no longer typechecks. Here is a minimal setup to reproduce with stack: {{{ name: bug version: 0.0.0.2 license: AllRightsReserved author: Greg Horn maintainer: gregmainland at gmail.com build-type: Simple cabal-version: >=1.10 library exposed-modules: Bug build-depends: base >= 4.7 && < 5 default-language: Haskell2010 }}} {{{ resolver: lts-10.2 compiler-check: newer-minor # Local packages, usually specified by relative directory name packages: - . }}} Alternatively: {{{ git clone https://github.com/ghorn/ghc-redundant-constraint-bug cd ghc-redundant-constraint-bug stack build }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 3 21:28:50 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 03 Jan 2018 21:28:50 -0000 Subject: [GHC] #13002: :set -O does not work in .ghci file In-Reply-To: <045.1c938219ffdaa14f896f37fe62db4c60@haskell.org> References: <045.1c938219ffdaa14f896f37fe62db4c60@haskell.org> Message-ID: <060.11a32e58807a85c8d9ce76d6ce663440@haskell.org> #13002: :set -O does not work in .ghci file -------------------------------------+------------------------------------- Reporter: George | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.0.3 Component: GHCi | Version: 8.0.1 Resolution: | Keywords: | RecompilationCheck 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: | -------------------------------------+------------------------------------- Changes (by dfeuer): * Attachment "Foo-if" added. The interface produced with -O on the command line -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 3 21:29:17 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 03 Jan 2018 21:29:17 -0000 Subject: [GHC] #13002: :set -O does not work in .ghci file In-Reply-To: <045.1c938219ffdaa14f896f37fe62db4c60@haskell.org> References: <045.1c938219ffdaa14f896f37fe62db4c60@haskell.org> Message-ID: <060.9847954804deb420a5523f1c25162feb@haskell.org> #13002: :set -O does not work in .ghci file -------------------------------------+------------------------------------- Reporter: George | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.0.3 Component: GHCi | Version: 8.0.1 Resolution: | Keywords: | RecompilationCheck 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: | -------------------------------------+------------------------------------- Changes (by dfeuer): * Attachment "Foo-if-leak" added. The interface produced *without* -O on the command line -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 3 21:49:21 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 03 Jan 2018 21:49:21 -0000 Subject: [GHC] #14630: name shadowing warnings by record pattern synonyms + RecordWildCards or NamedFieldPuns In-Reply-To: <053.0838c2dcc7b95d4aed5fb595896d561b@haskell.org> References: <053.0838c2dcc7b95d4aed5fb595896d561b@haskell.org> Message-ID: <068.a837c814d945ea8e98f585099960a2df@haskell.org> #14630: name shadowing warnings by record pattern synonyms + RecordWildCards or NamedFieldPuns -------------------------------------+------------------------------------- Reporter: mizunashi_mana | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: | PatternSynonyms Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect | Unknown/Multiple error/warning at compile-time | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by mizunashi_mana): * failure: None/Unknown => Incorrect error/warning at compile-time -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 3 23:24:24 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 03 Jan 2018 23:24:24 -0000 Subject: [GHC] #14633: -fwarn-redundant-constraints false positive In-Reply-To: <044.fe882f072c6ce802080bede195853a86@haskell.org> References: <044.fe882f072c6ce802080bede195853a86@haskell.org> Message-ID: <059.ac4d4e0e8629bf759d152a63825cf84d@haskell.org> #14633: -fwarn-redundant-constraints false positive -------------------------------------+------------------------------------- Reporter: ghorn | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect | Unknown/Multiple error/warning at compile-time | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Here is a much simpler example: {{{ type family F a foo :: forall a b. (Eq a , a ~ F b ) => b -> Bool foo _ = (undefined :: a) == undefined }}} We compiling this we get {{{ T14663.hs:35:1: error: [-Wredundant-constraints, -Werror=redundant- constraints] * Redundant constraint: a ~ F b * In the type signature for: foo :: forall a b. (Eq a, a ~ F b) => b -> Bool | 35 | foo :: forall a b. (Eq a | ^^^^^^^^^^^^^^^^^^^^^^^^... }}} And indeed the equality constraint is redundant: the expression `undefined :: a == undefined` needs `Eq a` but we have that. But if we remove the equality constraint we get this complaint: {{{ T14663.hs:35:8: error: * Could not deduce (Eq a0) from the context: Eq a bound by the type signature for: foo :: forall a b. Eq a => b -> Bool at T14663.hs:(35,8)-(37,33) The type variable `a0' is ambiguous * In the ambiguity check for `foo' <------ NB -------------- To defer the ambiguity check to use sites, enable AllowAmbiguousTypes In the type signature: foo :: forall a b. (Eq a) => b -> Bool | 35 | foo :: forall a b. (Eq a | ^^^^^^^^^^^^^^^^^... }}} Notice that this complaint comes from the '''ambiguity check''' for `foo`. Indeed `foo` really does have an ambiguous type. For example, if have `foo :: Eq a => b -> Bool` and try {{{ foo2 :: Eq c => d -> Bool foo2 = foo }}} we'd fail, because nothing forces the `a` from `foo` to be instantiated to `c` in `foo2`. So the complaint is valid. The solution is to make the type unambiguous, perhaps by adding a proxy parameter: {{{ foo :: forall a b. (Eq a) => Proxy a -> b -> Bool foo _ _ = (undefined :: a) == undefined }}} Now all is well: the type is unambiguous. I suppose you could also try `-XAllowAmbiguousTypes`, but the function really is ambiguous! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 4 00:08:13 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 04 Jan 2018 00:08:13 -0000 Subject: [GHC] #14633: -fwarn-redundant-constraints false positive In-Reply-To: <044.fe882f072c6ce802080bede195853a86@haskell.org> References: <044.fe882f072c6ce802080bede195853a86@haskell.org> Message-ID: <059.a9f13845c785272cc56cb3dd7286fd0d@haskell.org> #14633: -fwarn-redundant-constraints false positive -------------------------------------+------------------------------------- Reporter: ghorn | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect | Unknown/Multiple error/warning at compile-time | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by ghorn): Sounds like GHC 8.2 improved its warnings and exposed a problem with my code -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 4 00:57:55 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 04 Jan 2018 00:57:55 -0000 Subject: [GHC] #14632: Export typeNatDivTyCon from TcTypeNats In-Reply-To: <046.9a08807e882b9954423a7a486869ec2a@haskell.org> References: <046.9a08807e882b9954423a7a486869ec2a@haskell.org> Message-ID: <061.0fd7bcd10b7f93831acda2e271fc1476@haskell.org> #14632: Export typeNatDivTyCon from TcTypeNats -------------------------------------+------------------------------------- Reporter: darchon | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.4.1-alpha1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): That sounds entirely reasonable to me. Care to submit a patch? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 4 01:24:38 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 04 Jan 2018 01:24:38 -0000 Subject: [GHC] #14579: GeneralizedNewtypeDeriving produces ambiguously-kinded code In-Reply-To: <050.a14779f75731c6fe141e22d22092cebf@haskell.org> References: <050.a14779f75731c6fe141e22d22092cebf@haskell.org> Message-ID: <065.8c94ae2cca34fa4799e6235a3e47a3e6@haskell.org> #14579: GeneralizedNewtypeDeriving produces ambiguously-kinded code -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: Component: Compiler (Type | Version: 8.2.2 checker) | Resolution: | Keywords: deriving Operating System: Unknown/Multiple | Architecture: Type of failure: GHC rejects | Unknown/Multiple valid program | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4264 Wiki Page: | -------------------------------------+------------------------------------- Comment (by Ryan Scott ): In [changeset:"649e777211fe08432900093002547d7358f92d82/ghc" 649e777/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="649e777211fe08432900093002547d7358f92d82" Make typeToLHsType produce kind signatures for tycon applications Summary: `GeneralizedNewtypeDeriving` generates calls to `coerce` which take visible type arguments. These types must be produced by way of `typeToLHsType`, which converts a `Type` to an `LHsType`. However, `typeToLHsType` was leaving off important kind information when a `Type` contained a poly-kinded tycon application, leading to incorrectly generated code in #14579. This fixes the issue by tweaking `typeToLHsType` to generate explicit kind signatures for tycon applications. This makes the generated code noisier, but at least the program from #14579 now works correctly. Test Plan: make test TEST=T14579 Reviewers: simonpj, bgamari Reviewed By: simonpj Subscribers: rwbarton, thomie, carter GHC Trac Issues: #14579 Differential Revision: https://phabricator.haskell.org/D4264 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 4 01:25:58 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 04 Jan 2018 01:25:58 -0000 Subject: [GHC] #14579: GeneralizedNewtypeDeriving produces ambiguously-kinded code In-Reply-To: <050.a14779f75731c6fe141e22d22092cebf@haskell.org> References: <050.a14779f75731c6fe141e22d22092cebf@haskell.org> Message-ID: <065.aaf9c02c9a49984678faaf735832e5d1@haskell.org> #14579: GeneralizedNewtypeDeriving produces ambiguously-kinded code -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: merge Priority: normal | Milestone: 8.4.1 Component: Compiler (Type | Version: 8.2.2 checker) | Resolution: | Keywords: deriving Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: GHC rejects | Test Case: valid program | deriving/should_compile/T14579 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4264 Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * testcase: => deriving/should_compile/T14579 * status: patch => merge * milestone: => 8.4.1 Comment: Could merge to 8.4.1 if convenient. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 4 02:15:47 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 04 Jan 2018 02:15:47 -0000 Subject: [GHC] #14630: name shadowing warnings by record pattern synonyms + RecordWildCards or NamedFieldPuns In-Reply-To: <053.0838c2dcc7b95d4aed5fb595896d561b@haskell.org> References: <053.0838c2dcc7b95d4aed5fb595896d561b@haskell.org> Message-ID: <068.dc58acf26639376a856a41e284deca62@haskell.org> #14630: name shadowing warnings by record pattern synonyms + RecordWildCards or NamedFieldPuns -------------------------------------+------------------------------------- Reporter: mizunashi_mana | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: | PatternSynonyms Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect | Unknown/Multiple error/warning at compile-time | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): Hrm, I'm not sure how to fix this. The issues lies with the `is_shadowed_gre` function in `RnUtils`, defined [http://git.haskell.org/ghc.git/blob/7a25659efc4d22086a9e75dc90e3701c1706c625:/compiler/rename/RnUtils.hs#l163 here]: {{{#!hs is_shadowed_gre :: GlobalRdrElt -> RnM Bool -- Returns False for record selectors that are shadowed, when -- punning or wild-cards are on (cf Trac #2723) is_shadowed_gre gre | isRecFldGRE gre = do { dflags <- getDynFlags ; return $ not (xopt LangExt.RecordPuns dflags || xopt LangExt.RecordWildCards dflags) } is_shadowed_gre _other = return True }}} This uses the `isRecFldGRE` function to detect record selectors, which is in turn defined [http://git.haskell.org/ghc.git/blob/649e777211fe08432900093002547d7358f92d82:/compiler/basicTypes/RdrName.hs#l846 as follows]: {{{#!hs isRecFldGRE :: GlobalRdrElt -> Bool isRecFldGRE (GRE {gre_par = FldParent{}}) = True isRecFldGRE _ = False }}} The problem is that pattern synonym record selectors don't use `FldParent` as their `Parent`, but rather `NoParent`. At first, I thought this might have been an oversight, but it turns out there's a reason for this, as explained in [http://git.haskell.org/ghc.git/blob/649e777211fe08432900093002547d7358f92d82:/compiler/basicTypes/RdrName.hs#l578 this comment]: > Record pattern synonym selectors are treated differently. Their parent information is `NoParent` in the module in which they are defined. This is because a pattern synonym `P` has no parent constructor either. So it seems that we need to adjust `isRecFldGRE` to be aware of this fact somehow. But I doubt that having `isRecFldGRE` return `True` whenever it sees //any// occurrence of `NoParent` is the right thing to do... any ideas? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 4 11:04:04 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 04 Jan 2018 11:04:04 -0000 Subject: [GHC] #14634: Add print stacktrace to exception handler in runtime system Message-ID: <046.21083643a219f66288f6ab19ce9366f2@haskell.org> #14634: Add print stacktrace to exception handler in runtime system -------------------------------------+------------------------------------- Reporter: flip101 | Owner: (none) Type: feature | Status: new request | Priority: normal | Milestone: Component: Compiler | Version: 8.2.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: -------------------------------------+------------------------------------- {{{#!hs main :: IO () main = do someIO putStrLn "hello world" someIO :: IO () someIO = ioError $ IOError Nothing IllegalOperation "a" "b" Nothing Nothing }}} This code prints the following {{{ exception: a: illegal operation (b) }}} I think there is something in the runtime system which takes this exception and prints this text to the terminal. I will call this the "runtime exception handler" (for i don't know any better). {{{#!hs main :: IO () main = do ex <- try someIO :: IO (Either IOException ()) case ex of Left e -> error (show e) Right _ -> putStrLn "hello world" someIO :: IO () someIO = ioError $ IOError Nothing IllegalOperation "a" "b" Nothing Nothing }}} output: {{{ exception: a: illegal operation (b) CallStack (from HasCallStack): error, called at src/Main.hs:10:15 in main:Main }}} Now i use an explicit handler in my code and show the stacktrace with `error`. Could this handler be moved into the RTS so that i can stacktraces with exceptions just like with error? I think this issue is related to, but not the same as https://ghc.haskell.org/trac/ghc/ticket/12096 Because "Attach stacktrace information to SomeException" -- whatever there is being attached right now (with lts-10.2 ghc 8.2.2) is good enough to provide the information, it's just the print option in the handler that seems to be missing. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 4 11:09:29 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 04 Jan 2018 11:09:29 -0000 Subject: [GHC] #14635: Double stacktrace with errorWithCallStack Message-ID: <046.342ecdededd713faab2e8b8b0c796ed8@haskell.org> #14635: Double stacktrace with errorWithCallStack -------------------------------------+------------------------------------- Reporter: flip101 | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Documentation | Version: 8.2.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: -------------------------------------+------------------------------------- Hello, The documentation of https://hackage.haskell.org/package/base-4.10.0.0/docs/GHC- Stack.html#t:CallStack uses the following code: {{{#!hs errorWithCallStack :: HasCallStack => String -> a errorWithCallStack msg = error (msg ++ "n" ++ prettyCallStack callStack) }}} But this is confusing because now you will get two stacktraces. One from error and one inside error with prettyCallStack. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 4 11:31:21 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 04 Jan 2018 11:31:21 -0000 Subject: [GHC] #14635: Double stacktrace with errorWithCallStack In-Reply-To: <046.342ecdededd713faab2e8b8b0c796ed8@haskell.org> References: <046.342ecdededd713faab2e8b8b0c796ed8@haskell.org> Message-ID: <061.d067a5c10e53c68cd5d891e4edf10ba9@haskell.org> #14635: Double stacktrace with errorWithCallStack -------------------------------------+------------------------------------- Reporter: flip101 | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Documentation | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by flip101): Same code here https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/glasgow_exts.html#hascallstack -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 4 11:47:11 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 04 Jan 2018 11:47:11 -0000 Subject: [GHC] #14636: GHC Panic Message-ID: <051.6154c2e9259c82c83b3c18102f54a6f7@haskell.org> #14636: GHC Panic -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.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: -------------------------------------+------------------------------------- {{{ $ ghci -ignore-dot-ghci -XPolyKinds -XDataKinds GHCi, version 8.3.20171208: http://www.haskell.org/ghc/ :? for help Prelude> import Data.Proxy Prelude Data.Proxy> data ID :: a -> a -> * Prelude Data.Proxy> :kind (Proxy :: _ ID) ghc-stage2: panic! (the 'impossible' happened) (GHC version 8.3.20171208 for x86_64-unknown-linux): piResultTy k_a1yY[tau:1] ID Call stack: CallStack (from HasCallStack): callStackDoc, called at compiler/utils/Outputable.hs:1144:37 in ghc:Outputable pprPanic, called at compiler/types/Type.hs:951:35 in ghc:Type Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug Prelude Data.Proxy> }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 4 13:30:10 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 04 Jan 2018 13:30:10 -0000 Subject: [GHC] #14636: GHC Panic In-Reply-To: <051.6154c2e9259c82c83b3c18102f54a6f7@haskell.org> References: <051.6154c2e9259c82c83b3c18102f54a6f7@haskell.org> Message-ID: <066.f53d2f667c2e087d3890f2f08177d0e0@haskell.org> #14636: GHC Panic -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Can you give a repro case? Do check that it's not already fixed (search Trac for "piResultTy". Thanks! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 4 13:59:03 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 04 Jan 2018 13:59:03 -0000 Subject: [GHC] #14636: GHC Panic In-Reply-To: <051.6154c2e9259c82c83b3c18102f54a6f7@haskell.org> References: <051.6154c2e9259c82c83b3c18102f54a6f7@haskell.org> Message-ID: <066.e659e2a0cf31444ceedcc0b951c8a3ca@haskell.org> #14636: GHC Panic -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: duplicate | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #14520 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * status: new => closed * resolution: => duplicate * related: => #14520 Comment: Indeed, this is a duplicate of #14520: {{{ $ ghc/inplace/bin/ghc-stage2 --interactive -ignore-dot-ghci -XPolyKinds -XDataKinds GHCi, version 8.5.20180103: http://www.haskell.org/ghc/ :? for help Prelude> import Data.Proxy Prelude Data.Proxy> data ID :: a -> a -> * Prelude Data.Proxy> :kind (Proxy :: _ ID) :1:2: error: • Expecting one more argument to ‘Proxy’ Expected kind ‘_ ID’, but ‘Proxy’ has kind ‘k0 -> *’ • In the type ‘(Proxy :: _ ID)’ }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 4 16:27:35 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 04 Jan 2018 16:27:35 -0000 Subject: [GHC] #14632: Export typeNatDivTyCon from TcTypeNats In-Reply-To: <046.9a08807e882b9954423a7a486869ec2a@haskell.org> References: <046.9a08807e882b9954423a7a486869ec2a@haskell.org> Message-ID: <061.b0f115638bf70250582e858d194c0652@haskell.org> #14632: Export typeNatDivTyCon from TcTypeNats -------------------------------------+------------------------------------- Reporter: darchon | Owner: darchon Type: feature request | Status: new Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.4.1-alpha1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4284 Wiki Page: | -------------------------------------+------------------------------------- Changes (by darchon): * owner: (none) => darchon * differential: => Phab:D4284 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 4 17:04:38 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 04 Jan 2018 17:04:38 -0000 Subject: [GHC] #14626: No need to enter a scrutinised value In-Reply-To: <048.67c951c2aecb97b988badb4816dbe757@haskell.org> References: <048.67c951c2aecb97b988badb4816dbe757@haskell.org> Message-ID: <063.2241fd28ff19cd9685d4aee21e49ac6e@haskell.org> #14626: No need to enter a scrutinised value -------------------------------------+------------------------------------- Reporter: heisenbug | Owner: heisenbug Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: performance Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #13861 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by heisenbug): @simonpj, thanks this is a good start. When restricting myself to `wild*` vars, I already get a nice performance diff on dynamic instruction counts: https://perf.haskell.org/ghc/#compare/7a25659efc4d22086a9e75dc90e3701c1706c625/9ad6982e4074c1fdeff967cafa51e436023d69bb Then I tried to add `ds*` variables too, and (some of) those made the stage-2 crash. It is checked in on the branch if you want to have a try... https://github.com/ghc/ghc/commit/b30d61f64772d744e06e2acbab21895cb20d9bf7 Any hints appreciated! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 4 17:40:56 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 04 Jan 2018 17:40:56 -0000 Subject: [GHC] #14338: Simplifier fails with "Simplifier ticks exhausted" In-Reply-To: <049.819ef8e60a65cb9f3e29afb8f69166a7@haskell.org> References: <049.819ef8e60a65cb9f3e29afb8f69166a7@haskell.org> Message-ID: <064.c96605161e51616b5d398723495fe5b8@haskell.org> #14338: Simplifier fails with "Simplifier ticks exhausted" -------------------------------------+------------------------------------- Reporter: dredozubov | Owner: bgamari Type: bug | Status: new Priority: high | Milestone: 8.4.1 Component: Compiler | Version: 8.2.1 Resolution: | Keywords: Operating System: Linux | Architecture: x86_64 Type of failure: Compile-time | (amd64) crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Simon Peyton Jones ): In [changeset:"954cbc7c106a20639960f55ebb85c5c972652d41/ghc" 954cbc7c/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="954cbc7c106a20639960f55ebb85c5c972652d41" Drop dead Given bindings in setImplicationStatus Trac #13032 pointed out that we sometimes generate unused bindings for Givens, and (worse still) we can't always discard them later (we don't drop a case binding unless we can prove that the scrutinee is non-bottom. It looks as if this may be a major reason for the performace problems in #14338 (see comment:29). This patch fixes the problem at source, by pruning away all the dead Givens. See Note [Delete dead Given evidence bindings] Remarkably, compiler allocation falls by 23% in perf/compiler/T12227! I have not confirmed whether this change actualy helps with }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 4 17:40:56 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 04 Jan 2018 17:40:56 -0000 Subject: [GHC] #14552: GHC panic on pattern synonym In-Reply-To: <051.4b03121ed30f162401f20f20b19c9597@haskell.org> References: <051.4b03121ed30f162401f20f20b19c9597@haskell.org> Message-ID: <066.93623431c8c870da9bc8cea9ed8a8106@haskell.org> #14552: GHC panic on pattern synonym -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.3 Resolution: | Keywords: | PatternSynonyms, TypeInType, | ViewPatterns Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Simon Peyton Jones ): In [changeset:"e2998d720c6b6bf72c86201d816f256a8ba704e6/ghc" e2998d72/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="e2998d720c6b6bf72c86201d816f256a8ba704e6" Stop double-stacktrace in ASSERT failures We were getting the stack trace printed twice in assertion failures (e.g. see the Description of Trac #14552). This fixes it, by deleting code. (c.f. Trac #14635 which reports the same bug in documentation). }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 4 17:40:56 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 04 Jan 2018 17:40:56 -0000 Subject: [GHC] #13032: Redundant forcing of Given dictionaries In-Reply-To: <046.811080f481e777da656f14add09b1cc8@haskell.org> References: <046.811080f481e777da656f14add09b1cc8@haskell.org> Message-ID: <061.711ca51c315715db4a0f1266fe89e91b@haskell.org> #13032: Redundant forcing of Given dictionaries -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.0.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Simon Peyton Jones ): In [changeset:"954cbc7c106a20639960f55ebb85c5c972652d41/ghc" 954cbc7c/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="954cbc7c106a20639960f55ebb85c5c972652d41" Drop dead Given bindings in setImplicationStatus Trac #13032 pointed out that we sometimes generate unused bindings for Givens, and (worse still) we can't always discard them later (we don't drop a case binding unless we can prove that the scrutinee is non-bottom. It looks as if this may be a major reason for the performace problems in #14338 (see comment:29). This patch fixes the problem at source, by pruning away all the dead Givens. See Note [Delete dead Given evidence bindings] Remarkably, compiler allocation falls by 23% in perf/compiler/T12227! I have not confirmed whether this change actualy helps with }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 4 17:40:56 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 04 Jan 2018 17:40:56 -0000 Subject: [GHC] #14635: Double stacktrace with errorWithCallStack In-Reply-To: <046.342ecdededd713faab2e8b8b0c796ed8@haskell.org> References: <046.342ecdededd713faab2e8b8b0c796ed8@haskell.org> Message-ID: <061.6ba05a140ad059687d5356f364449ca3@haskell.org> #14635: Double stacktrace with errorWithCallStack -------------------------------------+------------------------------------- Reporter: flip101 | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Documentation | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Simon Peyton Jones ): In [changeset:"e2998d720c6b6bf72c86201d816f256a8ba704e6/ghc" e2998d72/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="e2998d720c6b6bf72c86201d816f256a8ba704e6" Stop double-stacktrace in ASSERT failures We were getting the stack trace printed twice in assertion failures (e.g. see the Description of Trac #14552). This fixes it, by deleting code. (c.f. Trac #14635 which reports the same bug in documentation). }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 4 17:40:56 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 04 Jan 2018 17:40:56 -0000 Subject: [GHC] #14552: GHC panic on pattern synonym In-Reply-To: <051.4b03121ed30f162401f20f20b19c9597@haskell.org> References: <051.4b03121ed30f162401f20f20b19c9597@haskell.org> Message-ID: <066.5c05668b3f3ab89589eb695ad1d556f9@haskell.org> #14552: GHC panic on pattern synonym -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.3 Resolution: | Keywords: | PatternSynonyms, TypeInType, | ViewPatterns Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Simon Peyton Jones ): In [changeset:"307d1dfe1d705379eafad6dba65e651ae3465cda/ghc" 307d1df/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="307d1dfe1d705379eafad6dba65e651ae3465cda" Fix deep, dark corner of pattern synonyms Trac #14552 showed a very obscure case where we can't infer a good pattern-synonym type. The error message is horrible, but at least we no longer crash and burn. }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 4 17:53:02 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 04 Jan 2018 17:53:02 -0000 Subject: [GHC] #14338: Simplifier fails with "Simplifier ticks exhausted" In-Reply-To: <049.819ef8e60a65cb9f3e29afb8f69166a7@haskell.org> References: <049.819ef8e60a65cb9f3e29afb8f69166a7@haskell.org> Message-ID: <064.f245ea76f7697625823021ec2d09869d@haskell.org> #14338: Simplifier fails with "Simplifier ticks exhausted" -------------------------------------+------------------------------------- Reporter: dredozubov | Owner: bgamari Type: bug | Status: new Priority: high | Milestone: 8.4.1 Component: Compiler | Version: 8.2.1 Resolution: | Keywords: Operating System: Linux | Architecture: x86_64 Type of failure: Compile-time | (amd64) crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): OK Matthew, can you see if the above patch helps? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 4 17:54:22 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 04 Jan 2018 17:54:22 -0000 Subject: [GHC] #14552: GHC panic on pattern synonym In-Reply-To: <051.4b03121ed30f162401f20f20b19c9597@haskell.org> References: <051.4b03121ed30f162401f20f20b19c9597@haskell.org> Message-ID: <066.ad2b22694c57368a637755414c624307@haskell.org> #14552: GHC panic on pattern synonym -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.3 Resolution: | Keywords: | PatternSynonyms, TypeInType, | ViewPatterns Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: | testsuite/tests/patsyn/should_fail/T14552 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * testcase: => testsuite/tests/patsyn/should_fail/T14552 Comment: OK the main fix here is comment:7. I'm not terribly happy with the error message, but it's better than a crash. Iceland Jack: ok? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 4 17:54:55 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 04 Jan 2018 17:54:55 -0000 Subject: [GHC] #13032: Redundant forcing of Given dictionaries In-Reply-To: <046.811080f481e777da656f14add09b1cc8@haskell.org> References: <046.811080f481e777da656f14add09b1cc8@haskell.org> Message-ID: <061.4599d4107b706b5c0b416e1f01c75464@haskell.org> #13032: Redundant forcing of Given dictionaries -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: Component: Compiler | Version: 8.0.1 Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * status: new => closed * resolution: => fixed Comment: This patch fixes the problem at source. Hooray! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 4 17:55:23 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 04 Jan 2018 17:55:23 -0000 Subject: [GHC] #13032: Redundant forcing of Given dictionaries In-Reply-To: <046.811080f481e777da656f14add09b1cc8@haskell.org> References: <046.811080f481e777da656f14add09b1cc8@haskell.org> Message-ID: <061.150923336dbaf0fbf35481dd1a71c6cc@haskell.org> #13032: Redundant forcing of Given dictionaries -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: Component: Compiler | Version: 8.0.1 Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: | typecheck/should_compile/T13032 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * testcase: => typecheck/should_compile/T13032 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 4 17:56:22 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 04 Jan 2018 17:56:22 -0000 Subject: [GHC] #14635: Double stacktrace with errorWithCallStack In-Reply-To: <046.342ecdededd713faab2e8b8b0c796ed8@haskell.org> References: <046.342ecdededd713faab2e8b8b0c796ed8@haskell.org> Message-ID: <061.bcf4a57f91f513613dbb36b0e7c0adb4@haskell.org> #14635: Double stacktrace with errorWithCallStack -------------------------------------+------------------------------------- Reporter: flip101 | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Documentation | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): The above commit just fixes the same problem in GHC's own source code. Could someone else fix the documentation in the two places identified above? Thanks! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 4 19:03:13 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 04 Jan 2018 19:03:13 -0000 Subject: [GHC] #10731: System.IO.openTempFile is not thread safe on Windows In-Reply-To: <051.f6b2ae5c769c1cac9a336c0052f78eb7@haskell.org> References: <051.f6b2ae5c769c1cac9a336c0052f78eb7@haskell.org> Message-ID: <066.1313bad78bac4338fc9fd44d8071ad7f@haskell.org> #10731: System.IO.openTempFile is not thread safe on Windows -------------------------------------+------------------------------------- Reporter: NeilMitchell | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: 8.4.1 Component: libraries/base | Version: 7.10.1 Resolution: fixed | Keywords: Operating System: Windows | Architecture: | Unknown/Multiple Type of failure: Runtime crash | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4278 Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: patch => closed * resolution: => fixed * milestone: => 8.4.1 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 4 19:04:15 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 04 Jan 2018 19:04:15 -0000 Subject: [GHC] #14608: Different GHCi error messages for similar scenarios In-Reply-To: <043.dc3a47548a95791f116ee7f040dff01e@haskell.org> References: <043.dc3a47548a95791f116ee7f040dff01e@haskell.org> Message-ID: <058.826c4cc4770fbf732da2f39afb68235d@haskell.org> #14608: Different GHCi error messages for similar scenarios -------------------------------------+------------------------------------- Reporter: mb64 | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: 8.4.1 Component: GHCi | Version: 8.2.2 Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Poor/confusing | Unknown/Multiple error message | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4276 Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: patch => closed * resolution: => fixed * milestone: => 8.4.1 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 4 22:37:45 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 04 Jan 2018 22:37:45 -0000 Subject: [GHC] #14552: GHC panic on pattern synonym In-Reply-To: <051.4b03121ed30f162401f20f20b19c9597@haskell.org> References: <051.4b03121ed30f162401f20f20b19c9597@haskell.org> Message-ID: <066.0b27c38bb1ca615521b08c98beb0d7b4@haskell.org> #14552: GHC panic on pattern synonym -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: infoneeded Priority: normal | Milestone: Component: Compiler | Version: 8.3 Resolution: | Keywords: | PatternSynonyms, TypeInType, | ViewPatterns Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: | testsuite/tests/patsyn/should_fail/T14552 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * status: new => infoneeded -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 4 22:56:28 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 04 Jan 2018 22:56:28 -0000 Subject: [GHC] #14626: No need to enter a scrutinised value In-Reply-To: <048.67c951c2aecb97b988badb4816dbe757@haskell.org> References: <048.67c951c2aecb97b988badb4816dbe757@haskell.org> Message-ID: <063.f81b7d41fa4b5312d30358acc5a4fe00@haskell.org> #14626: No need to enter a scrutinised value -------------------------------------+------------------------------------- Reporter: heisenbug | Owner: heisenbug Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: performance Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #13861 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): The names of the variables should not make any difference! That's bizarre. Guessing is usually fruitless; you need data. Did you add that assertionn I suggested? As I say, a stage2 compiler is a huge program. I urge you to first build the libraries and compiler without the change; then switch the change on and run the testsuite. Any bugs must be in those little programs. Then nofib. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 4 23:12:24 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 04 Jan 2018 23:12:24 -0000 Subject: [GHC] #14552: GHC panic on pattern synonym In-Reply-To: <051.4b03121ed30f162401f20f20b19c9597@haskell.org> References: <051.4b03121ed30f162401f20f20b19c9597@haskell.org> Message-ID: <066.be71ab34c5dae0d30485246232a84ca5@haskell.org> #14552: GHC panic on pattern synonym -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: infoneeded Priority: normal | Milestone: Component: Compiler | Version: 8.3 Resolution: | Keywords: | PatternSynonyms, TypeInType, | ViewPatterns Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: | testsuite/tests/patsyn/should_fail/T14552 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Iceland_jack): Yeah this is OK -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 4 23:34:39 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 04 Jan 2018 23:34:39 -0000 Subject: [GHC] #14552: GHC panic on pattern synonym In-Reply-To: <051.4b03121ed30f162401f20f20b19c9597@haskell.org> References: <051.4b03121ed30f162401f20f20b19c9597@haskell.org> Message-ID: <066.ff943c8fd28ca24cf651350b979ef8cc@haskell.org> #14552: GHC panic on pattern synonym -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: Component: Compiler | Version: 8.3 Resolution: fixed | Keywords: | PatternSynonyms, TypeInType, | ViewPatterns Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: | testsuite/tests/patsyn/should_fail/T14552 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * status: infoneeded => closed * resolution: => fixed -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 4 23:41:04 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 04 Jan 2018 23:41:04 -0000 Subject: [GHC] #14637: Simplifier Ticks Exhausted when compiling with profiling Message-ID: <048.f4904dcbe44c7548ff4503ec6ec99eff@haskell.org> #14637: Simplifier Ticks Exhausted when compiling with profiling -------------------------------------+------------------------------------- Reporter: cfhammill | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Keywords: | Operating System: Linux Architecture: x86_64 | Type of failure: Compile-time (amd64) | crash or panic Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- Hi GHC devs, I've run into a problem with the Frames library, I can compile a simple example using stack without executable profiling enabled, but when I enable profiling I get the simplifier ticks exhausted error. I've tried using -fsimpl-tick-factor=1000 to no avail. I've attached the stack config, cabal file, haskell code, two csv files, and the simplifier dump. Any help would be appreciated. Chris -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 4 23:41:55 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 04 Jan 2018 23:41:55 -0000 Subject: [GHC] #14637: Simplifier Ticks Exhausted when compiling with profiling In-Reply-To: <048.f4904dcbe44c7548ff4503ec6ec99eff@haskell.org> References: <048.f4904dcbe44c7548ff4503ec6ec99eff@haskell.org> Message-ID: <063.bb139e20983383ff53e5d52897cc82e0@haskell.org> #14637: Simplifier Ticks Exhausted when compiling with profiling -------------------------------------+------------------------------------- Reporter: cfhammill | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Linux | Architecture: x86_64 Type of failure: Compile-time | (amd64) crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by cfhammill): * Attachment "stack.yaml" added. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 4 23:43:19 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 04 Jan 2018 23:43:19 -0000 Subject: [GHC] #14637: Simplifier Ticks Exhausted when compiling with profiling In-Reply-To: <048.f4904dcbe44c7548ff4503ec6ec99eff@haskell.org> References: <048.f4904dcbe44c7548ff4503ec6ec99eff@haskell.org> Message-ID: <063.27d1d889b77bdb66bec3ec8657b64f7a@haskell.org> #14637: Simplifier Ticks Exhausted when compiling with profiling -------------------------------------+------------------------------------- Reporter: cfhammill | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Linux | Architecture: x86_64 Type of failure: Compile-time | (amd64) crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by cfhammill): * Attachment "FL6.csv" added. test csv -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 4 23:43:33 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 04 Jan 2018 23:43:33 -0000 Subject: [GHC] #14637: Simplifier Ticks Exhausted when compiling with profiling In-Reply-To: <048.f4904dcbe44c7548ff4503ec6ec99eff@haskell.org> References: <048.f4904dcbe44c7548ff4503ec6ec99eff@haskell.org> Message-ID: <063.08d4628c214647b7c07a5bfc721310c3@haskell.org> #14637: Simplifier Ticks Exhausted when compiling with profiling -------------------------------------+------------------------------------- Reporter: cfhammill | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Linux | Architecture: x86_64 Type of failure: Compile-time | (amd64) crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by cfhammill): * Attachment "FL7.csv" added. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 4 23:44:01 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 04 Jan 2018 23:44:01 -0000 Subject: [GHC] #14637: Simplifier Ticks Exhausted when compiling with profiling In-Reply-To: <048.f4904dcbe44c7548ff4503ec6ec99eff@haskell.org> References: <048.f4904dcbe44c7548ff4503ec6ec99eff@haskell.org> Message-ID: <063.dd56aa791fd62db5dc1120c3725130ea@haskell.org> #14637: Simplifier Ticks Exhausted when compiling with profiling -------------------------------------+------------------------------------- Reporter: cfhammill | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Linux | Architecture: x86_64 Type of failure: Compile-time | (amd64) crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by cfhammill): * Attachment "bug.hs" added. Code to trigger bug -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 4 23:44:15 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 04 Jan 2018 23:44:15 -0000 Subject: [GHC] #14637: Simplifier Ticks Exhausted when compiling with profiling In-Reply-To: <048.f4904dcbe44c7548ff4503ec6ec99eff@haskell.org> References: <048.f4904dcbe44c7548ff4503ec6ec99eff@haskell.org> Message-ID: <063.001b5b25bea3bec12dd083d523ff0c53@haskell.org> #14637: Simplifier Ticks Exhausted when compiling with profiling -------------------------------------+------------------------------------- Reporter: cfhammill | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Linux | Architecture: x86_64 Type of failure: Compile-time | (amd64) crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by cfhammill): * Attachment "simplifier_dump.txt" added. simplifier dump -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 4 23:44:25 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 04 Jan 2018 23:44:25 -0000 Subject: [GHC] #14637: Simplifier Ticks Exhausted when compiling with profiling In-Reply-To: <048.f4904dcbe44c7548ff4503ec6ec99eff@haskell.org> References: <048.f4904dcbe44c7548ff4503ec6ec99eff@haskell.org> Message-ID: <063.27bb9d5f8f414d36e7d573850a137bf1@haskell.org> #14637: Simplifier Ticks Exhausted when compiling with profiling -------------------------------------+------------------------------------- Reporter: cfhammill | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Linux | Architecture: x86_64 Type of failure: Compile-time | (amd64) crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by cfhammill): * Attachment "ghcBug.cabal" added. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 4 23:58:19 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 04 Jan 2018 23:58:19 -0000 Subject: [GHC] #14338: Simplifier fails with "Simplifier ticks exhausted" In-Reply-To: <049.819ef8e60a65cb9f3e29afb8f69166a7@haskell.org> References: <049.819ef8e60a65cb9f3e29afb8f69166a7@haskell.org> Message-ID: <064.a8c41389267dce79ec96eba043aaf90b@haskell.org> #14338: Simplifier fails with "Simplifier ticks exhausted" -------------------------------------+------------------------------------- Reporter: dredozubov | Owner: bgamari Type: bug | Status: new Priority: high | Milestone: 8.4.1 Component: Compiler | Version: 8.2.1 Resolution: | Keywords: Operating System: Linux | Architecture: x86_64 Type of failure: Compile-time | (amd64) crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by mpickering): I will try this again tomorrow. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 5 00:31:23 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 05 Jan 2018 00:31:23 -0000 Subject: =?utf-8?q?=5BGHC=5D_=2314638=3A_Simplifier_ticks_exhausted_on_?= =?utf-8?q?=CE=A9_lambda_term?= Message-ID: <048.0ef0ac4f96c9c69f4e0cd88315f471a9@haskell.org> #14638: Simplifier ticks exhausted on Ω lambda term -------------------------------------+------------------------------------- Reporter: merlynfry | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.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: -------------------------------------+------------------------------------- GHC panics when trying to compile the following program: {{{#!hs module Omega where newtype Mu a = Roll { unRoll :: Mu a -> a } omega = (\h -> $ Roll h) (\x -> unRoll x $ x) }}} However, GHC has no complaints about interpreting the module. ---- I've attached the most verbose output of GHC, should you so need it. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 5 00:32:09 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 05 Jan 2018 00:32:09 -0000 Subject: =?utf-8?q?Re=3A_=5BGHC=5D_=2314638=3A_Simplifier_ticks_exhausted?= =?utf-8?q?_on_=CE=A9_lambda_term?= In-Reply-To: <048.0ef0ac4f96c9c69f4e0cd88315f471a9@haskell.org> References: <048.0ef0ac4f96c9c69f4e0cd88315f471a9@haskell.org> Message-ID: <063.a20179b43b4aa443d14f2adedc753529@haskell.org> #14638: Simplifier ticks exhausted on Ω lambda term -------------------------------------+------------------------------------- Reporter: merlynfry | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by merlynfry): * Attachment "compilation output" added. GHC Output -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 5 00:36:22 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 05 Jan 2018 00:36:22 -0000 Subject: =?utf-8?q?Re=3A_=5BGHC=5D_=2314638=3A_Simplifier_ticks_exhausted?= =?utf-8?q?_on_=CE=A9_lambda_term?= In-Reply-To: <048.0ef0ac4f96c9c69f4e0cd88315f471a9@haskell.org> References: <048.0ef0ac4f96c9c69f4e0cd88315f471a9@haskell.org> Message-ID: <063.61d6e2ef289e07c41cd2b440c5b93d7b@haskell.org> #14638: Simplifier ticks exhausted on Ω lambda term -------------------------------------+------------------------------------- Reporter: merlynfry | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Old description: > GHC panics when trying to compile the following program: > > {{{#!hs > module Omega where > > newtype Mu a = Roll { unRoll :: Mu a -> a } > > omega = (\h -> $ Roll h) (\x -> unRoll x $ x) > > }}} > > However, GHC has no complaints about interpreting the module. > > ---- > > I've attached the most verbose output of GHC, should you so need it. New description: GHC panics when trying to compile the following program: {{{#!hs module Omega where newtype Mu a = Roll { unRoll :: Mu a -> a } omega = (\h -> h $ Roll h) (\x -> unRoll x $ x) }}} However, GHC has no complaints about interpreting the module. ---- I've attached the most verbose output of GHC, should you so need it. -- Comment (by merlynfry): Correcting a typo. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 5 03:00:36 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 05 Jan 2018 03:00:36 -0000 Subject: [GHC] #14592: Totality checking In-Reply-To: <045.248ecf06ff86b05ee9f7ac04c7a37292@haskell.org> References: <045.248ecf06ff86b05ee9f7ac04c7a37292@haskell.org> Message-ID: <060.54a6aced2ab63ad3f63615bf6ec72b6a@haskell.org> #14592: Totality checking -------------------------------------+------------------------------------- Reporter: varosi | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by goldfire): I agree with your first sentence -- it is of a similar impact to more types. The problem is that Haskell's type system is so flexible at the moment that I'm not sure we could prove any function that contains a function call as terminating. (Kind polymorphism and `Type :: Type` both introduce ways of writing very sneakily non-terminating functions.) So, essentially, I agree with you: we can verify totality only for certain functions, but those functions are (currently) very trivial: just case matches and returned constants. To expand this set would take ground- breaking research. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 5 03:06:22 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 05 Jan 2018 03:06:22 -0000 Subject: =?utf-8?q?Re=3A_=5BGHC=5D_=2314638=3A_Simplifier_ticks_exhausted?= =?utf-8?q?_on_=CE=A9_lambda_term?= In-Reply-To: <048.0ef0ac4f96c9c69f4e0cd88315f471a9@haskell.org> References: <048.0ef0ac4f96c9c69f4e0cd88315f471a9@haskell.org> Message-ID: <063.0beca4cb5d4576a03169e8f4e28e5be1@haskell.org> #14638: Simplifier ticks exhausted on Ω lambda term -------------------------------------+------------------------------------- Reporter: merlynfry | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by merlynfry): After looking at the compilation output log, it would seem (to my admittedly uneducated self) that the simplifier is getting trapped in an infinite loop until the ticks are depleted. The loop being: {{{ /-------------------------------\ | | V | PostInlineUnconditionally | | | V | BetaReduction | | | V | UnfoldingDone | | | | | \-------------------------------/ }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 5 03:28:59 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 05 Jan 2018 03:28:59 -0000 Subject: =?utf-8?q?Re=3A_=5BGHC=5D_=2314638=3A_Simplifier_ticks_exhausted?= =?utf-8?q?_on_=CE=A9_lambda_term?= In-Reply-To: <048.0ef0ac4f96c9c69f4e0cd88315f471a9@haskell.org> References: <048.0ef0ac4f96c9c69f4e0cd88315f471a9@haskell.org> Message-ID: <063.3f4a1f0b487dda9ae45d76a78c51cee4@haskell.org> #14638: Simplifier ticks exhausted on Ω lambda term -------------------------------------+------------------------------------- Reporter: merlynfry | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by goldfire): Is this an instance of the known bug listed as the third bullet [http://downloads.haskell.org/~ghc/latest/docs/html/users_guide/bugs.html #bugs-in-ghc here]? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 5 05:25:00 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 05 Jan 2018 05:25:00 -0000 Subject: [GHC] #14473: Implement Underscores in Numeric Literals Proposal (NumericUnderscores extension) In-Reply-To: <047.9478e62bd80e36e2a95f7745037003bc@haskell.org> References: <047.9478e62bd80e36e2a95f7745037003bc@haskell.org> Message-ID: <062.6444ad84e0e2060e830cbeade6d6e835@haskell.org> #14473: Implement Underscores in Numeric Literals Proposal (NumericUnderscores extension) -------------------------------------+------------------------------------- Reporter: takenobu | Owner: takenobu Type: task | Status: patch Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.2.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #13126 #9224 | Differential Rev(s): Phab:D4235 Wiki Page: | -------------------------------------+------------------------------------- Comment (by takenobu): For the later people, I record about the correspondence status of the syntax highlight on editors and code browsers for `BinaryLiterals`, `HexFloatLiterals` and `NumericUnderscores` extensions. * Vim * It has already been officially implemented. Since patch 8.0.1401 * https://github.com/vim/vim/pull/2455 * Emacs * Lowercase literals are already almost correctly displayed. * `haskell-lexeme.el` and `haskell-font-lock.el` * Atom (language-haskell package) * It has already been officially implemented. Since 1.15.0 * https://github.com/atom-haskell/language-haskell/pull/112 * Visual Studio Code (language-haskell extension) * It has already been officially implemented. * https://github.com/JustusAdam/language-haskell/pull/49 * Linguist (which is used from github) * Linguis uses language-haskell submodule of atom. * Linguis will bump it at new year release. * Pygments (which is used from trac, readthedocs, pandoc, ...) * This is pending review. * https://bitbucket.org/birkenfeld/pygments-main/pull-requests/745 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 5 07:31:47 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 05 Jan 2018 07:31:47 -0000 Subject: [GHC] #14594: 2 modules / 2500LOC takes nearly 3 minutes to build In-Reply-To: <046.b60bf688db171cb4139d3998a57394f4@haskell.org> References: <046.b60bf688db171cb4139d3998a57394f4@haskell.org> Message-ID: <061.b514f57cadc359f07f6f7f07f8482d21@haskell.org> #14594: 2 modules / 2500LOC takes nearly 3 minutes to build -------------------------------------+------------------------------------- Reporter: schyler | Owner: dfeuer Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.0.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by dfeuer): I've looked in a little more detail. The thing I've found most surprising and suspicious is that we end up with absolutely ''enormous'' unfoldings for some dictionaries. For `Data (Maybe Int)`, we get this mouthful: {{{#!hs $s$fDataMaybe_s57H [InlPrag=NOUSERINLINE CONLIKE] :: Data (Maybe Int) [LclId, Unf=DFun: \ -> Data.Data.C:Data TYPE: Maybe Int (base-4.11.0.0:Data.Typeable.Internal.mkTrApp @ * @ * @ Maybe @ Int Data.Data.$fDataMaybe5 Data.Data.$fDataInt4) `cast` (Sym (base-4.11.0.0:Data.Typeable.Internal.N:Typeable[0]) <*>_N _N :: (Type.Reflection.TypeRep (Maybe Int) :: *) ~R# (Typeable (Maybe Int) :: Constraint)) \ (@ (c_a5c3 :: * -> *)) (k_a5c4 [Occ=Once!] :: forall d b. Data d => c_a5c3 (d -> b) -> d -> c_a5c3 b) (z_a5c7 [Occ=Once*!] :: forall g. g -> c_a5c3 g) (ds_a5c9 [Occ=Once!] :: Maybe Int) -> case ds_a5c9 of { Nothing -> z_a5c7 @ (Maybe Int) (GHC.Base.Nothing @ Int); Just a1_a5ce [Occ=Once] -> k_a5c4 @ Int @ (Maybe Int) Data.Data.$fDataInt (z_a5c7 @ (Int -> Maybe Int) (GHC.Base.Just @ Int)) a1_a5ce } Data.Data.$fDataMaybe_$cgunfold @ Int Data.Data.$fDataInt \ (ds_a51o [Occ=Once!] :: Maybe Int) -> case ds_a51o of { Nothing -> Data.Data.$cNothing; Just _ [Occ=Dead] -> Data.Data.$cJust } \ _ [Occ=Dead] -> Data.Data.$tMaybe ... ... }}} Why are we inlining method definitions into the dictionary unfolding at all? I'd expect us to wait for someone to pluck a method from the dictionary unfolding and then consider whether to inline the method. Now I don't know if this has anything to do with the problem, but it looks weird. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 5 07:43:24 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 05 Jan 2018 07:43:24 -0000 Subject: [GHC] #14594: 2 modules / 2500LOC takes nearly 3 minutes to build In-Reply-To: <046.b60bf688db171cb4139d3998a57394f4@haskell.org> References: <046.b60bf688db171cb4139d3998a57394f4@haskell.org> Message-ID: <061.cf33d1903ca26447ac7c2b18ede0b4e8@haskell.org> #14594: 2 modules / 2500LOC takes nearly 3 minutes to build -------------------------------------+------------------------------------- Reporter: schyler | Owner: dfeuer Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.0.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by schyler): Could strictness have anything to do with it, perhaps -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 5 08:44:09 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 05 Jan 2018 08:44:09 -0000 Subject: =?utf-8?q?Re=3A_=5BGHC=5D_=2314638=3A_Simplifier_ticks_exhausted?= =?utf-8?q?_on_=CE=A9_lambda_term?= In-Reply-To: <048.0ef0ac4f96c9c69f4e0cd88315f471a9@haskell.org> References: <048.0ef0ac4f96c9c69f4e0cd88315f471a9@haskell.org> Message-ID: <063.9b666321b24110563dbdaea7dd11123c@haskell.org> #14638: Simplifier ticks exhausted on Ω lambda term -------------------------------------+------------------------------------- Reporter: merlynfry | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): > Is this an instance of the known bug listed as the third bullet ​here? I think it is. The ticks-exhausted thing at least means that GHC stops, rather than going into an infinite loop. It's a shortcoming I don't yet know how to fix, but fortunately it only seems to come up in artificial situations. So far! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 5 09:29:39 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 05 Jan 2018 09:29:39 -0000 Subject: [GHC] #14594: 2 modules / 2500LOC takes nearly 3 minutes to build In-Reply-To: <046.b60bf688db171cb4139d3998a57394f4@haskell.org> References: <046.b60bf688db171cb4139d3998a57394f4@haskell.org> Message-ID: <061.f3b4e113e94adead73fa01d88b00d43c@haskell.org> #14594: 2 modules / 2500LOC takes nearly 3 minutes to build -------------------------------------+------------------------------------- Reporter: schyler | Owner: dfeuer Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.0.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): David, can you make a small repro case for comment:11? Is that really a verbatim transcript. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 5 09:33:44 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 05 Jan 2018 09:33:44 -0000 Subject: [GHC] #14637: Simplifier Ticks Exhausted when compiling with profiling In-Reply-To: <048.f4904dcbe44c7548ff4503ec6ec99eff@haskell.org> References: <048.f4904dcbe44c7548ff4503ec6ec99eff@haskell.org> Message-ID: <063.49c9a98403c86bd1c0558236c237a172@haskell.org> #14637: Simplifier Ticks Exhausted when compiling with profiling -------------------------------------+------------------------------------- Reporter: cfhammill | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Linux | Architecture: x86_64 Type of failure: Compile-time | (amd64) crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): That does look odd. Can you explain the exact steps to reproduce? (Preferably just cabal.) The fewer library dependencies the better! Thanks. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 5 09:46:51 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 05 Jan 2018 09:46:51 -0000 Subject: [GHC] #14507: Core Lint error with Type.Reflection and pattern synonyms In-Reply-To: <051.39dfd28e6e1a32cce4d4d43aea87a71e@haskell.org> References: <051.39dfd28e6e1a32cce4d4d43aea87a71e@haskell.org> Message-ID: <066.6a6ff7870e879563930b706143448dad@haskell.org> #14507: Core Lint error with Type.Reflection and pattern synonyms -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: Component: Compiler | Version: 8.2.1 Resolution: | Keywords: | PatternSynonyms, TypeInType Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Simon Peyton Jones ): In [changeset:"40cbab9afe52fbc780310e880912b56370065a62/ghc" 40cbab9a/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="40cbab9afe52fbc780310e880912b56370065a62" Fix another obscure pattern-synonym crash This one, discovered by Iceland Jack (Trac #14507), shows that a pattern-bound coercion can show up in the argument type(s) of the matcher of a pattern synonym. The error message isn't great, but at least we now rightly reject the program. }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 5 09:48:20 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 05 Jan 2018 09:48:20 -0000 Subject: [GHC] #14507: Core Lint error with Type.Reflection and pattern synonyms In-Reply-To: <051.39dfd28e6e1a32cce4d4d43aea87a71e@haskell.org> References: <051.39dfd28e6e1a32cce4d4d43aea87a71e@haskell.org> Message-ID: <066.c26a3357a2856d811fb23196a443f7b1@haskell.org> #14507: Core Lint error with Type.Reflection and pattern synonyms -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: Component: Compiler | Version: 8.2.1 Resolution: | Keywords: | PatternSynonyms, TypeInType Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): OK now we just reject this program with this error message {{{ T14507.hs:19:9: error: • Iceland Jack! Iceland Jack! Stop torturing me! Pattern-bound variable x :: TypeRep a has a type that mentions pattern-bound coercion: co_a2CF Hint: use -fprint-explicit-coercions to see the coercions Probable fix: add a pattern signature • In the declaration for pattern synonym ‘SO’ }}} I hope you don't mind being immoralised in an error message. If you do, just say and I'll remove it. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 5 10:02:27 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 05 Jan 2018 10:02:27 -0000 Subject: [GHC] #14507: Core Lint error with Type.Reflection and pattern synonyms In-Reply-To: <051.39dfd28e6e1a32cce4d4d43aea87a71e@haskell.org> References: <051.39dfd28e6e1a32cce4d4d43aea87a71e@haskell.org> Message-ID: <066.76845b263e9ee01d22fdeab9eb03ea2a@haskell.org> #14507: Core Lint error with Type.Reflection and pattern synonyms -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: Component: Compiler | Version: 8.2.1 Resolution: | Keywords: | PatternSynonyms, TypeInType Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Iceland_jack): I'm very honored Simon! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 5 10:10:08 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 05 Jan 2018 10:10:08 -0000 Subject: [GHC] #14507: Core Lint error with Type.Reflection and pattern synonyms In-Reply-To: <051.39dfd28e6e1a32cce4d4d43aea87a71e@haskell.org> References: <051.39dfd28e6e1a32cce4d4d43aea87a71e@haskell.org> Message-ID: <066.06d052001f63c14f328898340b7220b5@haskell.org> #14507: Core Lint error with Type.Reflection and pattern synonyms -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: closed Priority: highest | Milestone: Component: Compiler | Version: 8.2.1 Resolution: fixed | Keywords: | PatternSynonyms, TypeInType Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * status: new => closed * resolution: => fixed -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 5 12:41:34 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 05 Jan 2018 12:41:34 -0000 Subject: [GHC] #14473: Implement Underscores in Numeric Literals Proposal (NumericUnderscores extension) In-Reply-To: <047.9478e62bd80e36e2a95f7745037003bc@haskell.org> References: <047.9478e62bd80e36e2a95f7745037003bc@haskell.org> Message-ID: <062.0da08967265f9eba0bd7b845ee6cfa2e@haskell.org> #14473: Implement Underscores in Numeric Literals Proposal (NumericUnderscores extension) -------------------------------------+------------------------------------- Reporter: takenobu | Owner: takenobu Type: task | Status: patch Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.2.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #13126 #9224 | Differential Rev(s): Phab:D4235 Wiki Page: | -------------------------------------+------------------------------------- Comment (by _recursion): I've submitted an issue for this for SublimeHaskell (Sublime Text Haskell plugin) which can be found here: https://github.com/SublimeHaskell/SublimeHaskell/issues/387 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 5 12:52:06 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 05 Jan 2018 12:52:06 -0000 Subject: [GHC] #14473: Implement Underscores in Numeric Literals Proposal (NumericUnderscores extension) In-Reply-To: <047.9478e62bd80e36e2a95f7745037003bc@haskell.org> References: <047.9478e62bd80e36e2a95f7745037003bc@haskell.org> Message-ID: <062.80de92cc1680ab2bc98c470f50d1dfef@haskell.org> #14473: Implement Underscores in Numeric Literals Proposal (NumericUnderscores extension) -------------------------------------+------------------------------------- Reporter: takenobu | Owner: takenobu Type: task | Status: patch Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.2.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #13126 #9224 | Differential Rev(s): Phab:D4235 Wiki Page: | -------------------------------------+------------------------------------- Comment (by takenobu): _recursion,thank you so much! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 5 13:26:43 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 05 Jan 2018 13:26:43 -0000 Subject: =?utf-8?q?Re=3A_=5BGHC=5D_=2314638=3A_Simplifier_ticks_exhausted?= =?utf-8?q?_on_=CE=A9_lambda_term?= In-Reply-To: <048.0ef0ac4f96c9c69f4e0cd88315f471a9@haskell.org> References: <048.0ef0ac4f96c9c69f4e0cd88315f471a9@haskell.org> Message-ID: <063.0d952cc2abfc5535f977f01315cbc023@haskell.org> #14638: Simplifier ticks exhausted on Ω lambda term -------------------------------------+------------------------------------- Reporter: merlynfry | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by merlynfry): Ah. Apologies, I should have been a bit more scrupulous in checking whether this bug had already been found. Should I modify this to be resolved with: 'wontfix', and perhaps put its milestone to bottom? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 5 13:32:32 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 05 Jan 2018 13:32:32 -0000 Subject: [GHC] #14592: Totality checking In-Reply-To: <045.248ecf06ff86b05ee9f7ac04c7a37292@haskell.org> References: <045.248ecf06ff86b05ee9f7ac04c7a37292@haskell.org> Message-ID: <060.080c28783e541cfa29a35137f9466f98@haskell.org> #14592: Totality checking -------------------------------------+------------------------------------- Reporter: varosi | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by varosi): I hope that great people at GHC dev team could trigger such research! May be we could "steal" some good ideas from dependently typed languages, like Idris, Agda, etc. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 5 15:31:19 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 05 Jan 2018 15:31:19 -0000 Subject: [GHC] #14626: No need to enter a scrutinised value In-Reply-To: <048.67c951c2aecb97b988badb4816dbe757@haskell.org> References: <048.67c951c2aecb97b988badb4816dbe757@haskell.org> Message-ID: <063.6b431727f8dca321d127b069f23e6353@haskell.org> #14626: No need to enter a scrutinised value -------------------------------------+------------------------------------- Reporter: heisenbug | Owner: heisenbug Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: performance Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #13861 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by heisenbug): Replying to [comment:10 simonpj]: > The names of the variables should not make any difference! That's bizarre. Of course it is not the names, ''per se''! Rather, one of the names starting with `ds` is misbehaving in a specific way, that trips over `stage2`. I built a `quick` compiler with the given revision, that is `stage2` compiled with `-O0`, and it behaves well. Testsuite passes without any strangeness. Then I bisected the sources in `compiler/*` and isolated these two (mutually dependent) sources, which when built with `-O1` (and all others with `-O0`) break stage 2. Here is what I did (for the record): {{{#!sh nice make V=1 GhcStage2HcOpts="-O0 -g" -j8 rm compiler/stage2/build/StgCmmBind.* nice make V=1 GhcStage2HcOpts="-O1 -g" -j8 ./compiler/stage2/build/StgCmmBind.hi nice make V=1 GhcStage2HcOpts="-O0 -g" -j8 }}} I'll have a look which differences occur here between `-O0` and `-O1`. Both interesting sources are >500 LOC, so it won't be trivial :-) > > Guessing is usually fruitless; you need data. > > Did you add that assertionn I suggested? > > As I say, a stage2 compiler is a huge program. I urge you to first build the libraries and compiler without the change; then switch the change on and run the testsuite. Any bugs must be in those little programs. Then nofib. > -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 5 15:46:13 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 05 Jan 2018 15:46:13 -0000 Subject: [GHC] #14626: No need to enter a scrutinised value In-Reply-To: <048.67c951c2aecb97b988badb4816dbe757@haskell.org> References: <048.67c951c2aecb97b988badb4816dbe757@haskell.org> Message-ID: <063.3630f30b87f3dd0fcf2654ed02fce171@haskell.org> #14626: No need to enter a scrutinised value -------------------------------------+------------------------------------- Reporter: heisenbug | Owner: heisenbug Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: performance Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #13861 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Once more, I urge you ''not'' to try debugging a stage2 compiler, unless you have a great deal of time on your hands. Instead, compile the libraries and stage2 compiler without the optimisation; and then try the testsuite and nofib. These are small programs and much easier to debug. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 5 15:56:55 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 05 Jan 2018 15:56:55 -0000 Subject: =?utf-8?q?Re=3A_=5BGHC=5D_=2314638=3A_Simplifier_ticks_exhausted?= =?utf-8?q?_on_=CE=A9_lambda_term?= In-Reply-To: <048.0ef0ac4f96c9c69f4e0cd88315f471a9@haskell.org> References: <048.0ef0ac4f96c9c69f4e0cd88315f471a9@haskell.org> Message-ID: <063.fdf2748a10b5d5dc9dc4a663cd7f8465@haskell.org> #14638: Simplifier ticks exhausted on Ω lambda term -------------------------------------+------------------------------------- Reporter: merlynfry | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): Indeed, closing as `wontfix` would be appropriate. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 5 16:02:40 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 05 Jan 2018 16:02:40 -0000 Subject: =?utf-8?q?Re=3A_=5BGHC=5D_=2314638=3A_Simplifier_ticks_exhausted?= =?utf-8?q?_on_=CE=A9_lambda_term?= In-Reply-To: <048.0ef0ac4f96c9c69f4e0cd88315f471a9@haskell.org> References: <048.0ef0ac4f96c9c69f4e0cd88315f471a9@haskell.org> Message-ID: <063.f0695212bc20ccafdb82a6e9597f3f98@haskell.org> #14638: Simplifier ticks exhausted on Ω lambda term -------------------------------------+------------------------------------- Reporter: merlynfry | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: ⊥ Component: Compiler | Version: 8.2.2 Resolution: wontfix | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by merlynfry): * status: new => closed * resolution: => wontfix * milestone: => ⊥ -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 5 16:46:40 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 05 Jan 2018 16:46:40 -0000 Subject: [GHC] #14637: Simplifier Ticks Exhausted when compiling with profiling In-Reply-To: <048.f4904dcbe44c7548ff4503ec6ec99eff@haskell.org> References: <048.f4904dcbe44c7548ff4503ec6ec99eff@haskell.org> Message-ID: <063.169e54c51319d55527772005dc93b6c4@haskell.org> #14637: Simplifier Ticks Exhausted when compiling with profiling -------------------------------------+------------------------------------- Reporter: cfhammill | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Linux | Architecture: x86_64 Type of failure: Compile-time | (amd64) crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by cfhammill): Thanks Simon, All you need to do is download the two csv's, bug.hs, and ghcBug.cabal into a directory. From there: {{{ cabal sandbox init echo "executable-profiling: true" >> cabal.config cabal install --only-dependencies cabal build ## fails with ticks error ## remove executable-profiling from cabal.config and rerun cabal build ## succeeds, or uses an extreme amount of memory and dies }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 5 18:05:17 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 05 Jan 2018 18:05:17 -0000 Subject: [GHC] #14639: "unresolved constraints" when import and main missing Message-ID: <051.3640c7cb858f989b51f5359eef0b70e6@haskell.org> #14639: "unresolved constraints" when import and main missing -------------------------------------+------------------------------------- Reporter: bainewedlock | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: GHCi | Version: 8.0.2 Keywords: | Operating System: Windows Architecture: | Type of failure: Compile-time Unknown/Multiple | crash or panic Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- I gut a weird error because I forgot an import and the main method. (the commented lines in the code below) GHCi told me to post a bug about this, so... :-) == Steps to reproduce: {{{ > ghci GHCi, version 8.0.2: http://www.haskell.org/ghc/ :? for help Prelude> :l bug.hs [1 of 1] Compiling Main ( bug.hs, interpreted ) ghc.exe: panic! (the 'impossible' happened) (GHC version 8.0.2 for x86_64-unknown-mingw32): initTc: unsolved constraints WC {wc_insol = [W] printf_a2MG :: t_a2MF[tau:1] (CHoleCan: printf)} Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug }}} == File bug.hs: {{{#!hs module Main where import Test.Hspec import Test.QuickCheck -- import Text.Printf testMovie :: Int -> Int -> Double -> Int -> Spec testMovie card ticket perc s = it (printf "should return Movie for card: %d, ticket: %d perc %s " card ticket (show perc)) $ movie card ticket perc `shouldBe` s movie :: Int -> Int -> Double -> Int movie card ticket perc = 4 -- main :: IO () -- main = undefined }}} == Expected behavior: Useful error message. == Actual behavior: "panic" error message. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 5 20:14:03 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 05 Jan 2018 20:14:03 -0000 Subject: [GHC] #14594: 2 modules / 2500LOC takes nearly 3 minutes to build In-Reply-To: <046.b60bf688db171cb4139d3998a57394f4@haskell.org> References: <046.b60bf688db171cb4139d3998a57394f4@haskell.org> Message-ID: <061.65121d3dc57fd70706b68489e9046e17@haskell.org> #14594: 2 modules / 2500LOC takes nearly 3 minutes to build -------------------------------------+------------------------------------- Reporter: schyler | Owner: dfeuer Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.0.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by dfeuer): Simon, here's a tiny repro: {{{#!hs {-# language RankNTypes #-} module T14594 where import Data.Data newtype Foo = Foo (Maybe Char) gfoldlFoo :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Foo -> c Foo gfoldlFoo k z (Foo a) = z Foo `k` a }}} Compile with `-O` and `-ddump-simpl`, and search for `Data (Maybe Char)`. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 5 20:19:51 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 05 Jan 2018 20:19:51 -0000 Subject: [GHC] #14594: 2 modules / 2500LOC takes nearly 3 minutes to build In-Reply-To: <046.b60bf688db171cb4139d3998a57394f4@haskell.org> References: <046.b60bf688db171cb4139d3998a57394f4@haskell.org> Message-ID: <061.f0719fd08488e6d039e4d5944ec155c8@haskell.org> #14594: 2 modules / 2500LOC takes nearly 3 minutes to build -------------------------------------+------------------------------------- Reporter: schyler | Owner: dfeuer Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.0.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by dfeuer): I would think we'd want a general rule against inlining under a constructor in core2core. The context seems inherently too boring. And indeed we ''don't'' inline into the definition of the dictionary itself; we only inline into its unfolding. I don't know why. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Jan 6 12:17:43 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 06 Jan 2018 12:17:43 -0000 Subject: [GHC] #14639: "unresolved constraints" when import and main missing In-Reply-To: <051.3640c7cb858f989b51f5359eef0b70e6@haskell.org> References: <051.3640c7cb858f989b51f5359eef0b70e6@haskell.org> Message-ID: <066.94dc9d1a8d50cea4dbc712d62d4a4977@haskell.org> #14639: "unresolved constraints" when import and main missing -------------------------------------+------------------------------------- Reporter: bainewedlock | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: Component: GHCi | Version: 8.0.2 Resolution: duplicate | Keywords: Operating System: Windows | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by Phyx-): * status: new => closed * resolution: => duplicate Comment: Thanks for the report, closing this as a duplicate of #13106 which has been fixed in 8.2. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Jan 6 17:48:51 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 06 Jan 2018 17:48:51 -0000 Subject: [GHC] #14624: HEAD panic in ghc:DsForeign: toCType In-Reply-To: <049.18489252b85eb82ec89c6d1f7eb8a625@haskell.org> References: <049.18489252b85eb82ec89c6d1f7eb8a625@haskell.org> Message-ID: <064.6fc665fb8a797fd068b4d5e9ae592e1d@haskell.org> #14624: HEAD panic in ghc:DsForeign: toCType -------------------------------------+------------------------------------- Reporter: tianxiaogu | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler (FFI) | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * os: Linux => Unknown/Multiple * component: Compiler => Compiler (FFI) * architecture: x86_64 (amd64) => Unknown/Multiple -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Jan 6 17:49:59 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 06 Jan 2018 17:49:59 -0000 Subject: [GHC] #14624: capi panic (toCType Int#) (was: HEAD panic in ghc:DsForeign: toCType) In-Reply-To: <049.18489252b85eb82ec89c6d1f7eb8a625@haskell.org> References: <049.18489252b85eb82ec89c6d1f7eb8a625@haskell.org> Message-ID: <064.cb220fcccc9d577b4488d0c389a30993@haskell.org> #14624: capi panic (toCType Int#) -------------------------------------+------------------------------------- Reporter: tianxiaogu | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler (FFI) | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 7 00:16:35 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 07 Jan 2018 00:16:35 -0000 Subject: [GHC] #8684: hWaitForInput cannot be interrupted by async exceptions on unix In-Reply-To: <042.bed34cc32ec4222496f7d8b921c80c8a@haskell.org> References: <042.bed34cc32ec4222496f7d8b921c80c8a@haskell.org> Message-ID: <057.42d992adbac6bb14b42e06b44175aa17@haskell.org> #8684: hWaitForInput cannot be interrupted by async exceptions on unix -------------------------------------+------------------------------------- Reporter: nh2 | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Core Libraries | Version: 7.6.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: 13497, 13525 | Blocking: Related Tickets: #12912, #13525 | Differential Rev(s): Phab:D42 Wiki Page: | -------------------------------------+------------------------------------- Comment (by nh2): As part of the review of my patch in https://phabricator.haskell.org/D42, I have gathered some information of how the timer signal is implemented. Since that may be a useful by itself, I post it here. It is as of commit `a1950e6`, and, since not much of this has changed since the last release, also of GHC 8.2. # How the timer signal is implemented In general, the tick callbacks go like this to do context switching: {{{ handle_tick() contextSwitchAllCapabilities() for all capabilities: contextSwitchCapability() stopCapability() cap->r.rHpLim = NULL; // makes the heap check fail also sets `cap->interrupt = 1;` }}} Methods used on the various platforms: {{{ - POSIX (method selected in `posix/Itimer.c`) - Linux, threaded RTS -> timer_create() if it exists, otherwise setitimer() - Linux, non-threaded, >= 2.6.25 -> pthread with timerfd - Linux, non-threaded, < 2.6.25 -> pthread without timerfd - Darwin -> pthread without timerfd - iOS -> pthread without timerfd - Windows (`win32/Ticker.c`) - Windows -> CreateTimerQueueTimer() }}} Notably the Darwin and iOS implementations use a pthread even for the non- threaded RTS! Relevant trac issues about the above methods: * #1933 - [https://ghc.haskell.org/trac/ghc/ticket/1933 Zero times in profiling with GHC-6.8.1] -- This added autoconf-based detection of `timer_create()` on Linux. * #10840 - [https://ghc.haskell.org/trac/ghc/ticket/10840 Periodic alarm signals can cause a retry loop to get stuck] -- This added the pthread-based implementations. Method implementation locations: {{{ - pthread with timerfd -> `itimer/Pthread.c` - pthread without timerfd (sleep loop) -> `itimer/Pthread.c` - timer_create() -> `itimer/TimerCreate.c` - setitimer() -> `itimer/Setitimer.c` }}} How the implementations work: - pthread with timerfd - A pthread is started that runs a loop reading from the timerfd. No SIGVTALRM is used. When the timerfd ticks, that thread wakes up and calls handle_tick(). - pthread without timerfd - A pthread is started that runs a loop running `sleep(itimer_interval)`. No SIGVTALRM is used. When that thread finishes the sleep, it calls handle_tick(). - timer_create() - A SIGVTALRM signal handler is set up that `handle_tick()`. Then timer_create() is called to set up a SIGVTALRM signal occurring regularly, using the `ITIMER_REAL` real-time clock. The SIGVTALRM signal occurring will EINTR all system calls of all threads of the process. - `setitimer()` - A SIGVTALRM signal handler is set up that `handle_tick()`. Then `setitimer()` is called to set up a SIGVTALRM signal occurring regularly, using the `CLOCK_ID` clock, which is `CLOCK_MONOTONIC` if available and `CLOCK_REALTIME` otherwise. The SIGVTALRM signal occurring will EINTR all system calls of all threads of the process. - `CreateTimerQueueTimer()` - `CreateTimerQueueTimer()` is set up to call `tick_callback()` which calls `tick_proc = handle_tick()` regularly. The option `WT_EXECUTEINTIMERTHREAD` is passed which results in "callback function is invoked by the timer thread itself". There are a couple issues with it: 1. The period is set to `TimeToUS(tick_interval) / 1000` milliseconds, which becomes 0 if less than a millisecond is chosen. `CreateTimerQueueTimer()` does not document what happens if a 0-period is given. It might busy-poll, but it's not documented, so who knows? 2. A comment in the code remarks that this timer has a maximum accuracy of 15ms on Windows 7, and even worse on older platforms. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 7 03:11:46 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 07 Jan 2018 03:11:46 -0000 Subject: [GHC] #14630: name shadowing warnings by record pattern synonyms + RecordWildCards or NamedFieldPuns In-Reply-To: <053.0838c2dcc7b95d4aed5fb595896d561b@haskell.org> References: <053.0838c2dcc7b95d4aed5fb595896d561b@haskell.org> Message-ID: <068.15cd2c40b7aadaf2e894d90a7b3f41dd@haskell.org> #14630: name shadowing warnings by record pattern synonyms + RecordWildCards or NamedFieldPuns -------------------------------------+------------------------------------- Reporter: mizunashi_mana | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: | PatternSynonyms Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect | Unknown/Multiple error/warning at compile-time | Test Case: Blocked By: | Blocking: Related Tickets: #11228 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * related: => #11228 Comment: This is likely related in nature to #11228 (Interaction between ORF and record pattern synonyms needs to be resolved.), since `FldParent` is used to disambiguate duplicate record fields in the presence of `DuplicateRecordFields`. This means that this program will not compile: {{{#!hs {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE PatternSynonyms #-} module Bug where pattern Foo :: Int -> Int -> (Int, Int) pattern Foo {x, y} = (x, y) pattern Bar :: Int -> Int -> (Int, Int) pattern Bar {x, y} = (x, y) }}} Whereas if `x` and `y` were normal record selectors from a data type constructor, GHC would accept them. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 7 05:33:14 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 07 Jan 2018 05:33:14 -0000 Subject: [GHC] #14640: Div and Mod type families don't have the same fixities as their term-level counterparts Message-ID: <050.f59dff27cbd52ba0b8f3d501166d856b@haskell.org> #14640: Div and Mod type families don't have the same fixities as their term-level counterparts -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.4.1 Component: | Version: 8.4.1-alpha1 libraries/base | 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: -------------------------------------+------------------------------------- Commit fa8035e3ee83aff5a20fc5e7e2697bac1686d6a6 added `Div` and `Mod` type families to `GHC.TypeNats`. However, they did not add the corresponding fixities! Currently, we have that both `div` and `mod` (at the value level) are `infixl 7`, so we should adopt the same fixities for the type- level `Div` and `Mod` as well. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 7 05:36:06 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 07 Jan 2018 05:36:06 -0000 Subject: [GHC] #14640: Div and Mod type families don't have the same fixities as their term-level counterparts In-Reply-To: <050.f59dff27cbd52ba0b8f3d501166d856b@haskell.org> References: <050.f59dff27cbd52ba0b8f3d501166d856b@haskell.org> Message-ID: <065.43117748693df3724e7181c7a32d2e35@haskell.org> #14640: Div and Mod type families don't have the same fixities as their term-level counterparts -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: 8.4.1 Component: libraries/base | Version: 8.4.1-alpha1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4291 Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * status: new => patch * differential: => Phab:D4291 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 7 08:37:54 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 07 Jan 2018 08:37:54 -0000 Subject: [GHC] #14641: GHC panics in incomplete program Message-ID: <042.4514b6a37a813e90854f77d12f99e562@haskell.org> #14641: GHC panics in incomplete program -------------------------------------+------------------------------------- Reporter: mmc | Owner: (none) Type: bug | Status: new Priority: low | Milestone: Component: Compiler | Version: 8.0.2 Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: Compile-time Unknown/Multiple | crash or panic Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- I misspell a variable and GHC panics. I have the following test1.hs file: {{{ foo :: Double -> Double -> Bool foo a b = c > b }}} Then I do ghc -c test1.hs and get: {{{ ghc: panic! (the 'impossible' happened) (GHC version 8.0.2 for x86_64-unknown-linux): initTc: unsolved constraints WC {wc_insol = [W] x_a1LD :: t_a1LC[tau:1] (CHoleCan: x)} }}} If I add a "main" method to my test.hs, I get the expected {{{ test1.hs:2:11: error: Variable not in scope: c :: Double }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 7 11:58:54 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 07 Jan 2018 11:58:54 -0000 Subject: [GHC] #14338: Simplifier fails with "Simplifier ticks exhausted" In-Reply-To: <049.819ef8e60a65cb9f3e29afb8f69166a7@haskell.org> References: <049.819ef8e60a65cb9f3e29afb8f69166a7@haskell.org> Message-ID: <064.613743e2445245b5124b859a9d26faa0@haskell.org> #14338: Simplifier fails with "Simplifier ticks exhausted" -------------------------------------+------------------------------------- Reporter: dredozubov | Owner: bgamari Type: bug | Status: closed Priority: high | Milestone: 8.4.1 Component: Compiler | Version: 8.2.1 Resolution: fixed | Keywords: Operating System: Linux | Architecture: x86_64 Type of failure: Compile-time | (amd64) crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by mpickering): * status: new => closed * resolution: => fixed Comment: Cheers Simon. That did the trick. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 7 14:03:51 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 07 Jan 2018 14:03:51 -0000 Subject: =?utf-8?b?W0dIQ10gIzE0NjQyOiDigJhjbGFzcyBDIHVzaW5n4oCZIGZhaWxz?= =?utf-8?q?_to_parse_with_MonadComprehensions?= Message-ID: <051.124e298093b7abc24b0dbf1f070ea713@haskell.org> #14642: ‘class C using’ fails to parse with MonadComprehensions -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.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: -------------------------------------+------------------------------------- `TransformListComp` / `MonadComprehensions` reserve `using` but should this not work? {{{#!hs {-# Language TransformListComp #-} class C using }}} gives {{{ $ ghci -ignore-dot-ghci /tmp/X.hs GHCi, version 8.5.20180105: http://www.haskell.org/ghc/ :? for help [1 of 1] Compiling Main ( /tmp/X.hs, interpreted ) /tmp/X.hs:3:9: error: parse error on input ‘using’ | 3 | class C using | ^^^^^ Failed, no modules loaded. Prelude> }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 7 18:08:07 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 07 Jan 2018 18:08:07 -0000 Subject: [GHC] #10245: panic in new integer switch logic with "out-of-range" literals In-Reply-To: <047.75ea0dc3feddacd480f06c86ecf69bf6@haskell.org> References: <047.75ea0dc3feddacd480f06c86ecf69bf6@haskell.org> Message-ID: <062.bb9c27ac4cc40c61d376457830ad03b6@haskell.org> #10245: panic in new integer switch logic with "out-of-range" literals -------------------------------------+------------------------------------- Reporter: rwbarton | Owner: AndreasK Type: bug | Status: closed Priority: normal | Milestone: 8.2.1 Component: Compiler | Version: 7.11 (CodeGen) | Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: x86_64 Type of failure: Incorrect result | (amd64) at runtime | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4218 Wiki Page: | -------------------------------------+------------------------------------- Changes (by AndreasK): * status: patch => closed * resolution: => fixed Comment: Replying to [comment:15 AndreasK]: > In MatchLit [https://ghc.haskell.org/trac/ghc/browser/ghc/compiler/deSugar/MatchLit.hs#L76 dsLit] doesn't use the `mkMachInt` functions resulting in potentially faulty code. > > `y = I# 0x8000000000000000# :: Int` compiles without warning with -Wall for example. Fixing this would incur a overhead when compiling Code which generates Prim Literals. As these use the same code Path as user specified Literals we can't skip the checks on these even when we know these will not be out of bounds. Closing this after a discussion on IRC and it's not deemed a big enough issue to warrant the overhead. (wontfix as to not confuse this issue with the original one) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 7 18:33:06 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 07 Jan 2018 18:33:06 -0000 Subject: [GHC] #13903: KQueue evtmgr backend fails to register for write events In-Reply-To: <048.b40d50b7e059c68fc52d5bbd492f52b4@haskell.org> References: <048.b40d50b7e059c68fc52d5bbd492f52b4@haskell.org> Message-ID: <063.388c2550b128fb109394a8e24b979590@haskell.org> #13903: KQueue evtmgr backend fails to register for write events -------------------------------------+------------------------------------- Reporter: waldheinz | Owner: (none) Type: bug | Status: merge Priority: normal | Milestone: 8.4.1 Component: Runtime System | Version: 8.0.2 Resolution: | Keywords: Operating System: FreeBSD | Architecture: Type of failure: Incorrect result | Unknown/Multiple at runtime | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D3692 Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: patch => merge -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 7 19:23:48 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 07 Jan 2018 19:23:48 -0000 Subject: [GHC] #11080: Open data kinds In-Reply-To: <047.64e06093644ddd3cb76b94e28bef420a@haskell.org> References: <047.64e06093644ddd3cb76b94e28bef420a@haskell.org> Message-ID: <062.e2adb9fdd1fb66c06844c30706e60ec5@haskell.org> #11080: Open data kinds -------------------------------------+------------------------------------- Reporter: dmcclean | Owner: jstolarek Type: feature request | Status: new Priority: low | Milestone: Component: Compiler | Version: Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #6024 | Differential Rev(s): Phab:D1778 Wiki Page: | GhcKinds/KindsWithoutData | -------------------------------------+------------------------------------- Comment (by Iceland_jack): I discuss my use cases for this feature here [https://gist.github.com/Icelandjack/ae22c42b01c9be7e8a82f80bc8ab3f1c Encoding Overlapping, Extensible Isomorphisms] & [https://gist.github.com/Icelandjack/865476f2299a4916d4e237d0f8ed0119 Rethinking Tricky Classes: Explicit Witnesses of Monoid Actions, Semigroup / Monoid / Applicative homomorphisms]. Does it make sense to allow associated open kinds? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 7 19:59:22 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 07 Jan 2018 19:59:22 -0000 Subject: [GHC] #14643: Partial type signatures in spliced TH declarations behave unexpectedly Message-ID: <047.6762d95c975e1952f57776fe89e6e2c0@haskell.org> #14643: Partial type signatures in spliced TH declarations behave unexpectedly -------------------------------------+------------------------------------- Reporter: mnislaih | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.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: -------------------------------------+------------------------------------- Minimal example: {{{#!hs {-# LANGUAGE PartialTypeSignatures #-} {-# LANGUAGE TemplateHaskell #-} module Minimal where id [d| f :: (Monad m, _) => [m a] -> m [a] f' :: (Monad m, _) => [m a] -> m [a] f = f' f' [] = return [] f' (x:xx) = f xx |] }}} {{{ [1 of 1] Compiling Minimal ( /Users/pepe/Dropbox/code/debug- hoed/test/minimal.hs, interpreted ) /Users/pepe/Dropbox/code/debug-hoed/test/minimal.hs:5:1: warning: [-Wpartial-type-signatures] • Found type wildcard ‘_’ standing for ‘()’ • In the type signature: f :: (Monad m_a7NN, _) => [m_a7NN a_a7NO] -> m_a7NN [a_a7NO] | 5 | id [d| | ^^^^^^... /Users/pepe/Dropbox/code/debug-hoed/test/minimal.hs:5:1: warning: [-Wpartial-type-signatures] • Found type wildcard ‘_’ standing for ‘()’ • In the type signature: f' :: (Monad m_a7NL, _) => [m_a7NL a_a7NM] -> m_a7NL [a_a7NM] | 5 | id [d| | ^^^^^^... Ok, one module loaded. :browse f :: (Monad m, Monad m) => [m a] -> m [a] f' :: (Monad m, Monad m) => [m a] -> m [a] }}} Notice the duplicate Monad m constraint. Things get even more weird if the type signatures are declared together: {{{#!hs id [d| f, f' :: (Monad m, _) => [m a] -> m [a] f = f' f' [] = return [] f' (x:xx) = f xx |] }}} {{{ [1 of 1] Compiling Minimal ( /Users/pepe/Dropbox/code/debug- hoed/test/minimal.hs, interpreted ) /Users/pepe/Dropbox/code/debug-hoed/test/minimal.hs:5:1: warning: [-Wpartial-type-signatures] • Found type wildcard ‘_’ standing for ‘()’ • In the type signature: f :: (Monad m_a88E, _) => [m_a88E a_a88F] -> m_a88E [a_a88F] | 5 | id [d| | ^^^^^^... /Users/pepe/Dropbox/code/debug-hoed/test/minimal.hs:5:1: warning: [-Wpartial-type-signatures] • Found type wildcard ‘_’ standing for ‘()’ • In the type signature: f' :: (Monad m_a88E, _) => [m_a88E a_a88F] -> m_a88E [a_a88F] | 5 | id [d| | ^^^^^^... Ok, one module loaded. :browse f :: (Monad ghc-prim-0.5.1.1:GHC.Types.Any, Monad m) => [ghc-prim-0.5.1.1:GHC.Types.Any ghc-prim-0.5.1.1:GHC.Types.Any] -> ghc-prim-0.5.1.1:GHC.Types.Any [ghc-prim-0.5.1.1:GHC.Types.Any] f' :: (Monad ghc-prim-0.5.1.1:GHC.Types.Any, Monad m) => [m a] -> m [a] }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 7 20:04:38 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 07 Jan 2018 20:04:38 -0000 Subject: [GHC] #14644: Improve cmm/assembly for pattern matches with two constants. Message-ID: <047.054a8f1d3e52c239a87742662b91a120@haskell.org> #14644: Improve cmm/assembly for pattern matches with two constants. -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 (CodeGen) | Keywords: Codegen, CMM, | Operating System: Unknown/Multiple Patterns, Pattern Matching | Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- For a pattern like: {{{ f_test :: Int#->Int# f_test a = case a of 1# -> 33# 7# -> 34# _ -> -1# }}} GHC currently generates code that works best if the default branch is taken most often. Pseudo-Code {{{ if (a >= 8) return -1; else { if (a < 7) { if(a != 1) return -1; else return 33; } else return 34; } }}} CMM: {{{ c1cr: // global if (%MO_S_Ge_W64(R2, 8)) goto c1co; else goto u1cu; u1cu: // global if (%MO_S_Lt_W64(R2, 7)) goto u1cv; else goto c1cq; u1cv: // global if (R2 != 1) goto c1co; else goto c1cp; c1co: // global R1 = (-1); call (P64[Sp])(R1) args: 8, res: 0, upd: 8; c1cp: // global R1 = 33; call (P64[Sp])(R1) args: 8, res: 0, upd: 8; c1cq: // global R1 = 34; call (P64[Sp])(R1) args: 8, res: 0, upd: 8; } }}} Wouldn't the following be better? {{{ if(a == 1) return 33 else if(a == 7) return 34 else return -1 }}} I would expect that to * Improve the cases: * a = 1 * a < 7 * Be the same for: * a = 7 * Be worse for * a > 8 This would be especially nice for the cases where the default branch is raising a pattern match exception. Which is a code path I wouldn't expect to be taken often nor be very performance sensitive. Even if we keep the current logic there is room for improvement. GHC currently creates the following assembly: {{{ _c1cr: cmpq $8,%r14 jge _c1co _u1cu: cmpq $7,%r14 jl _u1cv _c1cq: movl $34,%ebx jmp *(%rbp) _u1cv: cmpq $1,%r14 jne _c1co _c1cp: movl $33,%ebx jmp *(%rbp) _c1co: movq $-1,%rbx jmp *(%rbp) }}} It would be nice if we could remove one comparison at least. {{{ _c1cr: cmpq $7,%r14 jg _c1co _u1cu: ;No longer neccesary cmpq $7,%r14 jl _u1cv _c1cq: movl $34,%ebx jmp *(%rbp) _u1cv: cmpq $1,%r14 jne _c1co _c1cp: movl $33,%ebx jmp *(%rbp) _c1co: movq $-1,%rbx jmp *(%rbp) }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 7 20:30:08 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 07 Jan 2018 20:30:08 -0000 Subject: [GHC] #14643: Partial type signatures in spliced TH declarations behave unexpectedly In-Reply-To: <047.6762d95c975e1952f57776fe89e6e2c0@haskell.org> References: <047.6762d95c975e1952f57776fe89e6e2c0@haskell.org> Message-ID: <062.d65fd089c30dc3f5b762c0408753b94f@haskell.org> #14643: Partial type signatures in spliced TH declarations behave unexpectedly -------------------------------------+------------------------------------- Reporter: mnislaih | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by mnislaih): It looks the same under ghc 8.4 alpha: {{{ GHCi, version 8.4.0.20171214: http://www.haskell.org/ghc/ :? for help [1 of 1] Compiling Minimal ( code/debug-hoed/test/minimal.hs, interpreted ) code/debug-hoed/test/minimal.hs:5:1: warning: [-Wpartial-type-signatures] • Found type wildcard ‘_’ standing for ‘()’ • In the type signature: f :: (Monad m_a46U, _) => [m_a46U a_a46V] -> m_a46U [a_a46V] | 5 | id [d| | ^^^^^^... code/debug-hoed/test/minimal.hs:5:1: warning: [-Wpartial-type-signatures] • Found type wildcard ‘_’ standing for ‘()’ • In the type signature: f' :: (Monad m_a46U, _) => [m_a46U a_a46V] -> m_a46U [a_a46V] | 5 | id [d| | ^^^^^^... Ok, one module loaded. *Minimal> :browse f :: (Monad GHC.Types.Any, Monad m) => [GHC.Types.Any GHC.Types.Any] -> GHC.Types.Any [GHC.Types.Any] f' :: (Monad GHC.Types.Any, Monad m) => [m a] -> m [a] }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 7 21:25:27 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 07 Jan 2018 21:25:27 -0000 Subject: [GHC] #14645: Allow type family in data family return kind Message-ID: <047.3515b5078f2cb34cf2db81ba3af73423@haskell.org> #14645: Allow type family in data family return kind -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.4.1-alpha1 Keywords: TypeInType, | Operating System: Unknown/Multiple TypeFamilies | Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- GHC currently allows {{{#!hs data family DF1 :: k1 -> k2 }}} where it's expected (and checked) that all data ''instances'' have a return kind of `Type`. (Perhaps `k2` expands to `Type -> Type`, for example.) However, it rejects {{{#!hs type family TF (x :: Type) :: Type data family DF2 :: x -> TF x }}} when that's clearly just as sensible as the first definition. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 7 22:16:07 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 07 Jan 2018 22:16:07 -0000 Subject: [GHC] #14645: Allow type family in data family return kind In-Reply-To: <047.3515b5078f2cb34cf2db81ba3af73423@haskell.org> References: <047.3515b5078f2cb34cf2db81ba3af73423@haskell.org> Message-ID: <062.ed89caa91c90e8228d013477c2fb4929@haskell.org> #14645: Allow type family in data family return kind -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.4.1-alpha1 Resolution: | Keywords: TypeInType, | TypeFamilies Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): Is this the same bug as #14042? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 7 22:35:19 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 07 Jan 2018 22:35:19 -0000 Subject: [GHC] #14042: Datatypes cannot use a type family in their return kind In-Reply-To: <050.9a18856b2826cce2f7fbd06d0b9d2dd1@haskell.org> References: <050.9a18856b2826cce2f7fbd06d0b9d2dd1@haskell.org> Message-ID: <065.e8626e9aefc424ed433351c1b799be79@haskell.org> #14042: Datatypes cannot use a type family in their return kind -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.0.1 checker) | Keywords: TypeInType, Resolution: | TypeFamilies Operating System: Unknown/Multiple | Architecture: Type of failure: GHC rejects | Unknown/Multiple valid program | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by goldfire): I'm wondering why you want a datatype instead of a data family. A data family makes grand sense here. But I'm still stuck on how a datatype could work this way. For example: {{{#!hs bar :: Foo n -> ... bar f = case f of MkFoo0 -> ... MkFoo1 x -> ... MkFoo2 x y -> ... }}} What are the types of `x` and `y`? I suppose they're existential... but they certainly don't look it from the declaration. And, if we discover that `f` is `MkFoo1`, say, then we learn that type of `bar` is ill-kinded. Indeed, perhaps the fact that `Foo n :: Type` tells us that `n ~ Z` without any pattern matches. (NB: `MkFun` really ''is'' injective, even if GHC can't know it.) Given this fact, I don't know how you could construct a function where there is more than one possible constructor for `Foo`. Also, I like to think about GADTs in terms of their desugaring to uniform datatypes with equality constraints. How would `Foo` desugar? {{{#!hs Foo :: forall (args :: Nat). MkFun args MkFoo0 :: forall (args :: Nat). args ~ Z => Foo args MkFoo1 :: forall (args :: Nat). forall (a :: Type). -- existential?? args ~ S Z => a -> Foo args }}} I've left off the last constructor, as it doesn't illustrate much more. The problem is that, in this formulation, the final result type must always be `Foo args`. That's what uniform means. But, here, `Foo args` is ill-kinded there. So I really have no idea what this construct means. My bottom line (supported more by my first line of argument than my second): you really want a data family, and we should close this ticket in favor of #14645. The only advantage of a datatype over a data family is that one pattern match of a datatype can cover a multitude of cases -- but you don't actually achieve that here. Furthermore, despite my comment:13, I have a much better picture of how to implement this idea for data families than I do for datatypes. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 7 22:37:23 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 07 Jan 2018 22:37:23 -0000 Subject: [GHC] #14042: Datatypes cannot use a type family in their return kind In-Reply-To: <050.9a18856b2826cce2f7fbd06d0b9d2dd1@haskell.org> References: <050.9a18856b2826cce2f7fbd06d0b9d2dd1@haskell.org> Message-ID: <065.597dbb834709d001ef9291ee7e299092@haskell.org> #14042: Datatypes cannot use a type family in their return kind -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: Component: Compiler (Type | Version: 8.0.1 checker) | Keywords: TypeInType, Resolution: duplicate | TypeFamilies Operating System: Unknown/Multiple | Architecture: Type of failure: GHC rejects | Unknown/Multiple valid program | Test Case: Blocked By: | Blocking: Related Tickets: #14645 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * status: new => closed * resolution: => duplicate * related: => #14645 Comment: I would be quite happy to have this for only data families, so I'll close this in favor of #14645. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 7 22:39:31 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 07 Jan 2018 22:39:31 -0000 Subject: [GHC] #14042: Datatypes cannot use a type family in their return kind In-Reply-To: <050.9a18856b2826cce2f7fbd06d0b9d2dd1@haskell.org> References: <050.9a18856b2826cce2f7fbd06d0b9d2dd1@haskell.org> Message-ID: <065.57afcc801967aad8f5b4579d6ade8594@haskell.org> #14042: Datatypes cannot use a type family in their return kind -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: Component: Compiler (Type | Version: 8.0.1 checker) | Keywords: TypeInType, Resolution: duplicate | TypeFamilies Operating System: Unknown/Multiple | Architecture: Type of failure: GHC rejects | Unknown/Multiple valid program | Test Case: Blocked By: | Blocking: Related Tickets: #14645 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by goldfire): Oh wow. That was easy. I was expecting a mind-bending battle here. :) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 8 00:00:47 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 08 Jan 2018 00:00:47 -0000 Subject: [GHC] #14643: Partial type signatures interact unexpectedly with :browse (was: Partial type signatures in spliced TH declarations behave unexpectedly) In-Reply-To: <047.6762d95c975e1952f57776fe89e6e2c0@haskell.org> References: <047.6762d95c975e1952f57776fe89e6e2c0@haskell.org> Message-ID: <062.73e57d0ac3a745def86349bfc9e5a821@haskell.org> #14643: Partial type signatures interact unexpectedly with :browse -------------------------------------+------------------------------------- Reporter: mnislaih | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): Note that this has nothing to do with Template Haskell. You can also trigger the issue with this (slightly more) minimal file: {{{#!hs {-# LANGUAGE PartialTypeSignatures #-} {-# LANGUAGE TemplateHaskell #-} module Bug where f :: (Monad m, _) => [m a] -> m [a] f' :: (Monad m, _) => [m a] -> m [a] f = f' f' [] = return [] f' (x:xx) = f xx g, g' :: (Monad m, _) => [m a] -> m [a] g = g' g' [] = return [] g' (x:xx) = g xx }}} {{{ $ ghci Bug.hs -Wno-partial-type-signatures GHCi, version 8.2.2: http://www.haskell.org/ghc/ :? for help Loaded GHCi configuration from /home/rgscott/.ghci [1 of 1] Compiling Bug ( Bug.hs, interpreted ) Ok, one module loaded. λ> :browse f :: (Monad m, Monad m) => [m a] -> m [a] f' :: (Monad m, Monad m) => [m a] -> m [a] g :: (Monad GHC.Types.Any, Monad m) => [GHC.Types.Any GHC.Types.Any] -> GHC.Types.Any [GHC.Types.Any] g' :: (Monad GHC.Types.Any, Monad m) => [m a] -> m [a] }}} The same behavior also happens with `:type v` (but not `:type`, since that performs deep instantiation of the types): {{{ λ> :type +v f f :: (Monad m, Monad m) => [m a] -> m [a] λ> :type +v f' f' :: (Monad m, Monad m) => [m a] -> m [a] λ> :type +v g g :: (Monad GHC.Types.Any, Monad m) => [GHC.Types.Any GHC.Types.Any] -> GHC.Types.Any [GHC.Types.Any] λ> :type +v g' g' :: (Monad GHC.Types.Any, Monad m) => [m a] -> m [a] }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 8 01:43:56 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 08 Jan 2018 01:43:56 -0000 Subject: [GHC] #14646: GHC 8.4.1 regression: rank-n types no longer parenthesized when pretty-printed Message-ID: <050.f6d9f92b935b2b76cf140ddb5bc8ac61@haskell.org> #14646: GHC 8.4.1 regression: rank-n types no longer parenthesized when pretty- printed -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: high | Milestone: 8.4.1 Component: GHC API | Version: 8.4.1-alpha1 Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: Incorrect result Unknown/Multiple | at runtime Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- Take this file: {{{#!hs {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -ddump-splices #-} module Bug where import Language.Haskell.TH $([d| f :: (forall a. a) -> Int f _ = undefined |]) }}} In GHC 8.2.2, `-ddump-splices` behaves as you'd expect: {{{ $ /opt/ghc/8.2.2/bin/ghci Bug.hs GHCi, version 8.2.2: http://www.haskell.org/ghc/ :? for help Loaded GHCi configuration from /home/rgscott/.ghci [1 of 1] Compiling Bug ( Bug.hs, interpreted ) Bug.hs:(8,3)-(9,24): Splicing declarations [d| f_a1zL :: (forall a_a1zM. a_a1zM) -> Int f_a1zL _ = undefined |] ======> f_a49Z :: (forall a_a4a0. a_a4a0) -> Int f_a49Z _ = undefined Ok, one module loaded. }}} But in GHC 8.4.1-alpha (and HEAD), the GHC pretty-printer incorrectly leaves off the parentheses around the type `(forall a. a)`: {{{ $ /opt/ghc/8.4.1/bin/ghci Bug.hs GHCi, version 8.4.0.20171222: http://www.haskell.org/ghc/ :? for help Loaded GHCi configuration from /home/rgscott/.ghci [1 of 1] Compiling Bug ( Bug.hs, interpreted ) Bug.hs:(8,3)-(9,24): Splicing declarations [d| f_a1EF :: (forall a_a1EG. a_a1EG) -> Int f_a1EF _ = undefined |] ======> f_a4ap :: forall a_a4aq. a_a4aq -> Int f_a4ap _ = undefined Ok, one module loaded. }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 8 01:55:42 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 08 Jan 2018 01:55:42 -0000 Subject: [GHC] #14647: Invalid C in the via-C backend due to EFF_ Message-ID: <053.a0b7bf59bc66f94666659e0720602e13@haskell.org> #14647: Invalid C in the via-C backend due to EFF_ -------------------------------------+------------------------------------- Reporter: | Owner: (none) ElvishJerricco | Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.3 Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: Other Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: #8965 #11395 Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- {{{ // Stg.h #define EFF_(f) void f() /* See Note [External function prototypes] */ }}} Whenever Cmm uses a foreign C symbol, the generated C will declare the symbol with `EFF_`. Later, it will cast it to the appropriate type before calling it, often casting it to `void *` beforehand. `EFF_` is used in case the symbol is needed multiple times at incompatible types. This is invalid and discouraged in standard C for a number of reasons. - Even with incomplete args lists, it is invalid to declare a function with an inaccurate return type. - Incomplete args lists is considered "an obsolescent feature" of C. - It is invalid to call a function declared with an incomplete args list at multiple incompatible types. - It is invalid to cast a function to `void *`, as function pointers can technically have different width than regular pointers. This one obviously doesn't matter very much. - Using incomplete args lists to declare a function implemented with varargs is invalid, though this isn't really solvable for `foreign import ccall` without requiring the user to annotate such imports as varargs functions. On all the platforms GHC currently supports, this happens to work out fine. The C ABI on most platforms makes all of this compatible. But I've been working on making GHC target WebAssembly with via-C, and WebAssembly does not currently support this. Although it is [https://bugs.llvm.org/show_bug.cgi?id=35385 an LLVM bug] that incomplete args lists are unsupported on WebAssembly, it's fair-game that the inaccurate return type and liberal casting is broken. The fix is to declare externs with the proper types. We shouldn't use top level extern declarations in case the same symbol needs to be declared with multiple incompatible types (though frankly, I can't think of a good reason for this to occur, aside from varargs symbols, which is already invalid). We can use local externs to avoid the type incompatibilities. {{{ void foo() { extern int bar(int, int); ... } }}} The difficulty here is that Cmm doesn't carry the information necessary to make such declarations. {{{ module Test where foreign import ccall unsafe "testCSymbol" testHaskellSymbol :: Int -> Int -> Int -> Int }}} {{{ ghc -c Test.hs -o Test.o -ddump-cmm-raw }}} {{{ ... _s17E::I64 = I64[_s17D::P64 + 7]; _c188::I64 = testCSymbol; _c189::I64 = _s17A::I64; _c18a::I64 = _s17C::I64; _c18b::I64 = _s17E::I64; (_s17I::I64) = call "ccall" arg hints: [‘signed’, ‘signed’, ‘signed’] result hints: [‘signed’] (_c188::I64)(_c189::I64, _c18a::I64, _c18b::I64); ... }}} Cmm does not make any forward declaration of `testCSymbol`. It just uses the name ad-hoc, assigning it to the `c188` variable, eventually calling that variable at the proper type. This makes it nontrival to infer `testCSymbol`'s type (probably undecidable, considering anything can theoretically happen to these variables). It seems to me that Cmm needs to outlaw implicit declarations of foreign C symbols, `EFF_` needs to be removed, and there needs to be a local extern declaration syntax in Cmm. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 8 03:14:24 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 08 Jan 2018 03:14:24 -0000 Subject: [GHC] #14646: GHC 8.4.1 regression: rank-n types no longer parenthesized when pretty-printed In-Reply-To: <050.f6d9f92b935b2b76cf140ddb5bc8ac61@haskell.org> References: <050.f6d9f92b935b2b76cf140ddb5bc8ac61@haskell.org> Message-ID: <065.66cb475eeb66e7e716e800b564fea6a7@haskell.org> #14646: GHC 8.4.1 regression: rank-n types no longer parenthesized when pretty- printed -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: high | Milestone: 8.4.1 Component: GHC API | Version: 8.4.1-alpha1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect result | Unknown/Multiple at runtime | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): This regression was caused by commit 3b23f680c2b1f80b693eb8896fb21e4bbf8edc7e (`Remove HsContext from ppr_mono_ty, and remove ppParendHsType`). -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 8 05:05:55 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 08 Jan 2018 05:05:55 -0000 Subject: [GHC] #14335: Annotations aren't supported with -fexternal-interpreter In-Reply-To: <046.25c38c823cb7fca986641ffde5e3cbd0@haskell.org> References: <046.25c38c823cb7fca986641ffde5e3cbd0@haskell.org> Message-ID: <061.270b2b4def1297770c92d0405f0054a2@haskell.org> #14335: Annotations aren't supported with -fexternal-interpreter -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.2.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: T14335 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * owner: bgamari => (none) * status: closed => new * resolution: fixed => Comment: Hmm, actually the test I add in Phab:D4202 seems to reproduce this afterall. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 8 05:06:28 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 08 Jan 2018 05:06:28 -0000 Subject: [GHC] #14640: Div and Mod type families don't have the same fixities as their term-level counterparts In-Reply-To: <050.f59dff27cbd52ba0b8f3d501166d856b@haskell.org> References: <050.f59dff27cbd52ba0b8f3d501166d856b@haskell.org> Message-ID: <065.4653b8b5dfcb2e156d2ed33c75738c59@haskell.org> #14640: Div and Mod type families don't have the same fixities as their term-level counterparts -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: 8.4.1 Component: libraries/base | Version: 8.4.1-alpha1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4291 Wiki Page: | -------------------------------------+------------------------------------- Comment (by Ben Gamari ): In [changeset:"303106d55d75a9c796e58867cb541ad136bb217f/ghc" 303106d/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="303106d55d75a9c796e58867cb541ad136bb217f" Make the Div and Mod type families `infixl 7` Commit fa8035e3ee83aff5a20fc5e7e2697bac1686d6a6 added `Div` and `Mod` type families to `GHC.TypeNats`. However, they did not add the corresponding fixities! Currently, we have that both `div` and `mod` (at the value level) are `infixl 7`, so we should adopt the same fixities for the type-level `Div` and `Mod` as well. Test Plan: It compiles Reviewers: hvr, bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie, carter GHC Trac Issues: #14640 Differential Revision: https://phabricator.haskell.org/D4291 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 8 08:45:15 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 08 Jan 2018 08:45:15 -0000 Subject: [GHC] #12848: Reduce long-term memory usage of GHCi In-Reply-To: <047.67e660d21ca1bf05a200182e30500999@haskell.org> References: <047.67e660d21ca1bf05a200182e30500999@haskell.org> Message-ID: <062.1e5e03f0034a952a6b8fb123550af8b7@haskell.org> #12848: Reduce long-term memory usage of GHCi ------------------------------------+-------------------------------------- Reporter: arybczak | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: GHCi | Version: 8.0.1 Resolution: | Keywords: Operating System: Linux | Architecture: x86_64 (amd64) Type of failure: Other | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | ------------------------------------+-------------------------------------- Comment (by saurabhnanda): I have proposed this as an idea for GSoC / HSoC at https://github.com /haskell-org/summer-of-haskell/pull/15/files If anyone is interesting in mentoring students working on fixing this space leak, please participate in the discussion at https://github.com /haskell-org/summer-of-haskell/issues/29 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 8 08:45:30 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 08 Jan 2018 08:45:30 -0000 Subject: [GHC] #14336: ghci leaks memory In-Reply-To: <051.dbf33557716163bb981beab6790198d1@haskell.org> References: <051.dbf33557716163bb981beab6790198d1@haskell.org> Message-ID: <066.1b4d8ed9820880a8c12311c4a4b6532b@haskell.org> #14336: ghci leaks memory -------------------------------------+------------------------------------- Reporter: NeilMitchell | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: GHCi | Version: 8.2.1 Resolution: | Keywords: Operating System: Windows | Architecture: x86_64 Type of failure: Runtime | (amd64) performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by saurabhnanda): I have proposed this as an idea for GSoC / HSoC at https://github.com /haskell-org/summer-of-haskell/pull/15/files If anyone is interesting in mentoring students working on fixing this space leak, please participate in the discussion at https://github.com /haskell-org/summer-of-haskell/issues/29 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 8 08:55:30 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 08 Jan 2018 08:55:30 -0000 Subject: [GHC] #14643: Partial type signatures in class constraints behave unexpectedly (was: Partial type signatures interact unexpectedly with :browse) In-Reply-To: <047.6762d95c975e1952f57776fe89e6e2c0@haskell.org> References: <047.6762d95c975e1952f57776fe89e6e2c0@haskell.org> Message-ID: <062.ac27cdaa7652c8e16e44e7eea19373a8@haskell.org> #14643: Partial type signatures in class constraints behave unexpectedly -------------------------------------+------------------------------------- Reporter: mnislaih | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by mnislaih): Hi Ryan, thanks for the even smaller example! For some reason I didn't think of removing the TH splice. But just to clarify, this issue is not restricted to `:browse`. The resulting type signatures with `Any` in them cannot be instantiated, or at least I haven't figured out how. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 8 12:15:46 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 08 Jan 2018 12:15:46 -0000 Subject: [GHC] #14630: name shadowing warnings by record pattern synonyms + RecordWildCards or NamedFieldPuns In-Reply-To: <053.0838c2dcc7b95d4aed5fb595896d561b@haskell.org> References: <053.0838c2dcc7b95d4aed5fb595896d561b@haskell.org> Message-ID: <068.e927ea7e241939db0684a7e23853bea5@haskell.org> #14630: name shadowing warnings by record pattern synonyms + RecordWildCards or NamedFieldPuns -------------------------------------+------------------------------------- Reporter: mizunashi_mana | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: | PatternSynonyms Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect | Unknown/Multiple error/warning at compile-time | Test Case: Blocked By: | Blocking: Related Tickets: #11228 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * cc: adamgundry (added) Comment: Adam Gundry may want to comment. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 8 12:18:01 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 08 Jan 2018 12:18:01 -0000 Subject: [GHC] #14641: GHC panics in incomplete program In-Reply-To: <042.4514b6a37a813e90854f77d12f99e562@haskell.org> References: <042.4514b6a37a813e90854f77d12f99e562@haskell.org> Message-ID: <057.fe934c392a412e79037c5207e817df16@haskell.org> #14641: GHC panics in incomplete program -------------------------------------+------------------------------------- Reporter: mmc | Owner: (none) Type: bug | Status: new Priority: low | Milestone: Component: Compiler | Version: 8.0.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Thanks for the bug report. This one of GHC's most oft-reported bugs (search Trac for "initTc". It is a duplicate of #13106, and has been fixed in GHC 8.2. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 8 12:22:49 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 08 Jan 2018 12:22:49 -0000 Subject: [GHC] #14644: Improve cmm/assembly for pattern matches with two constants. In-Reply-To: <047.054a8f1d3e52c239a87742662b91a120@haskell.org> References: <047.054a8f1d3e52c239a87742662b91a120@haskell.org> Message-ID: <062.e0fd04493e2de01b15191c1ae2c65ae2@haskell.org> #14644: Improve cmm/assembly for pattern matches with two constants. -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 (CodeGen) | Keywords: Codegen, CMM, Resolution: | Patterns, Pattern Matching Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Looks plausible to me. I wonder how we'd measure any potential benefit? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 8 12:32:44 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 08 Jan 2018 12:32:44 -0000 Subject: [GHC] #14645: Allow type family in data family return kind In-Reply-To: <047.3515b5078f2cb34cf2db81ba3af73423@haskell.org> References: <047.3515b5078f2cb34cf2db81ba3af73423@haskell.org> Message-ID: <062.f665f9f5126fe88e95ece97dc0146298@haskell.org> #14645: Allow type family in data family return kind -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.4.1-alpha1 Resolution: | Keywords: TypeInType, | TypeFamilies Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): But there is useful discussion in #14042. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 8 12:49:24 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 08 Jan 2018 12:49:24 -0000 Subject: [GHC] #14644: Improve cmm/assembly for pattern matches with two constants. In-Reply-To: <047.054a8f1d3e52c239a87742662b91a120@haskell.org> References: <047.054a8f1d3e52c239a87742662b91a120@haskell.org> Message-ID: <062.894b82a664779e4929003f4dbd953333@haskell.org> #14644: Improve cmm/assembly for pattern matches with two constants. -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 (CodeGen) | Keywords: Codegen, CMM, Resolution: | Patterns, Pattern Matching Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by AndreasK): It should also be possible to see the difference using criterion or instruction counters when running affected code in a tight loop. I will take a stab at changing the logic to `if ... else if ... else` for these cases. I think that's a good starting point to learn how Cmm works inside GHC. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 8 13:13:52 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 08 Jan 2018 13:13:52 -0000 Subject: [GHC] #14641: GHC panics in incomplete program In-Reply-To: <042.4514b6a37a813e90854f77d12f99e562@haskell.org> References: <042.4514b6a37a813e90854f77d12f99e562@haskell.org> Message-ID: <057.cc6a50280e3b72f4e8c64daf043f130b@haskell.org> #14641: GHC panics in incomplete program -------------------------------------+------------------------------------- Reporter: mmc | Owner: (none) Type: bug | Status: closed Priority: low | Milestone: Component: Compiler | Version: 8.0.2 Resolution: duplicate | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: #13106 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * status: new => closed * resolution: => duplicate * related: => #13106 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 8 13:34:15 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 08 Jan 2018 13:34:15 -0000 Subject: [GHC] #14645: Allow type family in data family return kind In-Reply-To: <047.3515b5078f2cb34cf2db81ba3af73423@haskell.org> References: <047.3515b5078f2cb34cf2db81ba3af73423@haskell.org> Message-ID: <062.1034b59727c2dc12935a50f4089afb5e@haskell.org> #14645: Allow type family in data family return kind -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.4.1-alpha1 Resolution: | Keywords: TypeInType, | TypeFamilies Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Let's translate to FC. Here's the example {{{ type family TF (x :: Type) :: Type data family DF (x :: Type) :: TF x type instance TF Bool = Type -> Type data instance DF Bool (a :: Type) = T1 a | T2 }}} The translation to FC might look like this {{{ axiom ax1 :: TF Bool ~ (Type -> Type) data DFBool a = T1 a | T2 -- An ordinary algebraic data type -- T1 :: a -> DFBool a axiom ax2 :: DFBool ~ DF Bool |> ax1 $WT1 :: forall a. a -> DF Bool a $WT1 = /\a. \(x::a). T1 x |> ax2 a -- ax2 a :: DFBool a ~ ((DF Bool) |> ax1) a }}} The kind coercion `|> ax1` in the kind of `axiom ax2` is essential to make axiom `ax2` homogeneously kinded; both sides have kind `Type -> Type`. Does that look right? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 8 14:00:27 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 08 Jan 2018 14:00:27 -0000 Subject: [GHC] #14645: Allow type family in data family return kind In-Reply-To: <047.3515b5078f2cb34cf2db81ba3af73423@haskell.org> References: <047.3515b5078f2cb34cf2db81ba3af73423@haskell.org> Message-ID: <062.8f1af026268f5c2e14241c0ca1eecb5a@haskell.org> #14645: Allow type family in data family return kind -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.4.1-alpha1 Resolution: | Keywords: TypeInType, | TypeFamilies Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by goldfire): > Does that look right? Almost. You need a cast in the type of `$WT1`: {{{#!hs $WT1 :: forall a. a -> (DF Bool |> ax1) a }}} Otherwise, yes, I agree. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 8 14:20:40 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 08 Jan 2018 14:20:40 -0000 Subject: [GHC] #14644: Improve cmm/assembly for pattern matches with two constants. In-Reply-To: <047.054a8f1d3e52c239a87742662b91a120@haskell.org> References: <047.054a8f1d3e52c239a87742662b91a120@haskell.org> Message-ID: <062.9c3607df8e1ba1ff1713d1d3e5528131@haskell.org> #14644: Improve cmm/assembly for pattern matches with two constants. -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 (CodeGen) | Keywords: Codegen, CMM, Resolution: | Patterns, Pattern Matching Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by svenpanne): I am not sure if things are that easy: To do these kind of switches in a really good way, one would need a probability distribution how often the individual cases actually happen. If we e.g. assume that all Ints happen equally often in the example above, it would be best to check for <1 and >7 first, so we would get roughly 1.5 comparisons on average. Depending on the number of registers available, you can even get away with 1 subtraction and 1 unsigned comparison for this range check, a classic C hack (ab)using wrap-around for unsigned ints. If we have some hints, e.g. raising a pattern matching exception, we could do better, e.g. assume 0% probability for this case. If we have more detailed (estimated) probabilities, we could do a Huffman-like decision tree. This is where profile-guided optimization shines. Additional things to consider: Performance in tight loops is often vastly different, because branch prediction/caching will most likely kick in visibly. Correctly predicted branches will cost you almost nothing, while unknown/incorrectly predicted branches will be much more costly. In the absence of more information from their branch predictor, quite a few processors assume that backward branches are taken and forward branches are assumed to be not taken. So code layout has a non-trivial performance impact. Instruction counts are quite misleading nowadays... -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 8 14:50:17 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 08 Jan 2018 14:50:17 -0000 Subject: [GHC] #14644: Improve cmm/assembly for pattern matches with two constants. In-Reply-To: <047.054a8f1d3e52c239a87742662b91a120@haskell.org> References: <047.054a8f1d3e52c239a87742662b91a120@haskell.org> Message-ID: <062.76524a9cbede52eb33e37cd0dce93a4d@haskell.org> #14644: Improve cmm/assembly for pattern matches with two constants. -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 (CodeGen) | Keywords: Codegen, CMM, Resolution: | Patterns, Pattern Matching Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by AndreasK): Replying to [comment:3 svenpanne]: > I am not sure if things are that easy: To do these kind of switches in a really good way, one would need a probability distribution how often the individual cases actually happen. This is by no means meant as a "this is optimal" idea. As far as I'm aware there is currently no way to propagate probabilities through GHC's various stages. So even in cases where we can make a judgement on the probability we can't really use it at the Cmm level. In the end I suggested it because it: * I think it has a good chance of being faster * Leads to smaller code * Seems to be what gcc/clang do (using conditional moves instead of jumps but still). > Additional things to consider: Performance in tight loops is often vastly different, because branch prediction/caching will most likely kick in visibly. Correctly predicted branches will cost you almost nothing, while unknown/incorrectly predicted branches will be much more costly. In the absence of more information from their branch predictor, quite a few processors assume that backward branches are taken and forward branches are assumed to be not taken. So code layout has a non-trivial performance impact. > > Instruction counts are quite misleading nowadays... Indeed :( -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 8 15:07:15 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 08 Jan 2018 15:07:15 -0000 Subject: [GHC] #14646: GHC 8.4.1 regression: rank-n types no longer parenthesized when pretty-printed In-Reply-To: <050.f6d9f92b935b2b76cf140ddb5bc8ac61@haskell.org> References: <050.f6d9f92b935b2b76cf140ddb5bc8ac61@haskell.org> Message-ID: <065.0c588f9bf46cff06069c44319676ea77@haskell.org> #14646: GHC 8.4.1 regression: rank-n types no longer parenthesized when pretty- printed -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: high | Milestone: 8.4.1 Component: GHC API | Version: 8.4.1-alpha1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect result | Unknown/Multiple at runtime | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by goldfire): I think this will be hard to fix. The problem is that `ppParendHsType` was bad, as `HsSyn` already tracks parentheses. It was silly to have another function guess at where to put more of them. And it often guessed wrong, leading to all sorts of pretty-printer infelicities. On the other hand, Template Haskell does ''not'' track parentheses. And so when GHC converts TH to `HsSyn`, the parentheses aren't inserted and so are not pretty-printed. I see two ways forward: 1. Track parentheses in TH, breaking lots and lots of client code. (Note that this is different than TH's usual churn of adding new constructs, because much code out there that consumes the TH AST will start silently failing in the presence of an unexpected ''old'' construct.) 2. Insert parens when converting TH AST to `HsSyn`. By using precedence rules, etc., it should be possible to do a passable job, but we'll never replicate exactly what the user wrote. I think I favor (2). -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 8 15:12:19 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 08 Jan 2018 15:12:19 -0000 Subject: [GHC] #14646: GHC 8.4.1 regression: rank-n types no longer parenthesized when pretty-printed In-Reply-To: <050.f6d9f92b935b2b76cf140ddb5bc8ac61@haskell.org> References: <050.f6d9f92b935b2b76cf140ddb5bc8ac61@haskell.org> Message-ID: <065.ae6fd8369a50e076dedc87af5620c30d@haskell.org> #14646: GHC 8.4.1 regression: rank-n types no longer parenthesized when pretty- printed -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: high | Milestone: 8.4.1 Component: GHC API | Version: 8.4.1-alpha1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect result | Unknown/Multiple at runtime | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Yes to (2) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 8 15:33:05 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 08 Jan 2018 15:33:05 -0000 Subject: [GHC] #14646: GHC 8.4.1 regression: rank-n types no longer parenthesized when pretty-printed In-Reply-To: <050.f6d9f92b935b2b76cf140ddb5bc8ac61@haskell.org> References: <050.f6d9f92b935b2b76cf140ddb5bc8ac61@haskell.org> Message-ID: <065.d950fd9d9f897989d3a407f8f66e3245@haskell.org> #14646: GHC 8.4.1 regression: rank-n types no longer parenthesized when pretty- printed -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: high | Milestone: 8.4.1 Component: GHC API | Version: 8.4.1-alpha1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect result | Unknown/Multiple at runtime | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by alanz): (2) is the option I implemented for all the rest of these cases, in `hsSyn/Convert.hs` -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 8 16:41:28 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 08 Jan 2018 16:41:28 -0000 Subject: [GHC] #14645: Allow type family in data family return kind In-Reply-To: <047.3515b5078f2cb34cf2db81ba3af73423@haskell.org> References: <047.3515b5078f2cb34cf2db81ba3af73423@haskell.org> Message-ID: <062.30aac574f8fb459018c57cd4bf3d1703@haskell.org> #14645: Allow type family in data family return kind -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.4.1-alpha1 Resolution: | Keywords: TypeInType, | TypeFamilies Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Fine. Then let's do it! (Or does it need a GHC proposal?) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 8 16:48:32 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 08 Jan 2018 16:48:32 -0000 Subject: [GHC] #14645: Allow type family in data family return kind In-Reply-To: <047.3515b5078f2cb34cf2db81ba3af73423@haskell.org> References: <047.3515b5078f2cb34cf2db81ba3af73423@haskell.org> Message-ID: <062.78e805044ad992605a1d231e2f43848d@haskell.org> #14645: Allow type family in data family return kind -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.4.1-alpha1 Resolution: | Keywords: TypeInType, | TypeFamilies Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by goldfire): I think this passes under the bar of a proposal. :) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 8 17:02:36 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 08 Jan 2018 17:02:36 -0000 Subject: [GHC] #14338: Simplifier fails with "Simplifier ticks exhausted" In-Reply-To: <049.819ef8e60a65cb9f3e29afb8f69166a7@haskell.org> References: <049.819ef8e60a65cb9f3e29afb8f69166a7@haskell.org> Message-ID: <064.cbba26fca73d5bc7679e0be4792cf5b2@haskell.org> #14338: Simplifier fails with "Simplifier ticks exhausted" -------------------------------------+------------------------------------- Reporter: dredozubov | Owner: bgamari Type: bug | Status: merge Priority: high | Milestone: 8.4.1 Component: Compiler | Version: 8.2.1 Resolution: fixed | Keywords: Operating System: Linux | Architecture: x86_64 Type of failure: Compile-time | (amd64) crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: closed => merge -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 8 17:33:57 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 08 Jan 2018 17:33:57 -0000 Subject: [GHC] #14632: Export typeNatDivTyCon from TcTypeNats In-Reply-To: <046.9a08807e882b9954423a7a486869ec2a@haskell.org> References: <046.9a08807e882b9954423a7a486869ec2a@haskell.org> Message-ID: <061.cf9ff8b9464fd771c04538417f18a494@haskell.org> #14632: Export typeNatDivTyCon from TcTypeNats -------------------------------------+------------------------------------- Reporter: darchon | Owner: darchon Type: feature request | Status: new Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.4.1-alpha1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4284 Wiki Page: | -------------------------------------+------------------------------------- Comment (by Ryan Scott ): In [changeset:"fb78b0d22635b1d7ae68385c648b8c407f5562c2/ghc" fb78b0d2/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="fb78b0d22635b1d7ae68385c648b8c407f5562c2" Export typeNat{Div;Mod;Log}TyCon from TcTypeNats Summary: To be in line with the other typeNatTyCons Reviewers: bgamari, RyanGlScott Reviewed By: RyanGlScott Subscribers: RyanGlScott, rwbarton, thomie, carter GHC Trac Issues: #14632 Differential Revision: https://phabricator.haskell.org/D4284 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 8 17:34:37 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 08 Jan 2018 17:34:37 -0000 Subject: [GHC] #14632: Export typeNatDivTyCon from TcTypeNats In-Reply-To: <046.9a08807e882b9954423a7a486869ec2a@haskell.org> References: <046.9a08807e882b9954423a7a486869ec2a@haskell.org> Message-ID: <061.27058f7a3b02de7b90176024dab5e329@haskell.org> #14632: Export typeNatDivTyCon from TcTypeNats -------------------------------------+------------------------------------- Reporter: darchon | Owner: darchon Type: feature request | Status: merge Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.4.1-alpha1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4284 Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * status: new => merge -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 8 17:35:39 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 08 Jan 2018 17:35:39 -0000 Subject: [GHC] #14640: Div and Mod type families don't have the same fixities as their term-level counterparts In-Reply-To: <050.f59dff27cbd52ba0b8f3d501166d856b@haskell.org> References: <050.f59dff27cbd52ba0b8f3d501166d856b@haskell.org> Message-ID: <065.7c96629f4b41479ffcf4474808bcbe68@haskell.org> #14640: Div and Mod type families don't have the same fixities as their term-level counterparts -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: merge Priority: normal | Milestone: 8.4.1 Component: libraries/base | Version: 8.4.1-alpha1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4291 Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * status: patch => merge -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 8 17:48:46 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 08 Jan 2018 17:48:46 -0000 Subject: [GHC] #14648: ghc-pkg does handle unitids Message-ID: <048.007dd06250e569e25f20a7f4c15429a2@haskell.org> #14648: ghc-pkg does handle unitids -------------------------------------+------------------------------------- Reporter: lspitzner | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: ghc-pkg | 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 base the summary and the description on a single observation, see below. Sorry should this turn out to be a deduction too aggressive. == Assumed problem description New-style package-dbs can contain the same (package, version) entry multiple times, as entries are identified using an additional hash. I'll call the full identifier "unitId". The ghc-pkg interface seems to not support specifying full unitIds, i.e. "my-package-0.1.0.0-somehash" seems to be interpreted like "my-package-0.1.0.0-*". This is both a missing functionality and a bug: 1. many operations make sense per-unitId, not just per (package, version) 2. The fact that my-package-0.1.0.0-otherhash is unregistered by "ghc-pkg unregister my-package-0.1.0.0-somehash" is quite surprising. == Observation 1. Take a package-db containing the same (package, version) entry with two different hashes, e.g. - semigroupoids-5.2.1-2f552e489ce3109c2672606e2dc6e33c4f38174da930d5db0bb0dafbb4dccae8 - semigroupoids-5.2.1-e50d44ead36c6b8428c9417007cee15bd9cbe3a2906c19553366d94b15c2471e I suggest making a copy of some existing (cabal store) db. 2. call `ghc-pkg --package-db my-copy unregister semigroupoids-5.2.1-2f552e489ce3109c2672606e2dc6e33c4f38174da930d5db0bb0dafbb4dccae8` 3. test `ghc-pkg --package-db my-copy list semigroupoids-5.2.1` Expected result: `semigroupoids-5.2.1-e50d44ea..` is still registered Observed result: empty list == Impact This blocks the use-case of a garbage-collection for the global new-style package db "store". -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 8 18:41:59 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 08 Jan 2018 18:41:59 -0000 Subject: [GHC] #14648: ghc-pkg does handle unitids In-Reply-To: <048.007dd06250e569e25f20a7f4c15429a2@haskell.org> References: <048.007dd06250e569e25f20a7f4c15429a2@haskell.org> Message-ID: <063.bbfd6dc063e14ae7b702b96aa2eda41e@haskell.org> #14648: ghc-pkg does handle unitids -------------------------------------+------------------------------------- Reporter: lspitzner | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: ghc-pkg | Version: 8.2.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by alexbiehl): I think you can pass ˋ—unit-Idˋ to Interpret package identifiers as UnitIds (see https://github.com/ghc/ghc/blob/master/utils/ghc- pkg/Main.hs#L204) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 8 18:59:01 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 08 Jan 2018 18:59:01 -0000 Subject: [GHC] #14648: ghc-pkg does handle unitids In-Reply-To: <048.007dd06250e569e25f20a7f4c15429a2@haskell.org> References: <048.007dd06250e569e25f20a7f4c15429a2@haskell.org> Message-ID: <063.67518b8647fec482d222285dcb10bde0@haskell.org> #14648: ghc-pkg does handle unitids -------------------------------------+------------------------------------- Reporter: lspitzner | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: ghc-pkg | Version: 8.2.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by lspitzner): Oh, indeed. I'll test that. This would eliminate the "missing feature" part but not the "surprising behaviour" part. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 8 19:34:37 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 08 Jan 2018 19:34:37 -0000 Subject: [GHC] #8684: hWaitForInput cannot be interrupted by async exceptions on unix In-Reply-To: <042.bed34cc32ec4222496f7d8b921c80c8a@haskell.org> References: <042.bed34cc32ec4222496f7d8b921c80c8a@haskell.org> Message-ID: <057.11839e9232d5431f64551c4e84892200@haskell.org> #8684: hWaitForInput cannot be interrupted by async exceptions on unix -------------------------------------+------------------------------------- Reporter: nh2 | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Core Libraries | Version: 7.6.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: 13497, 13525 | Blocking: Related Tickets: #12912, #13525 | Differential Rev(s): Phab:D42 Wiki Page: | -------------------------------------+------------------------------------- Comment (by nh2): OK, due to the reasons at https://phabricator.haskell.org/D42#119714 I found that this bug is also present in non`-threaded` on Darwin and iOS: `ghc-bug-8684-test.hs` {{{ import Control.Concurrent import System.IO import System.Timeout main :: IO () main = do forkIO $ do threadDelay (5 * 1000000) -- The timeout should terminate before we ever make it here putStrLn "t=5 seconds: we shouldn't be here" timeout (1 * 1000000) $ do hWaitForInput stdin (10 * 1000) putStrLn "we shouldn't be here" return () }}} I just confirmed that this prints `t=5 seconds: we shouldn't be here` on OSX. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 8 22:27:41 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 08 Jan 2018 22:27:41 -0000 Subject: [GHC] #14201: Implement ideas from "Compiling Pattern Matching to Good Decision Trees" In-Reply-To: <047.8c12540f1c55383efff9bbd37be2e217@haskell.org> References: <047.8c12540f1c55383efff9bbd37be2e217@haskell.org> Message-ID: <062.58cff593bb5e61a74fcded9a1e7d135d@haskell.org> #14201: Implement ideas from "Compiling Pattern Matching to Good Decision Trees" -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: AndreasK Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by AndreasK): Thanks dfeuer. The imprecise exceptions paper **** == The bad == * Compilation is slowed down too much currently. This should be fixable as I haven't optimized my code AT ALL yet. * For larger benchmarks advantages often disappear at -O2 (with microbencharms being faster). I'm not completly sure why. Possibly reasons I thought of: 1. Performance reliant code is written with the current solution in mind 2. The larger code size causes more cache misses 3. There are some nasty edge cases 1) This doesn't make this approach worse, but might be a reason why it makes little differences in performance sensitive libraries which I used for benchmarks. 2/3) The larger code size is a given with this approach. I don't think it's a big issue outside of edge cases. However edge cases can blow up significantly. A good example the following which splits up the decision tree in a bad way. {{{ f1 _ A E = 1 f1 B _ _ = 2 f1 C _ C = 3 f1 A E A = 8 f1 _ _ _ = 5 }}} * We can't start at the third as we might not evaluate it, eg `f1 B B B` * We can't start at the first for the same reason, eg `f1 A A E` A perfect solution would switch between backtracking and tree based based on the pattern encountered. But maintaining both sounds like a nightmare and wouldn't be worth the trouble. There are also a few small things that I can still adjust which might enable a bit more CSE. But I'm not too optimistic that it will change much. == The good == * Regular code at -O0/1 gets faster on average when the algorithm applies. * Strict code runs faster with tree matching even at -O2 * The compiliation speed should be fixable * There are some small improvements still doable * Improve the heuristic which selects the column to match first * Change placement of the cleanup code which evaluates arguments not necessary for matching. (This is necessary to satisfy the exception/nontermination semantics) * I have enabled tree matching only for Vanilla Constructors as I had an issue with GADT's which didn't want to tackle at the time. == Where to go from here == I plan to at least: * Try to enable tree matching on GADTs and see if any of the benchmarks I looked at change. * Play around with the clean up placement But I have to get my bachelor out of the way first in the next 1-2 Months. Then I will see how the above change the story at -O2. For O1/Strict code the speedup of a few % at time would already be worth it if I can reign the compile times in. But currently at O2 the speed is usually equal sometimes worse and slightly less often faster using tree matching. Assuming it stays that way changing it only makes sense if GHC ever gets profile guided optimization. As we then could chose the best column to match on based on actual data. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 8 23:16:22 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 08 Jan 2018 23:16:22 -0000 Subject: [GHC] #14649: ghc panic: mergeSATInfo Message-ID: <049.cce3ce7e653fe690c2ca996c501da8d5@haskell.org> #14649: ghc panic: mergeSATInfo -------------------------------------+------------------------------------- Reporter: tianxiaogu | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: Compile-time Unknown/Multiple | crash or panic Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- ghc panic with option `-O` and `-fstatic-argument-transformation`. Affected versions include 8.2.2 and HEAD (8.5.20180108) {{{#!hs {-# LANGUAGE DataKinds #-} {-# LANGUAGE PartialTypeSignatures #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} module T12844 where barWraper :: ('(r,r') ~ Head rngs, Foo rngs) => FooData rngs barWraper = bar bar :: (_) => FooData rngs bar = barWraper data FooData rngs class Foo xs where foo :: (Head xs ~ '(r,r')) => FooData xs type family Head (xs :: [k]) where Head (x ': xs) = x }}} Log: {{{ ghc: panic! (the 'impossible' happened) (GHC version 8.5.20180108 for x86_64-unknown-linux): mergeSATInfo Left:STSTSTSTSTSVSV, Right:STSTSTSTSTSVSC Call stack: CallStack (from HasCallStack): callStackDoc, called at compiler/utils/Outputable.hs:1150:37 in ghc:Outputable pprPanic, called at compiler/simplCore/SAT.hs:152:20 in ghc:SAT Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 9 01:10:56 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 09 Jan 2018 01:10:56 -0000 Subject: [GHC] #14650: Panic with no extensions (StgCmmEnv: variable not found) Message-ID: <045.b734e19b172639c0ef220c04df7c2bd5@haskell.org> #14650: Panic with no extensions (StgCmmEnv: variable not found) -------------------------------------+------------------------------------- Reporter: Zemyla | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Keywords: | Operating System: Unknown/Multiple Architecture: x86_64 | Type of failure: Compile-time (amd64) | crash or panic Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- When I compile the attached Haskell program with `-O2`, or `-O1` with `-fspec-constr` added, I get a compiler panic: {{{ ghc: panic! (the 'impossible' happened) (GHC version 8.2.2 for x86_64-unknown-mingw32): StgCmmEnv: variable not found $smergeSplit_s3bq local binds for: $WLL $W:% $W:& cmp_s3ox eta_s3oy $wmergeLL_s3oz $s$wpush_s3pZ $wpush_s3q0 $s$wmergeAll_s3rl $wmergeAll_s3rR $wsplitDesc_s3sp $wsplitAsc_s3sC mergeSplit_s3tt ss_s3tu ds_s3tv wild_s3tw a1_s3tC as'_s3tD wild1_s3tE b_s3tF bs_s3tG wild2_s3tH ww1_s3tJ ww2_s3tK ww3_s3tL ww4_s3tM ww6_s3tO ww7_s3tP ww8_s3tQ ww9_s3tR Call stack: CallStack (from HasCallStack): prettyCurrentCallStack, called at compiler\utils\Outputable.hs:1133:58 in ghc:Outputable callStackDoc, called at compiler\utils\Outputable.hs:1137:37 in ghc:Outputable pprPanic, called at compiler\codeGen\StgCmmEnv.hs:147:9 in ghc:StgCmmEnv }}} I ran it with `-dcore-lint`, and it gives the following messages (full .lint attached): {{{ *** Core Lint errors : in result of Simplifier *** : warning: In the expression: jump $smergeSplit_s3bN ww_s34F ww_s34Q ww_s34R ww_s34S ww_s34T $smergeSplit_s3bN [Occ=LoopBreaker] :: [a_a23n] -> Int# -> Bool -> [a_a23n] -> Stack a_a23n -> [a_a23n] [LclId[JoinId(5)], Arity=5, Str=, Unf=Unf{Src=, TopLvl=False, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [80 0 0 0 0] 554 0}] is out of scope : warning: In the expression: jump $smergeSplit_s3bN ww_s34F ww_s34Q ww_s34R ww_s34S ww_s34T Invalid occurrence of a join variable: $smergeSplit_s3bN The binder is either not a join point, or not valid here : warning: In the expression: jump $smergeSplit_s3bN ww_s34K ww_s34Q ww_s34R ww_s34S ww_s34T $smergeSplit_s3bN [Occ=LoopBreaker] :: [a_a23n] -> Int# -> Bool -> [a_a23n] -> Stack a_a23n -> [a_a23n] [LclId[JoinId(5)], Arity=5, Str=, Unf=Unf{Src=, TopLvl=False, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [80 0 0 0 0] 554 0}] is out of scope : warning: In the expression: jump $smergeSplit_s3bN ww_s34K ww_s34Q ww_s34R ww_s34S ww_s34T Invalid occurrence of a join variable: $smergeSplit_s3bN The binder is either not a join point, or not valid here }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 9 01:13:14 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 09 Jan 2018 01:13:14 -0000 Subject: [GHC] #14650: Panic with no extensions (StgCmmEnv: variable not found) In-Reply-To: <045.b734e19b172639c0ef220c04df7c2bd5@haskell.org> References: <045.b734e19b172639c0ef220c04df7c2bd5@haskell.org> Message-ID: <060.e7b23f7f0faa910c37d148e782bb885f@haskell.org> #14650: Panic with no extensions (StgCmmEnv: variable not found) -------------------------------------+------------------------------------- Reporter: Zemyla | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: x86_64 Type of failure: Compile-time | (amd64) crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by Zemyla): * Attachment "MergeSort.zip" added. .Offending program and full core lint for that file -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 9 01:21:33 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 09 Jan 2018 01:21:33 -0000 Subject: [GHC] #14650: Panic with no extensions (StgCmmEnv: variable not found) In-Reply-To: <045.b734e19b172639c0ef220c04df7c2bd5@haskell.org> References: <045.b734e19b172639c0ef220c04df7c2bd5@haskell.org> Message-ID: <060.118e5f36dbad29ed48c4744c94ed4ea3@haskell.org> #14650: Panic with no extensions (StgCmmEnv: variable not found) -------------------------------------+------------------------------------- Reporter: Zemyla | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: x86_64 Type of failure: Compile-time | (amd64) crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Zemyla): Oh, I forgot to mention that, when I remove `{-# INLINABLE mergeSplit #-}`, the crash disappears. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 9 03:58:04 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 09 Jan 2018 03:58:04 -0000 Subject: [GHC] #14648: ghc-pkg does handle unitids In-Reply-To: <048.007dd06250e569e25f20a7f4c15429a2@haskell.org> References: <048.007dd06250e569e25f20a7f4c15429a2@haskell.org> Message-ID: <063.85682094b553cf5bfadf4be09de2308b@haskell.org> #14648: ghc-pkg does handle unitids -------------------------------------+------------------------------------- Reporter: lspitzner | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: ghc-pkg | Version: 8.2.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by ezyang): Yes, the defaulting to pkgname-version is tiresome but it's this way for backwards compatibility (since that is how ghc-pkg worked in the old days); and the surprising behavior stems from another BC thing where version numbers parse with tags and then Cabal ignores the tag, so `semigroupoids-5.2.1-f552e489ce3109c2672606e2dc6e33c4f38174da930d5db0bb0dafbb4dccae8` parses into `semigroupoids-5.2.1` and off we go. If someone updates ghc-pkg not to use Cabal's "tag ignoring" parser and handles the parsing itself, we could make it error when it sees a tag, or better yet automatically interpret it as an IPID. It's more work in the implementation but it would smooth this edge. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 9 04:00:47 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 09 Jan 2018 04:00:47 -0000 Subject: [GHC] #14651: recompilation checker overeager on executables produced with -o Message-ID: <047.73187139d8e777746cd6a8e9f411ae51@haskell.org> #14651: recompilation checker overeager on executables produced with -o -------------------------------------+------------------------------------- Reporter: gershomb | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.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: -------------------------------------+------------------------------------- {{{ -- Foo.hs module Main where main :: IO () main = putStrLn "foo" }}} {{{ -- Bar.hs module Main where main :: IO () main = putStrLn "bar" }}} {{{ ghc --make Foo.hs -o hello ghc --make Bar.hs -o hello }}} The first runthough this is fine. Any subsequent invocation of either of the above commands won't create a new executable again, even if the existing one is for "foo" and the command is invoked with "bar" or vice- versa. My guess is it sees that the *.hi and *.o files are up to date and sees the mtime of the executable is chronologically subsequent, so doesn't account for the fact that the file being compiled to an executable could itself have been changed. I don't know how fixable this is without always recompiling the executable, which is of course to be avoided. #13829 seems like it might be the flip-side of the same coin, so maybe fixing one also lets us fix the other... -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 9 05:26:43 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 09 Jan 2018 05:26:43 -0000 Subject: [GHC] #14651: recompilation checker overeager on executables produced with -o In-Reply-To: <047.73187139d8e777746cd6a8e9f411ae51@haskell.org> References: <047.73187139d8e777746cd6a8e9f411ae51@haskell.org> Message-ID: <062.74f2f32b4401315ba73b008eecf39ab0@haskell.org> #14651: recompilation checker overeager on executables produced with -o -------------------------------------+------------------------------------- Reporter: gershomb | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by angerman): * cc: angerman (added) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 9 07:44:27 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 09 Jan 2018 07:44:27 -0000 Subject: [GHC] #14647: Invalid C in the via-C backend due to EFF_ In-Reply-To: <053.a0b7bf59bc66f94666659e0720602e13@haskell.org> References: <053.a0b7bf59bc66f94666659e0720602e13@haskell.org> Message-ID: <068.f87cbbb563f62d4730b30d57113233c5@haskell.org> #14647: Invalid C in the via-C backend due to EFF_ -------------------------------------+------------------------------------- Reporter: ElvishJerricco | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Other | Test Case: Blocked By: | Blocking: Related Tickets: #8965 #11395 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by ElvishJerricco): * Attachment "ghc.patch" added. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 9 07:47:54 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 09 Jan 2018 07:47:54 -0000 Subject: [GHC] #14647: Invalid C in the via-C backend due to EFF_ In-Reply-To: <053.a0b7bf59bc66f94666659e0720602e13@haskell.org> References: <053.a0b7bf59bc66f94666659e0720602e13@haskell.org> Message-ID: <068.fa45a720babbfc48bcfea0bf5b3aceef@haskell.org> #14647: Invalid C in the via-C backend due to EFF_ -------------------------------------+------------------------------------- Reporter: ElvishJerricco | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Other | Test Case: Blocked By: | Blocking: Related Tickets: #8965 #11395 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by ElvishJerricco): This patch is not pretty yet, and is fairly incomplete. It just fixes Stg->Cmm->C. It doesn't work with any of the handwritten Cmm that makes foreign C calls yet. Also, none of the other code generators work yet, but I just want to get the via-C working first. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 9 09:32:38 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 09 Jan 2018 09:32:38 -0000 Subject: [GHC] #14630: name shadowing warnings by record pattern synonyms + RecordWildCards or NamedFieldPuns In-Reply-To: <053.0838c2dcc7b95d4aed5fb595896d561b@haskell.org> References: <053.0838c2dcc7b95d4aed5fb595896d561b@haskell.org> Message-ID: <068.55138ae915449845ca935800c03aa9cd@haskell.org> #14630: name shadowing warnings by record pattern synonyms + RecordWildCards or NamedFieldPuns -------------------------------------+------------------------------------- Reporter: mizunashi_mana | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: | PatternSynonyms Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect | Unknown/Multiple error/warning at compile-time | Test Case: Blocked By: | Blocking: Related Tickets: #11228 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by adamgundry): * cc: mpickering (added) Comment: I agree with Ryan's analysis. Now that we have pattern synoyms with record fields, I think we need to disentangle two aspects of `Parent` that are now orthogonal: * whether the `Name` has a parent at all (this can change due to pattern- synonym bundling) * whether the `Name` is a record field, and if so, its label (this shouldn't change) For example, we could add a constructor to `Parent` that has a `Maybe FieldLabelString` but not a parent `Name`. This ought to be enough to make `isRecFldGRE` accurate and hence calculate the name shadowing warnings correctly (fixing this ticket). However, this isn't quite enough for #11228, for which there are other complications (see discussion on https://github.com/ghc-proposals/ghc- proposals/pull/84). -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 9 10:03:18 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 09 Jan 2018 10:03:18 -0000 Subject: [GHC] #14649: ghc panic: mergeSATInfo In-Reply-To: <049.cce3ce7e653fe690c2ca996c501da8d5@haskell.org> References: <049.cce3ce7e653fe690c2ca996c501da8d5@haskell.org> Message-ID: <064.e423183d4b5fd20df847028eed652260@haskell.org> #14649: ghc panic: mergeSATInfo -------------------------------------+------------------------------------- Reporter: tianxiaogu | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: | StaticArgumentTransformation Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * keywords: => StaticArgumentTransformation Comment: Thanks for reporting this. The Static Argument Transformation could really do with some love from someone. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 9 11:34:06 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 09 Jan 2018 11:34:06 -0000 Subject: [GHC] #14652: Allow different executable names on windows Message-ID: <047.e6a3bc01cad203df066c1a713b94ac37@haskell.org> #14652: Allow different executable names on windows -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: (none) Type: task | Status: new Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: Keywords: | Operating System: Windows Architecture: | Type of failure: Compile-time Unknown/Multiple | crash or panic Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- Currently renaming the executable on windows leads to a ghc panic is it enforces that they are named ghc/ghc-stage[123]. This isn't enforced Linux and I don't see a good reason why we should do so on Windows. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 9 11:42:51 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 09 Jan 2018 11:42:51 -0000 Subject: [GHC] #14652: Allow different executable names on windows In-Reply-To: <047.e6a3bc01cad203df066c1a713b94ac37@haskell.org> References: <047.e6a3bc01cad203df066c1a713b94ac37@haskell.org> Message-ID: <062.2300d5db655e915cf478cd674557ee81@haskell.org> #14652: Allow different executable names on windows -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: AndreasK Type: task | Status: new Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: Resolution: | Keywords: Operating System: Windows | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4296 Wiki Page: | -------------------------------------+------------------------------------- Changes (by AndreasK): * owner: (none) => AndreasK * differential: => Phab:D4296 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 9 11:43:34 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 09 Jan 2018 11:43:34 -0000 Subject: [GHC] #14652: Allow different executable names on windows In-Reply-To: <047.e6a3bc01cad203df066c1a713b94ac37@haskell.org> References: <047.e6a3bc01cad203df066c1a713b94ac37@haskell.org> Message-ID: <062.f033219b7e472e530e19eeac9b724d73@haskell.org> #14652: Allow different executable names on windows -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: AndreasK Type: task | Status: patch Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: Resolution: | Keywords: Operating System: Windows | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4296 Wiki Page: | -------------------------------------+------------------------------------- Changes (by AndreasK): * status: new => patch -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 9 11:48:25 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 09 Jan 2018 11:48:25 -0000 Subject: [GHC] #14378: Unreasonably high memory use when compiling with profiling and -O2/-O2 In-Reply-To: <047.a8b592bdf4c4944a022c676f27e79424@haskell.org> References: <047.a8b592bdf4c4944a022c676f27e79424@haskell.org> Message-ID: <062.3c456f30183f791ad3176ff4952cdf1d@haskell.org> #14378: Unreasonably high memory use when compiling with profiling and -O2/-O2 -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by AndreasK): * status: new => closed * resolution: => fixed Comment: From feedback on IRC it seems the resources required on 8.2 for a profiling build are to be expected. As this doesn't seem to be a common issue and is fixed in 8.2 onwards I'm closing this as fixed. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 9 13:03:24 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 09 Jan 2018 13:03:24 -0000 Subject: [GHC] #14644: Improve cmm/assembly for pattern matches with two constants. In-Reply-To: <047.054a8f1d3e52c239a87742662b91a120@haskell.org> References: <047.054a8f1d3e52c239a87742662b91a120@haskell.org> Message-ID: <062.9184a6fd334e471224beabff18f9d1ad@haskell.org> #14644: Improve cmm/assembly for pattern matches with two constants. -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: AndreasK Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 (CodeGen) | Keywords: Codegen, CMM, Resolution: | Patterns, Pattern Matching Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4294 Wiki Page: | -------------------------------------+------------------------------------- Changes (by AndreasK): * owner: (none) => AndreasK * differential: => Phab:D4294 Comment: I ran a simple Benchmark and the results seem almost too good with >10% gains in almost all cases. If it really is that good then, well, I guess good for us. Assuming I didn't introduce an error somewhere I assume the combination of smaller code and less instructions on some paths is just better in general. > If we e.g. assume that all Ints happen equally often in the example above, it would be best to check for <1 and >7 first, so we would get roughly 1.5 comparisons on average. Depending on the number of registers available, you can even get away with 1 subtraction and 1 unsigned comparison for this range check, a classic C hack (ab)using wrap-around for unsigned ints. I thought about this a bit. While true it also means the first comparison has a hard time with prediction if the numbers are a random distribution over the range. So two 99.9% correctly predicted comparisons might still be better even without considering code size. `range check, jg, je, cmp, je, j ` could still be better. But not sure if I will look into that and it might warrant it's own ticket as GHC also uses this for range checks on jump tables I think. Code used for the test: {{{ f_test :: Int -> Int f_test 111 = 1111 f_test 222 = 2222 f_test _ = -1 run = print . sum . map f_test --main = print . sum . map f_test $ ([(-1500000000::Int) .. 0]) main = do args <- getArgs :: IO [String] if null args then putStrLn "Usage: pos|neg|both" else case (head args) of "pos" -> run [0 .. (1500000000::Int)] "neg" -> run [-1500000000::Int .. 0] "both" -> run [-750000000::Int .. 750000000::Int] "negrep" -> run . concat . replicate 100000000 $ [-311, -322, -333, -444] "posrep" -> run . concat . replicate 100000000 $ [311, 322, 333, 444] "unpre" -> run . concat . replicate 100000000 $ [111, 322, -333, 222] }}} I get these results for the current approach (range) and mine (if) on an 6700K === With inlining: {{{ benchmarking execute: range pos mean 1.196 s (1.196 s .. 1.198 s) benchmarking execute: if pos mean 806.0 ms (803.5 ms .. 807.3 ms) benchmarking execute: range neg mean 2.384 s (2.383 s .. 2.385 s) benchmarking execute: if neg mean 1.841 s (1.841 s .. 1.842 s) benchmarking execute: range negrep mean 840.1 ms (838.1 ms .. 841.3 ms) benchmarking execute: if negrep mean 728.6 ms (728.3 ms .. 728.8 ms) benchmarking execute: range unpre mean 852.2 ms (851.1 ms .. 853.1 ms) benchmarking execute: if unpre mean 789.7 ms (789.3 ms .. 789.9 ms) }}} === With inlining disabled on f_test {{{ benchmarking execute: range pos mean 2.385 s (2.383 s .. 2.386 s) benchmarking execute: if pos mean 2.383 s (2.382 s .. 2.384 s) benchmarking execute: range neg mean 2.845 s (2.839 s .. 2.848 s) benchmarking execute: if neg mean 2.047 s (2.041 s .. 2.053 s) benchmarking execute: range negrep mean 1.204 s (1.201 s .. 1.205 s) benchmarking execute: if negrep mean 829.4 ms (828.4 ms .. 830.1 ms) benchmarking execute: range unpre mean 1.165 s (1.164 s .. 1.166 s) benchmarking execute: if unpre mean 1.118 s (1.117 s .. 1.119 s) }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 9 13:24:08 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 09 Jan 2018 13:24:08 -0000 Subject: [GHC] #14644: Improve cmm/assembly for pattern matches with two constants. In-Reply-To: <047.054a8f1d3e52c239a87742662b91a120@haskell.org> References: <047.054a8f1d3e52c239a87742662b91a120@haskell.org> Message-ID: <062.8e57a658f309b36c2c9df0c917d1b582@haskell.org> #14644: Improve cmm/assembly for pattern matches with two constants. -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: AndreasK Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 (CodeGen) | Keywords: Codegen, CMM, Resolution: | Patterns, Pattern Matching Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4294 Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): A 10% improvement is amazing. If you commit this, please include a Note explaining the strategy, and pointing to the ticket. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 9 13:24:30 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 09 Jan 2018 13:24:30 -0000 Subject: [GHC] #14650: Panic with no extensions (StgCmmEnv: variable not found) In-Reply-To: <045.b734e19b172639c0ef220c04df7c2bd5@haskell.org> References: <045.b734e19b172639c0ef220c04df7c2bd5@haskell.org> Message-ID: <060.1e17a03ed503fc5bd407225bae61577a@haskell.org> #14650: Panic with no extensions (StgCmmEnv: variable not found) -------------------------------------+------------------------------------- Reporter: Zemyla | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: x86_64 Type of failure: Compile-time | (amd64) crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): I'm on this. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 9 13:53:05 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 09 Jan 2018 13:53:05 -0000 Subject: [GHC] #14653: Text missing in ghc-prim's documentation Message-ID: <046.609bd988f60cb8a028f94fdc7c2f2e0a@haskell.org> #14653: Text missing in ghc-prim's documentation -------------------------------------+------------------------------------- Reporter: gallais | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: libraries | Version: 8.2.2 (other) | Keywords: ghc-prim | Operating System: Unknown/Multiple Architecture: | Type of failure: Documentation Unknown/Multiple | bug Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- The comment for `reallyUnsafePtrEquality#` visible on [https://hackage.haskell.org/package/ghc-prim-0.5.1.1/docs/GHC- Prim.html#v:reallyUnsafePtrEquality-35- hackage] gives the impression that the function returns `1#` when the two points are not equal. Looking [https://hackage.haskell.org/package/ghc- prim-0.5.1.1/docs/src/GHC.Prim.html#reallyUnsafePtrEquality%23 at the source code], the intended comment is the complete opposite. It seems that haddock ate everything between hashes. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 9 13:53:35 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 09 Jan 2018 13:53:35 -0000 Subject: [GHC] #14653: Text missing in ghc-prim's documentation In-Reply-To: <046.609bd988f60cb8a028f94fdc7c2f2e0a@haskell.org> References: <046.609bd988f60cb8a028f94fdc7c2f2e0a@haskell.org> Message-ID: <061.4ffad0916a6aa98423289706285a674f@haskell.org> #14653: Text missing in ghc-prim's documentation -------------------------------------+------------------------------------- Reporter: gallais | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: libraries | Version: 8.2.2 (other) | Resolution: | Keywords: ghc-prim Operating System: Unknown/Multiple | Architecture: Type of failure: Documentation | Unknown/Multiple bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Description changed by gallais: Old description: > The comment for `reallyUnsafePtrEquality#` visible on > [https://hackage.haskell.org/package/ghc-prim-0.5.1.1/docs/GHC- > Prim.html#v:reallyUnsafePtrEquality-35- hackage] gives the impression > that the function returns `1#` when the two points are not equal. > > Looking [https://hackage.haskell.org/package/ghc- > prim-0.5.1.1/docs/src/GHC.Prim.html#reallyUnsafePtrEquality%23 at the > source code], the intended comment is the complete opposite. > > It seems that haddock ate everything between hashes. New description: The comment for `reallyUnsafePtrEquality#` visible on [https://hackage.haskell.org/package/ghc-prim-0.5.1.1/docs/GHC- Prim.html#v:reallyUnsafePtrEquality-35- hackage] gives the impression that the function returns `1#` when the two pointers are not equal. Looking [https://hackage.haskell.org/package/ghc- prim-0.5.1.1/docs/src/GHC.Prim.html#reallyUnsafePtrEquality%23 at the source code], the intended comment is the complete opposite. It seems that haddock ate everything between hashes. -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 9 14:29:08 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 09 Jan 2018 14:29:08 -0000 Subject: [GHC] #14654: Nofib: Strip called without .exe extension resulting in errors. Message-ID: <047.c0797d46dbce4498940454ea926743bb@haskell.org> #14654: Nofib: Strip called without .exe extension resulting in errors. -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: NoFib | Version: 8.2.2 benchmark suite | Keywords: nofib, | Operating System: Windows windows | Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- {{{ ... ==nofib== bernouilli: size of Main.o follows... text data bss dec hex filename 8080 1632 0 9712 25f0 Main.o ==nofib== bernouilli: time to link bernouilli follows... <> C:\ghc\msys64\mingw64\bin\strip.exe: 'bernouilli': No such file make[2]: *** [../../mk/target.mk:96: size] Error 1 make[2]: Target 'all' not remade because of errors. Finished making all in bernouilli: 0 ... }}} I assume strip looks for a file, not an executable. And as such requires the full name "foo.exe" instead of just "foo". Make sees this error and stops before the actual benchmark is run. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 9 14:48:38 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 09 Jan 2018 14:48:38 -0000 Subject: [GHC] #14654: Nofib: Strip called without .exe extension resulting in errors. In-Reply-To: <047.c0797d46dbce4498940454ea926743bb@haskell.org> References: <047.c0797d46dbce4498940454ea926743bb@haskell.org> Message-ID: <062.af274ab1688e172b0e36b1dd018e5282@haskell.org> #14654: Nofib: Strip called without .exe extension resulting in errors. -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: AndreasK Type: bug | Status: new Priority: normal | Milestone: Component: NoFib benchmark | Version: 8.2.2 suite | Keywords: nofib, Resolution: | windows Operating System: Windows | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4297 Wiki Page: | -------------------------------------+------------------------------------- Changes (by AndreasK): * owner: (none) => AndreasK * differential: => Phab:D4297 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 9 14:48:58 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 09 Jan 2018 14:48:58 -0000 Subject: [GHC] #14654: Nofib: Strip called without .exe extension resulting in errors. In-Reply-To: <047.c0797d46dbce4498940454ea926743bb@haskell.org> References: <047.c0797d46dbce4498940454ea926743bb@haskell.org> Message-ID: <062.0d49580e5601a0d240b51acd59f5eb36@haskell.org> #14654: Nofib: Strip called without .exe extension resulting in errors. -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: AndreasK Type: bug | Status: patch Priority: normal | Milestone: Component: NoFib benchmark | Version: 8.2.2 suite | Keywords: nofib, Resolution: | windows Operating System: Windows | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4297 Wiki Page: | -------------------------------------+------------------------------------- Changes (by AndreasK): * status: new => patch -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 9 16:22:35 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 09 Jan 2018 16:22:35 -0000 Subject: [GHC] #14655: Compiled nofib-analyse executable segfaults under windows Message-ID: <047.44633c0d8f4acc4718fac822df06754c@haskell.org> #14655: Compiled nofib-analyse executable segfaults under windows -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: Runtime crash Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- Happens in 8.2.2 and HEAD {{{ $ ./nofib-analyse.exe ../log2_range ../log2_range +RTS --generate-crash- dumps Access violation in generated code when reading 0xffffffffffffffff Attempting to reconstruct a stack trace... Frame Code address * 0x12ad980 0x454f0b C:\ghc\msys64\home\Andi\ghc_head\nofib\nofib- analyse\nofib-analyse.exe+0x54f0b * 0x12ada10 0x455515 C:\ghc\msys64\home\Andi\ghc_head\nofib\nofib- analyse\nofib-analyse.exe+0x55515 * 0x12adb80 0x4576f6 C:\ghc\msys64\home\Andi\ghc_head\nofib\nofib- analyse\nofib-analyse.exe+0x576f6 * 0x12adb88 0x44bfcd C:\ghc\msys64\home\Andi\ghc_head\nofib\nofib- analyse\nofib-analyse.exe+0x4bfcd * 0x12adb90 0x5512580 * 0x12adb98 0x9d6e10 C:\ghc\msys64\home\Andi\ghc_head\nofib\nofib- analyse\nofib-analyse.exe+0x5d6e10 * 0x12adba0 0x2 * 0x12adba8 0x53b4f30 Crash dump created. Dump written to: C:\ghc\msys64\tmp\ghc-20180109-171729-25632-48420.dmp }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 9 16:48:17 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 09 Jan 2018 16:48:17 -0000 Subject: [GHC] #14655: Compiled nofib-analyse executable segfaults under windows In-Reply-To: <047.44633c0d8f4acc4718fac822df06754c@haskell.org> References: <047.44633c0d8f4acc4718fac822df06754c@haskell.org> Message-ID: <062.c36646d8da17d2b726a38766aef591e0@haskell.org> #14655: Compiled nofib-analyse executable segfaults under windows -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Runtime crash | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by AndreasK): * Attachment "log_min.txt" added. Log file for reproduction -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 9 16:56:34 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 09 Jan 2018 16:56:34 -0000 Subject: [GHC] #14655: Compiled nofib-analyse executable segfaults under windows In-Reply-To: <047.44633c0d8f4acc4718fac822df06754c@haskell.org> References: <047.44633c0d8f4acc4718fac822df06754c@haskell.org> Message-ID: <062.06f144c951ce8cd12b2dd18b9f7fc958@haskell.org> #14655: Compiled nofib-analyse executable segfaults under windows -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Runtime crash | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by AndreasK): Crash dump: https://drive.google.com/file/d/1xbvJ57HehmnxvwbyqIPOq2N7iIlSYxX1/view?usp=sharing -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 9 16:56:43 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 09 Jan 2018 16:56:43 -0000 Subject: [GHC] #14653: Text missing in ghc-prim's documentation In-Reply-To: <046.609bd988f60cb8a028f94fdc7c2f2e0a@haskell.org> References: <046.609bd988f60cb8a028f94fdc7c2f2e0a@haskell.org> Message-ID: <061.7a2d4c1a2070d3cbb011b7b47f13341b@haskell.org> #14653: Text missing in ghc-prim's documentation -------------------------------------+------------------------------------- Reporter: gallais | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: libraries | Version: 8.2.2 (other) | Keywords: ghc-prim, Resolution: | newcomer Operating System: Unknown/Multiple | Architecture: Type of failure: Documentation | Unknown/Multiple bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * keywords: ghc-prim => ghc-prim, newcomer -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 9 20:22:55 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 09 Jan 2018 20:22:55 -0000 Subject: [GHC] #14646: GHC 8.4.1 regression: rank-n types no longer parenthesized when pretty-printed In-Reply-To: <050.f6d9f92b935b2b76cf140ddb5bc8ac61@haskell.org> References: <050.f6d9f92b935b2b76cf140ddb5bc8ac61@haskell.org> Message-ID: <065.12f9d0a5a06a2ccc10c3ff0521e98ef0@haskell.org> #14646: GHC 8.4.1 regression: rank-n types no longer parenthesized when pretty- printed -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: RyanGlScott Type: bug | Status: new Priority: high | Milestone: 8.4.1 Component: GHC API | Version: 8.4.1-alpha1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect result | Unknown/Multiple at runtime | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * owner: (none) => RyanGlScott Comment: I will take a crack at (2). Note to myself: we should try to emulate the behavior of the first case of [http://git.haskell.org/ghc.git/blob/fb78b0d22635b1d7ae68385c648b8c407f5562c2:/libraries /template-haskell/Language/Haskell/TH/Ppr.hs#l734 pprFunArgType] in the `ArrowT` case of `Convert.cvtTypeKind`. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 9 20:27:26 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 09 Jan 2018 20:27:26 -0000 Subject: [GHC] #14646: GHC 8.4.1 regression: rank-n types no longer parenthesized when pretty-printed In-Reply-To: <050.f6d9f92b935b2b76cf140ddb5bc8ac61@haskell.org> References: <050.f6d9f92b935b2b76cf140ddb5bc8ac61@haskell.org> Message-ID: <065.3a43d48e710c8d60d2f66046ca7a2d81@haskell.org> #14646: GHC 8.4.1 regression: rank-n types no longer parenthesized when pretty- printed -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: RyanGlScott Type: bug | Status: new Priority: high | Milestone: 8.4.1 Component: GHC API | Version: 8.4.1-alpha1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect result | Unknown/Multiple at runtime | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by alanz): I just realised this is an 8.4.1 regression. @RyanGlScott, I can take a look if you prefer. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 9 20:28:21 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 09 Jan 2018 20:28:21 -0000 Subject: [GHC] #14644: Improve cmm/assembly for pattern matches with two constants. In-Reply-To: <047.054a8f1d3e52c239a87742662b91a120@haskell.org> References: <047.054a8f1d3e52c239a87742662b91a120@haskell.org> Message-ID: <062.bebdfd8a77efe15f57b9291f7d0e308d@haskell.org> #14644: Improve cmm/assembly for pattern matches with two constants. -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: AndreasK Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 (CodeGen) | Keywords: Codegen, CMM, Resolution: | Patterns, Pattern Matching Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4294 Wiki Page: | -------------------------------------+------------------------------------- Comment (by AndreasK): Replying to [comment:6 simonpj]: > A 10% improvement is amazing. Indeed! Nothing in nofib gets up to 10% but wheel-sieve1 comes close. * 17 programs are changed (contain that kind of case statement) * 15 Show no significant runtime difference. (It's fair to assume it's an improvement but not mensurable with the noise on my machine) * k-nucleotide improves by ~1.2% * wheel-sieve1 has the code in a inner loop. It improves by ~4.3% in mode=normal. Increasing the problem size makes the difference even bigger up to somewhere around 8-9% > > If you commit this, please include a Note explaining the strategy, and pointing to the ticket. Will do. **** The patch is up on phab. If someone can run this on an older intel (or even better amd) processor and check the result that would be great to make sure it's not just a pecularity of my i7-6700K. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 9 20:29:08 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 09 Jan 2018 20:29:08 -0000 Subject: [GHC] #14646: GHC 8.4.1 regression: rank-n types no longer parenthesized when pretty-printed In-Reply-To: <050.f6d9f92b935b2b76cf140ddb5bc8ac61@haskell.org> References: <050.f6d9f92b935b2b76cf140ddb5bc8ac61@haskell.org> Message-ID: <065.488ba645ae89074d148de8b87dc65fa5@haskell.org> #14646: GHC 8.4.1 regression: rank-n types no longer parenthesized when pretty- printed -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: RyanGlScott Type: bug | Status: new Priority: high | Milestone: 8.4.1 Component: GHC API | Version: 8.4.1-alpha1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect result | Unknown/Multiple at runtime | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): No worries, I believe I already have the patch implemented. (I'll add you as a reviewer, of course.) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 9 20:31:38 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 09 Jan 2018 20:31:38 -0000 Subject: [GHC] #8095: TypeFamilies painfully slow In-Reply-To: <050.29bdc4d704aaf05e461a59330593e649@haskell.org> References: <050.29bdc4d704aaf05e461a59330593e649@haskell.org> Message-ID: <065.8cad11d92b3810f0b90781407125a327@haskell.org> #8095: TypeFamilies painfully slow -------------------------------------+------------------------------------- Reporter: MikeIzbicki | Owner: goldfire Type: bug | Status: new Priority: high | Milestone: 8.4.1 Component: Compiler (Type | Version: 7.6.3 checker) | Resolution: | Keywords: TypeFamilies Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: #5321, #11598, | Differential Rev(s): Phab:D3752 #12506 | Wiki Page: | -------------------------------------+------------------------------------- Comment (by alanz): I wonder if this is contributing to the slow compilation times for the TTG patches, related to deriving `Data` instances for type family indexed types. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 9 20:32:04 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 09 Jan 2018 20:32:04 -0000 Subject: [GHC] #8095: TypeFamilies painfully slow In-Reply-To: <050.29bdc4d704aaf05e461a59330593e649@haskell.org> References: <050.29bdc4d704aaf05e461a59330593e649@haskell.org> Message-ID: <065.a6cbc1e8b65bd8a4dc451eef77899cbf@haskell.org> #8095: TypeFamilies painfully slow -------------------------------------+------------------------------------- Reporter: MikeIzbicki | Owner: goldfire Type: bug | Status: new Priority: high | Milestone: 8.4.1 Component: Compiler (Type | Version: 7.6.3 checker) | Resolution: | Keywords: TypeFamilies Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: #5321, #11598, | Differential Rev(s): Phab:D3752 #12506 | Wiki Page: | -------------------------------------+------------------------------------- Changes (by alanz): * cc: alanz (added) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 9 20:32:49 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 09 Jan 2018 20:32:49 -0000 Subject: [GHC] #14646: GHC 8.4.1 regression: rank-n types no longer parenthesized when pretty-printed In-Reply-To: <050.f6d9f92b935b2b76cf140ddb5bc8ac61@haskell.org> References: <050.f6d9f92b935b2b76cf140ddb5bc8ac61@haskell.org> Message-ID: <065.df1a4678cc163ea1ec6aefb11031c0dd@haskell.org> #14646: GHC 8.4.1 regression: rank-n types no longer parenthesized when pretty- printed -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: RyanGlScott Type: bug | Status: patch Priority: high | Milestone: 8.4.1 Component: GHC API | Version: 8.4.1-alpha1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect result | Unknown/Multiple at runtime | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4298 Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * status: new => patch * differential: => Phab:D4298 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 9 21:02:32 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 09 Jan 2018 21:02:32 -0000 Subject: [GHC] #14644: Improve cmm/assembly for pattern matches with two constants. In-Reply-To: <047.054a8f1d3e52c239a87742662b91a120@haskell.org> References: <047.054a8f1d3e52c239a87742662b91a120@haskell.org> Message-ID: <062.e5731a1a2bbc3246aad042f6ff8396ec@haskell.org> #14644: Improve cmm/assembly for pattern matches with two constants. -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: AndreasK Type: task | Status: patch Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 (CodeGen) | Keywords: Codegen, CMM, Resolution: | Patterns, Pattern Matching Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4294 Wiki Page: | -------------------------------------+------------------------------------- Changes (by AndreasK): * status: new => patch -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 9 23:03:26 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 09 Jan 2018 23:03:26 -0000 Subject: [GHC] #14336: ghci leaks memory In-Reply-To: <051.dbf33557716163bb981beab6790198d1@haskell.org> References: <051.dbf33557716163bb981beab6790198d1@haskell.org> Message-ID: <066.855f1ac6d77ca60e9a5cd97334c90ad7@haskell.org> #14336: ghci leaks memory -------------------------------------+------------------------------------- Reporter: NeilMitchell | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: GHCi | Version: 8.2.1 Resolution: | Keywords: Operating System: Windows | Architecture: x86_64 Type of failure: Runtime | (amd64) performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by mpickering): Just to be clear, I should be looking at the third column increasing? It starts out for me at around 8,569,448 and gradually increases up to 13,360,528 after running 1000 iterations. Other things I tried. 1. Not creating `it` bindings as one was created for each line. This didn't seem to make a big difference for small examples but does for big examples. (Max residency 11mb (unmod) vs 2. Not running any Haskell code, so changing the string line to `:set -XTypeApplications", the live column still increased but more slowly. (Up to 11219144 after 1000 iterations). 3. Running with `:set -fobject-code`, seemed to make no difference or make things slightly worse (14051160) (Just once at the start of the loop). 4. Increasing the size of the string (by 100x) makes things much worse 62235312 but not 100x worse, just 6x worse, maximum residency 55mb. BUT, running with my modified compiler which doesn't generate `it` bindings, only 13mb max residency. Anyway I don't really know what I am looking for so if someone could point out which number I should be looking at and what it means for my hardware averse brain it would be useful. Here is the patch I used for `no_it`. https://gist.github.com/78366267566cfe8cf85101fc11b169ed -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 9 23:15:39 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 09 Jan 2018 23:15:39 -0000 Subject: [GHC] #14644: Improve cmm/assembly for pattern matches with two constants. In-Reply-To: <047.054a8f1d3e52c239a87742662b91a120@haskell.org> References: <047.054a8f1d3e52c239a87742662b91a120@haskell.org> Message-ID: <062.3bd7242d10f027dcb972928b05d63f40@haskell.org> #14644: Improve cmm/assembly for pattern matches with two constants. -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: AndreasK Type: task | Status: patch Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 (CodeGen) | Keywords: Codegen, CMM, Resolution: | Patterns, Pattern Matching Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4294 Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Didn't you say "I ran a simple Benchmark and the results seem almost too good with >10% gains in almost all cases.". But now you say "mostly no change; one gets 5-9%". Were the earlier measurements wrong? Anyway the patch looks good. Thanks -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 10 06:59:57 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 10 Jan 2018 06:59:57 -0000 Subject: [GHC] #14613: Validate Failure On OSX -- implicit fall through error for machO linker support (master == ghc8.5) In-Reply-To: <045.c82d9958b329ffd45f64454bdb7b134e@haskell.org> References: <045.c82d9958b329ffd45f64454bdb7b134e@haskell.org> Message-ID: <060.af06e405bb742c3b133c7786b5702499@haskell.org> #14613: Validate Failure On OSX -- implicit fall through error for machO linker support (master == ghc8.5) -------------------------------------+------------------------------------- Reporter: carter | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.3 (Linking) | Resolution: | Keywords: Operating System: MacOS X | Architecture: x86_64 | (amd64) Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by erikd): There's a way nicer fix, to add a comment/annotation: {{{ /* Falls through. */ }}} at the line where a `break;` statement might otherwise go. For example: https://github.com/erikd/libsndfile/blob/master/src/aiff.c#L852 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 10 07:14:26 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 10 Jan 2018 07:14:26 -0000 Subject: [GHC] #14656: Nofib: Ignore cr-lineendings in benchmarks Message-ID: <047.9bef567ea530bf2617132f7e80ca6f4e@haskell.org> #14656: Nofib: Ignore cr-lineendings in benchmarks -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: NoFib | Version: 8.2.2 benchmark suite | Keywords: | Operating System: Windows Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- At least the real/eff benchmarks fail because of this. {{{ ==nofib== CS: time to run CS follows... ../../../runstdtest/runstdtest ./CS -o1 CS.stdout -o1 CS.stdout -ghc- timing -stdout-binary ; ../../../runstdtest/runstdtest ./CS -o1 CS.stdout -o1 CS.stdout -ghc-timing -stdout-binary ; ../../../runstdtest/runstdtest ./CS -o1 CS.stdout -o1 CS.stdout -ghc- timing -stdout-binary ; ../../../runstdtest/runstdtest ./CS -o1 CS.stdout -o1 CS.stdout -ghc-timing -stdout-binary ; ../../../runstdtest/runstdtest ./CS -o1 CS.stdout -o1 CS.stdout -ghc- timing -stdout-binary ; real 0m0.173s user 0m0.000s sys 0m0.015s ././CS < /dev/null expected stdout not matched by reality <> }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 10 07:14:46 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 10 Jan 2018 07:14:46 -0000 Subject: [GHC] #14656: Nofib: Ignore cr-lineendings in benchmarks In-Reply-To: <047.9bef567ea530bf2617132f7e80ca6f4e@haskell.org> References: <047.9bef567ea530bf2617132f7e80ca6f4e@haskell.org> Message-ID: <062.ee9662b9f6cf97d81ecadd09c711412a@haskell.org> #14656: Nofib: Ignore cr-lineendings in benchmarks -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: NoFib benchmark | Version: 8.2.2 suite | Resolution: | Keywords: Operating System: Windows | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Description changed by AndreasK: Old description: > At least the real/eff benchmarks fail because of this. > > {{{ > ==nofib== CS: time to run CS follows... > ../../../runstdtest/runstdtest ./CS -o1 CS.stdout -o1 CS.stdout -ghc- > timing -stdout-binary ; ../../../runstdtest/runstdtest ./CS -o1 > CS.stdout -o1 CS.stdout -ghc-timing -stdout-binary ; > ../../../runstdtest/runstdtest ./CS -o1 CS.stdout -o1 CS.stdout -ghc- > timing -stdout-binary ; ../../../runstdtest/runstdtest ./CS -o1 > CS.stdout -o1 CS.stdout -ghc-timing -stdout-binary ; > ../../../runstdtest/runstdtest ./CS -o1 CS.stdout -o1 CS.stdout -ghc- > timing -stdout-binary ; > > real 0m0.173s > user 0m0.000s > sys 0m0.015s > ././CS < /dev/null > expected stdout not matched by reality > < samples), 290232 bytes GC work, 2M in use, 0.000 INIT (0.000 elapsed), > 0.125 MUT (0.124 elapsed), 0.000 GC (0.001 elapsed), 0.000 GC(0) (0.001 > elapsed), 0.000 GC(1) (0.001 elapsed), 1 balance :ghc>> > }}} New description: At least the real/eff benchmarks fail because of this on Windows. {{{ ==nofib== CS: time to run CS follows... ../../../runstdtest/runstdtest ./CS -o1 CS.stdout -o1 CS.stdout -ghc- timing -stdout-binary ; ../../../runstdtest/runstdtest ./CS -o1 CS.stdout -o1 CS.stdout -ghc-timing -stdout-binary ; ../../../runstdtest/runstdtest ./CS -o1 CS.stdout -o1 CS.stdout -ghc- timing -stdout-binary ; ../../../runstdtest/runstdtest ./CS -o1 CS.stdout -o1 CS.stdout -ghc-timing -stdout-binary ; ../../../runstdtest/runstdtest ./CS -o1 CS.stdout -o1 CS.stdout -ghc- timing -stdout-binary ; real 0m0.173s user 0m0.000s sys 0m0.015s ././CS < /dev/null expected stdout not matched by reality <> }}} -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 10 07:18:29 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 10 Jan 2018 07:18:29 -0000 Subject: [GHC] #14644: Improve cmm/assembly for pattern matches with two constants. In-Reply-To: <047.054a8f1d3e52c239a87742662b91a120@haskell.org> References: <047.054a8f1d3e52c239a87742662b91a120@haskell.org> Message-ID: <062.51d3226557dfd8c1372c0f6ed73e2286@haskell.org> #14644: Improve cmm/assembly for pattern matches with two constants. -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: AndreasK Type: task | Status: patch Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 (CodeGen) | Keywords: Codegen, CMM, Resolution: | Patterns, Pattern Matching Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4294 Wiki Page: | -------------------------------------+------------------------------------- Comment (by AndreasK): Replying to [comment:9 simonpj]: > Didn't you say "I ran a simple Benchmark and the results seem almost too good with >10% gains in almost all cases.". But now you say "mostly no change; one gets 5-9%". Were the earlier measurements wrong? No these are right. But the simple benchmark was running the code I posted above in [https://ghc.haskell.org/trac/ghc/ticket/14644?replyto=9#comment:5 comment 5]. All cases referred to the pos/neg/.. branches in that case. Nofib seems to be in a permanent state of breakdown on windows so I stopped using it in my initial benchmarks. And it was the [https://ghc.haskell.org/trac/ghc/ticket/14656 right] [https://ghc.haskell.org/trac/ghc/ticket/14655 thing] [https://ghc.haskell.org/trac/ghc/ticket/14654 to do ] as it took some work to get it running. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 10 08:20:50 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 10 Jan 2018 08:20:50 -0000 Subject: [GHC] #14650: Panic with no extensions (StgCmmEnv: variable not found) In-Reply-To: <045.b734e19b172639c0ef220c04df7c2bd5@haskell.org> References: <045.b734e19b172639c0ef220c04df7c2bd5@haskell.org> Message-ID: <060.e9465bdda123cbd896e35cd8d05f2cba@haskell.org> #14650: Panic with no extensions (StgCmmEnv: variable not found) -------------------------------------+------------------------------------- Reporter: Zemyla | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: x86_64 Type of failure: Compile-time | (amd64) crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Simon Peyton Jones ): In [changeset:"66ff794fedf6e81e727dc8f651e63afe6f2a874b/ghc" 66ff794f/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="66ff794fedf6e81e727dc8f651e63afe6f2a874b" Fix join-point decision This patch moves the "ok_unfolding" test from CoreOpt.joinPointBinding_maybe to OccurAnal.decideJoinPointHood Previously the occurrence analyser was deciding to make something a join point, but the simplifier was reversing that decision, which made the decision about /other/ bindings invalid. Fixes Trac #14650. }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 10 08:20:50 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 10 Jan 2018 08:20:50 -0000 Subject: [GHC] #14650: Panic with no extensions (StgCmmEnv: variable not found) In-Reply-To: <045.b734e19b172639c0ef220c04df7c2bd5@haskell.org> References: <045.b734e19b172639c0ef220c04df7c2bd5@haskell.org> Message-ID: <060.752878aafb6484d96cbf9afba70b409a@haskell.org> #14650: Panic with no extensions (StgCmmEnv: variable not found) -------------------------------------+------------------------------------- Reporter: Zemyla | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: x86_64 Type of failure: Compile-time | (amd64) crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Simon Peyton Jones ): In [changeset:"1c1e46c1292f4ac69275770ed588401535abec45/ghc" 1c1e46c1/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="1c1e46c1292f4ac69275770ed588401535abec45" preInlineUnconditionally is ok for INLINEABLE When debugging Trac #14650, I found a place where we had let {-# INLINEABLE f #-} f = BIG in f 7 but 'f' wasn't getting inlined at its unique call site. There's a good reason for that with INLINE things, which should only inline when saturated, but not for INILNEABLE things. This patch narrows the case where preInlineUnconditionally gives up. It significantly shortens (and improves) the code for #14650. }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 10 08:20:50 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 10 Jan 2018 08:20:50 -0000 Subject: [GHC] #14643: Partial type signatures in class constraints behave unexpectedly In-Reply-To: <047.6762d95c975e1952f57776fe89e6e2c0@haskell.org> References: <047.6762d95c975e1952f57776fe89e6e2c0@haskell.org> Message-ID: <062.c8399146289c5dfec271d0f8f480dc84@haskell.org> #14643: Partial type signatures in class constraints behave unexpectedly -------------------------------------+------------------------------------- Reporter: mnislaih | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Simon Peyton Jones ): In [changeset:"1577908f2a9db0fcf6f749d40dd75481015f5497/ghc" 1577908/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="1577908f2a9db0fcf6f749d40dd75481015f5497" Fix two more bugs in partial signatures These were shown up by Trac #14643 Bug 1: if we had a single partial signature for two functions f, g :: forall a. _ -> a then we made two different SigTvs but with the sane Name. This was jolly confusing and ultimately led to deeply bogus results with Any's appearing in the resulting program. Yikes. Fix: clone the quantified variables in TcSigs.tcInstSig (as indeed its name suggests). Bug 2: we were not eliminating duplicate/superclass constraints in the partial signatures of a mutually recursive group. Easy to fix: we are already doing dup/superclass elim in TcSimplify.decideQuantification. So we move the partial-sig constraints there too. }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 10 08:29:29 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 10 Jan 2018 08:29:29 -0000 Subject: [GHC] #14336: ghci leaks memory In-Reply-To: <051.dbf33557716163bb981beab6790198d1@haskell.org> References: <051.dbf33557716163bb981beab6790198d1@haskell.org> Message-ID: <066.bf0275115f559c2426fd4dad1863f1e6@haskell.org> #14336: ghci leaks memory -------------------------------------+------------------------------------- Reporter: NeilMitchell | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: GHCi | Version: 8.2.1 Resolution: | Keywords: Operating System: Windows | Architecture: x86_64 Type of failure: Runtime | (amd64) performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by mpickering): 30000 iterations with a short string is about the same max residency with/without `no_it`. (155mb vs 149mb) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 10 08:32:41 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 10 Jan 2018 08:32:41 -0000 Subject: [GHC] #14650: Panic with no extensions (StgCmmEnv: variable not found) In-Reply-To: <045.b734e19b172639c0ef220c04df7c2bd5@haskell.org> References: <045.b734e19b172639c0ef220c04df7c2bd5@haskell.org> Message-ID: <060.fef1aad9683931a73cfd437af505bebe@haskell.org> #14650: Panic with no extensions (StgCmmEnv: variable not found) -------------------------------------+------------------------------------- Reporter: Zemyla | Owner: (none) Type: bug | Status: merge Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: x86_64 | (amd64) Type of failure: Compile-time | Test Case: crash or panic | simplCore/should_compile/T14650.hs Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * status: new => merge * testcase: => simplCore/should_compile/T14650.hs Comment: Thanks for a great report. Now fixed. Worth merging "Fix join-point decision". (The other patch doesn't fix an outright bug.) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 10 08:33:51 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 10 Jan 2018 08:33:51 -0000 Subject: [GHC] #14643: Partial type signatures in class constraints behave unexpectedly In-Reply-To: <047.6762d95c975e1952f57776fe89e6e2c0@haskell.org> References: <047.6762d95c975e1952f57776fe89e6e2c0@haskell.org> Message-ID: <062.25d43c0f68ed92287d111be6ae897f18@haskell.org> #14643: Partial type signatures in class constraints behave unexpectedly -------------------------------------+------------------------------------- Reporter: mnislaih | Owner: (none) Type: bug | Status: merge Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: partial- | sigs/should_compile/T14643, T14643a Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * testcase: => partial-sigs/should_compile/T14643, T14643a * status: new => merge Comment: Thanks for the report. It was trickier than I thought, and showed up not one but two separate bugs. We could merge this... it's an outright bug. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 10 09:27:37 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 10 Jan 2018 09:27:37 -0000 Subject: [GHC] #14336: ghci leaks memory In-Reply-To: <051.dbf33557716163bb981beab6790198d1@haskell.org> References: <051.dbf33557716163bb981beab6790198d1@haskell.org> Message-ID: <066.4a24b1c3cab86395b706d20fd307fece@haskell.org> #14336: ghci leaks memory -------------------------------------+------------------------------------- Reporter: NeilMitchell | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: GHCi | Version: 8.2.1 Resolution: | Keywords: Operating System: Windows | Architecture: x86_64 Type of failure: Runtime | (amd64) performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by mpickering): 30000 iterations of `:set -XTypeApplications` only leads to 16mb of maximum residency so perhaps there is no serious leak there. (6mb with 1000 iterations) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 10 09:41:27 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 10 Jan 2018 09:41:27 -0000 Subject: [GHC] #14336: ghci leaks memory In-Reply-To: <051.dbf33557716163bb981beab6790198d1@haskell.org> References: <051.dbf33557716163bb981beab6790198d1@haskell.org> Message-ID: <066.27388293d5d9f57c4230ba85658cd269@haskell.org> #14336: ghci leaks memory -------------------------------------+------------------------------------- Reporter: NeilMitchell | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: GHCi | Version: 8.2.1 Resolution: | Keywords: Operating System: Windows | Architecture: x86_64 Type of failure: Runtime | (amd64) performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by NeilMitchell): The end thing that matters is process memory usage, and given enough time (half an hour or so) that clearly increases, but not linearly (thanks to effects like GC). The use of the RTS columns just gives you an easy way to spot it faster. The columns for the RTS stats are: {{{ Alloc Copied Live GC GC TOT TOT Page Flts bytes bytes bytes user elap user elap }}} Of those, {{{Live bytes}}} is the one I was watching (3rd one along) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 10 10:19:05 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 10 Jan 2018 10:19:05 -0000 Subject: [GHC] #14613: Validate Failure On OSX -- implicit fall through error for machO linker support (master == ghc8.5) In-Reply-To: <045.c82d9958b329ffd45f64454bdb7b134e@haskell.org> References: <045.c82d9958b329ffd45f64454bdb7b134e@haskell.org> Message-ID: <060.a61ccc942656b23c8adabae646c4b9c9@haskell.org> #14613: Validate Failure On OSX -- implicit fall through error for machO linker support (master == ghc8.5) -------------------------------------+------------------------------------- Reporter: carter | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.3 (Linking) | Resolution: | Keywords: Operating System: MacOS X | Architecture: x86_64 | (amd64) Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Phyx-): I originally suggested the pragma because that's supposed to be more portable while the comment is a GCC only thing. While it'll work in this case, be adviced that GCC will no longer recognize this comment in the stricter variants of the warning e.g. `-Wimplicit-fallthrough=5` -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 10 10:26:39 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 10 Jan 2018 10:26:39 -0000 Subject: [GHC] #14619: Output value of program changes upon compiling with -O optimizations In-Reply-To: <044.7bc7afdc77e978715c67bc6238b57042@haskell.org> References: <044.7bc7afdc77e978715c67bc6238b57042@haskell.org> Message-ID: <059.9934e9a277fd0035c4787774f0dbfd75@haskell.org> #14619: Output value of program changes upon compiling with -O optimizations -------------------------------------+------------------------------------- Reporter: sheaf | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.4.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Windows | Architecture: x86_64 Type of failure: Incorrect result | (amd64) at runtime | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Phyx-): I'll make some time to look at it this weekend. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 10 10:43:50 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 10 Jan 2018 10:43:50 -0000 Subject: [GHC] #14519: Exponential runtime performance regression in GHC 8.2 + Data.Text.Lazy + Text.RE.TDFA In-Reply-To: <043.92c07e3e0209c31f0a0f195fa98d301c@haskell.org> References: <043.92c07e3e0209c31f0a0f195fa98d301c@haskell.org> Message-ID: <058.0d79868509960d14205517a8478efcaf@haskell.org> #14519: Exponential runtime performance regression in GHC 8.2 + Data.Text.Lazy + Text.RE.TDFA -------------------------------------+------------------------------------- Reporter: ntc2 | Owner: tdammers Type: bug | Status: new Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Runtime | Test Case: performance bug | https://github.com/ntc2/ghc-8.2.1 | -regex-lazy-text- | bug/tree/07b7bb32c6e90e8f2d2eada4b59943f37e632d53 Blocked By: | Blocking: Related Tickets: #13745, #14564 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by tdammers): I took a stab at bisecting this myself, the problem however is that I'm getting too many false positives, even when cleaning thoroughly and starting with as clean a slate as possible, and when I do that, build times become prohibitive, so I gave up after a few night-long attempts. So I will now take a different route, trying to isolate the problem further on current GHC HEAD, see if I can pin it down. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 10 10:52:02 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 10 Jan 2018 10:52:02 -0000 Subject: [GHC] #14657: Quadratic constructor tag allocation Message-ID: <046.45808e9eac20b8ac2913c9c582e341fc@haskell.org> #14657: Quadratic constructor tag allocation -------------------------------------+------------------------------------- Reporter: niteria | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: Compile-time Unknown/Multiple | performance bug Test Case: | Blocked By: genManyConstructors | Blocking: | Related Tickets: Differential Rev(s): phab:D4289 | Wiki Page: -------------------------------------+------------------------------------- With a large data type like: {{{ data A = A0 | A0001 | A0002 ... | A9999 }}} GHC spends a lot of time allocating constructor tags. It accounts for half of allocations for large data types like this. The hot piece of code is in `mkDataCon`: {{{ tag = assoc "mkDataCon" (tyConDataCons rep_tycon `zip` [fIRST_TAG..]) con }}} Previous discussion: https://mail.haskell.org/pipermail/ghc-devs/2017-October/014974.html -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 10 10:52:23 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 10 Jan 2018 10:52:23 -0000 Subject: [GHC] #14657: Quadratic constructor tag allocation In-Reply-To: <046.45808e9eac20b8ac2913c9c582e341fc@haskell.org> References: <046.45808e9eac20b8ac2913c9c582e341fc@haskell.org> Message-ID: <061.1ef6b48ab0c04852e8f9cb993ee5e225@haskell.org> #14657: Quadratic constructor tag allocation -------------------------------------+------------------------------------- Reporter: niteria | Owner: niteria Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Compile-time | Test Case: performance bug | genManyConstructors Blocked By: | Blocking: Related Tickets: | Differential Rev(s): phab:D4289 Wiki Page: | -------------------------------------+------------------------------------- Changes (by niteria): * owner: (none) => niteria -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 10 12:53:09 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 10 Jan 2018 12:53:09 -0000 Subject: [GHC] #14519: Exponential runtime performance regression in GHC 8.2 + Data.Text.Lazy + Text.RE.TDFA In-Reply-To: <043.92c07e3e0209c31f0a0f195fa98d301c@haskell.org> References: <043.92c07e3e0209c31f0a0f195fa98d301c@haskell.org> Message-ID: <058.da8515bfc3041443cf4b4c42907946c3@haskell.org> #14519: Exponential runtime performance regression in GHC 8.2 + Data.Text.Lazy + Text.RE.TDFA -------------------------------------+------------------------------------- Reporter: ntc2 | Owner: tdammers Type: bug | Status: new Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Runtime | Test Case: performance bug | https://github.com/ntc2/ghc-8.2.1 | -regex-lazy-text- | bug/tree/07b7bb32c6e90e8f2d2eada4b59943f37e632d53 Blocked By: | Blocking: Related Tickets: #13745, #14564 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by tdammers): Quick data point: in a test case using a modified `Lazy.hs`, the bad behavior can be reproduced when running certain regular expressions against a large test data set, but not others: - `^def `: bad - `^def[^.]`: bad - `^[^.]`: good - `^d[^.]`: good - `^de[^.]`: good - `^def[^.]`: bad - `^[^.]def`: good (I picked `[^.]` as a subexpression that can never match). Particularly interesting is `^de[^.]` vs. `^def[^.]`: it seems that having to consume 4 or more tokens from the start of the input triggers the bad behavior. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 10 13:43:01 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 10 Jan 2018 13:43:01 -0000 Subject: [GHC] #14658: 'Fix two more bugs in partial signatures' broke T10846 Message-ID: <046.d589819107037d6543f2809768319041@haskell.org> #14658: 'Fix two more bugs in partial signatures' broke T10846 -------------------------------------+------------------------------------- Reporter: niteria | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 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: -------------------------------------+------------------------------------- {{{ =====> T10846(normal) 1 of 1 [0, 0, 0] cd "./typecheck/should_run/T10846.run" && "/home/niteria/ghc-allocate- tyids/inplace/test spaces/ghc-stage2" -o T10846 T10846.hs -dcore-lint -dcmm-lint -no-user-package-db -rtsopts -fno-warn-missed-specialisations -fshow-warning-groups -fdiagnostics-color=never -fno-diagnostics-show- caret -dno-debug-output cd "./typecheck/should_run/T10846.run" && ./T10846 Actual stdout output differs from expected: diff -uw "./typecheck/should_run/T10846.run/T10846.stdout.normalised" "./typecheck/should_run/T10846.run/T10846.run.stdout.normalised" --- ./typecheck/should_run/T10846.run/T10846.stdout.normalised 2018-01-10 13:39:29.720468420 +0000 +++ ./typecheck/should_run/T10846.run/T10846.run.stdout.normalised 2018-01-10 13:39:29.720468420 +0000 @@ -1,3 +1,3 @@ [18] -[19] -[20] +[] +[] *** unexpected failure for T10846(normal) }}} Harbormaster results: https://phabricator.haskell.org/harbormaster/build/39597/ Reverting fixed it for me locally. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 10 13:43:17 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 10 Jan 2018 13:43:17 -0000 Subject: [GHC] #14658: 'Fix two more bugs in partial signatures' broke T10846 In-Reply-To: <046.d589819107037d6543f2809768319041@haskell.org> References: <046.d589819107037d6543f2809768319041@haskell.org> Message-ID: <061.81b71a4deeb2edd07db9f898a4585603@haskell.org> #14658: 'Fix two more bugs in partial signatures' broke T10846 -------------------------------------+------------------------------------- Reporter: niteria | Owner: simonpj Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by niteria): * owner: (none) => simonpj -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 10 13:51:15 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 10 Jan 2018 13:51:15 -0000 Subject: [GHC] #14657: Quadratic constructor tag allocation In-Reply-To: <046.45808e9eac20b8ac2913c9c582e341fc@haskell.org> References: <046.45808e9eac20b8ac2913c9c582e341fc@haskell.org> Message-ID: <061.18aa539968302e09c5e7900c3656c95e@haskell.org> #14657: Quadratic constructor tag allocation -------------------------------------+------------------------------------- Reporter: niteria | Owner: niteria Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Compile-time | Test Case: performance bug | genManyConstructors Blocked By: | Blocking: Related Tickets: | Differential Rev(s): phab:D4289 Wiki Page: | -------------------------------------+------------------------------------- Comment (by Bartosz Nitka ): In [changeset:"dbdf77d92c9cd0bbb269137de0bf8754573cdc1e/ghc" dbdf77d/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="dbdf77d92c9cd0bbb269137de0bf8754573cdc1e" Lift constructor tag allocation out of a loop Before this change, for each constructor that we want to allocate a tag for we would traverse a list of all the constructors in a datatype to determine which tag a constructor should get. This is obviously quadratic and for datatypes with 10k constructors it actually makes a big difference. This change implements the plan outlined by @simonpj in https://mail.haskell.org/pipermail/ghc-devs/2017-October/014974.html which is basically about using a map and constructing it outside the loop. One place where things got a bit awkward was TysWiredIn.hs, it would have been possible to just assign the tags by hand, but that seemed error-prone to me, so I decided to go through a map there as well. Test Plan: ./validate On a file with 10k constructors Before: 8,130,522,344 bytes allocated in the heap Total time 3.682s ( 3.920s elapsed) After: 4,133,478,744 bytes allocated in the heap Total time 2.509s ( 2.750s elapsed) Reviewers: simonpj, bgamari Reviewed By: simonpj Subscribers: goldfire, rwbarton, thomie, simonmar, carter, simonpj GHC Trac Issues: #14657 Differential Revision: https://phabricator.haskell.org/D4289 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 10 13:55:45 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 10 Jan 2018 13:55:45 -0000 Subject: [GHC] #14657: Quadratic constructor tag allocation In-Reply-To: <046.45808e9eac20b8ac2913c9c582e341fc@haskell.org> References: <046.45808e9eac20b8ac2913c9c582e341fc@haskell.org> Message-ID: <061.55e535990c2b76df7ca36c257e1a10e7@haskell.org> #14657: Quadratic constructor tag allocation -------------------------------------+------------------------------------- Reporter: niteria | Owner: niteria Type: bug | Status: closed Priority: normal | Milestone: Component: Compiler | Version: Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Compile-time | Test Case: performance bug | genManyConstructors Blocked By: | Blocking: Related Tickets: | Differential Rev(s): phab:D4289 Wiki Page: | -------------------------------------+------------------------------------- Changes (by niteria): * status: new => closed * resolution: => fixed -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 10 13:57:54 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 10 Jan 2018 13:57:54 -0000 Subject: [GHC] #14338: Simplifier fails with "Simplifier ticks exhausted" In-Reply-To: <049.819ef8e60a65cb9f3e29afb8f69166a7@haskell.org> References: <049.819ef8e60a65cb9f3e29afb8f69166a7@haskell.org> Message-ID: <064.c18cc8e358d3dab3da910623e892663a@haskell.org> #14338: Simplifier fails with "Simplifier ticks exhausted" -------------------------------------+------------------------------------- Reporter: dredozubov | Owner: bgamari Type: bug | Status: merge Priority: high | Milestone: 8.4.1 Component: Compiler | Version: 8.2.1 Resolution: fixed | Keywords: Operating System: Linux | Architecture: x86_64 Type of failure: Compile-time | (amd64) crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by k-bx): Hi. Is there a chance this patch could be included in the 8.2.3 release? We think that our codebase was affected by the bug, we've resolved the issue by applying `-O0` in one of the modules, but it sounds like a rather risky hack to have, and also some other modules from our codebase still go considerably higher in RAM consumption upon compilation. Waiting for 8.4 would be rather unfortunate. Thank you! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 10 14:01:19 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 10 Jan 2018 14:01:19 -0000 Subject: [GHC] #14659: assertions are turned off if -O2 comes after -fno-ignore-asserts Message-ID: <046.9a8733cbe16d0aff2daf6dada8317a21@haskell.org> #14659: assertions are turned off if -O2 comes after -fno-ignore-asserts -------------------------------------+------------------------------------- Reporter: mwotton | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.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: -------------------------------------+------------------------------------- test.hs: {{{#!hs import Control.Exception main = assert False (return ()) }}} ➜ ~ rm test; rm test.o; stack ghc -- -fno-ignore-asserts -O2 test.hs; ./test && echo $? [1 of 1] Compiling Main ( test.hs, test.o ) Linking test ... 0 ➜ ~ rm test; rm test.o; stack ghc -- -O2 -fno-ignore-asserts test.hs; ./test && echo $? [1 of 1] Compiling Main ( test.hs, test.o ) Linking test ... test: Assertion failed CallStack (from HasCallStack): assert, called at test.hs:3:8 in main:Main ``` tested with ghc 8.0.2 and 8.2.2. would have expected -fno-ignore-asserts to override -O2, no matter where it is in the options list. https://twitter.com/AlecMuffett/status/950699975767482370 shows how dangerous this could be. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 10 14:03:17 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 10 Jan 2018 14:03:17 -0000 Subject: [GHC] #14659: assertions are turned off if -O2 comes after -fno-ignore-asserts In-Reply-To: <046.9a8733cbe16d0aff2daf6dada8317a21@haskell.org> References: <046.9a8733cbe16d0aff2daf6dada8317a21@haskell.org> Message-ID: <061.f50440173ebfccc2b913acb55405d4d7@haskell.org> #14659: assertions are turned off if -O2 comes after -fno-ignore-asserts -------------------------------------+------------------------------------- Reporter: mwotton | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Description changed by mwotton: Old description: > test.hs: > > {{{#!hs > import Control.Exception > > main = assert False (return ()) > }}} > > ➜ ~ rm test; rm test.o; stack ghc -- -fno-ignore-asserts -O2 test.hs; > ./test && echo $? > [1 of 1] Compiling Main ( test.hs, test.o ) > Linking test ... > 0 > ➜ ~ rm test; rm test.o; stack ghc -- -O2 -fno-ignore-asserts test.hs; > ./test && echo $? > [1 of 1] Compiling Main ( test.hs, test.o ) > Linking test ... > test: Assertion failed > CallStack (from HasCallStack): > assert, called at test.hs:3:8 in main:Main > ``` > > tested with ghc 8.0.2 and 8.2.2. > > would have expected -fno-ignore-asserts to override -O2, no matter where > it is in the options list. > https://twitter.com/AlecMuffett/status/950699975767482370 shows how > dangerous this could be. New description: test.hs: {{{#!hs import Control.Exception main = assert False (return ()) }}} {{{ ➜ ~ rm test; rm test.o; stack ghc -- -fno-ignore-asserts -O2 test.hs; ./test && echo $? [1 of 1] Compiling Main ( test.hs, test.o ) Linking test ... 0 ➜ ~ rm test; rm test.o; stack ghc -- -O2 -fno-ignore-asserts test.hs; ./test && echo $? [1 of 1] Compiling Main ( test.hs, test.o ) Linking test ... test: Assertion failed CallStack (from HasCallStack): assert, called at test.hs:3:8 in main:Main }}} tested with ghc 8.0.2 and 8.2.2. would have expected -fno-ignore-asserts to override -O2, no matter where it is in the options list. https://twitter.com/AlecMuffett/status/950699975767482370 shows how dangerous this could be. -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 10 15:21:56 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 10 Jan 2018 15:21:56 -0000 Subject: [GHC] #14336: ghci leaks memory In-Reply-To: <051.dbf33557716163bb981beab6790198d1@haskell.org> References: <051.dbf33557716163bb981beab6790198d1@haskell.org> Message-ID: <066.8dac082c6e40ef27381ec21a481de4e6@haskell.org> #14336: ghci leaks memory -------------------------------------+------------------------------------- Reporter: NeilMitchell | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: GHCi | Version: 8.2.1 Resolution: | Keywords: Operating System: Windows | Architecture: x86_64 Type of failure: Runtime | (amd64) performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by mpickering): Doing 1000 iterations with a very big string (approx 20000 chars) results in 47mb max residency with `no_it`. Doing 1000 iterations with a vanilla compiler causes my computer to oom, 100 iterations requires 488mb * 100 - `no_it` 42mb * 100 - vanilla 488mb * 1000 - `no_it` 47mb * 1000 - vanilla oom -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 10 15:28:53 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 10 Jan 2018 15:28:53 -0000 Subject: [GHC] #14658: 'Fix two more bugs in partial signatures' broke T10846 In-Reply-To: <046.d589819107037d6543f2809768319041@haskell.org> References: <046.d589819107037d6543f2809768319041@haskell.org> Message-ID: <061.dadfceb11a79cdf9991ac93ffec80d6e@haskell.org> #14658: 'Fix two more bugs in partial signatures' broke T10846 -------------------------------------+------------------------------------- Reporter: niteria | Owner: simonpj Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Ugh. Validate obviously didn't run that test. Fix validating now. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 10 15:36:59 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 10 Jan 2018 15:36:59 -0000 Subject: [GHC] #14336: ghci leaks memory In-Reply-To: <051.dbf33557716163bb981beab6790198d1@haskell.org> References: <051.dbf33557716163bb981beab6790198d1@haskell.org> Message-ID: <066.fdd02d9aa2c79d674b341453fe9c9211@haskell.org> #14336: ghci leaks memory -------------------------------------+------------------------------------- Reporter: NeilMitchell | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: GHCi | Version: 8.2.1 Resolution: | Keywords: Operating System: Windows | Architecture: x86_64 Type of failure: Runtime | (amd64) performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by cocreature): * cc: cocreature (added) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 10 16:49:09 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 10 Jan 2018 16:49:09 -0000 Subject: [GHC] #14658: 'Fix two more bugs in partial signatures' broke T10846 In-Reply-To: <046.d589819107037d6543f2809768319041@haskell.org> References: <046.d589819107037d6543f2809768319041@haskell.org> Message-ID: <061.b27c37e741f2b9f9e01fcad815d16a27@haskell.org> #14658: 'Fix two more bugs in partial signatures' broke T10846 -------------------------------------+------------------------------------- Reporter: niteria | Owner: simonpj Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Simon Peyton Jones ): In [changeset:"f3f90a079179e085295ee7edd2dda6505799370c/ghc" f3f90a07/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="f3f90a079179e085295ee7edd2dda6505799370c" Fix previous patch This recent patch commit 1577908f2a9db0fcf6f749d40dd75481015f5497 Author: Simon Peyton Jones Date: Tue Jan 9 16:20:46 2018 +0000 Fix two more bugs in partial signatures These were shown up by Trac #14643 failed validation for typecheck/should_run/T10846 (Reported in Trac #14658.) The fix is simple. }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 10 16:49:09 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 10 Jan 2018 16:49:09 -0000 Subject: [GHC] #14643: Partial type signatures in class constraints behave unexpectedly In-Reply-To: <047.6762d95c975e1952f57776fe89e6e2c0@haskell.org> References: <047.6762d95c975e1952f57776fe89e6e2c0@haskell.org> Message-ID: <062.36ee6d4c41e2b0fa238f120c9a552fd8@haskell.org> #14643: Partial type signatures in class constraints behave unexpectedly -------------------------------------+------------------------------------- Reporter: mnislaih | Owner: (none) Type: bug | Status: merge Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: partial- | sigs/should_compile/T14643, T14643a Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Simon Peyton Jones ): In [changeset:"f3f90a079179e085295ee7edd2dda6505799370c/ghc" f3f90a07/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="f3f90a079179e085295ee7edd2dda6505799370c" Fix previous patch This recent patch commit 1577908f2a9db0fcf6f749d40dd75481015f5497 Author: Simon Peyton Jones Date: Tue Jan 9 16:20:46 2018 +0000 Fix two more bugs in partial signatures These were shown up by Trac #14643 failed validation for typecheck/should_run/T10846 (Reported in Trac #14658.) The fix is simple. }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 10 16:50:36 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 10 Jan 2018 16:50:36 -0000 Subject: [GHC] #14658: 'Fix two more bugs in partial signatures' broke T10846 In-Reply-To: <046.d589819107037d6543f2809768319041@haskell.org> References: <046.d589819107037d6543f2809768319041@haskell.org> Message-ID: <061.ea3eec6456a127efa57ee7a8e8abc0c0@haskell.org> #14658: 'Fix two more bugs in partial signatures' broke T10846 -------------------------------------+------------------------------------- Reporter: niteria | Owner: simonpj Type: bug | Status: closed Priority: normal | Milestone: Component: Compiler | Version: Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * status: new => closed * resolution: => fixed Comment: Sorry about that. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 10 16:50:54 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 10 Jan 2018 16:50:54 -0000 Subject: [GHC] #14643: Partial type signatures in class constraints behave unexpectedly In-Reply-To: <047.6762d95c975e1952f57776fe89e6e2c0@haskell.org> References: <047.6762d95c975e1952f57776fe89e6e2c0@haskell.org> Message-ID: <062.3fde937500eed70aaeb36eed9bdc7cfe@haskell.org> #14643: Partial type signatures in class constraints behave unexpectedly -------------------------------------+------------------------------------- Reporter: mnislaih | Owner: (none) Type: bug | Status: merge Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: partial- | sigs/should_compile/T14643, T14643a Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): If you merge, merge both! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 10 17:38:26 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 10 Jan 2018 17:38:26 -0000 Subject: [GHC] #8684: hWaitForInput cannot be interrupted by async exceptions on unix In-Reply-To: <042.bed34cc32ec4222496f7d8b921c80c8a@haskell.org> References: <042.bed34cc32ec4222496f7d8b921c80c8a@haskell.org> Message-ID: <057.59d1a23bde49cb960e3f704eecf2618b@haskell.org> #8684: hWaitForInput cannot be interrupted by async exceptions on unix -------------------------------------+------------------------------------- Reporter: nh2 | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Core Libraries | Version: 7.6.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: 13497, 13525 | Blocking: Related Tickets: #12912, #13525 | Differential Rev(s): Phab:D42 Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonmar): I think the table above is a bit wrong. The relevant bit of code is {{{ #if defined(linux_HOST_OS) && defined(THREADED_RTS) && HAVE_SYS_TIMERFD_H #define USE_PTHREAD_FOR_ITIMER #endif }}} which means we should have (I re-ordered the lines a bit) {{{ - POSIX (method selected in `posix/Itimer.c`) - Linux, threaded, >= 2.6.25 -> pthread with timerfd - Linux, threaded, < 2.6.25 -> timer_create() if it exists, otherwise setitimer() - Linux, non-threaded RTS -> timer_create() if it exists, otherwise setitimer() - Darwin -> pthread without timerfd - iOS -> pthread without timerfd - Windows (`win32/Ticker.c`) - Windows -> CreateTimerQueueTimer() }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 10 19:23:01 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 10 Jan 2018 19:23:01 -0000 Subject: [GHC] #14336: ghci leaks memory In-Reply-To: <051.dbf33557716163bb981beab6790198d1@haskell.org> References: <051.dbf33557716163bb981beab6790198d1@haskell.org> Message-ID: <066.08652045a5a3d559b80b88a9e2ef5922@haskell.org> #14336: ghci leaks memory -------------------------------------+------------------------------------- Reporter: NeilMitchell | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: GHCi | Version: 8.2.1 Resolution: | Keywords: Operating System: Windows | Architecture: x86_64 Type of failure: Runtime | (amd64) performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by mpickering): I put the patch up at https://phabricator.haskell.org/D4299 if anyone wants to try it. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 11 05:00:50 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 11 Jan 2018 05:00:50 -0000 Subject: [GHC] #14660: Improve +RTS -t --machine-readable Message-ID: <043.836b49c779e440e5ecbd0ff4cdeb542d@haskell.org> #14660: Improve +RTS -t --machine-readable -------------------------------------+------------------------------------- Reporter: duog | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Runtime | Version: 8.3 System | 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: -------------------------------------+------------------------------------- The output of +RTS -t --machine-readable is a shown Haskell list, so we can easily add fields. Let's add everything shown by +RTS -s . I've posted a rough patch that does that at Phab:D4303. If this is a good idea, I'd like to also add the following: * a data structure and parsing function to GHC.Stats in base. * The ghc version as a field in the --machine-readable output * The rts ways as a field in the --machine-readable output -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 11 06:37:46 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 11 Jan 2018 06:37:46 -0000 Subject: [GHC] #14626: No need to enter a scrutinised value In-Reply-To: <048.67c951c2aecb97b988badb4816dbe757@haskell.org> References: <048.67c951c2aecb97b988badb4816dbe757@haskell.org> Message-ID: <063.9a2daf998ca239ee9ac7dd347cad2bf6@haskell.org> #14626: No need to enter a scrutinised value -------------------------------------+------------------------------------- Reporter: heisenbug | Owner: heisenbug Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: performance Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #13861 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by heisenbug): Replying to [comment:12 simonpj]: > Once more, I urge you ''not'' to try debugging a stage2 compiler, unless you have a great deal of time on your hands. Instead, compile the libraries and stage2 compiler without the optimisation; and then try the testsuite and nofib. These are small programs and much easier to debug. Yup, I entertained this idea of an assertion for some time, but it looked like too much of a hassle compared to some quick debugging session. Turns out you are right. So I now plant in taggedness assertions (pushed to `wip/T14626` for your reviewing pleasure) for suspicious constellations, and they fire indeed! {{{ * frame #0: 0x000000010a0fcbc8 libHSrts_thr- ghc8.5.20180103.dylib`checkTagged frame #1: 0x000000010073e2c1 libHSghc-8.5-ghc8.5.20180103.dylib`ghc_Name_nzuocc_info [inlined] _cpOv + 17 at Name.hs:111 frame #2: 0x000000010073e2b0 libHSghc-8.5-ghc8.5.20180103.dylib`ghc_Name_nzuocc_info + 72 frame #3: 0x000000010a104fb0 libHSrts_thr- ghc8.5.20180103.dylib`stg_upd_frame_info_dsp + 16 }}} `Name.hs:111` is a strict record field BTW. Does this ring a bell? Why is it `OtherCon _ <- idUnfolding id` but not tagged? Is it possibly implicitly unpacked? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 11 09:00:51 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 11 Jan 2018 09:00:51 -0000 Subject: [GHC] #14626: No need to enter a scrutinised value In-Reply-To: <048.67c951c2aecb97b988badb4816dbe757@haskell.org> References: <048.67c951c2aecb97b988badb4816dbe757@haskell.org> Message-ID: <063.d74262590d493229a11e0edb1e89da1f@haskell.org> #14626: No need to enter a scrutinised value -------------------------------------+------------------------------------- Reporter: heisenbug | Owner: heisenbug Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: performance Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #13861 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): > Name.hs:111 is a strict record field BTW. Does this ring a bell? Why is it OtherCon _ <- idUnfolding id but not tagged? Is it possibly implicitly unpacked? Can you explain more? I can't make sense of this paragraph. What is "it" that might be implicitly unpacked? What does it mean to be "implicitly unpacked" ? One good thing would be to distill a tiny example, and it sounds as if you have enough insight to do that now. E.g. perhaps you are saying that {{{ data T = MkT ![Int] f (MkT xs) = xs }}} returns a badly-tagged pointer? If so, just compile that tiny program and see. etc. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 11 10:09:36 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 11 Jan 2018 10:09:36 -0000 Subject: [GHC] #14626: No need to enter a scrutinised value In-Reply-To: <048.67c951c2aecb97b988badb4816dbe757@haskell.org> References: <048.67c951c2aecb97b988badb4816dbe757@haskell.org> Message-ID: <063.4226b81224325dd0ff93715df337a8b4@haskell.org> #14626: No need to enter a scrutinised value -------------------------------------+------------------------------------- Reporter: heisenbug | Owner: heisenbug Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: performance Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #13861 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by alexbiehl): Indeed GHC seems to unnecessarily enter `MkT`s argument! {{{ ... c1ab: // global R1 = P64[R1 + 7] & (-8); -- load constructor arg -- and untag(!) it Sp = Sp + 8; call (I64[R1])(R1) args: 8, res: 0, upd: 8; -- and enter it! }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 11 10:34:33 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 11 Jan 2018 10:34:33 -0000 Subject: [GHC] #14519: Exponential runtime performance regression in GHC 8.2 + Data.Text.Lazy + Text.RE.TDFA In-Reply-To: <043.92c07e3e0209c31f0a0f195fa98d301c@haskell.org> References: <043.92c07e3e0209c31f0a0f195fa98d301c@haskell.org> Message-ID: <058.56f933d57965515e694fa9a43a5dead0@haskell.org> #14519: Exponential runtime performance regression in GHC 8.2 + Data.Text.Lazy + Text.RE.TDFA -------------------------------------+------------------------------------- Reporter: ntc2 | Owner: tdammers Type: bug | Status: new Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Runtime | Test Case: performance bug | https://github.com/ntc2/ghc-8.2.1 | -regex-lazy-text- | bug/tree/07b7bb32c6e90e8f2d2eada4b59943f37e632d53 Blocked By: | Blocking: Related Tickets: #13745, #14564 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by tdammers): Actually it turns out that I must have done something wrong with my benchmarking; proper testing shows that *all* the examples that start with `^[.^]` (i.e. everything that fails on the first token) runs fast (~20 ms), while everything that matches on the first token at least runs slowly (~30,000 ms). -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 11 10:40:14 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 11 Jan 2018 10:40:14 -0000 Subject: [GHC] #14519: Exponential runtime performance regression in GHC 8.2 + Data.Text.Lazy + Text.RE.TDFA In-Reply-To: <043.92c07e3e0209c31f0a0f195fa98d301c@haskell.org> References: <043.92c07e3e0209c31f0a0f195fa98d301c@haskell.org> Message-ID: <058.11ddd43d7cabacc68588c3dee7ddf903@haskell.org> #14519: Exponential runtime performance regression in GHC 8.2 + Data.Text.Lazy + Text.RE.TDFA -------------------------------------+------------------------------------- Reporter: ntc2 | Owner: tdammers Type: bug | Status: new Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Runtime | Test Case: performance bug | https://github.com/ntc2/ghc-8.2.1 | -regex-lazy-text- | bug/tree/07b7bb32c6e90e8f2d2eada4b59943f37e632d53 Blocked By: | Blocking: Related Tickets: #13745, #14564 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): I would urge you to build the program and libraries with `-ticky` and see which function is getting executed a lot. The advantage of `-ticky` is that it's guaranteed not to affect optimisation or indeed anything. It just logs what happens. Then you'll need a `-ddump-simpl -ddump-stg` of the relevant modules to match up with the ticky logs. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 11 10:43:06 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 11 Jan 2018 10:43:06 -0000 Subject: [GHC] #14626: No need to enter a scrutinised value In-Reply-To: <048.67c951c2aecb97b988badb4816dbe757@haskell.org> References: <048.67c951c2aecb97b988badb4816dbe757@haskell.org> Message-ID: <063.e5e526427f906330d2afe1e4681ca8b6@haskell.org> #14626: No need to enter a scrutinised value -------------------------------------+------------------------------------- Reporter: heisenbug | Owner: heisenbug Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: performance Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #13861 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by heisenbug): Replying to [comment:15 alexbiehl]: > Indeed GHC seems to unnecessarily enter `MkT`s argument! > > {{{ > ... > c1ab: // global > R1 = P64[R1 + 7] & (-8); -- load xs and untag(!) it > Sp = Sp + 8; > call (I64[R1])(R1) args: 8, res: 0, upd: 8; -- and enter it! > }}} Yes, my branch is supposed to fix (soon) many (if not all) of these cases. Simon fixed the lost tracking of ''evaled-ness'' in core-prep already, now I am building on that patch. Which GHC do you use to check? My branch currently won't bootstrap, so you can only do your experiments with `stage1` (or roll your own modifications). -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 11 10:45:00 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 11 Jan 2018 10:45:00 -0000 Subject: [GHC] #14626: No need to enter a scrutinised value In-Reply-To: <048.67c951c2aecb97b988badb4816dbe757@haskell.org> References: <048.67c951c2aecb97b988badb4816dbe757@haskell.org> Message-ID: <063.462330825f9848445a87c841c87e9c4b@haskell.org> #14626: No need to enter a scrutinised value -------------------------------------+------------------------------------- Reporter: heisenbug | Owner: heisenbug Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: performance Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #13861 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Yes, the whole point heisenbug's patch is to return `xs` without entering it. But we we are returning a badly-tagged pointer. If in the above code we return R1, that will be bad. Really we should un-tag it only if/when we enter it. For example if we had {{{ data MkS = MkS ![Int] f (MkT xs) = MkS xs }}} then when we build `MkS xs` we need a correctly tagged xs, not a de-tagged one. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 11 12:37:10 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 11 Jan 2018 12:37:10 -0000 Subject: [GHC] #14519: Exponential runtime performance regression in GHC 8.2 + Data.Text.Lazy + Text.RE.TDFA In-Reply-To: <043.92c07e3e0209c31f0a0f195fa98d301c@haskell.org> References: <043.92c07e3e0209c31f0a0f195fa98d301c@haskell.org> Message-ID: <058.6b66a627505f80857eaaf51454ca4441@haskell.org> #14519: Exponential runtime performance regression in GHC 8.2 + Data.Text.Lazy + Text.RE.TDFA -------------------------------------+------------------------------------- Reporter: ntc2 | Owner: tdammers Type: bug | Status: new Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Runtime | Test Case: performance bug | https://github.com/ntc2/ghc-8.2.1 | -regex-lazy-text- | bug/tree/07b7bb32c6e90e8f2d2eada4b59943f37e632d53 Blocked By: | Blocking: Related Tickets: #13745, #14564 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by tdammers): > I would urge you to build the program and libraries with -ticky and see which function is getting executed a lot. The advantage of -ticky is that it's guaranteed not to affect optimisation or indeed anything. It just logs what happens. That's actually exactly what I'm doing right now. A comparison of running two regular expressions such that one is fast (`^[^.]d`) and the other is slow (`^def`) shows that all the metrics are the same, or nearly the same, except for ALLOC_PRIM_gds (from 669 up to 1801526) and ALLOC_PRIM_ctr (from 371392 up to 9325581456). I should probably dig a bit deeper from here. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 11 12:48:29 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 11 Jan 2018 12:48:29 -0000 Subject: [GHC] #8684: hWaitForInput cannot be interrupted by async exceptions on unix In-Reply-To: <042.bed34cc32ec4222496f7d8b921c80c8a@haskell.org> References: <042.bed34cc32ec4222496f7d8b921c80c8a@haskell.org> Message-ID: <057.3f9e3edb98a244f964d4e5c05d730b8e@haskell.org> #8684: hWaitForInput cannot be interrupted by async exceptions on unix -------------------------------------+------------------------------------- Reporter: nh2 | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Core Libraries | Version: 7.6.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: 13497, 13525 | Blocking: Related Tickets: #12912, #13525 | Differential Rev(s): Phab:D42 Wiki Page: | -------------------------------------+------------------------------------- Comment (by nh2): @simonmar Oops, you are right. I swapped `threaded` and `non-threaded` when typing down my table, thus writing we use pthreads in non-threaded, which is exactly the wrong way around. I'll edit to reflect that. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 11 12:58:56 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 11 Jan 2018 12:58:56 -0000 Subject: [GHC] #14660: Improve +RTS -t --machine-readable In-Reply-To: <043.836b49c779e440e5ecbd0ff4cdeb542d@haskell.org> References: <043.836b49c779e440e5ecbd0ff4cdeb542d@haskell.org> Message-ID: <058.6fb2131a8c0e309108d42cbc5922e089@haskell.org> #14660: Improve +RTS -t --machine-readable -------------------------------------+------------------------------------- Reporter: duog | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Runtime System | Version: 8.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by mpickering): It could just be output as a JSON record rather than relying on having to use Haskell tooling to parse it. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 11 13:23:55 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 11 Jan 2018 13:23:55 -0000 Subject: [GHC] #14519: Exponential runtime performance regression in GHC 8.2 + Data.Text.Lazy + Text.RE.TDFA In-Reply-To: <043.92c07e3e0209c31f0a0f195fa98d301c@haskell.org> References: <043.92c07e3e0209c31f0a0f195fa98d301c@haskell.org> Message-ID: <058.c7351747d7c21d1849b18e072fd8b550@haskell.org> #14519: Exponential runtime performance regression in GHC 8.2 + Data.Text.Lazy + Text.RE.TDFA -------------------------------------+------------------------------------- Reporter: ntc2 | Owner: tdammers Type: bug | Status: new Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Runtime | Test Case: performance bug | https://github.com/ntc2/ghc-8.2.1 | -regex-lazy-text- | bug/tree/07b7bb32c6e90e8f2d2eada4b59943f37e632d53 Blocked By: | Blocking: Related Tickets: #13745, #14564 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Interesting. I was thinking of this part of the ticky file {{{ Entries Alloc Alloc'd Non-void Arguments STG Name -------------------------------------------------------------------------------- 1800047 78722320 0 1 L p_term{v raIX} (main:Main) (fun) 2160065 50401232 0 2 >L base:GHC.List.takeWhile{v rcW} (fun) 1509183 43941968 0 2 LL base:GHC.Base.++{v 03} (fun) 1086514 43446320 0 2 LL base:GHC.List.zip{v 0x} (fun) 1088129 37257616 0 2 >L base:GHC.Base.map{v 01X} (fun) 480015 24961008 0 1 L p2{v raIU} (main:Main) (fun) 240001 19200080 0 2 ML $w$j{v raIV} (main:Main) (fun,se) 665502 17440560 0 2 iL go1{v raJb} (main:Main) (fun) 545117 17421624 0 1 M subterms{v r1ki} (main:Main) (fun) 723688 15430288 0 3 LMM $wmatch'{v raJ5} (main:Main) (fun) 662950 15428096 0 3 MML $sfind'{v raIM} (main:Main) (fun) 363373 12627992 0 1 L go11{v saSX} (main:Main) (fun) in raJb 487124 11666944 0 3 >>M expr_fold{v r1jH} (main:Main) (fun) 1267348 11605760 0 2 LM find'{v raIN} (main:Main) (fun) }}} Usually when something exponential is going on you get some very bug numbers at the top. (You may need to sort first.) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 11 15:35:56 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 11 Jan 2018 15:35:56 -0000 Subject: [GHC] #14519: Exponential runtime performance regression in GHC 8.2 + Data.Text.Lazy + Text.RE.TDFA In-Reply-To: <043.92c07e3e0209c31f0a0f195fa98d301c@haskell.org> References: <043.92c07e3e0209c31f0a0f195fa98d301c@haskell.org> Message-ID: <058.75c108b8248b5a07c2ff04ae8ca8add7@haskell.org> #14519: Exponential runtime performance regression in GHC 8.2 + Data.Text.Lazy + Text.RE.TDFA -------------------------------------+------------------------------------- Reporter: ntc2 | Owner: tdammers Type: bug | Status: new Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Runtime | Test Case: performance bug | https://github.com/ntc2/ghc-8.2.1 | -regex-lazy-text- | bug/tree/07b7bb32c6e90e8f2d2eada4b59943f37e632d53 Blocked By: | Blocking: Related Tickets: #13745, #14564 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by tdammers): Correct, but that's why I needed to dig deeper - ticky-ing only the module itself didn't reveal anything, but compiling a bunch of dependencies with -ticky as well gives me this line: {{{ 2250377760180010799840 0 2 Mi $wnext2{v reC2} (regex-tdfa- text-1.0.0.3-CIfFZ6rjdCoJI5EFpqTwBO:Text.Regex.TDFA.Text.Lazy) (fun) }}} (note that it actually overflows the `Alloc` field, so that's two large numbers concatenated together there) I can't seem to find `wnext2` anywhere in the dumps though, which is a bit strange. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 11 15:50:52 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 11 Jan 2018 15:50:52 -0000 Subject: [GHC] #14661: Cannot derive (newtype I a b = I (F a -> F b) deriving newtype Category) for type family F Message-ID: <051.db51abc527e2395586903121a4d671be@haskell.org> #14661: Cannot derive (newtype I a b = I (F a -> F b) deriving newtype Category) for type family F -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.4.1-alpha1 Keywords: | Operating System: Unknown/Multiple DerivingStrategies, deriving, | TypeFamilies | Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- This works fine {{{#!hs {-# Language PolyKinds #-} {-# Language GADTs #-} {-# Language GeneralizedNewtypeDeriving #-} {-# Language InstanceSigs #-} {-# Language RankNTypes #-} {-# Language ScopedTypeVariables #-} {-# Language StandaloneDeriving #-} {-# Language TypeApplications #-} {-# Language DataKinds #-} {-# Language DerivingStrategies #-} {-# Language TypeFamilies #-} import Data.Kind import Control.Category import Prelude hiding (id, (.)) import Data.Coerce data TY = TI | TB type family Interp ty where Interp TI = Int Interp TB = Bool newtype Ixed :: TY -> TY -> Type where Ixed :: (Interp ix -> Interp ix') -> (Ixed ix ix') -- deriving newtype Category instance Category Ixed where id :: forall a. Ixed a a id = coerce (id @(->) @(Interp a)) (.) :: forall b c a. Ixed b c -> Ixed a b -> Ixed a c (.) = coerce ((.) @(->) @(Interp b) @(Interp c) @(Interp a)) }}} This instance can **not** be derived using `newtype` deriving. Commenting the `Category`-instance out and uncommenting `deriving newtype Category` results in an error {{{ $ ghci2 -ignore-dot-ghci hs/164-trac.hs GHCi, version 8.5.20180105: http://www.haskell.org/ghc/ :? for help [1 of 1] Compiling Main ( hs/164-trac.hs, interpreted ) hs/164-trac.hs:28:20: error: • Can't make a derived instance of ‘Category Ixed’ with the newtype strategy: cannot eta-reduce the representation type enough • In the newtype declaration for ‘Ixed’ | 28 | deriving newtype Category | ^^^^^^^^ Failed, no modules loaded. Prelude> }}} I may have asked this before, but can we make GHC smart enough to derive this instance? It consists entirely of the right visible type application of `method`: `method = coerce (method @a @b @..)` -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 11 16:06:30 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 11 Jan 2018 16:06:30 -0000 Subject: [GHC] #14519: Exponential runtime performance regression in GHC 8.2 + Data.Text.Lazy + Text.RE.TDFA In-Reply-To: <043.92c07e3e0209c31f0a0f195fa98d301c@haskell.org> References: <043.92c07e3e0209c31f0a0f195fa98d301c@haskell.org> Message-ID: <058.c9239517e622bdd0b7ef94ed9b7eeeea@haskell.org> #14519: Exponential runtime performance regression in GHC 8.2 + Data.Text.Lazy + Text.RE.TDFA -------------------------------------+------------------------------------- Reporter: ntc2 | Owner: tdammers Type: bug | Status: new Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Runtime | Test Case: performance bug | https://github.com/ntc2/ghc-8.2.1 | -regex-lazy-text- | bug/tree/07b7bb32c6e90e8f2d2eada4b59943f37e632d53 Blocked By: | Blocking: Related Tickets: #13745, #14564 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Compile `Text.Regex.TDFA.Text.Lazy` with `-ddump-simpl -ddump-stg -ticky`. I'd be surprised if `$wnext2{v reC2}` doesn't show up. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 11 16:28:20 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 11 Jan 2018 16:28:20 -0000 Subject: [GHC] #14519: Exponential runtime performance regression in GHC 8.2 + Data.Text.Lazy + Text.RE.TDFA In-Reply-To: <043.92c07e3e0209c31f0a0f195fa98d301c@haskell.org> References: <043.92c07e3e0209c31f0a0f195fa98d301c@haskell.org> Message-ID: <058.8bf64a4eebbffcbbadf3b8bc5a88a98c@haskell.org> #14519: Exponential runtime performance regression in GHC 8.2 + Data.Text.Lazy + Text.RE.TDFA -------------------------------------+------------------------------------- Reporter: ntc2 | Owner: tdammers Type: bug | Status: new Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Runtime | Test Case: performance bug | https://github.com/ntc2/ghc-8.2.1 | -regex-lazy-text- | bug/tree/07b7bb32c6e90e8f2d2eada4b59943f37e632d53 Blocked By: | Blocking: Related Tickets: #13745, #14564 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by tdammers): That's what I thought I was doing, but apparently I fat-fingered a cabal command. Recompiling as we speak, will report back. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 11 16:59:32 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 11 Jan 2018 16:59:32 -0000 Subject: [GHC] #13253: Exponential compilation time with RWST & ReaderT stack with `-02` In-Reply-To: <045.b3c468c50b4e8e33ee0981a3ab0c6b4b@haskell.org> References: <045.b3c468c50b4e8e33ee0981a3ab0c6b4b@haskell.org> Message-ID: <060.bfb5a2f65d91701f74030f3506c02b4b@haskell.org> #13253: Exponential compilation time with RWST & ReaderT stack with `-02` -------------------------------------+------------------------------------- Reporter: phadej | Owner: dfeuer Type: bug | Status: new Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.0.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): > The code duplication alluded to in comment:12 is a result of the special case in rebuildCall for a strict argument. Can you elaborate on how that special case duplicates code? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 11 17:05:11 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 11 Jan 2018 17:05:11 -0000 Subject: [GHC] #13253: Exponential compilation time with RWST & ReaderT stack with `-02` In-Reply-To: <045.b3c468c50b4e8e33ee0981a3ab0c6b4b@haskell.org> References: <045.b3c468c50b4e8e33ee0981a3ab0c6b4b@haskell.org> Message-ID: <060.18836f2f22558e99e9c5a5538c54a329@haskell.org> #13253: Exponential compilation time with RWST & ReaderT stack with `-02` -------------------------------------+------------------------------------- Reporter: phadej | Owner: dfeuer Type: bug | Status: new Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.0.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by mpickering): I think it is explained in `Note [Duplicating StrictArg]`? I did confirm this by commenting out the case and observing that the program compiled in a reasonable amount of time. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 11 17:13:48 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 11 Jan 2018 17:13:48 -0000 Subject: [GHC] #13253: Exponential compilation time with RWST & ReaderT stack with `-02` In-Reply-To: <045.b3c468c50b4e8e33ee0981a3ab0c6b4b@haskell.org> References: <045.b3c468c50b4e8e33ee0981a3ab0c6b4b@haskell.org> Message-ID: <060.0e2f446adb0d009734bd4ca3a3c95e31@haskell.org> #13253: Exponential compilation time with RWST & ReaderT stack with `-02` -------------------------------------+------------------------------------- Reporter: phadej | Owner: dfeuer Type: bug | Status: new Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.0.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Whoa! That comment says {{{ We make a StrictArg duplicable simply by making all its stored-up arguments (in sc_fun) trivial, by let-binding them. Thus: f E [..hole..] ==> let a = E in f a [..hole..] }}} So the `f a` is duplicated. For example we'll transform {{{ f E (case x of True -> e1 False -> e2) ----> let a = E in case x of True -> f a e1 False -> f a e2 }}} I see no code duplication except of the `f a`, which is by-design. But that's pretty modest. Can you explain more? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 11 17:32:38 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 11 Jan 2018 17:32:38 -0000 Subject: [GHC] #14331: Overzealous free-floating kind check causes deriving clause to be rejected In-Reply-To: <050.cb87f2a10e38fd0ac57d92b074ac5d5b@haskell.org> References: <050.cb87f2a10e38fd0ac57d92b074ac5d5b@haskell.org> Message-ID: <065.745eb3d2d036d0235c5fa8714312412d@haskell.org> #14331: Overzealous free-floating kind check causes deriving clause to be rejected -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.4.1 Component: Compiler (Type | Version: 8.2.1 checker) | Resolution: | Keywords: deriving Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: GHC rejects | Test Case: valid program | deriving/should_compile/T14331 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by goldfire): What do we think of {{{#!hs class Cat k (cat :: k -> k -> *) where catId :: cat a a catComp :: cat b c -> cat a b -> cat a c instance Cat * (->) where catId = id catComp = (.) newtype Fun1 a b = Fun1 (a -> b) deriving (Cat k) }}} This is currently accepted and in the testsuite as `deriving/should_compile/T11732c`. I think this should fail, because it requires unifying `k` with `Type`. There is useful commentary in #11732. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 11 17:43:54 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 11 Jan 2018 17:43:54 -0000 Subject: [GHC] #14661: Cannot derive (newtype I a b = I (F a -> F b) deriving newtype Category) for type family F In-Reply-To: <051.db51abc527e2395586903121a4d671be@haskell.org> References: <051.db51abc527e2395586903121a4d671be@haskell.org> Message-ID: <066.11c5e7f3af808972c35b1504810c2b68@haskell.org> #14661: Cannot derive (newtype I a b = I (F a -> F b) deriving newtype Category) for type family F -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.4.1-alpha1 Resolution: | Keywords: | DerivingStrategies, deriving, | TypeFamilies Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Interesting. The type family is a red herring. Same thing happens with `data Interp a = I`. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 11 17:44:49 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 11 Jan 2018 17:44:49 -0000 Subject: [GHC] #13253: Exponential compilation time with RWST & ReaderT stack with `-02` In-Reply-To: <045.b3c468c50b4e8e33ee0981a3ab0c6b4b@haskell.org> References: <045.b3c468c50b4e8e33ee0981a3ab0c6b4b@haskell.org> Message-ID: <060.c53e48d640356d9f46bfbae568619725@haskell.org> #13253: Exponential compilation time with RWST & ReaderT stack with `-02` -------------------------------------+------------------------------------- Reporter: phadej | Owner: dfeuer Type: bug | Status: new Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.0.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by mpickering): I think this is what happens but I've sinced paged out the details. We start with `((FormSuccess f <*> x0) <*> x1)` You have {{{ ((FormSuccess f <*> x0) <*> x1) <*> x2 => ((<*>) (FormSuccess f) x0) <*> x1 <*> x2 => (Inline (<*>)) (case x0 of { FormMissing -> FormMissing; FormFailure errs_a2dS -> FormFailure errs_a2dS; FormSuccess a_a2dU -> FormSuccess ...; }) <*> x1 <*> x2 => (prefixify) ((<*>) (case x0 of { FormMissing -> FormMissing; FormFailure errs_a2dS -> FormFailure errs_a2dS; FormSuccess a_a2dU -> FormSuccess ...; }) x1) <*> x2 => (StrictArg) (case x0 of { FormMissing -> (<*>) FormMissing x1; FormFailure errs_a2dS -> (<*>) (FormFailure errs_a2dS) x1; FormSuccess a_a2dU -> (<*>) (FormSuccess ...) x1 ; }) <*> x2 => (Inline) (case x0 of { FormMissing -> (case x1...) FormFailure errs_a2dS -> case x1.... FormSuccess a_a2dU -> case x1... ; }) <*> x2 => (Strict arg for x2) (case x0 of { FormMissing -> (<*>) (case x1...) x2; FormFailure errs_a2dS -> (<*>) (case x1...) x2; FormSuccess a_a2dU -> (<*>) (case x1...) x2 ; }) => (Strict arg fires again pushing the <*> into the inner cases and now we have 9 copies of (<*>). }}} Does that sound plausible? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 11 17:45:00 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 11 Jan 2018 17:45:00 -0000 Subject: [GHC] #14331: Overzealous free-floating kind check causes deriving clause to be rejected In-Reply-To: <050.cb87f2a10e38fd0ac57d92b074ac5d5b@haskell.org> References: <050.cb87f2a10e38fd0ac57d92b074ac5d5b@haskell.org> Message-ID: <065.f05eddb0374c7fbb42402576b11e6bf0@haskell.org> #14331: Overzealous free-floating kind check causes deriving clause to be rejected -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.4.1 Component: Compiler (Type | Version: 8.2.1 checker) | Resolution: | Keywords: deriving Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: GHC rejects | Test Case: valid program | deriving/should_compile/T14331 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): I assume we're treating the `k` in `deriving (Cat k)` and the `k` in `deriving (forall k. Cat k)` the same? If so, then yes, this program should fail. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 11 17:48:47 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 11 Jan 2018 17:48:47 -0000 Subject: [GHC] #14660: Improve +RTS -t --machine-readable In-Reply-To: <043.836b49c779e440e5ecbd0ff4cdeb542d@haskell.org> References: <043.836b49c779e440e5ecbd0ff4cdeb542d@haskell.org> Message-ID: <058.0b6ca487aeeacad0143952b99e84252e@haskell.org> #14660: Improve +RTS -t --machine-readable -------------------------------------+------------------------------------- Reporter: duog | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Runtime System | Version: 8.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by duog): Using a JSON record would break existing tooling, which is a little on the nose since this output has been documented as being forwards compatible. It would be good to have a nice structured record for the per-generations stats though. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 11 18:16:51 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 11 Jan 2018 18:16:51 -0000 Subject: [GHC] #14660: Improve +RTS -t --machine-readable In-Reply-To: <043.836b49c779e440e5ecbd0ff4cdeb542d@haskell.org> References: <043.836b49c779e440e5ecbd0ff4cdeb542d@haskell.org> Message-ID: <058.72e00c4a6c98198c8a1e9e2d058d63bc@haskell.org> #14660: Improve +RTS -t --machine-readable -------------------------------------+------------------------------------- Reporter: duog | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Runtime System | Version: 8.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4303 Wiki Page: | -------------------------------------+------------------------------------- Changes (by duog): * differential: => Phab:D4303 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 11 18:17:53 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 11 Jan 2018 18:17:53 -0000 Subject: [GHC] #14626: No need to enter a scrutinised value In-Reply-To: <048.67c951c2aecb97b988badb4816dbe757@haskell.org> References: <048.67c951c2aecb97b988badb4816dbe757@haskell.org> Message-ID: <063.f0a7b539eb613c7bd0b715902705f7d4@haskell.org> #14626: No need to enter a scrutinised value -------------------------------------+------------------------------------- Reporter: heisenbug | Owner: heisenbug Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: performance Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #13861 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by heisenbug): Replying to [comment:14 simonpj]: > > Name.hs:111 is a strict record field BTW. Does this ring a bell? Why is it OtherCon _ <- idUnfolding id but not tagged? Is it possibly implicitly unpacked? > > Can you explain more? I can't make sense of this paragraph. What is "it" that might be implicitly unpacked? What does it mean to be "implicitly unpacked" ? No, this is a red herring. Just me, desperately looking for hints. The `n_occ` is not unpacked. But I have a theory now. I set a few breakpoints: {{{ (gdb) info breakpoints Num Type Disp Enb Address What 8 breakpoint keep n 0x00007ffff52e39e0 in ghc_Name_nzuocC_info at compiler/basicTypes/Name.hs:111 breakpoint already hit 1 time 11 breakpoint keep y 0x00007ffff52e3a18 in ghc_Name_nzuocC_info at compiler/basicTypes/Name.hs:111 breakpoint already hit 46 times 12 breakpoint keep y 0x00007ffff2332a58 breakpoint already hit 1 time }}} ''bp11'' is set as `breakpoint *ghc_Name_nzuocC_info+56` ''bp11'' is the continuation of ''bp8'' which is jumped at when the `Name` is in WHNF. Then the `n_occ` field is being extracted. It turns out that ''bp11'' needs to be hit '''46 times''' in order to find it untagged! Then I looked into why it is untagged at all. Here is a transcript from `gdb` `0x420006f4a9` is the (tagged) `Name`: {{{ (gdb) x/x 0x420006f4a9-1 0x420006f4a8: 0xf52ece08 (gdb) x/x 0x420006f4a9+7 0x420006f4b0: 0x0006f451 (gdb) x/x 0x420006f4a9+15 0x420006f4b8: 0x000662a0 (gdb) x/x 0x420006f4a9+19 0x420006f4bc: 0x00000042 ### the `n_occ` field is 0x42000662a0 (gdb) x/x 0x420006f4a9+23 0x420006f4c0: 0xf74a17e8 (gdb) x/x 0x420006f4a9+31 0x420006f4c8: 0x00001818 }}} Then I follow the closure pointer of the `OccName`: {{{ (gdb) x/2x 0x42000662a0 0x42000662a0: 0xf2335878 0x00007fff (gdb) x/x 0x00007ffff2335878 0x7ffff2335878 : 0x08438b48 }}} Ooops! How can a strict field point to a '''BLACKHOLE'''? So this is my findings. Are strict fields able to hold blackholes? And if so, why do they carry an ''isEvaldUnfolding` when pattern matched against? Any hints appreciated! > > One good thing would be to distill a tiny example, and it sounds as if you have enough insight to do that now. E.g. perhaps you are saying that > {{{ > data T = MkT ![Int] > f (MkT xs) = xs > }}} > returns a badly-tagged pointer? If so, just compile that tiny program and see. etc. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 11 19:14:42 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 11 Jan 2018 19:14:42 -0000 Subject: [GHC] #14331: Overzealous free-floating kind check causes deriving clause to be rejected In-Reply-To: <050.cb87f2a10e38fd0ac57d92b074ac5d5b@haskell.org> References: <050.cb87f2a10e38fd0ac57d92b074ac5d5b@haskell.org> Message-ID: <065.08087faf678d8a111dc87ff45a14a62e@haskell.org> #14331: Overzealous free-floating kind check causes deriving clause to be rejected -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.4.1 Component: Compiler (Type | Version: 8.2.1 checker) | Resolution: | Keywords: deriving Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: GHC rejects | Test Case: valid program | deriving/should_compile/T14331 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Iceland_jack): Intuition: I would expect to have to write `deriving (Cat Type)`. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 11 19:17:00 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 11 Jan 2018 19:17:00 -0000 Subject: [GHC] #14661: Cannot derive (newtype I a b = I (F a -> F b) deriving newtype Category) for type family F In-Reply-To: <051.db51abc527e2395586903121a4d671be@haskell.org> References: <051.db51abc527e2395586903121a4d671be@haskell.org> Message-ID: <066.3590b94eade87d22ea2246c484f42ec3@haskell.org> #14661: Cannot derive (newtype I a b = I (F a -> F b) deriving newtype Category) for type family F -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.4.1-alpha1 Resolution: | Keywords: | DerivingStrategies, deriving, | TypeFamilies Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): Replying to [comment:1 simonpj]: > Same thing happens with `data Interp a = I`. Well sure—you can't use `GeneralizedNewtypeDeriving` on a non-newtype. I agree that the type family is a red herring, though. Let's look at a slightly simpler example: {{{#!hs {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} import Control.Category data Bar a newtype Foo a b = MkFoo (Bar a -> Bar b) deriving newtype Category }}} {{{ • Can't make a derived instance of ‘Category Foo’ with the newtype strategy: cannot eta-reduce the representation type enough • In the newtype declaration for ‘Foo’ | 9 | deriving newtype Category | ^^^^^^^^ }}} Why is this happening? As per the [https://downloads.haskell.org/~ghc/8.2.2/docs/html/users_guide/glasgow_exts.html?highlight=generalizednewtypederiving#a -more-precise-specification specification] of `GeneralizedNewtypeDeriving` in the users' guide, GHC must be able to eta-convert `Foo`'s underlying representation type (i.e., `Bar a -> Bar b`) in order to generate a context. But you cannot eta-reduce the type variables `a` and `b` from `Bar a -> Bar b`, try as you might. ----- Returning to your original example, you claim that the instance you hand- wrote "consists entirely of the right visible type application of `method: method = coerce (method @a @b @..)`", but this isn't true. Look at your `id` implementation, for instance: {{{#!hs id :: forall a. Ixed a a id = coerce (id @(->) @(Interp a)) }}} This is a good deal more clever than what `GeneralizedNewtypeDeriving` currently does. GND would try to coerce from `id :: forall a. Ixed a a` to `id :: forall a. ??? a a`, where `???` is the eta-reduced representation type (that we were unable to obtain, as explained previously). But your implementation tunnels down through `(->)` and exploits the fact that `Interp` happens to be present on both sides of the arrow. This insider knowledge would not be particularly simple to teach GHC—for instance, what happens if you chance `Ixed` to be of type `(Interp ix -> Maybe (Interp ix') -> (Ixed ix ix')`? Moreover, the kinds of tricks that would work for `Category`/`(->)` would likely not be applicable for other type class/type constructor combinations. '''tl;dr''' I claim this is not a bug, but rather a misunderstanding of how `GeneralizedNewtypeDeriving` works. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 11 19:28:17 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 11 Jan 2018 19:28:17 -0000 Subject: [GHC] #14331: Overzealous free-floating kind check causes deriving clause to be rejected In-Reply-To: <050.cb87f2a10e38fd0ac57d92b074ac5d5b@haskell.org> References: <050.cb87f2a10e38fd0ac57d92b074ac5d5b@haskell.org> Message-ID: <065.85935292c118a5dc3b1528f43195f0ee@haskell.org> #14331: Overzealous free-floating kind check causes deriving clause to be rejected -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.4.1 Component: Compiler (Type | Version: 8.2.1 checker) | Resolution: | Keywords: deriving Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: GHC rejects | Test Case: valid program | deriving/should_compile/T14331 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by goldfire): I agree wholeheartedly with comment:52 and comment:53, but this is at odds with what we (the same we!) concluded in #11732. I'm OK with a change of mind here, but I just want to call this out as different than what we thought previously. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 11 19:34:33 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 11 Jan 2018 19:34:33 -0000 Subject: [GHC] #14331: Overzealous free-floating kind check causes deriving clause to be rejected In-Reply-To: <050.cb87f2a10e38fd0ac57d92b074ac5d5b@haskell.org> References: <050.cb87f2a10e38fd0ac57d92b074ac5d5b@haskell.org> Message-ID: <065.18772a1abddcecea3f93d4d082b7ac71@haskell.org> #14331: Overzealous free-floating kind check causes deriving clause to be rejected -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.4.1 Component: Compiler (Type | Version: 8.2.1 checker) | Resolution: | Keywords: deriving Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: GHC rejects | Test Case: valid program | deriving/should_compile/T14331 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): I'm not sure how this is at odds? The example from #11732 is: {{{#!hs data Proxy k (a :: k) = ProxyCon deriving Generic1 }}} Here, we are unifying a kind variable //from the datatype// with `Type`, which is acceptable, instead of a kind variable from the class (as is the case in comment:51), which should be an error. Or am I missing something? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 11 19:55:34 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 11 Jan 2018 19:55:34 -0000 Subject: [GHC] #14661: Cannot derive (newtype I a b = I (F a -> F b) deriving newtype Category) for type family F In-Reply-To: <051.db51abc527e2395586903121a4d671be@haskell.org> References: <051.db51abc527e2395586903121a4d671be@haskell.org> Message-ID: <066.725f68c74e7a8588526f40c9d7b89867@haskell.org> #14661: Cannot derive (newtype I a b = I (F a -> F b) deriving newtype Category) for type family F -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.4.1-alpha1 Resolution: | Keywords: | DerivingStrategies, deriving, | TypeFamilies Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by Iceland_jack): * type: bug => feature request Comment: Changed it to a feature request. This is actually a new deriving strategy. A second derivation for the same thing: I am able to mechanically write type constructors like this (clever / insider knowledge? I don't think so) and it compiles: {{{#!hs instance Category Ixed where id = Ixed id Ixed f . Ixed g = Ixed (f . g) }}} With this derivation your other example `newtype Ixed ix ix' = Ixed (Interp ix -> Maybe (Interp ix'))` does not compile. I am experimenting with categories over type families / data types and the above instance is boilerplate. This space may be too limited to be worth it, maybe someone else has useful examples of a different character. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 11 20:04:30 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 11 Jan 2018 20:04:30 -0000 Subject: [GHC] #14661: Cannot derive (newtype I a b = I (F a -> F b) deriving newtype Category) for type family F In-Reply-To: <051.db51abc527e2395586903121a4d671be@haskell.org> References: <051.db51abc527e2395586903121a4d671be@haskell.org> Message-ID: <066.41cef753856f58d93d56459126a6e387@haskell.org> #14661: Cannot derive (newtype I a b = I (F a -> F b) deriving newtype Category) for type family F -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.4.1-alpha1 Resolution: | Keywords: | DerivingStrategies, deriving, | TypeFamilies Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Iceland_jack): Similar example from Conal's [http://conal.net/papers/compiling-to- categories/compiling-to-categories.pdf Compiling to Categories], **7.6 Incremental Computation** {{{#!hs class HasDelta a where type Delta a :: Type newtype DelX a b = DelX (Delta a -> Delta b) instance Category DelX where type Ok DelX = HasDelta id = DelX id DelX g . DelX f = DelX (g . f) instance Cartesian DelX where exl = DelX exl exr = DelX exr DelX f &&& DelX g = DelX (f &&& g) }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 11 20:35:23 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 11 Jan 2018 20:35:23 -0000 Subject: [GHC] #14661: Cannot derive (newtype I a b = I (F a -> F b) deriving newtype Category) for type family F In-Reply-To: <051.db51abc527e2395586903121a4d671be@haskell.org> References: <051.db51abc527e2395586903121a4d671be@haskell.org> Message-ID: <066.d78f789107d384a65b2bcba038dcbd2a@haskell.org> #14661: Cannot derive (newtype I a b = I (F a -> F b) deriving newtype Category) for type family F -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.4.1-alpha1 Resolution: | Keywords: | DerivingStrategies, deriving, | TypeFamilies Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Iceland_jack): This can be derived (clunkily) with GND + `singletons` {{{#!hs import Data.Singletons type Cat ob = ob -> ob -> Type newtype WRAP :: (k' ~> k) -> (Cat k -> Cat k) where WRAP :: cat (f@@a) (f@@b) -> WRAP f cat a b instance Category cat => Category (WRAP f cat) where id :: forall a. WRAP f cat a a id = WRAP (id @cat @(f@@a)) (.) :: forall b c a. WRAP f cat b c -> WRAP f cat a b -> WRAP f cat a c WRAP f . WRAP g = WRAP ((.) @cat @(f@@b) @(f@@c) @(f@@a) f g) data InterpSym0 :: TY ~> Type type instance InterpSym0 @@ ty = Interp ty }}} + {{{#!hs newtype Ixed a b = Ixed (WRAP InterpSym0 (->) a b) deriving newtype Category }}} or with `-XDerivingVia` {{{#!hs newtype Ixed a b = Ixed (Interp a -> Interp b) deriving Category via (WRAP InterpSym0 (->) a b) }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 11 21:07:18 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 11 Jan 2018 21:07:18 -0000 Subject: [GHC] #14626: No need to enter a scrutinised value In-Reply-To: <048.67c951c2aecb97b988badb4816dbe757@haskell.org> References: <048.67c951c2aecb97b988badb4816dbe757@haskell.org> Message-ID: <063.08e1eeb6273fd0ba2029cc889a466ed0@haskell.org> #14626: No need to enter a scrutinised value -------------------------------------+------------------------------------- Reporter: heisenbug | Owner: heisenbug Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: performance Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #13861 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by heisenbug): Replying to [comment:18 heisenbug]: > [snippety] > > So this is my findings. Are strict fields able to hold blackholes? > And if so, why do they carry an `isEvaldUnfolding` when pattern matched against? > > Any hints appreciated! Do I have a (black)hole in my reasoning? > Following up my own question... I had luck and could set a few watchpoints in `lldb`, with the fourth one capturing the history of the `OccName`'s closure. I'll leave it here for the reference... {{{ Watchpoint 4 hit: new value: 4313987056 Process 2009 stopped * thread #1: tid = 0xa7e8d1, 0x0000000101223ddd libHSghc-8.5-ghc8.5.20180103.dylib`sxWx_info [inlined] _cA5r + 12 at BinIface.hs:149, queue = 'com.apple.main-thread', stop reason = watchpoint 4 frame #0: 0x0000000101223ddd libHSghc-8.5-ghc8.5.20180103.dylib`sxWx_info [inlined] _cA5r + 12 at BinIface.hs:149 146 147 -- Initialise the user-data field of bh 148 bh <- do -> 149 bh <- return $ setUserData bh $ newReadState (error "getSymtabName") 150 (getDictFastString dict) 151 symtab_p <- Binary.get bh -- Get the symtab ptr 152 data_p <- tellBin bh -- Remember where we are now }}} This is presumably when the `OccName` got allocated on the heap. The next change happened here: {{{ Watchpoint 4 hit: old value: 4313987056 new value: 4463800616 Process 2009 stopped * thread #1: tid = 0xa7e8d1, 0x000000010a104fc2 libHSrts_thr- ghc8.5.20180103.dylib`stg_upd_frame_info + 18, queue = 'com.apple.main- thread', stop reason = watchpoint 4 frame #0: 0x000000010a104fc2 libHSrts_thr- ghc8.5.20180103.dylib`stg_upd_frame_info + 18 libHSrts_thr-ghc8.5.20180103.dylib`stg_upd_frame_info: -> 0x10a104fc2 <+18>: movq %rax, %rcx 0x10a104fc5 <+21>: andq $-0x100000, %rcx 0x10a104fcc <+28>: movq %rax, %rdx 0x10a104fcf <+31>: andl $0xff000, %edx }}} Let's disassemble the change: {{{ (lldb) disassemble -s 4313987056 libHSghc-8.5-ghc8.5.20180103.dylib`sxXT_info: 0x1012237f0 <+0>: leaq -0x18(%rbp), %rax 0x1012237f4 <+4>: cmpq %r15, %rax 0x1012237f7 <+7>: jb 0x10122388c ; <+156> [inlined] _cA3D 0x1012237fd <+13>: movq 0x1d6b6fc(%rip), %rax ; (void *)0x000000010a104fb0: stg_upd_frame_info 0x101223804 <+20>: movq %rax, -0x10(%rbp) 0x101223808 <+24>: movq %rbx, -0x8(%rbp) }}} This gets overwritten with a BLACKHOLE: {{{ (lldb) disassemble -s 4463800616 libHSrts_thr-ghc8.5.20180103.dylib`stg_BLACKHOLE_info: 0x10a103128 <+0>: movq 0x8(%rbx), %rax 0x10a10312c <+4>: testb $0x7, %al 0x10a10312e <+6>: jne 0x10a103230 ; <+264> 0x10a103134 <+12>: movq (%rax), %rcx 0x10a103137 <+15>: cmpq 0x190c2(%rip), %rcx ; (void *)0x000000010a1030c8: stg_IND_info 0x10a10313e <+22>: je 0x10a103128 ; <+0> 0x10a103140 <+24>: cmpq 0x19121(%rip), %rcx ; (void *)0x000000010a103390: stg_TSO_info }}} Now, maybe the `Binary` instance breaks the invariant that the `n_occ` field is strict? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 11 21:13:42 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 11 Jan 2018 21:13:42 -0000 Subject: [GHC] #14661: Cannot derive (newtype I a b = I (F a -> F b) deriving newtype Category) for type family F In-Reply-To: <051.db51abc527e2395586903121a4d671be@haskell.org> References: <051.db51abc527e2395586903121a4d671be@haskell.org> Message-ID: <066.1e3d79fa45317829c9e1b8de62534449@haskell.org> #14661: Cannot derive (newtype I a b = I (F a -> F b) deriving newtype Category) for type family F -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.4.1-alpha1 Resolution: | Keywords: | DerivingStrategies, deriving, | TypeFamilies Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): My belief is that `DerivingVia` is exactly what you're looking for (instead of attempting to encode this into GHC somehow in an //ad hoc// fashion). -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 11 21:26:53 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 11 Jan 2018 21:26:53 -0000 Subject: [GHC] #14626: No need to enter a scrutinised value In-Reply-To: <048.67c951c2aecb97b988badb4816dbe757@haskell.org> References: <048.67c951c2aecb97b988badb4816dbe757@haskell.org> Message-ID: <063.4b6a75d3ee7a018fdbd3adaf7a01abd7@haskell.org> #14626: No need to enter a scrutinised value -------------------------------------+------------------------------------- Reporter: heisenbug | Owner: heisenbug Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: performance Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #13861 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by heisenbug): Replying to [comment:19 heisenbug]: > Replying to [comment:18 heisenbug]: > > [snippety] > > Now, maybe the `Binary` instance breaks the invariant that the `n_occ` field is strict? Actually it seems to be {{{#!hs -- | Assumes that the 'Name' is a non-binding one. See -- 'IfaceSyn.putIfaceTopBndr' and 'IfaceSyn.getIfaceTopBndr' for serializing -- binding 'Name's. See 'UserData' for the rationale for this distinction. instance Binary Name where put_ bh name = case getUserData bh of UserData{ ud_put_nonbinding_name = put_name } -> put_name bh name get bh = case getUserData bh of UserData { ud_get_name = get_name } -> get_name bh }}} which breaks the contract. Let's see what `getUserData` does... -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 11 20:10:51 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 11 Jan 2018 20:10:51 -0000 Subject: [GHC] #14519: Exponential runtime performance regression in GHC 8.2 + Data.Text.Lazy + Text.RE.TDFA In-Reply-To: <043.92c07e3e0209c31f0a0f195fa98d301c@haskell.org> References: <043.92c07e3e0209c31f0a0f195fa98d301c@haskell.org> Message-ID: <058.1f1bcd7627c2307061ffa52dbd255863@haskell.org> #14519: Exponential runtime performance regression in GHC 8.2 + Data.Text.Lazy + Text.RE.TDFA -------------------------------------+------------------------------------- Reporter: ntc2 | Owner: tdammers Type: bug | Status: new Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Runtime | Test Case: performance bug | https://github.com/ntc2/ghc-8.2.1 | -regex-lazy-text- | bug/tree/07b7bb32c6e90e8f2d2eada4b59943f37e632d53 Blocked By: | Blocking: Related Tickets: #13745, #14564 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by tdammers): Recompiled everything, with `--force-reinstalls` and `-fforce-recomp`, and `-ddump-stg` on everything including dependencies, however, grepping the entire project tree for `wnext` only matches binaries (`.o`, `.a` and the like), but none of the dumps. So I ran GHC directly on the source file inside the cabal tree: {{{ ../ghc/inplace/bin/ghc-stage2 regex-tdfa- text-1.0.0.3/Text/Regex/TDFA/Text/Lazy.hs -fforce-recomp -package-db .cabal-sandbox/x86_64-linux-ghc-8.5.20180108-packages.conf.d -ticky -c -ddump-stg -rtsopts -XMultiParamTypeClasses }}} But to no avail, `wnext2` does not appear in the STG dump: {{{ ==================== Pre unarise: ==================== sat_s6o2 :: GHC.Types.Int -> GHC.Int.Int64 [LclId] = [] \u [] GHC.Enum.toEnum GHC.Int.$fEnumInt64; $cafter_r6mQ :: GHC.Types.Int -> Data.Text.Internal.Lazy.Text -> Data.Text.Internal.Lazy.Text [GblId] = [] \u [] GHC.Base.. Data.Text.Lazy.drop sat_s6o2; sat_s6o3 :: GHC.Types.Int -> GHC.Int.Int64 [LclId] = [] \u [] GHC.Enum.toEnum GHC.Int.$fEnumInt64; $cbefore_r6nJ :: GHC.Types.Int -> Data.Text.Internal.Lazy.Text -> Data.Text.Internal.Lazy.Text [GblId] = [] \u [] GHC.Base.. Data.Text.Lazy.take sat_s6o3; Text.Regex.TDFA.Text.Lazy.$fExtractText [InlPrag=NOUSERINLINE CONLIKE] :: Text.Regex.Base.RegexLike.Extract Data.Text.Internal.Lazy.Text [GblId[DFunId]] = NO_CCS Text.Regex.Base.RegexLike.C:Extract! [$cbefore_r6nJ $cafter_r6mQ Data.Text.Internal.Lazy.empty $cextract_r6nK]; $cextract_r6nK :: (GHC.Types.Int, GHC.Types.Int) -> Data.Text.Internal.Lazy.Text -> Data.Text.Internal.Lazy.Text [GblId] = [] \u [] Text.Regex.Base.RegexLike.$dmextract Text.Regex.TDFA.Text.Lazy.$fExtractText; Text.Regex.TDFA.Text.Lazy.$fUnconsText [InlPrag=INLINE (sat-args=0)] :: Text.Regex.TDFA.NewDFA.Uncons.Uncons Data.Text.Internal.Lazy.Text [GblId[DFunId(nt)]] = [] \u [] Data.Text.Lazy.uncons; $cmakeRegexOptsM_r6nL :: forall (m :: * -> *). GHC.Base.Monad m => Text.Regex.TDFA.Common.CompOption -> Text.Regex.TDFA.Common.ExecOption -> Data.Text.Internal.Lazy.Text -> m Text.Regex.TDFA.Common.Regex [GblId, Arity=4, Unf=OtherCon []] = [] \r [$dMonad_s6o4 c_s6o5 e_s6o6 source_s6o7] let { sat_s6o8 [Occ=Once] :: GHC.Base.String [LclId] = [source_s6o7] \u [] Data.Text.Lazy.unpack source_s6o7; } in Text.Regex.Base.RegexLike.makeRegexOptsM Text.Regex.TDFA.String.$fRegexMakerRegexCompOptionExecOption[] $dMonad_s6o4 c_s6o5 e_s6o6 sat_s6o8; Text.Regex.TDFA.Text.Lazy.$fRegexMakerRegexCompOptionExecOptionText [InlPrag=NOUSERINLINE CONLIKE] :: Text.Regex.Base.RegexLike.RegexMaker Text.Regex.TDFA.Common.Regex Text.Regex.TDFA.Common.CompOption Text.Regex.TDFA.Common.ExecOption Data.Text.Internal.Lazy.Text [GblId[DFunId]] = NO_CCS Text.Regex.Base.RegexLike.C:RegexMaker! [Text.Regex.TDFA.Common.$fRegexOptionsRegexCompOptionExecOption $cmakeRegex_r6nN $cmakeRegexOpts_r6nM $cmakeRegexM_r6nO $cmakeRegexOptsM_r6nL]; $cmakeRegexOpts_r6nM :: Text.Regex.TDFA.Common.CompOption -> Text.Regex.TDFA.Common.ExecOption -> Data.Text.Internal.Lazy.Text -> Text.Regex.TDFA.Common.Regex [GblId] = [] \u [] Text.Regex.Base.RegexLike.$dmmakeRegexOpts Text.Regex.TDFA.Text.Lazy.$fRegexMakerRegexCompOptionExecOptionText; $cmakeRegex_r6nN :: Data.Text.Internal.Lazy.Text -> Text.Regex.TDFA.Common.Regex [GblId] = [] \u [] Text.Regex.Base.RegexLike.$dmmakeRegex Text.Regex.TDFA.Text.Lazy.$fRegexMakerRegexCompOptionExecOptionText; $cmakeRegexM_r6nO :: forall (m :: * -> *). GHC.Base.Monad m => Data.Text.Internal.Lazy.Text -> m Text.Regex.TDFA.Common.Regex [GblId, Arity=1, Unf=OtherCon []] = [] \r [$dMonad_s6o9] Text.Regex.Base.RegexLike.$dmmakeRegexM Text.Regex.TDFA.Text.Lazy.$fRegexMakerRegexCompOptionExecOptionText $dMonad_s6o9; $trModule1_r6nP :: GHC.Prim.Addr# [GblId, Caf=NoCafRefs, Unf=OtherCon []] = "main"#; $trModule2_r6nQ :: GHC.Types.TrName [GblId, Caf=NoCafRefs, Unf=OtherCon []] = NO_CCS GHC.Types.TrNameS! [$trModule1_r6nP]; $trModule3_r6nR :: GHC.Prim.Addr# [GblId, Caf=NoCafRefs, Unf=OtherCon []] = "Text.Regex.TDFA.Text.Lazy"#; $trModule4_r6nS :: GHC.Types.TrName [GblId, Caf=NoCafRefs, Unf=OtherCon []] = NO_CCS GHC.Types.TrNameS! [$trModule3_r6nR]; Text.Regex.TDFA.Text.Lazy.$trModule :: GHC.Types.Module [GblId, Caf=NoCafRefs, Unf=OtherCon []] = NO_CCS GHC.Types.Module! [$trModule2_r6nQ $trModule4_r6nS]; $cmatchTest_r6nT :: Text.Regex.TDFA.Common.Regex -> Data.Text.Internal.Lazy.Text -> GHC.Types.Bool [GblId] = [] \u [] Text.Regex.TDFA.NewDFA.Tester.matchTest Data.Text.Lazy.uncons; $cmatchAll_r6nU :: Text.Regex.TDFA.Common.Regex -> Data.Text.Internal.Lazy.Text -> [Text.Regex.Base.RegexLike.MatchArray] [GblId, Arity=2, Unf=OtherCon []] = [] \r [r_s6oa s_s6ob] let { sat_s6od [Occ=Once] :: GHC.Types.Char [LclId] = NO_CCS GHC.Types.C#! ['\n'#]; } in let { sat_s6oc [Occ=Once] :: Text.Regex.TDFA.Common.Position [LclId] = NO_CCS GHC.Types.I#! [0#]; } in Text.Regex.TDFA.NewDFA.Engine.execMatch Data.Text.Lazy.uncons r_s6oa sat_s6oc sat_s6od s_s6ob; Text.Regex.TDFA.Text.Lazy.compile :: Text.Regex.TDFA.Common.CompOption -> Text.Regex.TDFA.Common.ExecOption -> Data.Text.Internal.Lazy.Text -> Data.Either.Either GHC.Base.String Text.Regex.TDFA.Common.Regex [GblId, Arity=3, Unf=OtherCon []] = [] \r [compOpt_s6oe execOpt_s6of txt_s6og] let { sat_s6oh [Occ=Once] :: GHC.Base.String [LclId] = [txt_s6og] \u [] Data.Text.Lazy.unpack txt_s6og; } in case Text.Regex.TDFA.ReadRegex.parseRegex sat_s6oh of { Data.Either.Left err_s6oj [Occ=Once] -> let { sat_s6om [Occ=Once] :: [GHC.Types.Char] [LclId] = [err_s6oj] \u [] let { sat_s6ol [Occ=Once] :: [GHC.Types.Char] [LclId] = [err_s6oj] \u [] GHC.Show.show Text.Parsec.Error.$fShowParseError err_s6oj; } in let { sat_s6ok [Occ=Once] :: [GHC.Types.Char] [LclId] = [] \u [] GHC.CString.unpackCString# "parseRegex for Text.Regex.TDFA.Text.Lazy failed:"#; } in GHC.Base.++ sat_s6ok sat_s6ol; } in Data.Either.Left [sat_s6om]; Data.Either.Right pattern_s6on [Occ=Once] -> let { sat_s6oo [Occ=Once] :: Text.Regex.TDFA.Common.Regex [LclId] = [compOpt_s6oe execOpt_s6of pattern_s6on] \u [] Text.Regex.TDFA.TDFA.patternToRegex pattern_s6on compOpt_s6oe execOpt_s6of; } in Data.Either.Right [sat_s6oo]; }; $cmatchOnce_r6nV :: Text.Regex.TDFA.Common.Regex -> Data.Text.Internal.Lazy.Text -> GHC.Base.Maybe Text.Regex.Base.RegexLike.MatchArray [GblId, Arity=2, Unf=OtherCon []] = [] \r [r_s6op s_s6oq] let { sat_s6or [Occ=Once] :: [Text.Regex.Base.RegexLike.MatchArray] [LclId] = [r_s6op s_s6oq] \u [] $cmatchAll_r6nU r_s6op s_s6oq; } in Data.Maybe.listToMaybe sat_s6or; $cmatchAllText_r6nW :: Text.Regex.TDFA.Common.Regex -> Data.Text.Internal.Lazy.Text -> [Text.Regex.Base.RegexLike.MatchText Data.Text.Internal.Lazy.Text] [GblId, Arity=2, Unf=OtherCon []] = [] \r [regex_s6os source_s6ot] let { go_s6ou [Occ=LoopBreaker] :: GHC.Types.Int -> Data.Text.Internal.Lazy.Text -> [GHC.Arr.Array GHC.Types.Int (GHC.Types.Int, GHC.Types.Int)] -> [GHC.Arr.Array GHC.Types.Int (Data.Text.Internal.Lazy.Text, (GHC.Types.Int, GHC.Types.Int))] [LclId, Arity=3, Unf=OtherCon []] = sat-only [go_s6ou] \r [i_s6ov ds_s6ow ds1_s6ox] case i_s6ov of i1_s6oy { GHC.Types.I# _ [Occ=Dead] -> case ds1_s6ox of { [] -> [] []; : x_s6oB xs_s6oC [Occ=Once] -> let { ds2_s6oD :: (GHC.Types.Int, GHC.Types.Int) [LclId] = [x_s6oB] \u [] let { sat_s6oE [Occ=Once] :: GHC.Types.Int [LclId] = NO_CCS GHC.Types.I#! [0#]; } in Data.Array.Base.! Data.Array.Base.$fIArrayArraye GHC.Arr.$fIxInt x_s6oB sat_s6oE; } in let { off0_s6oF :: GHC.Types.Int [LclId] = [ds2_s6oD] \u [] case ds2_s6oD of { (,) off1_s6oH [Occ=Once] _ [Occ=Dead] -> off1_s6oH; }; } in let { len0_s6oJ :: GHC.Types.Int [LclId] = [ds2_s6oD] \u [] case ds2_s6oD of { (,) _ [Occ=Dead] len1_s6oM [Occ=Once] -> len1_s6oM; }; } in let { sat_s6p0 [Occ=Once] :: [GHC.Arr.Array GHC.Types.Int (Data.Text.Internal.Lazy.Text, (GHC.Types.Int, GHC.Types.Int))] [LclId] = [go_s6ou ds_s6ow i1_s6oy xs_s6oC off0_s6oF len0_s6oJ] \u [] let { sat_s6oX [Occ=Once] :: GHC.Types.Int [LclId] = [i1_s6oy off0_s6oF len0_s6oJ] \u [] let { sat_s6oW [Occ=Once] :: GHC.Types.Int [LclId] = [i1_s6oy len0_s6oJ] \u [] GHC.Num.- GHC.Num.$fNumInt len0_s6oJ i1_s6oy; } in GHC.Num.+ GHC.Num.$fNumInt off0_s6oF sat_s6oW; } in case $cafter_r6mQ sat_s6oX ds_s6ow of t'_s6oY { __DEFAULT -> let { sat_s6oZ [Occ=Once] :: GHC.Types.Int [LclId] = [off0_s6oF len0_s6oJ] \u [] GHC.Num.+ GHC.Num.$fNumInt off0_s6oF len0_s6oJ; } in go_s6ou sat_s6oZ t'_s6oY xs_s6oC; }; } in let { sat_s6oV [Occ=Once] :: GHC.Arr.Array GHC.Types.Int (Data.Text.Internal.Lazy.Text, (GHC.Types.Int, GHC.Types.Int)) [LclId] = [ds_s6ow i1_s6oy x_s6oB] \u [] let { sat_s6oU [Occ=Once] :: (GHC.Types.Int, GHC.Types.Int) -> (Data.Text.Internal.Lazy.Text, (GHC.Types.Int, GHC.Types.Int)) [LclId] = [ds_s6ow i1_s6oy] \r [pair_s6oN] case pair_s6oN of wild1_s6oO { (,) off_s6oP [Occ=Once] len_s6oQ [Occ=Once] -> let { sat_s6oT [Occ=Once] :: Data.Text.Internal.Lazy.Text [LclId] = [ds_s6ow i1_s6oy off_s6oP len_s6oQ] \u [] let { sat_s6oR [Occ=Once] :: GHC.Types.Int [LclId] = [i1_s6oy off_s6oP] \u [] GHC.Num.- GHC.Num.$fNumInt off_s6oP i1_s6oy; } in let { sat_s6oS [Occ=Once] :: (GHC.Types.Int, GHC.Types.Int) [LclId] = NO_CCS (,)! [sat_s6oR len_s6oQ]; } in $cextract_r6nK sat_s6oS ds_s6ow; } in (,) [sat_s6oT wild1_s6oO]; }; } in GHC.Base.fmap GHC.Arr.$fFunctorArray sat_s6oU x_s6oB; } in : [sat_s6oV sat_s6p0]; }; }; } in let { sat_s6p2 [Occ=Once] :: [GHC.Arr.Array GHC.Types.Int (GHC.Types.Int, GHC.Types.Int)] [LclId] = [regex_s6os source_s6ot] \u [] $cmatchAll_r6nU regex_s6os source_s6ot; } in let { sat_s6p1 [Occ=Once] :: GHC.Types.Int [LclId] = NO_CCS GHC.Types.I#! [0#]; } in go_s6ou sat_s6p1 source_s6ot sat_s6p2; $cmatchCount_r6nX :: Text.Regex.TDFA.Common.Regex -> Data.Text.Internal.Lazy.Text -> GHC.Types.Int [GblId, Arity=2, Unf=OtherCon []] = [] \r [r_s6p3 s_s6p4] let { sat_s6pm [Occ=Once] :: [Text.Regex.Base.RegexLike.MatchArray] [LclId] = [r_s6p3 s_s6p4] \u [] let { sat_s6pl [Occ=Once] :: GHC.Types.Char [LclId] = NO_CCS GHC.Types.C#! ['\n'#]; } in let { sat_s6pk [Occ=Once] :: Text.Regex.TDFA.Common.Position [LclId] = NO_CCS GHC.Types.I#! [0#]; } in let { sat_s6pj [Occ=Once] :: Text.Regex.TDFA.Common.Regex [LclId] = [r_s6p3] \u [] case r_s6p3 of wild_s6p5 { Text.Regex.TDFA.Common.Regex ds_s6p6 [Occ=Once] ds1_s6p7 [Occ=Once] ds2_s6p8 [Occ=Once] ds3_s6p9 [Occ=Once] ds4_s6pa [Occ=Once] ds5_s6pb [Occ=Once] ds6_s6pc [Occ=Once] ds7_s6pd [Occ=Once] ds8_s6pe [Occ=Once] _ [Occ=Dead] -> let { sat_s6pi [Occ=Once] :: Text.Regex.TDFA.Common.ExecOption [LclId] = [wild_s6p5] \u [] case Text.Regex.TDFA.Common.regex_execOptions wild_s6p5 of { Text.Regex.TDFA.Common.ExecOption _ [Occ=Dead] -> Text.Regex.TDFA.Common.ExecOption [GHC.Types.False]; }; } in Text.Regex.TDFA.Common.Regex [ds_s6p6 ds1_s6p7 ds2_s6p8 ds3_s6p9 ds4_s6pa ds5_s6pb ds6_s6pc ds7_s6pd ds8_s6pe sat_s6pi]; }; } in Text.Regex.TDFA.NewDFA.Engine.execMatch Data.Text.Lazy.uncons sat_s6pj sat_s6pk sat_s6pl s_s6p4; } in Data.Foldable.length Data.Foldable.$fFoldable[] sat_s6pm; $cmatchOnceText_r6nY :: Text.Regex.TDFA.Common.Regex -> Data.Text.Internal.Lazy.Text -> GHC.Base.Maybe (Data.Text.Internal.Lazy.Text, Text.Regex.Base.RegexLike.MatchText Data.Text.Internal.Lazy.Text, Data.Text.Internal.Lazy.Text) [GblId, Arity=2, Unf=OtherCon []] = [] \r [regex_s6pn source_s6po] let { sat_s6pL [Occ=Once] :: GHC.Base.Maybe (GHC.Arr.Array GHC.Types.Int (GHC.Types.Int, GHC.Types.Int)) [LclId] = [regex_s6pn source_s6po] \u [] let { sat_s6pK [Occ=Once] :: [Text.Regex.Base.RegexLike.MatchArray] [LclId] = [regex_s6pn source_s6po] \u [] let { sat_s6pJ [Occ=Once] :: GHC.Types.Char [LclId] = NO_CCS GHC.Types.C#! ['\n'#]; } in let { sat_s6pI [Occ=Once] :: Text.Regex.TDFA.Common.Position [LclId] = NO_CCS GHC.Types.I#! [0#]; } in Text.Regex.TDFA.NewDFA.Engine.execMatch Data.Text.Lazy.uncons regex_s6pn sat_s6pI sat_s6pJ source_s6po; } in Data.Maybe.listToMaybe sat_s6pK; } in let { sat_s6pH [Occ=Once] :: GHC.Arr.Array GHC.Types.Int (GHC.Types.Int, GHC.Types.Int) -> (Data.Text.Internal.Lazy.Text, GHC.Arr.Array GHC.Types.Int (Data.Text.Internal.Lazy.Text, (GHC.Types.Int, GHC.Types.Int)), Data.Text.Internal.Lazy.Text) [LclId] = [source_s6po] \r [ma_s6pp] let { ds_s6pq :: (GHC.Types.Int, GHC.Types.Int) [LclId] = [ma_s6pp] \u [] let { sat_s6pr [Occ=Once] :: GHC.Types.Int [LclId] = NO_CCS GHC.Types.I#! [0#]; } in Data.Array.Base.! Data.Array.Base.$fIArrayArraye GHC.Arr.$fIxInt ma_s6pp sat_s6pr; } in let { o_s6ps :: GHC.Types.Int [LclId] = [ds_s6pq] \u [] case ds_s6pq of { (,) o1_s6pu [Occ=Once] _ [Occ=Dead] -> o1_s6pu; }; } in let { sat_s6pG [Occ=Once] :: Data.Text.Internal.Lazy.Text [LclId] = [source_s6po ds_s6pq o_s6ps] \u [] let { sat_s6pF [Occ=Once] :: GHC.Types.Int [LclId] = [ds_s6pq o_s6ps] \u [] let { sat_s6pE [Occ=Once] :: GHC.Types.Int [LclId] = [ds_s6pq] \u [] case ds_s6pq of { (,) _ [Occ=Dead] l_s6pD [Occ=Once] -> l_s6pD; }; } in GHC.Num.+ GHC.Num.$fNumInt o_s6ps sat_s6pE; } in $cafter_r6mQ sat_s6pF source_s6po; } in let { sat_s6pA [Occ=Once] :: GHC.Arr.Array GHC.Types.Int (Data.Text.Internal.Lazy.Text, (GHC.Types.Int, GHC.Types.Int)) [LclId] = [source_s6po ma_s6pp] \u [] let { sat_s6pz [Occ=Once] :: (GHC.Types.Int, GHC.Types.Int) -> (Data.Text.Internal.Lazy.Text, (GHC.Types.Int, GHC.Types.Int)) [LclId] = [source_s6po] \r [ol_s6px] let { sat_s6py [Occ=Once] :: Data.Text.Internal.Lazy.Text [LclId] = [source_s6po ol_s6px] \u [] $cextract_r6nK ol_s6px source_s6po; } in (,) [sat_s6py ol_s6px]; } in GHC.Base.fmap GHC.Arr.$fFunctorArray sat_s6pz ma_s6pp; } in let { sat_s6pw [Occ=Once] :: Data.Text.Internal.Lazy.Text [LclId] = [source_s6po o_s6ps] \u [] $cbefore_r6nJ o_s6ps source_s6po; } in (,,) [sat_s6pw sat_s6pA sat_s6pG]; } in GHC.Base.fmap GHC.Base.$fFunctorMaybe sat_s6pH sat_s6pL; Text.Regex.TDFA.Text.Lazy.$fRegexLikeRegexText [InlPrag=NOUSERINLINE CONLIKE] :: Text.Regex.Base.RegexLike.RegexLike Text.Regex.TDFA.Common.Regex Data.Text.Internal.Lazy.Text [GblId[DFunId]] = NO_CCS Text.Regex.Base.RegexLike.C:RegexLike! [Text.Regex.TDFA.Text.Lazy.$fExtractText $cmatchOnce_r6nV $cmatchAll_r6nU $cmatchCount_r6nX $cmatchTest_r6nT $cmatchAllText_r6nW $cmatchOnceText_r6nY]; Text.Regex.TDFA.Text.Lazy.regexec :: Text.Regex.TDFA.Common.Regex -> Data.Text.Internal.Lazy.Text -> Data.Either.Either GHC.Base.String (GHC.Base.Maybe (Data.Text.Internal.Lazy.Text, Data.Text.Internal.Lazy.Text, Data.Text.Internal.Lazy.Text, [Data.Text.Internal.Lazy.Text])) [GblId, Arity=2, Unf=OtherCon []] = [] \r [r_s6pM txt_s6pN] case $cmatchOnceText_r6nY r_s6pM txt_s6pN of { GHC.Base.Nothing -> Data.Either.Right [GHC.Base.Nothing]; GHC.Base.Just ds_s6pP [Occ=Once!] -> case ds_s6pP of { (,,) pre_s6pR [Occ=Once] mt_s6pS post_s6pT [Occ=Once] -> let { sat_s6pZ [Occ=Once] :: [Data.Text.Internal.Lazy.Text] [LclId] = [mt_s6pS] \u [] let { sat_s6pY [Occ=Once] :: [(Data.Text.Internal.Lazy.Text, (Text.Regex.Base.RegexLike.MatchOffset, Text.Regex.Base.RegexLike.MatchLength))] [LclId] = [mt_s6pS] \u [] let { sat_s6pX [Occ=Once] :: [(Data.Text.Internal.Lazy.Text, (Text.Regex.Base.RegexLike.MatchOffset, Text.Regex.Base.RegexLike.MatchLength))] [LclId] = [mt_s6pS] \u [] Data.Array.Base.elems Data.Array.Base.$fIArrayArraye GHC.Arr.$fIxInt mt_s6pS; } in GHC.List.tail sat_s6pX; } in GHC.Base.map Data.Tuple.fst sat_s6pY; } in let { sat_s6pW [Occ=Once] :: Data.Text.Internal.Lazy.Text [LclId] = [mt_s6pS] \u [] let { sat_s6pV [Occ=Once] :: (Data.Text.Internal.Lazy.Text, (Text.Regex.Base.RegexLike.MatchOffset, Text.Regex.Base.RegexLike.MatchLength)) [LclId] = [mt_s6pS] \u [] let { sat_s6pU [Occ=Once] :: GHC.Types.Int [LclId] = NO_CCS GHC.Types.I#! [0#]; } in Data.Array.Base.! Data.Array.Base.$fIArrayArraye GHC.Arr.$fIxInt mt_s6pS sat_s6pU; } in Data.Tuple.fst sat_s6pV; } in let { sat_s6q0 [Occ=Once] :: (Data.Text.Internal.Lazy.Text, Data.Text.Internal.Lazy.Text, Data.Text.Internal.Lazy.Text, [Data.Text.Internal.Lazy.Text]) [LclId] = NO_CCS (,,,)! [pre_s6pR sat_s6pW post_s6pT sat_s6pZ]; } in let { sat_s6q1 [Occ=Once] :: GHC.Base.Maybe (Data.Text.Internal.Lazy.Text, Data.Text.Internal.Lazy.Text, Data.Text.Internal.Lazy.Text, [Data.Text.Internal.Lazy.Text]) [LclId] = NO_CCS GHC.Base.Just! [sat_s6q0]; } in Data.Either.Right [sat_s6q1]; }; }; $cmatch_r6nZ :: Text.Regex.TDFA.Common.Regex -> Data.Text.Internal.Lazy.Text -> Data.Text.Internal.Lazy.Text [GblId] = [] \u [] Text.Regex.Base.Impl.polymatch Text.Regex.TDFA.Text.Lazy.$fRegexLikeRegexText; $cmatchM_r6o0 :: forall (m :: * -> *). GHC.Base.Monad m => Text.Regex.TDFA.Common.Regex -> Data.Text.Internal.Lazy.Text -> m Data.Text.Internal.Lazy.Text [GblId, Arity=1, Unf=OtherCon []] = [] \r [$dMonad_s6q2] Text.Regex.Base.Impl.polymatchM Text.Regex.TDFA.Text.Lazy.$fRegexLikeRegexText $dMonad_s6q2; Text.Regex.TDFA.Text.Lazy.$fRegexContextRegexTextText [InlPrag=NOUSERINLINE CONLIKE] :: Text.Regex.Base.RegexLike.RegexContext Text.Regex.TDFA.Common.Regex Data.Text.Internal.Lazy.Text Data.Text.Internal.Lazy.Text [GblId[DFunId]] = NO_CCS Text.Regex.Base.RegexLike.C:RegexContext! [Text.Regex.TDFA.Text.Lazy.$fRegexLikeRegexText $cmatch_r6nZ $cmatchM_r6o0]; Text.Regex.TDFA.Text.Lazy.execute :: Text.Regex.TDFA.Common.Regex -> Data.Text.Internal.Lazy.Text -> Data.Either.Either GHC.Base.String (GHC.Base.Maybe Text.Regex.Base.RegexLike.MatchArray) [GblId, Arity=2, Unf=OtherCon []] = [] \r [r_s6q3 txt_s6q4] let { sat_s6q5 [Occ=Once] :: GHC.Base.Maybe Text.Regex.Base.RegexLike.MatchArray [LclId] = [r_s6q3 txt_s6q4] \u [] $cmatchOnce_r6nV r_s6q3 txt_s6q4; } in Data.Either.Right [sat_s6q5]; ==================== STG syntax: ==================== sat_s6o2 :: GHC.Types.Int -> GHC.Int.Int64 [LclId] = [] \u [] GHC.Enum.toEnum GHC.Int.$fEnumInt64; $cafter_r6mQ :: GHC.Types.Int -> Data.Text.Internal.Lazy.Text -> Data.Text.Internal.Lazy.Text [GblId] = [] \u [] GHC.Base.. Data.Text.Lazy.drop sat_s6o2; sat_s6o3 :: GHC.Types.Int -> GHC.Int.Int64 [LclId] = [] \u [] GHC.Enum.toEnum GHC.Int.$fEnumInt64; $cbefore_r6nJ :: GHC.Types.Int -> Data.Text.Internal.Lazy.Text -> Data.Text.Internal.Lazy.Text [GblId] = [] \u [] GHC.Base.. Data.Text.Lazy.take sat_s6o3; Text.Regex.TDFA.Text.Lazy.$fExtractText [InlPrag=NOUSERINLINE CONLIKE] :: Text.Regex.Base.RegexLike.Extract Data.Text.Internal.Lazy.Text [GblId[DFunId]] = NO_CCS Text.Regex.Base.RegexLike.C:Extract! [$cbefore_r6nJ $cafter_r6mQ Data.Text.Internal.Lazy.empty $cextract_r6nK]; $cextract_r6nK :: (GHC.Types.Int, GHC.Types.Int) -> Data.Text.Internal.Lazy.Text -> Data.Text.Internal.Lazy.Text [GblId] = [] \u [] Text.Regex.Base.RegexLike.$dmextract Text.Regex.TDFA.Text.Lazy.$fExtractText; Text.Regex.TDFA.Text.Lazy.$fUnconsText [InlPrag=INLINE (sat-args=0)] :: Text.Regex.TDFA.NewDFA.Uncons.Uncons Data.Text.Internal.Lazy.Text [GblId[DFunId(nt)]] = [] \u [] Data.Text.Lazy.uncons; $cmakeRegexOptsM_r6nL :: forall (m :: * -> *). GHC.Base.Monad m => Text.Regex.TDFA.Common.CompOption -> Text.Regex.TDFA.Common.ExecOption -> Data.Text.Internal.Lazy.Text -> m Text.Regex.TDFA.Common.Regex [GblId, Arity=4, Unf=OtherCon []] = [] \r [$dMonad_s6o4 c_s6o5 e_s6o6 source_s6o7] let { sat_s6o8 [Occ=Once] :: GHC.Base.String [LclId] = [source_s6o7] \u [] Data.Text.Lazy.unpack source_s6o7; } in Text.Regex.Base.RegexLike.makeRegexOptsM Text.Regex.TDFA.String.$fRegexMakerRegexCompOptionExecOption[] $dMonad_s6o4 c_s6o5 e_s6o6 sat_s6o8; Text.Regex.TDFA.Text.Lazy.$fRegexMakerRegexCompOptionExecOptionText [InlPrag=NOUSERINLINE CONLIKE] :: Text.Regex.Base.RegexLike.RegexMaker Text.Regex.TDFA.Common.Regex Text.Regex.TDFA.Common.CompOption Text.Regex.TDFA.Common.ExecOption Data.Text.Internal.Lazy.Text [GblId[DFunId]] = NO_CCS Text.Regex.Base.RegexLike.C:RegexMaker! [Text.Regex.TDFA.Common.$fRegexOptionsRegexCompOptionExecOption $cmakeRegex_r6nN $cmakeRegexOpts_r6nM $cmakeRegexM_r6nO $cmakeRegexOptsM_r6nL]; $cmakeRegexOpts_r6nM :: Text.Regex.TDFA.Common.CompOption -> Text.Regex.TDFA.Common.ExecOption -> Data.Text.Internal.Lazy.Text -> Text.Regex.TDFA.Common.Regex [GblId] = [] \u [] Text.Regex.Base.RegexLike.$dmmakeRegexOpts Text.Regex.TDFA.Text.Lazy.$fRegexMakerRegexCompOptionExecOptionText; $cmakeRegex_r6nN :: Data.Text.Internal.Lazy.Text -> Text.Regex.TDFA.Common.Regex [GblId] = [] \u [] Text.Regex.Base.RegexLike.$dmmakeRegex Text.Regex.TDFA.Text.Lazy.$fRegexMakerRegexCompOptionExecOptionText; $cmakeRegexM_r6nO :: forall (m :: * -> *). GHC.Base.Monad m => Data.Text.Internal.Lazy.Text -> m Text.Regex.TDFA.Common.Regex [GblId, Arity=1, Unf=OtherCon []] = [] \r [$dMonad_s6o9] Text.Regex.Base.RegexLike.$dmmakeRegexM Text.Regex.TDFA.Text.Lazy.$fRegexMakerRegexCompOptionExecOptionText $dMonad_s6o9; $trModule1_r6nP :: GHC.Prim.Addr# [GblId, Caf=NoCafRefs, Unf=OtherCon []] = "main"#; $trModule2_r6nQ :: GHC.Types.TrName [GblId, Caf=NoCafRefs, Unf=OtherCon []] = NO_CCS GHC.Types.TrNameS! [$trModule1_r6nP]; $trModule3_r6nR :: GHC.Prim.Addr# [GblId, Caf=NoCafRefs, Unf=OtherCon []] = "Text.Regex.TDFA.Text.Lazy"#; $trModule4_r6nS :: GHC.Types.TrName [GblId, Caf=NoCafRefs, Unf=OtherCon []] = NO_CCS GHC.Types.TrNameS! [$trModule3_r6nR]; Text.Regex.TDFA.Text.Lazy.$trModule :: GHC.Types.Module [GblId, Caf=NoCafRefs, Unf=OtherCon []] = NO_CCS GHC.Types.Module! [$trModule2_r6nQ $trModule4_r6nS]; $cmatchTest_r6nT :: Text.Regex.TDFA.Common.Regex -> Data.Text.Internal.Lazy.Text -> GHC.Types.Bool [GblId] = [] \u [] Text.Regex.TDFA.NewDFA.Tester.matchTest Data.Text.Lazy.uncons; $cmatchAll_r6nU :: Text.Regex.TDFA.Common.Regex -> Data.Text.Internal.Lazy.Text -> [Text.Regex.Base.RegexLike.MatchArray] [GblId, Arity=2, Unf=OtherCon []] = [] \r [r_s6oa s_s6ob] let { sat_s6od [Occ=Once] :: GHC.Types.Char [LclId] = NO_CCS GHC.Types.C#! ['\n'#]; } in let { sat_s6oc [Occ=Once] :: Text.Regex.TDFA.Common.Position [LclId] = NO_CCS GHC.Types.I#! [0#]; } in Text.Regex.TDFA.NewDFA.Engine.execMatch Data.Text.Lazy.uncons r_s6oa sat_s6oc sat_s6od s_s6ob; Text.Regex.TDFA.Text.Lazy.compile :: Text.Regex.TDFA.Common.CompOption -> Text.Regex.TDFA.Common.ExecOption -> Data.Text.Internal.Lazy.Text -> Data.Either.Either GHC.Base.String Text.Regex.TDFA.Common.Regex [GblId, Arity=3, Unf=OtherCon []] = [] \r [compOpt_s6oe execOpt_s6of txt_s6og] let { sat_s6oh [Occ=Once] :: GHC.Base.String [LclId] = [txt_s6og] \u [] Data.Text.Lazy.unpack txt_s6og; } in case Text.Regex.TDFA.ReadRegex.parseRegex sat_s6oh of { Data.Either.Left err_s6oj [Occ=Once] -> let { sat_s6om [Occ=Once] :: [GHC.Types.Char] [LclId] = [err_s6oj] \u [] let { sat_s6ol [Occ=Once] :: [GHC.Types.Char] [LclId] = [err_s6oj] \u [] GHC.Show.show Text.Parsec.Error.$fShowParseError err_s6oj; } in let { sat_s6ok [Occ=Once] :: [GHC.Types.Char] [LclId] = [] \u [] GHC.CString.unpackCString# "parseRegex for Text.Regex.TDFA.Text.Lazy failed:"#; } in GHC.Base.++ sat_s6ok sat_s6ol; } in Data.Either.Left [sat_s6om]; Data.Either.Right pattern_s6on [Occ=Once] -> let { sat_s6oo [Occ=Once] :: Text.Regex.TDFA.Common.Regex [LclId] = [compOpt_s6oe execOpt_s6of pattern_s6on] \u [] Text.Regex.TDFA.TDFA.patternToRegex pattern_s6on compOpt_s6oe execOpt_s6of; } in Data.Either.Right [sat_s6oo]; }; $cmatchOnce_r6nV :: Text.Regex.TDFA.Common.Regex -> Data.Text.Internal.Lazy.Text -> GHC.Base.Maybe Text.Regex.Base.RegexLike.MatchArray [GblId, Arity=2, Unf=OtherCon []] = [] \r [r_s6op s_s6oq] let { sat_s6or [Occ=Once] :: [Text.Regex.Base.RegexLike.MatchArray] [LclId] = [r_s6op s_s6oq] \u [] $cmatchAll_r6nU r_s6op s_s6oq; } in Data.Maybe.listToMaybe sat_s6or; $cmatchAllText_r6nW :: Text.Regex.TDFA.Common.Regex -> Data.Text.Internal.Lazy.Text -> [Text.Regex.Base.RegexLike.MatchText Data.Text.Internal.Lazy.Text] [GblId, Arity=2, Unf=OtherCon []] = [] \r [regex_s6os source_s6ot] let { go_s6ou [Occ=LoopBreaker] :: GHC.Types.Int -> Data.Text.Internal.Lazy.Text -> [GHC.Arr.Array GHC.Types.Int (GHC.Types.Int, GHC.Types.Int)] -> [GHC.Arr.Array GHC.Types.Int (Data.Text.Internal.Lazy.Text, (GHC.Types.Int, GHC.Types.Int))] [LclId, Arity=3, Unf=OtherCon []] = sat-only [go_s6ou] \r [i_s6ov ds_s6ow ds1_s6ox] case i_s6ov of i1_s6oy { GHC.Types.I# _ [Occ=Dead] -> case ds1_s6ox of { [] -> [] []; : x_s6oB xs_s6oC [Occ=Once] -> let { ds2_s6oD :: (GHC.Types.Int, GHC.Types.Int) [LclId] = [x_s6oB] \u [] let { sat_s6oE [Occ=Once] :: GHC.Types.Int [LclId] = NO_CCS GHC.Types.I#! [0#]; } in Data.Array.Base.! Data.Array.Base.$fIArrayArraye GHC.Arr.$fIxInt x_s6oB sat_s6oE; } in let { off0_s6oF :: GHC.Types.Int [LclId] = [ds2_s6oD] \u [] case ds2_s6oD of { (,) off1_s6oH [Occ=Once] _ [Occ=Dead] -> off1_s6oH; }; } in let { len0_s6oJ :: GHC.Types.Int [LclId] = [ds2_s6oD] \u [] case ds2_s6oD of { (,) _ [Occ=Dead] len1_s6oM [Occ=Once] -> len1_s6oM; }; } in let { sat_s6p0 [Occ=Once] :: [GHC.Arr.Array GHC.Types.Int (Data.Text.Internal.Lazy.Text, (GHC.Types.Int, GHC.Types.Int))] [LclId] = [go_s6ou ds_s6ow i1_s6oy xs_s6oC off0_s6oF len0_s6oJ] \u [] let { sat_s6oX [Occ=Once] :: GHC.Types.Int [LclId] = [i1_s6oy off0_s6oF len0_s6oJ] \u [] let { sat_s6oW [Occ=Once] :: GHC.Types.Int [LclId] = [i1_s6oy len0_s6oJ] \u [] GHC.Num.- GHC.Num.$fNumInt len0_s6oJ i1_s6oy; } in GHC.Num.+ GHC.Num.$fNumInt off0_s6oF sat_s6oW; } in case $cafter_r6mQ sat_s6oX ds_s6ow of t'_s6oY { __DEFAULT -> let { sat_s6oZ [Occ=Once] :: GHC.Types.Int [LclId] = [off0_s6oF len0_s6oJ] \u [] GHC.Num.+ GHC.Num.$fNumInt off0_s6oF len0_s6oJ; } in go_s6ou sat_s6oZ t'_s6oY xs_s6oC; }; } in let { sat_s6oV [Occ=Once] :: GHC.Arr.Array GHC.Types.Int (Data.Text.Internal.Lazy.Text, (GHC.Types.Int, GHC.Types.Int)) [LclId] = [ds_s6ow i1_s6oy x_s6oB] \u [] let { sat_s6oU [Occ=Once] :: (GHC.Types.Int, GHC.Types.Int) -> (Data.Text.Internal.Lazy.Text, (GHC.Types.Int, GHC.Types.Int)) [LclId] = [ds_s6ow i1_s6oy] \r [pair_s6oN] case pair_s6oN of wild1_s6oO { (,) off_s6oP [Occ=Once] len_s6oQ [Occ=Once] -> let { sat_s6oT [Occ=Once] :: Data.Text.Internal.Lazy.Text [LclId] = [ds_s6ow i1_s6oy off_s6oP len_s6oQ] \u [] let { sat_s6oR [Occ=Once] :: GHC.Types.Int [LclId] = [i1_s6oy off_s6oP] \u [] GHC.Num.- GHC.Num.$fNumInt off_s6oP i1_s6oy; } in let { sat_s6oS [Occ=Once] :: (GHC.Types.Int, GHC.Types.Int) [LclId] = NO_CCS (,)! [sat_s6oR len_s6oQ]; } in $cextract_r6nK sat_s6oS ds_s6ow; } in (,) [sat_s6oT wild1_s6oO]; }; } in GHC.Base.fmap GHC.Arr.$fFunctorArray sat_s6oU x_s6oB; } in : [sat_s6oV sat_s6p0]; }; }; } in let { sat_s6p2 [Occ=Once] :: [GHC.Arr.Array GHC.Types.Int (GHC.Types.Int, GHC.Types.Int)] [LclId] = [regex_s6os source_s6ot] \u [] $cmatchAll_r6nU regex_s6os source_s6ot; } in let { sat_s6p1 [Occ=Once] :: GHC.Types.Int [LclId] = NO_CCS GHC.Types.I#! [0#]; } in go_s6ou sat_s6p1 source_s6ot sat_s6p2; $cmatchCount_r6nX :: Text.Regex.TDFA.Common.Regex -> Data.Text.Internal.Lazy.Text -> GHC.Types.Int [GblId, Arity=2, Unf=OtherCon []] = [] \r [r_s6p3 s_s6p4] let { sat_s6pm [Occ=Once] :: [Text.Regex.Base.RegexLike.MatchArray] [LclId] = [r_s6p3 s_s6p4] \u [] let { sat_s6pl [Occ=Once] :: GHC.Types.Char [LclId] = NO_CCS GHC.Types.C#! ['\n'#]; } in let { sat_s6pk [Occ=Once] :: Text.Regex.TDFA.Common.Position [LclId] = NO_CCS GHC.Types.I#! [0#]; } in let { sat_s6pj [Occ=Once] :: Text.Regex.TDFA.Common.Regex [LclId] = [r_s6p3] \u [] case r_s6p3 of wild_s6p5 { Text.Regex.TDFA.Common.Regex ds_s6p6 [Occ=Once] ds1_s6p7 [Occ=Once] ds2_s6p8 [Occ=Once] ds3_s6p9 [Occ=Once] ds4_s6pa [Occ=Once] ds5_s6pb [Occ=Once] ds6_s6pc [Occ=Once] ds7_s6pd [Occ=Once] ds8_s6pe [Occ=Once] _ [Occ=Dead] -> let { sat_s6pi [Occ=Once] :: Text.Regex.TDFA.Common.ExecOption [LclId] = [wild_s6p5] \u [] case Text.Regex.TDFA.Common.regex_execOptions wild_s6p5 of { Text.Regex.TDFA.Common.ExecOption _ [Occ=Dead] -> Text.Regex.TDFA.Common.ExecOption [GHC.Types.False]; }; } in Text.Regex.TDFA.Common.Regex [ds_s6p6 ds1_s6p7 ds2_s6p8 ds3_s6p9 ds4_s6pa ds5_s6pb ds6_s6pc ds7_s6pd ds8_s6pe sat_s6pi]; }; } in Text.Regex.TDFA.NewDFA.Engine.execMatch Data.Text.Lazy.uncons sat_s6pj sat_s6pk sat_s6pl s_s6p4; } in Data.Foldable.length Data.Foldable.$fFoldable[] sat_s6pm; $cmatchOnceText_r6nY :: Text.Regex.TDFA.Common.Regex -> Data.Text.Internal.Lazy.Text -> GHC.Base.Maybe (Data.Text.Internal.Lazy.Text, Text.Regex.Base.RegexLike.MatchText Data.Text.Internal.Lazy.Text, Data.Text.Internal.Lazy.Text) [GblId, Arity=2, Unf=OtherCon []] = [] \r [regex_s6pn source_s6po] let { sat_s6pL [Occ=Once] :: GHC.Base.Maybe (GHC.Arr.Array GHC.Types.Int (GHC.Types.Int, GHC.Types.Int)) [LclId] = [regex_s6pn source_s6po] \u [] let { sat_s6pK [Occ=Once] :: [Text.Regex.Base.RegexLike.MatchArray] [LclId] = [regex_s6pn source_s6po] \u [] let { sat_s6pJ [Occ=Once] :: GHC.Types.Char [LclId] = NO_CCS GHC.Types.C#! ['\n'#]; } in let { sat_s6pI [Occ=Once] :: Text.Regex.TDFA.Common.Position [LclId] = NO_CCS GHC.Types.I#! [0#]; } in Text.Regex.TDFA.NewDFA.Engine.execMatch Data.Text.Lazy.uncons regex_s6pn sat_s6pI sat_s6pJ source_s6po; } in Data.Maybe.listToMaybe sat_s6pK; } in let { sat_s6pH [Occ=Once] :: GHC.Arr.Array GHC.Types.Int (GHC.Types.Int, GHC.Types.Int) -> (Data.Text.Internal.Lazy.Text, GHC.Arr.Array GHC.Types.Int (Data.Text.Internal.Lazy.Text, (GHC.Types.Int, GHC.Types.Int)), Data.Text.Internal.Lazy.Text) [LclId] = [source_s6po] \r [ma_s6pp] let { ds_s6pq :: (GHC.Types.Int, GHC.Types.Int) [LclId] = [ma_s6pp] \u [] let { sat_s6pr [Occ=Once] :: GHC.Types.Int [LclId] = NO_CCS GHC.Types.I#! [0#]; } in Data.Array.Base.! Data.Array.Base.$fIArrayArraye GHC.Arr.$fIxInt ma_s6pp sat_s6pr; } in let { o_s6ps :: GHC.Types.Int [LclId] = [ds_s6pq] \u [] case ds_s6pq of { (,) o1_s6pu [Occ=Once] _ [Occ=Dead] -> o1_s6pu; }; } in let { sat_s6pG [Occ=Once] :: Data.Text.Internal.Lazy.Text [LclId] = [source_s6po ds_s6pq o_s6ps] \u [] let { sat_s6pF [Occ=Once] :: GHC.Types.Int [LclId] = [ds_s6pq o_s6ps] \u [] let { sat_s6pE [Occ=Once] :: GHC.Types.Int [LclId] = [ds_s6pq] \u [] case ds_s6pq of { (,) _ [Occ=Dead] l_s6pD [Occ=Once] -> l_s6pD; }; } in GHC.Num.+ GHC.Num.$fNumInt o_s6ps sat_s6pE; } in $cafter_r6mQ sat_s6pF source_s6po; } in let { sat_s6pA [Occ=Once] :: GHC.Arr.Array GHC.Types.Int (Data.Text.Internal.Lazy.Text, (GHC.Types.Int, GHC.Types.Int)) [LclId] = [source_s6po ma_s6pp] \u [] let { sat_s6pz [Occ=Once] :: (GHC.Types.Int, GHC.Types.Int) -> (Data.Text.Internal.Lazy.Text, (GHC.Types.Int, GHC.Types.Int)) [LclId] = [source_s6po] \r [ol_s6px] let { sat_s6py [Occ=Once] :: Data.Text.Internal.Lazy.Text [LclId] = [source_s6po ol_s6px] \u [] $cextract_r6nK ol_s6px source_s6po; } in (,) [sat_s6py ol_s6px]; } in GHC.Base.fmap GHC.Arr.$fFunctorArray sat_s6pz ma_s6pp; } in let { sat_s6pw [Occ=Once] :: Data.Text.Internal.Lazy.Text [LclId] = [source_s6po o_s6ps] \u [] $cbefore_r6nJ o_s6ps source_s6po; } in (,,) [sat_s6pw sat_s6pA sat_s6pG]; } in GHC.Base.fmap GHC.Base.$fFunctorMaybe sat_s6pH sat_s6pL; Text.Regex.TDFA.Text.Lazy.$fRegexLikeRegexText [InlPrag=NOUSERINLINE CONLIKE] :: Text.Regex.Base.RegexLike.RegexLike Text.Regex.TDFA.Common.Regex Data.Text.Internal.Lazy.Text [GblId[DFunId]] = NO_CCS Text.Regex.Base.RegexLike.C:RegexLike! [Text.Regex.TDFA.Text.Lazy.$fExtractText $cmatchOnce_r6nV $cmatchAll_r6nU $cmatchCount_r6nX $cmatchTest_r6nT $cmatchAllText_r6nW $cmatchOnceText_r6nY]; Text.Regex.TDFA.Text.Lazy.regexec :: Text.Regex.TDFA.Common.Regex -> Data.Text.Internal.Lazy.Text -> Data.Either.Either GHC.Base.String (GHC.Base.Maybe (Data.Text.Internal.Lazy.Text, Data.Text.Internal.Lazy.Text, Data.Text.Internal.Lazy.Text, [Data.Text.Internal.Lazy.Text])) [GblId, Arity=2, Unf=OtherCon []] = [] \r [r_s6pM txt_s6pN] case $cmatchOnceText_r6nY r_s6pM txt_s6pN of { GHC.Base.Nothing -> Data.Either.Right [GHC.Base.Nothing]; GHC.Base.Just ds_s6pP [Occ=Once!] -> case ds_s6pP of { (,,) pre_s6pR [Occ=Once] mt_s6pS post_s6pT [Occ=Once] -> let { sat_s6pZ [Occ=Once] :: [Data.Text.Internal.Lazy.Text] [LclId] = [mt_s6pS] \u [] let { sat_s6pY [Occ=Once] :: [(Data.Text.Internal.Lazy.Text, (Text.Regex.Base.RegexLike.MatchOffset, Text.Regex.Base.RegexLike.MatchLength))] [LclId] = [mt_s6pS] \u [] let { sat_s6pX [Occ=Once] :: [(Data.Text.Internal.Lazy.Text, (Text.Regex.Base.RegexLike.MatchOffset, Text.Regex.Base.RegexLike.MatchLength))] [LclId] = [mt_s6pS] \u [] Data.Array.Base.elems Data.Array.Base.$fIArrayArraye GHC.Arr.$fIxInt mt_s6pS; } in GHC.List.tail sat_s6pX; } in GHC.Base.map Data.Tuple.fst sat_s6pY; } in let { sat_s6pW [Occ=Once] :: Data.Text.Internal.Lazy.Text [LclId] = [mt_s6pS] \u [] let { sat_s6pV [Occ=Once] :: (Data.Text.Internal.Lazy.Text, (Text.Regex.Base.RegexLike.MatchOffset, Text.Regex.Base.RegexLike.MatchLength)) [LclId] = [mt_s6pS] \u [] let { sat_s6pU [Occ=Once] :: GHC.Types.Int [LclId] = NO_CCS GHC.Types.I#! [0#]; } in Data.Array.Base.! Data.Array.Base.$fIArrayArraye GHC.Arr.$fIxInt mt_s6pS sat_s6pU; } in Data.Tuple.fst sat_s6pV; } in let { sat_s6q0 [Occ=Once] :: (Data.Text.Internal.Lazy.Text, Data.Text.Internal.Lazy.Text, Data.Text.Internal.Lazy.Text, [Data.Text.Internal.Lazy.Text]) [LclId] = NO_CCS (,,,)! [pre_s6pR sat_s6pW post_s6pT sat_s6pZ]; } in let { sat_s6q1 [Occ=Once] :: GHC.Base.Maybe (Data.Text.Internal.Lazy.Text, Data.Text.Internal.Lazy.Text, Data.Text.Internal.Lazy.Text, [Data.Text.Internal.Lazy.Text]) [LclId] = NO_CCS GHC.Base.Just! [sat_s6q0]; } in Data.Either.Right [sat_s6q1]; }; }; $cmatch_r6nZ :: Text.Regex.TDFA.Common.Regex -> Data.Text.Internal.Lazy.Text -> Data.Text.Internal.Lazy.Text [GblId] = [] \u [] Text.Regex.Base.Impl.polymatch Text.Regex.TDFA.Text.Lazy.$fRegexLikeRegexText; $cmatchM_r6o0 :: forall (m :: * -> *). GHC.Base.Monad m => Text.Regex.TDFA.Common.Regex -> Data.Text.Internal.Lazy.Text -> m Data.Text.Internal.Lazy.Text [GblId, Arity=1, Unf=OtherCon []] = [] \r [$dMonad_s6q2] Text.Regex.Base.Impl.polymatchM Text.Regex.TDFA.Text.Lazy.$fRegexLikeRegexText $dMonad_s6q2; Text.Regex.TDFA.Text.Lazy.$fRegexContextRegexTextText [InlPrag=NOUSERINLINE CONLIKE] :: Text.Regex.Base.RegexLike.RegexContext Text.Regex.TDFA.Common.Regex Data.Text.Internal.Lazy.Text Data.Text.Internal.Lazy.Text [GblId[DFunId]] = NO_CCS Text.Regex.Base.RegexLike.C:RegexContext! [Text.Regex.TDFA.Text.Lazy.$fRegexLikeRegexText $cmatch_r6nZ $cmatchM_r6o0]; Text.Regex.TDFA.Text.Lazy.execute :: Text.Regex.TDFA.Common.Regex -> Data.Text.Internal.Lazy.Text -> Data.Either.Either GHC.Base.String (GHC.Base.Maybe Text.Regex.Base.RegexLike.MatchArray) [GblId, Arity=2, Unf=OtherCon []] = [] \r [r_s6q3 txt_s6q4] let { sat_s6q5 [Occ=Once] :: GHC.Base.Maybe Text.Regex.Base.RegexLike.MatchArray [LclId] = [r_s6q3 txt_s6q4] \u [] $cmatchOnce_r6nV r_s6q3 txt_s6q4; } in Data.Either.Right [sat_s6q5]; }}} Which I think is strange, because `wnext2` doesn't look like anything GHC would autogenerate, but rather like a name a human would choose on purpose. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 11 21:28:39 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 11 Jan 2018 21:28:39 -0000 Subject: [GHC] #14661: Cannot derive (newtype I a b = I (F a -> F b) deriving newtype Category) for type family F In-Reply-To: <051.db51abc527e2395586903121a4d671be@haskell.org> References: <051.db51abc527e2395586903121a4d671be@haskell.org> Message-ID: <066.419278e93bac98f25005dc19eff355eb@haskell.org> #14661: Cannot derive (newtype I a b = I (F a -> F b) deriving newtype Category) for type family F -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.4.1-alpha1 Resolution: | Keywords: | DerivingStrategies, deriving, | TypeFamilies Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Iceland_jack): Yes this logic should rather be defined in a module/library than in GHC. Any thoughts Simon? Can close this -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 11 21:52:47 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 11 Jan 2018 21:52:47 -0000 Subject: [GHC] #14662: Partial type signatures + mutual recursion = confusion Message-ID: <047.3b31857d5e13c83eb10eb7b983365dfd@haskell.org> #14662: Partial type signatures + mutual recursion = confusion -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.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: -------------------------------------+------------------------------------- I'm trying to understand better how partial type signatures interact with mutual recursion. This is all in 8.4.1-alpha1. Example 1: {{{#!hs f :: forall a. _ -> a -> a f _ x = g True x g :: forall b. _ -> b -> b g _ x = f 'x' x }}} This works -- no problem. Example 2: {{{#!hs f :: forall a. _ -> a -> a f _ x = snd (g True 'a', x) g :: forall b. _ -> b -> b g _ x = f 'x' x }}} This fails, explaining that GHC inferred `g :: Bool -> a -> a` and that `a` doesn't match `Char` (in the second argument of the call site in the body of `f`). This is unsatisfactory because clearly `g` should be ''instantiated'' at `Char`. The manual does say that polymorphic recursion isn't available with partial type signatures, and I suppose this is an example of polymorphic (mutual) recursion. Example 3: {{{#!hs f :: forall a. _ -> a -> a f _ x = snd (g True 'a', x) where g :: forall b. _ -> b -> b g _ y = f 'x' y }}} This is accepted. This is the same example as the last one, but now `g` is local. It does not capture any variables (including type variables) from `f`, so it seems to me that it should be equivalent to Example 2. But somehow GHC is clever enough to accept. Example 4: {{{#!hs thdOf3 (_, _, c) = c f :: forall a. _ -> a -> a f _ x = thdOf3 (g True 'a', g False 5, x) where g :: forall b. _ -> b -> b g _ y = f 'x' y }}} This works, too. Note that `g` is applied at several different types, so it really is being generalized. Example 5: {{{#!hs f :: Int -> forall a. _ -> a -> a f n _ x = snd (g n True 'a', x) g :: Int -> forall b. _ -> b -> b g n _ x = f n 'x' x }}} This is accepted. This is the same as Example 2, but each function now takes an `Int`, which is simply passed back and forth. Evidently, when you write the type non-prenex, polymorphic recursion is OK. Example 6: {{{#!hs f :: Int -> forall a. _ -> a -> a f n _ x = snd (f n True 'x', x) }}} This is accepted, even though it's blatantly using polymorphic recursion. Example 7: {{{#!hs f :: forall a. _ -> a -> a f _ x = snd (f True 'x', x) }}} This is rejected as polymorphically recursive. -------------------------- Something is fishy here. It's not the explicit prenex `forall`s -- leaving those out doesn't change the behavior. I guess my big question is this: * If the user quantifies a partial type signature (either by using `forall`, or just using an out-of-scope type variable and using Haskell's implicit quantification), why can't we use polymorphic recursion with that variable? I understand why we can't use polymorphic recursion with wildcards. ----------------------------------- A little background for context: I'm struggling (in my work on #14066) with GHC's use of `SigTv`s for partial type signatures. I don't have a better suggestion, but `SigTv`s never make me feel good. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 11 22:02:14 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 11 Jan 2018 22:02:14 -0000 Subject: [GHC] #14519: Exponential runtime performance regression in GHC 8.2 + Data.Text.Lazy + Text.RE.TDFA In-Reply-To: <043.92c07e3e0209c31f0a0f195fa98d301c@haskell.org> References: <043.92c07e3e0209c31f0a0f195fa98d301c@haskell.org> Message-ID: <058.067207748d733db7e36a7affda84701d@haskell.org> #14519: Exponential runtime performance regression in GHC 8.2 + Data.Text.Lazy + Text.RE.TDFA -------------------------------------+------------------------------------- Reporter: ntc2 | Owner: tdammers Type: bug | Status: new Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Runtime | Test Case: performance bug | https://github.com/ntc2/ghc-8.2.1 | -regex-lazy-text- | bug/tree/07b7bb32c6e90e8f2d2eada4b59943f37e632d53 Blocked By: | Blocking: Related Tickets: #13745, #14564 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by mpickering): There is a function called `next` in `regex-tdfa` in `Text/Regex/TDFA/NewDFA` which is probably the one you are looking for? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 11 22:33:54 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 11 Jan 2018 22:33:54 -0000 Subject: [GHC] #14662: Partial type signatures + mutual recursion = confusion In-Reply-To: <047.3b31857d5e13c83eb10eb7b983365dfd@haskell.org> References: <047.3b31857d5e13c83eb10eb7b983365dfd@haskell.org> Message-ID: <062.ebb282f6416de99c0b594dcf17df4804@haskell.org> #14662: Partial type signatures + mutual recursion = confusion -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): > If the user quantifies a partial type signature (either by using forall, or just using an out-of-scope type variable and using Haskell's implicit quantification), why can't we use polymorphic recursion with that variable? I recommend caution. Partial type signatures were implemented fairly quickly by a PhD student some time ago, but I have spent many hours since slowly fixing bugs in the implementation. It's much trickier than I supposed at first. (So I'm not blaming him! And its a very nice feature.) Here's a core principle: partial type signatures go entirely via the `InferGen` plan: that is, we use only monomorphic rcursion exactly as if there was no signature. All the signature does is to impose a partial shape on the type of the RHS, including restricting some parts of that type to type variables -- hence the `SigTvs`. (I don't share your dislike; `SigTvs` are very nice actually.) Yes, you could imagine some kind of partial polymorphic recursion, but I don't think it makes sense. Eg {{{ f :: forall a. _ -> a f = ...f @Int...f @Bool..... }}} That wildcard might end up being `a`! If it did, then would the recursive occurrences get instantiate to `Int->Int` and `Bool->Bool`. Certainly not. This way lies madness. The current implementation is quite complicated enough. I agree that documentation is lacking: no, polymorphic recursion is absolutely not available for functions with a partial type signature. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 11 22:44:27 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 11 Jan 2018 22:44:27 -0000 Subject: [GHC] #14626: No need to enter a scrutinised value In-Reply-To: <048.67c951c2aecb97b988badb4816dbe757@haskell.org> References: <048.67c951c2aecb97b988badb4816dbe757@haskell.org> Message-ID: <063.994398bbadada93478def95fc3d9620f@haskell.org> #14626: No need to enter a scrutinised value -------------------------------------+------------------------------------- Reporter: heisenbug | Owner: heisenbug Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: performance Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #13861 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by heisenbug): Replying to [comment:20 heisenbug]: > Replying to [comment:19 heisenbug]: > > Replying to [comment:18 heisenbug]: > > > [snippety] > > > which breaks the contract. Let's see what `getUserData` does... `getSymtabName` should somehow check the `getTag#` of the presumably strict fields and if any of them is 0, `seq` it? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 11 22:47:20 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 11 Jan 2018 22:47:20 -0000 Subject: [GHC] #14626: No need to enter a scrutinised value In-Reply-To: <048.67c951c2aecb97b988badb4816dbe757@haskell.org> References: <048.67c951c2aecb97b988badb4816dbe757@haskell.org> Message-ID: <063.1c77aadee50f849cfb195ee9c3541221@haskell.org> #14626: No need to enter a scrutinised value -------------------------------------+------------------------------------- Reporter: heisenbug | Owner: heisenbug Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: performance Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #13861 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): I'm totally lost. I believe that the `n_occ` field you are referring to is in the `Name` data type {{{ data Name = Name { n_sort :: NameSort, -- What sort of name it is n_occ :: !OccName, -- Its occurrence name n_uniq :: {-# UNPACK #-} !Unique, n_loc :: !SrcSpan -- Definition site } }}} I think you believe you have found some code that is allocating a `Name` without evaluating the `n_occ` field first. But which code? I see no `Name` allocation above? Also I am still perplexed about why you are trying to debug GHC itself. Why not run the testsuite with the stage1 compiler; and the nofib; and see if/when your assertions trip? Starting with the largest Haskell program in the world seems... ambitious. Or are you saying that you did all that, and not a single assertion tripped? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 11 22:52:07 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 11 Jan 2018 22:52:07 -0000 Subject: [GHC] #14626: No need to enter a scrutinised value In-Reply-To: <048.67c951c2aecb97b988badb4816dbe757@haskell.org> References: <048.67c951c2aecb97b988badb4816dbe757@haskell.org> Message-ID: <063.816ba604ef754239b1fffe86bee39f4b@haskell.org> #14626: No need to enter a scrutinised value -------------------------------------+------------------------------------- Reporter: heisenbug | Owner: heisenbug Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: performance Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #13861 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): > getSymtabName should somehow check the getTag# of the presumably strict fields and if any of them is 0, seq it? I don't think so. Here's its code: {{{ getSymtabName _ncu _dict symtab bh = do i :: Word32 <- get bh case i .&. 0xC0000000 of 0x00000000 -> return $! symtab ! fromIntegral i 0x80000000 -> let tag = chr (fromIntegral ((i .&. 0x3FC00000) `shiftR` 22)) ix = fromIntegral i .&. 0x003FFFFF u = mkUnique tag ix in return $! case lookupKnownKeyName u of Nothing -> pprPanic "getSymtabName:unknown known-key unique" (ppr i $$ ppr (unpkUnique u)) Just n -> n _ -> pprPanic "getSymtabName:unknown name tag" (ppr i) }}} The only way it can return a `Name` is either as a result of `lookupKownKeyName` or as ar result of indexing `symtab`. Both should return properly formed names. Maybe somehow one of them isn't? But which one? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 11 23:08:27 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 11 Jan 2018 23:08:27 -0000 Subject: [GHC] #14626: No need to enter a scrutinised value In-Reply-To: <048.67c951c2aecb97b988badb4816dbe757@haskell.org> References: <048.67c951c2aecb97b988badb4816dbe757@haskell.org> Message-ID: <063.e54ba4ba1fb4ec89eed9dab30a48a363@haskell.org> #14626: No need to enter a scrutinised value -------------------------------------+------------------------------------- Reporter: heisenbug | Owner: heisenbug Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: performance Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #13861 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by heisenbug): Replying to [comment:23 simonpj]: > > getSymtabName should somehow check the getTag# of the presumably strict fields and if any of them is 0, seq it? > > I don't think so. Here's its code: > {{{ > getSymtabName _ncu _dict symtab bh = do > i :: Word32 <- get bh > case i .&. 0xC0000000 of > 0x00000000 -> return $! symtab ! fromIntegral i > > 0x80000000 -> > let > tag = chr (fromIntegral ((i .&. 0x3FC00000) `shiftR` 22)) > ix = fromIntegral i .&. 0x003FFFFF > u = mkUnique tag ix > in > return $! case lookupKnownKeyName u of > Nothing -> pprPanic "getSymtabName:unknown known- key unique" > (ppr i $$ ppr (unpkUnique u)) > Just n -> n > > _ -> pprPanic "getSymtabName:unknown name tag" (ppr i) > }}} > The only way it can return a `Name` is either as a result of `lookupKownKeyName` or as ar result of indexing `symtab`. Both should return properly formed names. Maybe somehow one of them isn't? But which one? I bet it comes from the call to `getDictionary` in `BinIface.hs`. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 11 23:12:15 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 11 Jan 2018 23:12:15 -0000 Subject: [GHC] #14626: No need to enter a scrutinised value In-Reply-To: <048.67c951c2aecb97b988badb4816dbe757@haskell.org> References: <048.67c951c2aecb97b988badb4816dbe757@haskell.org> Message-ID: <063.fdb2a1bf4b7c39696d9020226af4eff9@haskell.org> #14626: No need to enter a scrutinised value -------------------------------------+------------------------------------- Reporter: heisenbug | Owner: heisenbug Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: performance Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #13861 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by heisenbug): Replying to [comment:22 simonpj]: > I'm totally lost. I believe that the `n_occ` field you are referring to is in the `Name` data type > {{{ > data Name = Name { > n_sort :: NameSort, -- What sort of name it is > n_occ :: !OccName, -- Its occurrence name > n_uniq :: {-# UNPACK #-} !Unique, > n_loc :: !SrcSpan -- Definition site > } > }}} > I think you believe you have found some code that is allocating a `Name` without evaluating the `n_occ` field first. But which code? I see no `Name` allocation above? > > Also I am still perplexed about why you are trying to debug GHC itself. Why not run the testsuite with the stage1 compiler; and the nofib; and see if/when your assertions trip? Starting with the largest Haskell program in the world seems... ambitious. Well, hubris :-) Seriously, it only happens with GHC! > > Or are you saying that you did all that, and not a single assertion tripped? > I tried a lot of things. All seemed to work. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 12 01:21:13 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 12 Jan 2018 01:21:13 -0000 Subject: [GHC] #14663: Deriving Typeable for enumerations seems expensive Message-ID: <046.f6a840bdc5006a4360df3a724cb886a0@haskell.org> #14663: Deriving Typeable for enumerations seems expensive -------------------------------------+------------------------------------- Reporter: niteria | Owner: (none) Type: bug | Status: new Priority: low | Milestone: Component: Compiler | Version: 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 have a module `A10000` that looks like this: {{{ module A10000 where data A = A | A00001 | A00002 ... | A10000 }}} Currently compiling it with `./inplace/bin/ghc-stage2 A10000.hs +RTS -s` produces: {{{ [1 of 1] Compiling A10000 ( A10000.hs, A10000.o ) 4,133,470,392 bytes allocated in the heap 1,194,866,080 bytes copied during GC 141,604,816 bytes maximum residency (14 sample(s)) 813,104 bytes maximum slop 341 MB total memory in use (0 MB lost due to fragmentation) Tot time (elapsed) Avg pause Max pause Gen 0 329 colls, 0 par 0.551s 0.551s 0.0017s 0.0246s Gen 1 14 colls, 0 par 0.453s 0.453s 0.0323s 0.1031s TASKS: 4 (1 bound, 3 peak workers (3 total), using -N1) SPARKS: 0 (0 converted, 0 overflowed, 0 dud, 0 GC'd, 0 fizzled) INIT time 0.000s ( 0.000s elapsed) MUT time 1.498s ( 1.730s elapsed) GC time 1.004s ( 1.004s elapsed) EXIT time 0.000s ( 0.006s elapsed) Total time 2.502s ( 2.740s elapsed) Alloc rate 2,759,911,143 bytes per MUT second Productivity 59.9% of total user, 63.4% of total elapsed }}} I've noticed a lot of code getting generated (>500k lines of ASM), particularly interesting was code that supported `TyCon`s. I've tried again disabling the generation of `TyCon`s by modifying: {{{ mkTypeRepTodoBinds :: [TypeRepTodo] -> TcM TcGblEnv mkTypeRepTodoBinds _ = getGblEnv }}} This is the result: {{{ [1 of 1] Compiling A10000 ( A10000.hs, A10000.o ) 1,731,693,280 bytes allocated in the heap 280,362,376 bytes copied during GC 41,423,608 bytes maximum residency (10 sample(s)) 746,272 bytes maximum slop 102 MB total memory in use (0 MB lost due to fragmentation) Tot time (elapsed) Avg pause Max pause Gen 0 401 colls, 0 par 0.111s 0.111s 0.0003s 0.0065s Gen 1 10 colls, 0 par 0.124s 0.124s 0.0124s 0.0298s TASKS: 4 (1 bound, 3 peak workers (3 total), using -N1) SPARKS: 0 (0 converted, 0 overflowed, 0 dud, 0 GC'd, 0 fizzled) INIT time 0.000s ( 0.000s elapsed) MUT time 0.773s ( 0.889s elapsed) GC time 0.235s ( 0.235s elapsed) EXIT time 0.000s ( 0.007s elapsed) Total time 1.008s ( 1.130s elapsed) Alloc rate 2,241,052,377 bytes per MUT second Productivity 76.7% of total user, 79.2% of total elapsed }}} It appears that by default I pay >50% of compile time for a feature that I probably won't use. I'm sorry if this is a duplicate, I've looked at https://ghc.haskell.org/trac/ghc/wiki/Typeable, but nothing seemed relevant. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 12 01:53:05 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 12 Jan 2018 01:53:05 -0000 Subject: [GHC] #14182: Allow full control over dyn lib names In-Reply-To: <045.073c1d99e34a3803119019c2f0a9d718@haskell.org> References: <045.073c1d99e34a3803119019c2f0a9d718@haskell.org> Message-ID: <060.8f464593765a0e04a87691853dac89a2@haskell.org> #14182: Allow full control over dyn lib names -------------------------------------+------------------------------------- Reporter: duncan | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Package system | Version: 8.2.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by lelf): * cc: lelf (added) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 12 03:11:35 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 12 Jan 2018 03:11:35 -0000 Subject: [GHC] #14444: Linker limit on OS X Sierra breaks builds for big projects In-Reply-To: <049.ef1cbd3eecd105a31deac573ded19c35@haskell.org> References: <049.ef1cbd3eecd105a31deac573ded19c35@haskell.org> Message-ID: <064.3e338686c2e28e6389968486485e1822@haskell.org> #14444: Linker limit on OS X Sierra breaks builds for big projects -------------------------------------+------------------------------------- Reporter: dredozubov | Owner: angerman Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 (Linking) | Resolution: | Keywords: Operating System: MacOS X | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by lelf): * cc: lelf (added) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 12 05:07:06 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 12 Jan 2018 05:07:06 -0000 Subject: [GHC] #14619: Output value of program changes upon compiling with -O optimizations In-Reply-To: <044.7bc7afdc77e978715c67bc6238b57042@haskell.org> References: <044.7bc7afdc77e978715c67bc6238b57042@haskell.org> Message-ID: <059.1ca7f21387a609e3bfc72ed827af33f6@haskell.org> #14619: Output value of program changes upon compiling with -O optimizations -------------------------------------+------------------------------------- Reporter: sheaf | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.4.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Windows | Architecture: x86_64 Type of failure: Incorrect result | (amd64) at runtime | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by lelf): * cc: lelf (added) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 12 05:15:16 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 12 Jan 2018 05:15:16 -0000 Subject: [GHC] #14069: RTS linker maps code as writable In-Reply-To: <046.9e22b0896a2cacfd4a0714e7a6c1497b@haskell.org> References: <046.9e22b0896a2cacfd4a0714e7a6c1497b@haskell.org> Message-ID: <061.90dde7180afc5966773981e1e4a44404@haskell.org> #14069: RTS linker maps code as writable -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: new Priority: high | Milestone: 8.4.1 Component: Runtime System | Version: 8.0.1 (Linker) | Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by lelf): * cc: lelf (added) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 12 05:29:18 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 12 Jan 2018 05:29:18 -0000 Subject: [GHC] #5889: -fno-prof-count-entries leads to linking errors In-Reply-To: <043.c51b50cea9fd3755f487a8490fe8400e@haskell.org> References: <043.c51b50cea9fd3755f487a8490fe8400e@haskell.org> Message-ID: <058.b867e5a8dd6feb33fc73725cb4ad2566@haskell.org> #5889: -fno-prof-count-entries leads to linking errors -------------------------------------+------------------------------------- Reporter: akio | Owner: bgamari Type: bug | Status: new Priority: highest | Milestone: 8.4.1 Component: Compiler | Version: 8.3 Resolution: | Keywords: Operating System: Linux | Architecture: x86_64 | (amd64) Type of failure: GHC rejects | Test Case: valid program | profiling/should_compile/T5889 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by osa1): I just realized that in the test program `-fspec-constr` eliminates the cost centers in the use site. So - `-O` fails, cost centers are there in the use site - `-O -fspec-constr` works -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 12 06:11:47 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 12 Jan 2018 06:11:47 -0000 Subject: [GHC] #14664: "GHC.Integer can't throw exceptions" is wrong Message-ID: <045.bb424a774c8b0cd8f542a7f3b5a2b9d8@haskell.org> #14664: "GHC.Integer can't throw exceptions" is wrong -------------------------------------+------------------------------------- Reporter: Zemyla | Owner: (none) Type: feature | Status: new request | Priority: low | Milestone: Component: Compiler | Version: 8.2.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: -------------------------------------+------------------------------------- The various integer packages, and anything else that might be loaded before the Prelude, goes through contortions to report errors, or else doesn't report them and crashes, because those packages are compiled before the `Exception` type is available. However, there is a way to throw exceptions from code that only has access to `ghc-prim`. It relies on the fact that the RTS itself throws an exception in a certain circumstance: when `atomically` is called from within `atomically`. This gives us the following: {{{#!hs {-# LANGUAGE MagicHash, UnboxedTuples, NoImplicitPrelude #-} import GHC.Prim import GHC.Magic atomicLoop :: State# RealWorld -> (# State# RealWorld, a #) atomicLoop s = atomically atomicLoop s exception :: a exception = runRW# (\s -> case atomicLoop s of (# _, a #) -> a) }}} I think that `integer-simple` and `integer-gmp`, and maybe the very earliest parts of `base`, are the only packages that would benefit from this circumlocution; however, having the error be a catchable exception rather than a straight-up crash has benefits. Priority is low because I don't think there have been any bugs regarding GHC.Integer crashing; I just think it might make the code a bit more elegant. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 12 08:24:20 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 12 Jan 2018 08:24:20 -0000 Subject: [GHC] #14519: Exponential runtime performance regression in GHC 8.2 + Data.Text.Lazy + Text.RE.TDFA In-Reply-To: <043.92c07e3e0209c31f0a0f195fa98d301c@haskell.org> References: <043.92c07e3e0209c31f0a0f195fa98d301c@haskell.org> Message-ID: <058.fa7dd1ea2e0de20e9cdf969e433ca629@haskell.org> #14519: Exponential runtime performance regression in GHC 8.2 + Data.Text.Lazy + Text.RE.TDFA -------------------------------------+------------------------------------- Reporter: ntc2 | Owner: tdammers Type: bug | Status: new Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Runtime | Test Case: performance bug | https://github.com/ntc2/ghc-8.2.1 | -regex-lazy-text- | bug/tree/07b7bb32c6e90e8f2d2eada4b59943f37e632d53 Blocked By: | Blocking: Related Tickets: #13745, #14564 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by tdammers): Right, didn't think to try without the `w-` and the `-2`. On my setup, there's no `next` in `Text/Regex/TDFA/NewDFA`, but four similar modules underneath it (`Engine`, `Engine_FA`, `Engine_NC`, and `Engine_NC_FA`) do have such a function defined in a let binding. It seems that the `Lazy` module ends up using the one in `Engine` (without any suffix), via `execMatch`. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 12 08:42:10 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 12 Jan 2018 08:42:10 -0000 Subject: [GHC] #14626: No need to enter a scrutinised value In-Reply-To: <048.67c951c2aecb97b988badb4816dbe757@haskell.org> References: <048.67c951c2aecb97b988badb4816dbe757@haskell.org> Message-ID: <063.ddcbf1b9e2e6c461d5bb67c86f9cf2cb@haskell.org> #14626: No need to enter a scrutinised value -------------------------------------+------------------------------------- Reporter: heisenbug | Owner: heisenbug Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: performance Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #13861 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): I think you believe that there is a heap-allocated `Name` with an un- evaluated `n_occ` field. There is only one place in the code generator namely `StgCmmCon.buildDynCon'`. You could perhaps add (runtime) assertions there to see if any strict fields had un-tagged pointers. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 12 08:49:59 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 12 Jan 2018 08:49:59 -0000 Subject: [GHC] #14663: Deriving Typeable for enumerations seems expensive In-Reply-To: <046.f6a840bdc5006a4360df3a724cb886a0@haskell.org> References: <046.f6a840bdc5006a4360df3a724cb886a0@haskell.org> Message-ID: <061.7d8ce0673b11aade354e19bdf79b85f3@haskell.org> #14663: Deriving Typeable for enumerations seems expensive -------------------------------------+------------------------------------- Reporter: niteria | Owner: (none) Type: bug | Status: new Priority: low | Milestone: Component: Compiler | Version: Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): > It appears that by default I pay >50% of compile time for a feature that I probably won't use. Yes, we debated this quite a bit. For each data type we generate a bit of static information, just Haskell data structures, to describe the type. That way, anyone (in another module) who needs `Typeable T` or `Typeable 'A0001` can have it. But mostly they don't need that, so it's wasted bloat. Another alternative is to generate those data structure on-the-fly in every client module. Before long we'd be saying "let's avoid doing that multiple times in the same module, or doing it in module M if it's already done in one of M's imports", and we'd add machinery to avoid duplication. That is all extra complexity. Maybe it's justified. It'd be interesting to know who else tripped over this. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 12 08:58:58 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 12 Jan 2018 08:58:58 -0000 Subject: [GHC] #14664: "GHC.Integer can't throw exceptions" is wrong In-Reply-To: <045.bb424a774c8b0cd8f542a7f3b5a2b9d8@haskell.org> References: <045.bb424a774c8b0cd8f542a7f3b5a2b9d8@haskell.org> Message-ID: <060.79c2adb0978e57bd9e9a240620a821e7@haskell.org> #14664: "GHC.Integer can't throw exceptions" is wrong -------------------------------------+------------------------------------- Reporter: Zemyla | Owner: (none) Type: feature request | Status: new Priority: low | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Interesting. But if we were going to do this we might want to build some (modest) direct RTS support, rather than using `atomically` for a purpose it wasn't designed for. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 12 09:29:53 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 12 Jan 2018 09:29:53 -0000 Subject: [GHC] #14519: Exponential runtime performance regression in GHC 8.2 + Data.Text.Lazy + Text.RE.TDFA In-Reply-To: <043.92c07e3e0209c31f0a0f195fa98d301c@haskell.org> References: <043.92c07e3e0209c31f0a0f195fa98d301c@haskell.org> Message-ID: <058.250a2746c52a7b7895d773f85de378ad@haskell.org> #14519: Exponential runtime performance regression in GHC 8.2 + Data.Text.Lazy + Text.RE.TDFA -------------------------------------+------------------------------------- Reporter: ntc2 | Owner: tdammers Type: bug | Status: new Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Runtime | Test Case: performance bug | https://github.com/ntc2/ghc-8.2.1 | -regex-lazy-text- | bug/tree/07b7bb32c6e90e8f2d2eada4b59943f37e632d53 Blocked By: | Blocking: Related Tickets: #13745, #14564 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Something is spitting out this line in the ticky dump {{{ 2250377760180010799840 0 2 Mi $wnext2{v reC2} (regex-tdfa- text-1.0.0.3-CIfFZ6rjdCoJI5EFpqTwBO:Text.Regex.TDFA.Text.Lazy) (fun) }}} So the string "$wnext2{v reC2}" must appear in some `.o` file. I'd do `strings *.o | grep ` to find it. It it easy to repro? I don't see precise instructions above. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 12 09:31:21 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 12 Jan 2018 09:31:21 -0000 Subject: [GHC] #14661: Cannot derive (newtype I a b = I (F a -> F b) deriving newtype Category) for type family F In-Reply-To: <051.db51abc527e2395586903121a4d671be@haskell.org> References: <051.db51abc527e2395586903121a4d671be@haskell.org> Message-ID: <066.0dacf55bdebf7b572e0ed04b80f8d8a3@haskell.org> #14661: Cannot derive (newtype I a b = I (F a -> F b) deriving newtype Category) for type family F -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.4.1-alpha1 Resolution: | Keywords: | DerivingStrategies, deriving, | TypeFamilies Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): > Well sure—you can't use GeneralizedNewtypeDeriving on a non-newtype The newtype is called `Ixed`. The type function is `Interp`. Turning it into a data type (and removing the instances) simplifies the example, but does not affect the payload. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 12 09:57:58 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 12 Jan 2018 09:57:58 -0000 Subject: [GHC] #14661: Cannot derive (newtype I a b = I (F a -> F b) deriving newtype Category) for type family F In-Reply-To: <051.db51abc527e2395586903121a4d671be@haskell.org> References: <051.db51abc527e2395586903121a4d671be@haskell.org> Message-ID: <066.fbc492a1b4be4045fe27a91babe35198@haskell.org> #14661: Cannot derive (newtype I a b = I (F a -> F b) deriving newtype Category) for type family F -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.4.1-alpha1 Resolution: | Keywords: | DerivingStrategies, deriving, | TypeFamilies Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Trac 14661 Hmm. What is `DerivingVia`? Is it implemented, documented? I agree this is a feature request, going significantly beyond what GHC can do right now. However, the new feature looks tantalisingly close. E.g. for `instance Category Ixed` we need to find {{{ id :: forall a. Ixed a a }}} Expanding the type representation gives {{{ id1 :: forall a. Interp a -> Interp a }}} We have in hand the `(->)` instance of `Category`: {{{ id @(->) :: forall b. b -> b }}} and in fact we can readily instantiate `id @(->)@` to match the needed type. So, could we imagine this? Given {{{ newtype N a b = MkN (R t1 t2 t3) deriving( Category ) }}} we want to derive `instance ... => C N` given `instance ... => C R`. Suppose we have a method in class `C` {{{ class R (c :: * -> * -> *) where foo :: forall p q. ...(c s1 s2)... }}} (NB: for now I will assume that `c` appears fully applied in `foo`'s type.) Then we will have available `foo1 :: forall p q. ...(R s1 s2)...` and we want to get `foo2 :: forall p q. ...(N s1 s2)...`. Well from the newtype declaration we have an axiom that equates the representation types of `(N a b)` and `(R t1 t2 t3)`: {{{ ax :: forall a b. N a b ~R R t1 t2 t3 }}} So, if we could find {{{ foo3 :: forall p q. ...(R t1[s1/a,s2/q] t2[s1/a,s2/q] t3[s1/a,s2/q]) ... }}} we'd be home and dry, because then we can use `ax` to get from `foo3` to `foo2`. How can we get `foo3`? Well, it's possible that we can get it just by instantiating the type of `foo1`. In the case of `id` in `Category` we have {{{ id1 :: forall a. (->) a a -- Available, given id2 :: forall a. Ixed a a -- Wanted id3 :: forall a. (->) (Interp a) (Interp a) -- Wanted }}} And indeed we can get `id3` from `id1` by instantiation. This won't always work as Ryan points out, but sometimes. And I suppose we could work that out. It seems rather elaborate though! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 12 10:35:25 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 12 Jan 2018 10:35:25 -0000 Subject: [GHC] #13253: Exponential compilation time with RWST & ReaderT stack with `-02` In-Reply-To: <045.b3c468c50b4e8e33ee0981a3ab0c6b4b@haskell.org> References: <045.b3c468c50b4e8e33ee0981a3ab0c6b4b@haskell.org> Message-ID: <060.85a2980dbf097240af963c71ae1d0407@haskell.org> #13253: Exponential compilation time with RWST & ReaderT stack with `-02` -------------------------------------+------------------------------------- Reporter: phadej | Owner: dfeuer Type: bug | Status: new Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.0.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Ah, yes I think you may be on to something. Suppose we have {{{ case2 (case1 e of True -> e1 False -> e2) of True -> r1 False -> r2 }}} and suppose that `r1` and `r2` are small. (If they aren't they get bound as join points.) I've put numbers on the `case1` and `case2` so we can talk about them, but they are just ordinary Core `case` expressions. Then we push the outer `case2` into the right hand sides of `case1` thus {{{ case1 e of True -> case2 e1 of True -> r1 False -> r2 False -> case2 e2 of True -> r1 False -> r2 }}} We have (by design) duplicated outer `case2`. Now suppose that entire expression E was surrounded by `case3 E of { True -> s1; False -> s2 }`. Again `s1` and `s2` are small. Then we'll duplicate that into alternatives of `case1` and then into the alternatives of `case2`, to get this {{{ case1 e of True -> case2 e1 of True -> case3 r1 of { True -> s2; False -> s2 } False -> case3 r2 of { True -> s2; False -> s2 } False -> case2 e2 of True -> case3 r1 of { True -> s2; False -> s2 } False -> case3 r2 of { True -> s2; False -> s2 } }}} Now we have four copies of `case3`. You can see how this may go exponential. How can we get these deepyly nested cases? Suppose {{{ f x = case x of { True -> e1; False -> e2 } }}} and we have `f (f (f (f (f (f blah)))))`. If we inline `f` we'll get exactly such a deep nest of cases. Here is a concrete example {{{ f :: Int -> Bool -> Bool {-# INLINE f #-} f y x = case x of { True -> y>0 ; False -> y<0 } foo y x = f (y+1) $ f (y+2) $ f (y+3) $ f (y+4) $ f (y+5) $ f (y+6) $ f (y+7) $ f (y+8) $ f (y+9) $ f y x }}} Sure enough, adding one more line to `foo` doubles the size of the optimised code. And this is very similar to the chain of `<*>` applications that seems to trigger the problem in the Description. So this looks like the root cause of the problem, which is great progress. And now we have a tiny repro case, which is also super-helpful. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 12 11:51:59 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 12 Jan 2018 11:51:59 -0000 Subject: [GHC] #14665: http://www.cminusminus.org/ is dead Message-ID: <046.ee5d0668b0e8cf9e55beec4faafe96d3@haskell.org> #14665: http://www.cminusminus.org/ is dead -------------------------------------+------------------------------------- Reporter: niteria | Owner: (none) Type: task | Status: new Priority: lowest | Milestone: Component: Documentation | Version: 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: -------------------------------------+------------------------------------- There are a couple of comments referring to it in the source, it's easy enough to find the original site at the mirror: http://www.cs.tufts.edu/~nr/c--/index.html or from the wayback machine: https://web.archive.org/web/20080822062234/http://www.cminusminus.org/ If we no longer own the domain, perhaps it would be a good idea to move it under haskell.org somewhere? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 12 12:56:56 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 12 Jan 2018 12:56:56 -0000 Subject: [GHC] #14331: Overzealous free-floating kind check causes deriving clause to be rejected In-Reply-To: <050.cb87f2a10e38fd0ac57d92b074ac5d5b@haskell.org> References: <050.cb87f2a10e38fd0ac57d92b074ac5d5b@haskell.org> Message-ID: <065.610b8c88303b722d11f1976cff1da869@haskell.org> #14331: Overzealous free-floating kind check causes deriving clause to be rejected -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.4.1 Component: Compiler (Type | Version: 8.2.1 checker) | Resolution: | Keywords: deriving Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: GHC rejects | Test Case: valid program | deriving/should_compile/T14331 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Ryan is spot on in comment:56 (i.e. this is different to #11732), and also in comment:52 (i.e. `deriving( Cat k )` should fail if we really mean `deriving( Cat Type )`. Ryan this is in your patch, indeed right in the area you have in-flight work on. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 12 14:09:14 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 12 Jan 2018 14:09:14 -0000 Subject: [GHC] #13253: Exponential compilation time with RWST & ReaderT stack with `-02` In-Reply-To: <045.b3c468c50b4e8e33ee0981a3ab0c6b4b@haskell.org> References: <045.b3c468c50b4e8e33ee0981a3ab0c6b4b@haskell.org> Message-ID: <060.60720caecb414e4e4ace570db1ba3424@haskell.org> #13253: Exponential compilation time with RWST & ReaderT stack with `-02` -------------------------------------+------------------------------------- Reporter: phadej | Owner: dfeuer Type: bug | Status: new Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.0.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by phadej): I might be pointing out the obvious, but given Simon's example {{{ module Expfoo (f, foo, bar) where f :: Int -> Bool -> Bool {-# INLINE f #-} f y x = case x of { True -> y>0 ; False -> y<0 } foo :: Int -> Bool -> Bool foo y x = f (y+1) $ f (y+2) $ f (y+3) $ f (y+4) $ f (y+5) $ f (y+6) $ f (y+7) $ f (y+8) $ f (y+9) $ f y x bar :: Bool bar = foo 10 True }}} The -ddump-simpl -ddump-simpl-stats say {{{ 2157 PostInlineUnconditionally 2060 x_a28M 2129 KnownBranch 2060 wild_a28K 1024 FillInCaseDefault 512 wild_X1l 256 wild_X1n 128 wild_X1p 64 wild_X1r 32 wild_X1t 16 wild_X1v 8 wild_X1x 4 wild_X1z 2 wild_Xc 2 wild_X1y bar = GHC.Types.True }}} I.e. simplifier is able to calculate `bar` value, which is great! But it does exponential job while trying to figure out what's `foo`. However if we only export {{{ module Expfoo (f, bar) where }}} then `bar` is still `True`, but stats looks way better, all Grand total simplifier statistics are under 12, e.g. {{{ 8 CaseOfCase 8 wild_Xb 73 KnownBranch 11 wild1_a28w 10 wild_a28s 9 wild1_a28m 9 wild_a28K 9 wild1_a28O 8 wild_a28i 2 wild_Xb 2 wild_X17 2 wild_X19 2 wild_X1b 2 wild_X1d 2 wild_X1f 2 wild_X1h 2 wild_X1j 1 wild_X1m 1 FillInCaseDefault 1 wild_Xb 12 SimplifierDone 12 }}} I'm quite sure that while fixing the exponential time issue, we should "break" the fact that `bar` is fully simplified to `True`. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 12 14:21:16 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 12 Jan 2018 14:21:16 -0000 Subject: [GHC] #14331: Overzealous free-floating kind check causes deriving clause to be rejected In-Reply-To: <050.cb87f2a10e38fd0ac57d92b074ac5d5b@haskell.org> References: <050.cb87f2a10e38fd0ac57d92b074ac5d5b@haskell.org> Message-ID: <065.31844786c259b33f3524e6c2ba42fc73@haskell.org> #14331: Overzealous free-floating kind check causes deriving clause to be rejected -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.4.1 Component: Compiler (Type | Version: 8.2.1 checker) | Resolution: | Keywords: deriving Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: GHC rejects | Test Case: valid program | deriving/should_compile/T14331 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Iceland_jack): comment:56 is self-referential :-) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 12 14:23:43 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 12 Jan 2018 14:23:43 -0000 Subject: [GHC] #14331: Overzealous free-floating kind check causes deriving clause to be rejected In-Reply-To: <050.cb87f2a10e38fd0ac57d92b074ac5d5b@haskell.org> References: <050.cb87f2a10e38fd0ac57d92b074ac5d5b@haskell.org> Message-ID: <065.2837cf5cd7bf4ecb4da2cabc3af8957d@haskell.org> #14331: Overzealous free-floating kind check causes deriving clause to be rejected -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.4.1 Component: Compiler (Type | Version: 8.2.1 checker) | Resolution: | Keywords: deriving Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: GHC rejects | Test Case: valid program | deriving/should_compile/T14331 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by goldfire): See comment:14:ticket:11732 and environs for how this is at odds. But it's probably not worth rehashing it all. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 12 14:32:26 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 12 Jan 2018 14:32:26 -0000 Subject: [GHC] #14331: Overzealous free-floating kind check causes deriving clause to be rejected In-Reply-To: <050.cb87f2a10e38fd0ac57d92b074ac5d5b@haskell.org> References: <050.cb87f2a10e38fd0ac57d92b074ac5d5b@haskell.org> Message-ID: <065.9f2999f932f14542841eeee7dfd1cd46@haskell.org> #14331: Overzealous free-floating kind check causes deriving clause to be rejected -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.4.1 Component: Compiler (Type | Version: 8.2.1 checker) | Resolution: | Keywords: deriving Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: GHC rejects | Test Case: valid program | deriving/should_compile/T14331 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Iceland_jack): How about inferring wildcards? Should I open a ticket {{{#!hs newtype Fun1 a b = Fun1 (a -> b) deriving (Cat _) }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 12 14:36:28 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 12 Jan 2018 14:36:28 -0000 Subject: [GHC] #5889: -fno-prof-count-entries leads to linking errors In-Reply-To: <043.c51b50cea9fd3755f487a8490fe8400e@haskell.org> References: <043.c51b50cea9fd3755f487a8490fe8400e@haskell.org> Message-ID: <058.ff1a16cb76851ab1af886d64c12db1b8@haskell.org> #5889: -fno-prof-count-entries leads to linking errors -------------------------------------+------------------------------------- Reporter: akio | Owner: bgamari Type: bug | Status: new Priority: highest | Milestone: 8.4.1 Component: Compiler | Version: 8.3 Resolution: | Keywords: Operating System: Linux | Architecture: x86_64 | (amd64) Type of failure: GHC rejects | Test Case: valid program | profiling/should_compile/T5889 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by osa1): I just checked what simplifier pass optimizes these cost centers in the definition site, and then checked why the same pass does not optimize the same way in the use site. The pass is `post-worker-wrapper`. Before the pass `bar` looks like this: {{{ bar = \ (n_a1Gx :: Integer) (m_a1Gy [Dmd=] :: Maybe Integer) -> scc let { ds_s2rs [Dmd=] :: (Integer, Integer) [LclId, Unf=Unf{Src=, TopLvl=False, Value=False, ConLike=False, WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 30 0}] ds_s2rs = let { ds_s2rs [Dmd=] :: (Integer, Integer) [LclId, Unf=Unf{Src=, TopLvl=False, Value=False, ConLike=False, WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 30 0}] ds_s2rs = scc split n_a1Gx m_a1Gy } in case ds_s2rs of ww_s2sc { (ww_s2sd [Dmd=], ww_s2se [Dmd=]) -> (ww_s2sd, ww_s2se) } in plus_noinline (scc case ds_s2rs of { (y_a2pz [Dmd=], z_a2pB [Dmd=]) -> y_a2pz }) (scc case ds_s2rs of { (y_a2pz [Dmd=], z_a2pB [Dmd=]) -> z_a2pB }) }}} after: {{{ bar = \ (n_a1Gx :: Integer) (m_a1Gy :: Maybe Integer) -> scc case scc split n_a1Gx m_a1Gy of { (ww_s2sd [Dmd=], ww_s2se [Dmd=]) -> plus_noinline ww_s2sd ww_s2se } }}} The same pass in `A` does nothing. The program before and after the pass looks like this: {{{ ds_s4uU :: (Integer, Integer) [LclId, Unf=Unf{Src=, TopLvl=True, Value=False, ConLike=False, WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 50 30}] ds_s4uU = scc scc case B.$wsplit n_s4uS (GHC.Base.Nothing @ Integer) of { (# ww1_s2sg, ww2_s2sh #) -> (ww1_s2sg, ww2_s2sh) } main_s37c :: String [LclId, Unf=Unf{Src=, TopLvl=True, Value=False, ConLike=False, WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 110 30}] main_s37c = case GHC.Show.$w$cshowsPrec4 0# (scc plus_noinline (scc case ds_s4uU of { (y_a2pz [Dmd=], z_a2pB [Dmd=]) -> y_a2pz }) (scc case ds_s4uU of { (y_a2pz [Dmd=], z_a2pB [Dmd=]) -> z_a2pB })) (GHC.Types.[] @ Char) of { (# ww3_a376, ww4_a377 #) -> GHC.Types.: @ Char ww3_a376 ww4_a377 } }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 12 15:03:04 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 12 Jan 2018 15:03:04 -0000 Subject: [GHC] #5889: -fno-prof-count-entries leads to linking errors In-Reply-To: <043.c51b50cea9fd3755f487a8490fe8400e@haskell.org> References: <043.c51b50cea9fd3755f487a8490fe8400e@haskell.org> Message-ID: <058.7053ae25386550a416298dbdfb8189b8@haskell.org> #5889: -fno-prof-count-entries leads to linking errors -------------------------------------+------------------------------------- Reporter: akio | Owner: bgamari Type: bug | Status: new Priority: highest | Milestone: 8.4.1 Component: Compiler | Version: 8.3 Resolution: | Keywords: Operating System: Linux | Architecture: x86_64 | (amd64) Type of failure: GHC rejects | Test Case: valid program | profiling/should_compile/T5889 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by osa1): I wonder if this could be related with inlining worker for `split`. This program {{{ import A {-# NOINLINE b #-} b :: Integer b = bar 100 Nothing }}} compiles to {{{ ds_r4vL :: (Integer, Integer) [GblId] ds_r4vL = scc scc case B.$wsplit n_r4u9 (GHC.Base.Nothing @ Integer) of { (# ww1_s2sg, ww2_s2sh #) -> (ww1_s2sg, ww2_s2sh) } b [InlPrag=NOINLINE] :: Integer [GblId] b = scc plus_noinline (scc case ds_r4vL of { (y_a2pz, z_a2pB) -> y_a2pz }) (scc case ds_r4vL of { (y_a2pz, z_a2pB) -> z_a2pB }) }}} and fails the same way. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 12 15:18:56 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 12 Jan 2018 15:18:56 -0000 Subject: [GHC] #14653: Text missing in ghc-prim's documentation In-Reply-To: <046.609bd988f60cb8a028f94fdc7c2f2e0a@haskell.org> References: <046.609bd988f60cb8a028f94fdc7c2f2e0a@haskell.org> Message-ID: <061.65604acaeb33cee294a56989ed83b9ba@haskell.org> #14653: Text missing in ghc-prim's documentation -------------------------------------+------------------------------------- Reporter: gallais | Owner: sighingnow Type: bug | Status: new Priority: normal | Milestone: Component: libraries | Version: 8.2.2 (other) | Keywords: ghc-prim, Resolution: | newcomer Operating System: Unknown/Multiple | Architecture: Type of failure: Documentation | Unknown/Multiple bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4305 Wiki Page: | -------------------------------------+------------------------------------- Changes (by sighingnow): * owner: (none) => sighingnow * differential: => Phab:D4305 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 12 16:20:06 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 12 Jan 2018 16:20:06 -0000 Subject: [GHC] #14626: No need to enter a scrutinised value In-Reply-To: <048.67c951c2aecb97b988badb4816dbe757@haskell.org> References: <048.67c951c2aecb97b988badb4816dbe757@haskell.org> Message-ID: <063.8548afed1cf60832967f4f19b2683d1c@haskell.org> #14626: No need to enter a scrutinised value -------------------------------------+------------------------------------- Reporter: heisenbug | Owner: heisenbug Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: performance Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #13861 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by heisenbug): Replying to [comment:26 simonpj]: > I think you believe that there is a heap-allocated `Name` with an un- evaluated `n_occ` field. Yes. `n_occ` is a strict field and it appears to be non-WHNF when reading it. I was suspecting that this is because of deserialisation doing some dirty `unsafeCoerce` tricks when loading dictionaries, which contain the `Name` values, but there are other culprits too. I had to remove two further bangs on datatype fields on order to get a ''quick'' build with `make GhcStage2HcOpts="-O1 -g"` through. (https://github.com/ghc/ghc/commit/57a57f2f8cef2ea67588edd1f09f73981e86c889) So all evidence point towards a GHC defect in allocation of heap objects with strict fields. > There is only one place in the code generator namely `StgCmmCon.buildDynCon'`. You could perhaps add (runtime) assertions there to see if any strict fields had un-tagged pointers. I'll look into the assertion which you suggest. Btw. this might be a recent regression or something ancient. I'll find out and file another ticket if this gets confirmed. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 12 16:24:29 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 12 Jan 2018 16:24:29 -0000 Subject: [GHC] #14331: Overzealous free-floating kind check causes deriving clause to be rejected In-Reply-To: <050.cb87f2a10e38fd0ac57d92b074ac5d5b@haskell.org> References: <050.cb87f2a10e38fd0ac57d92b074ac5d5b@haskell.org> Message-ID: <065.772aa3596539b459487744cc99ea6f73@haskell.org> #14331: Overzealous free-floating kind check causes deriving clause to be rejected -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.4.1 Component: Compiler (Type | Version: 8.2.1 checker) | Resolution: | Keywords: deriving Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: GHC rejects | Test Case: valid program | deriving/should_compile/T14331 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): Sorry goldfire, I didn't realize you were referring to comment:14:ticket:11732 in particular when you referenced #11732 (which has a much different program than the original one I copy-pasted in comment:55). Yes, I was originally of the belief that `deriving` should be allowed to unify whatever it likes, which is why I originally argued so vehemently against the ideas put forth in this ticket. I've since changed my opinion on the matter after reading the discussion here, and believe that the program in comment:14:ticket:11732 should fail. FWIW, programs like in comment:14:ticket:11732 are quite rare in practice, so I wouldn't anticipate too much breakage from disallowing them. The only comparable example that I can think of which is widely used in practice is when you derive `Generic1`, since the kind of `Generic1` is `(k -> Type) -> Constraint`, and one frequently unifies that `k` with `Type`. Fortunately, almost everyone writes their derived `Generic1` instances as {{{#!hs data Foo (a :: Type) = ... deriving Generic1 }}} where the `k` argument to `Generic1` isn't specified, so it's allowed to freely unify with `Type`. It'd be a problem if folks were writing the above as {{{#!hs data Foo (a :: Type) = ... deriving ((Generic1 :: (k -> Type) -> Constraint)) }}} But thankfully, only crazy people like myself have ever attempted this. :) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 12 16:35:39 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 12 Jan 2018 16:35:39 -0000 Subject: [GHC] #14661: Cannot derive (newtype I a b = I (F a -> F b) deriving newtype Category) for type family F In-Reply-To: <051.db51abc527e2395586903121a4d671be@haskell.org> References: <051.db51abc527e2395586903121a4d671be@haskell.org> Message-ID: <066.fc457f7dbf04592a6b9c579bda4d3e95@haskell.org> #14661: Cannot derive (newtype I a b = I (F a -> F b) deriving newtype Category) for type family F -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: feature request | Status: closed Priority: normal | Milestone: Component: Compiler | Version: 8.4.1-alpha1 Resolution: wontfix | Keywords: | DerivingStrategies, deriving, | TypeFamilies Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * status: new => closed * resolution: => wontfix Comment: Apologies simonpj, comment:6 wouldn't have made sense except to Iceland_jack, myself, and a handful of other people. `DerivingVia` is the code name we're using to describe a work-in-progress deriving strategy that we're developing, based on this [https://skillsmatter.com/skillscasts/10934-lightning-talk-stolen- instances-taste-just-fine HaskellX talk] that Iceland_jack gave. This would allow you to write something of the form: {{{#!hs newtype Ixed a b = Ixed (Interp a -> Interp b) deriving Category via (WRAP InterpSym0 (->) a b) }}} Where `WRAP` is a separate data type that has exactly the right `Category` instance that you'd want for `Ixed`. It would generate the following code: {{{#!hs instance Category Ixed where id = coerce @(forall a. Ixed a a) @(forall a. WRAP InterpSym0 (->) a a) id (.) = coerce @(forall a b c. Ixed b c -> Ixed a b -> Ixed a c) @(forall a b c. WRAP InterpSym0 (->) b c -> WRAP InterpSym0 (->) a b -> WRAP InterpSym0 (->) a c) (.) }}} Another way of thinking about it is that it's an even more generalized form of `GeneralizedNewtypeDeriving` where the user is allowed to specify their own type to `coerce` from (instead of being required to use a newtype's underlying representation type). It's not fully documented at the moment, but we do have a WIP specification [https://github.com/Icelandjack/deriving- via/blob/06cb4fffbac68a7ca788ce1778f76c971906911e/paper/Specification_sketch.markdown here] if you're curious. Anyways, I'll opt to close this, since Iceland_jack seems OK with the idea of using `DerivingVia` to accomplish this task. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 12 17:20:38 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 12 Jan 2018 17:20:38 -0000 Subject: [GHC] #14662: Partial type signatures + mutual recursion = confusion In-Reply-To: <047.3b31857d5e13c83eb10eb7b983365dfd@haskell.org> References: <047.3b31857d5e13c83eb10eb7b983365dfd@haskell.org> Message-ID: <062.a72f20f4e5f20a384646ac06773acd78@haskell.org> #14662: Partial type signatures + mutual recursion = confusion -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by goldfire): OK. I see why polymorphic recursion is no good. But then can you explain Example 6? That's polymorphically recursive and is accepted. (It's accepted because the "use `SigTv`s" rule for partial type signatures only works at the outermost level; nested `forall`s don't benefit.) The reason I dislike `SigTv`s is this: When a user writes down a type variable, do they mean it to be unique (skolem) with a unique binding site, or could it stand for something else (a `TauTv`)? We generally choose the former, but wildcards are the latter. These positions are all good. But a `SigTv` is something in between: it's a type variable that can stand only for another type variable. Does it have a binding site? If yes, then what if we discover that it stands for something else? If no, then why do we say `forall a` to introduce them (in the case of partial type signatures)? The whole thing seems very squishy to me. I ''do'' understand why they came into being, and I agree that they solve real problems. But I think you'd have a hard time of writing a declarative specification of type inference that involves them. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 12 18:18:14 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 12 Jan 2018 18:18:14 -0000 Subject: [GHC] #5889: -fno-prof-count-entries leads to linking errors In-Reply-To: <043.c51b50cea9fd3755f487a8490fe8400e@haskell.org> References: <043.c51b50cea9fd3755f487a8490fe8400e@haskell.org> Message-ID: <058.0b8925d97686b83d0b534da37b6a76f5@haskell.org> #5889: -fno-prof-count-entries leads to linking errors -------------------------------------+------------------------------------- Reporter: akio | Owner: bgamari Type: bug | Status: new Priority: highest | Milestone: 8.4.1 Component: Compiler | Version: 8.3 Resolution: | Keywords: Operating System: Linux | Architecture: x86_64 | (amd64) Type of failure: GHC rejects | Test Case: valid program | profiling/should_compile/T5889 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): > The same pass in A does nothing. osa1, can you clarify what `A` is? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 12 18:22:38 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 12 Jan 2018 18:22:38 -0000 Subject: [GHC] #5889: -fno-prof-count-entries leads to linking errors In-Reply-To: <043.c51b50cea9fd3755f487a8490fe8400e@haskell.org> References: <043.c51b50cea9fd3755f487a8490fe8400e@haskell.org> Message-ID: <058.0235c52064dd0b176b6cb40b900c6fa0@haskell.org> #5889: -fno-prof-count-entries leads to linking errors -------------------------------------+------------------------------------- Reporter: akio | Owner: bgamari Type: bug | Status: new Priority: highest | Milestone: 8.4.1 Component: Compiler | Version: 8.3 Resolution: | Keywords: Operating System: Linux | Architecture: x86_64 | (amd64) Type of failure: GHC rejects | Test Case: valid program | profiling/should_compile/T5889 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by osa1): > osa1, can you clarify what A is? It's the module A in the test case (testsuite/tests/profiling/should_compile/T5889/A.hs) and B is the module B. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 12 19:08:40 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 12 Jan 2018 19:08:40 -0000 Subject: [GHC] #14338: Simplifier fails with "Simplifier ticks exhausted" In-Reply-To: <049.819ef8e60a65cb9f3e29afb8f69166a7@haskell.org> References: <049.819ef8e60a65cb9f3e29afb8f69166a7@haskell.org> Message-ID: <064.0666d5a72bc34263df091da2fe620b84@haskell.org> #14338: Simplifier fails with "Simplifier ticks exhausted" -------------------------------------+------------------------------------- Reporter: dredozubov | Owner: bgamari Type: bug | Status: merge Priority: high | Milestone: 8.4.1 Component: Compiler | Version: 8.2.1 Resolution: fixed | Keywords: Operating System: Linux | Architecture: x86_64 Type of failure: Compile-time | (amd64) crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): It seems quite unlikely that there will be an 8.2.3 at this point. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 12 19:14:03 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 12 Jan 2018 19:14:03 -0000 Subject: [GHC] #5889: -fno-prof-count-entries leads to linking errors In-Reply-To: <043.c51b50cea9fd3755f487a8490fe8400e@haskell.org> References: <043.c51b50cea9fd3755f487a8490fe8400e@haskell.org> Message-ID: <058.9706891f83e3ac324bafceb4f76b218c@haskell.org> #5889: -fno-prof-count-entries leads to linking errors -------------------------------------+------------------------------------- Reporter: akio | Owner: bgamari Type: bug | Status: new Priority: highest | Milestone: 8.4.1 Component: Compiler | Version: 8.3 Resolution: | Keywords: Operating System: Linux | Architecture: x86_64 | (amd64) Type of failure: GHC rejects | Test Case: valid program | profiling/should_compile/T5889 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by osa1): We discussed this with @bgamari on IRC and I did some experimenting with the flags, and I think this story makes sense: Answer to question "why are these cost centers eliminated in the definition site (in module B) but not in use site (in module A)" is because worker for `split` is not inlined in module A. It's inlined when I compile module B with `-fspec-constr`: {{{ Inlining done: B.$wsplit Inlined fn: \ (w :: GHC.Integer.Type.Integer) (w1 [Occ=Once!] :: GHC.Base.Maybe GHC.Integer.Type.Integer) -> case w1 of { GHC.Base.Nothing -> (# scc B.plus_noinline w B.split3, scc B.plus_noinline w B.split2 #); GHC.Base.Just m -> case scc GHC.Integer.Type.eqInteger# w B.split1 of { __DEFAULT -> scc B.split_$s$wsplit m (GHC.Integer.Type.minusInteger w B.split3); 1# -> (# m, m #) } } Cont: ApplyToVal nodup w ApplyToVal nodup w1 Select nodup ww Stop[BoringCtxt] (GHC.Integer.Type.Integer, GHC.Integer.Type.Integer) }}} with this I no longer get any linker errors. In comment:19 I said that `SpecConstr` pass doesn't actually change the program -- this is correct, we don't need `SpecConstr` in A, we need it in B to make the worker for `split` available in module A. Once we compile `B` with `-fspec-constr` the worker becomes available in when compiling `A`. Hopefully this explains. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 12 19:34:59 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 12 Jan 2018 19:34:59 -0000 Subject: [GHC] #14655: Compiled nofib-analyse executable segfaults under windows In-Reply-To: <047.44633c0d8f4acc4718fac822df06754c@haskell.org> References: <047.44633c0d8f4acc4718fac822df06754c@haskell.org> Message-ID: <062.aa4d14d5cab380ae1855e824f839cf10@haskell.org> #14655: Compiled nofib-analyse executable segfaults under windows -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Runtime crash | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): YHikes, is this still reproducible in 8.4? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 12 19:35:23 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 12 Jan 2018 19:35:23 -0000 Subject: [GHC] #14654: Nofib: Strip called without .exe extension resulting in errors. In-Reply-To: <047.c0797d46dbce4498940454ea926743bb@haskell.org> References: <047.c0797d46dbce4498940454ea926743bb@haskell.org> Message-ID: <062.e53c89ed5edca6021161a5f055a48ff3@haskell.org> #14654: Nofib: Strip called without .exe extension resulting in errors. -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: AndreasK Type: bug | Status: patch Priority: normal | Milestone: Component: NoFib benchmark | Version: 8.2.2 suite | Keywords: nofib, Resolution: | windows Operating System: Windows | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4297 Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): Thanks for the patch! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 12 19:35:53 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 12 Jan 2018 19:35:53 -0000 Subject: [GHC] #14654: Nofib: Strip called without .exe extension resulting in errors. In-Reply-To: <047.c0797d46dbce4498940454ea926743bb@haskell.org> References: <047.c0797d46dbce4498940454ea926743bb@haskell.org> Message-ID: <062.414c013a6ae29fac78a3204ad96a93d2@haskell.org> #14654: Nofib: Strip called without .exe extension resulting in errors. -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: AndreasK Type: bug | Status: merge Priority: normal | Milestone: 8.4.1 Component: NoFib benchmark | Version: 8.2.2 suite | Keywords: nofib, Resolution: | windows Operating System: Windows | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4297 Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: patch => merge * milestone: => 8.4.1 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 12 19:44:37 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 12 Jan 2018 19:44:37 -0000 Subject: [GHC] #14665: http://www.cminusminus.org/ is dead In-Reply-To: <046.ee5d0668b0e8cf9e55beec4faafe96d3@haskell.org> References: <046.ee5d0668b0e8cf9e55beec4faafe96d3@haskell.org> Message-ID: <061.346b3dcdee02cc3856cdafd664706488@haskell.org> #14665: http://www.cminusminus.org/ is dead -------------------------------------+------------------------------------- Reporter: niteria | Owner: (none) Type: task | Status: new Priority: lowest | Milestone: Component: Documentation | Version: Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): I have no idea what the status of this is. Presumably Simon Marlow knows? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 12 20:15:56 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 12 Jan 2018 20:15:56 -0000 Subject: [GHC] #14640: Div and Mod type families don't have the same fixities as their term-level counterparts In-Reply-To: <050.f59dff27cbd52ba0b8f3d501166d856b@haskell.org> References: <050.f59dff27cbd52ba0b8f3d501166d856b@haskell.org> Message-ID: <065.3b4fd956bf3df9e2fd43e43ccbcc87a5@haskell.org> #14640: Div and Mod type families don't have the same fixities as their term-level counterparts -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: 8.4.1 Component: libraries/base | Version: 8.4.1-alpha1 Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4291 Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: merge => closed * resolution: => fixed Comment: Merged in fdfaa56b04b2cefb86e4dc557b1d163fd2e062dc. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 12 20:19:35 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 12 Jan 2018 20:19:35 -0000 Subject: [GHC] #14578: Incorrect parenthesization of types in -ddump-deriv In-Reply-To: <050.1bb782b3eb79c5da4302f5fbe9b4afd7@haskell.org> References: <050.1bb782b3eb79c5da4302f5fbe9b4afd7@haskell.org> Message-ID: <065.15bc97affb57d5c10f351e1afc1dbbc0@haskell.org> #14578: Incorrect parenthesization of types in -ddump-deriv -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: merge Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.2.2 Resolution: fixed | Keywords: deriving Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Debugging | Test Case: information is incorrect | deriving/should_compile/T14578 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4266 Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: closed => merge * milestone: => 8.4.1 Comment: Merged in e32f582783. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 12 20:19:41 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 12 Jan 2018 20:19:41 -0000 Subject: [GHC] #14578: Incorrect parenthesization of types in -ddump-deriv In-Reply-To: <050.1bb782b3eb79c5da4302f5fbe9b4afd7@haskell.org> References: <050.1bb782b3eb79c5da4302f5fbe9b4afd7@haskell.org> Message-ID: <065.234c59629c2eb291c32994301b6f43d9@haskell.org> #14578: Incorrect parenthesization of types in -ddump-deriv -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.2.2 Resolution: fixed | Keywords: deriving Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Debugging | Test Case: information is incorrect | deriving/should_compile/T14578 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4266 Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: merge => closed -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 12 20:19:55 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 12 Jan 2018 20:19:55 -0000 Subject: [GHC] #14579: GeneralizedNewtypeDeriving produces ambiguously-kinded code In-Reply-To: <050.a14779f75731c6fe141e22d22092cebf@haskell.org> References: <050.a14779f75731c6fe141e22d22092cebf@haskell.org> Message-ID: <065.cbcc954804322266114ff733db41f686@haskell.org> #14579: GeneralizedNewtypeDeriving produces ambiguously-kinded code -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: 8.4.1 Component: Compiler (Type | Version: 8.2.2 checker) | Resolution: fixed | Keywords: deriving Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: GHC rejects | Test Case: valid program | deriving/should_compile/T14579 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4264 Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: merge => closed * resolution: => fixed Comment: Merged in ebf8e07629. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 12 20:48:28 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 12 Jan 2018 20:48:28 -0000 Subject: [GHC] #13903: KQueue evtmgr backend fails to register for write events In-Reply-To: <048.b40d50b7e059c68fc52d5bbd492f52b4@haskell.org> References: <048.b40d50b7e059c68fc52d5bbd492f52b4@haskell.org> Message-ID: <063.3055f60bd7c5707b805a96f24bff0829@haskell.org> #13903: KQueue evtmgr backend fails to register for write events -------------------------------------+------------------------------------- Reporter: waldheinz | Owner: (none) Type: bug | Status: merge Priority: normal | Milestone: 8.4.1 Component: Runtime System | Version: 8.0.2 Resolution: | Keywords: Operating System: FreeBSD | Architecture: Type of failure: Incorrect result | Unknown/Multiple at runtime | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D3692 Wiki Page: | -------------------------------------+------------------------------------- Comment (by Ben Gamari ): In [changeset:"6c3eafb35eb7c664963d08a5904faf8c6471218e/ghc" 6c3eafb3/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="6c3eafb35eb7c664963d08a5904faf8c6471218e" KQueue: Fix write notification requests being ignored... when read notifications are requested, too (#13903) Signed-off-by: Matthias Treydte KQueue: Drop Bits/FiniteBits instances for Filter as they are really constants whose bits should not be fiddled with Signed-off-by: Matthias Treydte Reviewers: austin, hvr, bgamari Reviewed By: bgamari Subscribers: gridaphobe, kazu_yamamoto, rwbarton, thomie GHC Trac Issues: #13903 Differential Revision: https://phabricator.haskell.org/D3692 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 12 21:26:28 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 12 Jan 2018 21:26:28 -0000 Subject: [GHC] #5889: -fno-prof-count-entries leads to linking errors In-Reply-To: <043.c51b50cea9fd3755f487a8490fe8400e@haskell.org> References: <043.c51b50cea9fd3755f487a8490fe8400e@haskell.org> Message-ID: <058.e76daa7e6ed700c4e5c689adfdc42864@haskell.org> #5889: -fno-prof-count-entries leads to linking errors -------------------------------------+------------------------------------- Reporter: akio | Owner: bgamari Type: bug | Status: new Priority: highest | Milestone: 8.4.1 Component: Compiler | Version: 8.3 Resolution: | Keywords: Operating System: Linux | Architecture: x86_64 | (amd64) Type of failure: GHC rejects | Test Case: valid program | profiling/should_compile/T5889 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by duog): I found your analysis instructive osa1, thank you. My current understanding is now that the cost-centres are, modulo bugs, removed when they aren't wrapping any work. I don't think we have any examples here of erroneous cost-centre removal, do you agree? As for how to implement alternative (2) in comment:10, Note [inline scc] summarises the difficulty: {{{ -- Note [inline sccs] -- -- It should be reasonable to add ticks to INLINE functions; however -- currently this tickles a bug later on because the SCCfinal pass -- does not look inside unfoldings to find CostCentres. It would be -- difficult to fix that, because SCCfinal currently works on STG and -- not Core (and since it also generates CostCentres for CAFs, -- changing this would be difficult too). }}} Could we collect SCCs from all unfoldings in `corePrepPgm`, and union them with the result of `myCoreToStg`? What could go wrong? Are there any pathological scenarios where large numbers of SCCs would be created? That would fix the bug alluded to in the note, so if we go forward with that idea let's not forget to update the note and create a ticket for the task of reevaluating the sites referencing said note. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 12 22:42:38 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 12 Jan 2018 22:42:38 -0000 Subject: [GHC] #14666: Improve assembly for dense jump tables. Message-ID: <047.99261781a856d98a575046488cd268ef@haskell.org> #14666: Improve assembly for dense jump tables. -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 (CodeGen) | Keywords: Cmm, Asm, | Operating System: Unknown/Multiple CodeGen | Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- When generating assembly for cases with dense alternatives GHC currently often generates somewhat repetitive code: {{{ Main.$wf_test_info: ... # Check range _u48M: #Jump into jump table jmp *_n48P(,%r14,8) _c48H: movl $11008,%ebx jmp *(%rbp) ##################### # Repeat 6 more times ##################### _c48A: movl $11001,%ebx jmp *(%rbp) _c48z: movq $-1,%rbx jmp *(%rbp) _n48P: #Jump table }}} From what I've seen it should often be possible to replace the indirect jmp with a indirect mov instead. {{{ ... #Check Range .Lu48M: #Get value out of table and jump to continuation. movl .Ln48P(,%r14,8), %ebx jmp *(%rbp) .Lc48z: movq $-1,%rbx jmp *(%rbp) .Ln48P: #Jump table }}} Depending on the number of cases this has the potential to do a lot for code size. ---- I did the transformation manually for one case in a inner loop. It improved speed but not much and depending on the codelayout I did it was possible to get worse performance in specific cases. It's also not a simply patch as Cmm currently generates switches containing gotos. So this would require a change in the Cmm stage as well as in the code generator. But it should be at least worth investigating and seems to be what gcc does for similar cases. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 12 23:29:45 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 12 Jan 2018 23:29:45 -0000 Subject: [GHC] #14664: "GHC.Integer can't throw exceptions" is wrong In-Reply-To: <045.bb424a774c8b0cd8f542a7f3b5a2b9d8@haskell.org> References: <045.bb424a774c8b0cd8f542a7f3b5a2b9d8@haskell.org> Message-ID: <060.a23efbb39ba7971da013c6c5389acd61@haskell.org> #14664: "GHC.Integer can't throw exceptions" is wrong -------------------------------------+------------------------------------- Reporter: Zemyla | Owner: (none) Type: feature request | Status: new Priority: low | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Zemyla): Well, yeah, this was mostly a proof of concept, and I don't know how exactly to make it support unboxed as well as boxed types, though I'm pretty sure it's possible. But yeah, a primop like `primError# :: Addr# -> a` that takes a zero- terminated string literal and throws a specific type of error hardcoded into the RTS and defined later in Control.Exception might work. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Jan 13 01:21:02 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 13 Jan 2018 01:21:02 -0000 Subject: [GHC] #14667: Compiling a function with a lot of alternatives bottlenecks on insertIntHeap Message-ID: <046.bf8bb91dd6a70996717f1ecc929e7901@haskell.org> #14667: Compiling a function with a lot of alternatives bottlenecks on insertIntHeap -------------------------------------+------------------------------------- Reporter: niteria | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: Compile-time Unknown/Multiple | performance bug Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- I have a module that looks like this: {{{ module A10000 where data A = A | A00001 | A00002 ... | A10000 f :: A -> Int f A00001 = 19900001 f A00002 = 19900002 ... f A10000 = 19910000 }}} Compiling with `-s` gives: {{{ [1 of 1] Compiling A10000 ( A10000.hs, A10000.o ) A10000.hs:10004:1: warning: Pattern match checker exceeded (2000000) iterations in an equation for ‘f’. (Use -fmax-pmcheck-iterations=n to set the maximun number of iterations to n) | 10004 | f A00001 = 19900001 | ^^^^^^^^^^^^^^^^^^^... 95,068,628,968 bytes allocated in the heap 14,166,421,680 bytes copied during GC 312,247,488 bytes maximum residency (19 sample(s)) 3,267,024 bytes maximum slop 857 MB total memory in use (0 MB lost due to fragmentation) Tot time (elapsed) Avg pause Max pause Gen 0 35163 colls, 0 par 5.191s 5.170s 0.0001s 0.0724s Gen 1 19 colls, 0 par 1.240s 1.236s 0.0650s 0.1872s TASKS: 4 (1 bound, 3 peak workers (3 total), using -N1) SPARKS: 0 (0 converted, 0 overflowed, 0 dud, 0 GC'd, 0 fizzled) INIT time 0.000s ( 0.000s elapsed) MUT time 23.100s ( 23.341s elapsed) GC time 6.431s ( 6.405s elapsed) RP time 0.000s ( 0.000s elapsed) PROF time 0.000s ( 0.000s elapsed) EXIT time 0.000s ( 0.001s elapsed) Total time 29.532s ( 29.748s elapsed) }}} With profiling enabled I get: {{{ total time = 22.67 secs (22673 ticks @ 1000 us, 1 processor) total alloc = 36,143,653,320 bytes (excludes profiling overheads) COST CENTRE MODULE SRC %time %alloc ticks bytes insertIntHeap Hoopl.Dataflow compiler/cmm/Hoopl/Dataflow.hs:(450,1)-(454,38) 73.9 77.5 16746 28001680176 SimplTopBinds SimplCore compiler/simplCore/SimplCore.hs:770:39-74 9.4 1.8 2136 647116224 deSugar HscMain compiler/main/HscMain.hs:511:7-44 2.6 4.2 599 1530056552 pprNativeCode AsmCodeGen compiler/nativeGen/AsmCodeGen.hs:(529,37)-(530,65) 2.3 2.9 524 1030493864 StgCmm HscMain compiler/main/HscMain.hs:(1426,13)-(1427,62) 1.3 1.4 288 497401376 RegAlloc-linear AsmCodeGen compiler/nativeGen/AsmCodeGen.hs:(658,27)-(660,55) 0.9 1.1 201 383789200 tc_rn_src_decls TcRnDriver compiler/typecheck/TcRnDriver.hs:(494,4)-(556,7) 0.8 1.2 176 441973152 Parser HscMain compiler/main/HscMain.hs:(316,5)-(384,20) 0.5 1.1 113 411448880 }}} After a local patch that basically reverts https://phabricator.haskell.org/rGHC5a1a2633553 I get: {{{ [1 of 1] Compiling A10000 ( A10000.hs, A10000.o ) A10000.hs:10004:1: warning: Pattern match checker exceeded (2000000) iterations in an equation for ‘f’. (Use -fmax-pmcheck-iterations=n to set the maximun number of iterations to n) | 10004 | f A00001 = 19900001 | ^^^^^^^^^^^^^^^^^^^... 15,162,268,144 bytes allocated in the heap 4,870,184,600 bytes copied during GC 323,794,936 bytes maximum residency (19 sample(s)) 3,074,056 bytes maximum slop 886 MB total memory in use (0 MB lost due to fragmentation) Tot time (elapsed) Avg pause Max pause Gen 0 811 colls, 0 par 1.828s 1.821s 0.0022s 0.0770s Gen 1 19 colls, 0 par 1.217s 1.213s 0.0638s 0.1820s TASKS: 4 (1 bound, 3 peak workers (3 total), using -N1) SPARKS: 0 (0 converted, 0 overflowed, 0 dud, 0 GC'd, 0 fizzled) INIT time 0.000s ( 0.000s elapsed) MUT time 5.842s ( 6.144s elapsed) GC time 3.046s ( 3.034s elapsed) RP time 0.000s ( 0.000s elapsed) PROF time 0.000s ( 0.000s elapsed) EXIT time 0.000s ( 0.001s elapsed) Total time 8.888s ( 9.179s elapsed) }}} For a file of smaller size with 1000 constructors, it still gives a 10% win. This example is artificial, but it looks like something that someone could write for a sparse enum that looks like this in C++: {{{ enum access_t { read = 1, write = 2, exec = 4 }; }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Jan 13 04:10:27 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 13 Jan 2018 04:10:27 -0000 Subject: [GHC] #14662: Partial type signatures + mutual recursion = confusion In-Reply-To: <047.3b31857d5e13c83eb10eb7b983365dfd@haskell.org> References: <047.3b31857d5e13c83eb10eb7b983365dfd@haskell.org> Message-ID: <062.1e426907380d5da9c92934050d0780f3@haskell.org> #14662: Partial type signatures + mutual recursion = confusion -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by goldfire): Interestingly, this was changed '''three days ago'''. Now, in HEAD, Example 3 and Example 4 are rejected with {{{ • Can't quantify over ‘b’ bound by the partial type signature: g :: forall b. _ -> b -> b }}} I think this is an improvement in behavior, but it underscores how squishy this all is. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Jan 13 09:52:59 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 13 Jan 2018 09:52:59 -0000 Subject: [GHC] #5889: -fno-prof-count-entries leads to linking errors In-Reply-To: <043.c51b50cea9fd3755f487a8490fe8400e@haskell.org> References: <043.c51b50cea9fd3755f487a8490fe8400e@haskell.org> Message-ID: <058.4a40d9d7a8d8da748e56eb20dcad008b@haskell.org> #5889: -fno-prof-count-entries leads to linking errors -------------------------------------+------------------------------------- Reporter: akio | Owner: bgamari Type: bug | Status: new Priority: highest | Milestone: 8.4.1 Component: Compiler | Version: 8.3 Resolution: | Keywords: Operating System: Linux | Architecture: x86_64 | (amd64) Type of failure: GHC rejects | Test Case: valid program | profiling/should_compile/T5889 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by osa1): > My current understanding is now that the cost-centres are, modulo bugs, removed when they aren't wrapping any work. I don't think we have any examples here of erroneous cost-centre removal, do you agree? Well, this ticket iself is an example of erroneous cost-centre removal, isn't it? I don't know answers to other questions, but I think the right thing to do here is to collect cost-centers in Core instead of STG (maybe in coreToStg). Because unfoldings are just Core expressions, once we have the code for collecting cost centers from unfoldings we can just use the same function for the actual program so no need for two functions for collecting cost centers (one collects from Core, another one from STG). So once we write this we can get rid of cost center collection in STG, `stgMassageForProfiling` would just add CAF cost centers. On a related note, I found this in the user manual: (8.1.1) > Cost centres are just program annotations. When you say -fprof-auto to the compiler, it automatically inserts a cost centre annotation around every binding not marked INLINE in your program, but you are entirely free to add cost centre annotations yourself. So GHC by default avoids this bug by not adding SCCs to INLINE functions but if you do it yourself you get this bug in some cases. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Jan 13 17:50:01 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 13 Jan 2018 17:50:01 -0000 Subject: [GHC] #14519: Exponential runtime performance regression in GHC 8.2 + Data.Text.Lazy + Text.RE.TDFA In-Reply-To: <043.92c07e3e0209c31f0a0f195fa98d301c@haskell.org> References: <043.92c07e3e0209c31f0a0f195fa98d301c@haskell.org> Message-ID: <058.c191eeb890f24b5a52a4f93f72505201@haskell.org> #14519: Exponential runtime performance regression in GHC 8.2 + Data.Text.Lazy + Text.RE.TDFA -------------------------------------+------------------------------------- Reporter: ntc2 | Owner: tdammers Type: bug | Status: new Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Runtime | Test Case: performance bug | https://github.com/ntc2/ghc-8.2.1 | -regex-lazy-text- | bug/tree/07b7bb32c6e90e8f2d2eada4b59943f37e632d53 Blocked By: | Blocking: Related Tickets: #13745, #14564 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by ntc2): @simonpj, you can reproduce by checking out the repo with the `slow-regex` test package (https://github.com/ntc2/ghc-8.2.1-regex-lazy-text-bug), building it, and then running the `slow-regex` executable that produces with arguments "text-lazy" and the name of one of the test files. E.g. {{{ slow-regex text-lazy defs-10000.txt }}} The `defs-10000.txt` test file is included with the test package. With GHC 8.2.2, using new Cabal: {{{ git clone git at github.com:ntc2/ghc-8.2.1-regex-lazy-text-bug.git cd ghc-8.2.1-regex-lazy-text-bug.git cabal new-build slow-regex ./dist-newstyle/build/x86_64-linux/ghc-8.2.2/slow-regex-0.1.0.0/c/slow- regex/build/slow-regex/slow-regex text-lazy defs-10000.txt }}} With GHC 8.2.2, using Stack: {{{ git clone git at github.com:ntc2/ghc-8.2.1-regex-lazy-text-bug.git cd ghc-8.2.1-regex-lazy-text-bug.git stack build --stack-yaml stack-ghc-8.2.2.yaml slow-regex stack exec --stack-yaml stack-ghc-8.2.2.yaml slow-regex text-lazy defs-10000.txt }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Jan 13 19:08:15 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 13 Jan 2018 19:08:15 -0000 Subject: [GHC] #14666: Improve assembly for dense jump tables. In-Reply-To: <047.99261781a856d98a575046488cd268ef@haskell.org> References: <047.99261781a856d98a575046488cd268ef@haskell.org> Message-ID: <062.9abf0b28b8f79986520eb4d8cb3c3222@haskell.org> #14666: Improve assembly for dense jump tables. -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: (none) Type: task | Status: closed Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 (CodeGen) | Keywords: Cmm, Asm, Resolution: duplicate | CodeGen Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #14372 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by AndreasK): * status: new => closed * resolution: => duplicate * related: => #14372 Comment: Closing this in favour of #14372 which describes the same issue. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Jan 13 19:46:33 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 13 Jan 2018 19:46:33 -0000 Subject: [GHC] #9269: Type families returning quantified types In-Reply-To: <046.d2986c8d4f1d8bdce682f681ff6827a2@haskell.org> References: <046.d2986c8d4f1d8bdce682f681ff6827a2@haskell.org> Message-ID: <061.baabc8e3b43ee4d8f932d8e50b62be26@haskell.org> #9269: Type families returning quantified types -------------------------------------+------------------------------------- Reporter: pumpkin | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 7.8.2 checker) | Resolution: | Keywords: TypeFamilies Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: 11962 Related Tickets: #13901 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by glaebhoerl): * cc: glaebhoerl (added) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Jan 13 19:49:34 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 13 Jan 2018 19:49:34 -0000 Subject: [GHC] #5889: -fno-prof-count-entries leads to linking errors In-Reply-To: <043.c51b50cea9fd3755f487a8490fe8400e@haskell.org> References: <043.c51b50cea9fd3755f487a8490fe8400e@haskell.org> Message-ID: <058.305dd13de62101ac823762fafe37ef5a@haskell.org> #5889: -fno-prof-count-entries leads to linking errors -------------------------------------+------------------------------------- Reporter: akio | Owner: bgamari Type: bug | Status: new Priority: highest | Milestone: 8.4.1 Component: Compiler | Version: 8.3 Resolution: | Keywords: Operating System: Linux | Architecture: x86_64 | (amd64) Type of failure: GHC rejects | Test Case: valid program | profiling/should_compile/T5889 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by duog): Replying to [comment:26 osa1]: > > My current understanding is now that the cost-centres are, modulo bugs, removed when they aren't wrapping any work. I don't think we have any examples here of erroneous cost-centre removal, do you agree? > > Well, this ticket iself is an example of erroneous cost-centre removal, isn't it? To be more precise, I claim that there are no simplifier bugs here; all of the `scc`s that are removed (by the simplifier) in the examples above are ok to remove. If you disagree, can you point to one above? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Jan 13 19:51:08 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 13 Jan 2018 19:51:08 -0000 Subject: [GHC] #14372: CMM contains a bunch of tail-merging opportunities In-Reply-To: <048.1c543d9c1482e4763ed7a0bf48a66309@haskell.org> References: <048.1c543d9c1482e4763ed7a0bf48a66309@haskell.org> Message-ID: <063.1a34a1445b63c0aa94aedef0ad9c5281@haskell.org> #14372: CMM contains a bunch of tail-merging opportunities -------------------------------------+------------------------------------- Reporter: heisenbug | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by AndreasK): Replying to [comment:3 bgamari]: > Poorly predicted branches can indeed be expensive. However, I think here we are just taking about jumps which, as far as I know, are quite cheap assuming they don't boot you out of $I since they can be predicted perfectly. I've run the code: {{{ {-# NOINLINE f_test #-} f_test :: Int ->Int f_test a = case a of 1 -> 11001 2 -> 11002 3 -> 11003 4 -> 11004 5 -> 11005 6 -> 11006 7 -> 11007 8 -> 11008 main = print . sum . map (f_test) $ (concat . replicate 9000000) [1..45::Int] }}} I did the transformation manually into: {{{ .Lc48I: cmpq $9,%r14 jge .Lc48z .Lu48L: cmpq $1,%r14 jl .Lc48z .Lu48M: movl .Ln48P-8(,%r14,8), %ebx jmp *(%rbp) .Lc48z: movq $-1,%rbx jmp *(%rbp) .section .rodata .Ln48P: .quad 11001 # 11002 .. 11007 .quad 11008 }}} Turning the jumps into a indirect mov instruction. > I wonder what prior art exists in this area; I'm sure other compilers have considered this in the past. Gcc/clang do the same thing for switch statements. It improved speed, but not by much and depending on the codelayout I did it was possible to get worse performance in specific cases. But thats true for everything that changes the code layout and isn't a major win I assume. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Jan 13 22:03:22 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 13 Jan 2018 22:03:22 -0000 Subject: [GHC] #14372: CMM contains a bunch of tail-merging opportunities In-Reply-To: <048.1c543d9c1482e4763ed7a0bf48a66309@haskell.org> References: <048.1c543d9c1482e4763ed7a0bf48a66309@haskell.org> Message-ID: <063.d7f8321b6fc82de0bde2ec35090add04@haskell.org> #14372: CMM contains a bunch of tail-merging opportunities -------------------------------------+------------------------------------- Reporter: heisenbug | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by AndreasK): I think this can be solved in two steps: ---- Change the Cmm generation for case statements: Currently we generate cmm of the sort {{{ ... case 1: goto foo; ... foo: Register = Value return(Register) }}} Instead we could inline this when generating the switch. {{{ #include "Cmm.h" test_entry() { switch [1 .. 8] R2 { case 1 : {R1 = 0; return();} ... case 8 : {R1 = 8; return();} } } }}} From what I've seen this hopefully won't change the generated assembly since GHC does this already when compiling the switch in the cases I looked at. ---- The second step would be to change the Assembly generated to something like the listing in [comment:17 the comment above]. I imagine a way to do that would be to: * Check if * Assignments are into the same register. * The rest of the code is the same * Collect all the constants, put them into a lookup table and generate assembly that uses the lookup table like [comment:17 above]. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Jan 13 22:26:58 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 13 Jan 2018 22:26:58 -0000 Subject: [GHC] #8400: Migrate the RTS to use libuv (or libev, or libevent) In-Reply-To: <046.b38bad0bbb5fef315e7819ac07954a6b@haskell.org> References: <046.b38bad0bbb5fef315e7819ac07954a6b@haskell.org> Message-ID: <061.9378dc8042ea101aa52edfb4353257be@haskell.org> #8400: Migrate the RTS to use libuv (or libev, or libevent) -------------------------------------+------------------------------------- Reporter: schyler | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Runtime System | Version: Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: 635, 7353 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by dobenour): I have an idea for how to implement this: * Each `Capability` contains a `uv_loop_t` as well as a pointer to a list of threads that are blocked waiting on C callbacks to fire. Since initializing a `uv_loop_t` can fail due to OS resource exhaustion, such as too many open files, the RTS checks that initializing succeeded before a capability can run Haskell code. * Each Capability owns a pool of C structures {{{#!C typedef struct StgCCallbackInfo { StgTSO *BlockedThread; /* The thread that is blocked waiting for the callback */ StgWord refcount; /* Reference count */ void *user; /* Arbitrary C data */ } StgCCallbackInfo; }}} This list is a GC root. The members of this pool are in pinned memory, so they can safely be referenced by C code * The RTS exports C functions {{{#!C /** * Allocates a C callback info struct, or NULL if we run out of memory. */ StgCCallbackInfo *rts_newCCallbackInfo(Capability *c, StgTSO *t, void *user); /** * Wakes up the thread pointed to by the given `StgCCallbackInfo`. */ void rts_wakeupThread(struct StgCCallbackInfo *ptr); /** * Increments the reference count on the `StgCCallbackInfo`. */ void rts_callback_incref(struct StgCCallbackInfo *ptr); /** * Decrements the reference count. */ void rts_callback_decref(struct StgCCallbackInfo *ptr); }}} which can be used to manipulate these structures -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Jan 13 22:41:05 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 13 Jan 2018 22:41:05 -0000 Subject: [GHC] #14226: Common Block Elimination pass doesn't eliminate common blocks In-Reply-To: <046.64e654c74c7432ac06e937473b6324b1@haskell.org> References: <046.64e654c74c7432ac06e937473b6324b1@haskell.org> Message-ID: <061.8b05e03648ae25bf783d522380859513@haskell.org> #14226: Common Block Elimination pass doesn't eliminate common blocks -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: closed Priority: high | Milestone: 8.4.1 Component: Compiler | Version: 8.2.1 (CodeGen) | Resolution: fixed | Keywords: newcomer Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #9157 | Differential Rev(s): Phab:D3973, Wiki Page: | Phab:D3999 -------------------------------------+------------------------------------- Comment (by AndreasK): Replying to [comment:14 bgamari]: > This should now be resolved. > > Rather, I think we could improve the `switch` lowering: currently we lower this as a chain of branches. I suspect this is the sort of case where we might benefit from instead using a jump table. > > Measuring this idea and, if it pays off, implementing it might be an interesting project for someone looking to get their hands dirty in the NCG. According to the comments in `CmmSwitch.hs` jump tables only make sense when the gaps between entries are smaller than 7 and the table has at least 5 elements which isn't the case here. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Jan 13 23:57:32 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 13 Jan 2018 23:57:32 -0000 Subject: [GHC] #8406: Invalid object in isRetainer() or Segfault In-Reply-To: <047.cda95cb1752355077595406288b06592@haskell.org> References: <047.cda95cb1752355077595406288b06592@haskell.org> Message-ID: <062.8211caabb8cb29e4c3c080035eab148c@haskell.org> #8406: Invalid object in isRetainer() or Segfault -----------------------------------+-------------------------------------- Reporter: crockeea | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: Component: Runtime System | Version: 7.8.3 Resolution: fixed | Keywords: Operating System: Linux | Architecture: x86_64 (amd64) Type of failure: Runtime crash | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -----------------------------------+-------------------------------------- Changes (by dobenour): * status: new => closed * resolution: => fixed Comment: This is probably fixed by Phab:D3967. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 14 00:17:41 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 14 Jan 2018 00:17:41 -0000 Subject: [GHC] #13554: Allow the user to provide a C function that is called on each thread the RTS creates before running any Haskell code In-Reply-To: <047.8330d7f9bec3b64bb6803d51d3c05214@haskell.org> References: <047.8330d7f9bec3b64bb6803d51d3c05214@haskell.org> Message-ID: <062.08a683e95d38b7a579f56a8a83c0e965@haskell.org> #13554: Allow the user to provide a C function that is called on each thread the RTS creates before running any Haskell code -------------------------------------+------------------------------------- Reporter: dobenour | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: 8.4.1 Component: Runtime System | Version: 8.0.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by dobenour): Yes it does, though note that “thread” means OS thread and not Haskell thread. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 14 01:28:08 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 14 Jan 2018 01:28:08 -0000 Subject: [GHC] #14668: Ordering of declarations can cause typechecking to fail Message-ID: <050.d042aa520b7fcde791e49a2b284676e9@haskell.org> #14668: Ordering of declarations can cause typechecking to fail -------------------------------------+------------------------------------- Reporter: heptahedron | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 (Type checker) | 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: -------------------------------------+------------------------------------- The following will successfully typecheck: {{{#!hs {-# LANGUAGE DataKinds #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE TypeInType #-} {-# LANGUAGE TypeFamilies #-} data CInst data G (b :: ()) = G class C a where type family F a class (C a) => C' a where type family F' a (b :: F a) -- data CInst instance C CInst where type F CInst = () instance C' CInst where type F' CInst (b :: F CInst) = G b }}} But if the `data CInst` declaration is moved to where it is currently commented out, typechecking fails with this error: {{{ Test.hs:23:18: error: • Expected kind ‘F CInst’, but ‘b’ has kind ‘()’ • In the second argument of ‘F'’, namely ‘(b :: F CInst)’ In the type instance declaration for ‘F'’ In the instance declaration for ‘C' CInst’ | 23 | type F' CInst (b :: F CInst) = G b | }}} However, the data declaration //can// be in the lower position if the kind annotation for its argument is instead written as `data G (b :: F CInst) = G`. This behavior is also exhibited when G is a type family (I believe the sort of type family does not matter, but I know for sure closed and open type families). I was using GHC 8.2.2 when I discovered this, but user `erisco` on `#haskell` confirmed for 8.2.1 as well. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 14 01:36:52 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 14 Jan 2018 01:36:52 -0000 Subject: [GHC] #14668: Ordering of declarations can cause typechecking to fail In-Reply-To: <050.d042aa520b7fcde791e49a2b284676e9@haskell.org> References: <050.d042aa520b7fcde791e49a2b284676e9@haskell.org> Message-ID: <065.cf4be6bdc0242002bc4c8d13d75eccf4@haskell.org> #14668: Ordering of declarations can cause typechecking to fail -------------------------------------+------------------------------------- Reporter: heptahedron | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.2.1 checker) | Resolution: | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by heptahedron): * keywords: => TypeInType -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 14 02:26:57 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 14 Jan 2018 02:26:57 -0000 Subject: [GHC] #14668: Ordering of declarations can cause typechecking to fail In-Reply-To: <050.d042aa520b7fcde791e49a2b284676e9@haskell.org> References: <050.d042aa520b7fcde791e49a2b284676e9@haskell.org> Message-ID: <065.5a5a1356071be934ade5962f881588c7@haskell.org> #14668: Ordering of declarations can cause typechecking to fail -------------------------------------+------------------------------------- Reporter: heptahedron | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.2.1 checker) | Resolution: | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by goldfire): Thanks for the report! The `TypeInType` keyword makes sure it's in my queue. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 14 03:31:24 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 14 Jan 2018 03:31:24 -0000 Subject: [GHC] #13032: Redundant forcing of Given dictionaries In-Reply-To: <046.811080f481e777da656f14add09b1cc8@haskell.org> References: <046.811080f481e777da656f14add09b1cc8@haskell.org> Message-ID: <061.cdd5d6708b8075bcff00bdd8e7b05519@haskell.org> #13032: Redundant forcing of Given dictionaries -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: Component: Compiler | Version: 8.0.1 Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: | typecheck/should_compile/T13032 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by goldfire): The test case for this ticket is unfortunate, because it fails with a DEBUG compiler (which prints out desugared code before the simple- optimizer). I don't see an easy way to fix; do you? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 14 04:53:50 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 14 Jan 2018 04:53:50 -0000 Subject: [GHC] #13903: KQueue evtmgr backend fails to register for write events In-Reply-To: <048.b40d50b7e059c68fc52d5bbd492f52b4@haskell.org> References: <048.b40d50b7e059c68fc52d5bbd492f52b4@haskell.org> Message-ID: <063.64b0beff18202a4845dc8009ac518e81@haskell.org> #13903: KQueue evtmgr backend fails to register for write events -------------------------------------+------------------------------------- Reporter: waldheinz | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: 8.4.1 Component: Runtime System | Version: 8.0.2 Resolution: fixed | Keywords: Operating System: FreeBSD | Architecture: Type of failure: Incorrect result | Unknown/Multiple at runtime | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D3692 Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: merge => closed * resolution: => fixed -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 14 05:01:43 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 14 Jan 2018 05:01:43 -0000 Subject: [GHC] #5889: -fno-prof-count-entries leads to linking errors In-Reply-To: <043.c51b50cea9fd3755f487a8490fe8400e@haskell.org> References: <043.c51b50cea9fd3755f487a8490fe8400e@haskell.org> Message-ID: <058.936850b519802907ada460abc6b3b719@haskell.org> #5889: -fno-prof-count-entries leads to linking errors -------------------------------------+------------------------------------- Reporter: akio | Owner: bgamari Type: bug | Status: new Priority: highest | Milestone: 8.4.1 Component: Compiler | Version: 8.3 Resolution: | Keywords: Operating System: Linux | Architecture: x86_64 | (amd64) Type of failure: GHC rejects | Test Case: valid program | profiling/should_compile/T5889 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): I think we all agree that the simplifier is not at fault here. Indeed the approach that duog mentions comment:25 is roughly what osa1 and I have discussed. However, it's slightly tricky as unfoldings are currently dropped before we make it to `core2Stg` (in CorePrep). I doubt this will unacceptably increase the number of emitted cost centers although I've been wrong before. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 14 11:31:42 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 14 Jan 2018 11:31:42 -0000 Subject: [GHC] #14644: Improve cmm/assembly for pattern matches with two constants. In-Reply-To: <047.054a8f1d3e52c239a87742662b91a120@haskell.org> References: <047.054a8f1d3e52c239a87742662b91a120@haskell.org> Message-ID: <062.c1599c35bdbb358f4f98ca75ec8ac4a3@haskell.org> #14644: Improve cmm/assembly for pattern matches with two constants. -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: AndreasK Type: task | Status: patch Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 (CodeGen) | Keywords: Codegen, CMM, Resolution: | Patterns, Pattern Matching Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4294 Wiki Page: | -------------------------------------+------------------------------------- Comment (by AndreasK): Replying to [comment:3 svenpanne]: > Additional things to consider: Performance in tight loops is often vastly different, because branch prediction/caching will most likely kick in visibly. Correctly predicted branches will cost you almost nothing, while unknown/incorrectly predicted branches will be much more costly. In the absence of more information from their branch predictor, quite a few processors assume that backward branches are taken and forward branches are assumed to be not taken. So code layout has a non-trivial performance impact. I went over Agners guide and it seems like this is only for Netburst CPU's, the last of which was released in 2001 so I'm not too worried about these. And even if you have on of these according to Agner: > It is rarely worth the effort to take static prediction into account. Almost any branch that is executed sufficiently often for its timing to have any significant effect is likely to stay in the BTB so that only the dynamic prediction counts. All other architectures he lists default to not taken if they use static prediction at all. ---- What might help explain the difference is that jumps not taken should be faster than taken jumps on both modern Intel and AMD CPU's. If someone wants to dig deeper Agner probably has enough info in the guides to explain the change completely based on the assembly generated. But I don't think that is necessary. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 14 15:45:30 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 14 Jan 2018 15:45:30 -0000 Subject: [GHC] #14669: Executable finishing via unhandled exception results in segmentation fault on 32 bit Windows Message-ID: <044.45c88c9a13190d9f2a70cd9b35309cc0@haskell.org> #14669: Executable finishing via unhandled exception results in segmentation fault on 32 bit Windows --------------------------------------+---------------------------------- Reporter: sergv | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Runtime System | Version: 8.2.1 Keywords: | Operating System: Windows Architecture: x86 | Type of failure: Runtime crash Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: --------------------------------------+---------------------------------- It seems that 32 bit Windows GHC version 8.2.1 onwards (I can reproduce it with 8.2.1, 8.2.2 and 8.4.1-alpha, but not with 8.0.2) has some issues in Runtime System related to exception handling. The symptom is that executable exiting via unhandled exception ends with a segmentation fault and non-zero exit code. It would be okay-ish if not for the fact that this bug causes tools like `ghc-pkg` or `hsc2hs` to exit with non-zero exit code when asked for their `--version`. In turn, this breaks cabal-the- executable which interprets non-zero exit code of the `--version` call as a failure and refuses to `configure` further. Why do those executables segfault when invoked with `--version`? It's because they call `exitSuccess` after printing a version, which throws an `ExitSuccess` exception. Thus executables exit with unhandled exception and this bit seems to be faulty. Please see minimalistic example below: {{{ $ cat HW.hs import System.Exit main :: IO () main = do putStrLn "Situation normal" exitWith ExitSuccess $ ghc HW.hs [1 of 1] Compiling Main ( HW.hs, HW.o ) Linking HW.exe ... ./HW.exe Situation normal Segmentation fault $ echo $? 139 }}} If exception is caught then everything's ok. But then it's hard to signal non-zero exit code: {{{ $ cat HWCatch.hs {-# LANGUAGE ScopedTypeVariables #-} import Control.Exception import System.Exit main :: IO () main = do (res :: Either SomeException ()) <- try $ do putStrLn "Situation normal" exitWith ExitSuccess print res $ ghc HWCatch.hs [1 of 1] Compiling Main ( HWCatch.hs, HWCatch.o ) Linking HWCatch.exe ... $ ./HWCatch.exe Situation normal Left ExitSuccess $ echo $? 0 }}} System info: {{{ $ uname -a MINGW64_NT-6.1 box 2.9.0(0.318/5/3) 2017-09-13 23:16 x86_64 Msys $ ghc --version The Glorious Glasgow Haskell Compilation System, version 8.2.2 $ ghc --info [("Project name","The Glorious Glasgow Haskell Compilation System") ,("GCC extra via C opts"," -fwrapv -fno-builtin") ,("C compiler command","$topdir/../mingw/bin/gcc.exe") ,("C compiler flags"," -U__i686 -march=i686 -fno-stack-protector") ,("C compiler link flags"," ") ,("C compiler supports -no-pie","YES") ,("Haskell CPP command","$topdir/../mingw/bin/gcc.exe") ,("Haskell CPP flags","-E -undef -traditional") ,("ld command","$topdir/../mingw/bin/ld.exe") ,("ld flags","") ,("ld supports compact unwind","YES") ,("ld supports build-id","YES") ,("ld supports filelist","NO") ,("ld is GNU ld","YES") ,("ar command","$topdir/../mingw/bin/ar.exe") ,("ar flags","q") ,("ar supports at file","YES") ,("touch command","$topdir/bin/touchy.exe") ,("dllwrap command","$topdir/../mingw/bin/dllwrap.exe") ,("windres command","$topdir/../mingw/bin/windres.exe") ,("libtool command","") ,("perl command","$topdir/../perl/perl.exe") ,("cross compiling","NO") ,("target os","OSMinGW32") ,("target arch","ArchX86") ,("target word size","4") ,("target has GNU nonexec stack","False") ,("target has .ident directive","True") ,("target has subsections via symbols","False") ,("target has RTS linker","YES") ,("Unregisterised","NO") ,("LLVM llc command","llc") ,("LLVM opt command","opt") ,("Project version","8.2.2") ,("Project Git commit id","0156a3d815b784510a980621fdcb9c5b23826f1e") ,("Booter version","8.2.1") ,("Stage","2") ,("Build platform","i386-unknown-mingw32") ,("Host platform","i386-unknown-mingw32") ,("Target platform","i386-unknown-mingw32") ,("Have interpreter","YES") ,("Object splitting supported","YES") ,("Have native code generator","YES") ,("Support SMP","YES") ,("Tables next to code","YES") ,("RTS ways","l debug thr thr_debug thr_l thr_p ") ,("RTS expects libdw","NO") ,("Support dynamic-too","NO") ,("Support parallel --make","YES") ,("Support reexported-modules","YES") ,("Support thinning and renaming package flags","YES") ,("Support Backpack","YES") ,("Requires unified installed package IDs","YES") ,("Uses package keys","YES") ,("Uses unit IDs","YES") ,("Dynamic by default","NO") ,("GHC Dynamic","NO") ,("GHC Profiled","NO") ,("Leading underscore","YES") ,("Debug on","False") ,("LibDir","C:\\home\\ghc\\ghc-8.2.2-x32\\lib") ,("Global Package DB","C:\\home\\ghc\\ghc-8.2.2-x32\\lib\\package.conf.d") ] $ ghc-pkg --version # This is a sign of the problem GHC package manager version 8.2.2 Segmentation fault $ echo $? 139 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 14 16:08:33 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 14 Jan 2018 16:08:33 -0000 Subject: [GHC] #14669: Executable finishing via unhandled exception results in segmentation fault on 32 bit Windows In-Reply-To: <044.45c88c9a13190d9f2a70cd9b35309cc0@haskell.org> References: <044.45c88c9a13190d9f2a70cd9b35309cc0@haskell.org> Message-ID: <059.665b8719cff3f2a1d7d62c825fc1ad11@haskell.org> #14669: Executable finishing via unhandled exception results in segmentation fault on 32 bit Windows -----------------------------------+---------------------------------- Reporter: sergv | Owner: (none) Type: bug | Status: infoneeded Priority: normal | Milestone: Component: Runtime System | Version: 8.2.1 Resolution: | Keywords: Operating System: Windows | Architecture: x86 Type of failure: Runtime crash | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -----------------------------------+---------------------------------- Changes (by Phyx-): * status: new => infoneeded Comment: I can't reproduce this {{{ Tamar at Rage ~/ghc2> /r/x86/ghc-8.2.2/bin/ghc-pkg.exe --version; echo $status GHC package manager version 8.2.2 0 Tamar at Rage ~/ghc2> /r/x86/ghc-8.2.2/bin/ghc.exe HW.hs; ./HW.exe; echo $status [1 of 1] Compiling Main ( HW.hs, HW.o ) Linking HW.exe ... Situation normal 0 }}} Haskell Exceptions are also language level, they don't throw an actual signal so they shouldn't be triggering the exception handlers. More likely than not, since it happens across compilers, you have an external process interrupting your Haskell program. using the `8.4.1` alpha compile your program with `-debug` and run it with `+RTS --generate-crash-dump` and upload the dump somewhere and link it back. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 14 17:00:22 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 14 Jan 2018 17:00:22 -0000 Subject: [GHC] #14669: Executable finishing via unhandled exception results in segmentation fault on 32 bit Windows In-Reply-To: <044.45c88c9a13190d9f2a70cd9b35309cc0@haskell.org> References: <044.45c88c9a13190d9f2a70cd9b35309cc0@haskell.org> Message-ID: <059.55a8eda06e55524628f6918076aee8e8@haskell.org> #14669: Executable finishing via unhandled exception results in segmentation fault on 32 bit Windows -----------------------------------+---------------------------------- Reporter: sergv | Owner: (none) Type: bug | Status: infoneeded Priority: normal | Milestone: Component: Runtime System | Version: 8.2.1 Resolution: | Keywords: Operating System: Windows | Architecture: x86 Type of failure: Runtime crash | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -----------------------------------+---------------------------------- Comment (by sergv): Oh, I forgot to mention that debug RTS does not have this problem :) {{{ sergey at box /c/home/ghc/bugs$ ../ghc-8.2.2-x32/bin/ghc HW.hs -fforce-recomp [1 of 1] Compiling Main ( HW.hs, HW.o ) Linking HW.exe ... sergey at box /c/home/ghc/bugs$ ./HW.exe Situation normal Segmentation fault sergey at box /c/home/ghc/bugs$ ../ghc-8.2.2-x32/bin/ghc HW.hs -fforce-recomp -debug [1 of 1] Compiling Main ( HW.hs, HW.o ) Linking HW.exe ... sergey at box /c/home/ghc/bugs$ ./HW.exe Situation normal sergey at box /c/home/ghc/bugs$ sergey at box /c/home/ghc/bugs$ ../ghc-8.4.1-alpha/bin/ghc HW.hs -fforce- recomp [1 of 1] Compiling Main ( HW.hs, HW.o ) Linking HW.exe ... sergey at box /c/home/ghc/bugs$ ./HW.exe Situation normal Segmentation fault sergey at box /c/home/ghc/bugs$ ../ghc-8.4.1-alpha/bin/ghc HW.hs -fforce- recomp -debug [1 of 1] Compiling Main ( HW.hs, HW.o ) Linking HW.exe ... sergey at box /c/home/ghc/bugs$ ./HW.exe Situation normal sergey at box /c/home/ghc/bugs$ echo $? 0 }}} I believe this issue has similar reproducibility difficulties as https://ghc.haskell.org/trac/ghc/ticket/14081. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 14 17:05:16 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 14 Jan 2018 17:05:16 -0000 Subject: [GHC] #14310: Assertion triggered by STM invariant. In-Reply-To: <042.9c3fac38bbd2247bedc1f2616e6e2820@haskell.org> References: <042.9c3fac38bbd2247bedc1f2616e6e2820@haskell.org> Message-ID: <057.d1b52880638a65d031d81825848f70ef@haskell.org> #14310: Assertion triggered by STM invariant. -------------------------------------+------------------------------------- Reporter: mbw | Owner: (none) Type: bug | Status: patch Priority: high | Milestone: 8.6.1 Component: Compiler | Version: 8.2.1 Resolution: | Keywords: Operating System: Linux | Architecture: x86_64 | (amd64) Type of failure: Runtime crash | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4065, Wiki Page: | Phab:D4067, Phab:D4073 -------------------------------------+------------------------------------- Changes (by bgamari): * milestone: 8.4.1 => 8.6.1 Comment: Unfortunately the above patches are rather subtly wrong. It's unclear whether I will have time to dive back into this before the release and frankly I'm not particularly inclined to given that we will likely be [[https://github.com/ghc-proposals/ghc-proposals/pull/77|removing]] the invariants mechanism in 8.6. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 14 17:18:28 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 14 Jan 2018 17:18:28 -0000 Subject: [GHC] #14669: Executable finishing via unhandled exception results in segmentation fault on 32 bit Windows In-Reply-To: <044.45c88c9a13190d9f2a70cd9b35309cc0@haskell.org> References: <044.45c88c9a13190d9f2a70cd9b35309cc0@haskell.org> Message-ID: <059.3b448630f91a6fb463b291945ed62417@haskell.org> #14669: Executable finishing via unhandled exception results in segmentation fault on 32 bit Windows -----------------------------------+---------------------------------- Reporter: sergv | Owner: (none) Type: bug | Status: infoneeded Priority: normal | Milestone: Component: Runtime System | Version: 8.2.1 Resolution: | Keywords: Operating System: Windows | Architecture: x86 Type of failure: Runtime crash | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -----------------------------------+---------------------------------- Comment (by Phyx-): Can you run `+RTS --generate-crash-dump`. also 8.4 should have produced a stack trace. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 14 17:24:22 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 14 Jan 2018 17:24:22 -0000 Subject: [GHC] #10634: Type class with injective type functions In-Reply-To: <046.d71414e34b5bda9c37dd4a62236b6422@haskell.org> References: <046.d71414e34b5bda9c37dd4a62236b6422@haskell.org> Message-ID: <061.9d7314a7d75609e86302399dca72e395@haskell.org> #10634: Type class with injective type functions -------------------------------------+------------------------------------- Reporter: Lemming | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: Component: Compiler | Version: 7.10.1 Resolution: duplicate | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: GHC rejects | Unknown/Multiple valid program | Test Case: Blocked By: | Blocking: Related Tickets: #10009, #6018 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by Lemming): * related: #10009 => #10009, #6018 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 14 17:28:11 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 14 Jan 2018 17:28:11 -0000 Subject: [GHC] #14669: Executable finishing via unhandled exception results in segmentation fault on 32 bit Windows In-Reply-To: <044.45c88c9a13190d9f2a70cd9b35309cc0@haskell.org> References: <044.45c88c9a13190d9f2a70cd9b35309cc0@haskell.org> Message-ID: <059.52ca45e0b8a371a0255c5d93efb59e45@haskell.org> #14669: Executable finishing via unhandled exception results in segmentation fault on 32 bit Windows -----------------------------------+---------------------------------- Reporter: sergv | Owner: (none) Type: bug | Status: infoneeded Priority: normal | Milestone: Component: Runtime System | Version: 8.2.1 Resolution: | Keywords: Operating System: Windows | Architecture: x86 Type of failure: Runtime crash | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -----------------------------------+---------------------------------- Comment (by sergv): It seems that without exception nothing is generated. And with `-debug` there are no exceptions... {{{ ../ghc-8.4.1-alpha/bin/ghc HW.hs -fforce-recomp -debug -rtsopts [1 of 1] Compiling Main ( HW.hs, HW.o ) Linking HW.exe ... sergey at box /c/home/ghc/bugs$ ./HW.exe +RTS --generate-crash-dumps Situation normal sergey at box /c/home/ghc/bugs$ echo $? 0 sergey at box /c/home/ghc/bugs$ ls HW.exe* HW.hi HW.hs HW.o HWCatch.hs }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 14 17:50:37 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 14 Jan 2018 17:50:37 -0000 Subject: [GHC] #13752: Odd pattern synonym type errors In-Reply-To: <045.1606ca3f9f49f5ab3dc0f32f4ec61304@haskell.org> References: <045.1606ca3f9f49f5ab3dc0f32f4ec61304@haskell.org> Message-ID: <060.9cd5b35d40e06fcaff8e261e859af2d6@haskell.org> #13752: Odd pattern synonym type errors -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: 8.4.1 Component: Compiler (Type | Version: 8.2.1-rc2 checker) | Keywords: Resolution: fixed | PatternSynonyms Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: GHC rejects | Test Case: valid program | patsyn/should_compile/T13752, | T13752a Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: merge => closed * resolution: => fixed Comment: This was not merged into 8.2.2. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 14 18:49:16 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 14 Jan 2018 18:49:16 -0000 Subject: [GHC] #14669: Executable finishing via unhandled exception results in segmentation fault on 32 bit Windows In-Reply-To: <044.45c88c9a13190d9f2a70cd9b35309cc0@haskell.org> References: <044.45c88c9a13190d9f2a70cd9b35309cc0@haskell.org> Message-ID: <059.030dcc63e8218dbda80a09a8ffb1e520@haskell.org> #14669: Executable finishing via unhandled exception results in segmentation fault on 32 bit Windows -----------------------------------+---------------------------------- Reporter: sergv | Owner: (none) Type: bug | Status: infoneeded Priority: normal | Milestone: Component: Runtime System | Version: 8.2.1 Resolution: | Keywords: Operating System: Windows | Architecture: x86 Type of failure: Runtime crash | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -----------------------------------+---------------------------------- Comment (by Phyx-): Sorry, forgot to clarify, you don't need `-debug` for `+RTS --generate- crash-dumps`. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 14 19:02:09 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 14 Jan 2018 19:02:09 -0000 Subject: [GHC] #14669: Executable finishing via unhandled exception results in segmentation fault on 32 bit Windows In-Reply-To: <044.45c88c9a13190d9f2a70cd9b35309cc0@haskell.org> References: <044.45c88c9a13190d9f2a70cd9b35309cc0@haskell.org> Message-ID: <059.f59f59c0e4f4325c47243a2077efab30@haskell.org> #14669: Executable finishing via unhandled exception results in segmentation fault on 32 bit Windows -----------------------------------+---------------------------------- Reporter: sergv | Owner: (none) Type: bug | Status: infoneeded Priority: normal | Milestone: Component: Runtime System | Version: 8.2.1 Resolution: | Keywords: Operating System: Windows | Architecture: x86 Type of failure: Runtime crash | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -----------------------------------+---------------------------------- Comment (by sergv): It seems nothing's generated anyway: {{{ sergey at box /c/home/ghc/bugs$ ../ghc-8.4.1-alpha-x32/bin/ghc HW.hs -rtsopts -fforce-recomp [1 of 1] Compiling Main ( HW.hs, HW.o ) Linking HW.exe ... sergey at box /c/home/ghc/bugs$ ./HW.exe +RTS --generate-crash-dumps --generate-stack-traces=yes Situation normal Segmentation fault sergey at box /c/home/ghc/bugs$ ls HW.exe* HW.hi HW.hs HW.o HWCatch.hs }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 14 19:37:01 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 14 Jan 2018 19:37:01 -0000 Subject: [GHC] #14669: Executable finishing via unhandled exception results in segmentation fault on 32 bit Windows In-Reply-To: <044.45c88c9a13190d9f2a70cd9b35309cc0@haskell.org> References: <044.45c88c9a13190d9f2a70cd9b35309cc0@haskell.org> Message-ID: <059.9235d4be1db84aaa3a6fa637a95cf639@haskell.org> #14669: Executable finishing via unhandled exception results in segmentation fault on 32 bit Windows -----------------------------------+---------------------------------- Reporter: sergv | Owner: (none) Type: bug | Status: infoneeded Priority: normal | Milestone: Component: Runtime System | Version: 8.2.1 Resolution: | Keywords: Operating System: Windows | Architecture: x86 Type of failure: Runtime crash | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -----------------------------------+---------------------------------- Comment (by Phyx-): That's very peculiar.. use `procdump` then https://docs.microsoft.com/en- us/sysinternals/downloads/procdump `procdump.exe -t -ma -e 1 -x . Hw.exe` -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 14 19:41:11 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 14 Jan 2018 19:41:11 -0000 Subject: [GHC] #10789: Notify user when a kind mismatch holds up a type family reduction In-Reply-To: <047.282dd8bb976bc76373d556a5e980ac6e@haskell.org> References: <047.282dd8bb976bc76373d556a5e980ac6e@haskell.org> Message-ID: <062.b86ba1b8088b0f83b51cce5a4c0ec3cb@haskell.org> #10789: Notify user when a kind mismatch holds up a type family reduction -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 7.10.2 Resolution: | Keywords: newcomer, | TypeFamilies Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by ckoparkar): Hello. I'm a newcomer, and would like to give this a shot. As goldfire suggested, I've started looking at `TcErrors`. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 14 20:04:22 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 14 Jan 2018 20:04:22 -0000 Subject: [GHC] #14669: Executable finishing via unhandled exception results in segmentation fault on 32 bit Windows In-Reply-To: <044.45c88c9a13190d9f2a70cd9b35309cc0@haskell.org> References: <044.45c88c9a13190d9f2a70cd9b35309cc0@haskell.org> Message-ID: <059.948b5cd445d07ee3d6cccd635058d993@haskell.org> #14669: Executable finishing via unhandled exception results in segmentation fault on 32 bit Windows -----------------------------------+---------------------------------- Reporter: sergv | Owner: (none) Type: bug | Status: infoneeded Priority: normal | Milestone: Component: Runtime System | Version: 8.2.1 Resolution: | Keywords: Operating System: Windows | Architecture: x86 Type of failure: Runtime crash | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -----------------------------------+---------------------------------- Comment (by sergv): Okay `procdump` seems to fare better: {{{ sergey at box /c/home/ghc/bugs$ procdump.exe -accepteula -t -ma -e 1 -x . Hw.exe ProcDump v9.0 - Sysinternals process dump utility Copyright (C) 2009-2017 Mark Russinovich and Andrew Richards Sysinternals - www.sysinternals.com Process: HW.exe (684) CPU threshold: n/a Performance counter: n/a Commit threshold: n/a Threshold seconds: n/a Hung window check: Disabled Log debug strings: Disabled Exception monitor: First Chance+Unhandled Exception filter: [Includes] * [Excludes] Terminate monitor: Enabled Cloning type: Disabled Concurrent limit: n/a Avoid outage: n/a Number of dumps: 1 Dump folder: .\ Dump filename/mask: PROCESSNAME_YYMMDD_HHMMSS Queue to WER: Disabled Kill after dump: Disabled Press Ctrl-C to end monitoring without terminating the process. Situation normal [19:51:59] Exception: C0000005.ACCESS_VIOLATION [19:51:59] Dump 1 initiated: .\HW.exe_180114_195159.dmp [19:52:00] Dump 1 writing: Estimated dump file size is 35 MB. [19:52:01] Dump 1 complete: 35 MB written in 1.4 seconds [19:52:01] Dump count reached. }}} I've uploaded the dump to https://fex.net/get/403580615683/210526178. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 14 20:11:09 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 14 Jan 2018 20:11:09 -0000 Subject: [GHC] #10789: Notify user when a kind mismatch holds up a type family reduction In-Reply-To: <047.282dd8bb976bc76373d556a5e980ac6e@haskell.org> References: <047.282dd8bb976bc76373d556a5e980ac6e@haskell.org> Message-ID: <062.1564bde48ffca1197211b68a37d6b659@haskell.org> #10789: Notify user when a kind mismatch holds up a type family reduction -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 7.10.2 Resolution: | Keywords: newcomer, | TypeFamilies Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by goldfire): A word of warning: TcErrors bears the accumulation of small patches that have been applied to incrementally improve error messages. I, personally, always find the module hard to navigate. However, if you have a specific erroneous situation in mind, it's not that hard to trace how that particular error filters through the module, and you should be able to find the stretch of code where the error itself is rendered. (A good starting place is to search for the text printed in the current error message.) To fix this, you'll have to add an extra check somewhere and then tailor the error message if necessary. Give a holler if you get stuck! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 14 20:36:56 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 14 Jan 2018 20:36:56 -0000 Subject: [GHC] #14619: Output value of program changes upon compiling with -O optimizations In-Reply-To: <044.7bc7afdc77e978715c67bc6238b57042@haskell.org> References: <044.7bc7afdc77e978715c67bc6238b57042@haskell.org> Message-ID: <059.2528dfec0ca35a5442ba5ec00c5872e9@haskell.org> #14619: Output value of program changes upon compiling with -O optimizations -------------------------------------+------------------------------------- Reporter: sheaf | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.4.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Windows | Architecture: x86_64 Type of failure: Incorrect result | (amd64) at runtime | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by carter): summary notes of findings / information so far. 1) reproducible in 64bit windows/ mingw32 windows 64bit build. Phyx- indicated that the bug is observable with ghc 8.2 and old, but not with 8.4/head? 2) O2 and disabling the CMM SINK optimization pass makes the bug go away, which seems to indicate / hint at the issue being some piece of compilation / optimization that interacts with the CMM Sink algorithm using platform dependent data is incorrect theres not that many places (seemingly) where the information / action differs at this layer between different x86_64 compiler targets. So i think one of the spots in cmm/ native code gen that does something different when the platform in MinGW32 is the culptrit? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 14 20:38:28 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 14 Jan 2018 20:38:28 -0000 Subject: [GHC] #14619: Output value of program changes upon compiling with -O optimizations In-Reply-To: <044.7bc7afdc77e978715c67bc6238b57042@haskell.org> References: <044.7bc7afdc77e978715c67bc6238b57042@haskell.org> Message-ID: <059.906a696c56d04586b1a91a2bc30e2838@haskell.org> #14619: Output value of program changes upon compiling with -O optimizations -------------------------------------+------------------------------------- Reporter: sheaf | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.4.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Windows | Architecture: x86_64 Type of failure: Incorrect result | (amd64) at runtime | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by carter): also phyx- had mentioned that when looking at the generate code, the bug seems to boil down to an xmm6 register being saved but not restored? one crazy experiment i'm wondering about is if using the graph register allocator would have the same bug? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 14 23:01:09 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 14 Jan 2018 23:01:09 -0000 Subject: [GHC] #14619: Output value of program changes upon compiling with -O optimizations In-Reply-To: <044.7bc7afdc77e978715c67bc6238b57042@haskell.org> References: <044.7bc7afdc77e978715c67bc6238b57042@haskell.org> Message-ID: <059.d41140b44570d7012e3d077f5911b8db@haskell.org> #14619: Output value of program changes upon compiling with -O optimizations -------------------------------------+------------------------------------- Reporter: sheaf | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.4.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Windows | Architecture: x86_64 Type of failure: Incorrect result | (amd64) at runtime | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Phyx-): I don't think it's a register allocation issue. I think it's a genuine bug in a Core2Core pass: Following the code fom `sphereIntersection`, the first interesting location is `0x0000000000401E72` (it's all statically linked). At this address the first 6 doubles are loaded from the stack: {{{ 0x401e72 : movsd %xmm1,-0x30(%rbp) 0x401e77 : movsd %xmm2,-0x28(%rbp) 0x401e7c : movsd %xmm3,-0x20(%rbp) 0x401e81 : movsd %xmm4,-0x18(%rbp) 0x401e86 : movsd %xmm5,-0x10(%rbp) 0x401e8b : movsd %xmm6,-0x8(%rbp) }}} Here: {{{ xmm1 = 0 xmm2 = 0 xmm3 = 0 xmm4 = 1.1 xmm5 = 2.2 xmm6 = 3.3 }}} So far so good. The first operation to get done is `b = oc <.> dir`. oc we already know since `(<+>)` seems to have been inlined and folded away (I assume GHC does constant folding since I can't find any code for this). so the code for `(<.>)` is at `0x0000000000401C14`: {{{ 0x401c14 : movsd 0x10(%rbp),%xmm0 (= 200) 0x401c19 : addsd %xmm3,%xmm0 0x401c1d : mulsd %xmm6,%xmm0 0x401c21 : movsd 0x8(%rbp),%xmm6 (= 0) 0x401c26 : addsd %xmm2,%xmm6 0x401c2a : mulsd %xmm5,%xmm6 0x401c2e : movsd 0x0(%rbp),%xmm7 (= 0) 0x401c33 : addsd %xmm1,%xmm7 0x401c37 : mulsd %xmm4,%xmm7 0x401c3b : addsd %xmm6,%xmm7 0x401c3f : addsd %xmm0,%xmm7 }}} So this performed `oc <.> dir` and `xmm7` now contains `b`. Also notice we clobbed `xmm6` here. It now contains `0`. The next thing we must do is calculate `sqrtDisc` and calculate `t1`. t1 is at `0000000000401C9B` {{{ 0x401c9b : movsd 0x68(%rsp),%xmm1 0x401ca1 : movsd %xmm1,%xmm2 0x401ca5 : subsd %xmm0,%xmm2 0x401ca9 : xorpd %xmm3,%xmm3 0x401cad : ucomisd %xmm3,%xmm2 0x401cb1 : ja 0x401cd8 (t1 > 0) 0x401cb3 : addsd %xmm0,%xmm1 0x401cb7 : xorpd %xmm0,%xmm0 0x401cbb : ucomisd %xmm0,%xmm1 0x401cbf : ja 0x401d9a (t2 > 0) }}} we take the branch to `0x401cd8` which is `t1 > 0` and then must evaluate `(*>)` which is at `0x0000000000401CD8` `t1` is stored in `xmm2`. {{{ 0x401cd8 : movq $0x498cd8,-0x80(%r12) 0x401ce1 : movsd %xmm6,-0x78(%r12) 0x401ce8 : movq $0x498cd8,-0x70(%r12) 0x401cf1 : movsd %xmm2,%xmm0 0x401cf5 : mulsd %xmm6,%xmm0 0x401cf9 : movsd %xmm0,-0x68(%r12) 0x401d00 : movq $0x498cd8,-0x60(%r12) 0x401d09 : movsd %xmm2,%xmm0 0x401d0d : movsd 0x60(%rsp),%xmm1 0x401d13 : mulsd %xmm1,%xmm0 0x401d17 : movsd %xmm0,-0x58(%r12) 0x401d1e : movq $0x498cd8,-0x50(%r12) 0x401d27 : movsd 0x58(%rsp),%xmm0 0x401d2d : mulsd %xmm0,%xmm2 0x401d31 : movsd %xmm2,-0x48(%r12) 0x401d38 : movq $0x498b18,-0x40(%r12) }}} Notice a couple of weird things here. `xmm6` is still clobbered and has no meaning, yet we still spill it but never load it again (that I could find). Then we do the multiplication of `a*x'` without ever restoring `x'` {{{ 0x401cf5 : mulsd %xmm6,%xmm0 }}} Weirdly, we then restore `y'` and `z'` which are stored at `0x60(%rsp)` and `0x58(%rsp)`. Inspecting `%rsp` I see `xmm6` (3.3) was never spilled to begin with. {{{ 0000000000B6DBB8 0 0 0000000000B6DBC8 0 1.1 0000000000B6DBD8 2.2 660 }}} Now that we know what's happening, let's compare `-O0` and `-O2`. At `-O0` where it works, we have the following sequence for `(<.>)`: {{{ .Ln4nu: movsd (%rbp),%xmm0 movsd 8(%rbp),%xmm7 movsd 16(%rbp),%xmm8 ... .Ln4nw: addsd %xmm3,%xmm8 mulsd %xmm6,%xmm8 addsd %xmm2,%xmm7 mulsd %xmm5,%xmm7 addsd %xmm1,%xmm0 mulsd %xmm4,%xmm0 addsd %xmm7,%xmm0 addsd %xmm8,%xmm0 xorpd %xmm7,%xmm7 ucomisd %xmm7,%xmm0 }}} Notice that `xmm6` is not clobbered here. The `-O2` version is: {{{ movsd 16(%rbp),%xmm0 addsd %xmm3,%xmm0 mulsd %xmm6,%xmm0 movsd 8(%rbp),%xmm6 addsd %xmm2,%xmm6 mulsd %xmm5,%xmm6 movsd (%rbp),%xmm7 addsd %xmm1,%xmm7 mulsd %xmm4,%xmm7 addsd %xmm6,%xmm7 addsd %xmm0,%xmm7 xorpd %xmm0,%xmm0 ucomisd %xmm0,%xmm7 }}} At `-O0` because it's not clobbered later it correctly spills `xmm6`: {{{ .Ln4o8: movl $1,%eax movsd %xmm1,104(%rsp) movsd %xmm2,112(%rsp) movsd %xmm3,120(%rsp) movsd %xmm4,128(%rsp) movsd %xmm5,136(%rsp) movsd %xmm6,144(%rsp) movsd %xmm8,152(%rsp) }}} Whereas `-O2` thinks it doesn't need the value and spills one register too few. {{{ .Ln4os: movl $1,%eax movsd %xmm1,104(%rsp) movsd %xmm2,112(%rsp) movsd %xmm3,120(%rsp) movsd %xmm4,128(%rsp) movsd %xmm5,136(%rsp) movsd %xmm7,144(%rsp) }}} My guess is, at `-O2` it thinks it has enough registers to not need to spill `xmm6`. But it then later clobbers without spilling and reloading it! However I'm too tired to look at Core tonight, so I'll continue next week. I think it's a Core pass eliminating a value it shouldn't. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 14 23:23:31 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 14 Jan 2018 23:23:31 -0000 Subject: [GHC] #14669: Executable finishing via unhandled exception results in segmentation fault on 32 bit Windows In-Reply-To: <044.45c88c9a13190d9f2a70cd9b35309cc0@haskell.org> References: <044.45c88c9a13190d9f2a70cd9b35309cc0@haskell.org> Message-ID: <059.e92ff9c1df616889074d731eaba081ce@haskell.org> #14669: Executable finishing via unhandled exception results in segmentation fault on 32 bit Windows -----------------------------------+---------------------------------- Reporter: sergv | Owner: (none) Type: bug | Status: infoneeded Priority: normal | Milestone: Component: Runtime System | Version: 8.2.1 Resolution: | Keywords: Operating System: Windows | Architecture: x86 Type of failure: Runtime crash | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -----------------------------------+---------------------------------- Comment (by Phyx-): This seems like a genuine segfault to me. {{{ CONTEXT: (.ecxr) eax=02703818 ebx=00527150 ecx=02700040 edx=02702f04 esi=00000001 edi=02702f00 eip=004c4343 esp=0028bcac ebp=02703804 iopl=0 nv up ei pl nz na pe nc cs=0023 ss=002b ds=002b es=002b fs=0053 gs=002b efl=00010206 HW+0xc4343: 004c4343 89442440 mov dword ptr [esp+40h],eax ss:002b:0028bcec=???????? Resetting default scope WARNING: Stack overflow detected. The unwound frames are extracted from outside normal stack bounds. FAULTING_IP: HW+c4343 004c4343 89442440 mov dword ptr [esp+40h],eax EXCEPTION_RECORD: (.exr -1) ExceptionAddress: 004c4343 (HW+0x000c4343) ExceptionCode: c0000005 (Access violation) ExceptionFlags: 00000000 NumberParameters: 2 Parameter[0]: 00000001 Parameter[1]: 0028bcec Attempt to write to address 0028bcec DEFAULT_BUCKET_ID: INVALID_STACK_ACCESS }}} Something is writing to `$sp+0x40` which seems to be invalid. Actually the address `sp` itself is pointing to seems to be invalid. Attach the broken binary too please. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 15 00:51:28 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 15 Jan 2018 00:51:28 -0000 Subject: [GHC] #14670: -XRebindableSyntax needs return? Message-ID: <048.c96b42d6aefe76220126edbb094e21e4@haskell.org> #14670: -XRebindableSyntax needs return? -------------------------------------+------------------------------------- Reporter: jackkelly | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Keywords: | Operating System: Unknown/Multiple RebindableSyntax | Architecture: | Type of failure: GHC rejects Unknown/Multiple | valid program Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- The documentation for -XRebindableSyntax ( https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/glasgow_exts.html #rebindable-syntax-and-the-implicit-prelude-import ) reads: > “Do” notation is translated using whatever functions (>>=), (>>), and fail, are in scope (not the Prelude versions). List comprehensions, mdo (The recursive do-notation), and parallel array comprehensions, are unaffected. The following code fails to compile (also confirmed to fail on GHC 8.0.2): {{{ {-# LANGUAGE RebindableSyntax #-} module Lib where import Prelude (IO) foo :: IO () foo = do pure () }}} It fails with this error: {{{ /home/kel317/z/src/Lib.hs:9:3: error: Not in scope: ‘return’ Perhaps you want to add ‘return’ to the import list in the import of ‘Prelude’ (src/Lib.hs:5:1-19). | 9 | pure () | ^^^^^^^ }}} To my reading, either something funky is going on with the way the do- notation is desugared, or the documentation needs to be corrected. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 15 02:52:19 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 15 Jan 2018 02:52:19 -0000 Subject: [GHC] #13032: Redundant forcing of Given dictionaries In-Reply-To: <046.811080f481e777da656f14add09b1cc8@haskell.org> References: <046.811080f481e777da656f14add09b1cc8@haskell.org> Message-ID: <061.484188409a7d74471df45745a6f48ad5@haskell.org> #13032: Redundant forcing of Given dictionaries -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: Component: Compiler | Version: 8.0.1 Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: | typecheck/should_compile/T13032 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by goldfire): I fixed the test case by suppressing the extra `-ddump-ds` output when `-dno-debug-output` is enabled. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 15 07:41:07 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 15 Jan 2018 07:41:07 -0000 Subject: [GHC] #14122: Core lint error while compiling GHC.IO.Handle In-Reply-To: <046.2391c0290c34ee83dfcea71f37a050f4@haskell.org> References: <046.2391c0290c34ee83dfcea71f37a050f4@haskell.org> Message-ID: <061.fc1fd223d46416a3bc11a3ab8d93395e@haskell.org> #14122: Core lint error while compiling GHC.IO.Handle -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.2.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #14123 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by osa1): bgamari, what's your `build.mk` contents that reproduces this error? I just tried with {{{ SRC_HC_OPTS = -O0 -H64m GhcStage1HcOpts = -O -g3 -dcore-lint GhcStage2HcOpts = -O0 GhcLibHcOpts = -O BUILD_PROF_LIBS = NO SplitObjs = NO SplitSections = NO HADDOCK_DOCS = NO BUILD_SPHINX_HTML = NO BUILD_SPHINX_PDF = NO BUILD_MAN = NO }}} but couldn't reproduce this. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 15 08:47:04 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 15 Jan 2018 08:47:04 -0000 Subject: [GHC] #14669: Executable finishing via unhandled exception results in segmentation fault on 32 bit Windows In-Reply-To: <044.45c88c9a13190d9f2a70cd9b35309cc0@haskell.org> References: <044.45c88c9a13190d9f2a70cd9b35309cc0@haskell.org> Message-ID: <059.042966374fac738bdc4957f31a17c5f2@haskell.org> #14669: Executable finishing via unhandled exception results in segmentation fault on 32 bit Windows -----------------------------------+---------------------------------- Reporter: sergv | Owner: (none) Type: bug | Status: infoneeded Priority: normal | Milestone: Component: Runtime System | Version: 8.2.1 Resolution: | Keywords: Operating System: Windows | Architecture: x86 Type of failure: Runtime crash | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -----------------------------------+---------------------------------- Comment (by sergv): Please find the binary and a copy of the same dump log at https://fex.net/#!034044549103. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 15 08:48:20 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 15 Jan 2018 08:48:20 -0000 Subject: [GHC] #14619: Output value of program changes upon compiling with -O optimizations In-Reply-To: <044.7bc7afdc77e978715c67bc6238b57042@haskell.org> References: <044.7bc7afdc77e978715c67bc6238b57042@haskell.org> Message-ID: <059.9f6bf06ad6ad94b2bf6f6bd63a12ced5@haskell.org> #14619: Output value of program changes upon compiling with -O optimizations -------------------------------------+------------------------------------- Reporter: sheaf | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.4.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Windows | Architecture: x86_64 Type of failure: Incorrect result | (amd64) at runtime | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): > I think it's a Core pass eliminating a value it shouldn't. That would be easier to fix; but wouldn't that affect all platforms equally? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 15 08:51:09 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 15 Jan 2018 08:51:09 -0000 Subject: [GHC] #13032: Redundant forcing of Given dictionaries In-Reply-To: <046.811080f481e777da656f14add09b1cc8@haskell.org> References: <046.811080f481e777da656f14add09b1cc8@haskell.org> Message-ID: <061.56b4da0116f4b00042810b544654cf7d@haskell.org> #13032: Redundant forcing of Given dictionaries -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: Component: Compiler | Version: 8.0.1 Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: | typecheck/should_compile/T13032 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): > I fixed the test case by suppressing the extra -ddump-ds output when -dno-debug-output is enabled. OK. Actually it's very unsavoury that the DEBUG build changes the behaviour of `-ddump-ds`. I think it'd be better to add a flag `-ddump- ds-preopt` or something like that. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 15 08:59:05 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 15 Jan 2018 08:59:05 -0000 Subject: [GHC] #14671: Make the Template Haskell class Lift work over typed expressions Message-ID: <046.7f4fa9b815f39c9531e53be8b5e6ebfa@haskell.org> #14671: Make the Template Haskell class Lift work over typed expressions -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: feature | Status: new request | Priority: normal | Milestone: Component: Template | Version: 8.2.2 Haskell | Keywords: | Operating System: Unknown/Multiple TemplateHaskell | Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- At the moment we have the `Lift` class in TH: {{{ class Lift t where lift :: t -> Q Exp }}} But that loses type information. What we want is this: {{{ Lift t where typedLift :: t -> Q (TExp t) lift :: Lift t => t -> Q Exp lift = fmap unType . typedLift }}} Otherwise, when you want the typed version, people resort to unsafe-coerce operations, which are entirely unnecessary. See [https://mail.haskell.org/pipermail/libraries/2018-January/028409.html this thread on the libraries list]. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 15 09:28:19 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 15 Jan 2018 09:28:19 -0000 Subject: [GHC] #14644: Improve cmm/assembly for pattern matches with two constants. In-Reply-To: <047.054a8f1d3e52c239a87742662b91a120@haskell.org> References: <047.054a8f1d3e52c239a87742662b91a120@haskell.org> Message-ID: <062.8032043277889cb6d93acbacccbf9859@haskell.org> #14644: Improve cmm/assembly for pattern matches with two constants. -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: AndreasK Type: task | Status: patch Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 (CodeGen) | Keywords: Codegen, CMM, Resolution: | Patterns, Pattern Matching Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4294 Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): It would be great to ensure that there is a Note to explain the thinking before you tie the bow on this. Thanks! Simon -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 15 10:37:55 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 15 Jan 2018 10:37:55 -0000 Subject: [GHC] #14626: No need to enter a scrutinised value In-Reply-To: <048.67c951c2aecb97b988badb4816dbe757@haskell.org> References: <048.67c951c2aecb97b988badb4816dbe757@haskell.org> Message-ID: <063.7c0e83f4b562eab6ae80edb98b8f2838@haskell.org> #14626: No need to enter a scrutinised value -------------------------------------+------------------------------------- Reporter: heisenbug | Owner: heisenbug Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: performance Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #13861 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by heisenbug): > > > There is only one place in the code generator namely `StgCmmCon.buildDynCon'`. You could perhaps add (runtime) assertions there to see if any strict fields had un-tagged pointers. After adding a runtime assertion here, I found one smoking gun. Banged `IORef`s (a.k.a `newtype`d `STRef`s) should be tagged, but end up untagged e.g. in `Handle__`. I am investigating why this happens. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 15 10:50:37 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 15 Jan 2018 10:50:37 -0000 Subject: [GHC] #14665: http://www.cminusminus.org/ is dead In-Reply-To: <046.ee5d0668b0e8cf9e55beec4faafe96d3@haskell.org> References: <046.ee5d0668b0e8cf9e55beec4faafe96d3@haskell.org> Message-ID: <061.52a7b4f22c163552c73722ad1c1c6bc7@haskell.org> #14665: http://www.cminusminus.org/ is dead -------------------------------------+------------------------------------- Reporter: niteria | Owner: (none) Type: task | Status: new Priority: lowest | Milestone: Component: Documentation | Version: Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * cc: nr@… (added) Comment: Or just point to http://www.cs.tufts.edu/~nr/c--/index.html? I'm cc'ing Norman to ask if it'll stay there. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 15 14:30:31 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 15 Jan 2018 14:30:31 -0000 Subject: [GHC] #14626: No need to enter a scrutinised value In-Reply-To: <048.67c951c2aecb97b988badb4816dbe757@haskell.org> References: <048.67c951c2aecb97b988badb4816dbe757@haskell.org> Message-ID: <063.15c30a548399309afc920b3f9c32a963@haskell.org> #14626: No need to enter a scrutinised value -------------------------------------+------------------------------------- Reporter: heisenbug | Owner: heisenbug Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: performance Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #13861 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by alexbiehl): An `STRef` is a wrapper around `MutVar#` which is has `UnliftedRep` (represented through a pointer, never bottom) thus it doesn't need a tag to note its evaluatedness. GHC probably only tags value with `LiftedRep`. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 15 14:51:37 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 15 Jan 2018 14:51:37 -0000 Subject: [GHC] #14626: No need to enter a scrutinised value In-Reply-To: <048.67c951c2aecb97b988badb4816dbe757@haskell.org> References: <048.67c951c2aecb97b988badb4816dbe757@haskell.org> Message-ID: <063.0df87d41336b12991ef67dba4b50f75b@haskell.org> #14626: No need to enter a scrutinised value -------------------------------------+------------------------------------- Reporter: heisenbug | Owner: heisenbug Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: performance Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #13861 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): We have {{{ data STRef s a = STRef (MutVar# s a) newtype IORef a = IORef (STRef RealWorld a) data Handle__ = H !(IORef Char) }}} Indeed the pointer to the `MutVarf` is untagged; but heisenbug is claiming that the pointer to the `IORef`, stored in the `Handle__` is untagged. And that pointer should ''certainly'' be tagged. Smoking gun, I say, if I have correctly understood the claim. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 15 15:37:15 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 15 Jan 2018 15:37:15 -0000 Subject: [GHC] #14626: No need to enter a scrutinised value In-Reply-To: <048.67c951c2aecb97b988badb4816dbe757@haskell.org> References: <048.67c951c2aecb97b988badb4816dbe757@haskell.org> Message-ID: <063.66187e45102a27a347b6d8883d04cecd@haskell.org> #14626: No need to enter a scrutinised value -------------------------------------+------------------------------------- Reporter: heisenbug | Owner: heisenbug Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: performance Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #13861 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by alexbiehl): Right, though `GHC.IO.Handle.Types`, which contains `Handle__`, has {{{ {-# OPTIONS_GHC -funbox-strict-fields #-} }}} in its header. Given this, our example `data H = H !(IORef Char)` turns into {{{ $WH $WH = \ dt_aV9 -> case dt_aV9 `cast` of { STRef dt_aVb -> H dt_aVb } }}} So we are indeed storing a `MutVar#` here. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 15 16:23:39 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 15 Jan 2018 16:23:39 -0000 Subject: [GHC] #14123: Figure out invariants surrounding ticks in Core In-Reply-To: <046.0308c769b363c5285c5969fe8d556b65@haskell.org> References: <046.0308c769b363c5285c5969fe8d556b65@haskell.org> Message-ID: <061.76f01e6d41e13a2633fcc675b536d442@haskell.org> #14123: Figure out invariants surrounding ticks in Core -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: task | Status: new Priority: highest | Milestone: 8.4.1 Component: Compiler | Version: 8.2.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #13233, #14122, | Differential Rev(s): #8472, #14406 | Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): ticket:13233#comment:40 has some useful ideas on how to proceed. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 15 16:32:08 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 15 Jan 2018 16:32:08 -0000 Subject: [GHC] #14665: http://www.cminusminus.org/ is dead In-Reply-To: <046.ee5d0668b0e8cf9e55beec4faafe96d3@haskell.org> References: <046.ee5d0668b0e8cf9e55beec4faafe96d3@haskell.org> Message-ID: <061.e62d15d3d82976c0d1a7147a880b2b5e@haskell.org> #14665: http://www.cminusminus.org/ is dead -------------------------------------+------------------------------------- Reporter: niteria | Owner: (none) Type: task | Status: patch Priority: lowest | Milestone: Component: Documentation | Version: Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4311 Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: new => patch * differential: => Phab:D4311 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 15 16:39:19 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 15 Jan 2018 16:39:19 -0000 Subject: [GHC] #14635: Double stacktrace with errorWithCallStack In-Reply-To: <046.342ecdededd713faab2e8b8b0c796ed8@haskell.org> References: <046.342ecdededd713faab2e8b8b0c796ed8@haskell.org> Message-ID: <061.094cd39bad661ab4f9499970ca36d66c@haskell.org> #14635: Double stacktrace with errorWithCallStack -------------------------------------+------------------------------------- Reporter: flip101 | Owner: alpmestan Type: bug | Status: new Priority: normal | Milestone: Component: Documentation | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by alpmestan): * owner: (none) => alpmestan -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 15 16:41:42 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 15 Jan 2018 16:41:42 -0000 Subject: [GHC] #14632: Export typeNatDivTyCon from TcTypeNats In-Reply-To: <046.9a08807e882b9954423a7a486869ec2a@haskell.org> References: <046.9a08807e882b9954423a7a486869ec2a@haskell.org> Message-ID: <061.c730f21cec810df15bcb33aaf7354aca@haskell.org> #14632: Export typeNatDivTyCon from TcTypeNats -------------------------------------+------------------------------------- Reporter: darchon | Owner: darchon Type: feature request | Status: closed Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.4.1-alpha1 Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4284 Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: merge => closed * resolution: => fixed Comment: Merged in 273131dfd83ef4f8b6722526dbc9be3215815af4. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 15 16:42:11 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 15 Jan 2018 16:42:11 -0000 Subject: [GHC] #14338: Simplifier fails with "Simplifier ticks exhausted" In-Reply-To: <049.819ef8e60a65cb9f3e29afb8f69166a7@haskell.org> References: <049.819ef8e60a65cb9f3e29afb8f69166a7@haskell.org> Message-ID: <064.fcdbb5c878b7ee6496084b47fe048416@haskell.org> #14338: Simplifier fails with "Simplifier ticks exhausted" -------------------------------------+------------------------------------- Reporter: dredozubov | Owner: bgamari Type: bug | Status: closed Priority: high | Milestone: 8.4.1 Component: Compiler | Version: 8.2.1 Resolution: fixed | Keywords: Operating System: Linux | Architecture: x86_64 Type of failure: Compile-time | (amd64) crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: merge => closed Comment: Merged in 5124b04f10adfee6390f435a493984f2b45062d0. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 15 16:43:11 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 15 Jan 2018 16:43:11 -0000 Subject: [GHC] #14650: Panic with no extensions (StgCmmEnv: variable not found) In-Reply-To: <045.b734e19b172639c0ef220c04df7c2bd5@haskell.org> References: <045.b734e19b172639c0ef220c04df7c2bd5@haskell.org> Message-ID: <060.c71711c7299528d623f6075a48a8f8e9@haskell.org> #14650: Panic with no extensions (StgCmmEnv: variable not found) -------------------------------------+------------------------------------- Reporter: Zemyla | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.2.2 Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: x86_64 | (amd64) Type of failure: Compile-time | Test Case: crash or panic | simplCore/should_compile/T14650.hs Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: merge => closed * resolution: => fixed * milestone: => 8.4.1 Comment: comment:3 merged in 20afdaa75e269697c2f9608e6d29f720a6387d01. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 15 16:43:36 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 15 Jan 2018 16:43:36 -0000 Subject: [GHC] #14643: Partial type signatures in class constraints behave unexpectedly In-Reply-To: <047.6762d95c975e1952f57776fe89e6e2c0@haskell.org> References: <047.6762d95c975e1952f57776fe89e6e2c0@haskell.org> Message-ID: <062.02f9aa4238404688bb7233e1128f125a@haskell.org> #14643: Partial type signatures in class constraints behave unexpectedly -------------------------------------+------------------------------------- Reporter: mnislaih | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.2.2 Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: partial- | sigs/should_compile/T14643, T14643a Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: merge => closed * resolution: => fixed * milestone: => 8.4.1 Comment: Merged in 3d2664e4d97fde24f4a70d3fd106618d41c55776 and 8553593731872dc9d33edca3afc9088d40fe75ed. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 15 16:48:37 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 15 Jan 2018 16:48:37 -0000 Subject: [GHC] #14538: forkprocess01 fails occassionally on with multiple ACQUIRE_LOCK panic In-Reply-To: <046.6179459a606dda455f09a96c2a4bfb98@haskell.org> References: <046.6179459a606dda455f09a96c2a4bfb98@haskell.org> Message-ID: <061.2d833dcddee7e452682cfcf5bc5cc54a@haskell.org> #14538: forkprocess01 fails occassionally on with multiple ACQUIRE_LOCK panic -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: Component: Runtime System | Version: 8.3 Resolution: | Keywords: Operating System: MacOS X | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * priority: high => highest Comment: We really need to do something about this; a significant fraction of OS X builds are failing due to this test. I'm going to `skip` it on OS X for the time being. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 15 17:21:07 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 15 Jan 2018 17:21:07 -0000 Subject: [GHC] #9285: IO manager startup procedure somewhat odd In-Reply-To: <044.a7ab40532a3a20a4ca082f731e68f5e6@haskell.org> References: <044.a7ab40532a3a20a4ca082f731e68f5e6@haskell.org> Message-ID: <059.9a6248e485c7468aa0efca7a19a9ebcc@haskell.org> #9285: IO manager startup procedure somewhat odd -------------------------------------+------------------------------------- Reporter: edsko | Owner: simonmar Type: task | Status: closed Priority: low | Milestone: 8.6.1 Component: Runtime System | Version: 7.8.2 Resolution: wontfix | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: patch => closed * resolution: => wontfix * milestone: 8.4.1 => 8.6.1 Comment: I'm not sure that the proposal in comment:2 is reasonable; this would mean that calling `hs_init_ghc` would be insufficient to fully initialize the runtime environment. This in turn means that users who drive the RTS directly would need to duplicate the IO manager initialization logic. All of this for questionable benefit. I'm going to close this as WONTFIX but do say if there is a different refactoring that you would like to see. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 15 17:49:08 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 15 Jan 2018 17:49:08 -0000 Subject: [GHC] #8949: switch -msse2 to be on by default In-Reply-To: <044.ed86a749988b5b707f5059998e60c5c2@haskell.org> References: <044.ed86a749988b5b707f5059998e60c5c2@haskell.org> Message-ID: <059.e36f665c303a417ccf8848c62f9f58fd@haskell.org> #8949: switch -msse2 to be on by default --------------------------------------------+------------------------------ Reporter: errge | Owner: (none) Type: bug | Status: new Priority: high | Milestone: 8.6.1 Component: Compiler (CodeGen) | Version: 7.9 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: x86 Type of failure: Runtime performance bug | Test Case: Blocked By: | Blocking: Related Tickets: #13540 | Differential Rev(s): Wiki Page: | --------------------------------------------+------------------------------ Changes (by bgamari): * milestone: 8.4.1 => 8.6.1 Comment: We can't act on this until the linker issues are sorted out. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 15 17:50:15 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 15 Jan 2018 17:50:15 -0000 Subject: [GHC] #5620: Dynamic linking and threading does not work on Windows In-Reply-To: <046.0549cfb6865d8f8da0c4dd410e165104@haskell.org> References: <046.0549cfb6865d8f8da0c4dd410e165104@haskell.org> Message-ID: <061.b660fea81b64af15bb370b0270fefa55@haskell.org> #5620: Dynamic linking and threading does not work on Windows -------------------------------------+------------------------------------- Reporter: Lennart | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 7.2.1 (Linking) | Resolution: | Keywords: Operating System: Windows | Architecture: | Unknown/Multiple Type of failure: Runtime crash | Test Case: Blocked By: | Blocking: Related Tickets: #10352 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * milestone: 8.4.1 => 8.6.1 Comment: This won't happen this release. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 15 17:54:19 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 15 Jan 2018 17:54:19 -0000 Subject: [GHC] #10972: Add a :binfo (beginner info) GHCi command In-Reply-To: <045.69c25027f6e9192e0896957840c11b0e@haskell.org> References: <045.69c25027f6e9192e0896957840c11b0e@haskell.org> Message-ID: <060.34f76cb0c954ce57781256e1a8c81599@haskell.org> #10972: Add a :binfo (beginner info) GHCi command -------------------------------------+------------------------------------- Reporter: kanetw | Owner: kanetw Type: feature request | Status: new Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 7.10.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #10963 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): KaneTW, what ever happened to this? I agree that it sounds like a very helpful feature for newcomers. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 15 17:54:36 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 15 Jan 2018 17:54:36 -0000 Subject: [GHC] #10972: Add a :binfo (beginner info) GHCi command In-Reply-To: <045.69c25027f6e9192e0896957840c11b0e@haskell.org> References: <045.69c25027f6e9192e0896957840c11b0e@haskell.org> Message-ID: <060.8ccfab570b8776d53dd11549104a6a5e@haskell.org> #10972: Add a :binfo (beginner info) GHCi command -------------------------------------+------------------------------------- Reporter: kanetw | Owner: kanetw Type: feature request | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 7.10.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #10963 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * milestone: 8.4.1 => 8.6.1 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 15 17:56:03 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 15 Jan 2018 17:56:03 -0000 Subject: [GHC] #14191: Implement Semigroup as a superclass of Monoid Proposal (Phase 2) In-Reply-To: <042.0aadb43263d56b871c202e854c7ea816@haskell.org> References: <042.0aadb43263d56b871c202e854c7ea816@haskell.org> Message-ID: <057.73dd26c13d59ac283f01154c586648bb@haskell.org> #14191: Implement Semigroup as a superclass of Monoid Proposal (Phase 2) -------------------------------------+------------------------------------- Reporter: hvr | Owner: hvr Type: task | Status: closed Priority: normal | Milestone: 8.4.1 Component: libraries/base | Version: 8.2.1 Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #10365 | Differential Rev(s): phab:D3927 Wiki Page: | prime:Libraries/Proposals/SemigroupMonoid| -------------------------------------+------------------------------------- Changes (by bgamari): * status: new => closed * resolution: => fixed Comment: I believe this is now done. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 15 17:56:27 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 15 Jan 2018 17:56:27 -0000 Subject: [GHC] #14282: tagToEnum# . dataToTag# not optimized away In-Reply-To: <045.5438ce0b3dc299cc3f08e924d6abe37c@haskell.org> References: <045.5438ce0b3dc299cc3f08e924d6abe37c@haskell.org> Message-ID: <060.3d809cda5e9e162e92c70fab8aba2bab@haskell.org> #14282: tagToEnum# . dataToTag# not optimized away -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: dfeuer Type: bug | Status: new Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.2.1 Resolution: | Keywords: datacon-tags Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): dfeuer, what is the status of this? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 15 17:59:03 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 15 Jan 2018 17:59:03 -0000 Subject: [GHC] #13647: Tidy up TcTypeable In-Reply-To: <046.ce5bf479308764e177daf1d80c7aa0cd@haskell.org> References: <046.ce5bf479308764e177daf1d80c7aa0cd@haskell.org> Message-ID: <061.adddeab7e34afdfcdeb2b7ca70e61cc0@haskell.org> #13647: Tidy up TcTypeable -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.0.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * milestone: 8.4.1 => 8.6.1 Comment: On re-reading Simon's suggestions they actually sound quite plausible. We should certainly give this a try. Not for 8.4, however. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 15 18:00:07 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 15 Jan 2018 18:00:07 -0000 Subject: [GHC] #7206: Implement cheap build In-Reply-To: <046.231132dc13e5eec24b09b65a3836eff3@haskell.org> References: <046.231132dc13e5eec24b09b65a3836eff3@haskell.org> Message-ID: <061.154fdf91fbfdfd1c52538c49254983da@haskell.org> #7206: Implement cheap build -------------------------------------+------------------------------------- Reporter: simonpj | Owner: simonpj Type: bug | Status: new Priority: normal | Milestone: ⊥ Component: Compiler | Version: 7.4.2 Resolution: | Keywords: FloatOut Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: #8763, #13422 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * related: #8763 => #8763, #13422 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 15 18:44:54 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 15 Jan 2018 18:44:54 -0000 Subject: [GHC] #14626: No need to enter a scrutinised value In-Reply-To: <048.67c951c2aecb97b988badb4816dbe757@haskell.org> References: <048.67c951c2aecb97b988badb4816dbe757@haskell.org> Message-ID: <063.3169bdac84c84cbd4afb39ae57abb0e3@haskell.org> #14626: No need to enter a scrutinised value -------------------------------------+------------------------------------- Reporter: heisenbug | Owner: heisenbug Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: performance Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #13861 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by heisenbug): Replying to [comment:31 alexbiehl]: > > Edit: Ah this isn't true. A `-O` slipped into my tests. So my statement above isn't true. So strict field unboxing (without the explicit pragma) happens in `-O1` (and above) only? (That would explain why I often get crashes when mixing `-O0` and `-O1`) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 15 18:44:59 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 15 Jan 2018 18:44:59 -0000 Subject: [GHC] #14670: -XRebindableSyntax needs return? In-Reply-To: <048.c96b42d6aefe76220126edbb094e21e4@haskell.org> References: <048.c96b42d6aefe76220126edbb094e21e4@haskell.org> Message-ID: <063.2df2e4745c715a43ca7ce84c6a4f8c1e@haskell.org> #14670: -XRebindableSyntax needs return? -------------------------------------+------------------------------------- Reporter: jackkelly | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: | RebindableSyntax Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: GHC rejects | Test Case: valid program | rebindable/T14670 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * testcase: => rebindable/T14670 * milestone: => 8.6.1 Comment: Indeed that is quite curious. My first thought was perhaps `ApplicativeDo` was involved, but it's not enabled. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 15 19:22:06 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 15 Jan 2018 19:22:06 -0000 Subject: [GHC] #14569: refutable let bindings produce "irrefutable pattern failed" errors In-Reply-To: <044.8464d6345485258705bd110865737bdc@haskell.org> References: <044.8464d6345485258705bd110865737bdc@haskell.org> Message-ID: <059.d77ea3460256113cf2e500a966e7a19e@haskell.org> #14569: refutable let bindings produce "irrefutable pattern failed" errors -------------------------------------+------------------------------------- Reporter: int-e | Owner: dfeuer Type: bug | Status: patch Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Poor/confusing | Unknown/Multiple error message | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4261 Wiki Page: | -------------------------------------+------------------------------------- Comment (by Ben Gamari ): In [changeset:"492e6044577519b59f390008362de98e9517e04d/ghc" 492e604/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="492e6044577519b59f390008362de98e9517e04d" Kill off irrefutable pattern errors Distinguishing between "refutable" and "irrefutable" patterns (as described by the Haskell Report) in incomplete pattern errors was more confusing than helpful. Remove references to irrefutable patterns. Reviewers: hvr, bgamari, simonpj Reviewed By: simonpj Subscribers: simonpj, rwbarton, thomie, carter GHC Trac Issues: #14569 Differential Revision: https://phabricator.haskell.org/D4261 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 15 19:22:06 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 15 Jan 2018 19:22:06 -0000 Subject: [GHC] #14456: Windows runtime linker failure with icuuc In-Reply-To: <050.3b07902cfc2f558e6740649e9c204478@haskell.org> References: <050.3b07902cfc2f558e6740649e9c204478@haskell.org> Message-ID: <065.bb7ad1631a309b8466e47cdba93bff16@haskell.org> #14456: Windows runtime linker failure with icuuc -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: Phyx- Type: bug | Status: patch Priority: normal | Milestone: 8.6.1 Component: Runtime System | Version: 8.2.2 (Linker) | Resolution: | Keywords: Operating System: Windows | Architecture: | Unknown/Multiple Type of failure: GHCi crash | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4274 Wiki Page: | -------------------------------------+------------------------------------- Comment (by Ben Gamari ): In [changeset:"3d17f1f10fc00540ac052f2fd03182906aa47e35/ghc" 3d17f1f/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="3d17f1f10fc00540ac052f2fd03182906aa47e35" Tweak link order slightly to prefer user shared libs before system ones. We currently always prefer shared libraries before import libraries and static libraries. This is because they're faster to load. The problem is when shared library are installed in the Windows directory. These would supersede any user specified ones. This is bad because e.g. Windows now ships icuuc, but an old version. If you try to use -licuuc then it would pick the Windows one instead of your user specified one. This patch slighly tweaks the ordering so user paths get prefered. Test Plan: ./validate Reviewers: RyanGlScott, hvr, bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie, carter GHC Trac Issues: #14456 Differential Revision: https://phabricator.haskell.org/D4274 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 15 19:22:06 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 15 Jan 2018 19:22:06 -0000 Subject: [GHC] #14611: Support LIBRARY_PATH and LD_LIBRARY_PATH in rts In-Reply-To: <044.c9e86efaafe85adfbe60e6506a085329@haskell.org> References: <044.c9e86efaafe85adfbe60e6506a085329@haskell.org> Message-ID: <059.1aa5da14fd8feb8929433c70d01dc315@haskell.org> #14611: Support LIBRARY_PATH and LD_LIBRARY_PATH in rts -------------------------------------+------------------------------------- Reporter: Phyx- | Owner: Phyx- Type: feature request | Status: patch Priority: normal | Milestone: 8.6.1 Component: Runtime System | Version: 8.2.2 (Linker) | Resolution: | Keywords: Operating System: Windows | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: T14611 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4275 Wiki Page: | -------------------------------------+------------------------------------- Comment (by Ben Gamari ): In [changeset:"87917a594f37b70810013168a5df64d630620724/ghc" 87917a59/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="87917a594f37b70810013168a5df64d630620724" Support LIBRARY_PATH and LD_LIBRARY_PATH in rts `LIBRARY_PATH` is used to find libraries and other link artifacts while `LD_LIBRARY_PATH` is used to find shared libraries by the loader. Due to an implementation detail on Windows, using `LIBRARY_PATH` will automatically add the path of any library found to the loader's path. So in that case `LD_LIBRARY_PATH` won't be needed. Test Plan: ./validate along with T14611 which has been made Windows only due to linux using the system linker/loader by default. So I feel a testcase there is unwarranted as the support is indirect via glibc. Reviewers: hvr, bgamari, erikd, simonmar, RyanGlScott Reviewed By: RyanGlScott Subscribers: RyanGlScott, rwbarton, thomie, carter GHC Trac Issues: #14611 Differential Revision: https://phabricator.haskell.org/D4275 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 15 19:22:06 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 15 Jan 2018 19:22:06 -0000 Subject: [GHC] #14653: Text missing in ghc-prim's documentation In-Reply-To: <046.609bd988f60cb8a028f94fdc7c2f2e0a@haskell.org> References: <046.609bd988f60cb8a028f94fdc7c2f2e0a@haskell.org> Message-ID: <061.4222c4dd6b9252f06b5e084533aefccd@haskell.org> #14653: Text missing in ghc-prim's documentation -------------------------------------+------------------------------------- Reporter: gallais | Owner: sighingnow Type: bug | Status: new Priority: normal | Milestone: Component: libraries | Version: 8.2.2 (other) | Keywords: ghc-prim, Resolution: | newcomer Operating System: Unknown/Multiple | Architecture: Type of failure: Documentation | Unknown/Multiple bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4305 Wiki Page: | -------------------------------------+------------------------------------- Comment (by Ben Gamari ): In [changeset:"2feed118413944cae8a4eed17365f40521f470db/ghc" 2feed11/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="2feed118413944cae8a4eed17365f40521f470db" Fix hash in haddock of ghc-prim. Reviewers: bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie, carter GHC Trac Issues: #14653 Differential Revision: https://phabricator.haskell.org/D4305 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 15 19:22:06 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 15 Jan 2018 19:22:06 -0000 Subject: [GHC] #14336: ghci leaks memory In-Reply-To: <051.dbf33557716163bb981beab6790198d1@haskell.org> References: <051.dbf33557716163bb981beab6790198d1@haskell.org> Message-ID: <066.e37f29c9da6ec420a4cb0fe96bfc0096@haskell.org> #14336: ghci leaks memory -------------------------------------+------------------------------------- Reporter: NeilMitchell | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: GHCi | Version: 8.2.1 Resolution: | Keywords: Operating System: Windows | Architecture: x86_64 Type of failure: Runtime | (amd64) performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Ben Gamari ): In [changeset:"41afbb3f20f3d84abacb37afcc5aa64b24c22da8/ghc" 41afbb3/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="41afbb3f20f3d84abacb37afcc5aa64b24c22da8" Add flag -fno-it This flag stops ghci creating the special variable `it` after evaluating an expression. This stops ghci leaking as much memory when evaluating expressions. See #14336 Reviewers: bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie, carter GHC Trac Issues: #14336 Differential Revision: https://phabricator.haskell.org/D4299 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 15 19:22:06 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 15 Jan 2018 19:22:06 -0000 Subject: [GHC] #14646: GHC 8.4.1 regression: rank-n types no longer parenthesized when pretty-printed In-Reply-To: <050.f6d9f92b935b2b76cf140ddb5bc8ac61@haskell.org> References: <050.f6d9f92b935b2b76cf140ddb5bc8ac61@haskell.org> Message-ID: <065.a2da447bab1850cb0122ad19bbbedb81@haskell.org> #14646: GHC 8.4.1 regression: rank-n types no longer parenthesized when pretty- printed -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: RyanGlScott Type: bug | Status: patch Priority: high | Milestone: 8.4.1 Component: GHC API | Version: 8.4.1-alpha1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect result | Unknown/Multiple at runtime | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4298 Wiki Page: | -------------------------------------+------------------------------------- Comment (by Ben Gamari ): In [changeset:"f380115cd834ffbe51aca60f5476a51b94cdd413/ghc" f380115/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="f380115cd834ffbe51aca60f5476a51b94cdd413" Parenthesize forall-type args in cvtTypeKind Trac #14646 happened because we forgot to parenthesize `forall` types to the left of an arrow. This simple patch fixes that. Test Plan: make test TEST=T14646 Reviewers: alanz, goldfire, bgamari Reviewed By: alanz Subscribers: rwbarton, thomie, carter GHC Trac Issues: #14646 Differential Revision: https://phabricator.haskell.org/D4298 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 15 19:22:06 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 15 Jan 2018 19:22:06 -0000 Subject: [GHC] #14652: Allow different executable names on windows In-Reply-To: <047.e6a3bc01cad203df066c1a713b94ac37@haskell.org> References: <047.e6a3bc01cad203df066c1a713b94ac37@haskell.org> Message-ID: <062.b2f63f3fd5984a864eb73914c093560c@haskell.org> #14652: Allow different executable names on windows -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: AndreasK Type: task | Status: patch Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: Resolution: | Keywords: Operating System: Windows | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4296 Wiki Page: | -------------------------------------+------------------------------------- Comment (by Ben Gamari ): In [changeset:"1bf70b2041dc2b7c89565fcb46cad8f151f96790/ghc" 1bf70b20/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="1bf70b2041dc2b7c89565fcb46cad8f151f96790" Remove executable filename check on windows On Windows GHC enforces currently that the real executable is named ghc.exe/ghc-stage[123].exe. I don't see a good reason why this is neccessary. This patch removes this restriction and fixes #14652 Test Plan: ci Reviewers: bgamari, Phyx Reviewed By: Phyx Subscribers: Phyx, rwbarton, thomie, carter GHC Trac Issues: #14652 Differential Revision: https://phabricator.haskell.org/D4296 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 15 19:22:29 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 15 Jan 2018 19:22:29 -0000 Subject: [GHC] #14456: Windows runtime linker failure with icuuc In-Reply-To: <050.3b07902cfc2f558e6740649e9c204478@haskell.org> References: <050.3b07902cfc2f558e6740649e9c204478@haskell.org> Message-ID: <065.6cf37f3a6f7cff2c71d6de6e26b754bf@haskell.org> #14456: Windows runtime linker failure with icuuc -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: Phyx- Type: bug | Status: closed Priority: normal | Milestone: 8.6.1 Component: Runtime System | Version: 8.2.2 (Linker) | Resolution: fixed | Keywords: Operating System: Windows | Architecture: | Unknown/Multiple Type of failure: GHCi crash | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4274 Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: patch => closed * resolution: => fixed -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 15 19:22:54 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 15 Jan 2018 19:22:54 -0000 Subject: [GHC] #14646: GHC 8.4.1 regression: rank-n types no longer parenthesized when pretty-printed In-Reply-To: <050.f6d9f92b935b2b76cf140ddb5bc8ac61@haskell.org> References: <050.f6d9f92b935b2b76cf140ddb5bc8ac61@haskell.org> Message-ID: <065.68a322d42725a03c22c8a33117e29e71@haskell.org> #14646: GHC 8.4.1 regression: rank-n types no longer parenthesized when pretty- printed -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: RyanGlScott Type: bug | Status: merge Priority: high | Milestone: 8.4.1 Component: GHC API | Version: 8.4.1-alpha1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect result | Unknown/Multiple at runtime | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4298 Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: patch => merge -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 15 19:23:58 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 15 Jan 2018 19:23:58 -0000 Subject: [GHC] #14336: ghci leaks memory In-Reply-To: <051.dbf33557716163bb981beab6790198d1@haskell.org> References: <051.dbf33557716163bb981beab6790198d1@haskell.org> Message-ID: <066.934ca5d27ea8583a93f8b224d2538b9b@haskell.org> #14336: ghci leaks memory -------------------------------------+------------------------------------- Reporter: NeilMitchell | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: GHCi | Version: 8.2.1 Resolution: | Keywords: Operating System: Windows | Architecture: x86_64 Type of failure: Runtime | (amd64) performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * milestone: => 8.6.1 Comment: Can someone verify whether there are any leaks remaining after the above patch? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 15 19:24:24 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 15 Jan 2018 19:24:24 -0000 Subject: [GHC] #14653: Text missing in ghc-prim's documentation In-Reply-To: <046.609bd988f60cb8a028f94fdc7c2f2e0a@haskell.org> References: <046.609bd988f60cb8a028f94fdc7c2f2e0a@haskell.org> Message-ID: <061.d3302cb64e0c923249245fbfb0484ac3@haskell.org> #14653: Text missing in ghc-prim's documentation -------------------------------------+------------------------------------- Reporter: gallais | Owner: sighingnow Type: bug | Status: merge Priority: normal | Milestone: 8.4.1 Component: libraries | Version: 8.2.2 (other) | Keywords: ghc-prim, Resolution: | newcomer Operating System: Unknown/Multiple | Architecture: Type of failure: Documentation | Unknown/Multiple bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4305 Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: new => merge * milestone: => 8.4.1 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 15 19:24:58 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 15 Jan 2018 19:24:58 -0000 Subject: [GHC] #14611: Support LIBRARY_PATH and LD_LIBRARY_PATH in rts In-Reply-To: <044.c9e86efaafe85adfbe60e6506a085329@haskell.org> References: <044.c9e86efaafe85adfbe60e6506a085329@haskell.org> Message-ID: <059.f34799fdcd33b1a79f5444b332c8ff21@haskell.org> #14611: Support LIBRARY_PATH and LD_LIBRARY_PATH in rts -------------------------------------+------------------------------------- Reporter: Phyx- | Owner: Phyx- Type: feature request | Status: closed Priority: normal | Milestone: 8.6.1 Component: Runtime System | Version: 8.2.2 (Linker) | Resolution: fixed | Keywords: Operating System: Windows | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: T14611 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4275 Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: patch => closed * resolution: => fixed -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 15 19:25:40 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 15 Jan 2018 19:25:40 -0000 Subject: [GHC] #14569: refutable let bindings produce "irrefutable pattern failed" errors In-Reply-To: <044.8464d6345485258705bd110865737bdc@haskell.org> References: <044.8464d6345485258705bd110865737bdc@haskell.org> Message-ID: <059.86b94234a287002a6f60a6b7f3833e68@haskell.org> #14569: refutable let bindings produce "irrefutable pattern failed" errors -------------------------------------+------------------------------------- Reporter: int-e | Owner: dfeuer Type: bug | Status: closed Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.2.1 Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Poor/confusing | Unknown/Multiple error message | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4261 Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: patch => closed * resolution: => fixed * milestone: => 8.6.1 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 15 19:29:40 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 15 Jan 2018 19:29:40 -0000 Subject: [GHC] #14626: No need to enter a scrutinised value In-Reply-To: <048.67c951c2aecb97b988badb4816dbe757@haskell.org> References: <048.67c951c2aecb97b988badb4816dbe757@haskell.org> Message-ID: <063.e3912ec232fbf7279f5434dfa90a8def@haskell.org> #14626: No need to enter a scrutinised value -------------------------------------+------------------------------------- Reporter: heisenbug | Owner: heisenbug Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: performance Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #13861 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by heisenbug): I have a nice one: {{{ libHSghc-8.5-ghc8.5.20180103.dylib`sSTG_info + 98 [inlined] _c147g + 1 503 -- force evaluation all this stuff to avoid space leaks 504 {-# SCC "seqString" #-} evaluate $ seqString (showSDoc dflags $ vcat $ map ppr imports) 505 0x102a5b6ca <+98>: leal -0x179cf8(%rip), %eax ; ghc_Outputable_SDC_con_info 0x102a5b6d0 <+104>: movq %rax, -0x18(%r12) 0x102a5b6d5 <+109>: leaq 0x95471c(%rip), %rax ; ghc_Outputable_defaultUserStyle1_closure 0x102a5b6dc <+116>: movq %rax, -0x10(%r12) 0x102a5b6e1 <+121>: movq %rbx, -0x8(%r12) 0x102a5b6e6 <+126>: movq 0x8(%rbp), %rax 0x102a5b6ea <+130>: movq %rax, (%r12) 0x102a5b6ee <+134>: movq -0x10(%r12), %rax 0x102a5b6f3 <+139>: testb $0x7, %al 0x102a5b6f5 <+141>: jne 0x102a5b70b ; <+163> [inlined] _c147A libHSghc-8.5-ghc8.5.20180103.dylib`sSTG_info + 143 [inlined] _c147B 503 -- force evaluation all this stuff to avoid space leaks 504 {-# SCC "seqString" #-} evaluate $ seqString (showSDoc dflags $ vcat $ map ppr imports) 505 0x102a5b6f7 <+143>: subq $0x8, %rsp 0x102a5b6fb <+147>: movq -0x10(%r12), %rdi 0x102a5b700 <+152>: xorl %eax, %eax 0x102a5b702 <+154>: callq 0x102eb8604 ; symbol stub for: checkTagged }}} Here the first (banged) field of `SDC` gets initialised to a global closure. Clearly it is non-tagged and not evaluated. It gets caught by my assertion a bit later. I think this is a clear bug. The closure should be entered and evaluated to a WHNF (tagged) constructor before saving it into the `SDC` constructor. I did a `quick` compilation with `make -j5 GhcStage2HcOpts="-O1 -g" stage=2` in this case. I still don't understand how GHC manages to create a standalone closure (nullary thunk, statically allocated, PC-relative) for `defaultUserStyle dflags`. {{{ showSDoc dflags sdoc = renderWithStyle dflags sdoc (defaultUserStyle dflags) }}} It looks ''unary'' to me! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 15 20:36:19 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 15 Jan 2018 20:36:19 -0000 Subject: [GHC] #14667: Compiling a function with a lot of alternatives bottlenecks on insertIntHeap In-Reply-To: <046.bf8bb91dd6a70996717f1ecc929e7901@haskell.org> References: <046.bf8bb91dd6a70996717f1ecc929e7901@haskell.org> Message-ID: <061.63e8c7e7e9c82ceaf58b8a832afba818@haskell.org> #14667: Compiling a function with a lot of alternatives bottlenecks on insertIntHeap -------------------------------------+------------------------------------- Reporter: niteria | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Bartosz Nitka ): In [changeset:"cf2c029ccdb967441c85ffb66073974fbdb20c20/ghc" cf2c029c/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="cf2c029ccdb967441c85ffb66073974fbdb20c20" Fix quadratic behavior of prepareAlts Summary: This code is quadratic and a simple test case I used managed to tickle it. The example (same one as #14667) looks like this: ``` module A10000 where data A = A | A00001 | A00002 ... | A10000 f :: A -> Int f A00001 = 19900001 f A00002 = 19900002 ... f A10000 = 19910000 ``` Applied on top of a fix for #14667, it gives a 30% compile time improvement. Test Plan: ./validate Reviewers: simonpj, bgamari Subscribers: rwbarton, thomie, simonmar, carter Differential Revision: https://phabricator.haskell.org/D4307 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 15 21:03:40 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 15 Jan 2018 21:03:40 -0000 Subject: [GHC] #14619: Output value of program changes upon compiling with -O optimizations In-Reply-To: <044.7bc7afdc77e978715c67bc6238b57042@haskell.org> References: <044.7bc7afdc77e978715c67bc6238b57042@haskell.org> Message-ID: <059.2258cf3bb40a1c06baea484ba86bf04b@haskell.org> #14619: Output value of program changes upon compiling with -O optimizations -------------------------------------+------------------------------------- Reporter: sheaf | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.4.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Windows | Architecture: x86_64 Type of failure: Incorrect result | (amd64) at runtime | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Phyx-): > That would be easier to fix; but wouldn't that affect all platforms equally? Yes, but I'm honestly still a bit puzzled as to what makes this failure Windows only. While on Windows `xmm6` is a callee save register we seem to be handling that correctly. Also the sequence has no branches in between. Only jumps so it shouldn't matter. It's also very fragile. Small alterations to the test program trying to reduce makes the issue go away. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 15 21:07:54 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 15 Jan 2018 21:07:54 -0000 Subject: [GHC] #14619: Output value of program changes upon compiling with -O optimizations In-Reply-To: <044.7bc7afdc77e978715c67bc6238b57042@haskell.org> References: <044.7bc7afdc77e978715c67bc6238b57042@haskell.org> Message-ID: <059.05f967725150d24ae1b120040d1ad19d@haskell.org> #14619: Output value of program changes upon compiling with -O optimizations -------------------------------------+------------------------------------- Reporter: sheaf | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.4.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Windows | Architecture: x86_64 Type of failure: Incorrect result | (amd64) at runtime | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by carter): 1) phyx- none of these register excerpts mention xmm0 .... whys that? the set of caller saved registers is xmm0 -xmm5 ... but here the exceprts only work on xmm1-xmm6! (is there some off by one error in the register abi encoding stuff ?) 2) i think we can probably assume / presume that the code at fault likely lies somewhere in https://github.com/ghc/ghc/blob/ghc-8.2/compiler/nativeGen/X86/CodeGen.hs#L2355-L2474 (perma link https://github.com/ghc/ghc/blob/4d99a665986f66f403ad49f7d91a1fc069870274/compiler/nativeGen/X86/CodeGen.hs#L2355-L2474 ) or something related in register/abi stuff -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 15 21:14:40 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 15 Jan 2018 21:14:40 -0000 Subject: [GHC] #14619: Output value of program changes upon compiling with -O optimizations In-Reply-To: <044.7bc7afdc77e978715c67bc6238b57042@haskell.org> References: <044.7bc7afdc77e978715c67bc6238b57042@haskell.org> Message-ID: <059.598d1ad746c27ea6a6068ccea61f305e@haskell.org> #14619: Output value of program changes upon compiling with -O optimizations -------------------------------------+------------------------------------- Reporter: sheaf | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.4.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Windows | Architecture: x86_64 Type of failure: Incorrect result | (amd64) at runtime | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by carter): i'm also curious if the bug can be reproduced with `-fregs-graph ` -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 15 21:23:28 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 15 Jan 2018 21:23:28 -0000 Subject: [GHC] #14626: No need to enter a scrutinised value In-Reply-To: <048.67c951c2aecb97b988badb4816dbe757@haskell.org> References: <048.67c951c2aecb97b988badb4816dbe757@haskell.org> Message-ID: <063.106845e4122fb0858efabd17afc75811@haskell.org> #14626: No need to enter a scrutinised value -------------------------------------+------------------------------------- Reporter: heisenbug | Owner: heisenbug Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: performance Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #13861 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by heisenbug): Replying to [comment:33 heisenbug]: > It looks ''unary'' to me! Interesting, there is a saturated static constructor defined in `Outputable` {{{ ==================== Cmm produced by codegen ==================== 2018-01-13 13:02:23.081236 UTC [section ""data" . Outputable.defaultUserStyle1_closure" { Outputable.defaultUserStyle1_closure: const Outputable.PprUser_con_info; const Outputable.neverQualify_closure+1; const Outputable.AllTheWay_closure+1; const Outputable.Uncoloured_closure+1; const 3; }] ==================== Cmm produced by codegen ==================== 2018-01-13 13:02:23.081545 UTC [section ""data" . Outputable.defaultUserStyle_closure" { Outputable.defaultUserStyle_closure: const Outputable.defaultUserStyle_info; const 0; }, Outputable.defaultUserStyle_entry() // [R2] { info_tbl: [(chd7, label: Outputable.defaultUserStyle_info rep:HeapRep static { Fun {arity: 1 fun_type: ArgSpec 5} })] stack_info: arg_space: 8 updfr_space: Just 8 } {offset ... }}} ''Side question: which optimisation creates this guy?'' All uses of the `Outputable.defaultUserStyle1_closure` in `Outputable` ''are'' tagged with `1`, e.g.: {{{ R1 = Outputable.defaultUserStyle1_closure+1; }}} But this is not the case in the module `AsmCodeGen`: {{{ P64[Hp - 16] = Outputable.defaultUserStyle1_closure; }}} This explains why there is no tag sometimes, but the tag being present most of the time. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 15 21:26:54 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 15 Jan 2018 21:26:54 -0000 Subject: [GHC] #14619: Output value of program changes upon compiling with -O optimizations In-Reply-To: <044.7bc7afdc77e978715c67bc6238b57042@haskell.org> References: <044.7bc7afdc77e978715c67bc6238b57042@haskell.org> Message-ID: <059.a4dc651a98438db0496538472d9bb741@haskell.org> #14619: Output value of program changes upon compiling with -O optimizations -------------------------------------+------------------------------------- Reporter: sheaf | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.4.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Windows | Architecture: x86_64 Type of failure: Incorrect result | (amd64) at runtime | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Phyx-): {{{ Tamar at Rage ~/ghc2> /r/ghc-8.2.2/bin/ghc.exe -O2 -fforce-recomp -fregs- graph Bug.hs -o Bug-reg.exe; ./Bug-reg.exe [1 of 1] Compiling Main ( Bug.hs, Bug.o ) Linking Bug-reg.exe ... Just ((575.5051025721682,1151.0102051443364,0.0),0.0) }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 15 22:20:42 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 15 Jan 2018 22:20:42 -0000 Subject: [GHC] #14672: Make likelyhood of branches/conditions available throughout the compiler. Message-ID: <047.de2c13e36902d9be8400d9448aa09671@haskell.org> #14672: Make likelyhood of branches/conditions available throughout the compiler. -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.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: -------------------------------------+------------------------------------- For simple code such as `if a > 10 then foo else bar` it can make a big difference if we jump on `a > 10` or `a <= 10`. We already tracked the likelyhood of such conditionals for stack/heap checks in Cmm. I recently updated the native codegen on X86 to take this information into account where available and in one edge case this improved execution time from 1.7s to 1.5s! Having this info available for other cases like bound checking (assume valid) or partial pattern matches (assume no match failure) should be a small win for most programs and hopefully a big one for a few of them. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 15 22:28:50 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 15 Jan 2018 22:28:50 -0000 Subject: [GHC] #14541: Stg lint failure while building ghc-stage2: compiler/stage2/build/Hoopl/Block.o In-Reply-To: <043.cd9c2f13d20866525a2d25a84f929b95@haskell.org> References: <043.cd9c2f13d20866525a2d25a84f929b95@haskell.org> Message-ID: <058.c63f2bd336f4e3138204b27e8de1b4b6@haskell.org> #14541: Stg lint failure while building ghc-stage2: compiler/stage2/build/Hoopl/Block.o -------------------------------------+------------------------------------- Reporter: duog | Owner: duog Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.3 Resolution: | Keywords: stg-lint Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Description changed by duog: Old description: > With the tree at: https://github.com/duog/ghc/tree/trac-14536 > Which fixes ticket:14536 > With build.mk: > {{{ > BuildFlavour = validate > > ifneq "$(BuildFlavour)" "" > include mk/flavours/$(BuildFlavour).mk > endif > > GhcStage2HcOpts += -dcore-lint -dstg-lint -dcmm-lint > }}} > building with: > {{{ > make compiler/stage2/build/Hoopl/Blocks.o > }}} > > I get the following Stg lint error (extracts, full dump attached): > {{{ > : warning: > [in body of lambda with binders ds_s4dH :: a_a3as -> b_a3at, > ds1_s4dI :: MaybeO ex_a3ao a_a3as] > In some algebraic case alternative, number of arguments doesn't > match constructor: > JustO (arity 2) > [a1_s4dK] > }}} > ... > {{{ > $fFunctorMaybeO_$cfmap > :: forall ex a b. (a -> b) -> MaybeO ex a -> MaybeO ex b > [GblId, > Arity=2, > Caf=NoCafRefs, > Str=, > Unf=OtherCon []] = > [] \r [ds_s4dH ds1_s4dI] > case ds1_s4dI of { > JustO a1_s4dK [Occ=Once] -> > let { > sat_s4dL [Occ=Once] :: b_a3at > [LclId] = > [ds_s4dH a1_s4dK] \u [] ds_s4dH a1_s4dK; > } in JustO [sat_s4dL]; > NothingO -> $WNothingO; > }; > }}} New description: With the tree at: https://github.com/duog/ghc/tree/trac-14536 Which fixes ticket:14536 With build.mk: {{{ BuildFlavour = validate ifneq "$(BuildFlavour)" "" include mk/flavours/$(BuildFlavour).mk endif GhcStage2HcOpts += -dcore-lint -dstg-lint -dcmm-lint }}} building with: {{{ make compiler/stage2/build/Hoopl/Block.o }}} I get the following Stg lint error (extracts, full dump attached): {{{ : warning: [in body of lambda with binders ds_s4dH :: a_a3as -> b_a3at, ds1_s4dI :: MaybeO ex_a3ao a_a3as] In some algebraic case alternative, number of arguments doesn't match constructor: JustO (arity 2) [a1_s4dK] }}} ... {{{ $fFunctorMaybeO_$cfmap :: forall ex a b. (a -> b) -> MaybeO ex a -> MaybeO ex b [GblId, Arity=2, Caf=NoCafRefs, Str=, Unf=OtherCon []] = [] \r [ds_s4dH ds1_s4dI] case ds1_s4dI of { JustO a1_s4dK [Occ=Once] -> let { sat_s4dL [Occ=Once] :: b_a3at [LclId] = [ds_s4dH a1_s4dK] \u [] ds_s4dH a1_s4dK; } in JustO [sat_s4dL]; NothingO -> $WNothingO; }; }}} -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 15 23:02:19 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 15 Jan 2018 23:02:19 -0000 Subject: [GHC] #14626: No need to enter a scrutinised value In-Reply-To: <048.67c951c2aecb97b988badb4816dbe757@haskell.org> References: <048.67c951c2aecb97b988badb4816dbe757@haskell.org> Message-ID: <063.0359602d3387e738050ea31f39aba360@haskell.org> #14626: No need to enter a scrutinised value -------------------------------------+------------------------------------- Reporter: heisenbug | Owner: heisenbug Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: performance Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #13861 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): > Here the first (banged) field of SDC gets initialised to a global closure. Clearly it is non-tagged and not evaluated. That is very wrong. Can you show the `-ddump-simpl -ddump-stg` of the module that allocates an SDC closure with a non-tagged, non-evaluated argument? Thanks. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 15 23:07:14 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 15 Jan 2018 23:07:14 -0000 Subject: [GHC] #14663: Deriving Typeable for enumerations seems expensive In-Reply-To: <046.f6a840bdc5006a4360df3a724cb886a0@haskell.org> References: <046.f6a840bdc5006a4360df3a724cb886a0@haskell.org> Message-ID: <061.1b5679a1f5b07b72905dbe2040a59401@haskell.org> #14663: Deriving Typeable for enumerations seems expensive -------------------------------------+------------------------------------- Reporter: niteria | Owner: (none) Type: bug | Status: new Priority: low | Milestone: Component: Compiler | Version: Resolution: | Keywords: Typeable Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * keywords: => Typeable -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 15 23:08:51 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 15 Jan 2018 23:08:51 -0000 Subject: [GHC] #14270: GHC HEAD's ghc-stage1 panics on Data.Typeable.Internal In-Reply-To: <042.d21b92eb840644cd16549869583bccd0@haskell.org> References: <042.d21b92eb840644cd16549869583bccd0@haskell.org> Message-ID: <057.5e6a013af1b1fa53e1bcf43f786b6730@haskell.org> #14270: GHC HEAD's ghc-stage1 panics on Data.Typeable.Internal -------------------------------------+------------------------------------- Reporter: hvr | Owner: bgamari Type: bug | Status: new Priority: high | Milestone: 8.4.1 Component: Compiler | Version: 8.3 Resolution: | Keywords: Typeable Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: #14236 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * keywords: => Typeable -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 15 23:09:19 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 15 Jan 2018 23:09:19 -0000 Subject: [GHC] #13647: Tidy up TcTypeable In-Reply-To: <046.ce5bf479308764e177daf1d80c7aa0cd@haskell.org> References: <046.ce5bf479308764e177daf1d80c7aa0cd@haskell.org> Message-ID: <061.4a0d71b6de5f92179026c59a21286946@haskell.org> #13647: Tidy up TcTypeable -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.0.1 Resolution: | Keywords: Typeable Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * keywords: => Typeable -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 15 23:13:27 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 15 Jan 2018 23:13:27 -0000 Subject: [GHC] #14273: Typed holes' "valid substitutions" suggestions are oblivious to type class constraints In-Reply-To: <050.ec57930d289b450ca4924847bd0d6061@haskell.org> References: <050.ec57930d289b450ca4924847bd0d6061@haskell.org> Message-ID: <065.99885ba9123005c01fede6ab2ccf2485@haskell.org> #14273: Typed holes' "valid substitutions" suggestions are oblivious to type class constraints -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: Tritlo Type: bug | Status: new Priority: normal | Milestone: 8.4.1 Component: Compiler (Type | Version: 8.3 checker) | Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Poor/confusing | Unknown/Multiple error message | Test Case: Blocked By: | Blocking: Related Tickets: #9091, #9479 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Tritlo): RyanGIScott: I've implemented a fix which is currently on Phabricator as [https://phabricator.haskell.org/D4315 D4315], and I've included your example as a test. Could you have a look at the diff and check that the output is the output you'd expect? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 15 23:13:55 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 15 Jan 2018 23:13:55 -0000 Subject: [GHC] #14626: No need to enter a scrutinised value In-Reply-To: <048.67c951c2aecb97b988badb4816dbe757@haskell.org> References: <048.67c951c2aecb97b988badb4816dbe757@haskell.org> Message-ID: <063.746302cbf7cbe7fdb26cadcea15249fc@haskell.org> #14626: No need to enter a scrutinised value -------------------------------------+------------------------------------- Reporter: heisenbug | Owner: heisenbug Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: performance Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #13861 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): > (That would explain why I often get crashes when mixing -O0 and -O1) The strict-field unboxing choice should be made once and for all at the module declaring the data constructor. If client modules made a different choice there'd be chaos. If you think that is happening can you demonstrate? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 15 23:56:23 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 15 Jan 2018 23:56:23 -0000 Subject: [GHC] #14336: ghci leaks memory In-Reply-To: <051.dbf33557716163bb981beab6790198d1@haskell.org> References: <051.dbf33557716163bb981beab6790198d1@haskell.org> Message-ID: <066.ad84a4338a844d5959c11a02a619f507@haskell.org> #14336: ghci leaks memory -------------------------------------+------------------------------------- Reporter: NeilMitchell | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: GHCi | Version: 8.2.1 Resolution: | Keywords: Operating System: Windows | Architecture: x86_64 Type of failure: Runtime | (amd64) performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by mpickering): I think there still are leaks but at a much slower rate. I also suspect module reloading still causes big leaks. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 16 00:45:43 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 16 Jan 2018 00:45:43 -0000 Subject: [GHC] #14273: Typed holes' "valid substitutions" suggestions are oblivious to type class constraints In-Reply-To: <050.ec57930d289b450ca4924847bd0d6061@haskell.org> References: <050.ec57930d289b450ca4924847bd0d6061@haskell.org> Message-ID: <065.7c6386ad8f3ecfabbe7b9b1846ab7794@haskell.org> #14273: Typed holes' "valid substitutions" suggestions are oblivious to type class constraints -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: Tritlo Type: bug | Status: patch Priority: normal | Milestone: 8.4.1 Component: Compiler (Type | Version: 8.3 checker) | Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Poor/confusing | Unknown/Multiple error message | Test Case: Blocked By: | Blocking: Related Tickets: #9091, #9479 | Differential Rev(s): Phab:D4315 Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * status: new => patch * differential: => Phab:D4315 Comment: I've left some comments on Phabricator. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 16 01:27:30 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 16 Jan 2018 01:27:30 -0000 Subject: [GHC] #14673: Unary Unboxed Tuple Type Constructor Message-ID: <049.d9c870f0c2ef1490b284fbb19f566786@haskell.org> #14673: Unary Unboxed Tuple Type Constructor -------------------------------------+------------------------------------- Reporter: andrewthad | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.4.1-alpha1 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: -------------------------------------+------------------------------------- The type constructor for a unary unboxed tuple cannot be written in GHC haskell. Consider the following value which is wrapped in by a unary unboxed tuple: {{{ >>> :type (# 5# #) (# 5# #) :: (# Int# #) }}} Now consider the type constructor for unboxed 2-tuples: {{{ >>> :set -fprint-explicit-kinds >>> :set -fprint-explicit-foralls >>> :kind! (# , #) (# , #) :: forall (k0 :: RuntimeRep) (k1 :: RuntimeRep). TYPE k0 -> TYPE k1 -> TYPE ('TupleRep ((':) RuntimeRep k0 ((':) RuntimeRep k1 ('[] RuntimeRep)))) = (#,#) }}} Horrid looking, but undoubtedly correct. But how can we do this for a unary unboxed tuple? The naive approach gives us the nullary tuple instead: {{{ >>> :kind! (# #) (# #) :: TYPE ('TupleRep ('[] RuntimeRep)) = (# #) }}} I do actually have a real use-case for this that I can discuss more if needed. For the syntax, I really haven't the faintest idea what I would expect. Maybe something like: `(## ##)` or `(# @1 #)`, but those both seem pretty bad. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 16 01:31:07 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 16 Jan 2018 01:31:07 -0000 Subject: [GHC] #10972: Add a :binfo (beginner info) GHCi command In-Reply-To: <045.69c25027f6e9192e0896957840c11b0e@haskell.org> References: <045.69c25027f6e9192e0896957840c11b0e@haskell.org> Message-ID: <060.0af60b865aebad0ec03f92fc1f1105c6@haskell.org> #10972: Add a :binfo (beginner info) GHCi command -------------------------------------+------------------------------------- Reporter: kanetw | Owner: kanetw Type: feature request | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 7.10.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #10963 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by kanetw): It kind of fell by the wayside. I'll put it on my to-do list. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 16 01:38:21 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 16 Jan 2018 01:38:21 -0000 Subject: [GHC] #14673: Unary Unboxed Tuple Type Constructor In-Reply-To: <049.d9c870f0c2ef1490b284fbb19f566786@haskell.org> References: <049.d9c870f0c2ef1490b284fbb19f566786@haskell.org> Message-ID: <064.84e6fe7a9a879da74b493744149093ca@haskell.org> #14673: Unary Unboxed Tuple Type Constructor -------------------------------------+------------------------------------- Reporter: andrewthad | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.4.1-alpha1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by andrewthad): As a verbose workaround, it looks like this should give me something with an equivalent runtime representation: {{{ ((# , #) :: forall (r :: RuntimeRep). TYPE (TupleRep '[]) -> TYPE r -> TYPE (TupleRep '[ TupleRep '[], r])) (# #) }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 16 02:06:26 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 16 Jan 2018 02:06:26 -0000 Subject: [GHC] #14673: Unary Unboxed Tuple Type Constructor In-Reply-To: <049.d9c870f0c2ef1490b284fbb19f566786@haskell.org> References: <049.d9c870f0c2ef1490b284fbb19f566786@haskell.org> Message-ID: <064.1a0aac4b7598481ce1effb867643f21f@haskell.org> #14673: Unary Unboxed Tuple Type Constructor -------------------------------------+------------------------------------- Reporter: andrewthad | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.4.1-alpha1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by duog): There is `Unit#` defined in TysWiredIn, see Note [One-tuples] in that file. I don't think it's exported for use anywhere though, I couldn't get it to work in ghci. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 16 02:17:09 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 16 Jan 2018 02:17:09 -0000 Subject: [GHC] #14674: Deferring more levity polymorphism checks in indefinite backpack modules Message-ID: <049.f63f9dc5c6b5c2a7debe049513b8ff01@haskell.org> #14674: Deferring more levity polymorphism checks in indefinite backpack modules -------------------------------------+------------------------------------- Reporter: andrewthad | Owner: (none) Type: feature | Status: new request | Priority: normal | Milestone: Component: Compiler | Version: 8.4.1-alpha1 Keywords: backpack | Operating System: Unknown/Multiple Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- This is kind of a follow up issue to issue #13955. I'm able to get along a little further with the thing I'm trying to do. Here's a minimal example. The `number-example-a` and `number-example-b` sections are not really needed to trigger the problem. They are included as examples of how the signature might be instantiated. {{{ {-# LANGUAGE MagicHash #-} {-# LANGUAGE TypeInType #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE TypeFamilies #-} unit the-fam where module TheFamily where import Data.Kind import GHC.Types import GHC.Prim data Liftedness = Lifted | Unlifted data SingLiftedness (x :: Liftedness) where SingLifted :: SingLiftedness 'Lifted SingUnlifted :: SingLiftedness 'Unlifted type family LiftednessIntRep (x :: Liftedness) :: RuntimeRep where LiftednessIntRep 'Lifted = LiftedRep LiftednessIntRep 'Unlifted = IntRep type family LiftednessInt (x :: Liftedness) :: TYPE (LiftednessIntRep x) where LiftednessInt 'Lifted = Int LiftednessInt 'Unlifted = Int# unit number-indefinite where dependency the-fam signature NumberUnknown where import GHC.Types import TheFamily data MyLiftedness :: Liftedness module NumberStuff where import NumberUnknown import TheFamily identityInt :: LiftednessInt MyLiftedness -> LiftednessInt MyLiftedness identityInt i = i unit number-example-a where dependency the-fam module NumberUnknown where import GHC.Types import TheFamily type MyLiftedness = Lifted identityInt :: Int -> Int identityInt x = x unit number-example-b where dependency the-fam module NumberUnknown where import GHC.Types import GHC.Prim import TheFamily type MyLiftedness = Unlifted identityInt :: Int# -> Int# identityInt i = i unit main where dependency number-indefinite[NumberUnknown=number- example-a:NumberUnknown] module Main where import NumberStuff import GHC.Types main = print (identityInt 5) }}} Attempting to compile with the ghc 8.4 release candidate gives: {{{ > /usr/local/bin/ghc-8.4.0.20171214 --backpack small_levity_backpack.bkp small_levity_backpack.bkp:35:17: error: A levity-polymorphic type is not allowed here: Type: LiftednessInt MyLiftedness Kind: TYPE (LiftednessIntRep MyLiftedness) In the type of binder ‘i’ | 35 | identityInt i = i | ^ }}} I disagree with this error. The type of `i` is not actually levity polymorphic in either of the example instantiations of the signature. If this check were omitted from the type-checking of the indefinite module, I suspect that this code should be able to compile and run fine. I'm not sure if there's a good general rule for when to suppress these checks in indefinite modules and when to not suppress them. Clearly, there are some cases were a function will with a levity-polymorphic binder no matter how the signature is fulfilled, and those ideally should continue to be rejected. And there are other cases like the one I raise here where it's guaranteed to be safe. There are other cases where the whether or not there's a levity-polymorphic binder depends on the instantiation: {{{ data X = X1 | X2 type family Rep (a :: X) (r :: RuntimeRep) :: RuntimeRep Rep X1 r = r Rep X2 r = UnliftedRep }}} And then finally, there are situations where it's always going to lead to a levity-polymorphic binder, but it isn't feasible for the compiler to figure that out. A sufficiently tricky type family would cause this. Sorry this was a bit of a ramble. I think there actually is a good rule for this. Defer the levity-polymorphic binder check in indefinite modules any time the type-checker encounters a type variable whose RuntimeRep is a type family that cannot be reduced. The check will happen later any way, and more correct code will be accepted. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 16 02:24:37 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 16 Jan 2018 02:24:37 -0000 Subject: [GHC] #14673: Unary Unboxed Tuple Type Constructor In-Reply-To: <049.d9c870f0c2ef1490b284fbb19f566786@haskell.org> References: <049.d9c870f0c2ef1490b284fbb19f566786@haskell.org> Message-ID: <064.248c3f38af10aba99537c8056bf4b187@haskell.org> #14673: Unary Unboxed Tuple Type Constructor -------------------------------------+------------------------------------- Reporter: andrewthad | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.4.1-alpha1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by andrewthad): Ah, `Unit#` is a much more natural name for this. It would be nice if this were exported somewhere. Even if `Unit# a` and `(# a #)` aren't actually the same type, it would still work fine for what I'm trying to do. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 16 04:31:59 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 16 Jan 2018 04:31:59 -0000 Subject: [GHC] #14675: GHC 8.4.1 regression: segfault when loading doctest on a module with ANNs on Ubuntu 16.04 or later Message-ID: <050.c5c190ffbc3e4175e84536f4424d1ad2@haskell.org> #14675: GHC 8.4.1 regression: segfault when loading doctest on a module with ANNs on Ubuntu 16.04 or later -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.4.1 Component: GHC API | Version: 8.4.1-alpha1 Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: Runtime crash Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- As observed [https://github.com/ekmett/lens/issues/781#issuecomment-357841481 here], any attempt to run [https://hackage.haskell.org/package/doctest-0.13.0 doctest] on a module that contains an `ANN` will result in a segfault—but only under certain settings! To explain better what I mean, let's look at a stripped-down version of `doctest`: {{{#!hs -- Bug.hs module Main (main) where import Control.Applicative ((<|>)) import Control.Monad.IO.Class (liftIO) import Data.Char (isSpace) import Data.List (dropWhileEnd) import Digraph (flattenSCCs) import GHC (depanal, getSessionDynFlags, guessTarget, loadModule, noLoc, parseDynamicFlags, parseModule, runGhc, setSessionDynFlags, setTargets, topSortModuleGraph, typecheckModule) import System.Directory (findExecutable) import System.Process (readProcess) getLibDir :: IO FilePath getLibDir = do Just ghcPath <- findExecutable "ghc" <|> findExecutable "ghc-stage2" dropWhileEnd isSpace <$> readProcess ghcPath ["--print-libdir"] "" main :: IO () main = do libdir <- getLibDir putStrLn libdir runGhc (Just libdir) $ do (dynflags, _, _) <- getSessionDynFlags >>= flip parseDynamicFlags (map noLoc ["-package base"]) _ <- setSessionDynFlags dynflags mapM (`guessTarget` Nothing) ["Foo.hs"] >>= setTargets mods <- depanal [] False let sortedMods = flattenSCCs (topSortModuleGraph False mods Nothing) let f theMod = do liftIO $ putStrLn "Before parseModule" m1 <- parseModule theMod liftIO $ putStrLn "Before typecheckModule" m2 <- typecheckModule m1 liftIO $ putStrLn "Before loadModule" m3 <- loadModule m2 liftIO $ putStrLn "After loadModule" return m3 mods' <- mapM f sortedMods mods' `seq` return () }}} As well as a module with an `ANN`: {{{#!hs module Foo where {-# ANN module "I'm an annotation" #-} }}} If you attempt to compile and run `Bug.hs` with GHC 8.2.2, everything is fine and dandy: {{{ $ PATH=/opt/ghc/8.2.2/bin:$PATH ghc -fforce-recomp Bug.hs -package ghc [1 of 1] Compiling Main ( Bug.hs, Bug.o ) Linking Bug ... $ PATH=/opt/ghc/8.2.2/bin:$PATH ./Bug /opt/ghc/8.2.2/lib/ghc-8.2.2 Before parseModule Before typecheckModule Before loadModule After loadModule }}} But if these two criteria are met: * You're using GHC 8.4.1-alpha * You're using Ubuntu 16.04 or later Then this will result in a segfault! {{{ $ PATH=/opt/ghc/8.4.1/bin:$PATH ghc -fforce-recomp Bug.hs -package ghc [1 of 1] Compiling Main ( Bug.hs, Bug.o ) Linking Bug ... $ PATH=/opt/ghc/8.4.1/bin:$PATH ./Bug /opt/ghc/8.4.1/lib/ghc-8.4.0.20171222 Before parseModule Before typecheckModule Segmentation fault (core dumped) $ lsb_release -a No LSB modules are available. Distributor ID: Ubuntu Description: Ubuntu 17.04 Release: 17.04 Codename: zesty }}} The second criteria about Ubuntu version is the most baffling part, but the segfault does not appear to occur when I try it on, for instance, an Ubuntu 14.04 machine: {{{ $ PATH=/opt/ghc/8.4.1/bin:$PATH ghc -fforce-recomp Bug.hs -package ghc [1 of 1] Compiling Main ( Bug.hs, Bug.o ) Linking Bug ... $ PATH=/opt/ghc/8.4.1/bin:$PATH ./Bug /opt/ghc/8.4.1/lib/ghc-8.4.0.20171222 Before parseModule Before typecheckModule Before loadModule After loadModule $ lsb_release -a No LSB modules are available. Distributor ID: Ubuntu Description: Ubuntu 14.04.5 LTS Release: 14.04 Codename: trusty }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 16 08:17:55 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 16 Jan 2018 08:17:55 -0000 Subject: [GHC] #14626: No need to enter a scrutinised value In-Reply-To: <048.67c951c2aecb97b988badb4816dbe757@haskell.org> References: <048.67c951c2aecb97b988badb4816dbe757@haskell.org> Message-ID: <063.a3e9400ffa377c42b7733adb5194c7cc@haskell.org> #14626: No need to enter a scrutinised value -------------------------------------+------------------------------------- Reporter: heisenbug | Owner: heisenbug Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: performance Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #13861 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by alexbiehl): I think I found a reproducer for this: Trac14626_1.hs {{{ module Trac14626_1 where data Style = UserStyle Int | PprDebug data SDC = SDC !Style !Int defaultUserStyle :: Bool -> Style defaultUserStyle True = UserStyle 123 defaultUserStyle False = PprDebug }}} Trac14626_2.hs {{{ module Trac14626_2 where import Trac14626_1 f :: Int -> SDC f x = SDC (defaultUserStyle (x > 1)) x }}} Compiling with `ghc Trac14626_1 Trac14626_2 -ddump-simpl -O` results in a similar scenario than the one described by Heisenbug: {{{ -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} defaultUserStyle2 defaultUserStyle2 = I# 123# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} defaultUserStyle1 defaultUserStyle1 = UserStyle defaultUserStyle2 -- RHS size: {terms: 7, types: 2, coercions: 0, joins: 0/0} defaultUserStyle defaultUserStyle = \ ds_dZ7 -> case ds_dZ7 of { False -> PprDebug; True -> defaultUserStyle1 } }}} Our `UserStyle 123` constant has been lifted to top-level, just like in Heisenbugs example. Now looking at the Core of `f` {{{ f f = \ x_a1dk -> case x_a1dk of { I# x1_a2gV -> case ># x1_a2gV 1# of { __DEFAULT -> SDC PprDebug x1_a2gV; 1# -> SDC defaultUserStyle1 x1_a2gV } } }}} (Note how `f` doesn't scrutinise defaultUserStyle1) Looking at the CMM for `f` we can see {{{ ... if (%MO_S_Le_W64(_s2hT::I64, 1)) goto c2ip; else goto c2is; c2ip: I64[Hp - 16] = SDC_con_info; P64[Hp - 8] = PprDebug_closure+2; I64[Hp] = _s2hT::I64; R1 = Hp - 15; Sp = Sp + 8; call (P64[Sp])(R1) args: 8, res: 0, upd: 8; c2is: I64[Hp - 16] = SDC_con_info; P64[Hp - 8] = defaultUserStyle1_closure; -- defaultUserStyle1 isn't tagged! I64[Hp] = _s2hT::I64; R1 = Hp - 15; Sp = Sp + 8; call (P64[Sp])(R1) args: 8, res: 0, upd: 8; }}} The strange thing: Putting the definitions into one module Core/Stg look the same but the CMM correctly tags the closure. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 16 09:37:13 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 16 Jan 2018 09:37:13 -0000 Subject: [GHC] #14626: No need to enter a scrutinised value In-Reply-To: <048.67c951c2aecb97b988badb4816dbe757@haskell.org> References: <048.67c951c2aecb97b988badb4816dbe757@haskell.org> Message-ID: <063.296e4482f6e541e5b8555adad533bdd8@haskell.org> #14626: No need to enter a scrutinised value -------------------------------------+------------------------------------- Reporter: heisenbug | Owner: heisenbug Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: performance Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #13861 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by alexbiehl): I think I know what is happening: - When generating code for `f` the CodeGenerator wants to know the `LambdaFormInfo` (the closure type) of `defaultUserStyle1`. - Since `defaultUserStyle1` is defined in another module we end up calling `mkLFImported` in `StgCmmClosure` which ultimatively gives an `LFUnknown` which always gets a `DynTag` 0 from `lfDynTag`. I think we lack a bit of information here to give `defaultUserStyle1` the correct `LFCon` lambda form. Maybe top-level binders should know its LambdaForm and include them in their interfaces. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 16 09:56:40 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 16 Jan 2018 09:56:40 -0000 Subject: [GHC] #14626: No need to enter a scrutinised value In-Reply-To: <048.67c951c2aecb97b988badb4816dbe757@haskell.org> References: <048.67c951c2aecb97b988badb4816dbe757@haskell.org> Message-ID: <063.4b54a2b29ae73ce7d6b12b905040f9a2@haskell.org> #14626: No need to enter a scrutinised value -------------------------------------+------------------------------------- Reporter: heisenbug | Owner: heisenbug Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: performance Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #13861 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Alex, you've nailed it. Thank you! I'll think about what to do. I'm astonished it hasn't led to more serious problems already. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 16 09:59:38 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 16 Jan 2018 09:59:38 -0000 Subject: [GHC] #14519: Exponential runtime performance regression in GHC 8.2 + Data.Text.Lazy + Text.RE.TDFA In-Reply-To: <043.92c07e3e0209c31f0a0f195fa98d301c@haskell.org> References: <043.92c07e3e0209c31f0a0f195fa98d301c@haskell.org> Message-ID: <058.641b5ce3d0ae0385e99092e83775152f@haskell.org> #14519: Exponential runtime performance regression in GHC 8.2 + Data.Text.Lazy + Text.RE.TDFA -------------------------------------+------------------------------------- Reporter: ntc2 | Owner: tdammers Type: bug | Status: new Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Runtime | Test Case: performance bug | https://github.com/ntc2/ghc-8.2.1 | -regex-lazy-text- | bug/tree/07b7bb32c6e90e8f2d2eada4b59943f37e632d53 Blocked By: | Blocking: Related Tickets: #13745, #14564 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by tdammers): > So the string "$wnext2{v reC2}" must appear in some .o file. I'd do strings *.o | grep to find it. Using `strings -f **/*.o | grep wnext2`, I get: {{{ regex-tdfa-text-1.0.0.3/dist/dist-sandbox- 3f35acf6/build/Text/Regex/TDFA/Text/Lazy.o: $wnext2{v reyv} (regex-tdfa- text-1.0.0.3-CIfFZ6rjdCoJI5EFpqTwBO:Text.Regex.TDFA.Text.Lazy) (fun) }}} There is no identifier `wnext` or `next` in that module, but it does have this: {{{ {-# SPECIALIZE execMatch :: Regex -> Position -> Char -> L.Text -> [MatchArray] #-} execMatch :: Uncons text => Regex -> Position -> Char -> text -> [MatchArray] execMatch = Engine.execMatch }}} `execMatch` imported from `Text.Regex.TDFA.NewDFA.Engine`, in turn, defines local functions `next` and `next'`; the alias defined here seems to mainly exist in order to add the `SPECIALIZE` pragma for lazy `Text`. `execMatch` is monstrously large and quite complex, so I haven't managed to figure out entirely how it works, however there is a promising starting point for further digging: Whether or not `SPECIALIZE` triggers might depend on debugging and/or profiling build flags, which would explain why the problem disappears in a profiling build. The hypothesis would be that the specialized code does something that the non-specialized code doesn't do, and that something ends up being *less* efficient rather than *more*. The `execMatch` function is polymorphic over, among other things, the `text` type, with a typeclass constraint `Uncons text` (documentation [http://hackage.haskell.org/package/regex-tdfa-1.2.2/docs/Text-Regex-TDFA- NewDFA-Uncons.html here]), so we should expect `uncons` to inline for the specialized version, but not the un-specialized one (because in the specialized case we can statically resolve it to the non-polymorphic `uncons` from `Data.Text.Lazy`), and then, possibly maybe, the inlined uncons leads to a space leak. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 16 10:07:45 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 16 Jan 2018 10:07:45 -0000 Subject: [GHC] #14519: Exponential runtime performance regression in GHC 8.2 + Data.Text.Lazy + Text.RE.TDFA In-Reply-To: <043.92c07e3e0209c31f0a0f195fa98d301c@haskell.org> References: <043.92c07e3e0209c31f0a0f195fa98d301c@haskell.org> Message-ID: <058.f05ef9ddf1039f650269db9856380b75@haskell.org> #14519: Exponential runtime performance regression in GHC 8.2 + Data.Text.Lazy + Text.RE.TDFA -------------------------------------+------------------------------------- Reporter: ntc2 | Owner: tdammers Type: bug | Status: new Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Runtime | Test Case: performance bug | https://github.com/ntc2/ghc-8.2.1 | -regex-lazy-text- | bug/tree/07b7bb32c6e90e8f2d2eada4b59943f37e632d53 Blocked By: | Blocking: Related Tickets: #13745, #14564 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by tdammers): > It it easy to repro? I don't see precise instructions above. It's a bit elaborate; what I did is roughly this: 1. Set up a new cabal sandbox 2. Attempt to install `regex-tdfa-text` and its dependencies, using GHC HEAD, and with `-ticky` enabled. 3. Step 2 will fail due to several dependencies no longer compiling under GHC 8.2. Do whatever it takes to convince cabal otherwise: `--allow-newer` works for most, but for a few libraries, I had to check out the sources and install from the local source checkout. I started this was before the 8.2 release though, so it's possible that all the dependencies install cleanly by now. 4. Then inside the sandbox, compile and run an example that triggers the problematic behavior. I used a trimmed-down version of [https://ghc.haskell.org/trac/ghc/attachment/ticket/14519/Main.hs], feeding it the 30000-line example attached to this ticket. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 16 10:51:42 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 16 Jan 2018 10:51:42 -0000 Subject: [GHC] #14626: No need to enter a scrutinised value In-Reply-To: <048.67c951c2aecb97b988badb4816dbe757@haskell.org> References: <048.67c951c2aecb97b988badb4816dbe757@haskell.org> Message-ID: <063.8677b655cf540c1d1bc9e7357937140e@haskell.org> #14626: No need to enter a scrutinised value -------------------------------------+------------------------------------- Reporter: heisenbug | Owner: heisenbug Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: performance Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #13861 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by heisenbug): Replying to [comment:39 simonpj]: > Alex, you've nailed it. Thank you! I'll think about what to do. I'm astonished it hasn't led to more serious problems already. I'll second that! Great work Alex! Will there be another ticket I can block this one on? Simon, do you think we should insert taggedness-checks into runtime when the compiler (resp. a binary) is built with some debug flag? My current solution is rather weak and won't work for constructors that have constraints (e.g. class dictionaries) in them. It may be a good way to detect similar hiccups in the future. I'll happily invest some effort to make my current checks water-proof, though. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 16 10:57:35 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 16 Jan 2018 10:57:35 -0000 Subject: [GHC] #14626: No need to enter a scrutinised value In-Reply-To: <048.67c951c2aecb97b988badb4816dbe757@haskell.org> References: <048.67c951c2aecb97b988badb4816dbe757@haskell.org> Message-ID: <063.c9d47886715bf0055e8b6b761e51251a@haskell.org> #14626: No need to enter a scrutinised value -------------------------------------+------------------------------------- Reporter: heisenbug | Owner: heisenbug Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: performance Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #13861 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by heisenbug): Replying to [comment:36 simonpj]: > > (That would explain why I often get crashes when mixing -O0 and -O1) > > The strict-field unboxing choice should be made once and for all at the module declaring the data constructor. If client modules made a different choice there'd be chaos. If you think that is happening can you demonstrate? I'll watch out for it. I've crashed my GHC in many very different ways in the last weeks, so it is impossible to remember. My taggedness-check on strict constructor fields will need to deal with this anyway, so we'll possibly get hard data soon. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 16 11:28:02 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 16 Jan 2018 11:28:02 -0000 Subject: [GHC] #14676: GHCI doesn't recover from bad :add Message-ID: <045.ccd6c837250f0c0b76f1bf7950e53b8c@haskell.org> #14676: GHCI doesn't recover from bad :add -------------------------------------+------------------------------------- Reporter: Juzley | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.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: -------------------------------------+------------------------------------- In GHCi, when the user attempts to add a module that can not be found, the error message for that module will be repeated for any subsequent :add calls. {{{ ghci> :add Slightly/Misspelled/File.hs : error: can't find file: Slightly/Misspelled/File.hs ... ghci> :add Correctly/Spelled/File.hs : error: can't find file: Slightly/Misspelled/File.hs }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 16 11:28:24 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 16 Jan 2018 11:28:24 -0000 Subject: [GHC] #14676: GHCI doesn't recover from bad :add In-Reply-To: <045.ccd6c837250f0c0b76f1bf7950e53b8c@haskell.org> References: <045.ccd6c837250f0c0b76f1bf7950e53b8c@haskell.org> Message-ID: <060.34c5143e70361279467c845e734d3ff5@haskell.org> #14676: GHCI doesn't recover from bad :add -------------------------------------+------------------------------------- Reporter: Juzley | Owner: Juzley Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by Juzley): * owner: (none) => Juzley -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 16 11:32:23 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 16 Jan 2018 11:32:23 -0000 Subject: [GHC] #14676: GHCI doesn't recover from bad :add In-Reply-To: <045.ccd6c837250f0c0b76f1bf7950e53b8c@haskell.org> References: <045.ccd6c837250f0c0b76f1bf7950e53b8c@haskell.org> Message-ID: <060.657352ec781ff016f49ff2b1bbbfe302@haskell.org> #14676: GHCI doesn't recover from bad :add -------------------------------------+------------------------------------- Reporter: Juzley | Owner: Juzley Type: bug | Status: new Priority: normal | Milestone: Component: GHCi | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Other | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by Juzley): * failure: None/Unknown => Other * component: Compiler => GHCi -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 16 11:54:58 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 16 Jan 2018 11:54:58 -0000 Subject: [GHC] #13930: Cabal configure regresses in space/time In-Reply-To: <046.5b2c9cbc56e2d7d878c20dcde39f4651@haskell.org> References: <046.5b2c9cbc56e2d7d878c20dcde39f4651@haskell.org> Message-ID: <061.df9bd6f8c032ad3d942d6c710fe3e631@haskell.org> #13930: Cabal configure regresses in space/time -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: new Priority: high | Milestone: 8.4.1 Component: Compiler | Version: 8.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: #13982 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by osa1): I can't reproduce this with ghc 8.5.20180115 and cabal HEAD. configure uses about the same (and very little) amount of memory. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 16 12:40:26 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 16 Jan 2018 12:40:26 -0000 Subject: [GHC] #14519: Exponential runtime performance regression in GHC 8.2 + Data.Text.Lazy + Text.RE.TDFA In-Reply-To: <043.92c07e3e0209c31f0a0f195fa98d301c@haskell.org> References: <043.92c07e3e0209c31f0a0f195fa98d301c@haskell.org> Message-ID: <058.9f737c158c6c00eb946064f52bab7ae0@haskell.org> #14519: Exponential runtime performance regression in GHC 8.2 + Data.Text.Lazy + Text.RE.TDFA -------------------------------------+------------------------------------- Reporter: ntc2 | Owner: tdammers Type: bug | Status: new Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Runtime | Test Case: performance bug | https://github.com/ntc2/ghc-8.2.1 | -regex-lazy-text- | bug/tree/07b7bb32c6e90e8f2d2eada4b59943f37e632d53 Blocked By: | Blocking: Related Tickets: #13745, #14564 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): > There is no identifier wnext or next in that module That's fine -- it will have come from inlining. But I'd be surprised if there was no `wnext` in the `-ddump-simpl` or `-ddump-stg` for that module. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 16 13:15:03 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 16 Jan 2018 13:15:03 -0000 Subject: [GHC] #14338: Simplifier fails with "Simplifier ticks exhausted" In-Reply-To: <049.819ef8e60a65cb9f3e29afb8f69166a7@haskell.org> References: <049.819ef8e60a65cb9f3e29afb8f69166a7@haskell.org> Message-ID: <064.35fa852938ce7087fcad399c17e6e4d6@haskell.org> #14338: Simplifier fails with "Simplifier ticks exhausted" -------------------------------------+------------------------------------- Reporter: dredozubov | Owner: bgamari Type: bug | Status: closed Priority: high | Milestone: 8.4.1 Component: Compiler | Version: 8.2.1 Resolution: fixed | Keywords: Operating System: Linux | Architecture: x86_64 Type of failure: Compile-time | (amd64) crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by k-bx): Just wanted to mention that a direct application of a patch on top of 8.2.2 (with some conflict resolution done) doesn't work for me and I'm not experienced enough to understand what's going on https://gist.github.com/k-bx/9b4a3d95f2de9c86b50dca1c615c63e6 I first cherry-picked the commit, but then tried manual change-by-change cherry-picking, getting same error on three machines (1 macOS, 2 Ubuntu). I guess my another attempt would be to see if building 5124b04f10adfee6390f435a493984f2b45062d0 itself as a replacement for our 8.2.2 will be a good idea. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 16 13:18:26 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 16 Jan 2018 13:18:26 -0000 Subject: [GHC] #14677: Code generator does not correctly tag a pointer Message-ID: <046.7a1d900f9976c54932290e6492402f05@haskell.org> #14677: Code generator does not correctly tag a pointer -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.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: -------------------------------------+------------------------------------- Consider {{{ data T a = MkT ![a] }}} The pointer stored in a `MkT` constructor should always be correctly tagged, never tagged with un-evaluated 00. C.f. [wiki:Commentary/Rts/HaskellExecution/PointerTagging] But this invariant is broken. Example taken from #14626, comment:37-39. Trac14626_1.hs {{{ module Trac14626_1 where data Style = UserStyle Int | PprDebug data SDC = SDC !Style !Int defaultUserStyle :: Bool -> Style defaultUserStyle True = UserStyle 123 defaultUserStyle False = PprDebug }}} Trac14626_2.hs {{{ module Trac14626_2 where import Trac14626_1 f :: Int -> SDC f x = SDC (defaultUserStyle (x > 1)) x }}} Compiling with `ghc Trac14626_1 Trac14626_2 -ddump-simpl -O` results in a similar scenario than the one described by Heisenbug: {{{ -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} defaultUserStyle2 defaultUserStyle2 = I# 123# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} defaultUserStyle1 defaultUserStyle1 = UserStyle defaultUserStyle2 -- RHS size: {terms: 7, types: 2, coercions: 0, joins: 0/0} defaultUserStyle defaultUserStyle = \ ds_dZ7 -> case ds_dZ7 of { False -> PprDebug; True -> defaultUserStyle1 } }}} Our `UserStyle 123` constant has been lifted to top-level, just like in Heisenbugs example. Now looking at the Core of `f` {{{ f f = \ x_a1dk -> case x_a1dk of { I# x1_a2gV -> case ># x1_a2gV 1# of { __DEFAULT -> SDC PprDebug x1_a2gV; 1# -> SDC defaultUserStyle1 x1_a2gV } } }}} (Note how `f` doesn't scrutinise defaultUserStyle1) Looking at the CMM for `f` we can see {{{ ... if (%MO_S_Le_W64(_s2hT::I64, 1)) goto c2ip; else goto c2is; c2ip: I64[Hp - 16] = SDC_con_info; P64[Hp - 8] = PprDebug_closure+2; I64[Hp] = _s2hT::I64; R1 = Hp - 15; Sp = Sp + 8; call (P64[Sp])(R1) args: 8, res: 0, upd: 8; c2is: I64[Hp - 16] = SDC_con_info; P64[Hp - 8] = defaultUserStyle1_closure; -- defaultUserStyle1 isn't tagged! I64[Hp] = _s2hT::I64; R1 = Hp - 15; Sp = Sp + 8; call (P64[Sp])(R1) args: 8, res: 0, upd: 8; }}} When generating code for f the code generator wants to know the `LambdaFormInfo` (the closure type) of `defaultUserStyle1`. Since `defaultUserStyle1` is defined in another module we end up calling `mkLFImported` in `StgCmmClosure` which ultimatively gives an `LFUnknown` which always gets a `DynTag` 0 from `lfDynTag`. I think we lack a bit of information here to give defaultUserStyle1 the correct `LFCon` lambda form. Maybe top-level binders should know its `LambdaForm` and include them in their interfaces. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 16 13:19:40 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 16 Jan 2018 13:19:40 -0000 Subject: [GHC] #14677: Code generator does not correctly tag a pointer In-Reply-To: <046.7a1d900f9976c54932290e6492402f05@haskell.org> References: <046.7a1d900f9976c54932290e6492402f05@haskell.org> Message-ID: <061.41201df6e33a8689e59f1d82230d45a3@haskell.org> #14677: Code generator does not correctly tag a pointer -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * Attachment "lf-imported-patch" added. Untested patch -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 16 13:20:21 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 16 Jan 2018 13:20:21 -0000 Subject: [GHC] #14677: Code generator does not correctly tag a pointer In-Reply-To: <046.7a1d900f9976c54932290e6492402f05@haskell.org> References: <046.7a1d900f9976c54932290e6492402f05@haskell.org> Message-ID: <061.41b173b9fb4cf03f9cae8d49a963db26@haskell.org> #14677: Code generator does not correctly tag a pointer -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Try this (untested) patch. It works for the particular example. In haste... -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 16 13:20:59 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 16 Jan 2018 13:20:59 -0000 Subject: [GHC] #14626: No need to enter a scrutinised value In-Reply-To: <048.67c951c2aecb97b988badb4816dbe757@haskell.org> References: <048.67c951c2aecb97b988badb4816dbe757@haskell.org> Message-ID: <063.2424a463e56c3902c3f74c0c112e6c16@haskell.org> #14626: No need to enter a scrutinised value -------------------------------------+------------------------------------- Reporter: heisenbug | Owner: heisenbug Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: performance Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #13861 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): > Will there be another ticket I can block this one on? I opened #14677. And I offer a patch there. Give it a try! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 16 15:22:34 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 16 Jan 2018 15:22:34 -0000 Subject: [GHC] #14519: Exponential runtime performance regression in GHC 8.2 + Data.Text.Lazy + Text.RE.TDFA In-Reply-To: <043.92c07e3e0209c31f0a0f195fa98d301c@haskell.org> References: <043.92c07e3e0209c31f0a0f195fa98d301c@haskell.org> Message-ID: <058.e4eebdb641ed9aebd00123be5aab5316@haskell.org> #14519: Exponential runtime performance regression in GHC 8.2 + Data.Text.Lazy + Text.RE.TDFA -------------------------------------+------------------------------------- Reporter: ntc2 | Owner: tdammers Type: bug | Status: new Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Runtime | Test Case: performance bug | https://github.com/ntc2/ghc-8.2.1 | -regex-lazy-text- | bug/tree/07b7bb32c6e90e8f2d2eada4b59943f37e632d53 Blocked By: | Blocking: Related Tickets: #13745, #14564 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by tdammers): > That's fine -- it will have come from inlining. But I'd be surprised if there was no wnext in the -ddump-simpl or -ddump-stg for that module. Figured it out, I typo-ed my cabal command - `cabal install regex-tdfa- text` will of course not touch the local checkout of regex-tdfa-text, and so `-ddump-simpl -ddump-to-file` doesn't put dumps where I expect them, and grepping for `wnext` won't produce anything useful. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 16 15:33:34 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 16 Jan 2018 15:33:34 -0000 Subject: [GHC] #13253: Exponential compilation time with RWST & ReaderT stack with `-02` In-Reply-To: <045.b3c468c50b4e8e33ee0981a3ab0c6b4b@haskell.org> References: <045.b3c468c50b4e8e33ee0981a3ab0c6b4b@haskell.org> Message-ID: <060.bd92af1ad614a0fd31214869c39d849c@haskell.org> #13253: Exponential compilation time with RWST & ReaderT stack with `-02` -------------------------------------+------------------------------------- Reporter: phadej | Owner: dfeuer Type: bug | Status: new Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.0.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): This patch {{{ modified compiler/simplCore/SimplUtils.hs @@ -1255,7 +1255,8 @@ postInlineUnconditionally env top_lvl bndr occ_info rhs -- in allocation if you miss this out OneOcc { occ_in_lam = in_lam, occ_int_cxt = int_cxt } -- OneOcc => no code-duplication issue - -> smallEnoughToInline dflags unfolding -- Small enough to dup + -> not (isJoinId bndr) + && smallEnoughToInline dflags unfolding -- Small enough to dup -- ToDo: consider discount on smallEnoughToInline if int_cxt is true -- -- NB: Do NOT inline arbitrarily big things, even if one_br is True }}} makes a big difference. It makes my reproducer work in linear time. Nofib says {{{ Program Size Allocs Runtime Elapsed TotalMem -------------------------------------------------------------------------------- fibheaps -2.6% +1.1% 0.033 0.033 0.0% gamteb -2.3% +4.0% 0.062 0.062 0.0% ida -2.8% +2.0% 0.107 0.107 +33.3% mate -2.3% -19.6% -5.8% -5.8% 0.0% para -2.8% +0.7% -2.1% -2.4% 0.0% -------------------------------------------------------------------------------- Min -4.9% -19.6% -8.6% -8.6% 0.0% Max -1.5% +4.0% +3.5% +3.4% +33.3% Geometric Mean -2.5% -0.1% -0.5% -0.5% +0.5% }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 16 15:40:37 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 16 Jan 2018 15:40:37 -0000 Subject: [GHC] #13253: Exponential compilation time with RWST & ReaderT stack with `-02` In-Reply-To: <045.b3c468c50b4e8e33ee0981a3ab0c6b4b@haskell.org> References: <045.b3c468c50b4e8e33ee0981a3ab0c6b4b@haskell.org> Message-ID: <060.9e4de35639773a3311de685d1d34ead9@haskell.org> #13253: Exponential compilation time with RWST & ReaderT stack with `-02` -------------------------------------+------------------------------------- Reporter: phadej | Owner: dfeuer Type: bug | Status: new Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.0.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Questions * Are those `perf/compiler` improvements happening because (a) GHC is generating less code of (b) GHC's code is running faster? * Is compilation generally faster, or are those two cases exceptional? (The testsuite only reports changes when they break through a threshold.) * Where are the gains in `mate` and the losses in `gameteb`? (Use `-ticky` to see.) I'd like to be sure that the loss in `gameteb` isn't for some silly reason that could readily be fixed. Fundamentally this change looks good, but I don't want to commit it and forget it because I'd like to understand the reasons a bit better. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 16 15:45:56 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 16 Jan 2018 15:45:56 -0000 Subject: [GHC] #14519: Exponential runtime performance regression in GHC 8.2 + Data.Text.Lazy + Text.RE.TDFA In-Reply-To: <043.92c07e3e0209c31f0a0f195fa98d301c@haskell.org> References: <043.92c07e3e0209c31f0a0f195fa98d301c@haskell.org> Message-ID: <058.926f956de7b1542b4c786057a7aece0e@haskell.org> #14519: Exponential runtime performance regression in GHC 8.2 + Data.Text.Lazy + Text.RE.TDFA -------------------------------------+------------------------------------- Reporter: ntc2 | Owner: tdammers Type: bug | Status: new Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Runtime | Test Case: performance bug | https://github.com/ntc2/ghc-8.2.1 | -regex-lazy-text- | bug/tree/07b7bb32c6e90e8f2d2eada4b59943f37e632d53 Blocked By: | Blocking: Related Tickets: #13745, #14564 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by tdammers): - Compile without optimizations - Compile without the SPECIALIZE pragma -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 16 15:46:35 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 16 Jan 2018 15:46:35 -0000 Subject: [GHC] #14519: Exponential runtime performance regression in GHC 8.2 + Data.Text.Lazy + Text.RE.TDFA In-Reply-To: <043.92c07e3e0209c31f0a0f195fa98d301c@haskell.org> References: <043.92c07e3e0209c31f0a0f195fa98d301c@haskell.org> Message-ID: <058.6b68cb3479e77042d74f31111d15b75d@haskell.org> #14519: Exponential runtime performance regression in GHC 8.2 + Data.Text.Lazy + Text.RE.TDFA -------------------------------------+------------------------------------- Reporter: ntc2 | Owner: tdammers Type: bug | Status: new Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Runtime | Test Case: performance bug | https://github.com/ntc2/ghc-8.2.1 | -regex-lazy-text- | bug/tree/07b7bb32c6e90e8f2d2eada4b59943f37e632d53 Blocked By: | Blocking: Related Tickets: #13745, #14564 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Another line of approach.... Does the problem happen without `-O`? If not (and I bet it doesn't), then which modules must be compiled without `-O` to make the problem go away? And if compiling M without -O makes the problem go away, try with `-O` and `-fno-float-in` and other similar things to switch off various optimisations. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 16 15:47:03 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 16 Jan 2018 15:47:03 -0000 Subject: [GHC] #14594: 2 modules / 2500LOC takes nearly 3 minutes to build In-Reply-To: <046.b60bf688db171cb4139d3998a57394f4@haskell.org> References: <046.b60bf688db171cb4139d3998a57394f4@haskell.org> Message-ID: <061.152d1c032cca5a3accc5120d9a5b5a7a@haskell.org> #14594: 2 modules / 2500LOC takes nearly 3 minutes to build -------------------------------------+------------------------------------- Reporter: schyler | Owner: dfeuer Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.0.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by dfeuer): There's always a certain amount of non-linearity in the types of multi- field records. For example, given {{{#!hs data Foo = Foo Int Char Integer gfoldlFoo :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Foo -> c Foo gfoldlFoo c k (Foo x y z) = k Foo `c` x `c` y `c` z }}} we get {{{ Testy.$wgfoldlFoo = \ (@ (c_s4UQ :: * -> *)) (w_s4UR :: forall d b. Data d => c_s4UQ (d -> b) -> d -> c_s4UQ b) (w1_s4US :: forall g. g -> c_s4UQ g) (ww_s4UW :: Int) (ww1_s4UX :: Char) (ww2_s4UY :: Integer) -> w_s4UR @ Integer @ Foo Data.Data.$fDataInteger (w_s4UR @ Char @ (Integer -> Foo) Data.Data.$fDataChar (w_s4UR @ Int @ (Char -> Integer -> Foo) Data.Data.$fDataInt (w1_s4US @ (Int -> Char -> Integer -> Foo) Testy.Foo) ww_s4UW) ww1_s4UX) ww2_s4UY }}} Note that we get types `Foo`, `Integer -> Foo`, `Char -> Integer -> Foo`, and `Int -> Char -> Integer -> Foo`. But does this affect the simplifier? I don't know. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 16 15:48:05 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 16 Jan 2018 15:48:05 -0000 Subject: [GHC] #14594: 2 modules / 2500LOC takes nearly 3 minutes to build In-Reply-To: <046.b60bf688db171cb4139d3998a57394f4@haskell.org> References: <046.b60bf688db171cb4139d3998a57394f4@haskell.org> Message-ID: <061.1b93f95b33c4d7ef27ae0005aec688e5@haskell.org> #14594: 2 modules / 2500LOC takes nearly 3 minutes to build -------------------------------------+------------------------------------- Reporter: schyler | Owner: dfeuer Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.0.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by dfeuer): There's always a certain amount of non-linearity in the types of multi- field records. For example, given {{{#!hs data Foo = Foo Int Char Integer gfoldlFoo :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Foo -> c Foo gfoldlFoo c k (Foo x y z) = k Foo `c` x `c` y `c` z }}} we get {{{ Testy.$wgfoldlFoo = \ (@ (c_s4UQ :: * -> *)) (w_s4UR :: forall d b. Data d => c_s4UQ (d -> b) -> d -> c_s4UQ b) (w1_s4US :: forall g. g -> c_s4UQ g) (ww_s4UW :: Int) (ww1_s4UX :: Char) (ww2_s4UY :: Integer) -> w_s4UR @ Integer @ Foo Data.Data.$fDataInteger (w_s4UR @ Char @ (Integer -> Foo) Data.Data.$fDataChar (w_s4UR @ Int @ (Char -> Integer -> Foo) Data.Data.$fDataInt (w1_s4US @ (Int -> Char -> Integer -> Foo) Testy.Foo) ww_s4UW) ww1_s4UX) ww2_s4UY }}} Note that we get types `Foo`, `Integer -> Foo`, `Char -> Integer -> Foo`, and `Int -> Char -> Integer -> Foo`. But does this affect the simplifier? I don't know. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 16 15:55:37 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 16 Jan 2018 15:55:37 -0000 Subject: [GHC] #14594: 2 modules / 2500LOC takes nearly 3 minutes to build In-Reply-To: <046.b60bf688db171cb4139d3998a57394f4@haskell.org> References: <046.b60bf688db171cb4139d3998a57394f4@haskell.org> Message-ID: <061.f489af15f2b70e679415f60894225a2c@haskell.org> #14594: 2 modules / 2500LOC takes nearly 3 minutes to build -------------------------------------+------------------------------------- Reporter: schyler | Owner: dfeuer Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.0.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Yes, we can definitely get big type-blowup. See ​http://research.microsoft.com/en- us/um/people/simonpj/papers/variant-f/if.pdf, page 5. cf #5227. But that would show up clearly through the sizes reported by `-dshow- passes`. comment:3 shows some large numbers. What numbers do you see now? Do we have a standalone reproducer? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 16 16:27:56 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 16 Jan 2018 16:27:56 -0000 Subject: [GHC] #13253: Exponential compilation time with RWST & ReaderT stack with `-02` In-Reply-To: <045.b3c468c50b4e8e33ee0981a3ab0c6b4b@haskell.org> References: <045.b3c468c50b4e8e33ee0981a3ab0c6b4b@haskell.org> Message-ID: <060.8eaffb90006d00b4583e216523fe61ac@haskell.org> #13253: Exponential compilation time with RWST & ReaderT stack with `-02` -------------------------------------+------------------------------------- Reporter: phadej | Owner: bgamari, osa1 Type: bug | Status: new Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.0.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * owner: dfeuer => bgamari, osa1 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 16 16:44:06 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 16 Jan 2018 16:44:06 -0000 Subject: [GHC] #14519: Exponential runtime performance regression in GHC 8.2 + Data.Text.Lazy + Text.RE.TDFA In-Reply-To: <043.92c07e3e0209c31f0a0f195fa98d301c@haskell.org> References: <043.92c07e3e0209c31f0a0f195fa98d301c@haskell.org> Message-ID: <058.abc31d2ef207fb8db97cf5bd5b73c85b@haskell.org> #14519: Exponential runtime performance regression in GHC 8.2 + Data.Text.Lazy + Text.RE.TDFA -------------------------------------+------------------------------------- Reporter: ntc2 | Owner: tdammers Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Runtime | Test Case: performance bug | https://github.com/ntc2/ghc-8.2.1 | -regex-lazy-text- | bug/tree/07b7bb32c6e90e8f2d2eada4b59943f37e632d53 Blocked By: | Blocking: Related Tickets: #13745, #14564 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * milestone: 8.4.1 => 8.6.1 Comment: This likely won't be happening for 8.4. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 16 16:46:16 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 16 Jan 2018 16:46:16 -0000 Subject: [GHC] #13683: Use epoll rather than poll where appropriate In-Reply-To: <045.c2ab45ba7445ee160d1efae06a34ff10@haskell.org> References: <045.c2ab45ba7445ee160d1efae06a34ff10@haskell.org> Message-ID: <060.5417da4ee2d95bf168d568ee02ce812d@haskell.org> #13683: Use epoll rather than poll where appropriate -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: (none) Type: feature request | Status: closed Priority: normal | Milestone: 8.4.1 Component: Core Libraries | Version: 8.0.1 Resolution: fixed | Keywords: Operating System: Linux | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: new => closed * resolution: => fixed Comment: I'm going to close this as I think we should try to keep the non-threaded runtime simple and platform independent where possible. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 16 17:19:22 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 16 Jan 2018 17:19:22 -0000 Subject: [GHC] #14673: Unary Unboxed Tuple Type Constructor In-Reply-To: <049.d9c870f0c2ef1490b284fbb19f566786@haskell.org> References: <049.d9c870f0c2ef1490b284fbb19f566786@haskell.org> Message-ID: <064.b4fd821aa1f1d8b4d32ebe3d1f8b3536@haskell.org> #14673: Unary Unboxed Tuple Type Constructor -------------------------------------+------------------------------------- Reporter: andrewthad | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.4.1-alpha1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Yes, we have * Boxed tuple constructors: `()`, `Unit`, `(,)`, `(,,)`, etc * Unboxed tuple constructors: `(##)`, `Unit#`, `(#,#)`, `(#,,#)`, etc All but `Unit` and `Unit#` are built-in syntax, and hence don't need to be imported. I agree that it'd be useful to be able to import `Unit` and `Unit#`. I'm sure it would not be hard. I ''think'' that all you need to do is * add `AvailTC (getName unitTyCon) [getName unitTyCon, getName unitDataCon]` and simlarly for `unboxedUnitTyCon`, to `PrelInfo.ghcPrimExports` Would someone like to try that? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 16 17:20:31 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 16 Jan 2018 17:20:31 -0000 Subject: [GHC] #14677: Code generator does not correctly tag a pointer In-Reply-To: <046.7a1d900f9976c54932290e6492402f05@haskell.org> References: <046.7a1d900f9976c54932290e6492402f05@haskell.org> Message-ID: <061.18ba85016d53527376bcd857a7db3f9b@haskell.org> #14677: Code generator does not correctly tag a pointer -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by heisenbug): Thanks, I am building now... -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 16 17:22:42 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 16 Jan 2018 17:22:42 -0000 Subject: [GHC] #14635: Double stacktrace with errorWithCallStack In-Reply-To: <046.342ecdededd713faab2e8b8b0c796ed8@haskell.org> References: <046.342ecdededd713faab2e8b8b0c796ed8@haskell.org> Message-ID: <061.ebc167742e54a40eca6feddecda6f201@haskell.org> #14635: Double stacktrace with errorWithCallStack -------------------------------------+------------------------------------- Reporter: flip101 | Owner: alpmestan Type: bug | Status: patch Priority: normal | Milestone: Component: Documentation | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): D4317 Wiki Page: | -------------------------------------+------------------------------------- Changes (by alpmestan): * status: new => patch * differential: => D4317 Comment: I submitted a documentation patch for both sources on phabricator, see [https://phabricator.haskell.org/D4317 D4317]. If anyone's got any feedback, please leave a comment on that differential :) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 16 17:23:43 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 16 Jan 2018 17:23:43 -0000 Subject: [GHC] #14626: No need to enter a scrutinised value In-Reply-To: <048.67c951c2aecb97b988badb4816dbe757@haskell.org> References: <048.67c951c2aecb97b988badb4816dbe757@haskell.org> Message-ID: <063.dd8a372b3c03b3a32132cfd9d222d52e@haskell.org> #14626: No need to enter a scrutinised value -------------------------------------+------------------------------------- Reporter: heisenbug | Owner: heisenbug Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: performance Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: 14677 | Blocking: Related Tickets: #13861 #14677 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by heisenbug): * related: #13861 => #13861 #14677 * blockedby: => 14677 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 16 18:36:39 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 16 Jan 2018 18:36:39 -0000 Subject: [GHC] #14273: Typed holes' "valid substitutions" suggestions are oblivious to type class constraints In-Reply-To: <050.ec57930d289b450ca4924847bd0d6061@haskell.org> References: <050.ec57930d289b450ca4924847bd0d6061@haskell.org> Message-ID: <065.71e9cb623ab58666e6e3717a255e34c3@haskell.org> #14273: Typed holes' "valid substitutions" suggestions are oblivious to type class constraints -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: Tritlo Type: bug | Status: patch Priority: normal | Milestone: 8.4.1 Component: Compiler (Type | Version: 8.3 checker) | Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Poor/confusing | Unknown/Multiple error message | Test Case: Blocked By: | Blocking: Related Tickets: #9091, #9479 | Differential Rev(s): Phab:D4315 Wiki Page: | -------------------------------------+------------------------------------- Comment (by Tritlo): So I've responded to the comments and made some additional improvements and I think everything is in order for it to be patched now. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 16 18:44:06 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 16 Jan 2018 18:44:06 -0000 Subject: [GHC] #14670: -XRebindableSyntax needs return? In-Reply-To: <048.c96b42d6aefe76220126edbb094e21e4@haskell.org> References: <048.c96b42d6aefe76220126edbb094e21e4@haskell.org> Message-ID: <063.c2bcd82222c81ebbb568b093dd50a9af@haskell.org> #14670: -XRebindableSyntax needs return? -------------------------------------+------------------------------------- Reporter: jackkelly | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: | RebindableSyntax Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: GHC rejects | Test Case: valid program | rebindable/T14670 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by dfeuer): I see that in `compiler/rename/RnExpr.hs` there's a "TODO: I don't know how to get this right for rebindable syntax", but I don't think any of that is supposed to be used without `ApplicativeDo`. I haven't yet been able to find a place where `ApplicativeDo` checking obviously leaks out elsewhere. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 16 19:20:25 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 16 Jan 2018 19:20:25 -0000 Subject: [GHC] #14673: Unary Unboxed Tuple Type Constructor In-Reply-To: <049.d9c870f0c2ef1490b284fbb19f566786@haskell.org> References: <049.d9c870f0c2ef1490b284fbb19f566786@haskell.org> Message-ID: <064.10b8b030b439840ab275837c5190ed2e@haskell.org> #14673: Unary Unboxed Tuple Type Constructor -------------------------------------+------------------------------------- Reporter: andrewthad | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.4.1-alpha1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by goldfire): Perhaps I'm being dense here, but I normally use the word "unit" for the 0-tuple. Does GHC really define `Unit` and `Unit#` to be 1-tuples? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 16 21:24:46 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 16 Jan 2018 21:24:46 -0000 Subject: [GHC] #14677: Code generator does not correctly tag a pointer In-Reply-To: <046.7a1d900f9976c54932290e6492402f05@haskell.org> References: <046.7a1d900f9976c54932290e6492402f05@haskell.org> Message-ID: <061.8f3e5717e01ee39f09b2b944ca615591@haskell.org> #14677: Code generator does not correctly tag a pointer -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: 14626 Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by heisenbug): Replying to [comment:1 simonpj]: > Try this (untested) patch. It works for the particular example. > > In haste... Looks like this is a definitive improvement. At least I get a non- crasching stage2 compiler. Can you bring this to `master`? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 16 21:48:27 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 16 Jan 2018 21:48:27 -0000 Subject: [GHC] #14626: No need to enter a scrutinised value In-Reply-To: <048.67c951c2aecb97b988badb4816dbe757@haskell.org> References: <048.67c951c2aecb97b988badb4816dbe757@haskell.org> Message-ID: <063.8b2626ceb31b55ea0aa0323ead1a1ae2@haskell.org> #14626: No need to enter a scrutinised value -------------------------------------+------------------------------------- Reporter: heisenbug | Owner: heisenbug Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: performance Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: 14677 | Blocking: Related Tickets: #13861 #14677 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by heisenbug): With the fix in #14677 I mostly get {{{ HC [stage 2] utils/ghctags/dist-install/build/Main.dyn_o HC [stage 2] utils/check-api-annotations/dist-install/build/Main.dyn_o HC [stage 2] utils/check-ppr/dist-install/build/Main.dyn_o epollControl: does not exist (No such file or directory) epollControl: does not exist (No such file or directory) epollControl: does not exist (No such file or directory) }}} But at least no assertion failure related to tagging any more. (x86-64 darwin still has a snag). -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 16 21:49:51 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 16 Jan 2018 21:49:51 -0000 Subject: [GHC] #14677: Code generator does not correctly tag a pointer In-Reply-To: <046.7a1d900f9976c54932290e6492402f05@haskell.org> References: <046.7a1d900f9976c54932290e6492402f05@haskell.org> Message-ID: <061.26d3b59c45ed0f5b0c868c912e270529@haskell.org> #14677: Code generator does not correctly tag a pointer -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: 14626 Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by heisenbug): * cc: heisenbug (added) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 16 22:36:21 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 16 Jan 2018 22:36:21 -0000 Subject: [GHC] #14648: ghc-pkg does handle unitids In-Reply-To: <048.007dd06250e569e25f20a7f4c15429a2@haskell.org> References: <048.007dd06250e569e25f20a7f4c15429a2@haskell.org> Message-ID: <063.bedfc3c81a0bb782c00b24cb911f06b8@haskell.org> #14648: ghc-pkg does handle unitids -------------------------------------+------------------------------------- Reporter: lspitzner | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: ghc-pkg | Version: 8.2.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by lspitzner): Can't we just check if `show`/`disp` on the parsed value yields the input string, and print a warning if there is a difference? Is there any risk for false positives (cases where `input /= disp (read input)` for package- version strings without a tag)? Capitalization comes to mind, but i don't think it is a problem here, right? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 17 01:33:47 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 17 Jan 2018 01:33:47 -0000 Subject: [GHC] #14678: GHc 8.4.1-alpha's bundled transformers doesn't correspond to a tagged release Message-ID: <050.e45e5fc2b285549e2fcbcab2ac249ab8@haskell.org> #14678: GHc 8.4.1-alpha's bundled transformers doesn't correspond to a tagged release -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: high | Milestone: 8.4.1 Component: Compiler | Version: 8.4.1-alpha1 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: -------------------------------------+------------------------------------- GHC 8.4.1-alpha claims to be bundled with `transformers-0.5.4.0`, but this isn't true. That's because it's using `transformers` commit http://git.haskell.org/packages/transformers.git/commit/36311d39bc545261dab85d4a27af562db1868ed6, which happened somewhere in between the `0.5.4.0` and `0.5.5.0` releases. This is actually a problem for me in practice because that commit gives a `Semigroup` instance for `Constant` which should have only been introduced in `0.5.5.0`, according to the [https://hackage.haskell.org/package/transformers-0.5.5.0/changelog changelog]. But commit 36311d39bc545261dab85d4a27af562db1868ed6 uses version `0.5.4.0`, which makes it impossible to guard against the existence of this instance using CPP (see [https://travis-ci.org/ekmett /transformers-compat/jobs/329285046#L739 this Travis build failure] for an example of this problem occurring). -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 17 01:34:20 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 17 Jan 2018 01:34:20 -0000 Subject: [GHC] #14678: GHC 8.4.1-alpha's bundled transformers doesn't correspond to a tagged release (was: GHc 8.4.1-alpha's bundled transformers doesn't correspond to a tagged release) In-Reply-To: <050.e45e5fc2b285549e2fcbcab2ac249ab8@haskell.org> References: <050.e45e5fc2b285549e2fcbcab2ac249ab8@haskell.org> Message-ID: <065.52f126967baedc0a972f138f3a99d368@haskell.org> #14678: GHC 8.4.1-alpha's bundled transformers doesn't correspond to a tagged release -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: high | Milestone: 8.4.1 Component: Compiler | Version: 8.4.1-alpha1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 17 01:56:40 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 17 Jan 2018 01:56:40 -0000 Subject: [GHC] #14675: GHC 8.4.1 regression: segfault when loading doctest on a module with ANNs on Ubuntu 16.04 or later In-Reply-To: <050.c5c190ffbc3e4175e84536f4424d1ad2@haskell.org> References: <050.c5c190ffbc3e4175e84536f4424d1ad2@haskell.org> Message-ID: <065.321aba03ffcab29946099989a0b09e31@haskell.org> #14675: GHC 8.4.1 regression: segfault when loading doctest on a module with ANNs on Ubuntu 16.04 or later -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.4.1 Component: GHC API | Version: 8.4.1-alpha1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Runtime crash | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * cc: bgamari (added) Comment: This regression was introduced in commit 625143f473b58d770d2515b91c2566b52d35a4c3 (`configure: Coerce gcc to use $LD instead of system default`). -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 17 06:16:21 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 17 Jan 2018 06:16:21 -0000 Subject: [GHC] #14648: ghc-pkg does handle unitids In-Reply-To: <048.007dd06250e569e25f20a7f4c15429a2@haskell.org> References: <048.007dd06250e569e25f20a7f4c15429a2@haskell.org> Message-ID: <063.2c78cd864dafe58ff191a902cf1653af@haskell.org> #14648: ghc-pkg does handle unitids -------------------------------------+------------------------------------- Reporter: lspitzner | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: ghc-pkg | Version: 8.2.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by ezyang): I think that's a legitimate alternative way to achieve the same result. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 17 06:53:41 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 17 Jan 2018 06:53:41 -0000 Subject: [GHC] #5889: -fno-prof-count-entries leads to linking errors In-Reply-To: <043.c51b50cea9fd3755f487a8490fe8400e@haskell.org> References: <043.c51b50cea9fd3755f487a8490fe8400e@haskell.org> Message-ID: <058.0ec3d2b791b1062af1996f81a16b902e@haskell.org> #5889: -fno-prof-count-entries leads to linking errors -------------------------------------+------------------------------------- Reporter: akio | Owner: bgamari Type: bug | Status: new Priority: highest | Milestone: 8.4.1 Component: Compiler | Version: 8.3 Resolution: | Keywords: Operating System: Linux | Architecture: x86_64 | (amd64) Type of failure: GHC rejects | Test Case: valid program | profiling/should_compile/T5889 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by osa1): Simon, we were wrong about CorePrep not dropping unfoldings for exported ids, it really drops all unfoldings. There's a note {{{ {- Note [Drop unfoldings and rules] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We want to drop the unfolding/rules on every Id: - We are now past interface-file generation, and in the codegen pipeline, so we really don't need full unfoldings/rules - The unfolding/rule may be keeping stuff alive that we'd like to discard. See Note [Dead code in CorePrep] - Getting rid of unnecessary unfoldings reduces heap usage - We are changing uniques, so if we didn't discard unfoldings/rules we'd have to substitute in them HOWEVER, we want to preserve evaluated-ness; see Note [Preserve evaluated-ness in CorePrep] Note [Preserve evaluated-ness in CorePrep] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We want to preserve the evaluated-ness of each binder (via evaldUnfolding) for two reasons * In the code generator if we have case x of y { Red -> e1; DEFAULT -> y } we can return 'y' rather than entering it, if we know it is evaluated (Trac #14626) * In the DataToTag magic (in CorePrep itself) we rely on evaluated-ness. See Note Note [dataToTag magic]. -} }}} I can also clearly see that in the code we don't distinguish exported from non-exported, we just zap all unfoldings (see `cpCloneBndrs` and `zapUnfolding`). So it seems to me like we may have to collect cost centers before or during CorePrep. I vaguely remember discussing this in the meeting and one of the arguments against this was that `CorePrep` is already complex enough so if possible it'd be nice to avoid making it even more complex. Are there any other reasons for not doing this in CorePrep? Can we maybe implement a pass before CorePrep just for cost center collection? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 17 07:34:27 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 17 Jan 2018 07:34:27 -0000 Subject: [GHC] #14679: The interpreter showed panic! (the 'impossible' happened) Message-ID: <045.71444bf9e9929347ac7d3ad2119185f1@haskell.org> #14679: The interpreter showed panic! (the 'impossible' happened) -------------------------------------+------------------------------------- Reporter: crick_ | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.0.1 Keywords: panic | Operating System: Windows Architecture: x86_64 | Type of failure: Compile-time (amd64) | crash or panic Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- My code - {{{#!hs {- Example run: Enter initial state: 12356 784 Enter final state: 123586 74 1 2 3 5 8 6 7 4 1 2 3 5 8 6 7 4 1 2 3 5 6 7 8 4 1 2 3 5 6 7 8 4 Minimum path length: 3 -} import Data.List import Data.List.Split import Data.Map as Map hiding (map, filter) swap :: Int -> Int -> State -> State swap i j (State xs depth) = let (i', j') = if i > j then (j ,i) else (i, j) left = take i' xs middle = drop (i'+1) $ take j' xs i_elem = xs !! i' right = drop (j'+1) xs j_elem = xs !! j' xs' = left ++ [j_elem] ++ middle ++ [i_elem] ++ right in (State xs' depth) printGrid :: State -> IO() printGrid (State xs depth) = let [x,y,z] = chunksOf 6 $ intersperse ' ' xs in do putStrLn x putStrLn y putStrLn z putStrLn "" data State = State { state :: [Char], depth :: Int } deriving (Eq, Show, Ord) getMoves :: State -> [Char] getMoves (State xs depth) = case ' ' `elemIndex` xs of Nothing -> error "Empty block not found" Just n -> let l = n `elem` [1,4,7,2,5,8] r = n `elem` [0,3,6,1,4,7] d = n `elem` [0..5] u = n `elem` [3..8] pairs = zip [l,r,d,u] ['L','R','D','U'] filtered = filter (\x -> fst x) pairs in map snd filtered next :: State -> [Char] -> [State] next (State state depth) cs = case ' ' `elemIndex` state of Nothing -> error "Empty block not found" Just n -> do c <- cs return $ case c of 'L' -> swap n (n-1) (State state (depth + 1)) 'R' -> swap n (n+1) (State state (depth + 1)) 'U' -> swap n (n-3) (State state (depth + 1)) 'D' -> swap n (n+3) (State state (depth + 1)) test :: State -> State -> Bool test state1 state2 = (state state1) == (state state2) -- loop :: finalState -> open -> closed -> accmulated parentMap -> parentMap loop :: State -> [State] -> [State] -> Map State State -> Maybe (State, Map State State) loop final [] _ _ = Nothing loop final open@(x:xs) closed parentMap = if test final x then Just (x, parentMap) else let moves = getMoves x nextStates = next x moves filter_fn = \x -> not (x `elem` open || x `elem` closed) filtered = filter filter_fn nextStates newMap = insertIntoMap filtered x parentMap in loop final (xs ++ filtered) (x:closed) newMap insertIntoMap :: [State] -> State -> Map State State -> Map State State insertIntoMap [] _ parentMap = parentMap insertIntoMap (x:xs) parent parentMap = insertIntoMap xs parent (Map.insert x parent parentMap) printAns :: State -> Map State State -> Int -> IO () printAns state parentMap count = case Map.lookup state parentMap of Just parent -> do printGrid parent printAns parent parentMap (count + 1) Nothing -> do putStrLn $ "Minimum path length: " ++ show count return () ans :: Maybe (State, Map State State) -> IO () ans (Just (final, parentMap)) = do printGrid final printAns final parentMap 0 ans _ = putStrLn "No answer found." main :: IO () main = do putStrLn "Enter initial state: " start <- getLine putStrLn "Enter final state: " final <- getLine ans $ loop (State final 0) [(State start 0)] [] Map.empty }}} Test Cases I entered in the order: *Main> main Enter initial state: 123456 784 Enter final state: 1234567 8mianrrupted. *Main> *Main> main Enter initial state: 12356 784 Enter final state: 123586 74 1 2 3 5 8 6 7 4 1 2 3 5 8 6 7 4 1 2 3 5 6 7 8 4 1 2 3 5 6 7 8 4 Minimum path length: 3 *Main> : panic! (the 'impossible' happened) (GHC version 8.0.1 for x86_64-unknown-mingw32): thread blocked indefinitely in an MVar operation Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 17 07:42:52 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 17 Jan 2018 07:42:52 -0000 Subject: [GHC] #14677: Code generator does not correctly tag a pointer In-Reply-To: <046.7a1d900f9976c54932290e6492402f05@haskell.org> References: <046.7a1d900f9976c54932290e6492402f05@haskell.org> Message-ID: <061.8bd3ead2da2704f0b9e65ff2134a0b6a@haskell.org> #14677: Code generator does not correctly tag a pointer -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: 14626 Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by alexbiehl): Gabor, I am on OSX. Can you tell me where your code lives and what your build settings are? I will try to reproduce. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 17 08:44:40 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 17 Jan 2018 08:44:40 -0000 Subject: [GHC] #14519: Exponential runtime performance regression in GHC 8.2 + Data.Text.Lazy + Text.RE.TDFA In-Reply-To: <043.92c07e3e0209c31f0a0f195fa98d301c@haskell.org> References: <043.92c07e3e0209c31f0a0f195fa98d301c@haskell.org> Message-ID: <058.8ad53ac222b1768215c8a45c0c40cd2b@haskell.org> #14519: Exponential runtime performance regression in GHC 8.2 + Data.Text.Lazy + Text.RE.TDFA -------------------------------------+------------------------------------- Reporter: ntc2 | Owner: tdammers Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Runtime | Test Case: performance bug | https://github.com/ntc2/ghc-8.2.1 | -regex-lazy-text- | bug/tree/07b7bb32c6e90e8f2d2eada4b59943f37e632d53 Blocked By: | Blocking: Related Tickets: #13745, #14564 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by tdammers): Can confirm that the problem "goes away" when compiling with `-O0` (100 ms execution time vs. 50,000 for 30,000 lines of input). -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 17 08:59:55 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 17 Jan 2018 08:59:55 -0000 Subject: [GHC] #14519: Exponential runtime performance regression in GHC 8.2 + Data.Text.Lazy + Text.RE.TDFA In-Reply-To: <043.92c07e3e0209c31f0a0f195fa98d301c@haskell.org> References: <043.92c07e3e0209c31f0a0f195fa98d301c@haskell.org> Message-ID: <058.ce6be35a4fe5d6ebe69e2495e99db127@haskell.org> #14519: Exponential runtime performance regression in GHC 8.2 + Data.Text.Lazy + Text.RE.TDFA -------------------------------------+------------------------------------- Reporter: ntc2 | Owner: tdammers Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Runtime | Test Case: performance bug | https://github.com/ntc2/ghc-8.2.1 | -regex-lazy-text- | bug/tree/07b7bb32c6e90e8f2d2eada4b59943f37e632d53 Blocked By: | Blocking: Related Tickets: #13745, #14564 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by tdammers): > If not (and I bet it doesn't), then which modules must be compiled without -O to make the problem go away? Any quick hints on how to do that? Can I somehow instruct cabal to use specific GHC flags selectively for some modules? Setting `-O0` for the main module alone doesn't make the problem go away in any case, while setting `-O0` for the entire regex-tdfa-text package does. But that doesn't tell us much of course. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 17 09:17:48 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 17 Jan 2018 09:17:48 -0000 Subject: [GHC] #14677: Code generator does not correctly tag a pointer In-Reply-To: <046.7a1d900f9976c54932290e6492402f05@haskell.org> References: <046.7a1d900f9976c54932290e6492402f05@haskell.org> Message-ID: <061.7c7f4f541a923959add3bc584e6af5c6@haskell.org> #14677: Code generator does not correctly tag a pointer -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: 14626 Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by heisenbug): Replying to [comment:6 alexbiehl]: > Gabor, I am on OSX. Can you tell me where your code lives and what your build settings are? I will try to reproduce. I am in the context of branch `wip/T14626` in the central repository. There I build with basically unchanged `mk/build.mk` (i.e. `-O2`). I am pretty sure this patch from Simon '''alone''' works on all platforms. But I have no resources to validate it myself. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 17 09:18:22 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 17 Jan 2018 09:18:22 -0000 Subject: [GHC] #14519: Exponential runtime performance regression in GHC 8.2 + Data.Text.Lazy + Text.RE.TDFA In-Reply-To: <043.92c07e3e0209c31f0a0f195fa98d301c@haskell.org> References: <043.92c07e3e0209c31f0a0f195fa98d301c@haskell.org> Message-ID: <058.a4bf4518aeb4b605adef55bd8a448281@haskell.org> #14519: Exponential runtime performance regression in GHC 8.2 + Data.Text.Lazy + Text.RE.TDFA -------------------------------------+------------------------------------- Reporter: ntc2 | Owner: tdammers Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Runtime | Test Case: performance bug | https://github.com/ntc2/ghc-8.2.1 | -regex-lazy-text- | bug/tree/07b7bb32c6e90e8f2d2eada4b59943f37e632d53 Blocked By: | Blocking: Related Tickets: #13745, #14564 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by mpickering): Use an `{-# OPTIONS_GHC -O0 #-}` pragma at the top of the file you want to compile without optimisation. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 17 09:35:57 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 17 Jan 2018 09:35:57 -0000 Subject: [GHC] #14519: Exponential runtime performance regression in GHC 8.2 + Data.Text.Lazy + Text.RE.TDFA In-Reply-To: <043.92c07e3e0209c31f0a0f195fa98d301c@haskell.org> References: <043.92c07e3e0209c31f0a0f195fa98d301c@haskell.org> Message-ID: <058.f34878b156e29b1c86d7870bb02be1ee@haskell.org> #14519: Exponential runtime performance regression in GHC 8.2 + Data.Text.Lazy + Text.RE.TDFA -------------------------------------+------------------------------------- Reporter: ntc2 | Owner: tdammers Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Runtime | Test Case: performance bug | https://github.com/ntc2/ghc-8.2.1 | -regex-lazy-text- | bug/tree/07b7bb32c6e90e8f2d2eada4b59943f37e632d53 Blocked By: | Blocking: Related Tickets: #13745, #14564 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by tdammers): > Use an {-# OPTIONS_GHC -O0 #-} pragma at the top of the file you want to compile without optimisation. Hmm, I was hoping I could do it without changing the source files, that would be easier to script. But it'll have to do. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 17 10:28:37 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 17 Jan 2018 10:28:37 -0000 Subject: [GHC] #14519: Exponential runtime performance regression in GHC 8.2 + Data.Text.Lazy + Text.RE.TDFA In-Reply-To: <043.92c07e3e0209c31f0a0f195fa98d301c@haskell.org> References: <043.92c07e3e0209c31f0a0f195fa98d301c@haskell.org> Message-ID: <058.6cb0cfbade6cdffaffddc8319c3e57b7@haskell.org> #14519: Exponential runtime performance regression in GHC 8.2 + Data.Text.Lazy + Text.RE.TDFA -------------------------------------+------------------------------------- Reporter: ntc2 | Owner: tdammers Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Runtime | Test Case: performance bug | https://github.com/ntc2/ghc-8.2.1 | -regex-lazy-text- | bug/tree/07b7bb32c6e90e8f2d2eada4b59943f37e632d53 Blocked By: | Blocking: Related Tickets: #13745, #14564 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by mpickering): Right but you probably only need to add it to the module which creates the worker `$wnext`. Does compiling with `-fno-worker-wrapper` fix it? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 17 10:41:39 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 17 Jan 2018 10:41:39 -0000 Subject: [GHC] #14679: The interpreter showed panic! (the 'impossible' happened) In-Reply-To: <045.71444bf9e9929347ac7d3ad2119185f1@haskell.org> References: <045.71444bf9e9929347ac7d3ad2119185f1@haskell.org> Message-ID: <060.dbece537a31fa601121781e7427e3ca7@haskell.org> #14679: The interpreter showed panic! (the 'impossible' happened) -------------------------------------+------------------------------------- Reporter: crick_ | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.0.1 Resolution: | Keywords: panic Operating System: Unknown/Multiple | Architecture: x86_64 Type of failure: Compile-time | (amd64) crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: #14299 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by Phyx-): * os: Windows => Unknown/Multiple * related: => #14299 Comment: Possibly a duplicate of #14299 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 17 11:03:36 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 17 Jan 2018 11:03:36 -0000 Subject: [GHC] #14519: Exponential runtime performance regression in GHC 8.2 + Data.Text.Lazy + Text.RE.TDFA In-Reply-To: <043.92c07e3e0209c31f0a0f195fa98d301c@haskell.org> References: <043.92c07e3e0209c31f0a0f195fa98d301c@haskell.org> Message-ID: <058.1295a9d94a6f0fbe0c1d42275f7b3b0c@haskell.org> #14519: Exponential runtime performance regression in GHC 8.2 + Data.Text.Lazy + Text.RE.TDFA -------------------------------------+------------------------------------- Reporter: ntc2 | Owner: tdammers Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Runtime | Test Case: performance bug | https://github.com/ntc2/ghc-8.2.1 | -regex-lazy-text- | bug/tree/07b7bb32c6e90e8f2d2eada4b59943f37e632d53 Blocked By: | Blocking: Related Tickets: #13745, #14564 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by tdammers): > Does compiling with -fno-worker-wrapper fix it? Haven't tried this one yet; `-fno-enable-rewrite-rules` seems to fix it, the other optimization flags listed as "implied by -O" on [https://downloads.haskell.org/~ghc/7.8.2/docs/html/users_guide/flag- reference.html#options-f-compact] don't seem to make a difference. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 17 11:59:28 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 17 Jan 2018 11:59:28 -0000 Subject: [GHC] #14673: Unary Unboxed Tuple Type Constructor In-Reply-To: <049.d9c870f0c2ef1490b284fbb19f566786@haskell.org> References: <049.d9c870f0c2ef1490b284fbb19f566786@haskell.org> Message-ID: <064.33e1da883ba8299070e0e08e1716c841@haskell.org> #14673: Unary Unboxed Tuple Type Constructor -------------------------------------+------------------------------------- Reporter: andrewthad | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.4.1-alpha1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by andrewthad): One of my coworkers Daniel Cartwright has put up a PR on github for making `Unit` and `Unit#` available. Also, I agree with Richard that `Unit` is an unfortunate name. Perhaps something like "single" or "only" is more accurate, but I don't know how many places these are used internally and what the cost of renaming them is. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 17 11:59:46 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 17 Jan 2018 11:59:46 -0000 Subject: [GHC] #14673: Unary Unboxed Tuple Type Constructor In-Reply-To: <049.d9c870f0c2ef1490b284fbb19f566786@haskell.org> References: <049.d9c870f0c2ef1490b284fbb19f566786@haskell.org> Message-ID: <064.e9dce11384e35f7ceac72ea988ff222e@haskell.org> #14673: Unary Unboxed Tuple Type Constructor -------------------------------------+------------------------------------- Reporter: andrewthad | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.4.1-alpha1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by andrewthad): Forgot to link to the PR: https://github.com/ghc/ghc/pull/96. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 17 12:28:38 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 17 Jan 2018 12:28:38 -0000 Subject: [GHC] #14519: Exponential runtime performance regression in GHC 8.2 + Data.Text.Lazy + Text.RE.TDFA In-Reply-To: <043.92c07e3e0209c31f0a0f195fa98d301c@haskell.org> References: <043.92c07e3e0209c31f0a0f195fa98d301c@haskell.org> Message-ID: <058.2ca7ffe47a046b9405adf148f133fef4@haskell.org> #14519: Exponential runtime performance regression in GHC 8.2 + Data.Text.Lazy + Text.RE.TDFA -------------------------------------+------------------------------------- Reporter: ntc2 | Owner: tdammers Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Runtime | Test Case: performance bug | https://github.com/ntc2/ghc-8.2.1 | -regex-lazy-text- | bug/tree/07b7bb32c6e90e8f2d2eada4b59943f37e632d53 Blocked By: | Blocking: Related Tickets: #13745, #14564 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by tdammers): Specifically, running the minimal test code over defs-30000, with various flags, and an execution time limit of 1 second (enough to detect the "bad" behavior), gives us this list: {{{ unoptimized (-O0): Time: 101 ms no-float-in (-O -fno-float-in): Timeout exceeded no-strictness (-O -fno-strictness): Timeout exceeded no-full-laziness (-O -fno-full-laziness): Timeout exceeded no-specialise (-O -fno-specialise): Timeout exceeded no-do-eta-reduction (-O -fno-do-eta-reduction): Timeout exceeded no-cse (-O -fno-cse): Timeout exceeded no-case-merge (-O -fno-case-merge): Timeout exceeded no-enable-rewrite-rules (-O -fno-enable-rewrite-rules): Time: 88 ms no-worker-wrapper (-O -fno-worker-wrapper): Timeout exceeded }}} In other words, among these optimizations, `enable-rewrite-rules` seems to be the one that triggers the bad behavior. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 17 12:33:57 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 17 Jan 2018 12:33:57 -0000 Subject: [GHC] #14519: Exponential runtime performance regression in GHC 8.2 + Data.Text.Lazy + Text.RE.TDFA In-Reply-To: <043.92c07e3e0209c31f0a0f195fa98d301c@haskell.org> References: <043.92c07e3e0209c31f0a0f195fa98d301c@haskell.org> Message-ID: <058.8adc3b58e0050bb32feb096bb41769f1@haskell.org> #14519: Exponential runtime performance regression in GHC 8.2 + Data.Text.Lazy + Text.RE.TDFA -------------------------------------+------------------------------------- Reporter: ntc2 | Owner: tdammers Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Runtime | Test Case: performance bug | https://github.com/ntc2/ghc-8.2.1 | -regex-lazy-text- | bug/tree/07b7bb32c6e90e8f2d2eada4b59943f37e632d53 Blocked By: | Blocking: Related Tickets: #13745, #14564 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by mpickering): You can try using `-ddump-rule-firings` to see which rules are firing. Be careful though, disabling rules will cripple other optimisation passes which rely on them to work properly. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 17 12:51:47 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 17 Jan 2018 12:51:47 -0000 Subject: [GHC] #14519: Exponential runtime performance regression in GHC 8.2 + Data.Text.Lazy + Text.RE.TDFA In-Reply-To: <043.92c07e3e0209c31f0a0f195fa98d301c@haskell.org> References: <043.92c07e3e0209c31f0a0f195fa98d301c@haskell.org> Message-ID: <058.523c6e2765d313d217c44c0b16bc8b7e@haskell.org> #14519: Exponential runtime performance regression in GHC 8.2 + Data.Text.Lazy + Text.RE.TDFA -------------------------------------+------------------------------------- Reporter: ntc2 | Owner: tdammers Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Runtime | Test Case: performance bug | https://github.com/ntc2/ghc-8.2.1 | -regex-lazy-text- | bug/tree/07b7bb32c6e90e8f2d2eada4b59943f37e632d53 Blocked By: | Blocking: Related Tickets: #13745, #14564 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by tdammers): Disabling all optimizations (`-O0`) *only* on the `Text.Regex.TDFA.Text.Lazy`, with `-O` on all other modules, also produces "good" behavior. Removing the `SPECIALIZE` pragma on `execMatch` in that module however does *not* make a difference. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 17 13:37:17 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 17 Jan 2018 13:37:17 -0000 Subject: [GHC] #14519: Exponential runtime performance regression in GHC 8.2 + Data.Text.Lazy + Text.RE.TDFA In-Reply-To: <043.92c07e3e0209c31f0a0f195fa98d301c@haskell.org> References: <043.92c07e3e0209c31f0a0f195fa98d301c@haskell.org> Message-ID: <058.d6b4dbef8e9857d9773d3d4303fc85bc@haskell.org> #14519: Exponential runtime performance regression in GHC 8.2 + Data.Text.Lazy + Text.RE.TDFA -------------------------------------+------------------------------------- Reporter: ntc2 | Owner: tdammers Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Runtime | Test Case: performance bug | https://github.com/ntc2/ghc-8.2.1 | -regex-lazy-text- | bug/tree/07b7bb32c6e90e8f2d2eada4b59943f37e632d53 Blocked By: | Blocking: Related Tickets: #13745, #14564 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by tdammers): Compiling with -ddump-rule-firings gives us: {{{ Rule fired: Class op toEnum (BUILTIN) Rule fired: Class op toEnum (BUILTIN) Rule fired: Class op before (BUILTIN) Rule fired: Class op after (BUILTIN) Rule fired: LAZY TEXT drop -> fused (Data.Text.Lazy) Rule fired: LAZY TEXT take -> fused (Data.Text.Lazy) Rule fired: LAZY STREAM stream/unstream fusion (Data.Text.Internal.Lazy.Fusion) Rule fired: Class op makeRegexOptsM (BUILTIN) Rule fired: Class op $p1RegexMaker (BUILTIN) Rule fired: Class op makeRegexOptsM (BUILTIN) Rule fired: Class op defaultCompOpt (BUILTIN) Rule fired: Class op defaultExecOpt (BUILTIN) Rule fired: Class op makeRegexOptsM (BUILTIN) Rule fired: Class op $p1RegexMaker (BUILTIN) Rule fired: Class op makeRegexOpts (BUILTIN) Rule fired: Class op defaultCompOpt (BUILTIN) Rule fired: Class op defaultExecOpt (BUILTIN) Rule fired: unpack (GHC.Base) Rule fired: Class op show (BUILTIN) Rule fired: ++ (GHC.Base) Rule fired: fold/build (GHC.Base) Rule fired: Class op fmap (BUILTIN) Rule fired: Class op matchOnce (BUILTIN) Rule fired: Class op bounds (BUILTIN) Rule fired: Class op unsafeAt (BUILTIN) Rule fired: Class op numElements (BUILTIN) Rule fired: Class op index (BUILTIN) Rule fired: Class op before (BUILTIN) Rule fired: LAZY TEXT take -> fused (Data.Text.Lazy) Rule fired: Class op fmap (BUILTIN) Rule fired: Class op extract (BUILTIN) Rule fired: Class op after (BUILTIN) Rule fired: Class op + (BUILTIN) Rule fired: LAZY TEXT drop -> fused (Data.Text.Lazy) Rule fired: Class op length (BUILTIN) Rule fired: Class op matchAll (BUILTIN) Rule fired: length (GHC.List) Rule fired: unpack (GHC.Base) Rule fired: unpack (GHC.Base) Rule fired: unpack (GHC.Base) Rule fired: unpack (GHC.Base) Rule fired: Class op bounds (BUILTIN) Rule fired: Class op unsafeAt (BUILTIN) Rule fired: Class op numElements (BUILTIN) Rule fired: Class op index (BUILTIN) Rule fired: Class op fmap (BUILTIN) Rule fired: Class op extract (BUILTIN) Rule fired: Class op - (BUILTIN) Rule fired: Class op after (BUILTIN) Rule fired: Class op + (BUILTIN) Rule fired: Class op - (BUILTIN) Rule fired: LAZY TEXT drop -> fused (Data.Text.Lazy) Rule fired: Class op + (BUILTIN) Rule fired: Class op matchAll (BUILTIN) Rule fired: Class op matchAll (BUILTIN) Rule fired: Class op matchOnceText (BUILTIN) Rule fired: Class op bounds (BUILTIN) Rule fired: Class op unsafeAt (BUILTIN) Rule fired: Class op numElements (BUILTIN) Rule fired: Class op index (BUILTIN) Rule fired: Class op numElements (BUILTIN) Rule fired: Class op unsafeAt (BUILTIN) Rule fired: map (GHC.Base) Rule fired: Class op matchOnce (BUILTIN) Rule fired: Class op matchOnceText (BUILTIN) Rule fired: Class op $p1Integral (BUILTIN) Rule fired: Class op $p1Real (BUILTIN) Rule fired: Class op fromInteger (BUILTIN) Rule fired: integerToInt (BUILTIN) Rule fired: Class op fromInteger (BUILTIN) Rule fired: integerToInt (BUILTIN) Rule fired: Class op $p2Real (BUILTIN) Rule fired: Class op <= (BUILTIN) Rule fired: Class op - (BUILTIN) Rule fired: Class op <= (BUILTIN) Rule fired: Class op fromInteger (BUILTIN) Rule fired: integerToInt (BUILTIN) Rule fired: Class op - (BUILTIN) Rule fired: Class op fromInteger (BUILTIN) Rule fired: integerToInt (BUILTIN) Rule fired: Class op toInteger (BUILTIN) Rule fired: smallIntegerToInt (BUILTIN) Rule fired: SPEC next @ Int64 (Text.Regex.TDFA.Text.Lazy) Rule fired: SPEC next @ Int64 (Text.Regex.TDFA.Text.Lazy) Rule fired: SPEC next @ Int64 (Text.Regex.TDFA.Text.Lazy) Rule fired: SPEC next @ Int64 (Text.Regex.TDFA.Text.Lazy) Rule fired: SPEC next @ Int64 (Text.Regex.TDFA.Text.Lazy) Rule fired: Class op $p1Integral (BUILTIN) Rule fired: Class op $p1Real (BUILTIN) Rule fired: Class op $p2Real (BUILTIN) Rule fired: Class op toInteger (BUILTIN) Rule fired: smallIntegerToInt (BUILTIN) Rule fired: Class op $p1Integral (BUILTIN) Rule fired: Class op $p1Real (BUILTIN) Rule fired: Class op fromInteger (BUILTIN) Rule fired: integerToInt (BUILTIN) Rule fired: Class op fromInteger (BUILTIN) Rule fired: integerToInt (BUILTIN) Rule fired: Class op $p2Real (BUILTIN) Rule fired: Class op <= (BUILTIN) Rule fired: Class op - (BUILTIN) Rule fired: Class op <= (BUILTIN) Rule fired: Class op fromInteger (BUILTIN) Rule fired: integerToInt (BUILTIN) Rule fired: Class op - (BUILTIN) Rule fired: Class op fromInteger (BUILTIN) Rule fired: integerToInt (BUILTIN) Rule fired: Class op toInteger (BUILTIN) Rule fired: smallIntegerToInt (BUILTIN) Rule fired: SPEC next @ Int64 (Text.Regex.TDFA.Text.Lazy) Rule fired: SPEC next @ Int64 (Text.Regex.TDFA.Text.Lazy) Rule fired: SPEC next @ Int64 (Text.Regex.TDFA.Text.Lazy) Rule fired: SPEC next @ Int64 (Text.Regex.TDFA.Text.Lazy) Rule fired: SPEC next @ Int64 (Text.Regex.TDFA.Text.Lazy) Rule fired: SPEC next @ Int64 (Text.Regex.TDFA.Text.Lazy) Rule fired: SPEC next @ Int64 (Text.Regex.TDFA.Text.Lazy) Rule fired: SPEC next @ Int64 (Text.Regex.TDFA.Text.Lazy) Rule fired: Class op $p1Integral (BUILTIN) Rule fired: Class op $p1Real (BUILTIN) Rule fired: Class op $p2Real (BUILTIN) Rule fired: Class op toInteger (BUILTIN) Rule fired: smallIntegerToInt (BUILTIN) Rule fired: Class op $p1RegexLike (BUILTIN) Rule fired: Class op empty (BUILTIN) Rule fired: Class op matchOnceText (BUILTIN) Rule fired: Class op $p1RegexLike (BUILTIN) Rule fired: Class op matchOnceText (BUILTIN) Rule fired: Class op empty (BUILTIN) Rule fired: SPEC/Text.Regex.TDFA.Text.Lazy polymatch @ Regex @ Text (Text.Regex.TDFA.Text.Lazy) Rule fired: unpack-list (GHC.Base) Rule fired: unpack-list (GHC.Base) Rule fired: unpack-list (GHC.Base) Rule fired: unpack-list (GHC.Base) Rule fired: unpack-list (GHC.Base) Rule fired: unpack-list (GHC.Base) Rule fired: unpack-list (GHC.Base) Rule fired: unpack-list (GHC.Base) Rule fired: unpack-list (GHC.Base) Rule fired: unpack-list (GHC.Base) Rule fired: unpack-list (GHC.Base) Rule fired: unpack-list (GHC.Base) Rule fired: foldr/app (GHC.Base) Rule fired: unpack-append (GHC.Base) Rule fired: foldr/app (GHC.Base) Rule fired: unpack-append (GHC.Base) Rule fired: unpack-list (GHC.Base) Rule fired: foldr/app (GHC.Base) Rule fired: unpack-append (GHC.Base) Rule fired: foldr/app (GHC.Base) Rule fired: unpack-append (GHC.Base) Rule fired: lengthList (GHC.List) Rule fired: unpack-list (GHC.Base) Rule fired: unpack-list (GHC.Base) Rule fired: unpack-list (GHC.Base) Rule fired: unpack-list (GHC.Base) Rule fired: unpack-list (GHC.Base) Rule fired: unpack-list (GHC.Base) Rule fired: unpack-list (GHC.Base) Rule fired: unpack-list (GHC.Base) Rule fired: unpack-list (GHC.Base) Rule fired: unpack-list (GHC.Base) Rule fired: unpack-list (GHC.Base) Rule fired: foldr/app (GHC.Base) Rule fired: unpack-append (GHC.Base) Rule fired: foldr/app (GHC.Base) Rule fired: unpack-append (GHC.Base) Rule fired: mapList (GHC.Base) Rule fired: unpack-list (GHC.Base) Rule fired: unpack-append (GHC.Base) Rule fired: Class op $p1Integral (BUILTIN) Rule fired: Class op $p1Real (BUILTIN) Rule fired: Class op $p2Real (BUILTIN) Rule fired: Class op $p1Integral (BUILTIN) Rule fired: Class op $p1Real (BUILTIN) Rule fired: Class op $p2Real (BUILTIN) Rule fired: Class op <= (BUILTIN) Rule fired: Class op fromInteger (BUILTIN) Rule fired: integerToInt (BUILTIN) Rule fired: Class op - (BUILTIN) Rule fired: Class op fromInteger (BUILTIN) Rule fired: integerToInt (BUILTIN) Rule fired: Class op <= (BUILTIN) Rule fired: Class op fromInteger (BUILTIN) Rule fired: integerToInt (BUILTIN) Rule fired: Class op - (BUILTIN) Rule fired: Class op fromInteger (BUILTIN) Rule fired: integerToInt (BUILTIN) Rule fired: Class op toInteger (BUILTIN) Rule fired: smallIntegerToInt (BUILTIN) Rule fired: Class op $p1Integral (BUILTIN) Rule fired: Class op $p1Real (BUILTIN) Rule fired: Class op $p2Real (BUILTIN) Rule fired: Class op toInteger (BUILTIN) Rule fired: smallIntegerToInt (BUILTIN) Rule fired: Class op $p1Integral (BUILTIN) Rule fired: Class op $p1Real (BUILTIN) Rule fired: Class op $p2Real (BUILTIN) Rule fired: Class op <= (BUILTIN) Rule fired: Class op fromInteger (BUILTIN) Rule fired: integerToInt (BUILTIN) Rule fired: Class op - (BUILTIN) Rule fired: Class op fromInteger (BUILTIN) Rule fired: integerToInt (BUILTIN) Rule fired: Class op <= (BUILTIN) Rule fired: Class op fromInteger (BUILTIN) Rule fired: integerToInt (BUILTIN) Rule fired: Class op - (BUILTIN) Rule fired: Class op fromInteger (BUILTIN) Rule fired: integerToInt (BUILTIN) Rule fired: Class op $p1Integral (BUILTIN) Rule fired: Class op $p1Real (BUILTIN) Rule fired: Class op $p2Real (BUILTIN) Rule fired: Class op <= (BUILTIN) Rule fired: Class op fromInteger (BUILTIN) Rule fired: integerToInt (BUILTIN) Rule fired: Class op - (BUILTIN) Rule fired: Class op fromInteger (BUILTIN) Rule fired: integerToInt (BUILTIN) Rule fired: Class op <= (BUILTIN) Rule fired: Class op fromInteger (BUILTIN) Rule fired: integerToInt (BUILTIN) Rule fired: Class op - (BUILTIN) Rule fired: Class op fromInteger (BUILTIN) Rule fired: integerToInt (BUILTIN) Rule fired: *# (BUILTIN) Rule fired: *# (BUILTIN) }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 17 13:59:33 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 17 Jan 2018 13:59:33 -0000 Subject: [GHC] #13016: SPECIALIZE INLINE doesn't necessarily inline specializations of a recursive function In-Reply-To: <046.2aa9b52ee76a4c5247a957951dd35986@haskell.org> References: <046.2aa9b52ee76a4c5247a957951dd35986@haskell.org> Message-ID: <061.1f19ea48d2f342c2d0a28b828b18af1c@haskell.org> #13016: SPECIALIZE INLINE doesn't necessarily inline specializations of a recursive function -------------------------------------+------------------------------------- Reporter: nfrisby | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.0.1 Resolution: | Keywords: Inlining Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: #13014 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by andrewthad): I also feel the behavior of `SPECIALIZE INLINE` is weird in this situation, and I would prefer that it not be marked as a loop breaker. Here's an example that I was toying with that led me to this ticket: {{{!#hs {-# language DataKinds #-} {-# language GADTs #-} {-# language KindSignatures #-} {-# OPTIONS_GHC -O2 -fforce-recomp -ddump-simpl -dsuppress-all #-} import Data.Kind data Nat = Succ Nat | Zero data SNat :: Nat -> Type where SZero :: SNat 'Zero SSucc :: SNat n -> SNat ('Succ n) {-# SPECIALISE INLINE exponentiate :: SNat ('Succ n) -> Int -> Int #-} {-# SPECIALISE INLINE exponentiate :: SNat 'Zero -> Int -> Int #-} exponentiate :: SNat n -> Int -> Int exponentiate SZero x = 1 exponentiate (SSucc s) x = x * (exponentiate s x) main :: IO () main = print (exponentiate (SSucc (SSucc (SSucc (SSucc SZero)))) 3) }}} I would expect that the call to `exponentiate` be supercompiled, but it is not. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 17 14:53:14 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 17 Jan 2018 14:53:14 -0000 Subject: [GHC] #14677: Code generator does not correctly tag a pointer In-Reply-To: <046.7a1d900f9976c54932290e6492402f05@haskell.org> References: <046.7a1d900f9976c54932290e6492402f05@haskell.org> Message-ID: <061.c0aea58be21f2357f4d2b03df79c5fbf@haskell.org> #14677: Code generator does not correctly tag a pointer -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: 14626 Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by heisenbug): Replying to [comment:1 simonpj]: > Try this (untested) patch. It works for the particular example. > > In haste... Simon, the branch has problems, as it turns out: {{{ HC [stage 2] utils/ghctags/dist-install/build/Main.dyn_o HC [stage 2] utils/check-api-annotations/dist-install/build/Main.dyn_o HC [stage 2] utils/check-ppr/dist-install/build/Main.dyn_o epollControl: does not exist (No such file or directory) epollControl: does not exist (No such file or directory) epollControl: does not exist (No such file or directory) }}} I have sent the patch to `wip/T14677` and hopefully `circleci` will reproduce it. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 17 15:26:41 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 17 Jan 2018 15:26:41 -0000 Subject: [GHC] #14519: Exponential runtime performance regression in GHC 8.2 + Data.Text.Lazy + Text.RE.TDFA In-Reply-To: <043.92c07e3e0209c31f0a0f195fa98d301c@haskell.org> References: <043.92c07e3e0209c31f0a0f195fa98d301c@haskell.org> Message-ID: <058.9d64ccf96678773b92c4777f87878be4@haskell.org> #14519: Exponential runtime performance regression in GHC 8.2 + Data.Text.Lazy + Text.RE.TDFA -------------------------------------+------------------------------------- Reporter: ntc2 | Owner: tdammers Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Runtime | Test Case: performance bug | https://github.com/ntc2/ghc-8.2.1 | -regex-lazy-text- | bug/tree/07b7bb32c6e90e8f2d2eada4b59943f37e632d53 Blocked By: | Blocking: Related Tickets: #13745, #14564 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by tdammers): Evidence so far: - We already suspected that whatever we're doing in `uncons` for lazy `Text` might break things. - The `next` function, which uses `uncons` a lot, is where things blow up in ticky profiles - Problem disappears when disabling rewrite rules. - Problem also disappears in profiling builds; this may however be due to rewrites and other optimizations not being fully applied in the presence of explicit cost centres. - Some `RULES` wrt `Text` fusion appear in the dump. So, updated hypothesis: This may not actually be a bug in GHC itself, but in the `text` library, particularly the fusion-related rules. Things like [https://github.com/haskell/text/pull/200 this PR] support the idea that `text`'s fusion behavior may not be perfect yet. If this is the case, then disabling the relevant RULES in `text` should also make the problem disappear. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 17 15:27:30 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 17 Jan 2018 15:27:30 -0000 Subject: [GHC] #13016: SPECIALIZE INLINE doesn't necessarily inline specializations of a recursive function In-Reply-To: <046.2aa9b52ee76a4c5247a957951dd35986@haskell.org> References: <046.2aa9b52ee76a4c5247a957951dd35986@haskell.org> Message-ID: <061.302eea01a50a4b77c02d360a38762365@haskell.org> #13016: SPECIALIZE INLINE doesn't necessarily inline specializations of a recursive function -------------------------------------+------------------------------------- Reporter: nfrisby | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.0.1 Resolution: | Keywords: Inlining Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: #13014 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by mpickering): I don't think the earlier comments in this ticket are resolved. I would just expect `SPECIALISE INLINE` to be totally broken until they are. If you are blocked then you can achieve the same thing in your example using type classes. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 17 16:30:32 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 17 Jan 2018 16:30:32 -0000 Subject: [GHC] #11645: Heap profiling - hp2ps: samples out of sequence In-Reply-To: <045.b3866e053eb1eb6cf46e7327a6d7e479@haskell.org> References: <045.b3866e053eb1eb6cf46e7327a6d7e479@haskell.org> Message-ID: <060.9c50f0dad17ac7153c7200fe71f4e1db@haskell.org> #11645: Heap profiling - hp2ps: samples out of sequence -------------------------------------+------------------------------------- Reporter: thomie | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Profiling | Version: 8.0.1-rc2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: | libraries/hpc/tests/fork/hpc_fork Blocked By: | Blocking: Related Tickets: #664, #14257 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by mnislaih): * cc: mnislaih (added) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 17 17:28:27 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 17 Jan 2018 17:28:27 -0000 Subject: [GHC] #14680: GHC 8.4.1-alpha panics when optimizing function using getTag and tagToEnum# Message-ID: <050.ae9e72a72ce45f0a50476094399e0e2c@haskell.org> #14680: GHC 8.4.1-alpha panics when optimizing function using getTag and tagToEnum# -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.4.1 Component: Compiler | Version: 8.4.1-alpha1 Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: Compile-time Unknown/Multiple | crash or panic Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- I originally observed this panic in [https://travis-ci.org/haskell-compat /deriving-compat/jobs/329948624#L804 this Travis build]. The panic can be reduced to this file: {{{#!hs {-# LANGUAGE MagicHash #-} {-# LANGUAGE TypeFamilies #-} module Bug where import GHC.Base (getTag) import GHC.Exts (Int(..), tagToEnum#) data family TyFamilyEnum data instance TyFamilyEnum = TyFamilyEnum1 | TyFamilyEnum2 | TyFamilyEnum3 suc :: TyFamilyEnum -> TyFamilyEnum suc a_aaf8 = case getTag a_aaf8 of a_aaf9 -> if 2 == I# a_aaf9 then error "succ{TyFamilyEnum}: tried to take `succ' of last tag in enumeration" else case I# a_aaf9 + 1 of I# i_aafa -> tagToEnum# i_aafa :: TyFamilyEnum }}} In GHC 8.2.2, compiling this with optimization works fine. But in GHC 8.4.1-alpha, it panics: {{{ $ /opt/ghc/8.4.1/bin/ghc -fforce-recomp -O1 Bug.hs [1 of 1] Compiling Bug ( Bug.hs, Bug.o ) ghc: panic! (the 'impossible' happened) (GHC version 8.4.0.20171222 for x86_64-unknown-linux): Prelude.!!: index too large }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 17 17:29:44 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 17 Jan 2018 17:29:44 -0000 Subject: [GHC] #14680: GHC 8.4.1-alpha panics when optimizing function using getTag and tagToEnum# In-Reply-To: <050.ae9e72a72ce45f0a50476094399e0e2c@haskell.org> References: <050.ae9e72a72ce45f0a50476094399e0e2c@haskell.org> Message-ID: <065.9ad930465d167cdab901dfd31bc24de3@haskell.org> #14680: GHC 8.4.1-alpha panics when optimizing function using getTag and tagToEnum# -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.4.1 Component: Compiler | Version: 8.4.1-alpha1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by mpickering): * cc: dfeuer (added) Comment: I think David was looking at this at some point? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 17 17:33:21 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 17 Jan 2018 17:33:21 -0000 Subject: [GHC] #14681: More incorrect Template Haskell parenthesization Message-ID: <050.46d7d944797257fdd21b8d7b6afb1448@haskell.org> #14681: More incorrect Template Haskell parenthesization -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Template | Version: 8.2.2 Haskell | Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: Incorrect result Unknown/Multiple | at runtime Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- The latest installment of "RyanGlScott finds bugs in Template Haskell pretty-printing". Here is what's featured on today's episode: {{{#!hs {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -ddump-splices #-} module Bug where import Data.Functor.Identity import Language.Haskell.TH $([d| f = \(Identity x) -> x |]) $([d| g = $(pure $ VarE '(+) `AppE` LitE (IntegerL (-1)) `AppE` (LitE (IntegerL (-1)))) |]) }}} Running this with GHC 8.2 or later yields some incorrectly parenthesized output: {{{ $ /opt/ghc/8.2.2/bin/ghc Bug.hs [1 of 1] Compiling Bug ( Bug.hs, Bug.o ) Bug.hs:8:3-31: Splicing declarations [d| f_azO = \ (Identity x_azP) -> x_azP |] ======> f_a3Nx = \ Identity x_a3Ny -> x_a3Ny Bug.hs:9:3-90: Splicing declarations [d| g_a3NU = $(pure $ VarE '(+) `AppE` LitE (IntegerL (- 1)) `AppE` (LitE (IntegerL (- 1)))) |] pending(rn) [] ======> g_a4dU = ((+) -1) -1 }}} In particular, look at these two lines: {{{ f_a3Nx = \ Identity x_a3Ny -> x_a3Ny g_a4dU = ((+) -1) -1 }}} These should be: {{{ f_a3Nx = \ (Identity x_a3Ny) -> x_a3Ny g_a4dU = ((+) (-1)) (-1) }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 17 19:11:50 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 17 Jan 2018 19:11:50 -0000 Subject: [GHC] #14678: GHC 8.4.1-alpha's bundled transformers doesn't correspond to a tagged release In-Reply-To: <050.e45e5fc2b285549e2fcbcab2ac249ab8@haskell.org> References: <050.e45e5fc2b285549e2fcbcab2ac249ab8@haskell.org> Message-ID: <065.1534e6fd8a602b0e08a0629cab976f93@haskell.org> #14678: GHC 8.4.1-alpha's bundled transformers doesn't correspond to a tagged release -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: high | Milestone: 8.4.1 Component: Compiler | Version: 8.4.1-alpha1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): Oh dear. Yes, we need to get infrastructure in place to ensure the submodules are properly tagged. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 17 19:14:26 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 17 Jan 2018 19:14:26 -0000 Subject: [GHC] #14673: Unary Unboxed Tuple Type Constructor In-Reply-To: <049.d9c870f0c2ef1490b284fbb19f566786@haskell.org> References: <049.d9c870f0c2ef1490b284fbb19f566786@haskell.org> Message-ID: <064.08ea1de833fd6757bf50dcefba0495a9@haskell.org> #14673: Unary Unboxed Tuple Type Constructor -------------------------------------+------------------------------------- Reporter: andrewthad | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.4.1-alpha1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): I doubt it would be very hard to change the name and if we are going to do so we should do it now, before the names are in the wild. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 17 19:25:25 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 17 Jan 2018 19:25:25 -0000 Subject: [GHC] #14673: Unary Unboxed Tuple Type Constructor In-Reply-To: <049.d9c870f0c2ef1490b284fbb19f566786@haskell.org> References: <049.d9c870f0c2ef1490b284fbb19f566786@haskell.org> Message-ID: <064.8ac8b0400ad85d53c4e44bc2810b90c6@haskell.org> #14673: Unary Unboxed Tuple Type Constructor -------------------------------------+------------------------------------- Reporter: andrewthad | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.4.1-alpha1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by andrewthad): Here are my name suggestions: Single, Singleton, Only, UnaryTuple, Unary, Uni, Mono. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 17 19:29:54 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 17 Jan 2018 19:29:54 -0000 Subject: [GHC] #14675: GHC 8.4.1 regression: segfault when loading doctest on a module with ANNs on Ubuntu 16.04 or later In-Reply-To: <050.c5c190ffbc3e4175e84536f4424d1ad2@haskell.org> References: <050.c5c190ffbc3e4175e84536f4424d1ad2@haskell.org> Message-ID: <065.b88184954ed6108f0130c762d071d09d@haskell.org> #14675: GHC 8.4.1 regression: segfault when loading doctest on a module with ANNs on Ubuntu 16.04 or later -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.4.1 Component: GHC API | Version: 8.4.1-alpha1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Runtime crash | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): Thanks, as always, for the bisection Ryan; it's incredibly helpful. I wonder if this is related to the `gold` bug that I found while writing that patch (see #13883). It seems plausible that constructor mis-ordering would result in a crash. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 17 19:31:46 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 17 Jan 2018 19:31:46 -0000 Subject: [GHC] #13883: T5435_dyn_asm fails with ld.gold In-Reply-To: <046.0650089fc873411130b9f2d72ad5ad9e@haskell.org> References: <046.0650089fc873411130b9f2d72ad5ad9e@haskell.org> Message-ID: <061.5565078ed71a355678f6644c46696019@haskell.org> #13883: T5435_dyn_asm fails with ld.gold -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.0.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: closed => new * resolution: fixed => Comment: I don't believe this is supposed to be closed. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 17 20:19:27 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 17 Jan 2018 20:19:27 -0000 Subject: [GHC] #14673: Unary Unboxed Tuple Type Constructor In-Reply-To: <049.d9c870f0c2ef1490b284fbb19f566786@haskell.org> References: <049.d9c870f0c2ef1490b284fbb19f566786@haskell.org> Message-ID: <064.665c34f1b0b6b7bfd16f72faa0d4f2e5@haskell.org> #14673: Unary Unboxed Tuple Type Constructor -------------------------------------+------------------------------------- Reporter: andrewthad | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.4.1-alpha1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by _recursion): I like `Unary`, but I have a slight bit of concern that it's too close to `Unit` for comfort. `Only` also has quite a nice ring to it. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 17 20:33:52 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 17 Jan 2018 20:33:52 -0000 Subject: [GHC] #14680: GHC 8.4.1-alpha panics when optimizing function using getTag and tagToEnum# In-Reply-To: <050.ae9e72a72ce45f0a50476094399e0e2c@haskell.org> References: <050.ae9e72a72ce45f0a50476094399e0e2c@haskell.org> Message-ID: <065.245143769f4651e07898fb5efe860474@haskell.org> #14680: GHC 8.4.1-alpha panics when optimizing function using getTag and tagToEnum# -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.4.1 Component: Compiler | Version: 8.4.1-alpha1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * cc: simonpj (added) Comment: This regression was introduced in commi 193664d42dbceadaa1e4689dfa17ff1cf5a405a0 (`Re-engineer caseRules to add tagToEnum/dataToTag`). cc'ing simonpj, who authored this. From glancing at that diff, I can at least see why this happening. It's due to [http://git.haskell.org/ghc.git/blob/c65104e1a6875f7879db87877848cc35363c1bf3:/compiler/prelude/PrelRules.hs#l1515 this line]: {{{#!hs get_con ty tag = tyConDataCons (tyConAppTyCon ty) !! tag }}} But we're dealing with a data family here, so oughtn't we be using the //representation// tycon here, not `tyConAppTyCon`? It's likely that `tyConAppTyCon ty` is returning an empty list when `ty` is headed by a data family, which would explain the panic. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 17 20:36:23 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 17 Jan 2018 20:36:23 -0000 Subject: [GHC] #14677: Code generator does not correctly tag a pointer In-Reply-To: <046.7a1d900f9976c54932290e6492402f05@haskell.org> References: <046.7a1d900f9976c54932290e6492402f05@haskell.org> Message-ID: <061.eba3600a994412a2362038d44ba5d6a9@haskell.org> #14677: Code generator does not correctly tag a pointer -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: 14626 Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by heisenbug): Replying to [comment:6 alexbiehl]: > Gabor, I am on OSX. Can you tell me where your code lives and what your build settings are? I will try to reproduce. Looks like it is a CAF in OS X: {{{ Watchpoint 1 hit: old value: 4420539208 new value: 4420538632 Process 92235 stopped * thread #1: tid = 0xc753fd, 0x00000001077b525e libHSrts_thr- ghc8.5.20180103.dylib`newCAF(reg=, caf=0x00000001037286b8) + 142 at Storage.c:429, queue = 'com.apple.main-thread', stop reason = watchpoint 1 frame #0: 0x00000001077b525e libHSrts_thr- ghc8.5.20180103.dylib`newCAF(reg=, caf=0x00000001037286b8) + 142 at Storage.c:429 426 bh = lockCAF(reg, caf); 427 if (!bh) return NULL; 428 -> 429 if(keepCAFs) 430 { 431 // Note [dyn_caf_list] 432 // If we are in GHCi _and_ we are using dynamic libraries, (lldb) Process 92235 resuming Process 92235 stopped * thread #1: tid = 0xc753fd, 0x00000001077babc8 libHSrts_thr- ghc8.5.20180103.dylib`checkTagged, queue = 'com.apple.main-thread', stop reason = breakpoint 1.1 frame #0: 0x00000001077babc8 libHSrts_thr- ghc8.5.20180103.dylib`checkTagged libHSrts_thr-ghc8.5.20180103.dylib`checkTagged: -> 0x1077babc8 <+0>: testb $0x7, %bl 0x1077babcb <+3>: jne 0x1077babe3 ; <+27> 0x1077babcd <+5>: subq $0x8, %rsp 0x1077babd1 <+9>: leaq 0x165a4(%rip), %rdi ; "NOT TAGGED! " (lldb) p/x $rbx (unsigned long) $8 = 0x00000001037286b8 (lldb) watchpoint list Number of supported hardware watchpoints: 4 Current watchpoints: Watchpoint 1: addr = 0x1037286b8 size = 8 state = enabled type = w old value: 4420539208 new value: 4420538632 (lldb) dis -s 4420538632 libHSrts_thr-ghc8.5.20180103.dylib`stg_IND_STATIC_info: 0x1077c1108 <+0>: movq 0x8(%rbx), %rbx 0x1077c110c <+4>: andq $-0x8, %rbx 0x1077c1110 <+8>: jmpq *(%rbx) 0x1077c1112 <+10>: adcb %al, (%rax) 0x1077c1114 <+12>: addb %al, (%rax) 0x1077c1116 <+14>: nop libHSrts_thr-ghc8.5.20180103.dylib`stg_BLACKHOLE_info_dsp: 0x1077c1118 <+0>: addl %eax, (%rax) 0x1077c111a <+2>: addb %al, (%rax) 0x1077c111c <+4>: addb %al, (%rax) 0x1077c111e <+6>: addb %al, (%rax) 0x1077c1120 <+8>: addb %al, %es:(%rax) 0x1077c1123 <+11>: addb %al, (%rax) 0x1077c1125 <+13>: addb %al, (%rax) (lldb) dis -s 4420538632+16 libHSrts_thr-ghc8.5.20180103.dylib`stg_BLACKHOLE_info_dsp: 0x1077c1118 <+0>: addl %eax, (%rax) 0x1077c111a <+2>: addb %al, (%rax) 0x1077c111c <+4>: addb %al, (%rax) 0x1077c111e <+6>: addb %al, (%rax) 0x1077c1120 <+8>: addb %al, %es:(%rax) 0x1077c1123 <+11>: addb %al, (%rax) 0x1077c1125 <+13>: addb %al, (%rax) 0x1077c1127 <+15>: addb %cl, -0x75(%rax) libHSrts_thr-ghc8.5.20180103.dylib`stg_BLACKHOLE_info: 0x1077c112a <+2>: orb %bpl, -0x37af0f9(%r8) 0x1077c1131 <+9>: addb %al, (%rax) 0x1077c1133 <+11>: addb %cl, -0x75(%rax) (lldb) p/x $rbx (unsigned long) $10 = 0x00000001037286b8 }}} So it is probably another bug that is easier to trigger on OS X. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 17 20:49:43 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 17 Jan 2018 20:49:43 -0000 Subject: [GHC] #14681: More incorrect Template Haskell parenthesization In-Reply-To: <050.46d7d944797257fdd21b8d7b6afb1448@haskell.org> References: <050.46d7d944797257fdd21b8d7b6afb1448@haskell.org> Message-ID: <065.8c67a9e51160509ea94f9da59bc633c1@haskell.org> #14681: More incorrect Template Haskell parenthesization -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: Component: Template Haskell | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect result | Unknown/Multiple at runtime | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4323 Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * status: new => patch * differential: => Phab:D4323 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 17 20:55:10 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 17 Jan 2018 20:55:10 -0000 Subject: [GHC] #14672: Make likelyhood of branches/conditions available throughout the compiler. In-Reply-To: <047.de2c13e36902d9be8400d9448aa09671@haskell.org> References: <047.de2c13e36902d9be8400d9448aa09671@haskell.org> Message-ID: <062.c75d4bd56d31979a4b27ff6ea81c7fe7@haskell.org> #14672: Make likelyhood of branches/conditions available throughout the compiler. -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4316 Wiki Page: | Phab:D4324 -------------------------------------+------------------------------------- Changes (by AndreasK): * differential: => Phab:D4316 Phab:D4324 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 17 21:00:43 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 17 Jan 2018 21:00:43 -0000 Subject: [GHC] #14682: Atrocious parenthesization in -ddump-deriv output Message-ID: <050.412b21184a592fb4a8dbe5aa08fc49f9@haskell.org> #14682: Atrocious parenthesization in -ddump-deriv output -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Keywords: deriving | Operating System: Unknown/Multiple Architecture: | Type of failure: Debugging Unknown/Multiple | information is incorrect Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- The next installment in "RyanGlScott finds parenthesization bugs". This time, we're featuring `-ddump-deriv`. Just look at this garbage: {{{ $ /opt/ghc/8.2.2/bin/ghci GHCi, version 8.2.2: http://www.haskell.org/ghc/ :? for help Loaded GHCi configuration from /home/rgscott/.ghci λ> import Data.Ix λ> import Language.Haskell.TH.Syntax λ> import Data.Data λ> :set -ddump-deriv -XDeriveLift -XDeriveDataTypeable λ> data Foo = Foo Int Int deriving (Show, Lift, Data, Eq, Ord, Ix) ==================== Derived instances ==================== Derived class instances: instance GHC.Show.Show Ghci1.Foo where GHC.Show.showsPrec a_a6me Ghci1.Foo b1_a6mf b2_a6mg = GHC.Show.showParen (a_a6me GHC.Classes.>= 11) ((GHC.Base..) (GHC.Show.showString "Foo ") ((GHC.Base..) (GHC.Show.showsPrec 11 b1_a6mf) ((GHC.Base..) GHC.Show.showSpace (GHC.Show.showsPrec 11 b2_a6mg)))) GHC.Show.showList = GHC.Show.showList__ (GHC.Show.showsPrec 0) instance Language.Haskell.TH.Syntax.Lift Ghci1.Foo where Language.Haskell.TH.Syntax.lift Ghci1.Foo a1_a6mh a2_a6mi = Language.Haskell.TH.Lib.appE (Language.Haskell.TH.Lib.appE (Language.Haskell.TH.Lib.conE (Language.Haskell.TH.Syntax.mkNameG_d "interactive" "Ghci1" "Foo")) (Language.Haskell.TH.Syntax.lift a1_a6mh)) (Language.Haskell.TH.Syntax.lift a2_a6mi) instance Data.Data.Data Ghci1.Foo where Data.Data.gfoldl k_a6mj z_a6mk Ghci1.Foo a1_a6ml a2_a6mm = ((z_a6mk Ghci1.Foo `k_a6mj` a1_a6ml) `k_a6mj` a2_a6mm) Data.Data.gunfold k_a6mn z_a6mo _ = k_a6mn (k_a6mn (z_a6mo Ghci1.Foo)) Data.Data.toConstr Ghci1.Foo _ _ = Ghci1.$cFoo Data.Data.dataTypeOf _ = Ghci1.$tFoo instance GHC.Classes.Eq Ghci1.Foo where (GHC.Classes.==) (Ghci1.Foo a1_a6mp a2_a6mq) (Ghci1.Foo b1_a6mr b2_a6ms) = (((a1_a6mp GHC.Classes.== b1_a6mr)) GHC.Classes.&& ((a2_a6mq GHC.Classes.== b2_a6ms))) (GHC.Classes./=) a_a6mt b_a6mu = GHC.Classes.not ((GHC.Classes.==) a_a6mt b_a6mu) instance GHC.Classes.Ord Ghci1.Foo where GHC.Classes.compare a_a6mv b_a6mw = case a_a6mv of { Ghci1.Foo a1_a6mx a2_a6my -> case b_a6mw of { Ghci1.Foo b1_a6mz b2_a6mA -> case (GHC.Classes.compare a1_a6mx b1_a6mz) of GHC.Types.LT -> GHC.Types.LT GHC.Types.EQ -> (a2_a6my `GHC.Classes.compare` b2_a6mA) GHC.Types.GT -> GHC.Types.GT } } (GHC.Classes.<) a_a6mB b_a6mC = case a_a6mB of { Ghci1.Foo a1_a6mD a2_a6mE -> case b_a6mC of { Ghci1.Foo b1_a6mF b2_a6mG -> case (GHC.Classes.compare a1_a6mD b1_a6mF) of GHC.Types.LT -> GHC.Types.True GHC.Types.EQ -> (a2_a6mE GHC.Classes.< b2_a6mG) GHC.Types.GT -> GHC.Types.False } } (GHC.Classes.<=) a_a6mH b_a6mI = GHC.Classes.not ((GHC.Classes.<) b_a6mI a_a6mH) (GHC.Classes.>) a_a6mJ b_a6mK = (GHC.Classes.<) b_a6mK a_a6mJ (GHC.Classes.>=) a_a6mL b_a6mM = GHC.Classes.not ((GHC.Classes.<) a_a6mL b_a6mM) instance GHC.Arr.Ix Ghci1.Foo where GHC.Arr.range (Ghci1.Foo a1_a6mN a2_a6mO, Ghci1.Foo b1_a6mP b2_a6mQ) = [Ghci1.Foo c1_a6mR c2_a6mS | c1_a6mR <- GHC.Arr.range (a1_a6mN, b1_a6mP), c2_a6mS <- GHC.Arr.range (a2_a6mO, b2_a6mQ)] GHC.Arr.unsafeIndex (Ghci1.Foo a1_a6mT a2_a6mU, Ghci1.Foo b1_a6mV b2_a6mW) Ghci1.Foo c1_a6mX c2_a6mY = (GHC.Arr.unsafeIndex (a2_a6mU, b2_a6mW) c2_a6mY GHC.Num.+ (GHC.Arr.unsafeRangeSize (a2_a6mU, b2_a6mW) GHC.Num.* GHC.Arr.unsafeIndex (a1_a6mT, b1_a6mV) c1_a6mX)) GHC.Arr.inRange (Ghci1.Foo a1_a6oj a2_a6ok, Ghci1.Foo b1_a6ol b2_a6om) Ghci1.Foo c1_a6on c2_a6oo = (GHC.Arr.inRange (a1_a6oj, b1_a6ol) c1_a6on GHC.Classes.&& GHC.Arr.inRange (a2_a6ok, b2_a6om) c2_a6oo) Ghci1.$con2tag_Hv18APskVh1Gg9kT3PCwD2 :: Ghci1.Foo -> GHC.Prim.Int# Ghci1.$con2tag_Hv18APskVh1Gg9kT3PCwD2 Ghci1.Foo _ _ = 0# Ghci1.$tFoo :: Data.Data.DataType Ghci1.$cFoo :: Data.Data.Constr Ghci1.$tFoo = Data.Data.mkDataType "Foo" [Ghci1.$cFoo] Ghci1.$cFoo = Data.Data.mkConstr Ghci1.$tFoo "Foo" [] Data.Data.Prefix }}} There are several lines where `Foo` must be surrounded with parentheses to typecheck, but aren't. They are: * In the `Show` instance: {{{ GHC.Show.showsPrec a_a8sa Ghci11.Foo b1_a8sb b2_a8sc }}} * In the `Lift` instance: {{{ Language.Haskell.TH.Syntax.lift Ghci11.Foo a1_a8sd a2_a8se }}} * In the `Data` instance: {{{ Data.Data.gfoldl k_a8sf z_a8sg Ghci11.Foo a1_a8sh a2_a8si ... Data.Data.toConstr Ghci11.Foo _ _ = Ghci11.$cFoo }}} * In the auxiliary bindings (technically, these aren't legal definitions in the first place, but it does look jarring): {{{ Ghci11.$con2tag_GrjBmXmdiewCS4g3vLeGMg :: Ghci11.Foo -> GHC.Prim.Int# Ghci11.$con2tag_GrjBmXmdiewCS4g3vLeGMg Ghci11.Foo _ _ = 0# }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 17 21:14:45 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 17 Jan 2018 21:14:45 -0000 Subject: [GHC] #14682: Atrocious parenthesization in -ddump-deriv output In-Reply-To: <050.412b21184a592fb4a8dbe5aa08fc49f9@haskell.org> References: <050.412b21184a592fb4a8dbe5aa08fc49f9@haskell.org> Message-ID: <065.db6b172f2498725a43c925479803f60a@haskell.org> #14682: Atrocious parenthesization in -ddump-deriv output -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: deriving Operating System: Unknown/Multiple | Architecture: Type of failure: Debugging | Unknown/Multiple information is incorrect | Test Case: Blocked By: | Blocking: Related Tickets: #14681 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * related: => #14681 Comment: I end up needing the functions I defined in Phab:D4323 to fix this bug. Since the ticket that Phab:D4323 fixes (#14681) is so similar to this one, I think I'll just amend Phab:D4323 to fix this ticket as well. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 17 21:15:10 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 17 Jan 2018 21:15:10 -0000 Subject: [GHC] #14519: Exponential runtime performance regression in GHC 8.2 + Data.Text.Lazy + Text.RE.TDFA In-Reply-To: <043.92c07e3e0209c31f0a0f195fa98d301c@haskell.org> References: <043.92c07e3e0209c31f0a0f195fa98d301c@haskell.org> Message-ID: <058.25fded76c6c5bb3b7f2ec41d6c904a17@haskell.org> #14519: Exponential runtime performance regression in GHC 8.2 + Data.Text.Lazy + Text.RE.TDFA -------------------------------------+------------------------------------- Reporter: ntc2 | Owner: tdammers Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Runtime | Test Case: performance bug | https://github.com/ntc2/ghc-8.2.1 | -regex-lazy-text- | bug/tree/07b7bb32c6e90e8f2d2eada4b59943f37e632d53 Blocked By: | Blocking: Related Tickets: #13745, #14564 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): > This may not actually be a bug in GHC itself, but in the text library, particularly the fusion-related rules. Sounds plausible. Since there only very few such rules triggered in the trace you sent, you could disable them individually and see what happens. Then hand it off to the text library maintainers! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 17 21:15:33 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 17 Jan 2018 21:15:33 -0000 Subject: [GHC] #14682: Atrocious parenthesization in -ddump-deriv output In-Reply-To: <050.412b21184a592fb4a8dbe5aa08fc49f9@haskell.org> References: <050.412b21184a592fb4a8dbe5aa08fc49f9@haskell.org> Message-ID: <065.bdc8c90ffab3504b0472d1f6b428b634@haskell.org> #14682: Atrocious parenthesization in -ddump-deriv output -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: deriving Operating System: Unknown/Multiple | Architecture: Type of failure: Debugging | Unknown/Multiple information is incorrect | Test Case: Blocked By: | Blocking: Related Tickets: #14681 | Differential Rev(s): Phab:D4323 Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * status: new => patch * differential: => Phab:D4323 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 17 22:29:00 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 17 Jan 2018 22:29:00 -0000 Subject: [GHC] #14673: Unary Unboxed Tuple Type Constructor In-Reply-To: <049.d9c870f0c2ef1490b284fbb19f566786@haskell.org> References: <049.d9c870f0c2ef1490b284fbb19f566786@haskell.org> Message-ID: <064.1954e98315b421069f206670cf2dd28c@haskell.org> #14673: Unary Unboxed Tuple Type Constructor -------------------------------------+------------------------------------- Reporter: andrewthad | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.4.1-alpha1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Changing names would be easy. The hard thing is deciding the names. You might want to consult the libraries@ list. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 18 00:34:31 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 18 Jan 2018 00:34:31 -0000 Subject: [GHC] #14683: Hole-y partial type signatures lead to slow compile times Message-ID: <050.c267d901f7aabb72ea60ae5332333f63@haskell.org> #14683: Hole-y partial type signatures lead to slow compile times -------------------------------------+------------------------------------- Reporter: harpocrates | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.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: -------------------------------------+------------------------------------- This came up while investigating the compile times of Happy grammars: https://github.com/simonmar/happy/issues/109. GHC 8 and later take a lot longer to compile grammars with types that rely on `PartialTypeSignatures` and have lots of wildcards. Example: {{{#!hs happyReduce_6 :: () => Happy_GHC_Exts.Int# -> L Token -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _) -> ParserMonad (HappyAbsSyn _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _) }}} There is an example repo (https://github.com/wiz/too-happy) in that thread containing a grammar whose generated code has lots of wildcards. On my laptop, the project takes about 25 seconds to compile on 7.10.3. With 8.0.2, 8.2.2, and HEAD it takes on the order of 4 minutes. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 18 01:04:30 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 18 Jan 2018 01:04:30 -0000 Subject: [GHC] #14680: GHC 8.4.1-alpha panics when optimizing function using getTag and tagToEnum# In-Reply-To: <050.ae9e72a72ce45f0a50476094399e0e2c@haskell.org> References: <050.ae9e72a72ce45f0a50476094399e0e2c@haskell.org> Message-ID: <065.7c02b8c9233ae477df188058ea0a5e17@haskell.org> #14680: GHC 8.4.1-alpha panics when optimizing function using getTag and tagToEnum# -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.4.1 Component: Compiler | Version: 8.4.1-alpha1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): I had a go at this, but am stuck. I thought fixing this would be a matter of propagating the `FamInstEnvs` down to `get_con` and using that to look up the tycon, as in the following patch: {{{#!diff diff --git a/compiler/codeGen/StgCmmExpr.hs b/compiler/codeGen/StgCmmExpr.hs index 3fcc935..a912979 100644 --- a/compiler/codeGen/StgCmmExpr.hs +++ b/compiler/codeGen/StgCmmExpr.hs @@ -625,7 +625,7 @@ cgAlts gc_plan bndr (AlgAlt tycon) alts ; return AssignedDirectly } -cgAlts _ _ _ _ = panic "cgAlts" +cgAlts _ _ alt _ = pprPanic "cgAlts" (ppr alt) -- UbxTupAlt and PolyAlt have only one alternative diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in index 1e3447b..05ea7ca 100644 --- a/compiler/ghc.cabal.in +++ b/compiler/ghc.cabal.in @@ -434,6 +434,7 @@ Library WorkWrap WwLib FamInst + FamInstLookup Inst TcAnnotations TcArrows diff --git a/compiler/prelude/PrelRules.hs b/compiler/prelude/PrelRules.hs index db79589..9449747 100644 --- a/compiler/prelude/PrelRules.hs +++ b/compiler/prelude/PrelRules.hs @@ -33,6 +33,8 @@ import CoreSyn import MkCore import Id import Literal +import FamInstEnv ( FamInstEnvs ) +import FamInstLookup import CoreOpt ( exprIsLiteral_maybe ) import PrimOp ( PrimOp(..), tagToEnumKey ) import TysWiredIn @@ -1404,6 +1406,7 @@ match_smallIntegerTo _ _ _ _ _ = Nothing -- | Match the scrutinee of a case and potentially return a new scrutinee and a -- function to apply to each literal alternative. caseRules :: DynFlags + -> FamInstEnvs -> CoreExpr -- Scrutinee -> Maybe ( CoreExpr -- New scrutinee , AltCon -> AltCon -- How to fix up the alt pattern @@ -1419,14 +1422,14 @@ caseRules :: DynFlags -- fixup_altcon[con] bs -> let b = mk_orig[b] in rhs; -- ... } -caseRules dflags (App (App (Var f) v) (Lit l)) -- v `op` x# +caseRules dflags _ (App (App (Var f) v) (Lit l)) -- v `op` x# | Just op <- isPrimOpId_maybe f , Just x <- isLitValue_maybe l , Just adjust_lit <- adjustDyadicRight op x = Just (v, tx_lit_con dflags adjust_lit , \v -> (App (App (Var f) (Var v)) (Lit l))) -caseRules dflags (App (App (Var f) (Lit l)) v) -- x# `op` v +caseRules dflags _ (App (App (Var f) (Lit l)) v) -- x# `op` v | Just op <- isPrimOpId_maybe f , Just x <- isLitValue_maybe l , Just adjust_lit <- adjustDyadicLeft x op @@ -1434,25 +1437,25 @@ caseRules dflags (App (App (Var f) (Lit l)) v) -- x# `op` v , \v -> (App (App (Var f) (Lit l)) (Var v))) -caseRules dflags (App (Var f) v ) -- op v +caseRules dflags _ (App (Var f) v ) -- op v | Just op <- isPrimOpId_maybe f , Just adjust_lit <- adjustUnary op = Just (v, tx_lit_con dflags adjust_lit , \v -> App (Var f) (Var v)) -- See Note [caseRules for tagToEnum] -caseRules dflags (App (App (Var f) type_arg) v) +caseRules dflags _ (App (App (Var f) type_arg) v) | Just TagToEnumOp <- isPrimOpId_maybe f = Just (v, tx_con_tte dflags , \v -> (App (App (Var f) type_arg) (Var v))) -- See Note [caseRules for dataToTag] -caseRules _ (App (App (Var f) (Type ty)) v) -- dataToTag x +caseRules _ fam_envs (App (App (Var f) (Type ty)) v) -- dataToTag x | Just DataToTagOp <- isPrimOpId_maybe f - = Just (v, tx_con_dtt ty + = Just (v, tx_con_dtt fam_envs ty , \v -> App (App (Var f) (Type ty)) (Var v)) -caseRules _ _ = Nothing +caseRules _ _ _ = Nothing tx_lit_con :: DynFlags -> (Integer -> Integer) -> AltCon -> AltCon @@ -1506,13 +1509,19 @@ tx_con_tte dflags (DataAlt dc) tag = dataConTagZ dc tx_con_tte _ alt = pprPanic "caseRules" (ppr alt) -tx_con_dtt :: Type -> AltCon -> AltCon -tx_con_dtt _ DEFAULT = DEFAULT -tx_con_dtt ty (LitAlt (MachInt i)) = DataAlt (get_con ty (fromInteger i)) -tx_con_dtt _ alt = pprPanic "caseRules" (ppr alt) - -get_con :: Type -> ConTagZ -> DataCon -get_con ty tag = tyConDataCons (tyConAppTyCon ty) !! tag +tx_con_dtt :: FamInstEnvs -> Type -> AltCon -> AltCon +tx_con_dtt _ _ DEFAULT = DEFAULT +tx_con_dtt fam_envs ty (LitAlt (MachInt i)) = + DataAlt (get_con fam_envs ty (fromInteger i)) +tx_con_dtt _ _ alt = pprPanic "caseRules" (ppr alt) + +get_con :: FamInstEnvs -> Type -> ConTagZ -> DataCon +get_con fam_envs ty tag + | Just (tc, tys) <- tcSplitTyConApp_maybe ty + , (rep_tc, _, _) <- tcLookupDataFamInst fam_envs tc tys + = tyConDataCons rep_tc !! tag + | otherwise + = pprPanic "get_con" (ppr ty) {- Note [caseRules for tagToEnum] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ diff --git a/compiler/simplCore/SimplUtils.hs b/compiler/simplCore/SimplUtils.hs index d86adbb..252ebdb 100644 --- a/compiler/simplCore/SimplUtils.hs +++ b/compiler/simplCore/SimplUtils.hs @@ -65,6 +65,7 @@ import Outputable import Pair import PrelRules import FastString ( fsLit ) +import FamInstEnv ( FamInstEnvs ) import Control.Monad ( when ) import Data.List ( sortBy ) @@ -2012,6 +2013,7 @@ There are some wrinkles mkCase, mkCase1, mkCase2, mkCase3 :: DynFlags + -> FamInstEnvs -> OutExpr -> OutId -> OutType -> [OutAlt] -- Alternatives in standard (increasing) order -> SimplM OutExpr @@ -2020,7 +2022,8 @@ mkCase, mkCase1, mkCase2, mkCase3 -- 1. Merge Nested Cases -------------------------------------------------- -mkCase dflags scrut outer_bndr alts_ty ((DEFAULT, _, deflt_rhs) : outer_alts) +mkCase dflags fam_envs scrut outer_bndr alts_ty + ((DEFAULT, _, deflt_rhs) : outer_alts) | gopt Opt_CaseMerge dflags , (ticks, Case (Var inner_scrut_var) inner_bndr _ inner_alts) <- stripTicksTop tickishFloatable deflt_rhs @@ -2048,7 +2051,7 @@ mkCase dflags scrut outer_bndr alts_ty ((DEFAULT, _, deflt_rhs) : outer_alts) -- precedence over e2 as the value for A! ; fmap (mkTicks ticks) $ - mkCase1 dflags scrut outer_bndr alts_ty merged_alts + mkCase1 dflags fam_envs scrut outer_bndr alts_ty merged_alts } -- Warning: don't call mkCase recursively! -- Firstly, there's no point, because inner alts have already had @@ -2056,13 +2059,15 @@ mkCase dflags scrut outer_bndr alts_ty ((DEFAULT, _, deflt_rhs) : outer_alts) -- Secondly, if you do, you get an infinite loop, because the bindCaseBndr -- in munge_rhs may put a case into the DEFAULT branch! -mkCase dflags scrut bndr alts_ty alts = mkCase1 dflags scrut bndr alts_ty alts +mkCase dflags fam_envs scrut bndr alts_ty alts = + mkCase1 dflags fam_envs scrut bndr alts_ty alts -------------------------------------------------- -- 2. Eliminate Identity Case -------------------------------------------------- -mkCase1 _dflags scrut case_bndr _ alts@((_,_,rhs1) : _) -- Identity case +mkCase1 _dflags _fam_envs scrut case_bndr _ + alts@((_,_,rhs1) : _) -- Identity case | all identity_alt alts = do { tick (CaseIdentity case_bndr) ; return (mkTicks ticks $ re_cast scrut rhs1) } @@ -2101,27 +2106,28 @@ mkCase1 _dflags scrut case_bndr _ alts@((_,_,rhs1) : _) -- Identity case re_cast scrut (Cast rhs co) = Cast (re_cast scrut rhs) co re_cast scrut _ = scrut -mkCase1 dflags scrut bndr alts_ty alts = mkCase2 dflags scrut bndr alts_ty alts +mkCase1 dflags fam_envs scrut bndr alts_ty alts = + mkCase2 dflags fam_envs scrut bndr alts_ty alts -------------------------------------------------- -- 2. Scrutinee Constant Folding -------------------------------------------------- -mkCase2 dflags scrut bndr alts_ty alts +mkCase2 dflags fam_envs scrut bndr alts_ty alts | -- See Note [Scrutinee Constant Folding] case alts of -- Not if there is just a DEFAULT alternative [(DEFAULT,_,_)] -> False _ -> True , gopt Opt_CaseFolding dflags - , Just (scrut', tx_con, mk_orig) <- caseRules dflags scrut + , Just (scrut', tx_con, mk_orig) <- caseRules dflags fam_envs scrut = do { bndr' <- newId (fsLit "lwild") (exprType scrut') ; alts' <- mapM (tx_alt tx_con mk_orig bndr') alts - ; mkCase3 dflags scrut' bndr' alts_ty $ + ; mkCase3 dflags fam_envs scrut' bndr' alts_ty $ add_default (re_sort alts') } | otherwise - = mkCase3 dflags scrut bndr alts_ty alts + = mkCase3 dflags fam_envs scrut bndr alts_ty alts where -- We need to keep the correct association between the scrutinee and its -- binder if the latter isn't dead. Hence we wrap rhs of alternatives with @@ -2174,7 +2180,7 @@ mkCase2 dflags scrut bndr alts_ty alts -------------------------------------------------- -- Catch-all -------------------------------------------------- -mkCase3 _dflags scrut bndr alts_ty alts +mkCase3 _dflags _fam_envs scrut bndr alts_ty alts = return (Case scrut bndr alts_ty alts) {- diff --git a/compiler/simplCore/Simplify.hs b/compiler/simplCore/Simplify.hs index b123055..1e4d9d5 100644 --- a/compiler/simplCore/Simplify.hs +++ b/compiler/simplCore/Simplify.hs @@ -2482,9 +2482,10 @@ simplAlts env0 scrut case_bndr alts cont' ; -- pprTrace "simplAlts" (ppr case_bndr $$ ppr alts_ty $$ ppr alts_ty' $$ ppr alts $$ ppr cont') $ ; let alts_ty' = contResultType cont' + ; fam_envs <- getFamEnvs -- See Note [Avoiding space leaks in OutType] ; seqType alts_ty' `seq` - mkCase (seDynFlags env0) scrut' case_bndr' alts_ty' alts' } + mkCase (seDynFlags env0) fam_envs scrut' case_bndr' alts_ty' alts' } ------------------------------------ diff --git a/compiler/typecheck/FamInst.hs b/compiler/typecheck/FamInst.hs index 956a412..812a67d 100644 --- a/compiler/typecheck/FamInst.hs +++ b/compiler/typecheck/FamInst.hs @@ -17,6 +17,7 @@ import GhcPrelude import HscTypes import FamInstEnv +import FamInstLookup import InstEnv( roughMatchTcs ) import Coercion import TcEvidence @@ -469,38 +470,6 @@ getFamInsts hpt_fam_insts mod tcInstNewTyCon_maybe :: TyCon -> [TcType] -> Maybe (TcType, TcCoercion) tcInstNewTyCon_maybe = instNewTyCon_maybe --- | Like 'tcLookupDataFamInst_maybe', but returns the arguments back if --- there is no data family to unwrap. --- Returns a Representational coercion -tcLookupDataFamInst :: FamInstEnvs -> TyCon -> [TcType] - -> (TyCon, [TcType], Coercion) -tcLookupDataFamInst fam_inst_envs tc tc_args - | Just (rep_tc, rep_args, co) - <- tcLookupDataFamInst_maybe fam_inst_envs tc tc_args - = (rep_tc, rep_args, co) - | otherwise - = (tc, tc_args, mkRepReflCo (mkTyConApp tc tc_args)) - -tcLookupDataFamInst_maybe :: FamInstEnvs -> TyCon -> [TcType] - -> Maybe (TyCon, [TcType], Coercion) --- ^ Converts a data family type (eg F [a]) to its representation type (eg FList a) --- and returns a coercion between the two: co :: F [a] ~R FList a. -tcLookupDataFamInst_maybe fam_inst_envs tc tc_args - | isDataFamilyTyCon tc - , match : _ <- lookupFamInstEnv fam_inst_envs tc tc_args - , FamInstMatch { fim_instance = rep_fam@(FamInst { fi_axiom = ax - , fi_cvs = cvs }) - , fim_tys = rep_args - , fim_cos = rep_cos } <- match - , let rep_tc = dataFamInstRepTyCon rep_fam - co = mkUnbranchedAxInstCo Representational ax rep_args - (mkCoVarCos cvs) - = ASSERT( null rep_cos ) -- See Note [Constrained family instances] in FamInstEnv - Just (rep_tc, rep_args, co) - - | otherwise - = Nothing - -- | 'tcTopNormaliseNewTypeTF_maybe' gets rid of top-level newtypes, -- potentially looking through newtype /instances/. -- }}} Unfortunately, that just causes the panic to change: {{{ $ inplace/bin/ghc-stage2 -fforce-recomp -O1 ../Bug.hs [1 of 1] Compiling Bug ( ../Bug.hs, ../Bug.o ) ghc-stage2: panic! (the 'impossible' happened) (GHC version 8.5.20180117 for x86_64-unknown-linux): cgAlts Polymorphic Call stack: CallStack (from HasCallStack): callStackDoc, called at compiler/utils/Outputable.hs:1150:37 in ghc:Outputable pprPanic, called at compiler/codeGen/StgCmmExpr.hs:628:20 in ghc:StgCmmExpr }}} I have no idea what's going on in `StgCmmExpr`, so I'm out of ideas. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 18 08:20:59 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 18 Jan 2018 08:20:59 -0000 Subject: [GHC] #14683: Hole-y partial type signatures lead to slow compile times In-Reply-To: <050.c267d901f7aabb72ea60ae5332333f63@haskell.org> References: <050.c267d901f7aabb72ea60ae5332333f63@haskell.org> Message-ID: <065.7e76a76d3ed9607d2a0b0b57a3f7e18f@haskell.org> #14683: Hole-y partial type signatures lead to slow compile times -------------------------------------+------------------------------------- Reporter: harpocrates | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): > a grammar whose generated code has lots of wildcards. Would be possible to upload a standalone example? Perhaps just grab the offending generated file, remove unnecessary imports... -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 18 08:46:02 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 18 Jan 2018 08:46:02 -0000 Subject: [GHC] #12158: ghc: panic! (the 'impossible' happened) translateConPatVec: lookup In-Reply-To: <047.dbe3294939f168d779839dd776514e40@haskell.org> References: <047.dbe3294939f168d779839dd776514e40@haskell.org> Message-ID: <062.463bf1282c6b17f92d5136ef49630575@haskell.org> #12158: ghc: panic! (the 'impossible' happened) translateConPatVec: lookup -------------------------------------+------------------------------------- Reporter: wozgonon | Owner: gkaracha Type: bug | Status: new Priority: normal | Milestone: Component: GHCi | Version: 8.0.1 Resolution: | Keywords: | PatternMatchWarnings Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash | Test Case: Blocked By: | Blocking: Related Tickets: #13644 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by justus): I have another example of this error: {{{#!hs genExampleBenchmark :: Int -> LGCmdArgs -> [(String, Serialized)] genExampleBenchmark seed lgArgs@(LGCmdArgs { totalGraphs = total , language = lang , slowdatasource = slowDS , cachenum = cache , LG.percentages = p }) = ... }}} Here I use `LG.percentages` to disambiguate between two `percentages` record fields that are in scope, but it still fails with the same error. Btw if I remove the `LG.` it does throw the appropriate error telling me that it is an ambiguous reference. Commenting out `LG.percentages` makes the panic disappear. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 18 08:53:17 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 18 Jan 2018 08:53:17 -0000 Subject: [GHC] #14677: Code generator does not correctly tag a pointer In-Reply-To: <046.7a1d900f9976c54932290e6492402f05@haskell.org> References: <046.7a1d900f9976c54932290e6492402f05@haskell.org> Message-ID: <061.6cddc2b98d9cfef8210e2bbd3d2cb820@haskell.org> #14677: Code generator does not correctly tag a pointer -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: 14626 Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by heisenbug): * cc: alexbiehl (added) Comment: alexbiehl: I added you to the CC list just in case you want to see what is happening. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 18 11:22:16 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 18 Jan 2018 11:22:16 -0000 Subject: [GHC] #5889: -fno-prof-count-entries leads to linking errors In-Reply-To: <043.c51b50cea9fd3755f487a8490fe8400e@haskell.org> References: <043.c51b50cea9fd3755f487a8490fe8400e@haskell.org> Message-ID: <058.7284b0580429a7eb2a07a4136d616c6a@haskell.org> #5889: -fno-prof-count-entries leads to linking errors -------------------------------------+------------------------------------- Reporter: akio | Owner: bgamari Type: bug | Status: patch Priority: highest | Milestone: 8.4.1 Component: Compiler | Version: 8.3 Resolution: | Keywords: Operating System: Linux | Architecture: x86_64 | (amd64) Type of failure: GHC rejects | Test Case: valid program | profiling/should_compile/T5889 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4325 Wiki Page: | -------------------------------------+------------------------------------- Changes (by osa1): * status: new => patch * differential: => Phab:D4325 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 18 12:19:48 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 18 Jan 2018 12:19:48 -0000 Subject: [GHC] #14519: Exponential runtime performance regression in GHC 8.2 + Data.Text.Lazy + Text.RE.TDFA In-Reply-To: <043.92c07e3e0209c31f0a0f195fa98d301c@haskell.org> References: <043.92c07e3e0209c31f0a0f195fa98d301c@haskell.org> Message-ID: <058.114f724283908d28b54308d0d44ac1cb@haskell.org> #14519: Exponential runtime performance regression in GHC 8.2 + Data.Text.Lazy + Text.RE.TDFA -------------------------------------+------------------------------------- Reporter: ntc2 | Owner: tdammers Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Runtime | Test Case: performance bug | https://github.com/ntc2/ghc-8.2.1 | -regex-lazy-text- | bug/tree/07b7bb32c6e90e8f2d2eada4b59943f37e632d53 Blocked By: | Blocking: Related Tickets: #13745, #14564 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by tdammers): Neutering the following `RULES` in `Data.Text.Lazy` (from `text`) makes the problem go away: - LAZY TEXT take -> fused - LAZY TEXT take -> unfused - LAZY TEXT drop -> fused - LAZY TEXT drop -> unfused Will now try to isolate which one of these causes the trouble. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 18 13:50:12 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 18 Jan 2018 13:50:12 -0000 Subject: [GHC] #14519: Exponential runtime performance regression in GHC 8.2 + Data.Text.Lazy + Text.RE.TDFA In-Reply-To: <043.92c07e3e0209c31f0a0f195fa98d301c@haskell.org> References: <043.92c07e3e0209c31f0a0f195fa98d301c@haskell.org> Message-ID: <058.a9b526e3805fc2998f0f73ea85cca4dd@haskell.org> #14519: Exponential runtime performance regression in GHC 8.2 + Data.Text.Lazy + Text.RE.TDFA -------------------------------------+------------------------------------- Reporter: ntc2 | Owner: tdammers Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Runtime | Test Case: performance bug | https://github.com/ntc2/ghc-8.2.1 | -regex-lazy-text- | bug/tree/07b7bb32c6e90e8f2d2eada4b59943f37e632d53 Blocked By: | Blocking: Related Tickets: #13745, #14564 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by tdammers): Neutering only these two rules also makes the problem go away: - LAZY TEXT take -> fused - LAZY TEXT drop -> fused Neutering only the first one (take -> fused), the problem persists. Neutering only the last one (drop -> fused), the problem disappears. In other words, it seems that the culprit is this rule, somewhere around line #1119 in Data.Text.Lazy.hs: {{{ "LAZY TEXT drop -> fused" [~1] forall n t. drop n t = unstream (S.drop n (stream t)) }}} Going to run a few more tests to make sure though. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 18 15:31:26 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 18 Jan 2018 15:31:26 -0000 Subject: [GHC] #14665: http://www.cminusminus.org/ is dead In-Reply-To: <046.ee5d0668b0e8cf9e55beec4faafe96d3@haskell.org> References: <046.ee5d0668b0e8cf9e55beec4faafe96d3@haskell.org> Message-ID: <061.2ba62400f47319b8a8feca5dfa21b3f8@haskell.org> #14665: http://www.cminusminus.org/ is dead -------------------------------------+------------------------------------- Reporter: niteria | Owner: (none) Type: task | Status: patch Priority: lowest | Milestone: Component: Documentation | Version: Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4311 Wiki Page: | -------------------------------------+------------------------------------- Comment (by Ben Gamari ): In [changeset:"6b1ff0098e7595d5f3b8e6ad7c5d8e4104b02445/ghc" 6b1ff00/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="6b1ff0098e7595d5f3b8e6ad7c5d8e4104b02445" Fix references to cminusminus.org Reviewers: simonmar Reviewed By: simonmar Subscribers: rwbarton, thomie, carter GHC Trac Issues: #14665 Differential Revision: https://phabricator.haskell.org/D4311 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 18 15:31:26 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 18 Jan 2018 15:31:26 -0000 Subject: [GHC] #14273: Typed holes' "valid substitutions" suggestions are oblivious to type class constraints In-Reply-To: <050.ec57930d289b450ca4924847bd0d6061@haskell.org> References: <050.ec57930d289b450ca4924847bd0d6061@haskell.org> Message-ID: <065.728466aaa65c5d6112a3db1da6a68ebb@haskell.org> #14273: Typed holes' "valid substitutions" suggestions are oblivious to type class constraints -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: Tritlo Type: bug | Status: patch Priority: normal | Milestone: 8.4.1 Component: Compiler (Type | Version: 8.3 checker) | Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Poor/confusing | Unknown/Multiple error message | Test Case: Blocked By: | Blocking: Related Tickets: #9091, #9479 | Differential Rev(s): Phab:D4315 Wiki Page: | -------------------------------------+------------------------------------- Comment (by Ben Gamari ): In [changeset:"1e14fd3ecfd468c3beddb2e5f992c358e1a798de/ghc" 1e14fd3e/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="1e14fd3ecfd468c3beddb2e5f992c358e1a798de" Inform hole substitutions of typeclass constraints (fixes #14273). This implements SPJ's suggestion on the ticket (#14273). We find the relevant constraints (ones that whose free unification variables are all mentioned in the type of the hole), and then clone the free unification variables of the hole and the relevant constraints. We then add a subsumption constraints and run the simplifier, and then check whether all the constraints were solved. Reviewers: bgamari Reviewed By: bgamari Subscribers: RyanGlScott, rwbarton, thomie, carter GHC Trac Issues: #14273 Differential Revision: https://phabricator.haskell.org/D4315 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 18 16:02:17 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 18 Jan 2018 16:02:17 -0000 Subject: [GHC] #14519: Exponential runtime performance regression in GHC 8.2 + Data.Text.Lazy + Text.RE.TDFA In-Reply-To: <043.92c07e3e0209c31f0a0f195fa98d301c@haskell.org> References: <043.92c07e3e0209c31f0a0f195fa98d301c@haskell.org> Message-ID: <058.d49aa7e008c071647b55d369f4cc3534@haskell.org> #14519: Exponential runtime performance regression in GHC 8.2 + Data.Text.Lazy + Text.RE.TDFA -------------------------------------+------------------------------------- Reporter: ntc2 | Owner: tdammers Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Runtime | Test Case: performance bug | https://github.com/ntc2/ghc-8.2.1 | -regex-lazy-text- | bug/tree/07b7bb32c6e90e8f2d2eada4b59943f37e632d53 Blocked By: | Blocking: Related Tickets: #13745, #14564 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by tdammers): Clean build with only this one rule neutered confirms. So this particular rule causes, or at least triggers, the bug. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 18 17:04:22 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 18 Jan 2018 17:04:22 -0000 Subject: [GHC] #14603: GHC segfaults building store with profiling In-Reply-To: <046.7db770ba92a42deacd0ed35af7d6c965@haskell.org> References: <046.7db770ba92a42deacd0ed35af7d6c965@haskell.org> Message-ID: <061.3d5e89c5d032618b2615d032a3378c91@haskell.org> #14603: GHC segfaults building store with profiling -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: closed Priority: highest | Milestone: 8.4.1 Component: Compiler | Version: 8.4.1-alpha1 Resolution: duplicate | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: #14675 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: new => closed * resolution: => duplicate * related: => #14675 Comment: This sounds quite similar to #14675. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 18 17:04:52 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 18 Jan 2018 17:04:52 -0000 Subject: [GHC] #14675: GHC 8.4.1 regression: segfault when loading doctest on a module with ANNs on Ubuntu 16.04 or later In-Reply-To: <050.c5c190ffbc3e4175e84536f4424d1ad2@haskell.org> References: <050.c5c190ffbc3e4175e84536f4424d1ad2@haskell.org> Message-ID: <065.99549e7a5ed7a1d71af3028802e40054@haskell.org> #14675: GHC 8.4.1 regression: segfault when loading doctest on a module with ANNs on Ubuntu 16.04 or later -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.4.1 Component: GHC API | Version: 8.4.1-alpha1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Runtime crash | Test Case: Blocked By: | Blocking: Related Tickets: #14603 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * related: => #14603 Comment: I believe I saw this previously with #14603. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 18 18:02:53 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 18 Jan 2018 18:02:53 -0000 Subject: [GHC] #14681: More incorrect Template Haskell parenthesization In-Reply-To: <050.46d7d944797257fdd21b8d7b6afb1448@haskell.org> References: <050.46d7d944797257fdd21b8d7b6afb1448@haskell.org> Message-ID: <065.768813526a060be6fd8c64fb7fd99606@haskell.org> #14681: More incorrect Template Haskell parenthesization -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: Component: Template Haskell | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect result | Unknown/Multiple at runtime | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4323 Wiki Page: | -------------------------------------+------------------------------------- Comment (by Ben Gamari ): In [changeset:"575c009d9e4b25384ef984c09b2c54f909693e93/ghc" 575c009d/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="575c009d9e4b25384ef984c09b2c54f909693e93" Fix #14681 and #14682 with precision-aimed parentheses It turns out that `Convert` was recklessly leaving off parentheses in two places: * Negative numeric literals * Patterns in lambda position This patch fixes it by adding three new functions, `isCompoundHsLit`, `isCompoundHsOverLit`, and `isCompoundPat`, and using them in the right places in `Convert`. While I was in town, I also sprinkled `isCompoundPat` among some `Pat`-constructing functions in `HsUtils` to help avoid the likelihood of this problem happening in other places. One of these places is in `TcGenDeriv`, and sprinkling `isCompountPat` there fixes #14682 Test Plan: make test TEST="T14681 T14682" Reviewers: alanz, goldfire, bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie, carter GHC Trac Issues: #14681, #14682 Differential Revision: https://phabricator.haskell.org/D4323 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 18 18:02:53 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 18 Jan 2018 18:02:53 -0000 Subject: [GHC] #14682: Atrocious parenthesization in -ddump-deriv output In-Reply-To: <050.412b21184a592fb4a8dbe5aa08fc49f9@haskell.org> References: <050.412b21184a592fb4a8dbe5aa08fc49f9@haskell.org> Message-ID: <065.c7ff6e1e07f3b74e092f6cb29cf43fa4@haskell.org> #14682: Atrocious parenthesization in -ddump-deriv output -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: deriving Operating System: Unknown/Multiple | Architecture: Type of failure: Debugging | Unknown/Multiple information is incorrect | Test Case: Blocked By: | Blocking: Related Tickets: #14681 | Differential Rev(s): Phab:D4323 Wiki Page: | -------------------------------------+------------------------------------- Comment (by Ben Gamari ): In [changeset:"575c009d9e4b25384ef984c09b2c54f909693e93/ghc" 575c009d/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="575c009d9e4b25384ef984c09b2c54f909693e93" Fix #14681 and #14682 with precision-aimed parentheses It turns out that `Convert` was recklessly leaving off parentheses in two places: * Negative numeric literals * Patterns in lambda position This patch fixes it by adding three new functions, `isCompoundHsLit`, `isCompoundHsOverLit`, and `isCompoundPat`, and using them in the right places in `Convert`. While I was in town, I also sprinkled `isCompoundPat` among some `Pat`-constructing functions in `HsUtils` to help avoid the likelihood of this problem happening in other places. One of these places is in `TcGenDeriv`, and sprinkling `isCompountPat` there fixes #14682 Test Plan: make test TEST="T14681 T14682" Reviewers: alanz, goldfire, bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie, carter GHC Trac Issues: #14681, #14682 Differential Revision: https://phabricator.haskell.org/D4323 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 18 18:04:44 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 18 Jan 2018 18:04:44 -0000 Subject: [GHC] #14684: combineIdenticalAlts is only partially implemented Message-ID: <049.66bb6a9ebb8aeb6bc16c5fd3f9c006db@haskell.org> #14684: combineIdenticalAlts is only partially implemented -------------------------------------+------------------------------------- Reporter: mpickering | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.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: -------------------------------------+------------------------------------- combineIdenticalAlts commons up branches of case expressions which have the same RHS. However, it is not fully implemented so opportunities to common up branches are missed. For very big case expressions in might impact compilation time but it could be something which is enabled by `-O2`. For example, the `C` and `D` case for `foo` are not commened up but the `A` and `B` case in `foo2` are. {{{ module Foo where data T = A | B | C | D foo x = case x of A -> 0 B -> 1 C -> 2 D -> 2 foo2 x = case x of A -> 2 B -> 2 C -> 0 D -> 1 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 18 18:23:16 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 18 Jan 2018 18:23:16 -0000 Subject: [GHC] #14665: http://www.cminusminus.org/ is dead In-Reply-To: <046.ee5d0668b0e8cf9e55beec4faafe96d3@haskell.org> References: <046.ee5d0668b0e8cf9e55beec4faafe96d3@haskell.org> Message-ID: <061.d45bd6675429b9bb4e813fc1d1e74aa4@haskell.org> #14665: http://www.cminusminus.org/ is dead -------------------------------------+------------------------------------- Reporter: niteria | Owner: (none) Type: task | Status: closed Priority: lowest | Milestone: 8.6.1 Component: Documentation | Version: Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4311 Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: patch => closed * resolution: => fixed * milestone: => 8.6.1 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 18 18:23:56 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 18 Jan 2018 18:23:56 -0000 Subject: [GHC] #14667: Compiling a function with a lot of alternatives bottlenecks on insertIntHeap In-Reply-To: <046.bf8bb91dd6a70996717f1ecc929e7901@haskell.org> References: <046.bf8bb91dd6a70996717f1ecc929e7901@haskell.org> Message-ID: <061.76485ad65bbf7880e28ec2263bfa7267@haskell.org> #14667: Compiling a function with a lot of alternatives bottlenecks on insertIntHeap -------------------------------------+------------------------------------- Reporter: niteria | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): niteria, is there anything more needed here? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 18 18:24:24 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 18 Jan 2018 18:24:24 -0000 Subject: [GHC] #14652: Allow different executable names on windows In-Reply-To: <047.e6a3bc01cad203df066c1a713b94ac37@haskell.org> References: <047.e6a3bc01cad203df066c1a713b94ac37@haskell.org> Message-ID: <062.94aa9df005be6a4b943778f460516adb@haskell.org> #14652: Allow different executable names on windows -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: AndreasK Type: task | Status: merge Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: Resolution: | Keywords: Operating System: Windows | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4296 Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: patch => merge -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 18 18:24:32 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 18 Jan 2018 18:24:32 -0000 Subject: [GHC] #14273: Typed holes' "valid substitutions" suggestions are oblivious to type class constraints In-Reply-To: <050.ec57930d289b450ca4924847bd0d6061@haskell.org> References: <050.ec57930d289b450ca4924847bd0d6061@haskell.org> Message-ID: <065.5c63d51d484996876b9df21d9f46a35f@haskell.org> #14273: Typed holes' "valid substitutions" suggestions are oblivious to type class constraints -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: Tritlo Type: bug | Status: merge Priority: normal | Milestone: 8.4.1 Component: Compiler (Type | Version: 8.3 checker) | Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Poor/confusing | Unknown/Multiple error message | Test Case: Blocked By: | Blocking: Related Tickets: #9091, #9479 | Differential Rev(s): Phab:D4315 Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: patch => merge -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 18 18:24:46 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 18 Jan 2018 18:24:46 -0000 Subject: [GHC] #14682: Atrocious parenthesization in -ddump-deriv output In-Reply-To: <050.412b21184a592fb4a8dbe5aa08fc49f9@haskell.org> References: <050.412b21184a592fb4a8dbe5aa08fc49f9@haskell.org> Message-ID: <065.378780b299ddc3d0a3273a3fb6098426@haskell.org> #14682: Atrocious parenthesization in -ddump-deriv output -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: merge Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: deriving Operating System: Unknown/Multiple | Architecture: Type of failure: Debugging | Unknown/Multiple information is incorrect | Test Case: Blocked By: | Blocking: Related Tickets: #14681 | Differential Rev(s): Phab:D4323 Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: patch => merge * milestone: => 8.4.1 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 18 18:24:54 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 18 Jan 2018 18:24:54 -0000 Subject: [GHC] #14681: More incorrect Template Haskell parenthesization In-Reply-To: <050.46d7d944797257fdd21b8d7b6afb1448@haskell.org> References: <050.46d7d944797257fdd21b8d7b6afb1448@haskell.org> Message-ID: <065.43bfca0f28f960384668e61593ea27d4@haskell.org> #14681: More incorrect Template Haskell parenthesization -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: Component: Template Haskell | Version: 8.2.2 Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect result | Unknown/Multiple at runtime | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4323 Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: patch => closed * resolution: => fixed -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 18 18:26:35 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 18 Jan 2018 18:26:35 -0000 Subject: [GHC] #14684: combineIdenticalAlts is only partially implemented In-Reply-To: <049.66bb6a9ebb8aeb6bc16c5fd3f9c006db@haskell.org> References: <049.66bb6a9ebb8aeb6bc16c5fd3f9c006db@haskell.org> Message-ID: <064.b2689e19081a0fa8b6fae7195c2b3800@haskell.org> #14684: combineIdenticalAlts is only partially implemented -------------------------------------+------------------------------------- Reporter: mpickering | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by AndreasK): * cc: AndreasK (added) Comment: I think the only way to make -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 18 18:29:53 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 18 Jan 2018 18:29:53 -0000 Subject: [GHC] #14497: internal error: scavenge_one: strange object 19828 In-Reply-To: <044.d9e9a438baea314f437751a66a161d85@haskell.org> References: <044.d9e9a438baea314f437751a66a161d85@haskell.org> Message-ID: <059.45936c23bf050de66151a625371c49b5@haskell.org> #14497: internal error: scavenge_one: strange object 19828 -------------------------------------+------------------------------------- Reporter: Yuras | Owner: simonmar Type: bug | Status: closed Priority: high | Milestone: 8.2.3 Component: Compiler | Version: 8.2.1 Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Runtime crash | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4254 Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: merge => closed * resolution: => fixed Comment: Merged with 3e3a096885c0fcd0703edbeffb4e47f5cbd8f4cc. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 18 18:31:46 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 18 Jan 2018 18:31:46 -0000 Subject: [GHC] #12848: Reduce long-term memory usage of GHCi In-Reply-To: <047.67e660d21ca1bf05a200182e30500999@haskell.org> References: <047.67e660d21ca1bf05a200182e30500999@haskell.org> Message-ID: <062.b195f02aa31b7f4ccb984b57e92cd279@haskell.org> #12848: Reduce long-term memory usage of GHCi ------------------------------------+-------------------------------------- Reporter: arybczak | Owner: (none) Type: feature request | Status: new Priority: high | Milestone: Component: GHCi | Version: 8.0.1 Resolution: | Keywords: Operating System: Linux | Architecture: x86_64 (amd64) Type of failure: Other | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | ------------------------------------+-------------------------------------- Changes (by bgamari): * priority: normal => high Comment: Indeed 400MB is quite a jump. I think this would make for a reasonable SoC project if coupled with a few other bugs. I suspect tracking this down won't take an entire summer, even for a new contributor. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 18 18:39:22 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 18 Jan 2018 18:39:22 -0000 Subject: [GHC] #14673: Unary Unboxed Tuple Type Constructor In-Reply-To: <049.d9c870f0c2ef1490b284fbb19f566786@haskell.org> References: <049.d9c870f0c2ef1490b284fbb19f566786@haskell.org> Message-ID: <064.99241e07674687c743ff45afb187cd45@haskell.org> #14673: Unary Unboxed Tuple Type Constructor -------------------------------------+------------------------------------- Reporter: andrewthad | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.4.1-alpha1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by andrewthad): I've started a thread for this on the mailing list: https://mail.haskell.org/pipermail/libraries/2018-January/028419.html. It's attracted some good feedback. At this point, the name `Solo` (and `Solo#`) seems to have slightly more support than others, but it's probably best to wait several days for the thread to garner more attention. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 18 19:05:53 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 18 Jan 2018 19:05:53 -0000 Subject: [GHC] #14667: Compiling a function with a lot of alternatives bottlenecks on insertIntHeap In-Reply-To: <046.bf8bb91dd6a70996717f1ecc929e7901@haskell.org> References: <046.bf8bb91dd6a70996717f1ecc929e7901@haskell.org> Message-ID: <061.9a23379e6873493aebf7291cef383706@haskell.org> #14667: Compiling a function with a lot of alternatives bottlenecks on insertIntHeap -------------------------------------+------------------------------------- Reporter: niteria | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by niteria): The commit referenced above is related, but solves a different problem. I didn't expect it to be referenced here. The issue still persists, I'd like to revert https://phabricator.haskell.org/rGHC5a1a2633553, but that commit was supposed to be a performance win, so it'd be helpful if I knew that's what we want to do. I hoped someone would tell me what to test before putting up a diff with the revert. Should I run nofib, or is ./validate enough? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 18 19:06:26 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 18 Jan 2018 19:06:26 -0000 Subject: [GHC] #14667: Compiling a function with a lot of alternatives bottlenecks on insertIntHeap In-Reply-To: <046.bf8bb91dd6a70996717f1ecc929e7901@haskell.org> References: <046.bf8bb91dd6a70996717f1ecc929e7901@haskell.org> Message-ID: <061.be2d93cddbff9860fa51bcf5da94b31e@haskell.org> #14667: Compiling a function with a lot of alternatives bottlenecks on insertIntHeap -------------------------------------+------------------------------------- Reporter: niteria | Owner: niteria Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by niteria): * owner: (none) => niteria -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 18 21:09:03 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 18 Jan 2018 21:09:03 -0000 Subject: [GHC] #14683: Hole-y partial type signatures lead to slow compile times In-Reply-To: <050.c267d901f7aabb72ea60ae5332333f63@haskell.org> References: <050.c267d901f7aabb72ea60ae5332333f63@haskell.org> Message-ID: <065.49c7538651c91c2e2bafba83ca8f015e@haskell.org> #14683: Hole-y partial type signatures lead to slow compile times -------------------------------------+------------------------------------- Reporter: harpocrates | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Description changed by harpocrates: Old description: > This came up while investigating the compile times of Happy grammars: > https://github.com/simonmar/happy/issues/109. GHC 8 and later take a lot > longer to compile grammars with types that rely on > `PartialTypeSignatures` and have lots of wildcards. Example: > > {{{#!hs > happyReduce_6 > :: () > => Happy_GHC_Exts.Int# > -> L Token > -> Happy_GHC_Exts.Int# > -> Happy_IntList > -> HappyStk (HappyAbsSyn _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ > _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _) > -> ParserMonad (HappyAbsSyn _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ > _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _) > }}} > > There is an example repo (https://github.com/wiz/too-happy) in that > thread containing a grammar whose generated code has lots of wildcards. > > On my laptop, the project takes about 25 seconds to compile on 7.10.3. > With 8.0.2, 8.2.2, and HEAD it takes on the order of 4 minutes. New description: This came up while investigating the compile times of Happy grammars: https://github.com/simonmar/happy/issues/109. GHC 8 and later take a lot longer to compile ~~grammars with types that rely on `PartialTypeSignatures` and have lots of wildcards~~. There is an example repo (https://github.com/wiz/too-happy) in that thread containing a grammar whose generated code has lots of wildcards. On my laptop, the project takes about 25 seconds to compile on 7.10.3. With 8.0.2, 8.2.2, and HEAD it takes on the order of 4 minutes. -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 18 21:15:05 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 18 Jan 2018 21:15:05 -0000 Subject: [GHC] #14385: Clarify error message when missing GADTs extension In-Reply-To: <044.e15073ad95f4a8ec466187fd8001a2b6@haskell.org> References: <044.e15073ad95f4a8ec466187fd8001a2b6@haskell.org> Message-ID: <059.023018166d2697c05d2e9da95fedbd7f@haskell.org> #14385: Clarify error message when missing GADTs extension -------------------------------------+------------------------------------- Reporter: lyxia | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4122 Wiki Page: | -------------------------------------+------------------------------------- Comment (by lyxia): Yes, thank you! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 18 21:26:34 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 18 Jan 2018 21:26:34 -0000 Subject: [GHC] #14683: Hole-y partial type signatures lead to slow compile times In-Reply-To: <050.c267d901f7aabb72ea60ae5332333f63@haskell.org> References: <050.c267d901f7aabb72ea60ae5332333f63@haskell.org> Message-ID: <065.23adb83c6d1697cef3788a98af0e597b@haskell.org> #14683: Hole-y partial type signatures lead to slow compile times -------------------------------------+------------------------------------- Reporter: harpocrates | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by harpocrates): * Attachment "Grammar.hs" added. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 18 21:26:58 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 18 Jan 2018 21:26:58 -0000 Subject: [GHC] #14683: Hole-y partial type signatures lead to slow compile times In-Reply-To: <050.c267d901f7aabb72ea60ae5332333f63@haskell.org> References: <050.c267d901f7aabb72ea60ae5332333f63@haskell.org> Message-ID: <065.8d5476251164c94bcd0ba695454c132f@haskell.org> #14683: Hole-y partial type signatures lead to slow compile times -------------------------------------+------------------------------------- Reporter: harpocrates | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by harpocrates): I've distilled the repo down to a single file. In the process, I've realized that the problem is actually not related to `PartialTypeSignatures`! On my machine: {{{ $ time ghc-7.10.3 Grammar.hs 17.71s user 1.30s system 97% cpu 19.543 total $ time ghc-8.0.2 Grammar.hs 139.23s user 1.77s system 99% cpu 2:22.31 total $ time ghc-8.2.2 Grammar.hs 127.42s user 1.53s system 98% cpu 2:11.08 total $ time ghc-head Grammar.hs 130.42s user 1.06s system 99% cpu 2:12.58 total }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 18 22:32:58 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 18 Jan 2018 22:32:58 -0000 Subject: [GHC] #14683: Slow compile times for Happy-generated source (was: Hole-y partial type signatures lead to slow compile times) In-Reply-To: <050.c267d901f7aabb72ea60ae5332333f63@haskell.org> References: <050.c267d901f7aabb72ea60ae5332333f63@haskell.org> Message-ID: <065.67bf4519bdf1c729ad514638e0e717b9@haskell.org> #14683: Slow compile times for Happy-generated source -------------------------------------+------------------------------------- Reporter: harpocrates | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 18 23:14:12 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 18 Jan 2018 23:14:12 -0000 Subject: [GHC] #14683: Slow compile times for Happy-generated source In-Reply-To: <050.c267d901f7aabb72ea60ae5332333f63@haskell.org> References: <050.c267d901f7aabb72ea60ae5332333f63@haskell.org> Message-ID: <065.8b46f72d165955cbda526aa9a7b642f7@haskell.org> #14683: Slow compile times for Happy-generated source -------------------------------------+------------------------------------- Reporter: harpocrates | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * failure: None/Unknown => Compile-time performance bug -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 18 23:15:20 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 18 Jan 2018 23:15:20 -0000 Subject: [GHC] #14683: Slow compile times for Happy-generated source In-Reply-To: <050.c267d901f7aabb72ea60ae5332333f63@haskell.org> References: <050.c267d901f7aabb72ea60ae5332333f63@haskell.org> Message-ID: <065.f2eb8b2d26dc80cec5ebe5bbb8a42190@haskell.org> #14683: Slow compile times for Happy-generated source -------------------------------------+------------------------------------- Reporter: harpocrates | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Thanks for distilling it. Ben and colleagues: worth looking into this to characterise what's going on. Thanks. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 18 23:27:44 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 18 Jan 2018 23:27:44 -0000 Subject: [GHC] #14684: combineIdenticalAlts is only partially implemented In-Reply-To: <049.66bb6a9ebb8aeb6bc16c5fd3f9c006db@haskell.org> References: <049.66bb6a9ebb8aeb6bc16c5fd3f9c006db@haskell.org> Message-ID: <064.f203e88d8e1b6e61522f24d6868ebabe@haskell.org> #14684: combineIdenticalAlts is only partially implemented -------------------------------------+------------------------------------- Reporter: mpickering | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): In `CoreUtils`, `Note [Combine identical alternatives]` acknowledges this problem, saying {{{ To avoid an expensive test, we just merge branches equal to the *first* alternative; this picks up the common cases a) all branches equal b) some branches equal to the DEFAULT (which occurs first) }}} And indeed you are right that it'd be better to combine {{{ foo x = case x of ==> foo x = case x of A -> 0 DEFAULT -> 2 B -> 1 A -> 0 C -> 2 B -> 1 D -> 2 }}} (Reminder: in Core the DEFAULT alternative always comes first, if it exists.) Fortunately, we now have `TrieMap.CoreMap`, an efficient finite map whose keys are `CoreExprs`. Using this I think we can efficiently ask (as we iterate oover the alternatives) "have I seen this RHS in an earlier alternative?". More advanced: find the RHS that occurs most often. Take care that in the common case the RHSs are (a) large and (b) different, then the test does not exhaustively traverse the RHSs; just looks far enough to establish they are different. This a nice well-contained task, if someone would like to have a go. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 18 23:35:32 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 18 Jan 2018 23:35:32 -0000 Subject: [GHC] #14684: combineIdenticalAlts is only partially implemented In-Reply-To: <049.66bb6a9ebb8aeb6bc16c5fd3f9c006db@haskell.org> References: <049.66bb6a9ebb8aeb6bc16c5fd3f9c006db@haskell.org> Message-ID: <064.345adf25d2a54219ad439e78f1fb87aa@haskell.org> #14684: combineIdenticalAlts is only partially implemented -------------------------------------+------------------------------------- Reporter: mpickering | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: newcomer Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by mpickering): * keywords: => newcomer Comment: I'll mark it for a newcomer as it is well-specified now and should be a good introduction to the code base. If anyone wants to take it on then feel free to ask for help on #ghc. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 18 23:42:10 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 18 Jan 2018 23:42:10 -0000 Subject: [GHC] #14667: Compiling a function with a lot of alternatives bottlenecks on insertIntHeap In-Reply-To: <046.bf8bb91dd6a70996717f1ecc929e7901@haskell.org> References: <046.bf8bb91dd6a70996717f1ecc929e7901@haskell.org> Message-ID: <061.9abdcf5e41f20554d19a57d1c27cf2d9@haskell.org> #14667: Compiling a function with a lot of alternatives bottlenecks on insertIntHeap -------------------------------------+------------------------------------- Reporter: niteria | Owner: niteria Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): The commit in comment:1 says "Applied on top of a fix for #14667 it gives a 30% improvement". So that implies that you have a separate fix for this ticket. Can you * Characterise what causes the perf problem that this ticket identifies? * Describe your proposed fix? If you want to revert Simon M's patch you'd better discuss it with him. Perhaps he had a case that was improved by it. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 19 04:49:33 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 19 Jan 2018 04:49:33 -0000 Subject: [GHC] #14685: Pragma to reset language extensions in module header Message-ID: <046.75c67bbcb38b410120138cff6ee76ba2@haskell.org> #14685: Pragma to reset language extensions in module header -------------------------------------+------------------------------------- Reporter: mgsloan | Owner: (none) Type: feature | Status: new request | Priority: normal | Milestone: Component: Compiler | Version: 8.2.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: -------------------------------------+------------------------------------- In https://github.com/commercialhaskell/stack/issues/3789 , there is an issue where if OverloadableStrings is enabled in default extensions, the Paths_ module generated by cabal no longer compiles. I've opened a fix here - https://github.com/haskell/cabal/pull/5054 . However, this just disables specific extensions known to be problematic. It would be better to have a pragma that says "Please reset the extensions used for this module". I propose {{{ {-# LANGUAGE_RESET Haskell2010 #-} }}} and {{{ {-# LANGUAGE_RESET Haskell98 #-} }}} This would also provide for quite a nice workaround for the most common source of trouble when loading multiple packages at once into ghci - default-extensions causing some code to no longer compile. See https://ghc.haskell.org/trac/ghc/ticket/10827 for more about this. With `LANGUAGE_RESET`, we could write packages that gracefully load along with other packages that specify default-extensions. Of course, this is open to name bikeshedding. `{-# SET_LANGUAGE Haskell98 #-}`? Or perhaps just straight up `{-# HASKELL_98 #-}`. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 19 07:46:32 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 19 Jan 2018 07:46:32 -0000 Subject: [GHC] #14686: -XStrict language extension makes behavior change Message-ID: <044.f9e219711e13050888a5438f5b55d41d@haskell.org> #14686: -XStrict language extension makes behavior change -------------------------------------+------------------------------------- Reporter: jeiea | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.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: -------------------------------------+------------------------------------- In the below code without language pragma it prints 0, and it is expected. With language pragma, it doesn't terminate. I don't know whether it is intended to evaluate unnecessary where term and why it doesn't terminate. {{{ {-# LANGUAGE Strict #-} shouldBe0 :: Int -> Int shouldBe0 l = if l <= 0 then l else shouldBe0 (l - 1) where res = shouldBe0 (l - 1) main :: IO () main = print $ shouldBe0 1 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 19 08:34:26 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 19 Jan 2018 08:34:26 -0000 Subject: [GHC] #14686: -XStrict language extension makes behavior change In-Reply-To: <044.f9e219711e13050888a5438f5b55d41d@haskell.org> References: <044.f9e219711e13050888a5438f5b55d41d@haskell.org> Message-ID: <059.74a8d258c89de8ac4ac4fef85ba0414d@haskell.org> #14686: -XStrict language extension makes behavior change -------------------------------------+------------------------------------- Reporter: jeiea | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: invalid | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * status: new => closed * resolution: => invalid Comment: With `-XStrict`, the `where` binding is strict (see 10.28.3 in [http://downloads.haskell.org/~ghc/master/users-guide/glasgow_exts.html #bang-patterns-and-strict-haskell the user manual]). So every call to `shouldBe0 x` calls `shouldBe0 (x-1)`, which calls `shouldBe0 (x-2)` and so on. Hence divergence. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 19 08:42:23 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 19 Jan 2018 08:42:23 -0000 Subject: [GHC] #14683: Slow compile times for Happy-generated source In-Reply-To: <050.c267d901f7aabb72ea60ae5332333f63@haskell.org> References: <050.c267d901f7aabb72ea60ae5332333f63@haskell.org> Message-ID: <065.19cb921c281869890d89a4b77fbe9296@haskell.org> #14683: Slow compile times for Happy-generated source -------------------------------------+------------------------------------- Reporter: harpocrates | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by cblp): * cc: cblp (added) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 19 09:13:55 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 19 Jan 2018 09:13:55 -0000 Subject: [GHC] #13253: Exponential compilation time with RWST & ReaderT stack with `-02` In-Reply-To: <045.b3c468c50b4e8e33ee0981a3ab0c6b4b@haskell.org> References: <045.b3c468c50b4e8e33ee0981a3ab0c6b4b@haskell.org> Message-ID: <060.fc505d5eb8b5082180df7f73d98fe3b8@haskell.org> #13253: Exponential compilation time with RWST & ReaderT stack with `-02` -------------------------------------+------------------------------------- Reporter: phadej | Owner: bgamari, osa1 Type: bug | Status: new Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.0.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by osa1): I checked Core outputs of gameteb generated with and without this patch. What happens with this patch is we don't inline some join points that allocates `Int`s, so we end up allocating more `Int`s than before. In gameteb project these files change with this patch: - InitTable - Output - Utils Changes in InitTable and Output do not cause any increase in allocations. In Utils we generate join points like this: {{{ eIndx_s686 [Dmd=] :: Int [LclId] eIndx_s686 = let { wild_a4If [Dmd=] :: Int [LclId, Unf=OtherCon []] wild_a4If = GHC.Types.I# 1# } in case logE_s687 of { GHC.Types.D# x_a364 -> case ergs of { GHC.Arr.Array l_a5Ty u_a5Tz dt_a5TA ds_a5TB -> case l_a5Ty of wild3_s6zo { GHC.Types.I# m_s6zp -> case u_a5Tz of wild4_s6zr { GHC.Types.I# n_s6zs -> join { $j_s68y [Dmd=] :: Int [LclId[JoinId(0)], Str=x] $j_s68y = exit_r6GT wild_a4If wild3_s6zo wild4_s6zr } in case GHC.Prim.<=# m_s6zp 1# of { __DEFAULT -> jump $j_s68y; 1# -> ... }}} notice the `Int` allocation in `wild_a4If`, which is referenced by the join point. Without this patch, this code is simplified to: {{{ eIndx_s68j [Dmd=] :: Int [LclId] eIndx_s68j = case logE_s68k of { GHC.Types.D# x_a362 -> case ergs of { GHC.Arr.Array l_a5TL u_a5TM dt_a5TN ds_a5TO -> case l_a5TL of wild2_s6zD { GHC.Types.I# m_s6zE -> case u_a5TM of wild3_s6zG { GHC.Types.I# n_s6zH -> case GHC.Prim.<=# m_s6zE 1# of { __DEFAULT -> exit_r6Hk 1# wild2_s6zD wild3_s6zG; 1# -> ... }}} In this version the `exit` function called with `1#` instead of an `Int`. There are a few changes that all look like this. I tried running both versions with -ticky, but couldn't make sense of the output yet. I think the code explains the increase though so maybe we don't need -ticky output. I'll now look at what reduced allocationsin `mate`. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 19 09:30:02 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 19 Jan 2018 09:30:02 -0000 Subject: [GHC] #14685: Pragma to reset language extensions in module header In-Reply-To: <046.75c67bbcb38b410120138cff6ee76ba2@haskell.org> References: <046.75c67bbcb38b410120138cff6ee76ba2@haskell.org> Message-ID: <061.4501e0fca6b344923df05d23ed7248f4@haskell.org> #14685: Pragma to reset language extensions in module header -------------------------------------+------------------------------------- Reporter: mgsloan | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by hvr): *Sigh* We don't need the overkill of a new pragma; we'd just need something like `{-# OPTIONS_GHC -X #-}` which resets any `-X...` flags set before the compiler encounters the `-X` flag via `OPTIONS_GHC` ; just like `-i` resets all include paths. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 19 10:27:52 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 19 Jan 2018 10:27:52 -0000 Subject: [GHC] #14685: Pragma to reset language extensions in module header In-Reply-To: <046.75c67bbcb38b410120138cff6ee76ba2@haskell.org> References: <046.75c67bbcb38b410120138cff6ee76ba2@haskell.org> Message-ID: <061.46bdf2db69ff85653edbe31182f8638b@haskell.org> #14685: Pragma to reset language extensions in module header -------------------------------------+------------------------------------- Reporter: mgsloan | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by mgsloan): *Sigh* You think I didn't consider something like that? When convenient, I strongly prefer to write code that is compatible with older versions of the tools we use, unless there is a strong reason to do otherwise. I particularly appreciate it when others do the same.... :| With all prior versions, your suggestion would result in {{{ foo.hs:1:16: error: unknown flag in {-# OPTIONS_GHC #-} pragma: -X }}} With my proposal, it results in {{{ foo.hs:1:1: warning: [-Wunrecognised-pragmas] Unrecognised pragma }}} That said, having `-X` mean the same thing would be consistent with `-i` and the like, so that could be considered. I think that flag convention is really weird, but it is at least consistent. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 19 10:38:01 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 19 Jan 2018 10:38:01 -0000 Subject: [GHC] #14687: Investigate differences in Int-In/Outlining Message-ID: <047.b0b99a4233b5f30dbf7b15ebf4360dd1@haskell.org> #14687: Investigate differences in Int-In/Outlining -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.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: -------------------------------------+------------------------------------- In one case the numbers get floated out and in the others they stay in the alternative. This results in one being compiled as a CAF while the other gets recreated on the heap. {{{ {-# LANGUAGE MagicHash, BangPatterns, ScopedTypeVariables #-} import GHC.Prim import GHC.Exts func :: Int# -> Int# -> Int func 1# 1# = 10 func 1# 2# = 20 foo :: Int# -> Int# -> Int foo 1# 1# = 30 foo 2# 1# = 40 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 19 10:38:48 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 19 Jan 2018 10:38:48 -0000 Subject: [GHC] #14687: Investigate differences in Int-In/Outlining In-Reply-To: <047.b0b99a4233b5f30dbf7b15ebf4360dd1@haskell.org> References: <047.b0b99a4233b5f30dbf7b15ebf4360dd1@haskell.org> Message-ID: <062.242d17dd3efc96c464f02992e8c44a62@haskell.org> #14687: Investigate differences in Int-In/Outlining -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: mpickering Type: task | Status: new Priority: lowest | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by mpickering): * owner: (none) => mpickering * priority: normal => lowest -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 19 11:18:51 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 19 Jan 2018 11:18:51 -0000 Subject: [GHC] #14685: Pragma to reset language extensions in module header In-Reply-To: <046.75c67bbcb38b410120138cff6ee76ba2@haskell.org> References: <046.75c67bbcb38b410120138cff6ee76ba2@haskell.org> Message-ID: <061.c61a52a98c3e9df140eca0d39b6196f5@haskell.org> #14685: Pragma to reset language extensions in module header -------------------------------------+------------------------------------- Reporter: mgsloan | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by mgsloan): I have considered it a it a bit, and my proposal does indeed imply a bit of a fiddly difference in build semantics depending on version. It turns out that I'd usually want that difference, because my primary use-case is protecting code from variation in extensions used by the build. However, if the protection is not possible, I still want it to try to build. I guess this ugly incantation could be used. {{{ {-# LANGUAGE CPP #-} #if __GLASGOW_HASKELL__ >= 804 {-# OPTIONS_GHC -X #-} #endif }}} So, if one cares about behavior consistency `LANGUAGE_RESET` should only be used as a protection from varying build configurations, *not* as a way to turn off all the default options from your package configuration. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 19 13:19:46 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 19 Jan 2018 13:19:46 -0000 Subject: [GHC] #14688: Note [Lone variables] leads to missing a case-of-case opportunity Message-ID: <049.49a076b467188eb35828b1dabac9ffe9@haskell.org> #14688: Note [Lone variables] leads to missing a case-of-case opportunity -------------------------------------+------------------------------------- Reporter: mpickering | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.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: -------------------------------------+------------------------------------- After the simplifier, my program ends up in the following state. {{{ foo = \f s -> let x = case s of { T1 a b -> a :> b :> Nil } in fmap (\v -> case x of { _v1 :> vs -> T1 v (case vs of {v2 :> _ -> v2}) }) (f (case x of {v1 :> _ -> v1})) }}} Now if I understand `Note [Lone variables]` correctly, `x` is NOT inlined into the call sites, no matter what I do as `x` is work-free. However, this is bad as if we were to inline `x` we get a case-of-case opportunity. {{{ => Inline foo = \f s -> let x = case s of { T1 a b -> a :> b :> Nil } in fmap (\v -> case (case s of { T1 a b -> a :> b :> Nil }) of { _v1 :> vs -> T1 v (case vs of {v2 :> _ -> v2}) }) (f (case x of {v1 :> _ -> v1})) => case of case foo = \f s -> let x = case s of { T1 a b -> a :> b :> Nil } in fmap (\v -> case s of { T1 a b -> case (a :> b :> Nil) of { _v1 :> vs -> T1 v (case vs of {v2 :> _ -> v2}) }) (f (case x of {v1 :> _ -> v1})) => case of known constructor foo = \f s -> let x = case s of { T1 a b -> a :> b :> Nil } in fmap (\v -> case s of { T1 a b -> T1 v b}) (f (case x of {v1 :> _ -> v1})) => Same for the other branch foo = \f s -> fmap (\v -> case s of { T1 a b -> T1 v b}) (case s of T1 a b -> a) }}} Which no longer mentions the intermediate representation. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 19 14:06:43 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 19 Jan 2018 14:06:43 -0000 Subject: [GHC] #14689: Load order of .ghci config files is counterintuitive Message-ID: <050.b87151fcae6e630e6dfb4d15d5b0bf91@haskell.org> #14689: Load order of .ghci config files is counterintuitive -------------------------------------+------------------------------------- Reporter: hal9zillion | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: GHCi | Version: 8.2.2 Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: #14250, #6017 Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- Basically ghci seems to give precedence to global .ghci conguration settings by applying them after any local/project specific .ghci files: https://github.com/ghc/ghc/blob/314bc31489f1f4cd69e913c3b1e33236b2bdf553/ghc/GHCi/UI.hs#L561 OTOH there are a couple of open issues where people dont like the idea of local ghci evaluation for security reasons: #6017 #14250 I suggest the following resolution: - Change the order or evaluation from global first to local - include a new ghci setting that prevents/enables the evaluation of local/project specific .ghci files for people who wish to avoid the security concerns some people have - This flag can then be set in the global .ghci file I believe this would both address the counterintuitive loading strategy implied currently (i was convinced local .ghci files didnt work because when i changed the prompt it was always overwritten by my global config) and the security question. The only question then would be if evaluation of project/local .ghci files would be on or off by default. I would favour the former but that is just personal preference. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 19 14:33:07 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 19 Jan 2018 14:33:07 -0000 Subject: [GHC] #14667: Compiling a function with a lot of alternatives bottlenecks on insertIntHeap In-Reply-To: <046.bf8bb91dd6a70996717f1ecc929e7901@haskell.org> References: <046.bf8bb91dd6a70996717f1ecc929e7901@haskell.org> Message-ID: <061.3a4fc25dbae7256984f0003d8acb7257@haskell.org> #14667: Compiling a function with a lot of alternatives bottlenecks on insertIntHeap -------------------------------------+------------------------------------- Reporter: niteria | Owner: niteria Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonmar): That diff of mine basically replaces a set with a list, so it's not entirely surprising that it can be responsible for something being accidentally quadratic. I think at the time it was a small improvement because N was small in everything I measured, and for small N a list is a bit faster than an IntSet, but again it's not entirely surprising to find that it's possible to make it behave badly. I'm totally fine with reverting it, but do a nofib run first to check for adverse effects. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 19 15:15:38 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 19 Jan 2018 15:15:38 -0000 Subject: [GHC] #13253: Exponential compilation time with RWST & ReaderT stack with `-02` In-Reply-To: <045.b3c468c50b4e8e33ee0981a3ab0c6b4b@haskell.org> References: <045.b3c468c50b4e8e33ee0981a3ab0c6b4b@haskell.org> Message-ID: <060.057ad6604be2bfd98eb36f552e140316@haskell.org> #13253: Exponential compilation time with RWST & ReaderT stack with `-02` -------------------------------------+------------------------------------- Reporter: phadej | Owner: bgamari, osa1 Type: bug | Status: new Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.0.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by osa1): In `mate` there are various simple changes that doesn't change allocation, but `Move.hs` changes quite significantly so I'll need to investigate more to see what join point inlining is causing this reduction in allocations and why. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 19 15:41:48 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 19 Jan 2018 15:41:48 -0000 Subject: [GHC] #14690: Pattern match failure in GHCi with :steplocal Message-ID: <048.4ac9679edbe0cbd1f570bf129c521a7d@haskell.org> #14690: Pattern match failure in GHCi with :steplocal --------------------------------------+--------------------------------- Reporter: Philonous | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Keywords: | Operating System: Linux Architecture: x86_64 (amd64) | Type of failure: None/Unknown Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: --------------------------------------+--------------------------------- Using steplocal after breaking on an exception leads to GHCI giving a pattern match error Minimal testcase: {{{ Prelude> :set -fbreak-on-exception Prelude> error "abc" Stopped in , _exception :: e = _ [] [] Prelude> :steplocal *** Exception: Pattern match failure in do expression at ghc/GHCi/UI.hs:3149:12-18 }}} :step works as expected. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 19 15:42:22 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 19 Jan 2018 15:42:22 -0000 Subject: [GHC] #14690: Pattern match failure in GHCi with :steplocal In-Reply-To: <048.4ac9679edbe0cbd1f570bf129c521a7d@haskell.org> References: <048.4ac9679edbe0cbd1f570bf129c521a7d@haskell.org> Message-ID: <063.c31685de48daccd1455871f3fee22c78@haskell.org> #14690: Pattern match failure in GHCi with :steplocal ---------------------------------+-------------------------------------- Reporter: Philonous | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: GHCi | Version: 8.2.2 Resolution: | Keywords: Operating System: Linux | Architecture: x86_64 (amd64) Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | ---------------------------------+-------------------------------------- Changes (by Philonous): * component: Compiler => GHCi -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 19 16:59:34 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 19 Jan 2018 16:59:34 -0000 Subject: [GHC] #14667: Compiling a function with a lot of alternatives bottlenecks on insertIntHeap In-Reply-To: <046.bf8bb91dd6a70996717f1ecc929e7901@haskell.org> References: <046.bf8bb91dd6a70996717f1ecc929e7901@haskell.org> Message-ID: <061.58c00066d49c5c83f1671295737f6289@haskell.org> #14667: Compiling a function with a lot of alternatives bottlenecks on insertIntHeap -------------------------------------+------------------------------------- Reporter: niteria | Owner: niteria Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): I wonder ''why'' you replaced a set with a list? Was it just perf? Doing so would yield at best a small perf improvement. In any case, a well-implemented set abstraction should probably keep small sets as lists anyway (if that's a perf improvement). If it doesn't, it'd be better to improve the set abstraction than to commit to a list regardless of size. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 19 17:15:12 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 19 Jan 2018 17:15:12 -0000 Subject: [GHC] #14688: Note [Lone variables] leads to missing a case-of-case opportunity In-Reply-To: <049.49a076b467188eb35828b1dabac9ffe9@haskell.org> References: <049.49a076b467188eb35828b1dabac9ffe9@haskell.org> Message-ID: <064.c449c4df29e0a15cbf17ed2833e4647b@haskell.org> #14688: Note [Lone variables] leads to missing a case-of-case opportunity -------------------------------------+------------------------------------- Reporter: mpickering | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Crumbs, you are right. Looking at the `Note [Lone variables]` I see {{{ Fundamentally such contexts should not encourage inlining because the context can ``see'' the unfolding of the variable (e.g. case or a RULE) so there's no gain. If the thing is bound to a value. ... So the non-inlining of lone_variables should only apply if the unfolding is regarded as cheap; because that is when exprIsConApp_maybe looks through the unfolding. Hence the "&& is_wf" in the InlineRule branch. }}} But actually `exprIsConApp_maybe` uses `expandUnfolding_maybe` to look through the unfolding, which in turn uses the `uf_expandable` field of the unfolding, not the `uf_is_work_free` field. Conclusion: the test in `interesting_call` in `tryUnfolding` (at `Note [Lone variable]`) should not test `is_wf` but rather `is_exp`. That's an extremely simple, local change. Can you try it? I think it'll fix your problem. If it does, could you do a nofib comparison, before and after? Thanks. This looks promising. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 19 17:59:35 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 19 Jan 2018 17:59:35 -0000 Subject: [GHC] #14672: Make likelyhood of branches/conditions available throughout the compiler. In-Reply-To: <047.de2c13e36902d9be8400d9448aa09671@haskell.org> References: <047.de2c13e36902d9be8400d9448aa09671@haskell.org> Message-ID: <062.39e4ad58a98917a42ba2fa27d5a11494@haskell.org> #14672: Make likelyhood of branches/conditions available throughout the compiler. -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4316 Wiki Page: | Phab:D4324 Phab:D4327 -------------------------------------+------------------------------------- Changes (by AndreasK): * differential: Phab:D4316 Phab:D4324 => Phab:D4316 Phab:D4324 Phab:D4327 Comment: I've created Phab:D4327 for now as a proof of concept. * The diff alone improves runtime by about 0.8% for the parts of nofib I looked at. * It only covers the case where we have a branch that is recognized as being bottom. * It doesn't change asm codegen outside of simple cases. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 19 18:54:03 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 19 Jan 2018 18:54:03 -0000 Subject: [GHC] #14624: capi panic (toCType Int#) In-Reply-To: <049.18489252b85eb82ec89c6d1f7eb8a625@haskell.org> References: <049.18489252b85eb82ec89c6d1f7eb8a625@haskell.org> Message-ID: <064.95714b0d16c5b5adda61b37556d2fff7@haskell.org> #14624: capi panic (toCType Int#) -------------------------------------+------------------------------------- Reporter: tianxiaogu | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler (FFI) | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: #9274 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by hvr): * related: => #9274 Comment: Oh dear, this is another instance of #9274 (see add85cc2a3ec0bda810dca2a35264308ffaab069 for a hint on how to fix this instance here). -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 19 19:01:01 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 19 Jan 2018 19:01:01 -0000 Subject: [GHC] #14690: Pattern match failure in GHCi with :steplocal In-Reply-To: <048.4ac9679edbe0cbd1f570bf129c521a7d@haskell.org> References: <048.4ac9679edbe0cbd1f570bf129c521a7d@haskell.org> Message-ID: <063.4621d4c13e4ea8b79c72ed224de7463d@haskell.org> #14690: Pattern match failure in GHCi with :steplocal ---------------------------------+-------------------------------------- Reporter: Philonous | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: GHCi | Version: 8.2.2 Resolution: | Keywords: debugger Operating System: Linux | Architecture: x86_64 (amd64) Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | ---------------------------------+-------------------------------------- Changes (by RyanGlScott): * keywords: => debugger -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 19 20:15:38 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 19 Jan 2018 20:15:38 -0000 Subject: [GHC] #14691: Replace EvTerm with CoreExpr Message-ID: <046.62945affcc6cc14a9778d709349ac741@haskell.org> #14691: Replace EvTerm with CoreExpr -------------------------------------+------------------------------------- Reporter: nomeata | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.3 (Type checker) | 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 asked > I had some funky idea where a type checker plugin would have to | synthesize code for a custom-solved instances on the fly. But it seems that does not work because EvTerm is less expressive than Core (especially, no lambdas) > > What would break if we had > {{{ > | EvExpr CoreExpr > }}} > as an additional constructor there? And Simon said > This has come up before. I think that'd be a solid win. > > In fact, eliminate all the existing evidence constructors with "smart constructors" that produce an EvExpr. That'd mean moving stuff from the desugarer into these smart constructors, but that's ok. > > I /think/ I didn't do that initially only because there were very few forms and it mean that there was no CoreExpr stuff in the type checker. But as we add more forms that decision looks and less good. > > You'd need to add `zonkCoreExpr` in place of `zonkEvTerm`. > > `evVarsOfTerm` is called quite a bit; you might want to cache the result in the `EvExpr` constructor. This ticket tracks it. Not sure if i get to it right away, but I am happy to advise, review, and play around with the result. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 19 23:07:02 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 19 Jan 2018 23:07:02 -0000 Subject: [GHC] #14691: Replace EvTerm with CoreExpr In-Reply-To: <046.62945affcc6cc14a9778d709349ac741@haskell.org> References: <046.62945affcc6cc14a9778d709349ac741@haskell.org> Message-ID: <061.6946afb8b0fd322c6045d0d488fc27f1@haskell.org> #14691: Replace EvTerm with CoreExpr -------------------------------------+------------------------------------- Reporter: nomeata | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.3 checker) | Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by nomeata): Is it correct that the `evVarsOfTerm` are those free variables of the expression for which `isEvVar` is true, i.e. {{{ evVarsOfTerm evExpr = filter isEvVar (exprFreeVars (dsEvTerm evExpr)) }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 19 23:13:10 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 19 Jan 2018 23:13:10 -0000 Subject: [GHC] #14691: Replace EvTerm with CoreExpr In-Reply-To: <046.62945affcc6cc14a9778d709349ac741@haskell.org> References: <046.62945affcc6cc14a9778d709349ac741@haskell.org> Message-ID: <061.bcb8585dca818760087d52fd6cdc19fe@haskell.org> #14691: Replace EvTerm with CoreExpr -------------------------------------+------------------------------------- Reporter: nomeata | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.3 checker) | Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by nomeata): > `evVarsOfTerm` is called quite a bit; you might want to cache the result in the EvExpr constructor. `evVarsOfTerm` is not cached at the moment. Do you think that `exprSomeFreeVars isEvVar` is going to be significantly slower? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Jan 20 00:13:06 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 20 Jan 2018 00:13:06 -0000 Subject: [GHC] #14691: Replace EvTerm with CoreExpr In-Reply-To: <046.62945affcc6cc14a9778d709349ac741@haskell.org> References: <046.62945affcc6cc14a9778d709349ac741@haskell.org> Message-ID: <061.4dfa7f94ca5be648876c887a089d15d2@haskell.org> #14691: Replace EvTerm with CoreExpr -------------------------------------+------------------------------------- Reporter: nomeata | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.3 checker) | Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by nomeata): Prelimary work in `wip/14691`. But here is slight refactoring annoyance: The code from `dsEvTerm` would have to move into the new smart constructors, e.g. `evTypeable`, which replaces `EvTypable`. But the former is monadic (in `DsM`, to lookup things), while the latter is pure. So the uses of these smart constructors need to be made monadic. It seems to affect `evTypeable`, `evCallStack` and `evLit`, it looks like the other smart constructors can remain pure. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Jan 20 00:45:45 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 20 Jan 2018 00:45:45 -0000 Subject: [GHC] #14683: Slow compile times for Happy-generated source In-Reply-To: <050.c267d901f7aabb72ea60ae5332333f63@haskell.org> References: <050.c267d901f7aabb72ea60ae5332333f63@haskell.org> Message-ID: <065.d179d725fb6c7cb3cf7e743bf6618112@haskell.org> #14683: Slow compile times for Happy-generated source -------------------------------------+------------------------------------- Reporter: harpocrates | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by bernie): I believe this issue is causing a massive slow down in the compilation of the language-python library (https://github.com/bjpop/language-python). It used to take a couple of minutes to compile the library, now it takes 7 hours with ghc 8.2.1. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Jan 20 01:30:55 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 20 Jan 2018 01:30:55 -0000 Subject: [GHC] #14682: Atrocious parenthesization in -ddump-deriv output In-Reply-To: <050.412b21184a592fb4a8dbe5aa08fc49f9@haskell.org> References: <050.412b21184a592fb4a8dbe5aa08fc49f9@haskell.org> Message-ID: <065.cb08c6bf6d101d5f5a16645f39639cd4@haskell.org> #14682: Atrocious parenthesization in -ddump-deriv output -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.2.2 Resolution: fixed | Keywords: deriving Operating System: Unknown/Multiple | Architecture: Type of failure: Debugging | Unknown/Multiple information is incorrect | Test Case: Blocked By: | Blocking: Related Tickets: #14681 | Differential Rev(s): Phab:D4323 Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: merge => closed * resolution: => fixed Comment: Merged in 33e3b3eb55cb6cfa4abc7f57581066779a046626. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Jan 20 01:31:10 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 20 Jan 2018 01:31:10 -0000 Subject: [GHC] #14273: Typed holes' "valid substitutions" suggestions are oblivious to type class constraints In-Reply-To: <050.ec57930d289b450ca4924847bd0d6061@haskell.org> References: <050.ec57930d289b450ca4924847bd0d6061@haskell.org> Message-ID: <065.536507298281230c717f097fa059b81d@haskell.org> #14273: Typed holes' "valid substitutions" suggestions are oblivious to type class constraints -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: Tritlo Type: bug | Status: merge Priority: normal | Milestone: 8.4.1 Component: Compiler (Type | Version: 8.3 checker) | Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Poor/confusing | Unknown/Multiple error message | Test Case: Blocked By: | Blocking: Related Tickets: #9091, #9479 | Differential Rev(s): Phab:D4315 Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): Merged in 96b52e63b850f8072b905ca232b5644efc011b37. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Jan 20 01:31:15 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 20 Jan 2018 01:31:15 -0000 Subject: [GHC] #14273: Typed holes' "valid substitutions" suggestions are oblivious to type class constraints In-Reply-To: <050.ec57930d289b450ca4924847bd0d6061@haskell.org> References: <050.ec57930d289b450ca4924847bd0d6061@haskell.org> Message-ID: <065.a93beab14b71f888ee7c5afddde401ec@haskell.org> #14273: Typed holes' "valid substitutions" suggestions are oblivious to type class constraints -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: Tritlo Type: bug | Status: closed Priority: normal | Milestone: 8.4.1 Component: Compiler (Type | Version: 8.3 checker) | Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Poor/confusing | Unknown/Multiple error message | Test Case: Blocked By: | Blocking: Related Tickets: #9091, #9479 | Differential Rev(s): Phab:D4315 Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: merge => closed * resolution: => fixed -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Jan 20 01:31:36 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 20 Jan 2018 01:31:36 -0000 Subject: [GHC] #14652: Allow different executable names on windows In-Reply-To: <047.e6a3bc01cad203df066c1a713b94ac37@haskell.org> References: <047.e6a3bc01cad203df066c1a713b94ac37@haskell.org> Message-ID: <062.fa7891ef18a4ed1b0ef418275e7cf0df@haskell.org> #14652: Allow different executable names on windows -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: AndreasK Type: task | Status: closed Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: Resolution: fixed | Keywords: Operating System: Windows | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4296 Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: merge => closed * resolution: => fixed Comment: Merged in 4eccca7e298c08a35f099bd146aedaaf2b853dcf. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Jan 20 01:31:55 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 20 Jan 2018 01:31:55 -0000 Subject: [GHC] #14653: Text missing in ghc-prim's documentation In-Reply-To: <046.609bd988f60cb8a028f94fdc7c2f2e0a@haskell.org> References: <046.609bd988f60cb8a028f94fdc7c2f2e0a@haskell.org> Message-ID: <061.ac15fadd5d0ac7e25c2505210ba67fcb@haskell.org> #14653: Text missing in ghc-prim's documentation -------------------------------------+------------------------------------- Reporter: gallais | Owner: sighingnow Type: bug | Status: closed Priority: normal | Milestone: 8.4.1 Component: libraries | Version: 8.2.2 (other) | Keywords: ghc-prim, Resolution: fixed | newcomer Operating System: Unknown/Multiple | Architecture: Type of failure: Documentation | Unknown/Multiple bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4305 Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: merge => closed * resolution: => fixed Comment: Merged in f28645c04958a2e2ab61239db70478d9dcce6ba6. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Jan 20 14:48:18 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 20 Jan 2018 14:48:18 -0000 Subject: [GHC] #14692: Deriving Show with -XEmptyDataDeriving cases on the wrong argument Message-ID: <050.daa718a12ed484d79844655f3157b47c@haskell.org> #14692: Deriving Show with -XEmptyDataDeriving cases on the wrong argument -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: high | Milestone: 8.4.1 Component: Compiler | Version: 8.4.1-alpha1 Keywords: deriving | Operating System: Unknown/Multiple Architecture: | Type of failure: Incorrect result Unknown/Multiple | at runtime Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- Running this program in GHC 8.4.1-alpha: {{{#!hs {-# LANGUAGE EmptyDataDeriving #-} {-# OPTIONS_GHC -ddump-deriv #-} module Main (main) where data Empty deriving Show loop :: Empty loop = let x = x in x main :: IO () main = print loop }}} One would expect this to loop infinitely at runtime, but in practice, that is not the case: {{{ $ /opt/ghc/8.4.1/bin/runghc Bug.hs ==================== Derived instances ==================== Derived class instances: instance GHC.Show.Show Main.Empty where GHC.Show.showsPrec z_a1Iu = case z_a1Iu of Derived type family instances: ==================== Filling in method body ==================== GHC.Show.Show [Main.Empty] GHC.Show.show = GHC.Show.$dmshow @(Main.Empty) ==================== Filling in method body ==================== GHC.Show.Show [Main.Empty] GHC.Show.showList = GHC.Show.$dmshowList @(Main.Empty) Bug.hs: Bug.hs:5:21-24: Non-exhaustive patterns in case }}} The `-ddump-deriv` output reveals why: the `showsPrec` implementation for `Empty` is casing on the //precedence// argument, not the actual value of type `Empty`! This results in the non-exhaustive patterns error. This is my fault, so I'll prepare a fix :) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Jan 20 15:26:48 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 20 Jan 2018 15:26:48 -0000 Subject: [GHC] #14372: CMM contains a bunch of tail-merging opportunities In-Reply-To: <048.1c543d9c1482e4763ed7a0bf48a66309@haskell.org> References: <048.1c543d9c1482e4763ed7a0bf48a66309@haskell.org> Message-ID: <063.bd9ea0a66172353c9575cb1b27855528@haskell.org> #14372: CMM contains a bunch of tail-merging opportunities -------------------------------------+------------------------------------- Reporter: heisenbug | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by michalt): * cc: michalt (added) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Jan 20 15:29:31 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 20 Jan 2018 15:29:31 -0000 Subject: [GHC] #14691: Replace EvTerm with CoreExpr In-Reply-To: <046.62945affcc6cc14a9778d709349ac741@haskell.org> References: <046.62945affcc6cc14a9778d709349ac741@haskell.org> Message-ID: <061.1ae53dafd401ab81ad3c561b9c8f6ba0@haskell.org> #14691: Replace EvTerm with CoreExpr -------------------------------------+------------------------------------- Reporter: nomeata | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.3 checker) | Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by nomeata): When moving this desugaring code into smart constructors that are run by the type checker, it need to be able ot use functions like `mkStringExprFS` which require `MonadThings`. But the type checker monad does not have a suitable instance: {{{ No instance for (HscTypes.MonadThings TcS) }}} Is that by design, or has just nobody bothered so far to create such an instance? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Jan 20 15:35:56 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 20 Jan 2018 15:35:56 -0000 Subject: [GHC] #14692: Deriving Show with -XEmptyDataDeriving cases on the wrong argument In-Reply-To: <050.daa718a12ed484d79844655f3157b47c@haskell.org> References: <050.daa718a12ed484d79844655f3157b47c@haskell.org> Message-ID: <065.5d059c3351beb626482c928a826899b8@haskell.org> #14692: Deriving Show with -XEmptyDataDeriving cases on the wrong argument -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: patch Priority: high | Milestone: 8.4.1 Component: Compiler | Version: 8.4.1-alpha1 Resolution: | Keywords: deriving Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect result | Unknown/Multiple at runtime | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4328 Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * status: new => patch * differential: => Phab:D4328 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Jan 20 16:39:12 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 20 Jan 2018 16:39:12 -0000 Subject: [GHC] #14669: 32-bit binaries sometimes throw a stack overflow on shutdown. (was: Executable finishing via unhandled exception results in segmentation fault on 32 bit Windows) In-Reply-To: <044.45c88c9a13190d9f2a70cd9b35309cc0@haskell.org> References: <044.45c88c9a13190d9f2a70cd9b35309cc0@haskell.org> Message-ID: <059.d23e2d59444f8926776206eca57cbdcb@haskell.org> #14669: 32-bit binaries sometimes throw a stack overflow on shutdown. -----------------------------------+---------------------------------- Reporter: sergv | Owner: (none) Type: bug | Status: infoneeded Priority: normal | Milestone: Component: Runtime System | Version: 8.2.1 Resolution: | Keywords: Operating System: Windows | Architecture: x86 Type of failure: Runtime crash | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -----------------------------------+---------------------------------- Comment (by Phyx-): Hmm that binary works fine for me... {{{ Tamar at Rage ~/ghc2> /r/HW.exe; echo $status Situation normal 0 }}} I'll try to find a Windows 7 machine to test on. Have you already tried on a different machine? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Jan 20 17:53:44 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 20 Jan 2018 17:53:44 -0000 Subject: [GHC] #14675: GHC 8.4.1 regression: segfault when loading doctest on a module with ANNs on Ubuntu 16.04 or later In-Reply-To: <050.c5c190ffbc3e4175e84536f4424d1ad2@haskell.org> References: <050.c5c190ffbc3e4175e84536f4424d1ad2@haskell.org> Message-ID: <065.71bf4df2106b92f70e0be6b6959defd1@haskell.org> #14675: GHC 8.4.1 regression: segfault when loading doctest on a module with ANNs on Ubuntu 16.04 or later -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.4.1 Component: GHC API | Version: 8.4.1-alpha1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Runtime crash | Test Case: Blocked By: | Blocking: Related Tickets: #14603 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by alpmestan): I started taking a look at this. First, I haven't been able to reproduce the issue on NixOS. So I started toying around in an Ubuntu 16.04 virtual machine, on which I installed ghc 8.2.2 and 8.4.1, both from hvr's PPA. And I can indeed reproduce the segmentation fault, only with 8.4.1 just like you. However, I started thinking that it might be nice to be able to use gdb to see exactly what code is being executed when the segfault happens. Then I built both the same commit from which hvr's ghc-8.4.1 was built as well as the tip of the 8.4.1 alpha1 branch, both with the quick flavour, the --enable-dwarf-unwind configure option and -g3 for the libs and the RTS. Now, for the fun part: I have _not_ been able to reproduce the bug with those builds of GHC. I'll start looking into the Debian build recipes used by hvr's PPA, with the hope of being able to build a gdb-friendly clone of hvr's 8.4.1 build that does have the bug but also allows me to look around right before it happens. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Jan 20 17:54:09 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 20 Jan 2018 17:54:09 -0000 Subject: [GHC] #14675: GHC 8.4.1 regression: segfault when loading doctest on a module with ANNs on Ubuntu 16.04 or later In-Reply-To: <050.c5c190ffbc3e4175e84536f4424d1ad2@haskell.org> References: <050.c5c190ffbc3e4175e84536f4424d1ad2@haskell.org> Message-ID: <065.7299c8df7a1388ec1163bcd97acbf1d6@haskell.org> #14675: GHC 8.4.1 regression: segfault when loading doctest on a module with ANNs on Ubuntu 16.04 or later -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: alpmestan Type: bug | Status: new Priority: highest | Milestone: 8.4.1 Component: GHC API | Version: 8.4.1-alpha1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Runtime crash | Test Case: Blocked By: | Blocking: Related Tickets: #14603 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by alpmestan): * owner: (none) => alpmestan -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Jan 20 18:17:09 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 20 Jan 2018 18:17:09 -0000 Subject: [GHC] #14661: Cannot derive (newtype I a b = I (F a -> F b) deriving newtype Category) for type family F In-Reply-To: <051.db51abc527e2395586903121a4d671be@haskell.org> References: <051.db51abc527e2395586903121a4d671be@haskell.org> Message-ID: <066.b3053cf2f1371b6972cbcfcd9ea2e831@haskell.org> #14661: Cannot derive (newtype I a b = I (F a -> F b) deriving newtype Category) for type family F -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: feature request | Status: closed Priority: normal | Milestone: Component: Compiler | Version: 8.4.1-alpha1 Resolution: wontfix | Keywords: | DerivingStrategies, deriving, | TypeFamilies Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Iceland_jack): Replying to [comment:9 simonpj]: > However, the new feature looks tantalisingly close. > This won't always work as Ryan points out, but sometimes. > And I suppose we could work that out. > > It seems rather elaborate though! I agree that it's tantalising, if you think it's a general enough solution, enough “bang for the buck” then re-open. But there is no hurry on my end, I'd like more examples that need this. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Jan 20 18:25:33 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 20 Jan 2018 18:25:33 -0000 Subject: [GHC] #14667: Compiling a function with a lot of alternatives bottlenecks on insertIntHeap In-Reply-To: <046.bf8bb91dd6a70996717f1ecc929e7901@haskell.org> References: <046.bf8bb91dd6a70996717f1ecc929e7901@haskell.org> Message-ID: <061.74149d00d583c35b0237f1323325e500@haskell.org> #14667: Compiling a function with a lot of alternatives bottlenecks on insertIntHeap -------------------------------------+------------------------------------- Reporter: niteria | Owner: niteria Type: bug | Status: patch Priority: normal | Milestone: Component: Compiler | Version: Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): phab:D4329 Wiki Page: | -------------------------------------+------------------------------------- Changes (by niteria): * status: new => patch * differential: => phab:D4329 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Jan 20 20:29:52 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 20 Jan 2018 20:29:52 -0000 Subject: [GHC] #14669: 32-bit binaries sometimes throw a stack overflow on shutdown. In-Reply-To: <044.45c88c9a13190d9f2a70cd9b35309cc0@haskell.org> References: <044.45c88c9a13190d9f2a70cd9b35309cc0@haskell.org> Message-ID: <059.e4e0d1c2778f1563649b998efc290493@haskell.org> #14669: 32-bit binaries sometimes throw a stack overflow on shutdown. -----------------------------------+---------------------------------- Reporter: sergv | Owner: (none) Type: bug | Status: infoneeded Priority: normal | Milestone: Component: Runtime System | Version: 8.2.1 Resolution: | Keywords: Operating System: Windows | Architecture: x86 Type of failure: Runtime crash | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -----------------------------------+---------------------------------- Comment (by sergv): This issue is really complicated in terms of how it could be reproduced. I've tried it on few Windows 7 machines and it worked correctly. The logs I sent are from vanilla Windows 7 virtual machine I have at home and it is reproducible there. I recall that https://ghc.haskell.org/trac/ghc/ticket/14081 had similar issues - perhaps it's some kind of Windows preference that enables more runtime checks and causes failures, but unfortunately I have absolutely no clue what that might be. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Jan 20 20:36:11 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 20 Jan 2018 20:36:11 -0000 Subject: [GHC] #14669: 32-bit binaries sometimes throw a stack overflow on shutdown. In-Reply-To: <044.45c88c9a13190d9f2a70cd9b35309cc0@haskell.org> References: <044.45c88c9a13190d9f2a70cd9b35309cc0@haskell.org> Message-ID: <059.f0eb22f027bba3350248f629c7828d80@haskell.org> #14669: 32-bit binaries sometimes throw a stack overflow on shutdown. -----------------------------------+---------------------------------- Reporter: sergv | Owner: (none) Type: bug | Status: infoneeded Priority: normal | Milestone: Component: Runtime System | Version: 8.2.1 Resolution: | Keywords: Operating System: Windows | Architecture: x86 Type of failure: Runtime crash | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -----------------------------------+---------------------------------- Comment (by sergv): After quite some trial and error I figured out why debug RTS works and release doesn't. It boils down to `gcc` compiler optimizations that RTS was compiled with - deubg is build with `-O0` and release with `-O2`. If I build debug RTS with `-O2`, `-O1` or `-Og` then I can reproduce the crash as well. However, the exact cause of the problem is not known yet. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 21 01:12:54 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 21 Jan 2018 01:12:54 -0000 Subject: [GHC] #14693: Computing imp_finst can take up significant amount of time Message-ID: <046.a9caa20b4ad6e8f61c2910051e03ba80@haskell.org> #14693: Computing imp_finst can take up significant amount of time -------------------------------------+------------------------------------- Reporter: niteria | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: (Type checker) | Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: Compile-time Unknown/Multiple | performance bug Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- I profiled a build of a production code base with thousands of modules and merging `imp_finsts` [1] from different imports came up on top taking up 9% of total compile time. I made a synthetic test case to reproduce the issue (see attached `generateModules`). The test case is basically multiple layers of modules where each module defines a type family instance through deriving Generic. The problem is quite obvious, `unionLists` is quadratic and `imp_finsts` just keeps growing with the size of the code base. [1] https://phabricator.haskell.org/diffusion/GHC/browse/master/compiler/typecheck/TcRnTypes.hs;575c009d9e4b25384ef984c09b2c54f909693e93$1398 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 21 01:13:21 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 21 Jan 2018 01:13:21 -0000 Subject: [GHC] #14693: Computing imp_finst can take up significant amount of time In-Reply-To: <046.a9caa20b4ad6e8f61c2910051e03ba80@haskell.org> References: <046.a9caa20b4ad6e8f61c2910051e03ba80@haskell.org> Message-ID: <061.1dbd27e0414ea00c9e1652529f88dd36@haskell.org> #14693: Computing imp_finst can take up significant amount of time -------------------------------------+------------------------------------- Reporter: niteria | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: checker) | Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by niteria): * Attachment "generateModules" added. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 21 01:14:35 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 21 Jan 2018 01:14:35 -0000 Subject: [GHC] #14694: Can't coerce given assumptions Message-ID: <051.a24047975aac3bbc5e443262dff8c929@haskell.org> #14694: Can't coerce given assumptions -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.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: -------------------------------------+------------------------------------- {{{ $ ghci -ignore-dot-ghci GHCi, version 8.5.20180105: http://www.haskell.org/ghc/ :? for help Prelude> newtype WF f a = WF (f a) Prelude> import Data.Coerce Prelude Data.Coerce> :set -XFlexibleContexts Prelude Data.Coerce> :t coerce :: Coercible (cat a b) (a -> f b) => cat a b -> (a -> WF f b) :1:1: error: • Couldn't match representation of type ‘cat1 a1 b1’ with that of ‘a1 -> WF f1 b1’ arising from a use of ‘coerce’ • In the expression: coerce :: Coercible (cat a b) (a -> f b) => cat a b -> (a -> WF f b) }}} I'm not sure if I've filed this before or if it's even a bug. But we know that `Coercible (a -> f b) (a -> WF f b)` so why doesn't this work? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 21 01:29:48 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 21 Jan 2018 01:29:48 -0000 Subject: [GHC] #14693: Computing imp_finst can take up significant amount of time In-Reply-To: <046.a9caa20b4ad6e8f61c2910051e03ba80@haskell.org> References: <046.a9caa20b4ad6e8f61c2910051e03ba80@haskell.org> Message-ID: <061.e1a5c02fef912e261ce3052aff85cf75@haskell.org> #14693: Computing imp_finst can take up significant amount of time -------------------------------------+------------------------------------- Reporter: niteria | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: checker) | Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by niteria): The natural way to fix this would be to change the type of `imp_finst` to `ModuleSet`. `imp_finst` is converted back and forth from `dep_finst :: [Module]` and if I don't change the type of `dep_finst` to `ModuleSet` as well, the conversion costs 20% increase in allocations on the generated test case. If I want change the type of `dep_finst` then the way we ensure determinism in `checkFamInsts` [1] needs to be rethought. Because I like neither choice, I came up with a small workaround. The idea is to compute the `imp_finsts` for all the imports outside `plusImportAvails` using a set. Here's a hacky implementation of the idea: {{{ diff --git a/compiler/rename/RnNames.hs b/compiler/rename/RnNames.hs index ae3f75b1d0..2866113497 100644 --- a/compiler/rename/RnNames.hs +++ b/compiler/rename/RnNames.hs @@ -179,14 +179,17 @@ rnImports imports = do where combine :: [(LImportDecl GhcRn, GlobalRdrEnv, ImportAvails, AnyHpcUsage)] -> ([LImportDecl GhcRn], GlobalRdrEnv, ImportAvails, AnyHpcUsage) - combine = foldr plus ([], emptyGlobalRdrEnv, emptyImportAvails, False) + combine zs = + let (a, b, c,d,e) = foldr plus ([], emptyGlobalRdrEnv, emptyImportAvails, False, emptyModuleSet) zs + in (a, b, c { imp_finsts = moduleSetElts e }, d) plus (decl, gbl_env1, imp_avails1,hpc_usage1) - (decls, gbl_env2, imp_avails2,hpc_usage2) + (decls, gbl_env2, imp_avails2,hpc_usage2,finsts) = ( decl:decls, gbl_env1 `plusGlobalRdrEnv` gbl_env2, - imp_avails1 `plusImportAvails` imp_avails2, - hpc_usage1 || hpc_usage2 ) + imp_avails1 { imp_finsts = [] } `plusImportAvails` imp_avails2, + hpc_usage1 || hpc_usage2, + extendModuleSetList finsts (imp_finsts imp_avails1)) -- | Given a located import declaration @decl@ from @this_mod@, -- calculate the following pieces of information: }}} This makes the problem disappear from my profile and speeds up the test case from `10.7s` to `6.23s`. [1] https://phabricator.haskell.org/diffusion/GHC/browse/master/compiler/typecheck/FamInst.hs;575c009d9e4b25384ef984c09b2c54f909693e93$346-364 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 21 08:25:13 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 21 Jan 2018 08:25:13 -0000 Subject: [GHC] #13253: Exponential compilation time with RWST & ReaderT stack with `-02` In-Reply-To: <045.b3c468c50b4e8e33ee0981a3ab0c6b4b@haskell.org> References: <045.b3c468c50b4e8e33ee0981a3ab0c6b4b@haskell.org> Message-ID: <060.2291e40cbc67b99a88ce524caa680cab@haskell.org> #13253: Exponential compilation time with RWST & ReaderT stack with `-02` -------------------------------------+------------------------------------- Reporter: phadej | Owner: bgamari, osa1 Type: bug | Status: new Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.0.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by osa1): ManyConstructors outputs are exactly the same with and without this patch, so any changes in the stats should be because of the compiler itself doing the same work more or less efficiently. In T13056 there's only a small difference, with this patch there's this join point: {{{ join { ds1_s5PK [Dmd=] :: base-4.11.0.0:Data.Semigroup.Internal.Any [LclId[JoinId(0)]] ds1_s5PK = jump go_a5kA ys_a5kH } }}} this is inlined without this patch. I doubt this will make any difference though because this is just a single jump. So to answer > Are those perf/compiler improvements happening because (a) GHC is generating less code of (b) GHC's code is running faster? I think these are because GHC's code is running faster. FWIW, on my laptop this patch does not cause any perf failures. When I look at the stats files for these two tests I see that with this patch GHC allocates less in T13056 but more in ManyConstructors (just a few MB difference). Other stats differ (sometimes better with this patch, sometimes worse) but only very small amounts. Overall I don't get any perf failures. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 21 09:51:43 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 21 Jan 2018 09:51:43 -0000 Subject: [GHC] #14695: ghc --interactive error: "gcc: error: libgmp.so: No such file or directory" Message-ID: <043.14a5c82c2a46e2165050d731a268a622@haskell.org> #14695: ghc --interactive error: "gcc: error: libgmp.so: No such file or directory" -------------------------------------+------------------------------------- Reporter: osa1 | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 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 get this error when I run hello world with `ghci` or `runghc`: {{{ $ ghc-stage2 --interactive Hello.hs GHCi, version 8.5.20180117: http://www.haskell.org/ghc/ :? for help gcc: error: libgmp.so: No such file or directory gcc: fatal error: no input files compilation terminated. `gcc' failed in phase `gcc'. (Exit code: 1) }}} It works with 8.2.2's `runghc` and `ghci` so it seems like a regression to me. This also causes validate failure on my laptop, because at one point validate script runs `runghc`. OS: Xubuntu 16.04.2 `libgmp.so` location: {{{ ➜ ~ locate libgmp.so /usr/lib/x86_64-linux-gnu/libgmp.so /usr/lib/x86_64-linux-gnu/libgmp.so.10 /usr/lib/x86_64-linux-gnu/libgmp.so.10.3.0 /usr/lib/x86_64-linux-gnu/openssl-1.0.0/engines/libgmp.so }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 21 11:39:30 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 21 Jan 2018 11:39:30 -0000 Subject: [GHC] #14695: ghc --interactive error: "gcc: error: libgmp.so: No such file or directory" In-Reply-To: <043.14a5c82c2a46e2165050d731a268a622@haskell.org> References: <043.14a5c82c2a46e2165050d731a268a622@haskell.org> Message-ID: <058.32eacbf2c783861909729f5577ad5de6@haskell.org> #14695: ghc --interactive error: "gcc: error: libgmp.so: No such file or directory" -------------------------------------+------------------------------------- Reporter: osa1 | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by osa1): `-v3` output: {{{ $ ghc-stage2 --interactive -v3 GHCi, version 8.5.20180117: http://www.haskell.org/ghc/ :? for help Glasgow Haskell Compiler, Version 8.5.20180117, stage 2 booted by GHC version 8.2.2 Using binary package database: /home/omer/haskell/ghc_2/inplace/lib/package.conf.d/package.cache Using binary package database: /home/omer/.ghc/x86_64-linux-8.5.20180117/package.conf.d/package.cache package flags [] loading package database /home/omer/haskell/ghc_2/inplace/lib/package.conf.d loading package database /home/omer/.ghc/x86_64-linux-8.5.20180117/package.conf.d wired-in package ghc-prim mapped to ghc-prim-0.5.2.0 wired-in package integer-gmp mapped to integer-gmp-1.0.1.0 wired-in package base mapped to base-4.11.0.0 wired-in package rts mapped to rts wired-in package template-haskell mapped to template-haskell-2.13.0.0 wired-in package ghc mapped to ghc-8.5 wired-in package dph-seq not found. wired-in package dph-par not found. *** Parser [source]: !!! Parser [source]: finished in 0.51 milliseconds, allocated 0.266 megabytes *** Desugar: *** Simplify [expr]: !!! Simplify [expr]: finished in 0.18 milliseconds, allocated 0.120 megabytes *** CorePrep [expr]: !!! CorePrep [expr]: finished in 15.25 milliseconds, allocated 1.425 megabytes *** ByteCodeGen [Ghci1]: !!! ByteCodeGen [Ghci1]: finished in 0.12 milliseconds, allocated 0.132 megabytes Loading package ghc-prim-0.5.2.0 ... linking ... done. *** gcc: gcc -fno-stack-protector -DTABLES_NEXT_TO_CODE '-fuse-ld=gold' -B/home/omer/haskell/ghc_2/libraries/integer-gmp/dist-install/build -B/home/omer/lib -B/home/omer/lib64 -B --print-file-name libgmp.so gcc: error: libgmp.so: No such file or directory gcc: fatal error: no input files compilation terminated. *** Deleting temp files: Deleting: *** Deleting temp dirs: Deleting: `gcc' failed in phase `gcc'. (Exit code: 1) }}} gcc version: {{{ $ gcc --version gcc (Ubuntu 5.4.0-6ubuntu1~16.04.5) 5.4.0 20160609 Copyright (C) 2015 Free Software Foundation, Inc. This is free software; see the source for copying conditions. There is NO warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 21 11:48:35 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 21 Jan 2018 11:48:35 -0000 Subject: [GHC] #14695: ghc --interactive error: "gcc: error: libgmp.so: No such file or directory" In-Reply-To: <043.14a5c82c2a46e2165050d731a268a622@haskell.org> References: <043.14a5c82c2a46e2165050d731a268a622@haskell.org> Message-ID: <058.ccdf7707a75454ce09105cb2a94b5355@haskell.org> #14695: ghc --interactive error: "gcc: error: libgmp.so: No such file or directory" -------------------------------------+------------------------------------- Reporter: osa1 | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by osa1): We debugged this with AndreasK on IRC, it turns out this part of the gcc command: {{{ -B --print-file-name }}} causes gcc to not run in `--print-file-name` mode because `-B` is missing an argument, and `--print-file-name` is parsed as the argument for `-B`. So the question is now "why -B doesn't have an argument?". -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 21 11:50:56 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 21 Jan 2018 11:50:56 -0000 Subject: [GHC] #14695: ghc --interactive error: "gcc: error: libgmp.so: No such file or directory" In-Reply-To: <043.14a5c82c2a46e2165050d731a268a622@haskell.org> References: <043.14a5c82c2a46e2165050d731a268a622@haskell.org> Message-ID: <058.2de6ce785da9d0543152c5c3f48cc01e@haskell.org> #14695: ghc --interactive error: "gcc: error: libgmp.so: No such file or directory" -------------------------------------+------------------------------------- Reporter: osa1 | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by osa1): This is caused by a trailing `:` in my env variables. Specifically, {{{ export LIBRARY_PATH=/home/omer/lib:/home/omer/lib64: }}} breaks it. If I remove the trailing `:` it works. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 21 13:06:44 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 21 Jan 2018 13:06:44 -0000 Subject: [GHC] #14696: basement package fails to compile Message-ID: <050.12e87447db7cc5de91b7e8da1f3c2d5c@haskell.org> #14696: basement package fails to compile -----------------------------------+---------------------------- Reporter: asyropoulos | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Keywords: | Operating System: Solaris Architecture: x86 | Type of failure: Other Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -----------------------------------+---------------------------- I have noticed that the basement package faisl to compile on Solaris. However, the following patch solves the problem. diff -Naur basement-0.0.6/Basement/Terminal/Size.hsc basement-0.0.6.new/Basement/Terminal/Size.hsc --- basement-0.0.6/Basement/Terminal/Size.hsc 2017-11-11 19:03:59.000000000 +0000 +++ basement-0.0.6.new/Basement/Terminal/Size.hsc 2018-01-21 15:03:03.899338329 +0000 @@ -20,6 +20,9 @@ #include #elif defined FOUNDATION_SYSTEM_UNIX #include +#ifdef __sun +#include +#endif #endif #include -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 21 13:41:12 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 21 Jan 2018 13:41:12 -0000 Subject: [GHC] #14691: Replace EvTerm with CoreExpr In-Reply-To: <046.62945affcc6cc14a9778d709349ac741@haskell.org> References: <046.62945affcc6cc14a9778d709349ac741@haskell.org> Message-ID: <061.f90e0e20496b3942e6d44c8d4d94dbb6@haskell.org> #14691: Replace EvTerm with CoreExpr -------------------------------------+------------------------------------- Reporter: nomeata | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.3 checker) | Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by nomeata): When zonking a `CoreExpr`, is there a need to zonk inside a `Tickish`? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 21 14:03:19 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 21 Jan 2018 14:03:19 -0000 Subject: [GHC] #14695: ghc --interactive error: "gcc: error: libgmp.so: No such file or directory" In-Reply-To: <043.14a5c82c2a46e2165050d731a268a622@haskell.org> References: <043.14a5c82c2a46e2165050d731a268a622@haskell.org> Message-ID: <058.ffabc855dc2d5204bcaa221d93bc6c18@haskell.org> #14695: ghc --interactive error: "gcc: error: libgmp.so: No such file or directory" -------------------------------------+------------------------------------- Reporter: osa1 | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: Component: Compiler | Version: Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4330 Wiki Page: | -------------------------------------+------------------------------------- Changes (by osa1): * status: new => patch * differential: => Phab:D4330 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 21 14:57:17 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 21 Jan 2018 14:57:17 -0000 Subject: [GHC] #14691: Replace EvTerm with CoreExpr In-Reply-To: <046.62945affcc6cc14a9778d709349ac741@haskell.org> References: <046.62945affcc6cc14a9778d709349ac741@haskell.org> Message-ID: <061.dd8cd58f8feb80b52979a699e954c5a4@haskell.org> #14691: Replace EvTerm with CoreExpr -------------------------------------+------------------------------------- Reporter: nomeata | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.3 checker) | Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by nomeata): Ok, `wip/14691` has a complete refactoring. Time to address the fallout, and advise is welcome… I get {{{ libraries/base/Data/Typeable/Internal.hs:1:1: error: GHC internal error: ‘mkTrCon’ is not in scope during type checking, but it passed the renamer }}} It seems that this code: {{{ ds_ev_typeable :: MonadThings m => Type -> EvTypeable -> m CoreExpr ds_ev_typeable ty (EvTypeableTyCon tc kind_ev) = do { mkTrCon <- lookupId mkTrConName … }}} does not quite work when the current module is `Data.Typeable.Internal`, which is where `mkTrCon` is defined. Do I need a smarter `lookupId` that checks if the given `name` is supposed to be defined in the current module, and then uses the local name, rather than trying to find the global name? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 21 15:25:29 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 21 Jan 2018 15:25:29 -0000 Subject: [GHC] #14696: basement package fails to compile In-Reply-To: <050.12e87447db7cc5de91b7e8da1f3c2d5c@haskell.org> References: <050.12e87447db7cc5de91b7e8da1f3c2d5c@haskell.org> Message-ID: <065.0950003d4e6986ddb7cfde8a2b9ff154@haskell.org> #14696: basement package fails to compile --------------------------------+-------------------------------- Reporter: asyropoulos | Owner: (none) Type: bug | Status: upstream Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Solaris | Architecture: x86 Type of failure: Other | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | --------------------------------+-------------------------------- Changes (by bgamari): * status: new => upstream Comment: It sounds to me like this is a bug in `basement`, not GHC. Perhaps you could file a ticket with [[https://github.com/haskell- foundation/foundation|upstream]]? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 21 15:58:35 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 21 Jan 2018 15:58:35 -0000 Subject: [GHC] #14335: Annotations aren't supported with -fexternal-interpreter In-Reply-To: <046.25c38c823cb7fca986641ffde5e3cbd0@haskell.org> References: <046.25c38c823cb7fca986641ffde5e3cbd0@haskell.org> Message-ID: <061.744809783326c4e441a199c53de5e50c@haskell.org> #14335: Annotations aren't supported with -fexternal-interpreter -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.2.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: T14335 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Ben Gamari ): In [changeset:"5e8ea6a62e948bcc0da1279f06844fd1d8e979bd/ghc" 5e8ea6a/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="5e8ea6a62e948bcc0da1279f06844fd1d8e979bd" testsuite: Add test for #14335 Subscribers: rwbarton, thomie GHC Trac Issues: #14335 Differential Revision: https://phabricator.haskell.org/D4202 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 21 16:10:55 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 21 Jan 2018 16:10:55 -0000 Subject: [GHC] #2988: Improve float-in In-Reply-To: <046.83e28bfdd70de8fbe4dfb2a2f0f105d9@haskell.org> References: <046.83e28bfdd70de8fbe4dfb2a2f0f105d9@haskell.org> Message-ID: <061.857a6f53a6330ff307280a40a5403101@haskell.org> #2988: Improve float-in -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: task | Status: new Priority: lowest | Milestone: Component: Compiler | Version: 6.10.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * milestone: 8.4.1 => Comment: Simon, I seem to recall one of your somewhat recent simplifier patches did something like this. Is it possible this is now fixed? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 21 16:12:04 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 21 Jan 2018 16:12:04 -0000 Subject: [GHC] #2725: Remove Hack in compiler/nativeGen/X86/CodeGen.hs In-Reply-To: <046.d67fe0f29d3ab9719210cf02d0142851@haskell.org> References: <046.d67fe0f29d3ab9719210cf02d0142851@haskell.org> Message-ID: <061.6cf518b537b7abb2349d5abb75d8cdad@haskell.org> #2725: Remove Hack in compiler/nativeGen/X86/CodeGen.hs -------------------------------------+------------------------------------- Reporter: clemens | Owner: thoughtpolice Type: task | Status: new Priority: low | Milestone: 8.6.1 Component: Compiler (NCG) | Version: 6.11 Resolution: | Keywords: codegen Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * milestone: 8.4.1 => 8.6.1 Comment: I tried to remove this hack again but the affected linker versions are still too prevalent. I suspect we'll have to wait a few more years for this. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 21 16:16:24 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 21 Jan 2018 16:16:24 -0000 Subject: [GHC] Batch modify: #5291, #5302, #7723, #9249, #9981, #10582, #10930, ... In-Reply-To: <109.361f579bf1908934dfcd6c3657b801a0@haskell.org> References: <109.361f579bf1908934dfcd6c3657b801a0@haskell.org> Message-ID: <124.b757ac0d588d34b096e8c8d1aa33403f@haskell.org> Batch modification to #5291, #5302, #7723, #9249, #9981, #10582, #10930, #11091, #11958, #13039, #13064, #13182, #13779 by bgamari: milestone to Comment: These tasks won't happen for 8.4 and have been sitting at low priority for quite some time. Consequently I am un-milestoning them. Don't let this stop you, the interested reader, from picking one up, however. -- Tickets URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 21 16:16:52 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 21 Jan 2018 16:16:52 -0000 Subject: [GHC] #11958: Improved testing of cross-compiler In-Reply-To: <044.199977cda1889326e5e53eb484e40895@haskell.org> References: <044.199977cda1889326e5e53eb484e40895@haskell.org> Message-ID: <059.14e54e6778907cfdd2bc8aa20f579b71@haskell.org> #11958: Improved testing of cross-compiler -------------------------------------+------------------------------------- Reporter: erikd | Owner: bgamari Type: task | Status: new Priority: low | Milestone: 8.4.1 Component: Continuous | Version: 7.10.3 Integration | Resolution: | Keywords: cross-compile Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #13716 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * owner: (none) => bgamari * component: Test Suite => Continuous Integration * milestone: => 8.4.1 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 21 16:17:08 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 21 Jan 2018 16:17:08 -0000 Subject: [GHC] #14696: basement package fails to compile In-Reply-To: <050.12e87447db7cc5de91b7e8da1f3c2d5c@haskell.org> References: <050.12e87447db7cc5de91b7e8da1f3c2d5c@haskell.org> Message-ID: <065.be17da67ada1e32e367ce5ba4aaed4ea@haskell.org> #14696: basement package fails to compile --------------------------------+-------------------------------- Reporter: asyropoulos | Owner: (none) Type: bug | Status: upstream Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Solaris | Architecture: x86 Type of failure: Other | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | --------------------------------+-------------------------------- Comment (by asyropoulos): Thank you very much for the suggestion. I have already submitted a bug report. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 21 16:17:42 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 21 Jan 2018 16:17:42 -0000 Subject: [GHC] #11091: Fix MonadFail warnings In-Reply-To: <045.9ee4c703624749a10bd1943bc0d2d686@haskell.org> References: <045.9ee4c703624749a10bd1943bc0d2d686@haskell.org> Message-ID: <060.1cfea13fb2d53368dbefa55f4faf2b55@haskell.org> #11091: Fix MonadFail warnings -------------------------------------+------------------------------------- Reporter: quchen | Owner: (none) Type: task | Status: closed Priority: low | Milestone: 8.4.1 Component: Compiler | Version: 7.11 Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect | Unknown/Multiple warning at compile-time | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: new => closed * resolution: => fixed * milestone: => 8.4.1 Comment: I believe this is done. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 21 16:18:27 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 21 Jan 2018 16:18:27 -0000 Subject: [GHC] #7723: iOS patch no 12: Itimer.c doesn't work on iOS In-Reply-To: <056.9767e70565312fbbb95062bfdcdf193a@haskell.org> References: <056.9767e70565312fbbb95062bfdcdf193a@haskell.org> Message-ID: <071.c3714210a6f2ba2b8b733cf900801269@haskell.org> #7723: iOS patch no 12: Itimer.c doesn't work on iOS --------------------------------------+------------------------------ Reporter: StephenBlackheath | Owner: (none) Type: bug | Status: closed Priority: low | Milestone: 8.4.1 Component: Runtime System | Version: 7.7 Resolution: fixed | Keywords: Operating System: Other | Architecture: arm Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | --------------------------------------+------------------------------ Changes (by bgamari): * status: infoneeded => closed * cc: angerman (added) * resolution: => fixed * milestone: => 8.4.1 Comment: I'm going to assume that this is resolved or otherwise abandoned. Moritz, do re-open this if I am mistaken. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 21 16:20:32 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 21 Jan 2018 16:20:32 -0000 Subject: [GHC] #6132: Can't use both shebang line and #ifdef declarations in the same file. In-Reply-To: <046.5a1fb6c2a5c75e33d964893f8930e4ec@haskell.org> References: <046.5a1fb6c2a5c75e33d964893f8930e4ec@haskell.org> Message-ID: <061.24c8bb1ada0ed7f64ef90a86be540ee4@haskell.org> #6132: Can't use both shebang line and #ifdef declarations in the same file. -------------------------------------+------------------------------------- Reporter: gfxmonk | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.0.4 (Parser) | Resolution: | Keywords: cpp Operating System: MacOS X | Architecture: Type of failure: GHC rejects | Unknown/Multiple valid program | Test Case: runghc/T6132 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * milestone: 8.4.1 => Comment: Removing milestone. Do yell if you are bitten by this. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 21 16:22:44 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 21 Jan 2018 16:22:44 -0000 Subject: [GHC] #11549: Add -fshow-runtime-rep In-Reply-To: <047.266b1817848e78f8afbd8fee6528ff72@haskell.org> References: <047.266b1817848e78f8afbd8fee6528ff72@haskell.org> Message-ID: <062.8f68d22ad145f6bcedc166690a60c3ee@haskell.org> #11549: Add -fshow-runtime-rep -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: ⊥ Component: Compiler | Version: 8.0.1-rc2 Resolution: | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D1961 Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * milestone: 8.4.1 => ⊥ Comment: Removing milestone in light of comment:18. I think #8809 is ultimately the way forward here. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 21 16:23:12 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 21 Jan 2018 16:23:12 -0000 Subject: [GHC] #6087: Join points need strictness analysis In-Reply-To: <046.87e3f1b25b2500e98f2a686fd50954f8@haskell.org> References: <046.87e3f1b25b2500e98f2a686fd50954f8@haskell.org> Message-ID: <061.a62d1ab54f6a4f4671f7479c942e13a7@haskell.org> #6087: Join points need strictness analysis -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: infoneeded Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 7.4.1 Resolution: | Keywords: JoinPoints 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: | -------------------------------------+------------------------------------- Comment (by bgamari): Simon, do you know the status of this? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 21 16:23:47 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 21 Jan 2018 16:23:47 -0000 Subject: [GHC] #11382: Optimize Data.Char In-Reply-To: <046.07b85d059cbd81601867717299b83062@haskell.org> References: <046.07b85d059cbd81601867717299b83062@haskell.org> Message-ID: <061.c60feb7d65d8aeabd5ae2b9502a6da33@haskell.org> #11382: Optimize Data.Char -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Core Libraries | Version: 7.10.3 Resolution: | Keywords: newcomer Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: #9638 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * keywords: => newcomer * milestone: 8.4.1 => -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 21 16:25:54 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 21 Jan 2018 16:25:54 -0000 Subject: [GHC] #11359: Consider removing RelaxedLayout and friends In-Reply-To: <046.26f295ac88026e78626730eb2098b22e@haskell.org> References: <046.26f295ac88026e78626730eb2098b22e@haskell.org> Message-ID: <061.fcbd70716867227ebbdf86604c19ebfb@haskell.org> #11359: Consider removing RelaxedLayout and friends -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: task | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 7.10.3 (Parser) | Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Other | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * milestone: 8.4.1 => 8.6.1 Comment: Perhaps we can do this in 8.6. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 21 16:28:14 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 21 Jan 2018 16:28:14 -0000 Subject: [GHC] Batch modify: #314, #605, #3094, #3427, #4879, #5611, #6087, ... In-Reply-To: <616.774c80fb19dd95b102f167f65aa54da2@haskell.org> References: <616.774c80fb19dd95b102f167f65aa54da2@haskell.org> Message-ID: <631.d75b6f14c4858b15c866a598a8914989@haskell.org> Batch modification to #314, #605, #3094, #3427, #4879, #5611, #6087, #6132, #7273, #7353, #7860, #8634, #8763, #9221, #9244, #9248, #9775, #9793, #10141, #10346, #10352, #10431, #10506, #10536, #10542, #10640, #10770, #10789, #10853, #10878, #10933, #10962, #11092, #11149, #11197, #11204, #11222, #11238, #11243, #11259, #11260, #11261, #11307, #11323, #11359, #11369, #11382, #11384, #11394, #11409, #11445, #11457, #11472, #11474, #11495, #11526, #11549, #11587, #11594, #11634, #11686, #11719, #11749, #11765, #11767, #11773, #11798, #11827, #11836, #11953, #11955, #12021, #12038, #12075, #12090, #12193, #12218, #12388, #12389, #12428, #12498, #12517, #12581, #12599, #12619, #12636, #12652, #12669, #12712, #12714, #12715, #12737, #12758, #12765, #12774, #12798, #12808, #12825, #12875, #12891 by bgamari: milestone to 8.6.1 Comment: This ticket won't be resolved in 8.4; remilestoning for 8.6. Do holler if you are affected by this or would otherwise like to work on it. -- Tickets URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 21 16:29:06 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 21 Jan 2018 16:29:06 -0000 Subject: [GHC] Batch modify: #12913, #12926, #12932, #12934, #12937, #12938, ... In-Reply-To: <636.8ea7debdf636c4a5a8cf9b5924e8b477@haskell.org> References: <636.8ea7debdf636c4a5a8cf9b5924e8b477@haskell.org> Message-ID: <651.de902b7c725089dabc0d9316c5465d8e@haskell.org> Batch modification to #12913, #12926, #12932, #12934, #12937, #12938, #12940, #12941, #12949, #12951, #12964, #12965, #12982, #12999, #13003, #13008, #13065, #13069, #13072, #13075, #13078, #13080, #13090, #13092, #13093, #13104, #13152, #13153, #13154, #13165, #13176, #13189, #13225, #13226, #13240, #13243, #13253, #13276, #13279, #13280, #13309, #13331, #13346, #13357, #13360, #13362, #13363, #13378, #13390, #13406, #13422, #13423, #13443, #13448, #13452, #13465, #13471, #13507, #13511, #13513, #13515, #13554, #13564, #13617, #13629, #13639, #13654, #13686, #13690, #13692, #13693, #13709, #13717, #13723, #13724, #13753, #13892, #13897, #13898, #13905, #13906, #13944, #13981, #14003, #14005, #14006, #14023, #14030, #14056, #14078, #14122, #14165, #14190, #14214, #14242, #14252, #14261, #14268, #14282, #14283 by bgamari: milestone to 8.6.1 Comment: This ticket won't be resolved in 8.4; remilestoning for 8.6. Do holler if you are affected by this or would otherwise like to work on it. -- Tickets URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 21 16:29:44 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 21 Jan 2018 16:29:44 -0000 Subject: [GHC] Batch modify: #14291, #14295, #14309, #14319, #14331, #14335, ... In-Reply-To: <174.160106604d646adad8f5044aec2532b4@haskell.org> References: <174.160106604d646adad8f5044aec2532b4@haskell.org> Message-ID: <189.abb18b26a1e9c159ff60bfe20c47fcfb@haskell.org> Batch modification to #14291, #14295, #14309, #14319, #14331, #14335, #14337, #14401, #14405, #14411, #14412, #14413, #14469, #14482, #14492, #14495, #14501, #14502, #14504, #14509, #14512, #14606, #14654 by bgamari: milestone to 8.6.1 Comment: This ticket won't be resolved in 8.4; remilestoning for 8.6. Do holler if you are affected by this or would otherwise like to work on it. -- Tickets URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 21 16:30:22 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 21 Jan 2018 16:30:22 -0000 Subject: [GHC] #12825: ghc panic on ppc64le, ghc 8.0.1, agda 2.5.1.1 patched for newer EdisonAPI In-Reply-To: <044.632ebd0cd498a6c31622b890d3f61cd2@haskell.org> References: <044.632ebd0cd498a6c31622b890d3f61cd2@haskell.org> Message-ID: <059.7914112a42a060bf44f187d3f42b6d66@haskell.org> #12825: ghc panic on ppc64le, ghc 8.0.1, agda 2.5.1.1 patched for newer EdisonAPI ---------------------------------+--------------------------------- Reporter: clint | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.0.1 Resolution: invalid | Keywords: Operating System: Linux | Architecture: powerpc64 Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | ---------------------------------+--------------------------------- Changes (by bgamari): * status: infoneeded => closed * resolution: => invalid Comment: Closing due to lack of reproducer. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 21 16:31:56 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 21 Jan 2018 16:31:56 -0000 Subject: [GHC] #14006: Heap profiling ghc gives hp2ps error In-Reply-To: <045.33d3453df6819e51591e1886ab5b1893@haskell.org> References: <045.33d3453df6819e51591e1886ab5b1893@haskell.org> Message-ID: <060.daa446f50f3dbc460ebf2a84ec5353d6@haskell.org> #14006: Heap profiling ghc gives hp2ps error -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: 8.6.1 Component: Runtime System | Version: 8.3 Resolution: duplicate | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Debugging | Unknown/Multiple information is incorrect | Test Case: Blocked By: | Blocking: Related Tickets: #11645, #14257 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: new => closed * resolution: => duplicate * related: #11645 => #11645, #14257 Comment: I believe this was another manifestation of #14257. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 21 16:33:57 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 21 Jan 2018 16:33:57 -0000 Subject: [GHC] #14122: Core lint error while compiling GHC.IO.Handle In-Reply-To: <046.2391c0290c34ee83dfcea71f37a050f4@haskell.org> References: <046.2391c0290c34ee83dfcea71f37a050f4@haskell.org> Message-ID: <061.05ed75198d200dcae30a26fae176d041@haskell.org> #14122: Core lint error while compiling GHC.IO.Handle -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.2.1 Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #14123 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: new => closed * resolution: => fixed * milestone: 8.6.1 => 8.4.1 Comment: Hmm, indeed I can't reproduce this now either, even with `-g3` in `GhcStage2HcOpts` and `GhcLibHcOpts`. I suppose we should just consider this to be resolved then. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 21 16:36:33 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 21 Jan 2018 16:36:33 -0000 Subject: [GHC] #14606: ghc-exactprint not up to date In-Reply-To: <044.eda8c95560814c75d9806634f1da14ed@haskell.org> References: <044.eda8c95560814c75d9806634f1da14ed@haskell.org> Message-ID: <059.de541922908dbe89791609e23a3619ef@haskell.org> #14606: ghc-exactprint not up to date -------------------------------------+------------------------------------- Reporter: alanz | Owner: alanz Type: task | Status: new Priority: normal | Milestone: 8.4.1 Component: GHC API | Version: 8.4.1-alpha1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * milestone: 8.6.1 => 8.4.1 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 21 16:38:03 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 21 Jan 2018 16:38:03 -0000 Subject: [GHC] #14495: Relocatable GHC In-Reply-To: <046.eee2e7ee2b5b793946317cc2c012eb42@haskell.org> References: <046.eee2e7ee2b5b793946317cc2c012eb42@haskell.org> Message-ID: <061.732ef5515fd0ff2924bb01ea39f18414@haskell.org> #14495: Relocatable GHC -------------------------------------+------------------------------------- Reporter: bgamari | Owner: angerman Type: feature request | Status: new Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.2.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * milestone: 8.6.1 => 8.4.1 Comment: This actually (hopefully) will make it for 8.4. Alp is currently working on this. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 21 16:39:15 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 21 Jan 2018 16:39:15 -0000 Subject: [GHC] #14056: Figure out what to do about libffi In-Reply-To: <046.2f5998c0c0f3e8ceedb396a3922fff3a@haskell.org> References: <046.2f5998c0c0f3e8ceedb396a3922fff3a@haskell.org> Message-ID: <061.528af1ee03d58c2f2611fbb8588b4763@haskell.org> #14056: Figure out what to do about libffi -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: task | Status: closed Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.0.1 Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: new => closed * resolution: => fixed * milestone: 8.6.1 => 8.4.1 Comment: For the record, we have started using a snapshot of `libffi` in e515c7f37be97e1c2ccc497ddd0a730e63ddfa82. Until an alternative to `libffi` presents itself this will have to do. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 21 16:39:57 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 21 Jan 2018 16:39:57 -0000 Subject: [GHC] #14691: Replace EvTerm with CoreExpr In-Reply-To: <046.62945affcc6cc14a9778d709349ac741@haskell.org> References: <046.62945affcc6cc14a9778d709349ac741@haskell.org> Message-ID: <061.a7749af46b96b8cd0b822acd94599782@haskell.org> #14691: Replace EvTerm with CoreExpr -------------------------------------+------------------------------------- Reporter: nomeata | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.3 checker) | Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by nomeata): > Do I need a smarter lookupId that checks if the given name is supposed to be defined in the current module, and then uses the local name, rather than trying to find the global name? It seems that `lookupId` (which is `tcLookupGlobal`) already does that. But maybe the local definitions are not in the environment properly at the time `TcInteract` does its work? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 21 16:40:28 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 21 Jan 2018 16:40:28 -0000 Subject: [GHC] #14155: GHC mentions unlifted types out of the blue (to me anyway) In-Reply-To: <051.e9a8763157e763f2ef920c4bfc2f101b@haskell.org> References: <051.e9a8763157e763f2ef920c4bfc2f101b@haskell.org> Message-ID: <066.4b6f23fd16af0a147da06735b6fb5ba7@haskell.org> #14155: GHC mentions unlifted types out of the blue (to me anyway) -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: high | Milestone: 8.4.1 Component: Compiler | Version: 8.2.1 Resolution: | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * priority: highest => high Comment: This doesn't seem like a truly "highest" priority issue. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 21 16:40:59 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 21 Jan 2018 16:40:59 -0000 Subject: [GHC] #14396: Hs-boot woes during family instance consistency checks In-Reply-To: <046.2ccc4fa31be03dddd3503a257243a5e2@haskell.org> References: <046.2ccc4fa31be03dddd3503a257243a5e2@haskell.org> Message-ID: <061.a29ee2c5205918f837b86095aa480f07@haskell.org> #14396: Hs-boot woes during family instance consistency checks -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.2.1 Resolution: fixed | Keywords: hs-boot Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4154 Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: patch => closed * resolution: => fixed * milestone: => 8.4.1 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 21 16:48:48 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 21 Jan 2018 16:48:48 -0000 Subject: [GHC] #14655: Compiled nofib-analyse executable segfaults under windows In-Reply-To: <047.44633c0d8f4acc4718fac822df06754c@haskell.org> References: <047.44633c0d8f4acc4718fac822df06754c@haskell.org> Message-ID: <062.63ae34bcb4a7c6887cfe36ad2bab1fcd@haskell.org> #14655: Compiled nofib-analyse executable segfaults under windows -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Runtime crash | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): To answer my question, yes, this also occurs in HEAD> -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 21 16:53:53 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 21 Jan 2018 16:53:53 -0000 Subject: [GHC] #11645: Heap profiling - hp2ps: samples out of sequence In-Reply-To: <045.b3866e053eb1eb6cf46e7327a6d7e479@haskell.org> References: <045.b3866e053eb1eb6cf46e7327a6d7e479@haskell.org> Message-ID: <060.b68831e24f6af4d5b2a622fb4c749aa0@haskell.org> #11645: Heap profiling - hp2ps: samples out of sequence -------------------------------------+------------------------------------- Reporter: thomie | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: 8.4.1 Component: Profiling | Version: 8.0.1-rc2 Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: | libraries/hpc/tests/fork/hpc_fork Blocked By: | Blocking: Related Tickets: #664, #14257 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: new => closed * resolution: => fixed * milestone: => 8.4.1 Comment: I believe this is another manifestation of #14257. I have verified that this can no longer be reproduced on `master`. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 21 17:11:03 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 21 Jan 2018 17:11:03 -0000 Subject: [GHC] #14123: Figure out invariants surrounding ticks in Core In-Reply-To: <046.0308c769b363c5285c5969fe8d556b65@haskell.org> References: <046.0308c769b363c5285c5969fe8d556b65@haskell.org> Message-ID: <061.d89828b454616e466deec41e79211845@haskell.org> #14123: Figure out invariants surrounding ticks in Core -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: task | Status: new Priority: highest | Milestone: 8.4.1 Component: Compiler | Version: 8.2.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #13233, #14122, | Differential Rev(s): #8472, #14406 | Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): Phab:D3925 is a differential that I was working on some time ago asserting that primitive strings aren't ticked. The fact that the assertion fails is a canary suggesting that something is amiss here. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 21 17:41:40 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 21 Jan 2018 17:41:40 -0000 Subject: [GHC] #14689: Load order of .ghci config files is counterintuitive In-Reply-To: <050.b87151fcae6e630e6dfb4d15d5b0bf91@haskell.org> References: <050.b87151fcae6e630e6dfb4d15d5b0bf91@haskell.org> Message-ID: <065.c46031d9a70531d9bb95232f4d24a174@haskell.org> #14689: Load order of .ghci config files is counterintuitive -------------------------------------+------------------------------------- Reporter: hal9zillion | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: GHCi | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #14250, #6017 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): It seems like this might benefit from a wider discussion facilitated by the [[https://github.com/ghc-proposals/ghc-proposals|GHC proposals process]]. Perhaps you would like to open a proposal? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 21 17:47:57 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 21 Jan 2018 17:47:57 -0000 Subject: [GHC] #14385: Clarify error message when missing GADTs extension In-Reply-To: <044.e15073ad95f4a8ec466187fd8001a2b6@haskell.org> References: <044.e15073ad95f4a8ec466187fd8001a2b6@haskell.org> Message-ID: <059.161d0e6ae48bdd84ca26df0f0c7fd8a0@haskell.org> #14385: Clarify error message when missing GADTs extension -------------------------------------+------------------------------------- Reporter: lyxia | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.2.1 Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4122 Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: new => closed * resolution: => fixed * milestone: => 8.4.1 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 21 17:53:35 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 21 Jan 2018 17:53:35 -0000 Subject: [GHC] #14683: Slow compile times for Happy-generated source In-Reply-To: <050.c267d901f7aabb72ea60ae5332333f63@haskell.org> References: <050.c267d901f7aabb72ea60ae5332333f63@haskell.org> Message-ID: <065.20220c4bde8fc1cafd1e5a007a3840aa@haskell.org> #14683: Slow compile times for Happy-generated source -------------------------------------+------------------------------------- Reporter: harpocrates | Owner: (none) Type: bug | Status: new Priority: high | Milestone: 8.4.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * cc: tdammers (added) * priority: normal => high * milestone: => 8.4.1 Comment: Tobias, perhaps you want to have a look at this when you are done with your current task? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 21 18:56:24 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 21 Jan 2018 18:56:24 -0000 Subject: [GHC] #14697: Redundant computation in fingerprintDynFlags when compiling many modules Message-ID: <046.c781f4e812a45b7f1a7576c9d7db1ab8@haskell.org> #14697: Redundant computation in fingerprintDynFlags when compiling many modules -------------------------------------+------------------------------------- Reporter: niteria | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: Compile-time Unknown/Multiple | performance bug Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- I profiled a build of a production code base with thousands of modules and computing `fingerprintDynFlags` is `7%` of time and `14%` of allocations. Here's a synthetic test case inspired by what I observed: {{{ SIZE=1000 for i in $(seq -w 1 $SIZE); do echo "module A$i where" > A$i.hs echo "data A$i = A$i" >> A$i.hs done }}} This generates a 1000 modules each with one datatype. Compiling them with: {{{ inplace/bin/ghc-stage2 A*.hs -optP-D__F{1..10000}__ }}} results in `fingerprintDynFlags` being the top cost centre in the profile. AFAICT there's only one module dependent piece that goes into computing `fingerprintDynFlags` and the rest is the same between those 1000 modules. Now, why would I have so many preprocessor flags? This is how the Buck build system currently works. If a Haskell library depends on a C++ library then the GHC invocation gets the C++ library's directory as include path (`-optP-I -optP-I some/library/path`). This can grow quite big. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 21 19:37:55 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 21 Jan 2018 19:37:55 -0000 Subject: [GHC] #14678: GHC 8.4.1-alpha's bundled transformers doesn't correspond to a tagged release In-Reply-To: <050.e45e5fc2b285549e2fcbcab2ac249ab8@haskell.org> References: <050.e45e5fc2b285549e2fcbcab2ac249ab8@haskell.org> Message-ID: <065.17d3f3d642496e2c0bc30f7439bd06db@haskell.org> #14678: GHC 8.4.1-alpha's bundled transformers doesn't correspond to a tagged release -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.4.1 Component: Compiler | Version: 8.4.1-alpha1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * priority: high => highest Comment: Unfortunately the fix here didn't quite make alpha2. Bumping to ensure this happens for alpha3. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 21 20:56:47 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 21 Jan 2018 20:56:47 -0000 Subject: [GHC] #14698: Cut STM release Message-ID: <046.c514496096a222bc1b6ef3f997b3783f@haskell.org> #14698: Cut STM release -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: task | Status: new Priority: highest | Milestone: 8.4.1 Component: Compiler | Version: 8.2.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: -------------------------------------+------------------------------------- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 21 20:59:41 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 21 Jan 2018 20:59:41 -0000 Subject: [GHC] #14699: Library status for 8.4.1 Message-ID: <046.12f775ea02060174a5ac178f457055aa@haskell.org> #14699: Library status for 8.4.1 -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: task | Status: new Priority: highest | Milestone: 8.4.1 Component: Compiler | Version: 8.2.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: -------------------------------------+------------------------------------- * `Cabal`: needs release * `Win32`: on-release * `array`: Needs revision * `binary`: on-release * `bytestring`: on-release * `containers`: needs release: https://github.com/haskell/containers/issues/501 * `deepseq`: needs revision * `directory`: on-release * `filepath`: needs release: https://github.com/haskell/filepath/issues/65 * `haskeline`: needs release: https://github.com/judah/haskeline/issues/75 * `hpc`: needs release * `mtl`: needs release: https://github.com/haskell/mtl/issues/52 * `parallel`: needs revision * `parsec`: needs release: https://github.com/haskell/parsec/issues/86 * `pretty`: needs release: https://github.com/haskell/pretty/issues/47 * `primitive`: needs release: https://github.com/haskell/primitive/issues/72 * `process`: needs release: https://github.com/haskell/primitive/issues/72 * `stm`: needs release: #14698 * `terminfo`: needs release: https://github.com/judah/terminfo/issues/27 * `text`: needs release: https://github.com/haskell/text/issues/215 * `time`: on-release * `transformers`: needs update: #14678 * `unix`: needs release: https://github.com/haskell/unix/issues/106 * `haddock`: needs release: https://github.com/haskell/haddock/issues/737 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 21 21:01:40 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 21 Jan 2018 21:01:40 -0000 Subject: [GHC] #14699: Library status for 8.4.1 In-Reply-To: <046.12f775ea02060174a5ac178f457055aa@haskell.org> References: <046.12f775ea02060174a5ac178f457055aa@haskell.org> Message-ID: <061.30b2b97ecc571cdc8a36cb0fb180026b@haskell.org> #14699: Library status for 8.4.1 -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: task | Status: new Priority: highest | Milestone: 8.4.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Description changed by bgamari: Old description: > * `Cabal`: needs release > * `Win32`: on-release > * `array`: Needs revision > * `binary`: on-release > * `bytestring`: on-release > * `containers`: needs release: > https://github.com/haskell/containers/issues/501 > * `deepseq`: needs revision > * `directory`: on-release > * `filepath`: needs release: > https://github.com/haskell/filepath/issues/65 > * `haskeline`: needs release: > https://github.com/judah/haskeline/issues/75 > * `hpc`: needs release > * `mtl`: needs release: https://github.com/haskell/mtl/issues/52 > * `parallel`: needs revision > * `parsec`: needs release: https://github.com/haskell/parsec/issues/86 > * `pretty`: needs release: https://github.com/haskell/pretty/issues/47 > * `primitive`: needs release: > https://github.com/haskell/primitive/issues/72 > * `process`: needs release: > https://github.com/haskell/primitive/issues/72 > * `stm`: needs release: #14698 > * `terminfo`: needs release: https://github.com/judah/terminfo/issues/27 > * `text`: needs release: https://github.com/haskell/text/issues/215 > * `time`: on-release > * `transformers`: needs update: #14678 > * `unix`: needs release: https://github.com/haskell/unix/issues/106 > * `haddock`: needs release: https://github.com/haskell/haddock/issues/737 New description: ||= package =||= status =||= reference =|| || `Cabal` || needs release || || || `Win32` || on-release || || || `array` || Needs revision || || || `binary` || on-release || || || `bytestring` || on-release || || || `containers` || needs release || https://github.com/haskell/containers/issues/501 || || `deepseq` || needs revision || || || `directory` || on-release || || || `filepath` || needs release || https://github.com/haskell/filepath/issues/65 || || `haskeline` || needs release || https://github.com/judah/haskeline/issues/75 || || `hpc` || needs release || || || `mtl` || needs release || https://github.com/haskell/mtl/issues/52 || || `parallel` || needs revision || || || `parsec` || needs release || https://github.com/haskell/parsec/issues/86 || || `pretty` || needs release || https://github.com/haskell/pretty/issues/47 || || `primitive` || needs release || https://github.com/haskell/primitive/issues/72 || || `process` || needs release || https://github.com/haskell/primitive/issues/72 || || `stm` || needs release || #14698 || || `terminfo` || needs release || https://github.com/judah/terminfo/issues/27 || || `text` || needs release || https://github.com/haskell/text/issues/215 || || `time` || on-release || || || `transformers` || needs update || #14678 || || `unix` || needs release || https://github.com/haskell/unix/issues/106 || || `haddock` || needs release || https://github.com/haskell/haddock/issues/737 || -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 21 21:36:50 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 21 Jan 2018 21:36:50 -0000 Subject: [GHC] #14669: 32-bit binaries sometimes throw a stack overflow on shutdown. In-Reply-To: <044.45c88c9a13190d9f2a70cd9b35309cc0@haskell.org> References: <044.45c88c9a13190d9f2a70cd9b35309cc0@haskell.org> Message-ID: <059.34c8b64f914baec3b688f0efec277f49@haskell.org> #14669: 32-bit binaries sometimes throw a stack overflow on shutdown. -----------------------------------+---------------------------------- Reporter: sergv | Owner: (none) Type: bug | Status: infoneeded Priority: normal | Milestone: Component: Runtime System | Version: 8.2.1 Resolution: | Keywords: Operating System: Windows | Architecture: x86 Type of failure: Runtime crash | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -----------------------------------+---------------------------------- Comment (by Phyx-): Ok, compile the rts with `-Og -g`, recompile your example and run it in gdb. `gdb --args HW.exe`. Once it crashes get a backtrace using `bt`. It's entirely possible the 32 bit version of GCC has issues. It's not tested or used as much as the 64 bit one unfortunately. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 00:21:26 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 00:21:26 -0000 Subject: [GHC] #14669: 32-bit binaries sometimes throw a stack overflow on shutdown. In-Reply-To: <044.45c88c9a13190d9f2a70cd9b35309cc0@haskell.org> References: <044.45c88c9a13190d9f2a70cd9b35309cc0@haskell.org> Message-ID: <059.b4e2cd186813d23ade7f1913e6ad286d@haskell.org> #14669: 32-bit binaries sometimes throw a stack overflow on shutdown. -----------------------------------+---------------------------------- Reporter: sergv | Owner: (none) Type: bug | Status: infoneeded Priority: normal | Milestone: Component: Runtime System | Version: 8.2.1 Resolution: | Keywords: Operating System: Windows | Architecture: x86 Type of failure: Runtime crash | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -----------------------------------+---------------------------------- Comment (by sergv): Unfortunately, there's no informative backtrace to speak of: {{{ sergey at box /c/home/ghc/bugs/rts-investigations$ gdb --quiet -ex run --args ./HW.exe Reading symbols from ./HW.exe...done. Starting program: C:\home\ghc\bugs\rts-investigations\HW.exe [New Thread 2916.0x360] warning: `C:\Windows\SYSTEM32\ntdll.dll': Shared library architecture i386:x86-64 is not compatible with target architecture i386. warning: `C:\Windows\SYSTEM32\wow64.dll': Shared library architecture i386:x86-64 is not compatible with target architecture i386. warning: `C:\Windows\SYSTEM32\wow64win.dll': Shared library architecture i386:x86-64 is not compatible with target architecture i386. warning: `C:\Windows\SYSTEM32\wow64cpu.dll': Shared library architecture i386:x86-64 is not compatible with target architecture i386. warning: Could not load shared library symbols for WOW64_IMAGE_SECTION. Do you need "set solib-search-path" or "set sysroot"? warning: Could not load shared library symbols for WOW64_IMAGE_SECTION. Do you need "set solib-search-path" or "set sysroot"? warning: Could not load shared library symbols for NOT_AN_IMAGE. Do you need "set solib-search-path" or "set sysroot"? warning: Could not load shared library symbols for NOT_AN_IMAGE. Do you need "set solib-search-path" or "set sysroot"? [New Thread 2916.0x100] [New Thread 2916.0xe44] [New Thread 2916.0xdb0] Situation normal Thread 1 received signal SIGSEGV, Segmentation fault. 0x0000002b in ?? () (gdb) where #0 0x0000002b in ?? () #1 0x00788140 in n_capabilities () #2 0x01bde848 in ?? () #3 0x00000000 in ?? () (gdb) }}} However, I did narrow down the problem. Compiling `rts/StgCRun.c` with `-O0` fixes the issue, while compiling it with `-O1` reproduces the crash. Is there anything I can do to `StgCRun.c` to make locating the crash easier? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 01:39:31 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 01:39:31 -0000 Subject: [GHC] #14670: -XRebindableSyntax needs return? In-Reply-To: <048.c96b42d6aefe76220126edbb094e21e4@haskell.org> References: <048.c96b42d6aefe76220126edbb094e21e4@haskell.org> Message-ID: <063.01631287a7753f27d7822c805c24f1da@haskell.org> #14670: -XRebindableSyntax needs return? -------------------------------------+------------------------------------- Reporter: jackkelly | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: | RebindableSyntax Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: GHC rejects | Test Case: valid program | rebindable/T14670 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Ben Gamari ): In [changeset:"765ba657c08453615521f5cb0b2418512e606743/ghc" 765ba657/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="765ba657c08453615521f5cb0b2418512e606743" testsuite: Add testcase for #14670 Subscribers: rwbarton, thomie, carter GHC Trac Issues: #14670 Differential Revision: https://phabricator.haskell.org/D4314 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 01:39:31 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 01:39:31 -0000 Subject: [GHC] #14692: Deriving Show with -XEmptyDataDeriving cases on the wrong argument In-Reply-To: <050.daa718a12ed484d79844655f3157b47c@haskell.org> References: <050.daa718a12ed484d79844655f3157b47c@haskell.org> Message-ID: <065.4f07915d8a3d47c600a3017c65a0e7fb@haskell.org> #14692: Deriving Show with -XEmptyDataDeriving cases on the wrong argument -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: patch Priority: high | Milestone: 8.4.1 Component: Compiler | Version: 8.4.1-alpha1 Resolution: | Keywords: deriving Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect result | Unknown/Multiple at runtime | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4328 Wiki Page: | -------------------------------------+------------------------------------- Comment (by Ben Gamari ): In [changeset:"0074a08ea9dfd1416aa57a9504be73dcdf7a1e2b/ghc" 0074a08e/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="0074a08ea9dfd1416aa57a9504be73dcdf7a1e2b" Fix #14692 by correcting an off-by-one error in TcGenDeriv A silly mistake in `gen_Show_binds` was causing derived `Show` instances for empty data types to case on the precedence argument instead of the actual value being showed. Test Plan: make test TEST=drv-empty-data Reviewers: bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie, carter GHC Trac Issues: #14692 Differential Revision: https://phabricator.haskell.org/D4328 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 01:39:31 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 01:39:31 -0000 Subject: [GHC] #14206: Add bit deposit and bit extraction primops In-Reply-To: <047.2543734720307265ea1bddd575e5fddb@haskell.org> References: <047.2543734720307265ea1bddd575e5fddb@haskell.org> Message-ID: <062.957f318629dc969dc08d26f8f9187573@haskell.org> #14206: Add bit deposit and bit extraction primops -------------------------------------+------------------------------------- Reporter: newhoggy | Owner: (none) Type: feature request | Status: closed Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.2.1 Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Ben Gamari ): In [changeset:"f855769690eb998ea25818ee794714957852af48/ghc" f8557696/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="f855769690eb998ea25818ee794714957852af48" Add new mbmi and mbmi2 compiler flags This adds support for the bit deposit and extraction operations provided by the BMI and BMI2 instruction set extensions on modern amd64 machines. Implement x86 code generator for pdep and pext. Properly initialise bmiVersion field. pdep and pext test cases Fix pattern match for pdep and pext instructions Fix build of pdep and pext code for 32-bit architectures Test Plan: Validate Reviewers: austin, simonmar, bgamari, angerman Reviewed By: bgamari Subscribers: trommler, carter, angerman, thomie, rwbarton, newhoggy GHC Trac Issues: #14206 Differential Revision: https://phabricator.haskell.org/D4236 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 01:39:31 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 01:39:31 -0000 Subject: [GHC] #14635: Double stacktrace with errorWithCallStack In-Reply-To: <046.342ecdededd713faab2e8b8b0c796ed8@haskell.org> References: <046.342ecdededd713faab2e8b8b0c796ed8@haskell.org> Message-ID: <061.bb016cc205d7bd913968e2c24d43c80e@haskell.org> #14635: Double stacktrace with errorWithCallStack -------------------------------------+------------------------------------- Reporter: flip101 | Owner: alpmestan Type: bug | Status: patch Priority: normal | Milestone: Component: Documentation | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): D4317 Wiki Page: | -------------------------------------+------------------------------------- Comment (by Ben Gamari ): In [changeset:"5edb18a962cbfee0ff869b1a77ebf2cd79dd8ef5/ghc" 5edb18a9/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="5edb18a962cbfee0ff869b1a77ebf2cd79dd8ef5" tentative improvement to callstack docs This is an attempt at clarifying the docs for HasCallStack in both the user guide and libraries/base/GHC/Stack/Types.hs. The example used right now is built around an hypothetical 'error' function that doesn't itself print call stacks, and the fact that this doesn't hold makes it all confusing, see #14635. Reviewers: hvr, bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie, carter GHC Trac Issues: #14635 Differential Revision: https://phabricator.haskell.org/D4317 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 01:39:31 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 01:39:31 -0000 Subject: [GHC] #14473: Implement Underscores in Numeric Literals Proposal (NumericUnderscores extension) In-Reply-To: <047.9478e62bd80e36e2a95f7745037003bc@haskell.org> References: <047.9478e62bd80e36e2a95f7745037003bc@haskell.org> Message-ID: <062.df25611f049df6124cff588215070227@haskell.org> #14473: Implement Underscores in Numeric Literals Proposal (NumericUnderscores extension) -------------------------------------+------------------------------------- Reporter: takenobu | Owner: takenobu Type: task | Status: patch Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.2.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #13126 #9224 | Differential Rev(s): Phab:D4235 Wiki Page: | -------------------------------------+------------------------------------- Comment (by Ben Gamari ): In [changeset:"4a13c5b1f4beb53cbf1f3529acdf3ba37528e694/ghc" 4a13c5b1/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="4a13c5b1f4beb53cbf1f3529acdf3ba37528e694" Implement underscores in numeric literals (NumericUnderscores extension) Implement the proposal of underscores in numeric literals. Underscores in numeric literals are simply ignored. The specification of the feature is available here: https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/000 9-numeric-underscores.rst For a discussion of the various choices: https://github.com/ghc-proposals/ghc-proposals/pull/76 Implementation detail: * Added dynamic flag * `NumericUnderscores` extension flag is added for this feature. * Alex "Regular expression macros" in Lexer.x * Add `@numspc` (numeric spacer) macro to represent multiple underscores. * Modify `@decimal`, `@decimal`, `@binary`, `@octal`, `@hexadecimal`, `@exponent`, and `@bin_exponent` macros to include `@numspc`. * Alex "Rules" in Lexer.x * To be simpler, we have only the definitions with underscores. And then we have a separate function (`tok_integral` and `tok_frac`) that validates the literals. * Validation functions in Lexer.x * `tok_integral` and `tok_frac` functions validate whether contain underscores or not. If `NumericUnderscores` extensions are not enabled, check that there are no underscores. * `tok_frac` function is created by merging `strtoken` and `init_strtoken`. * `init_strtoken` is deleted. Because it is no longer used. * Remove underscores from target literal string * `parseUnsignedInteger`, `readRational__`, and `readHexRational} use the customized `span'` function to remove underscores. * Added Testcase * testcase for NumericUnderscores enabled. NumericUnderscores0.hs and NumericUnderscores1.hs * testcase for NumericUnderscores disabled. NoNumericUnderscores0.hs and NoNumericUnderscores1.hs * testcase to invalid pattern for NumericUnderscores enabled. NumericUnderscoresFail0.hs and NumericUnderscoresFail1.hs Test Plan: `validate` including the above testcase Reviewers: goldfire, bgamari Reviewed By: bgamari Subscribers: carter, rwbarton, thomie GHC Trac Issues: #14473 Differential Revision: https://phabricator.haskell.org/D4235 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 01:39:31 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 01:39:31 -0000 Subject: [GHC] #14667: Compiling a function with a lot of alternatives bottlenecks on insertIntHeap In-Reply-To: <046.bf8bb91dd6a70996717f1ecc929e7901@haskell.org> References: <046.bf8bb91dd6a70996717f1ecc929e7901@haskell.org> Message-ID: <061.2339fa08d17254eef1609ebddc25e845@haskell.org> #14667: Compiling a function with a lot of alternatives bottlenecks on insertIntHeap -------------------------------------+------------------------------------- Reporter: niteria | Owner: niteria Type: bug | Status: patch Priority: normal | Milestone: Component: Compiler | Version: Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): phab:D4329 Wiki Page: | -------------------------------------+------------------------------------- Comment (by Ben Gamari ): In [changeset:"88297438d550a93f72261447a215b6a58b4fae55/ghc" 88297438/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="88297438d550a93f72261447a215b6a58b4fae55" Use IntSet in Dataflow Before this change, a list was used as a substitute for a heap. This led to quadratic behavior on a simple program (see new test case). This change replaces it with IntSet in effect reverting 5a1a2633553. @simonmar said it's fine to revert as long as nofib results are good. Test Plan: new test case: 20% improvement 3x improvement when N=10000 nofib: I run it twice for before and after because the compile time results are noisy. - Compile Allocations: ``` before before re-run after after re-run -1 s.d. ----- -0.0% -0.1% -0.1% +1 s.d. ----- +0.0% +0.1% +0.1% Average ----- +0.0% -0.0% -0.0% ``` - Compile Time: ``` before before re-run after after re-run -1 s.d. ----- -0.1% -2.3% -2.6% +1 s.d. ----- +5.2% +3.7% +4.4% Average ----- +2.5% +0.7% +0.8% ``` I checked each case and couldn't find consistent slow-down/speed-up on compile time. Full results here: P173 Reviewers: simonpj, simonmar, bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie, carter, simonmar GHC Trac Issues: #14667 Differential Revision: https://phabricator.haskell.org/D4329 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 01:39:31 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 01:39:31 -0000 Subject: [GHC] #9885: ghc-pkg parser eats too much memory In-Reply-To: <045.91c2102f5d7dc20ac2d922c7041cfbfb@haskell.org> References: <045.91c2102f5d7dc20ac2d922c7041cfbfb@haskell.org> Message-ID: <060.03ff733b0248be5177429379564e9972@haskell.org> #9885: ghc-pkg parser eats too much memory -------------------------------------+------------------------------------- Reporter: gnezdo | Owner: (none) Type: bug | Status: new Priority: low | Milestone: Component: ghc-pkg | Version: 7.8.3 Resolution: | Keywords: Operating System: Linux | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): -------------------------------------+------------------------------------- Comment (by Ben Gamari ): In [changeset:"2671cccde749ed64129097358f81bff43480cdb9/ghc" 2671ccc/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="2671cccde749ed64129097358f81bff43480cdb9" Update Cabal submodule - Cabal-2.2 uses SPDX license identifiers, so I had to update `cabal-version: 2.1` packages `license: BSD3` to `license: BSD-3-Clause` - `ghc-cabal` used old ReadP parsec, now it uses `parsec` too - InstalledPackageInfo pretty-printing have changed a little, fields with default values aren't printed. This can be changed in `Cabal` still, but I haven't found problems with omitting them. Note: `BSD-3-Clause` is parsed as "name = BSD, version = 3" by old parser (because 3-Clause looks like version 3 with tag Clause). If you see *"BSD-3" is not a valid license*, then something is using old parser still. Fixes #9885. }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 03:19:56 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 03:19:56 -0000 Subject: [GHC] #14699: Library status for 8.4.1 In-Reply-To: <046.12f775ea02060174a5ac178f457055aa@haskell.org> References: <046.12f775ea02060174a5ac178f457055aa@haskell.org> Message-ID: <061.147c124e738976c3865e01a04b6c79ba@haskell.org> #14699: Library status for 8.4.1 -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: task | Status: new Priority: highest | Milestone: 8.4.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Old description: > ||= package =||= status =||= reference =|| > || `Cabal` || needs release || || > || `Win32` || on-release || || > || `array` || Needs revision || || > || `binary` || on-release || || > || `bytestring` || on-release || || > || `containers` || needs release || > https://github.com/haskell/containers/issues/501 || > || `deepseq` || needs revision || || > || `directory` || on-release || || > || `filepath` || needs release || > https://github.com/haskell/filepath/issues/65 || > || `haskeline` || needs release || > https://github.com/judah/haskeline/issues/75 || > || `hpc` || needs release || || > || `mtl` || needs release || https://github.com/haskell/mtl/issues/52 || > || `parallel` || needs revision || || > || `parsec` || needs release || > https://github.com/haskell/parsec/issues/86 || > || `pretty` || needs release || > https://github.com/haskell/pretty/issues/47 || > || `primitive` || needs release || > https://github.com/haskell/primitive/issues/72 || > || `process` || needs release || > https://github.com/haskell/primitive/issues/72 || > || `stm` || needs release || #14698 || > || `terminfo` || needs release || > https://github.com/judah/terminfo/issues/27 || > || `text` || needs release || https://github.com/haskell/text/issues/215 > || > || `time` || on-release || || > || `transformers` || needs update || #14678 || > || `unix` || needs release || https://github.com/haskell/unix/issues/106 > || > || `haddock` || needs release || > https://github.com/haskell/haddock/issues/737 || New description: ||= package =||= status =||= reference =|| || `Cabal` || needs release || || || `Win32` || on-release || || || `array` || Needs revision || || || `binary` || on-release || || || `bytestring` || on-release || || || `containers` || needs release || https://github.com/haskell/containers/issues/501 || || `deepseq` || needs revision || || || `directory` || on-release || || || `filepath` || needs release || https://github.com/haskell/filepath/issues/65 || || `haskeline` || needs release || https://github.com/judah/haskeline/issues/75 || || `hpc` || needs release || || || `mtl` || needs release || https://github.com/haskell/mtl/issues/52 || || `parallel` || needs revision || || || `parsec` || needs release || https://github.com/haskell/parsec/issues/86 || || `pretty` || needs release || https://github.com/haskell/pretty/issues/47 || || `primitive` || needs release || https://github.com/haskell/primitive/issues/72 || || `process` || needs release || https://github.com/haskell/primitive/issues/72 || || `stm` || needs release || #14698 || || `terminfo` || ready || https://github.com/judah/terminfo/issues/27 || || `text` || needs release || https://github.com/haskell/text/issues/215 || || `time` || on-release || || || `transformers` || needs update || #14678 || || `unix` || needs release || https://github.com/haskell/unix/issues/106 || || `haddock` || needs release || https://github.com/haskell/haddock/issues/737 || -- Comment (by bgamari): `ghc-8.4` now points at `terminfo` 0.4.1.1. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 03:20:29 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 03:20:29 -0000 Subject: [GHC] #14699: Library status for 8.4.1 In-Reply-To: <046.12f775ea02060174a5ac178f457055aa@haskell.org> References: <046.12f775ea02060174a5ac178f457055aa@haskell.org> Message-ID: <061.6d57f4b47157e10255450d70115f4b60@haskell.org> #14699: Library status for 8.4.1 -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: task | Status: new Priority: highest | Milestone: 8.4.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): The current state of `haskeline` has been tagged as 0.7.4.2. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 03:20:48 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 03:20:48 -0000 Subject: [GHC] #14699: Library status for 8.4.1 In-Reply-To: <046.12f775ea02060174a5ac178f457055aa@haskell.org> References: <046.12f775ea02060174a5ac178f457055aa@haskell.org> Message-ID: <061.44e751ca6694a3c33a230f2fcdcdde62@haskell.org> #14699: Library status for 8.4.1 -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: task | Status: new Priority: highest | Milestone: 8.4.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Description changed by bgamari: Old description: > ||= package =||= status =||= reference =|| > || `Cabal` || needs release || || > || `Win32` || on-release || || > || `array` || Needs revision || || > || `binary` || on-release || || > || `bytestring` || on-release || || > || `containers` || needs release || > https://github.com/haskell/containers/issues/501 || > || `deepseq` || needs revision || || > || `directory` || on-release || || > || `filepath` || needs release || > https://github.com/haskell/filepath/issues/65 || > || `haskeline` || needs release || > https://github.com/judah/haskeline/issues/75 || > || `hpc` || needs release || || > || `mtl` || needs release || https://github.com/haskell/mtl/issues/52 || > || `parallel` || needs revision || || > || `parsec` || needs release || > https://github.com/haskell/parsec/issues/86 || > || `pretty` || needs release || > https://github.com/haskell/pretty/issues/47 || > || `primitive` || needs release || > https://github.com/haskell/primitive/issues/72 || > || `process` || needs release || > https://github.com/haskell/primitive/issues/72 || > || `stm` || needs release || #14698 || > || `terminfo` || ready || https://github.com/judah/terminfo/issues/27 || > || `text` || needs release || https://github.com/haskell/text/issues/215 > || > || `time` || on-release || || > || `transformers` || needs update || #14678 || > || `unix` || needs release || https://github.com/haskell/unix/issues/106 > || > || `haddock` || needs release || > https://github.com/haskell/haddock/issues/737 || New description: ||= package =||= status =||= reference =|| || `Cabal` || needs release || || || `Win32` || on-release || || || `array` || Needs revision || || || `binary` || on-release || || || `bytestring` || on-release || || || `containers` || needs release || https://github.com/haskell/containers/issues/501 || || `deepseq` || needs revision || || || `directory` || on-release || || || `filepath` || needs release || https://github.com/haskell/filepath/issues/65 || || `haskeline` || ready || https://github.com/judah/haskeline/issues/75 || || `hpc` || needs release || || || `mtl` || needs release || https://github.com/haskell/mtl/issues/52 || || `parallel` || needs revision || || || `parsec` || needs release || https://github.com/haskell/parsec/issues/86 || || `pretty` || needs release || https://github.com/haskell/pretty/issues/47 || || `primitive` || needs release || https://github.com/haskell/primitive/issues/72 || || `process` || needs release || https://github.com/haskell/primitive/issues/72 || || `stm` || needs release || #14698 || || `terminfo` || ready || https://github.com/judah/terminfo/issues/27 || || `text` || needs release || https://github.com/haskell/text/issues/215 || || `time` || on-release || || || `transformers` || needs update || #14678 || || `unix` || needs release || https://github.com/haskell/unix/issues/106 || || `haddock` || needs release || https://github.com/haskell/haddock/issues/737 || -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 03:22:47 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 03:22:47 -0000 Subject: [GHC] #14696: basement package fails to compile In-Reply-To: <050.12e87447db7cc5de91b7e8da1f3c2d5c@haskell.org> References: <050.12e87447db7cc5de91b7e8da1f3c2d5c@haskell.org> Message-ID: <065.90d36934a8aaa6073142f27ab925ccbc@haskell.org> #14696: basement package fails to compile --------------------------------+------------------------------ Reporter: asyropoulos | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: invalid | Keywords: Operating System: Solaris | Architecture: x86 Type of failure: Other | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | --------------------------------+------------------------------ Changes (by bgamari): * status: upstream => closed * resolution: => invalid Comment: No worries! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 03:23:06 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 03:23:06 -0000 Subject: [GHC] #9885: ghc-pkg parser eats too much memory In-Reply-To: <045.91c2102f5d7dc20ac2d922c7041cfbfb@haskell.org> References: <045.91c2102f5d7dc20ac2d922c7041cfbfb@haskell.org> Message-ID: <060.bb8ed1aecc3f3109ed8acf9659727bbb@haskell.org> #9885: ghc-pkg parser eats too much memory -------------------------------------+------------------------------------- Reporter: gnezdo | Owner: (none) Type: bug | Status: closed Priority: low | Milestone: 8.4.1 Component: ghc-pkg | Version: 7.8.3 Resolution: fixed | Keywords: Operating System: Linux | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: new => closed * resolution: => fixed * milestone: => 8.4.1 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 03:23:14 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 03:23:14 -0000 Subject: [GHC] #14667: Compiling a function with a lot of alternatives bottlenecks on insertIntHeap In-Reply-To: <046.bf8bb91dd6a70996717f1ecc929e7901@haskell.org> References: <046.bf8bb91dd6a70996717f1ecc929e7901@haskell.org> Message-ID: <061.c3827549a85ac3fad5f4d082fc1959f5@haskell.org> #14667: Compiling a function with a lot of alternatives bottlenecks on insertIntHeap -------------------------------------+------------------------------------- Reporter: niteria | Owner: niteria Type: bug | Status: closed Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): phab:D4329 Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: patch => closed * resolution: => fixed * milestone: => 8.6.1 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 03:23:45 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 03:23:45 -0000 Subject: [GHC] #14667: Compiling a function with a lot of alternatives bottlenecks on insertIntHeap In-Reply-To: <046.bf8bb91dd6a70996717f1ecc929e7901@haskell.org> References: <046.bf8bb91dd6a70996717f1ecc929e7901@haskell.org> Message-ID: <061.74baa1b45776524a3b50ad6b6d5c7da2@haskell.org> #14667: Compiling a function with a lot of alternatives bottlenecks on insertIntHeap -------------------------------------+------------------------------------- Reporter: niteria | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): phab:D4329 Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * owner: niteria => (none) * status: closed => new * resolution: fixed => Comment: Actually, there may be more left to do here; niteria, close this when you feel appropriate. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 03:24:06 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 03:24:06 -0000 Subject: [GHC] #14473: Implement Underscores in Numeric Literals Proposal (NumericUnderscores extension) In-Reply-To: <047.9478e62bd80e36e2a95f7745037003bc@haskell.org> References: <047.9478e62bd80e36e2a95f7745037003bc@haskell.org> Message-ID: <062.3044ea3768f7e8c638bf8ef7c86a5d07@haskell.org> #14473: Implement Underscores in Numeric Literals Proposal (NumericUnderscores extension) -------------------------------------+------------------------------------- Reporter: takenobu | Owner: takenobu Type: task | Status: closed Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.2.1 Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #13126 #9224 | Differential Rev(s): Phab:D4235 Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: patch => closed * resolution: => fixed Comment: Thanks for taking this on, takenobu! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 03:24:14 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 03:24:14 -0000 Subject: [GHC] #14635: Double stacktrace with errorWithCallStack In-Reply-To: <046.342ecdededd713faab2e8b8b0c796ed8@haskell.org> References: <046.342ecdededd713faab2e8b8b0c796ed8@haskell.org> Message-ID: <061.a2dd28925cf2c154e9b250c1fa313c33@haskell.org> #14635: Double stacktrace with errorWithCallStack -------------------------------------+------------------------------------- Reporter: flip101 | Owner: alpmestan Type: bug | Status: closed Priority: normal | Milestone: 8.4.1 Component: Documentation | Version: 8.2.2 Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): D4317 Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: patch => closed * resolution: => fixed * milestone: => 8.4.1 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 03:25:26 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 03:25:26 -0000 Subject: [GHC] #14206: Add bit deposit and bit extraction primops In-Reply-To: <047.2543734720307265ea1bddd575e5fddb@haskell.org> References: <047.2543734720307265ea1bddd575e5fddb@haskell.org> Message-ID: <062.7da8830b961128bf5277de6a55100de5@haskell.org> #14206: Add bit deposit and bit extraction primops -------------------------------------+------------------------------------- Reporter: newhoggy | Owner: (none) Type: feature request | Status: closed Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.2.1 Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): Given that we had agreed to merge this for 8.4 I've merged it for the next alpha. Thanks again for sticking with this newhoggy! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 03:25:54 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 03:25:54 -0000 Subject: [GHC] #14692: Deriving Show with -XEmptyDataDeriving cases on the wrong argument In-Reply-To: <050.daa718a12ed484d79844655f3157b47c@haskell.org> References: <050.daa718a12ed484d79844655f3157b47c@haskell.org> Message-ID: <065.58170363a9a417408be2e42ef02d6c06@haskell.org> #14692: Deriving Show with -XEmptyDataDeriving cases on the wrong argument -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: closed Priority: high | Milestone: 8.4.1 Component: Compiler | Version: 8.4.1-alpha1 Resolution: fixed | Keywords: deriving Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect result | Unknown/Multiple at runtime | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4328 Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: patch => closed * resolution: => fixed Comment: Merged with 1d05e0c74ad861946e4deb4f27a77b181cab3089. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 06:09:54 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 06:09:54 -0000 Subject: [GHC] #14699: Library status for 8.4.1 In-Reply-To: <046.12f775ea02060174a5ac178f457055aa@haskell.org> References: <046.12f775ea02060174a5ac178f457055aa@haskell.org> Message-ID: <061.021666a5bc69a5dc129b8a9e287ab9c8@haskell.org> #14699: Library status for 8.4.1 -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: task | Status: new Priority: highest | Milestone: 8.4.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Old description: > ||= package =||= status =||= reference =|| > || `Cabal` || needs release || || > || `Win32` || on-release || || > || `array` || Needs revision || || > || `binary` || on-release || || > || `bytestring` || on-release || || > || `containers` || needs release || > https://github.com/haskell/containers/issues/501 || > || `deepseq` || needs revision || || > || `directory` || on-release || || > || `filepath` || needs release || > https://github.com/haskell/filepath/issues/65 || > || `haskeline` || ready || https://github.com/judah/haskeline/issues/75 > || > || `hpc` || needs release || || > || `mtl` || needs release || https://github.com/haskell/mtl/issues/52 || > || `parallel` || needs revision || || > || `parsec` || needs release || > https://github.com/haskell/parsec/issues/86 || > || `pretty` || needs release || > https://github.com/haskell/pretty/issues/47 || > || `primitive` || needs release || > https://github.com/haskell/primitive/issues/72 || > || `process` || needs release || > https://github.com/haskell/primitive/issues/72 || > || `stm` || needs release || #14698 || > || `terminfo` || ready || https://github.com/judah/terminfo/issues/27 || > || `text` || needs release || https://github.com/haskell/text/issues/215 > || > || `time` || on-release || || > || `transformers` || needs update || #14678 || > || `unix` || needs release || https://github.com/haskell/unix/issues/106 > || > || `haddock` || needs release || > https://github.com/haskell/haddock/issues/737 || New description: ||= package =||= status =||= reference =|| || `Cabal` || needs release || || || `Win32` || on-release || || || `array` || Needs revision || || || `binary` || on-release || || || `bytestring` || on-release || || || `containers` || needs release || https://github.com/haskell/containers/issues/501 || || `deepseq` || needs revision || || || `directory` || on-release || || || `filepath` || needs release || https://github.com/haskell/filepath/issues/65 || || `haskeline` || ready || https://github.com/judah/haskeline/issues/75 || || `hpc` || needs release || || || `mtl` || needs release || https://github.com/haskell/mtl/issues/52 || || `parallel` || needs revision || || || `parsec` || needs release || https://github.com/haskell/parsec/issues/86 || || `pretty` || needs release || https://github.com/haskell/pretty/issues/47 || || `primitive` || needs release || https://github.com/haskell/primitive/issues/72 || || `process` || ready || https://github.com/haskell/primitive/issues/72 || || `stm` || needs release || #14698 || || `terminfo` || ready || https://github.com/judah/terminfo/issues/27 || || `text` || needs release || https://github.com/haskell/text/issues/215 || || `time` || on-release || || || `transformers` || needs update || #14678 || || `unix` || needs release || https://github.com/haskell/unix/issues/106 || || `haddock` || needs release || https://github.com/haskell/haddock/issues/737 || -- Comment (by bgamari): `process` 1.6.3.0 has been released and the submodule updated. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 08:46:25 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 08:46:25 -0000 Subject: [GHC] #14691: Replace EvTerm with CoreExpr In-Reply-To: <046.62945affcc6cc14a9778d709349ac741@haskell.org> References: <046.62945affcc6cc14a9778d709349ac741@haskell.org> Message-ID: <061.1673c1c8ab9446b7f638b5810048f07b@haskell.org> #14691: Replace EvTerm with CoreExpr -------------------------------------+------------------------------------- Reporter: nomeata | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.3 checker) | Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): > ‘mkTrCon’ is not in scope during type checking, Well that's very tiresome. `mkTrCon` * is defined in `Data.Typeable.Internal` * is used when generating `Typeable` evidence But it's not in the environment early enough. Hmm. What about other data types that are defined before `Data.Typeable.Internal` is even defined? How do we get away with not having `mkTrCon` in scope? I think it's probably that they don't generate any `Typeable` evidence. But `mkTrCon` itself requires no `Typeable` evidence. So one possibility would be to move it and the things it depends on into another module; or equivalently to move the bits of `Internal` that generate `Typeable` evidence somewhere else. Another (inelegant) possibility would be to retain `EvTypeable` and continue to do that in the desugarer. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 08:47:32 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 08:47:32 -0000 Subject: [GHC] #14691: Replace EvTerm with CoreExpr In-Reply-To: <046.62945affcc6cc14a9778d709349ac741@haskell.org> References: <046.62945affcc6cc14a9778d709349ac741@haskell.org> Message-ID: <061.598c1c652da32fdc73d0bae323907bd3@haskell.org> #14691: Replace EvTerm with CoreExpr -------------------------------------+------------------------------------- Reporter: nomeata | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.3 checker) | Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): > When zonking a CoreExpr, is there a need to zonk inside a Tickish? Probably will never be used, but safer to do so. > Is it correct that the evVarsOfTerm are those free variables of the expression for which isEvVar is true I believe so, yes -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 09:08:58 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 09:08:58 -0000 Subject: [GHC] #14669: 32-bit binaries sometimes throw a stack overflow on shutdown. In-Reply-To: <044.45c88c9a13190d9f2a70cd9b35309cc0@haskell.org> References: <044.45c88c9a13190d9f2a70cd9b35309cc0@haskell.org> Message-ID: <059.e7fa9e0e1d842993dc02ee3483ce857c@haskell.org> #14669: 32-bit binaries sometimes throw a stack overflow on shutdown. -----------------------------------+---------------------------------- Reporter: sergv | Owner: (none) Type: bug | Status: infoneeded Priority: normal | Milestone: Component: Runtime System | Version: 8.2.1 Resolution: | Keywords: Operating System: Windows | Architecture: x86 Type of failure: Runtime crash | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -----------------------------------+---------------------------------- Comment (by Phyx-): That's great work @sergv! It does make some sense since `StgCRun.c` controls part of the stack allocations. Could you provide the preprocessed file `inplace/mingw/bin/gcc -E StgCRun.c -o StgCRun.i` along with the assembly output of the file compiled at `-O1` and `-O0`. `inplace/mingw/bin/gcc -O0 -S StgCRun.c -o StgCRun-O0.s` and similar for `-O1`. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 09:10:10 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 09:10:10 -0000 Subject: [GHC] #14669: 32-bit binaries sometimes throw a stack overflow on shutdown. In-Reply-To: <044.45c88c9a13190d9f2a70cd9b35309cc0@haskell.org> References: <044.45c88c9a13190d9f2a70cd9b35309cc0@haskell.org> Message-ID: <059.d0601163fe68a1c10c6281b94083f10b@haskell.org> #14669: 32-bit binaries sometimes throw a stack overflow on shutdown. -----------------------------------+---------------------------------- Reporter: sergv | Owner: (none) Type: bug | Status: infoneeded Priority: normal | Milestone: Component: Runtime System | Version: 8.2.1 Resolution: | Keywords: Operating System: Windows | Architecture: x86 Type of failure: Runtime crash | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -----------------------------------+---------------------------------- Changes (by Phyx-): * cc: Phyx- (added) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 09:26:25 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 09:26:25 -0000 Subject: [GHC] #14669: 32-bit binaries sometimes throw a stack overflow on shutdown. In-Reply-To: <044.45c88c9a13190d9f2a70cd9b35309cc0@haskell.org> References: <044.45c88c9a13190d9f2a70cd9b35309cc0@haskell.org> Message-ID: <059.04e874c81d8aef99c33d6ac24feb4e4a@haskell.org> #14669: 32-bit binaries sometimes throw a stack overflow on shutdown. -----------------------------------+---------------------------------- Reporter: sergv | Owner: (none) Type: bug | Status: infoneeded Priority: normal | Milestone: Component: Runtime System | Version: 8.2.1 Resolution: | Keywords: Operating System: Windows | Architecture: x86 Type of failure: Runtime crash | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -----------------------------------+---------------------------------- Changes (by sergv): * Attachment "sources.tar.xzaa" added. First part of preprocessed output, and -O0/-O1 assembly -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 09:26:48 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 09:26:48 -0000 Subject: [GHC] #14669: 32-bit binaries sometimes throw a stack overflow on shutdown. In-Reply-To: <044.45c88c9a13190d9f2a70cd9b35309cc0@haskell.org> References: <044.45c88c9a13190d9f2a70cd9b35309cc0@haskell.org> Message-ID: <059.e130b7a739d9ce47ed21191a75f34bed@haskell.org> #14669: 32-bit binaries sometimes throw a stack overflow on shutdown. -----------------------------------+---------------------------------- Reporter: sergv | Owner: (none) Type: bug | Status: infoneeded Priority: normal | Milestone: Component: Runtime System | Version: 8.2.1 Resolution: | Keywords: Operating System: Windows | Architecture: x86 Type of failure: Runtime crash | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -----------------------------------+---------------------------------- Changes (by sergv): * Attachment "sources.tar.xzab" added. Second and final part of preprocessed output, and -O0/-O1 assembly -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 09:27:49 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 09:27:49 -0000 Subject: [GHC] #14669: 32-bit binaries sometimes throw a stack overflow on shutdown. In-Reply-To: <044.45c88c9a13190d9f2a70cd9b35309cc0@haskell.org> References: <044.45c88c9a13190d9f2a70cd9b35309cc0@haskell.org> Message-ID: <059.fb2014618e5461f0e57fac549a1c2c8a@haskell.org> #14669: 32-bit binaries sometimes throw a stack overflow on shutdown. -----------------------------------+---------------------------------- Reporter: sergv | Owner: (none) Type: bug | Status: infoneeded Priority: normal | Milestone: Component: Runtime System | Version: 8.2.1 Resolution: | Keywords: Operating System: Windows | Architecture: x86 Type of failure: Runtime crash | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -----------------------------------+---------------------------------- Comment (by sergv): Okay, I did just that with a command shown below (taken from make output). Please find all three files packed in the `sources.tar.xz*` attachments and combine them via `cat`: `cat sources.tar.xz* | xz -d | tar xvf -`. {{{ sergey at box /c/home/projects/ghc/rts$ (cd ..; "C:\home\projects\ghc\inplace\lib/../mingw/bin/gcc.exe" "-U__i686" "-march=i686" "-fno-stack-protector" "-DTABLES_NEXT_TO_CODE" "-U__i686" "-march=i686" "-fno-stack-protector" "-Iincludes" "-Iincludes/dist" "-Iincludes/dist-derivedconstants/header" "-Iincludes/dist- ghcconstants/header" "-Irts" "-Irts/dist/build" "-DCOMPILING_RTS" "-fno- strict-aliasing" "-fno-common" "-Irts/dist/build/./autogen" "-Wno- error=inline" "-fno-omit-frame-pointer" "-g3" "-DRtsWay=\"rts_debug\"" "-DWINVER=0x06000100" "-w" "-DDEBUG" "-g2" "-DTRACING" "-x" "c" "rts\StgCRun.c" "-no-pie" "-Wimplicit" "-include" "C:/home/projects/ghc/includes\ghcversion.h" "-Iincludes" "-Iincludes/dist" "-Iincludes/dist-derivedconstants/header" "-Iincludes /dist-ghcconstants/header" "-Irts" "-Irts/dist/build" "-Irts/dist/build" "-Irts/dist/build/./autogen" "-IC:\home\projects\ghc\libraries\base\include" "-IC:\home\projects\ghc\libraries\integer-gmp\include" "-IC:/home/projects/ghc/rts/dist/build" "-IC:/home/projects/ghc/includes" "-IC:/home/projects/ghc/includes/dist-derivedconstants/header" -S -O0 -o e:/StgCRun.O0.s) }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 09:29:35 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 09:29:35 -0000 Subject: [GHC] #14669: 32-bit binaries sometimes throw a stack overflow on shutdown. In-Reply-To: <044.45c88c9a13190d9f2a70cd9b35309cc0@haskell.org> References: <044.45c88c9a13190d9f2a70cd9b35309cc0@haskell.org> Message-ID: <059.0f69d55464d07f798bcb399f95fad964@haskell.org> #14669: 32-bit binaries sometimes throw a stack overflow on shutdown. -----------------------------------+---------------------------------- Reporter: sergv | Owner: (none) Type: bug | Status: infoneeded Priority: normal | Milestone: Component: Runtime System | Version: 8.2.1 Resolution: | Keywords: Operating System: Windows | Architecture: x86 Type of failure: Runtime crash | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -----------------------------------+---------------------------------- Comment (by Phyx-): Thanks! I'll take a look at them once I get home this evening. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 10:15:25 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 10:15:25 -0000 Subject: [GHC] #6087: Join points need strictness analysis In-Reply-To: <046.87e3f1b25b2500e98f2a686fd50954f8@haskell.org> References: <046.87e3f1b25b2500e98f2a686fd50954f8@haskell.org> Message-ID: <061.951d2fa845bec7752203e0a7ce152d38@haskell.org> #6087: Join points need strictness analysis -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: infoneeded Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 7.4.1 Resolution: | Keywords: JoinPoints 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: | -------------------------------------+------------------------------------- Comment (by simonpj): Huh. We have a flag `-flate-dmd-anal`, but it does not seem to be enabled by `-O` or `-O2`. Could someone do a nofib run to see if it makes a difference? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 10:30:30 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 10:30:30 -0000 Subject: [GHC] #2988: Improve float-in In-Reply-To: <046.83e28bfdd70de8fbe4dfb2a2f0f105d9@haskell.org> References: <046.83e28bfdd70de8fbe4dfb2a2f0f105d9@haskell.org> Message-ID: <061.211b7e0a16fbb1bca57895d2d46f7a28@haskell.org> #2988: Improve float-in -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: task | Status: new Priority: lowest | Milestone: Component: Compiler | Version: 6.10.1 Resolution: | Keywords: FloatInwards Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * keywords: => FloatInwards Comment: No it's not fixed. Here's a concrete test case {{{ module T2988 where foo :: Int -> Bool -> String foo y b = let x1 = y+1 x2 = x1 : [] x3 = 1 : x2 x4 = 2 : x3 x5 = 3 : x4 x6 = 4 : x5 in case b of True -> show x6 False -> show (reverse x6) }}} We get a cascade of one-at-a-time inlinings. Horrid. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 10:52:29 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 10:52:29 -0000 Subject: [GHC] #14667: Compiling a function with a lot of alternatives bottlenecks on insertIntHeap In-Reply-To: <046.bf8bb91dd6a70996717f1ecc929e7901@haskell.org> References: <046.bf8bb91dd6a70996717f1ecc929e7901@haskell.org> Message-ID: <061.9f705753297ec11772b486874ee2fc5a@haskell.org> #14667: Compiling a function with a lot of alternatives bottlenecks on insertIntHeap -------------------------------------+------------------------------------- Reporter: niteria | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): phab:D4329 Wiki Page: | -------------------------------------+------------------------------------- Changes (by niteria): * status: new => closed * resolution: => fixed Comment: All good, thanks! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 11:51:54 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 11:51:54 -0000 Subject: [GHC] #14519: Exponential runtime performance regression in GHC 8.2 + Data.Text.Lazy + Text.RE.TDFA In-Reply-To: <043.92c07e3e0209c31f0a0f195fa98d301c@haskell.org> References: <043.92c07e3e0209c31f0a0f195fa98d301c@haskell.org> Message-ID: <058.43b5361a5f1395f6868dc5b74f635423@haskell.org> #14519: Exponential runtime performance regression in GHC 8.2 + Data.Text.Lazy + Text.RE.TDFA -------------------------------------+------------------------------------- Reporter: ntc2 | Owner: tdammers Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Runtime | Test Case: performance bug | https://github.com/ntc2/ghc-8.2.1 | -regex-lazy-text- | bug/tree/07b7bb32c6e90e8f2d2eada4b59943f37e632d53 Blocked By: | Blocking: Related Tickets: #13745, #14564 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by tdammers): A smaller reproduction case that depends only on `text`: {{{ module Main where import qualified Data.Text.Lazy as LText import Data.Char import System.Environment type LText = LText.Text matches :: LText -> ([LText], [LText]) matches str = case LText.uncons str of Nothing -> ([], []) Just (c, str') -> let (upperMatches, lowerMatches) = matches $ LText.drop 1 str upper = isUpper c lower = isLower c match = LText.take 10 str upperMatches' = if upper then match:upperMatches else upperMatches lowerMatches' = if lower then match:lowerMatches else lowerMatches in (upperMatches', lowerMatches') main = do (arg0:args) <- getArgs input <- LText.pack <$> readFile arg0 let (upper, lower) = matches input putStrLn $ "Lowercase: " ++ show (take 1 lower) putStrLn $ "Uppercase: " ++ show (take 1 upper) print $ LText.take 10 input }}} This example program tries to roughly mimic the usage of lazy `Text`s in `regex-tdfa-text` without actually using any code from that. Specifically, it uses `drop` (which triggers the offending `RULE`), it snatches off characters from the front of the remaining string one by one, it passes the tail through a recursive loop, it holds on to chunks of text as it traverses the input, thus preventing them from being collected, and it eventually forces at least the first one of the accumulated chunks by printing them to the console. I'm not 100% sure whether preventing collection is absolutely necessary to trigger the bug, but in any case, the above example runs slower by about a factor 2 when compiled with optimizations, the dump shows that the offending `RULE` is being hit, and the ticky profiles hint at the same performance issue as well. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 11:53:49 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 11:53:49 -0000 Subject: [GHC] #14519: Exponential runtime performance regression in GHC 8.2 + Data.Text.Lazy + Text.RE.TDFA In-Reply-To: <043.92c07e3e0209c31f0a0f195fa98d301c@haskell.org> References: <043.92c07e3e0209c31f0a0f195fa98d301c@haskell.org> Message-ID: <058.f3b0cfd7e57b6d1af4405bb0fd4b7541@haskell.org> #14519: Exponential runtime performance regression in GHC 8.2 + Data.Text.Lazy + Text.RE.TDFA -------------------------------------+------------------------------------- Reporter: ntc2 | Owner: tdammers Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Runtime | Test Case: performance bug | https://github.com/ntc2/ghc-8.2.1 | -regex-lazy-text- | bug/tree/07b7bb32c6e90e8f2d2eada4b59943f37e632d53 Blocked By: | Blocking: Related Tickets: #13745, #14564 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by tdammers): * Attachment "repro-opt.ticky" added. Minimal reproduction, unoptimized (`-O0`) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 11:54:11 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 11:54:11 -0000 Subject: [GHC] #14519: Exponential runtime performance regression in GHC 8.2 + Data.Text.Lazy + Text.RE.TDFA In-Reply-To: <043.92c07e3e0209c31f0a0f195fa98d301c@haskell.org> References: <043.92c07e3e0209c31f0a0f195fa98d301c@haskell.org> Message-ID: <058.81511ddcffa197299a4789f568570b93@haskell.org> #14519: Exponential runtime performance regression in GHC 8.2 + Data.Text.Lazy + Text.RE.TDFA -------------------------------------+------------------------------------- Reporter: ntc2 | Owner: tdammers Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Runtime | Test Case: performance bug | https://github.com/ntc2/ghc-8.2.1 | -regex-lazy-text- | bug/tree/07b7bb32c6e90e8f2d2eada4b59943f37e632d53 Blocked By: | Blocking: Related Tickets: #13745, #14564 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by tdammers): * Attachment "repro-opt.2.ticky" added. Minimal reproduction, optimized (`-O`) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 11:55:03 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 11:55:03 -0000 Subject: [GHC] #14519: Exponential runtime performance regression in GHC 8.2 + Data.Text.Lazy + Text.RE.TDFA In-Reply-To: <043.92c07e3e0209c31f0a0f195fa98d301c@haskell.org> References: <043.92c07e3e0209c31f0a0f195fa98d301c@haskell.org> Message-ID: <058.ee4ed8fc4fabfbfaab74b10036add027@haskell.org> #14519: Exponential runtime performance regression in GHC 8.2 + Data.Text.Lazy + Text.RE.TDFA -------------------------------------+------------------------------------- Reporter: ntc2 | Owner: tdammers Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Runtime | Test Case: performance bug | https://github.com/ntc2/ghc-8.2.1 | -regex-lazy-text- | bug/tree/07b7bb32c6e90e8f2d2eada4b59943f37e632d53 Blocked By: | Blocking: Related Tickets: #13745, #14564 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by tdammers): * Attachment "repro-unopt.ticky" added. Minimal reproduction, unoptimized (`-O0`) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 12:12:41 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 12:12:41 -0000 Subject: [GHC] #14473: Implement Underscores in Numeric Literals Proposal (NumericUnderscores extension) In-Reply-To: <047.9478e62bd80e36e2a95f7745037003bc@haskell.org> References: <047.9478e62bd80e36e2a95f7745037003bc@haskell.org> Message-ID: <062.281f0ea5a1de4b598c09e9977b9ad29b@haskell.org> #14473: Implement Underscores in Numeric Literals Proposal (NumericUnderscores extension) -------------------------------------+------------------------------------- Reporter: takenobu | Owner: takenobu Type: task | Status: closed Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.2.1 Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #13126 #9224 | Differential Rev(s): Phab:D4235 Wiki Page: | -------------------------------------+------------------------------------- Comment (by takenobu): It's my pleasure :) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 13:12:23 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 13:12:23 -0000 Subject: [GHC] #14693: Computing imp_finst can take up significant amount of time In-Reply-To: <046.a9caa20b4ad6e8f61c2910051e03ba80@haskell.org> References: <046.a9caa20b4ad6e8f61c2910051e03ba80@haskell.org> Message-ID: <061.42caa3973b8728d65ff9cf8166f1d906@haskell.org> #14693: Computing imp_finst can take up significant amount of time -------------------------------------+------------------------------------- Reporter: niteria | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: checker) | Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by niteria): * cc: simonmar (added) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 13:14:17 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 13:14:17 -0000 Subject: [GHC] #14697: Redundant computation in fingerprintDynFlags when compiling many modules In-Reply-To: <046.c781f4e812a45b7f1a7576c9d7db1ab8@haskell.org> References: <046.c781f4e812a45b7f1a7576c9d7db1ab8@haskell.org> Message-ID: <061.48c659b9cc1b039cb8af0c8c8234be39@haskell.org> #14697: Redundant computation in fingerprintDynFlags when compiling many modules -------------------------------------+------------------------------------- Reporter: niteria | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by niteria): * cc: simonmar (added) Old description: > I profiled a build of a production code base with thousands of modules > and computing `fingerprintDynFlags` is `7%` of time and `14%` of > allocations. > > Here's a synthetic test case inspired by what I observed: > {{{ > SIZE=1000 > > for i in $(seq -w 1 $SIZE); do > echo "module A$i where" > A$i.hs > echo "data A$i = A$i" >> A$i.hs > done > }}} > > This generates a 1000 modules each with one datatype. > Compiling them with: > {{{ > inplace/bin/ghc-stage2 A*.hs -optP-D__F{1..10000}__ > }}} > results in `fingerprintDynFlags` being the top cost centre in the > profile. > AFAICT there's only one module dependent piece that goes into computing > `fingerprintDynFlags` and the rest is the same between those 1000 > modules. > > Now, why would I have so many preprocessor flags? > This is how the Buck build system currently works. If a Haskell library > depends on a C++ library then the GHC invocation gets the C++ library's > directory as include path (`-optP-I -optP-I some/library/path`). This can > grow quite big. New description: I profiled a build of a production code base with thousands of modules and computing `fingerprintDynFlags` is `7%` of time and `14%` of allocations. Here's a synthetic test case inspired by what I observed: {{{ SIZE=1000 for i in $(seq -w 1 $SIZE); do echo "module A$i where" > A$i.hs echo "data A$i = A$i" >> A$i.hs done }}} This generates a 1000 modules each with one datatype. Compiling them with: {{{ inplace/bin/ghc-stage2 A*.hs -optP-D__F{1..10000}__ }}} results in `fingerprintDynFlags` being the top cost centre in the profile. AFAICT there's only one module dependent piece that goes into computing `fingerprintDynFlags` and the rest is the same between those 1000 modules. Now, why would I have so many preprocessor flags? This is how the Buck build system currently works. If a Haskell library depends on a C++ library then the GHC invocation gets the C++ library's directory as include path (`-optP -I -optP some/library/path`). This can grow quite big. -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 14:01:55 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 14:01:55 -0000 Subject: [GHC] #14675: GHC 8.4.1 regression: segfault when loading doctest on a module with ANNs on Ubuntu 16.04 or later In-Reply-To: <050.c5c190ffbc3e4175e84536f4424d1ad2@haskell.org> References: <050.c5c190ffbc3e4175e84536f4424d1ad2@haskell.org> Message-ID: <065.74ea569071d0c8a401936f8aa937c239@haskell.org> #14675: GHC 8.4.1 regression: segfault when loading doctest on a module with ANNs on Ubuntu 16.04 or later -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: alpmestan Type: bug | Status: new Priority: highest | Milestone: 8.4.1 Component: GHC API | Version: 8.4.1-alpha1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Runtime crash | Test Case: Blocked By: | Blocking: Related Tickets: #14603 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): I wonder if the version of `ld.gold` has something to do with this? On Ubuntu 14.04, I have: {{{ $ ld.gold --version GNU gold (GNU Binutils for Ubuntu 2.24) 1.11 Copyright 2013 Free Software Foundation, Inc. This program is free software; you may redistribute it under the terms of the GNU General Public License version 3 or (at your option) a later version. This program has absolutely no warranty. }}} But on Ubuntu 16.04 and later, I have: {{{ $ ld.gold --version GNU gold (GNU Binutils for Ubuntu 2.28) 1.14 Copyright (C) 2017 Free Software Foundation, Inc. This program is free software; you may redistribute it under the terms of the GNU General Public License version 3 or (at your option) a later version. This program has absolutely no warranty. }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 14:06:56 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 14:06:56 -0000 Subject: [GHC] #14675: GHC 8.4.1 regression: segfault when loading doctest on a module with ANNs on Ubuntu 16.04 or later In-Reply-To: <050.c5c190ffbc3e4175e84536f4424d1ad2@haskell.org> References: <050.c5c190ffbc3e4175e84536f4424d1ad2@haskell.org> Message-ID: <065.950ac2219e6a063427da60bf39b0c90f@haskell.org> #14675: GHC 8.4.1 regression: segfault when loading doctest on a module with ANNs on Ubuntu 16.04 or later -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: alpmestan Type: bug | Status: new Priority: highest | Milestone: 8.4.1 Component: GHC API | Version: 8.4.1-alpha1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Runtime crash | Test Case: Blocked By: | Blocking: Related Tickets: #14603 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by alpmestan): Ryan: I don't think so. In my VM I have ld.gold version 1.11, which I assume is used by both the 8.2.2 and 8.4.1 builds from hvr's PPA, as well as my custom 8.4.1 build. 8.2.2 and my custom 8.4.1 build don't have the issue while hvr's 8.4.1 does have the problem. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 14:10:37 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 14:10:37 -0000 Subject: [GHC] #14675: GHC 8.4.1 regression: segfault when loading doctest on a module with ANNs on Ubuntu 16.04 or later In-Reply-To: <050.c5c190ffbc3e4175e84536f4424d1ad2@haskell.org> References: <050.c5c190ffbc3e4175e84536f4424d1ad2@haskell.org> Message-ID: <065.3721a29e30ef18d5c4b32ac65fcb6236@haskell.org> #14675: GHC 8.4.1 regression: segfault when loading doctest on a module with ANNs on Ubuntu 16.04 or later -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: alpmestan Type: bug | Status: new Priority: highest | Milestone: 8.4.1 Component: GHC API | Version: 8.4.1-alpha1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Runtime crash | Test Case: Blocked By: | Blocking: Related Tickets: #14603 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): Well, you can check what `"ld command"` is on the respective `settings` files (e.g., `/opt/ghc/8.2.2/lib/ghc-8.2.2/settings` and `/opt/ghc/8.4.1/lib/ghc-8.4.0.20171222/settings`) to be sure (in my case, it's `ld.gold` for both). -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 14:11:24 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 14:11:24 -0000 Subject: [GHC] #14691: Replace EvTerm with CoreExpr In-Reply-To: <046.62945affcc6cc14a9778d709349ac741@haskell.org> References: <046.62945affcc6cc14a9778d709349ac741@haskell.org> Message-ID: <061.b0066049beeb43809b90b07bde06583d@haskell.org> #14691: Replace EvTerm with CoreExpr -------------------------------------+------------------------------------- Reporter: nomeata | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.3 checker) | Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by nomeata): The error message, with a bit more detail, is {{{ libraries/base/Data/Typeable/Internal.hs:618:5: error: • GHC internal error: ‘mkTrCon’ is not in scope during type checking, but it passed the renamer tcl_env of environment: [088 :-> Identifier[mkTrType::TypeRep *, TopLevelLet], 089 :-> Identifier[mkTrCon::forall k (a :: k). TyCon -> [SomeTypeRep] -> TypeRep a, TopLevelLet [] True], }}} Doesn’t that mean that `mkTrCon` actually is in scope, but somehow the lookup doesn't find it (different Unique maybe?) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 14:36:02 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 14:36:02 -0000 Subject: [GHC] #14691: Replace EvTerm with CoreExpr In-Reply-To: <046.62945affcc6cc14a9778d709349ac741@haskell.org> References: <046.62945affcc6cc14a9778d709349ac741@haskell.org> Message-ID: <061.a5ff90030f525366e4b5905ffbf30c93@haskell.org> #14691: Replace EvTerm with CoreExpr -------------------------------------+------------------------------------- Reporter: nomeata | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.3 checker) | Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): >Doesn’t that mean that mkTrCon actually is in scope Looks odd. Use `-dppr-debug` to see the unique of the thing being looked up. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 14:43:44 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 14:43:44 -0000 Subject: [GHC] #14670: -XRebindableSyntax needs return? In-Reply-To: <048.c96b42d6aefe76220126edbb094e21e4@haskell.org> References: <048.c96b42d6aefe76220126edbb094e21e4@haskell.org> Message-ID: <063.13e7d9308ec3f74cf9e64b5d93547852@haskell.org> #14670: -XRebindableSyntax needs return? -------------------------------------+------------------------------------- Reporter: jackkelly | Owner: simonmar Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: | RebindableSyntax Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: GHC rejects | Test Case: valid program | rebindable/T14670 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * owner: (none) => simonmar Comment: Simon: this is your bailiwick. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 15:21:21 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 15:21:21 -0000 Subject: [GHC] #14683: Slow compile times for Happy-generated source In-Reply-To: <050.c267d901f7aabb72ea60ae5332333f63@haskell.org> References: <050.c267d901f7aabb72ea60ae5332333f63@haskell.org> Message-ID: <065.76347791a9d46115112cf478d6094a47@haskell.org> #14683: Slow compile times for Happy-generated source -------------------------------------+------------------------------------- Reporter: harpocrates | Owner: (none) Type: bug | Status: new Priority: high | Milestone: 8.4.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonmar): * cc: simonmar (added) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 15:34:39 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 15:34:39 -0000 Subject: [GHC] #14594: 2 modules / 2500LOC takes nearly 3 minutes to build In-Reply-To: <046.b60bf688db171cb4139d3998a57394f4@haskell.org> References: <046.b60bf688db171cb4139d3998a57394f4@haskell.org> Message-ID: <061.f9f5cdef40174b6731c0946c2a971424@haskell.org> #14594: 2 modules / 2500LOC takes nearly 3 minutes to build -------------------------------------+------------------------------------- Reporter: schyler | Owner: dfeuer Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.0.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by dfeuer): I have not as yet been able to find anything non-linear, but we seem to pay an awful lot ''per instance''. Given {{{#!hs data Foo7 = Foo7 (Int) deriving Data data Foo8 = Foo8 (Int) deriving Data -- plus 25 more like this }}} compiling with `-O` takes 5 seconds. The single most expensive part is codegen, which takes about a second, but otherwise no particular pass stands out as being particularly expensive. I experimentally tried deriving more of the `Data` methods to try to reduce simplification time. Unfortunately, I paid for it in typechecking time. I still want to check if ''some'' of those extra methods are worthwhile, but otherwise I really don't know. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 15:34:45 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 15:34:45 -0000 Subject: [GHC] #14691: Replace EvTerm with CoreExpr In-Reply-To: <046.62945affcc6cc14a9778d709349ac741@haskell.org> References: <046.62945affcc6cc14a9778d709349ac741@haskell.org> Message-ID: <061.7a743d8c38a5aa177ceaa71a22f6a455@haskell.org> #14691: Replace EvTerm with CoreExpr -------------------------------------+------------------------------------- Reporter: nomeata | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.3 checker) | Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by nomeata): Ok, here is (part of) the deal: * `tcLookupGlobal :: Name -> TcM TyThing` looks things up in the global environment (`getGblEnv`). While compiling `Data.Typeable.Internal`, `mkTrCon` is not in the global environment. * If the lookup fails, it uses `notFound`, which, for some reason, prints the `tcl_env` of the *local* environment (`lcl_env <- getLclEnv`). * This shows us that `mkTrCon` is actually in the local environment! So presumably, we just have to use that. I would have expected that `tcLookup :: Name -> TcM TcTyThing` (no `Global` in the name) would consult the local environment. It seems to consult the local type environment (`local_env <- getLclTypeEnv`). But when I tried that (in http://git.haskell.org/ghc.git/commitdiff/cb7deb6d0f36132594ccad3c86bddc7d7cdbb0dd) it somehow did not help. Will have to try harder, I guess. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 15:42:44 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 15:42:44 -0000 Subject: [GHC] #14519: Exponential runtime performance regression in GHC 8.2 + Data.Text.Lazy + Text.RE.TDFA In-Reply-To: <043.92c07e3e0209c31f0a0f195fa98d301c@haskell.org> References: <043.92c07e3e0209c31f0a0f195fa98d301c@haskell.org> Message-ID: <058.c5cd66e5c10fa581207b7aadf09de5c4@haskell.org> #14519: Exponential runtime performance regression in GHC 8.2 + Data.Text.Lazy + Text.RE.TDFA -------------------------------------+------------------------------------- Reporter: ntc2 | Owner: tdammers Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Runtime | Test Case: performance bug | https://github.com/ntc2/ghc-8.2.1 | -regex-lazy-text- | bug/tree/07b7bb32c6e90e8f2d2eada4b59943f37e632d53 Blocked By: | Blocking: Related Tickets: #13745, #14564 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by tdammers): Filed issue with the text library: [https://github.com/haskell/text/issues/216] -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 15:51:49 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 15:51:49 -0000 Subject: [GHC] #14688: Note [Lone variables] leads to missing a case-of-case opportunity In-Reply-To: <049.49a076b467188eb35828b1dabac9ffe9@haskell.org> References: <049.49a076b467188eb35828b1dabac9ffe9@haskell.org> Message-ID: <064.93dd5400565c7eb40ea04d9ec6b3891e@haskell.org> #14688: Note [Lone variables] leads to missing a case-of-case opportunity -------------------------------------+------------------------------------- Reporter: mpickering | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by mpickering): I tried to get to the bottom of what was going on here this afternoon. Here's a nice self-contained program now. https://gist.github.com/mpickering/37b7119561e825ba895ac2b014d178d7 `foo` is the example from the original ticket. `x` is not work-free or expandable. `foo2` is a modified example where `x` is work-free and expandable but still doesn't get inlined even with the modified test (changing `is_wf` to `is_exp`). 1. Something is definitely wrong in `tryUnfolding` as if `lone_variable` then either `some_benefit` or `is_wf` is going to be `False` so it won't get inlined. (Case 1: `is_wf` is False; trivial, Case 2: `is_wf` is True then `not (lone_variable && is_wf)` will be `False` and hence `some_benefit` is `False`.) 2. Changing it to `is_exp` doesn't help `foo2` as `x` is reported to be expandable as well as work-free. 3. Using a GADT means that GHC concludes that the `x` binding is no longer expandable or work-free which I found very surprising. Adding the type index shouldn't affect the optimiser like this? 4. Changing the call to `is_exp` doesn't look like it would work anyway as there is no case for `Case` in `expandUnfolding_maybe` and so it will still return `Nothing`. Have you got any more hints Simon :) ? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 16:03:02 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 16:03:02 -0000 Subject: [GHC] #14691: Replace EvTerm with CoreExpr In-Reply-To: <046.62945affcc6cc14a9778d709349ac741@haskell.org> References: <046.62945affcc6cc14a9778d709349ac741@haskell.org> Message-ID: <061.ee122d985eed191761dbeadce027f09f@haskell.org> #14691: Replace EvTerm with CoreExpr -------------------------------------+------------------------------------- Reporter: nomeata | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.3 checker) | Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by nomeata): Ok, I made progress. `tcLookupId` is the right thing to use here, I just need to use it in the right place :-) Next problem: {{{ libraries/base/GHC/Exception.hs:1:1: error: GHC internal error: ‘GHC.Exception.$tcArithException’ is not in scope during type checking, but it passed the renamer }}} I believe this is caused by the following {{{ tyConRep :: TyCon -> TcS CoreExpr -- Returns CoreExpr :: TyCon tyConRep tc | Just tc_rep_nm <- tyConRepName_maybe tc = do { tc_rep_id <- tcLookupId tc_rep_nm ; return (Var tc_rep_id) } | otherwise = pprPanic "tyConRep" (ppr tc) }}} where the `tcLookupId` fails, because the type-checker does not know yet that `GHC.Exception.$tcArithException` exists (not sure if it exists at that time). -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 16:08:44 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 16:08:44 -0000 Subject: [GHC] #14691: Replace EvTerm with CoreExpr In-Reply-To: <046.62945affcc6cc14a9778d709349ac741@haskell.org> References: <046.62945affcc6cc14a9778d709349ac741@haskell.org> Message-ID: <061.5e82c2b0cb86846b70a177405005a0ce@haskell.org> #14691: Replace EvTerm with CoreExpr -------------------------------------+------------------------------------- Reporter: nomeata | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.3 checker) | Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): > tcLookupId is the right thing to use here That's bizarre. `tcLookupId` calls `tcLookup`, so if the latter succeeds, so should the former (provided you deal with both `ATcId` and `AGlobal` results). -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 16:11:05 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 16:11:05 -0000 Subject: [GHC] #14691: Replace EvTerm with CoreExpr In-Reply-To: <046.62945affcc6cc14a9778d709349ac741@haskell.org> References: <046.62945affcc6cc14a9778d709349ac741@haskell.org> Message-ID: <061.4a0b525ea92ce5c7f3d784e5b6a54d9c@haskell.org> #14691: Replace EvTerm with CoreExpr -------------------------------------+------------------------------------- Reporter: nomeata | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.3 checker) | Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by nomeata): I was using `lookupName` previously, from the `MonadThings` instance, which goes through `tcLookupGlobal`; I believe that is the cause for the bizarriness: {{{ instance MonadThings (IOEnv (Env TcGblEnv TcLclEnv)) where lookupThing = tcLookupGlobal }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 16:11:33 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 16:11:33 -0000 Subject: [GHC] #14691: Replace EvTerm with CoreExpr In-Reply-To: <046.62945affcc6cc14a9778d709349ac741@haskell.org> References: <046.62945affcc6cc14a9778d709349ac741@haskell.org> Message-ID: <061.ab835518128a78e89a0a067b34199175@haskell.org> #14691: Replace EvTerm with CoreExpr -------------------------------------+------------------------------------- Reporter: nomeata | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.3 checker) | Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): `$tcArithException`. Also bizarre. From what you say, it happens in an ordinary value definition, with no `Typeable` stuff in sight. I'm lost. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 16:12:43 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 16:12:43 -0000 Subject: [GHC] #14691: Replace EvTerm with CoreExpr In-Reply-To: <046.62945affcc6cc14a9778d709349ac741@haskell.org> References: <046.62945affcc6cc14a9778d709349ac741@haskell.org> Message-ID: <061.d475ce041a4232a477b7e5e79ba60c9b@haskell.org> #14691: Replace EvTerm with CoreExpr -------------------------------------+------------------------------------- Reporter: nomeata | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.3 checker) | Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): > I was using lookupName previously Yes, but then you said "..I would have expected that `tcLookup :: Name -> TcM TcTyThing` (no Global in the name) would consult the local environment. ... somehow did not help" Anyway, you are past that roadblock now anyway, which is good. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 16:14:07 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 16:14:07 -0000 Subject: [GHC] #14675: GHC 8.4.1 regression: segfault when loading doctest on a module with ANNs on Ubuntu 16.04 or later In-Reply-To: <050.c5c190ffbc3e4175e84536f4424d1ad2@haskell.org> References: <050.c5c190ffbc3e4175e84536f4424d1ad2@haskell.org> Message-ID: <065.73b935a13019b4a670c04c1b194678c3@haskell.org> #14675: GHC 8.4.1 regression: segfault when loading doctest on a module with ANNs on Ubuntu 16.04 or later -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: alpmestan Type: bug | Status: new Priority: highest | Milestone: 8.4.1 Component: GHC API | Version: 8.4.1-alpha1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Runtime crash | Test Case: Blocked By: | Blocking: Related Tickets: #14603 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by alpmestan): Here's what I have: {{{#!haskell alp at vm:~/ghc$ cat /opt/ghc/8.2.2/lib/ghc-8.2.2/settings | grep ld ("C compiler link flags", " -fuse-ld=gold"), ("ld command", "ld.gold"), ("ld flags", ""), ("ld supports compact unwind", "YES"), ("ld supports build-id", "YES"), ("ld supports filelist", "NO"), ("ld is GNU ld", "YES"), alp at vm:~/ghc$ cat /opt/ghc/8.4.1/lib/ghc-8.4.0.20171222/settings | grep ld ("C compiler link flags", " -fuse-ld=gold"), ("ld command", "ld.gold"), ("ld flags", ""), ("ld supports compact unwind", "YES"), ("ld supports build-id", "YES"), ("ld supports filelist", "NO"), ("ld is GNU ld", "YES"), }}} And my custom build reports the same thing as well. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 16:15:43 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 16:15:43 -0000 Subject: [GHC] #14675: GHC 8.4.1 regression: segfault when loading doctest on a module with ANNs on Ubuntu 16.04 or later In-Reply-To: <050.c5c190ffbc3e4175e84536f4424d1ad2@haskell.org> References: <050.c5c190ffbc3e4175e84536f4424d1ad2@haskell.org> Message-ID: <065.052a356a136bb761165883dbb9f4a478@haskell.org> #14675: GHC 8.4.1 regression: segfault when loading doctest on a module with ANNs on Ubuntu 16.04 or later -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: alpmestan Type: bug | Status: new Priority: highest | Milestone: 8.4.1 Component: GHC API | Version: 8.4.1-alpha1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Runtime crash | Test Case: Blocked By: | Blocking: Related Tickets: #14603 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): Ah, darn, never mind then :) I'm not sure if there's an easier way to pinpoint differences between individual components of Ubuntu 14.04 vs. 16.04 that might be contributing to this... perhaps Nix makes this easier? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 16:18:15 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 16:18:15 -0000 Subject: [GHC] #14691: Replace EvTerm with CoreExpr In-Reply-To: <046.62945affcc6cc14a9778d709349ac741@haskell.org> References: <046.62945affcc6cc14a9778d709349ac741@haskell.org> Message-ID: <061.1ad04c878a9960b2d7fda9d8d39e4f59@haskell.org> #14691: Replace EvTerm with CoreExpr -------------------------------------+------------------------------------- Reporter: nomeata | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.3 checker) | Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by nomeata): > Yes, but then you said "..I would have expected that tcLookup :: Name -> TcM TcTyThing (no Global in the name) would consult the local environment. ... somehow did not help" yes, but I was not using it in all the places I should have – that bizzarness was simply a mistake by me, sorry for the confusion. About `$tcArithException :: TyCon` – this value lives in `GHC.Exception`, but obviously it is not present in the Haskell source. Which phase is responsible for synthesizing these values? It seems that they are synthesized and added after `TcInteract` resolves the `Typeable` constraints (or, if they are created earlier, they are not added to the type checker’s local environment). -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 16:34:51 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 16:34:51 -0000 Subject: [GHC] #14691: Replace EvTerm with CoreExpr In-Reply-To: <046.62945affcc6cc14a9778d709349ac741@haskell.org> References: <046.62945affcc6cc14a9778d709349ac741@haskell.org> Message-ID: <061.23170a8cdd67de2edec2cd5e004550d8@haskell.org> #14691: Replace EvTerm with CoreExpr -------------------------------------+------------------------------------- Reporter: nomeata | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.3 checker) | Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by nomeata): Ah, it seems I have two make sure `mkTypeableBinds` is called before `simplifyTop` in `tcRnSrcDecls`. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 16:45:46 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 16:45:46 -0000 Subject: [GHC] #14688: Note [Lone variables] leads to missing a case-of-case opportunity In-Reply-To: <049.49a076b467188eb35828b1dabac9ffe9@haskell.org> References: <049.49a076b467188eb35828b1dabac9ffe9@haskell.org> Message-ID: <064.f8ead1e1b3b42851ba3621ce796aa417@haskell.org> #14688: Note [Lone variables] leads to missing a case-of-case opportunity -------------------------------------+------------------------------------- Reporter: mpickering | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Huh. I really don't think case-expressions should be expandable. I think that's an unintentional consequences of sharing `exprIsCheapX`. This patch makes both `foo` and `foo2` behave well. Would you like to do a full nofib run? {{{ diff --git a/compiler/coreSyn/CoreArity.hs b/compiler/coreSyn/CoreArity.hs index 945cad6..538648d 100644 --- a/compiler/coreSyn/CoreArity.hs +++ b/compiler/coreSyn/CoreArity.hs @@ -514,9 +514,9 @@ getBotArity _ = Nothing mk_cheap_fn :: DynFlags -> CheapAppFun -> CheapFun mk_cheap_fn dflags cheap_app | not (gopt Opt_DictsCheap dflags) - = \e _ -> exprIsCheapX cheap_app e + = \e _ -> exprIsCheapX True cheap_app e | otherwise - = \e mb_ty -> exprIsCheapX cheap_app e + = \e mb_ty -> exprIsCheapX True cheap_app e || case mb_ty of Nothing -> False Just ty -> isDictLikeTy ty diff --git a/compiler/coreSyn/CoreUnfold.hs b/compiler/coreSyn/CoreUnfold.hs index c459fd2..f30aca6 100644 --- a/compiler/coreSyn/CoreUnfold.hs +++ b/compiler/coreSyn/CoreUnfold.hs @@ -1241,8 +1241,8 @@ tryUnfolding dflags id lone_variable = True | otherwise = case cont_info of - CaseCtxt -> not (lone_variable && is_wf) -- Note [Lone variables] - ValAppCtxt -> True -- Note [Cast then apply] + CaseCtxt -> not (lone_variable && is_exp) -- Note [Lone variables] + ValAppCtxt -> True -- Note [Cast then apply] RuleArgCtxt -> uf_arity > 0 -- See Note [Unfold info lazy contexts] DiscArgCtxt -> uf_arity > 0 -- RhsCtxt -> uf_arity > 0 -- diff --git a/compiler/coreSyn/CoreUtils.hs b/compiler/coreSyn/CoreUtils.hs index 5e32dc6..c99e05f 100644 --- a/compiler/coreSyn/CoreUtils.hs +++ b/compiler/coreSyn/CoreUtils.hs @@ -1131,18 +1131,18 @@ in this (which it previously was): -} -------------------- +exprIsWorkFree :: CoreExpr -> Bool -- See Note [exprIsWorkFree] +exprIsWorkFree = exprIsCheapX True isWorkFreeApp + exprIsCheap :: CoreExpr -> Bool -exprIsCheap = exprIsCheapX isCheapApp +exprIsCheap = exprIsCheapX True isCheapApp exprIsExpandable :: CoreExpr -> Bool -- See Note [exprIsExpandable] -exprIsExpandable = exprIsCheapX isExpandableApp - -exprIsWorkFree :: CoreExpr -> Bool -- See Note [exprIsWorkFree] -exprIsWorkFree = exprIsCheapX isWorkFreeApp +exprIsExpandable = exprIsCheapX False isExpandableApp -------------------- -exprIsCheapX :: CheapAppFun -> CoreExpr -> Bool -exprIsCheapX ok_app e +exprIsCheapX :: Bool -> CheapAppFun -> CoreExpr -> Bool +exprIsCheapX ok_case ok_app e = ok e where ok e = go 0 e @@ -1153,7 +1153,8 @@ exprIsCheapX ok_app e go _ (Type {}) = True go _ (Coercion {}) = True go n (Cast e _) = go n e - go n (Case scrut _ _ alts) = ok scrut && + go n (Case scrut _ _ alts) = ok_case && + ok scrut && and [ go n rhs | (_,_,rhs) <- alts ] go n (Tick t e) | tickishCounts t = False | otherwise = go n e }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 17:22:11 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 17:22:11 -0000 Subject: [GHC] #14700: ApplicativeDo in MonadComprehensions Message-ID: <048.e3602ef00739fa0fae5c13e32ddb2bb4@haskell.org> #14700: ApplicativeDo in MonadComprehensions -------------------------------------+------------------------------------- Reporter: lspitzner | 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: -------------------------------------+------------------------------------- It appears that a MonadComp (even one that is "Applicative only") is not transformed appropriately in the presence of ApplicativeDo. {{{#!hs {-# LANGUAGE MonadComprehensions #-} {-# LANGUAGE ApplicativeDo #-} value1 = [ f a b c | a <- ma, b <- mb, c <- mc ] value2 = do { a <- ma; b <- mb; c <- mc; return (f a b c) } value3 = f <$> ma <*> mb <*> mc }}} value1 should desugar to value2 via monadcomp and to value3 via appdo. Yet I observe very bad performance in some specific instance (due to a slower Monad instance) when using value1, where value2 and value3 have good performance. I have not looked at desuraged/core dumps but the observation seems clear. Tested on ghc-8.0.2 only. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 17:23:50 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 17:23:50 -0000 Subject: [GHC] #14700: ApplicativeDo in MonadComprehensions In-Reply-To: <048.e3602ef00739fa0fae5c13e32ddb2bb4@haskell.org> References: <048.e3602ef00739fa0fae5c13e32ddb2bb4@haskell.org> Message-ID: <063.d5b54d2148d252642af665ed8ee767b8@haskell.org> #14700: ApplicativeDo in MonadComprehensions -------------------------------------+------------------------------------- Reporter: lspitzner | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.0.2 Resolution: | Keywords: ApplicativeDo Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * keywords: => ApplicativeDo -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 17:31:02 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 17:31:02 -0000 Subject: [GHC] #14675: GHC 8.4.1 regression: segfault when loading doctest on a module with ANNs on Ubuntu 16.04 or later In-Reply-To: <050.c5c190ffbc3e4175e84536f4424d1ad2@haskell.org> References: <050.c5c190ffbc3e4175e84536f4424d1ad2@haskell.org> Message-ID: <065.ff41d402dac70f9db1548c8a32fdb113@haskell.org> #14675: GHC 8.4.1 regression: segfault when loading doctest on a module with ANNs on Ubuntu 16.04 or later -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: alpmestan Type: bug | Status: new Priority: highest | Milestone: 8.4.1 Component: GHC API | Version: 8.4.1-alpha1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Runtime crash | Test Case: Blocked By: | Blocking: Related Tickets: #14603 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by alpmestan): Alright, I did another build, `perf` flavour instead of `quick` previously, using `./configure --with-ghc=/opt/ghc/8.2.2/bin/ghc --prefix=/opt/ghc/my-8.4.1/bin/ghc --enable-dwarf-unwind` along with `GhcLibHcOpts += -g3` and `GhcRtsHcOpts += -g3`, so that I can use gdb to figure out where exactly things are going wrong, if I can reproduce the crash. Also from the same commit as hvr's build: {{{#!haskell alp at vm:~/14675$ /home/alp/ghc/inplace/bin/ghc-stage2 --info | grep commit ,("Project Git commit id","c6cf13ca63f3a11a8da7c7e3bd69e673a8df5440") alp at vm:~/14675$ /opt/ghc/8.4.1/bin/ghc --info | grep commit ,("Project Git commit id","c6cf13ca63f3a11a8da7c7e3bd69e673a8df5440") }}} And with this precise setup, even though for some reason I can't `make install` this build, I can reproduce the problem. {{{#!bash alp at vm:~/14675$ /home/alp/ghc/inplace/bin/ghc-stage2 -fforce-recomp -package ghc Bug.hs [1 of 1] Compiling Main ( Bug.hs, Bug.o ) Linking Bug ... alp at vm:~/14675$ PATH=/home/alp/ghc/inplace/bin:$PATH ./Bug /home/alp/ghc/inplace/lib Using binary package database: /home/alp/ghc/inplace/lib/package.conf.d/package.cache package flags [-package base{package base True ([])}] loading package database /home/alp/ghc/inplace/lib/package.conf.d wired-in package ghc-prim mapped to ghc-prim-0.5.2.0 wired-in package integer-gmp mapped to integer-gmp-1.0.1.0 wired-in package base mapped to base-4.11.0.0 wired-in package rts mapped to rts wired-in package template-haskell mapped to template-haskell-2.13.0.0 wired-in package ghc mapped to ghc-8.4.0.20171222 wired-in package dph-seq not found. wired-in package dph-par not found. *** Chasing dependencies: Chasing modules from: *Foo.hs !!! Chasing dependencies: finished in 0.96 milliseconds, allocated 0.400 megabytes Before parseModule *** Parser [Foo]: !!! Parser [Foo]: finished in 0.08 milliseconds, allocated 0.070 megabytes Before typecheckModule *** Renamer/typechecker [Foo]: *** Simplify [expr]: !!! Simplify [expr]: finished in 0.07 milliseconds, allocated 0.000 megabytes *** CorePrep [expr]: !!! CorePrep [expr]: finished in 1.37 milliseconds, allocated 1.666 megabytes *** ByteCodeGen [Ghci1]: !!! ByteCodeGen [Ghci1]: finished in 0.10 milliseconds, allocated 0.047 megabytes Loading package ghc-prim-0.5.2.0 ... linking ... done. *** gcc: gcc -fno-stack-protector -DTABLES_NEXT_TO_CODE '-fuse-ld=gold' -B/home/alp/ghc/libraries/integer-gmp/dist-install/build --print-file-name libgmp.so Loading package integer-gmp-1.0.1.0 ... linking ... done. Loading package base-4.11.0.0 ... linking ... done. Erreur de segmentation (core dumped) }}} Tomorrow I'll fire up gdb and see if this builds lets me figure out precisely where things are going wrong. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 17:31:55 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 17:31:55 -0000 Subject: [GHC] #14691: Replace EvTerm with CoreExpr In-Reply-To: <046.62945affcc6cc14a9778d709349ac741@haskell.org> References: <046.62945affcc6cc14a9778d709349ac741@haskell.org> Message-ID: <061.118b459e6cf47d402952a9708ae027d2@haskell.org> #14691: Replace EvTerm with CoreExpr -------------------------------------+------------------------------------- Reporter: nomeata | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.3 checker) | Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): > Ah, it seems I have two make sure mkTypeableBinds is called before simplifyTop in tcRnSrcDecls. This is a stronger reason for deferring the desugaring of `Typeable` evidence: such evidence necessarily refers to top-level Haskell binding for the type representation of a type constructor defined in this module. e.g. To solve `Typeable T` we need to refer to `T`'s type representation. But we haven't generated those top-level bindings yet. In general, such evidence-solving may take place before `simplifyTop` is called; e.g. in `simplifyInfer`. Given this, better to defer to the desugarer I think, to postpone any evidence-solving that requires bindings that might be generated in this very module. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 17:38:32 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 17:38:32 -0000 Subject: [GHC] #14691: Replace EvTerm with CoreExpr In-Reply-To: <046.62945affcc6cc14a9778d709349ac741@haskell.org> References: <046.62945affcc6cc14a9778d709349ac741@haskell.org> Message-ID: <061.963f8843c4ea260435b5c75cb68a6d53@haskell.org> #14691: Replace EvTerm with CoreExpr -------------------------------------+------------------------------------- Reporter: nomeata | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.3 checker) | Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by nomeata): > Given this, better to defer to the desugarer I think, to postpone any evidence-solving that requires bindings that might be generated in this very module. So should I try this: {{{ data EvTerm = EvExpr CoreExpr | EvTypeable EvTypeable }}} This is differs from the state before, because now the `CoreExpr` in an `EvExpr` can no longer refer to an `EvTypeable`… I cannot tell yet if that would happen or if it is a problem. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 17:44:39 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 17:44:39 -0000 Subject: [GHC] #14691: Replace EvTerm with CoreExpr In-Reply-To: <046.62945affcc6cc14a9778d709349ac741@haskell.org> References: <046.62945affcc6cc14a9778d709349ac741@haskell.org> Message-ID: <061.676c21d9a79fd77110d8bd1ff3907cd9@haskell.org> #14691: Replace EvTerm with CoreExpr -------------------------------------+------------------------------------- Reporter: nomeata | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.3 checker) | Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): now the CoreExpr in an EvExpr can no longer refer to an EvTypeable Well it can, via `(Var d)` where `d` is the `Id` of the typeable evidence. So I think it'll be fine -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 17:46:38 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 17:46:38 -0000 Subject: [GHC] #14678: GHC 8.4.1-alpha's bundled transformers doesn't correspond to a tagged release In-Reply-To: <050.e45e5fc2b285549e2fcbcab2ac249ab8@haskell.org> References: <050.e45e5fc2b285549e2fcbcab2ac249ab8@haskell.org> Message-ID: <065.1627c5f938b5afc015747a4068df6d67@haskell.org> #14678: GHC 8.4.1-alpha's bundled transformers doesn't correspond to a tagged release -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.4.1 Component: Compiler | Version: 8.4.1-alpha1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): bgamari, was this fixed in 24e56ebd010846683b236b6ef3678c2217640120? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 18:16:53 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 18:16:53 -0000 Subject: [GHC] #14701: Investigate the performance impact of code alignment Message-ID: <042.e11dda7ab3eddd9e4c88a6b0f72299d7@haskell.org> #14701: Investigate the performance impact of code alignment -------------------------------------+------------------------------------- Reporter: nh2 | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 (CodeGen) | 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: -------------------------------------+------------------------------------- Maybe ghc's performance also varies due to reasons like that: https://dendibakh.github.io/blog/2018/01/18/Code_alignment_issues The gist of the article is that tight loops can have significantly different performance depending on whether the location of the assembly instructions themselves cross a cache line. I would not have expected this to make double-digit percentage differences. From `#ghc`: {{{ bgamari: nh2[m], there are nofib tests where this is very likely the cause of a good portion of the variant angerman: nh2[m]: that linked LLVM talk from 2016 makes me not want to have to deal with that... AndreasK: nh2[m]: It's a real issue. But atm I think ghc at least in the native codegen make no real attempt to optimize for this thoughtpolice: GHC does not carry knowledge of alignment or anything, no. I’m not sure how difficult this is to suss out, but at least making sure every branch target does not cross a cache line is probably a good start thoughtpolice: Well, far jump, e.g. a call to a function. not sure how TNTC fits into this story, tbqh }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 18:18:05 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 18:18:05 -0000 Subject: [GHC] #13891: forkIO can trivially defeat bracket In-Reply-To: <046.bb2170e97e55c0c11118313e8136933d@haskell.org> References: <046.bb2170e97e55c0c11118313e8136933d@haskell.org> Message-ID: <061.96d5e68d4b5e180fb31995990e8014e4@haskell.org> #13891: forkIO can trivially defeat bracket -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: Component: Compiler | Version: 8.0.1 Resolution: wontfix | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonmar): * status: new => closed * resolution: => wontfix Comment: The right solution to this is to use `withAsync` from the `async` package instead of `forkIO`. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 18:46:43 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 18:46:43 -0000 Subject: [GHC] #14702: Runtime is keeping hold to too much memory Message-ID: <044.b992e44759d80aa79bda392097ed4c31@haskell.org> #14702: Runtime is keeping hold to too much memory -------------------------------------+------------------------------------- Reporter: blaze | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Runtime | Version: 8.2.2 System | Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: Other Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- Currently runtime only releases memory to OS when it has more than 4x of the amount used. This leads to heavy memory overuse when process is run using many processes and large nurseries. For example, if process is run on 16 CPUs with each having 32MB nursery, it will use total 512MB allocation area. This will push "release boundary" to the 2GB. If process is ever to allocate that much memory for a short term use, it will never be given back to OS and effectively wasted. Nursery and other non-growing data areas should be excluded from this multiplier. Runtime should only keep an extra memory proportional to heap allocation. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 18:46:53 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 18:46:53 -0000 Subject: [GHC] #14606: ghc-exactprint not up to date In-Reply-To: <044.eda8c95560814c75d9806634f1da14ed@haskell.org> References: <044.eda8c95560814c75d9806634f1da14ed@haskell.org> Message-ID: <059.a0c41e900cabb1d5c8dae83b4094bfc4@haskell.org> #14606: ghc-exactprint not up to date -------------------------------------+------------------------------------- Reporter: alanz | Owner: alanz Type: task | Status: new Priority: normal | Milestone: 8.4.1 Component: GHC API | Version: 8.4.1-alpha1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by alanz): Initial tests on https://github.com/alanz/ghc-exactprint/tree/ghc-8.4 are positive. I will close this when I have finished the hackage roundtrip tests. But it looks like this issue will not be a hold up. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 18:47:42 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 18:47:42 -0000 Subject: [GHC] #14702: Runtime is keeping hold to too much memory In-Reply-To: <044.b992e44759d80aa79bda392097ed4c31@haskell.org> References: <044.b992e44759d80aa79bda392097ed4c31@haskell.org> Message-ID: <059.471d4b3abd5e6131784c762e7520ae17@haskell.org> #14702: Runtime is keeping hold to too much memory -------------------------------------+------------------------------------- Reporter: blaze | Owner: blaze Type: bug | Status: new Priority: normal | Milestone: Component: Runtime System | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Other | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by blaze): * owner: (none) => blaze -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 19:01:15 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 19:01:15 -0000 Subject: [GHC] #14703: T14507 testcase fragile due to unique exposed in error message Message-ID: <046.6d2f21966439a971c8f715a8b40d3267@haskell.org> #14703: T14507 testcase fragile due to unique exposed in error message -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Test Suite | Version: 8.4.1-alpha1 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 noticed this failure in the CircleCI output: {{{#!patch --- ./patsyn/should_fail/T14507.run/T14507.stderr.normalised 2018-01-22 18:57:32.381575253 +0000 +++ ./patsyn/should_fail/T14507.run/T14507.comp.stderr.normalised 2018-01-22 18:57:32.381575253 +0000 @@ -2,7 +2,7 @@ T14507.hs:18:9: Iceland Jack! Iceland Jack! Stop torturing me! Pattern-bound variable x :: TypeRep a - has a type that mentions pattern-bound coercion: co_a2CF + has a type that mentions pattern-bound coercion: co_a2D4 Hint: use -fprint-explicit-coercions to see the coercions Probable fix: add a pattern signature In the declaration for pattern synonym ‘SO’ }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 19:01:37 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 19:01:37 -0000 Subject: [GHC] #14519: Exponential runtime performance regression in GHC 8.2 + Data.Text.Lazy + Text.RE.TDFA In-Reply-To: <043.92c07e3e0209c31f0a0f195fa98d301c@haskell.org> References: <043.92c07e3e0209c31f0a0f195fa98d301c@haskell.org> Message-ID: <058.ebaaa0fff7aaf6f55bcb5777a0757f02@haskell.org> #14519: Exponential runtime performance regression in GHC 8.2 + Data.Text.Lazy + Text.RE.TDFA -------------------------------------+------------------------------------- Reporter: ntc2 | Owner: tdammers Type: bug | Status: closed Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.2.2 Resolution: wontfix | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Runtime | Test Case: performance bug | https://github.com/ntc2/ghc-8.2.1 | -regex-lazy-text- | bug/tree/07b7bb32c6e90e8f2d2eada4b59943f37e632d53 Blocked By: | Blocking: Related Tickets: #13745, #14564 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by tdammers): * status: new => closed * resolution: => wontfix Comment: Reported against `text` library probably not a GHC bug. We can always reopen if GHC itself turns out to be the problem after all. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 19:02:15 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 19:02:15 -0000 Subject: [GHC] #14704: Spurious cost-centre test failures Message-ID: <046.aed78b7537a34d382c90181e0bd1ef41@haskell.org> #14704: Spurious cost-centre test failures -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Profiling | Version: 8.2.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: -------------------------------------+------------------------------------- CircleCI seems to routinely turn up spurious differences in cost-center profiler tests, {{{patch --- ./profiling/should_run/scc003.run/scc003.prof.sample.normalised 2018-01-22 18:57:35.961616901 +0000 +++ ./profiling/should_run/scc003.run/scc003.prof.normalised 2018-01-22 18:57:35.961616901 +0000 @@ -1,6 +1,6 @@ MAIN MAIN 0 f Main scc003.hs:5:1-41 1 -f.(...) Main scc003.hs:5:11-21 1 -fib Main scc003.hs:8:1-50 21891 f.\ Main scc003.hs:5:32-41 1 fib Main scc003.hs:8:1-50 2692537 +f.x' Main scc003.hs:5:11-21 1 +fib Main scc003.hs:8:1-50 21891 --- ./profiling/should_run/scc003.run/scc003.prof.sample.normalised 2018-01-22 18:57:37.321632723 +0000 +++ ./profiling/should_run/scc003.run/scc003.prof.normalised 2018-01-22 18:57:37.321632723 +0000 @@ -1,6 +1,6 @@ MAIN MAIN 0 f Main scc003.hs:5:1-41 1 -f.(...) Main scc003.hs:5:11-21 1 -fib Main scc003.hs:8:1-50 21891 f.\ Main scc003.hs:5:32-41 1 fib Main scc003.hs:8:1-50 2692537 +f.x' Main scc003.hs:5:11-21 1 +fib Main scc003.hs:8:1-50 21891 --- ./profiling/should_run/T12962.run/T12962.prof.sample.normalised 2018-01-22 18:57:46.241736499 +0000 +++ ./profiling/should_run/T12962.run/T12962.prof.normalised 2018-01-22 18:57:46.241736499 +0000 @@ -1,4 +1,4 @@ MAIN MAIN 0 -blah Main T12962.hs:15:1-22 1 -niz3 Main T12962.hs:12:1-27 1 -foo Main T12962.hs:8:1-21 100 +blah Main T12962.hs:19:1-22 1 +niz3 Main T12962.hs:16:1-27 1 +foo Main T12962.hs:12:1-21 100 --- ./profiling/should_run/T12962.run/T12962.prof.sample.normalised 2018-01-22 18:57:47.209747760 +0000 +++ ./profiling/should_run/T12962.run/T12962.prof.normalised 2018-01-22 18:57:47.209747760 +0000 @@ -1,4 +1,4 @@ MAIN MAIN 0 -blah Main T12962.hs:15:1-22 1 -niz3 Main T12962.hs:12:1-27 1 -foo Main T12962.hs:8:1-21 100 +blah Main T12962.hs:19:1-22 1 +niz3 Main T12962.hs:16:1-27 1 +foo Main T12962.hs:12:1-21 100 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 19:02:35 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 19:02:35 -0000 Subject: [GHC] #14703: T14507 testcase fragile due to unique exposed in error message In-Reply-To: <046.6d2f21966439a971c8f715a8b40d3267@haskell.org> References: <046.6d2f21966439a971c8f715a8b40d3267@haskell.org> Message-ID: <061.ba92ae8425adf0a45f51b9ba2f5baac0@haskell.org> #14703: T14507 testcase fragile due to unique exposed in error message -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Test Suite | Version: 8.5 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * version: 8.4.1-alpha1 => 8.5 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 19:02:38 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 19:02:38 -0000 Subject: [GHC] #14704: Spurious cost-centre test failures In-Reply-To: <046.aed78b7537a34d382c90181e0bd1ef41@haskell.org> References: <046.aed78b7537a34d382c90181e0bd1ef41@haskell.org> Message-ID: <061.6eae6777b8ba05b79f22d54f9048f6fe@haskell.org> #14704: Spurious cost-centre test failures -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Profiling | Version: 8.5 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * version: 8.2.2 => 8.5 Old description: > CircleCI seems to routinely turn up spurious differences in cost-center > profiler tests, > {{{patch > --- ./profiling/should_run/scc003.run/scc003.prof.sample.normalised > 2018-01-22 18:57:35.961616901 +0000 > +++ ./profiling/should_run/scc003.run/scc003.prof.normalised > 2018-01-22 18:57:35.961616901 +0000 > @@ -1,6 +1,6 @@ > MAIN MAIN 0 > f Main scc003.hs:5:1-41 1 > -f.(...) Main scc003.hs:5:11-21 1 > -fib Main scc003.hs:8:1-50 21891 > f.\ Main scc003.hs:5:32-41 1 > fib Main scc003.hs:8:1-50 2692537 > +f.x' Main scc003.hs:5:11-21 1 > +fib Main scc003.hs:8:1-50 21891 > --- ./profiling/should_run/scc003.run/scc003.prof.sample.normalised > 2018-01-22 18:57:37.321632723 +0000 > +++ ./profiling/should_run/scc003.run/scc003.prof.normalised > 2018-01-22 18:57:37.321632723 +0000 > @@ -1,6 +1,6 @@ > MAIN MAIN 0 > f Main scc003.hs:5:1-41 1 > -f.(...) Main scc003.hs:5:11-21 1 > -fib Main scc003.hs:8:1-50 21891 > f.\ Main scc003.hs:5:32-41 1 > fib Main scc003.hs:8:1-50 2692537 > +f.x' Main scc003.hs:5:11-21 1 > +fib Main scc003.hs:8:1-50 21891 > --- ./profiling/should_run/T12962.run/T12962.prof.sample.normalised > 2018-01-22 18:57:46.241736499 +0000 > +++ ./profiling/should_run/T12962.run/T12962.prof.normalised > 2018-01-22 18:57:46.241736499 +0000 > @@ -1,4 +1,4 @@ > MAIN MAIN 0 > -blah Main T12962.hs:15:1-22 1 > -niz3 Main T12962.hs:12:1-27 1 > -foo Main T12962.hs:8:1-21 100 > +blah Main T12962.hs:19:1-22 1 > +niz3 Main T12962.hs:16:1-27 1 > +foo Main T12962.hs:12:1-21 100 > --- ./profiling/should_run/T12962.run/T12962.prof.sample.normalised > 2018-01-22 18:57:47.209747760 +0000 > +++ ./profiling/should_run/T12962.run/T12962.prof.normalised > 2018-01-22 18:57:47.209747760 +0000 > @@ -1,4 +1,4 @@ > MAIN MAIN 0 > -blah Main T12962.hs:15:1-22 1 > -niz3 Main T12962.hs:12:1-27 1 > -foo Main T12962.hs:8:1-21 100 > +blah Main T12962.hs:19:1-22 1 > +niz3 Main T12962.hs:16:1-27 1 > +foo Main T12962.hs:12:1-21 100 > }}} New description: CircleCI seems to routinely turn up spurious differences in cost-center profiler tests, {{{#!patch --- ./profiling/should_run/scc003.run/scc003.prof.sample.normalised 2018-01-22 18:57:35.961616901 +0000 +++ ./profiling/should_run/scc003.run/scc003.prof.normalised 2018-01-22 18:57:35.961616901 +0000 @@ -1,6 +1,6 @@ MAIN MAIN 0 f Main scc003.hs:5:1-41 1 -f.(...) Main scc003.hs:5:11-21 1 -fib Main scc003.hs:8:1-50 21891 f.\ Main scc003.hs:5:32-41 1 fib Main scc003.hs:8:1-50 2692537 +f.x' Main scc003.hs:5:11-21 1 +fib Main scc003.hs:8:1-50 21891 --- ./profiling/should_run/scc003.run/scc003.prof.sample.normalised 2018-01-22 18:57:37.321632723 +0000 +++ ./profiling/should_run/scc003.run/scc003.prof.normalised 2018-01-22 18:57:37.321632723 +0000 @@ -1,6 +1,6 @@ MAIN MAIN 0 f Main scc003.hs:5:1-41 1 -f.(...) Main scc003.hs:5:11-21 1 -fib Main scc003.hs:8:1-50 21891 f.\ Main scc003.hs:5:32-41 1 fib Main scc003.hs:8:1-50 2692537 +f.x' Main scc003.hs:5:11-21 1 +fib Main scc003.hs:8:1-50 21891 --- ./profiling/should_run/T12962.run/T12962.prof.sample.normalised 2018-01-22 18:57:46.241736499 +0000 +++ ./profiling/should_run/T12962.run/T12962.prof.normalised 2018-01-22 18:57:46.241736499 +0000 @@ -1,4 +1,4 @@ MAIN MAIN 0 -blah Main T12962.hs:15:1-22 1 -niz3 Main T12962.hs:12:1-27 1 -foo Main T12962.hs:8:1-21 100 +blah Main T12962.hs:19:1-22 1 +niz3 Main T12962.hs:16:1-27 1 +foo Main T12962.hs:12:1-21 100 --- ./profiling/should_run/T12962.run/T12962.prof.sample.normalised 2018-01-22 18:57:47.209747760 +0000 +++ ./profiling/should_run/T12962.run/T12962.prof.normalised 2018-01-22 18:57:47.209747760 +0000 @@ -1,4 +1,4 @@ MAIN MAIN 0 -blah Main T12962.hs:15:1-22 1 -niz3 Main T12962.hs:12:1-27 1 -foo Main T12962.hs:8:1-21 100 +blah Main T12962.hs:19:1-22 1 +niz3 Main T12962.hs:16:1-27 1 +foo Main T12962.hs:12:1-21 100 }}} -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 19:04:49 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 19:04:49 -0000 Subject: [GHC] #14705: ghc-iserv sometimes segfaults in profiled way Message-ID: <046.be67f06c8a68b32fb302ce316ee26108@haskell.org> #14705: ghc-iserv sometimes segfaults in profiled way -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Profiling | Version: 8.5 Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: Runtime crash Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- I have seen a few testsuite failures due to `ghc-iserv` crashes like these, {{{ --- ./profiling/should_run/T5363.run/T5363.stdout.normalised 2018-01-22 18:57:49.401773263 +0000 +++ ./profiling/should_run/T5363.run/T5363.run.stdout.normalised 2018-01-22 18:57:49.401773263 +0000 @@ -1 +1 @@ -1250030000000 +ghc-stage2: ghc-iserv terminated (-7) *** unexpected failure for T5363(ghci-ext-prof) Actual stdout output differs from expected: --- ./profiling/should_run/scc001.run/scc001.stdout.normalised 2018-01-22 18:57:45.177724120 +0000 +++ ./profiling/should_run/scc001.run/scc001.run.stdout.normalised 2018-01-22 18:57:45.177724120 +0000 @@ -1,3 +1,3 @@ True 3 -'a' +ghc-stage2: ghc-iserv terminated (-11) *** unexpected failure for scc001(ghci-ext-prof) }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 19:08:01 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 19:08:01 -0000 Subject: [GHC] #14706: T11489 fails if run as root Message-ID: <046.a14b90f533f833e4ef6e5c85c8add140@haskell.org> #14706: T11489 fails if run as root -------------------------------------+------------------------------------- Reporter: bgamari | Owner: bgamari Type: bug | Status: new Priority: normal | Milestone: Component: Continuous | Version: 8.5 Integration | 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: -------------------------------------+------------------------------------- The testcase `T11489` tests for #11489 by creating a `.prof` file, removing its write bit, and trying to run a program with profiling enabled. Usually the program would fail with an error message as the RTS can't open the `.prof` file for writing. However, when run as `root` the test succeeds. "What madman would compile GHC as `root`?" you ask? Well, CircleCI runs builds as `root` by default. It seems like running builds under Docker is one way around this, although this seems like a pretty large hammer just to eliminate a single test failure. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 19:08:37 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 19:08:37 -0000 Subject: [GHC] #14694: Can't coerce given assumptions In-Reply-To: <051.a24047975aac3bbc5e443262dff8c929@haskell.org> References: <051.a24047975aac3bbc5e443262dff8c929@haskell.org> Message-ID: <066.bbc961189f11a0336809dc6a828b7fac@haskell.org> #14694: Can't coerce given assumptions -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Roles Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by goldfire): * keywords: => Roles Comment: This is yet another incompleteness in the solver. A given like `cat a b ~R (a -> f b)` cannot be decomposed, as the typing rules for roles forbids this. Currently, GHC remembers the given and uses it only if a wanted matches the given exactly. Thus, this ticket. One approach would be to have some structure that remembers `cat a b` maps to `a -> f b` and then use this to look up types. Actually, this wouldn't even be all that hard: the left-hand sides would all be `AppTy`s (as plain old tyvars already have their own mechanism: `CTyEqCan`), and I believe just handling a top-level `AppTy` would be enough to make this approach complete. (I don't believe we'd ever need to look for a nested `AppTy` -- say, as the argument to a tycon -- because we'll decompose larger types until the `AppTy` bubbles up to the top.) We could just build a `TrieMap` mapping types to types; put a new entry in the `TrieMap` on given `AppTy` equalities and look up in the `TrieMap` on wanteds. Perhaps there's more to it than this, but I don't really think so. Iceland_jack, do you remember if there's a place where we collect representational incompletenesses? This is not the first. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 19:11:34 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 19:11:34 -0000 Subject: [GHC] #12758: Bring sanity to our performance testsuite In-Reply-To: <046.023630bbf855f7a4ed786cb14a3639ea@haskell.org> References: <046.023630bbf855f7a4ed786cb14a3639ea@haskell.org> Message-ID: <061.81a7c8c49a91d5fcb07111f19b00aad9@haskell.org> #12758: Bring sanity to our performance testsuite -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: task | Status: new Priority: normal | Milestone: 8.6.1 Component: Test Suite | Version: 8.0.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): A quick update: Last summer Jared Weakly implemented the proposal of this ticket. The result is Phab:D3758. At the time the plan was to switch to Jenkins in the fall (see #13716) and incorporate his work at that point since it requires a bit of integration with CI. However, shortly before ICFP we started a discussion which culminated in the decision to instead move CI to CircleCI. This process is still on-going (see wiki:ContinuousIntegration) but is nearly an end, at which point we will be able to move ahead with Phab:D3758. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 19:12:21 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 19:12:21 -0000 Subject: [GHC] #12758: Bring sanity to our performance testsuite In-Reply-To: <046.023630bbf855f7a4ed786cb14a3639ea@haskell.org> References: <046.023630bbf855f7a4ed786cb14a3639ea@haskell.org> Message-ID: <061.549f772e67332efc7108f891a94ae108@haskell.org> #12758: Bring sanity to our performance testsuite -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: task | Status: new Priority: high | Milestone: 8.6.1 Component: Test Suite | Version: 8.0.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * priority: normal => high -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 19:20:19 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 19:20:19 -0000 Subject: [GHC] #14703: T14507 testcase fragile due to unique exposed in error message In-Reply-To: <046.6d2f21966439a971c8f715a8b40d3267@haskell.org> References: <046.6d2f21966439a971c8f715a8b40d3267@haskell.org> Message-ID: <061.f912ec880bfc356182956983396fc1ee@haskell.org> #14703: T14507 testcase fragile due to unique exposed in error message -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Test Suite | Version: 8.5 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Ryan Scott ): In [changeset:"452dee3ff4f385977e56ac0fbb5adf0a90acbcac/ghc" 452dee3f/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="452dee3ff4f385977e56ac0fbb5adf0a90acbcac" Pass -dsuppress-uniques when running T14507 Not doing so resulted in different uniques being printed on different environments, as shown in #14703. }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 19:21:33 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 19:21:33 -0000 Subject: [GHC] #14703: T14507 testcase fragile due to unique exposed in error message In-Reply-To: <046.6d2f21966439a971c8f715a8b40d3267@haskell.org> References: <046.6d2f21966439a971c8f715a8b40d3267@haskell.org> Message-ID: <061.e4330f4a4e068eae13f8479326c80886@haskell.org> #14703: T14507 testcase fragile due to unique exposed in error message -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: Component: Test Suite | Version: 8.5 Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * status: new => closed * resolution: => fixed Comment: Oops! Fortunately, an easy fix. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 19:34:17 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 19:34:17 -0000 Subject: [GHC] #13154: Standalone-derived anyclass instances aren't as permissive as empty instances In-Reply-To: <050.313c7572181a73220f1b076de5274da4@haskell.org> References: <050.313c7572181a73220f1b076de5274da4@haskell.org> Message-ID: <065.e9f449389e100420f1b3899f725314ce@haskell.org> #13154: Standalone-derived anyclass instances aren't as permissive as empty instances -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: RyanGlScott Type: bug | Status: patch Priority: normal | Milestone: 8.6.1 Component: Compiler (Type | Version: 8.1 checker) | Resolution: | Keywords: deriving Operating System: Unknown/Multiple | Architecture: Type of failure: GHC rejects | Unknown/Multiple valid program | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D3337 Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): Another component of this issue which Iceland_jack noticed is that one cannot standalone-derive any instances for primitive types, among which include `(->)`: {{{#!hs {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE StandaloneDeriving #-} module Bug where import GHC.Exts class C1 a deriving instance C1 (a -> b) class C2 (a :: TYPE 'IntRep) deriving instance C2 Int# }}} {{{ $ ghc/inplace/bin/ghc-stage2 Bug.hs [1 of 1] Compiling Bug ( Bug.hs, Bug.o ) Bug.hs:11:1: error: • Can't make a derived instance of ‘C1 (a -> b)’: The last argument of the instance must be a data or newtype application • In the stand-alone deriving instance for ‘C1 (a -> b)’ | 11 | deriving instance C1 (a -> b) | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ Bug.hs:14:1: error: • Can't make a derived instance of ‘C2 Int#’: The last argument of the instance must be a data or newtype application • In the stand-alone deriving instance for ‘C2 Int#’ | 14 | deriving instance C2 Int# | ^^^^^^^^^^^^^^^^^^^^^^^^^ }}} I'll lump this bug under this ticket. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 19:35:37 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 19:35:37 -0000 Subject: [GHC] #14705: ghc-iserv sometimes segfaults in profiled way In-Reply-To: <046.be67f06c8a68b32fb302ce316ee26108@haskell.org> References: <046.be67f06c8a68b32fb302ce316ee26108@haskell.org> Message-ID: <061.62562d535e93950173c447f0cb6f46c8@haskell.org> #14705: ghc-iserv sometimes segfaults in profiled way -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Profiling | Version: 8.5 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Runtime crash | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): Looking at `scc001`, it looks like we get into trouble in the interpreter, {{{ Program received signal SIGSEGV, Segmentation fault. [Switching to Thread 0x7ffff647f700 (LWP 108910)] interpretBCO (cap=0x216c5c0 ) at rts/Interpreter.c:395 395 switch ( get_itbl(obj)->type ) { (gdb) print obj $1 = (gdb) print get_itbl(obj) value has been optimized out (gdb) print get_itbl(obj)->type value has been optimized out (gdb) info locals Sp = 0x420029fcc0 SpLim = 0x42002980d0 tagged_obj = 0x1c7b9b8 obj = n = m = }}} For future reference, getting here involved, {{{ $ cd testsuite/tests/profiling/should_run/ $ make test TEST=scc001 VERBOSE=4 CLEANUP=NO $ gdb --args $HOME/project/inplace/lib/bin/ghc-stage2 -B$HOME/project/inplace/lib scc001.hs -dcore-lint -ddump-bcos -v -fexternal-interpreter -prof -fno-state-hack -fno-full-laziness --interactive ... (gdb) set follow-fork-mode child (gdb) run ... *Main> :main }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 19:36:30 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 19:36:30 -0000 Subject: [GHC] #13154: Standalone-derived anyclass instances aren't as permissive as empty instances In-Reply-To: <050.313c7572181a73220f1b076de5274da4@haskell.org> References: <050.313c7572181a73220f1b076de5274da4@haskell.org> Message-ID: <065.2a9ed3a8530ecb6f3214be13e27c79d1@haskell.org> #13154: Standalone-derived anyclass instances aren't as permissive as empty instances -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler (Type | Version: 8.1 checker) | Resolution: | Keywords: deriving Operating System: Unknown/Multiple | Architecture: Type of failure: GHC rejects | Unknown/Multiple valid program | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * status: patch => new * owner: RyanGlScott => (none) * differential: Phab:D3337 => Comment: Removing Phab:D3337 as the Diff for this, since it's been abandoned. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 19:41:23 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 19:41:23 -0000 Subject: [GHC] #13154: Standalone-derived anyclass instances aren't as permissive as empty instances In-Reply-To: <050.313c7572181a73220f1b076de5274da4@haskell.org> References: <050.313c7572181a73220f1b076de5274da4@haskell.org> Message-ID: <065.f6b01bbe54038503ded6e6fff94e979d@haskell.org> #13154: Standalone-derived anyclass instances aren't as permissive as empty instances -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: RyanGlScott Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler (Type | Version: 8.1 checker) | Resolution: | Keywords: deriving Operating System: Unknown/Multiple | Architecture: Type of failure: GHC rejects | Unknown/Multiple valid program | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * owner: (none) => RyanGlScott Comment: See also commits: * a4f347c23ed926c24d178fec54c27d94f1fae0e4 (`Split out inferConstraintsDataConArgs from inferConstraints`) * ed7a830de6a2ea74dd6bb81f8ec55b9fe0b52f28 (`Use a ReaderT in TcDeriv to avoid some tedious plumbing`) * 9cb289abc582c9eb8337a2621baf58e35feeff46 (`Remove hack put in place for #12512`) Which have made progress towards fixing this ticket (but on whose commit messages I forgot to mention it). -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 19:46:27 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 19:46:27 -0000 Subject: [GHC] #13154: Standalone-derived anyclass instances aren't as permissive as empty instances In-Reply-To: <050.313c7572181a73220f1b076de5274da4@haskell.org> References: <050.313c7572181a73220f1b076de5274da4@haskell.org> Message-ID: <065.5bb1e8f8ca6af42c1b8fe1dff0845064@haskell.org> #13154: Standalone-derived anyclass instances aren't as permissive as empty instances -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: RyanGlScott Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler (Type | Version: 8.1 checker) | Resolution: | Keywords: deriving Operating System: Unknown/Multiple | Architecture: Type of failure: GHC rejects | Unknown/Multiple valid program | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D3337 Wiki Page: | -------------------------------------+------------------------------------- Changes (by Iceland_jack): * cc: Iceland_jack (added) * differential: => Phab:D3337 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 19:47:06 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 19:47:06 -0000 Subject: [GHC] #13154: Standalone-derived anyclass instances aren't as permissive as empty instances In-Reply-To: <050.313c7572181a73220f1b076de5274da4@haskell.org> References: <050.313c7572181a73220f1b076de5274da4@haskell.org> Message-ID: <065.fcdef9f8a2a81d25cc059c1840cb3416@haskell.org> #13154: Standalone-derived anyclass instances aren't as permissive as empty instances -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: RyanGlScott Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler (Type | Version: 8.1 checker) | Resolution: | Keywords: deriving Operating System: Unknown/Multiple | Architecture: Type of failure: GHC rejects | Unknown/Multiple valid program | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by Iceland_jack): * differential: Phab:D3337 => -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 19:48:50 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 19:48:50 -0000 Subject: [GHC] #14691: Replace EvTerm with CoreExpr In-Reply-To: <046.62945affcc6cc14a9778d709349ac741@haskell.org> References: <046.62945affcc6cc14a9778d709349ac741@haskell.org> Message-ID: <061.9e17801e2dd37f8833760066e664120d@haskell.org> #14691: Replace EvTerm with CoreExpr -------------------------------------+------------------------------------- Reporter: nomeata | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.3 checker) | Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by nomeata): Hmpf, no matter how I shake it, it converges back to having many constructors for `EvTerm`. At first I added only `EvTypeable`, because we have determined that we cannot create the Core for that during constraint solving. But then I find code like this: {{{ rewriteEvidence ev@(CtWanted { ctev_dest = dest , ctev_loc = loc }) new_pred co = do { mb_new_ev <- newWanted loc new_pred ; MASSERT( tcCoercionRole co == ctEvRole ev ) ; setWantedEvTerm dest (mkEvCast (getEvTerm mb_new_ev) (tcDowngradeRole Representational (ctEvRole ev) co)) ; case mb_new_ev of Fresh new_ev -> continueWith new_ev Cached _ -> stopWith ev "Cached wanted" } }}} where an arbitrary `EvTerm`, the result of `getEvTerm` needs to be casted. I cannot use Core’s `Cast` for that, because the `EvTerm` may be a `EvTypeable`. So seems that I need to add the `EvCast` constructor back to `EvTerm` … and bit by bit I am undoing the refactoring that I was hoping to do here… Maybe the better thing to do is to leave all the existing constructors in place, and just add `EvExpr :: CoreExpr -> EvTerm` as an additional leaf constructor. This way, the existing code structure can remain. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 20:06:42 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 20:06:42 -0000 Subject: [GHC] #6087: Join points need strictness analysis In-Reply-To: <046.87e3f1b25b2500e98f2a686fd50954f8@haskell.org> References: <046.87e3f1b25b2500e98f2a686fd50954f8@haskell.org> Message-ID: <061.9fb40d9d539d5558f52199cb8467f1b1@haskell.org> #6087: Join points need strictness analysis -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: infoneeded Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 7.4.1 Resolution: | Keywords: JoinPoints 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: | -------------------------------------+------------------------------------- Comment (by bgamari): osa1, can you take care of this? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 20:18:53 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 20:18:53 -0000 Subject: [GHC] #14678: GHC 8.4.1-alpha's bundled transformers doesn't correspond to a tagged release In-Reply-To: <050.e45e5fc2b285549e2fcbcab2ac249ab8@haskell.org> References: <050.e45e5fc2b285549e2fcbcab2ac249ab8@haskell.org> Message-ID: <065.7f8812f23c79e1f58d5acfb97e62205f@haskell.org> #14678: GHC 8.4.1-alpha's bundled transformers doesn't correspond to a tagged release -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: closed Priority: highest | Milestone: 8.4.1 Component: Compiler | Version: 8.4.1-alpha1 Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: new => closed * resolution: => fixed Comment: Indeed it was. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 20:20:05 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 20:20:05 -0000 Subject: [GHC] #14699: Library status for 8.4.1 In-Reply-To: <046.12f775ea02060174a5ac178f457055aa@haskell.org> References: <046.12f775ea02060174a5ac178f457055aa@haskell.org> Message-ID: <061.43ac3a9c24c992ad1ec6c597cf62ce60@haskell.org> #14699: Library status for 8.4.1 -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: task | Status: new Priority: highest | Milestone: 8.4.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Old description: > ||= package =||= status =||= reference =|| > || `Cabal` || needs release || || > || `Win32` || on-release || || > || `array` || Needs revision || || > || `binary` || on-release || || > || `bytestring` || on-release || || > || `containers` || needs release || > https://github.com/haskell/containers/issues/501 || > || `deepseq` || needs revision || || > || `directory` || on-release || || > || `filepath` || needs release || > https://github.com/haskell/filepath/issues/65 || > || `haskeline` || ready || https://github.com/judah/haskeline/issues/75 > || > || `hpc` || needs release || || > || `mtl` || needs release || https://github.com/haskell/mtl/issues/52 || > || `parallel` || needs revision || || > || `parsec` || needs release || > https://github.com/haskell/parsec/issues/86 || > || `pretty` || needs release || > https://github.com/haskell/pretty/issues/47 || > || `primitive` || needs release || > https://github.com/haskell/primitive/issues/72 || > || `process` || ready || https://github.com/haskell/primitive/issues/72 > || > || `stm` || needs release || #14698 || > || `terminfo` || ready || https://github.com/judah/terminfo/issues/27 || > || `text` || needs release || https://github.com/haskell/text/issues/215 > || > || `time` || on-release || || > || `transformers` || needs update || #14678 || > || `unix` || needs release || https://github.com/haskell/unix/issues/106 > || > || `haddock` || needs release || > https://github.com/haskell/haddock/issues/737 || New description: ||= package =||= status =||= reference =|| || `Cabal` || needs release || || || `Win32` || on-release || || || `array` || Needs revision || || || `binary` || on-release || || || `bytestring` || on-release || || || `containers` || needs release || https://github.com/haskell/containers/issues/501 || || `deepseq` || needs revision || || || `directory` || on-release || || || `filepath` || needs release || https://github.com/haskell/filepath/issues/65 || || `haskeline` || ready || https://github.com/judah/haskeline/issues/75 || || `hpc` || needs release || || || `mtl` || needs release || https://github.com/haskell/mtl/issues/52 || || `parallel` || needs revision || || || `parsec` || needs release || https://github.com/haskell/parsec/issues/86 || || `pretty` || needs release || https://github.com/haskell/pretty/issues/47 || || `primitive` || needs release || https://github.com/haskell/primitive/issues/72 || || `process` || ready || https://github.com/haskell/primitive/issues/72 || || `stm` || needs release || #14698 || || `terminfo` || ready || https://github.com/judah/terminfo/issues/27 || || `text` || needs release || https://github.com/haskell/text/issues/215 || || `time` || on-release || || || `transformers` || ready || #14678 || || `unix` || needs release || https://github.com/haskell/unix/issues/106 || || `haddock` || needs release || https://github.com/haskell/haddock/issues/737 || -- Comment (by bgamari): The `transformers` mirror has been updated and the submodule updated to 0.5.5.0. Also, I've added some notes on the mechanics of updating the `transformers` mirror to wiki:Repositories. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 20:54:17 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 20:54:17 -0000 Subject: [GHC] #13154: Standalone-derived anyclass instances aren't as permissive as empty instances In-Reply-To: <050.313c7572181a73220f1b076de5274da4@haskell.org> References: <050.313c7572181a73220f1b076de5274da4@haskell.org> Message-ID: <065.42a5eae2252fda6bd5ca62519b3930a4@haskell.org> #13154: Standalone-derived anyclass instances aren't as permissive as empty instances -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: RyanGlScott Type: bug | Status: patch Priority: normal | Milestone: 8.6.1 Component: Compiler (Type | Version: 8.1 checker) | Resolution: | Keywords: deriving Operating System: Unknown/Multiple | Architecture: Type of failure: GHC rejects | Unknown/Multiple valid program | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4337 Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * status: new => patch * differential: => Phab:D4337 Comment: Phab:D4337 fixes the issue in comment:8. It does //not// fix the entire issue, as there is still the degenerate case of: {{{#!hs {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE StandaloneDeriving #-} class C a deriving instance C a }}} Which needs further patching to fix. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 21:19:55 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 21:19:55 -0000 Subject: [GHC] #14702: Runtime is keeping hold to too much memory In-Reply-To: <044.b992e44759d80aa79bda392097ed4c31@haskell.org> References: <044.b992e44759d80aa79bda392097ed4c31@haskell.org> Message-ID: <059.5dd466d10a274285186a32e7c620c3d3@haskell.org> #14702: Runtime is keeping hold to too much memory -------------------------------------+------------------------------------- Reporter: blaze | Owner: blaze Type: bug | Status: new Priority: normal | Milestone: Component: Runtime System | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Other | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): D4338 Wiki Page: | -------------------------------------+------------------------------------- Changes (by blaze): * differential: => D4338 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 21:20:51 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 21:20:51 -0000 Subject: [GHC] #14702: Runtime is keeping hold to too much memory In-Reply-To: <044.b992e44759d80aa79bda392097ed4c31@haskell.org> References: <044.b992e44759d80aa79bda392097ed4c31@haskell.org> Message-ID: <059.2e8b1b0a8d8015132c713bc1ca9309da@haskell.org> #14702: Runtime is keeping hold to too much memory -------------------------------------+------------------------------------- Reporter: blaze | Owner: blaze Type: bug | Status: new Priority: normal | Milestone: Component: Runtime System | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Other | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4338 Wiki Page: | -------------------------------------+------------------------------------- Changes (by blaze): * differential: D4338 => Phab:D4338 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 21:31:14 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 21:31:14 -0000 Subject: [GHC] #14694: Can't coerce given assumptions In-Reply-To: <051.a24047975aac3bbc5e443262dff8c929@haskell.org> References: <051.a24047975aac3bbc5e443262dff8c929@haskell.org> Message-ID: <066.dfb722bcc7b395667892616c87d31978@haskell.org> #14694: Can't coerce given assumptions -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Roles Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Just to be clear about what Richard means when he says "incompleteness", it's this: there is a solution, we don't find it. Specifically we have {{{ [G] (cat a b) ~R (a -> f b) [W] cat a b ~R (a -> WF f b) }}} Applying the `[G]` transitively with the `[W]` wanted, we'd get {{{ [W] (a -> f b) ~R (a -> WF f b) }}} which we can certainly solve easily. It's annoying that GHC's solver can't spot this. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 21:39:13 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 21:39:13 -0000 Subject: [GHC] #14703: Uniques should not appear in error messages (was: T14507 testcase fragile due to unique exposed in error message) In-Reply-To: <046.6d2f21966439a971c8f715a8b40d3267@haskell.org> References: <046.6d2f21966439a971c8f715a8b40d3267@haskell.org> Message-ID: <061.bbc1f9eb54c0b5dfc8e46b8d7e3600d8@haskell.org> #14703: Uniques should not appear in error messages -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Test Suite | Version: 8.5 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * status: closed => new * resolution: fixed => Comment: This feels like the wrong solution. We really shouldn't print uniques in user error messages in the first place. Still, it's very much a corner case, so I'm not sure it's worth many cycles to fix. But I'll re-open as "uniques should not appear in error messages". -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 21:46:03 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 21:46:03 -0000 Subject: [GHC] #14691: Replace EvTerm with CoreExpr In-Reply-To: <046.62945affcc6cc14a9778d709349ac741@haskell.org> References: <046.62945affcc6cc14a9778d709349ac741@haskell.org> Message-ID: <061.477d861692e93d2a4dd5fe0470709a34@haskell.org> #14691: Replace EvTerm with CoreExpr -------------------------------------+------------------------------------- Reporter: nomeata | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.3 checker) | Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): > I cannot use Core’s Cast for that, because the EvTerm may be a EvTypeable. I think you can. `getEvTerm` calls `ctEvTerm` which always returns either an `EvId` (which we can do in Core) or an `EvCoercion` (ditto). Aside from coercions (alas) all evidence is represented just by an Id. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 22:02:42 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 22:02:42 -0000 Subject: [GHC] #14691: Replace EvTerm with CoreExpr In-Reply-To: <046.62945affcc6cc14a9778d709349ac741@haskell.org> References: <046.62945affcc6cc14a9778d709349ac741@haskell.org> Message-ID: <061.b7a57a00a92693886e15ab44d4aa6daf@haskell.org> #14691: Replace EvTerm with CoreExpr -------------------------------------+------------------------------------- Reporter: nomeata | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.3 checker) | Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by nomeata): > I think you can. getEvTerm calls ctEvTerm which always returns either an EvId (which we can do in Core) or an EvCoercion (ditto). Aside from coercions (alas) all evidence is represented just by an Id. Ah, is that an invariant? Could we encode that in the types somehow? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 22:05:51 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 22:05:51 -0000 Subject: [GHC] #14691: Replace EvTerm with CoreExpr In-Reply-To: <046.62945affcc6cc14a9778d709349ac741@haskell.org> References: <046.62945affcc6cc14a9778d709349ac741@haskell.org> Message-ID: <061.b52db91def46f466f5008aef6041d0b7@haskell.org> #14691: Replace EvTerm with CoreExpr -------------------------------------+------------------------------------- Reporter: nomeata | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.3 checker) | Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by nomeata): I guess I can answer that myself, and will give it a try. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 22:36:02 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 22:36:02 -0000 Subject: [GHC] #14707: setNumCapabilities can cause threads to get stuck in gcWorkerThread Message-ID: <043.ca2e764157922265dec6f8538e826907@haskell.org> #14707: setNumCapabilities can cause threads to get stuck in gcWorkerThread -------------------------------------+------------------------------------- Reporter: duog | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Runtime | Version: 8.5 System | 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 have a patch with some instrumentation that proves that sometimes threads do not leave gcWorkerThread until the following gc. I suspect it's caused by `idle_caps` being mutated in `scheduleDoGC` after the call to `requestSync`. A thread enters `yieldCapability` sees that itself is not idle, so enters `gcWorkerThread`, but then `idle_caps` is mutated so that that thread *is* idle, and it's spin locks are not touched by the garbage collector. Potential fixes: * Don't look at `idle_caps` in the garbage collector when we're touching the spin-locks, just do it for all capabilities. I don't *think* this does any harm. * Don't mutate `idle_caps` after the call to `requestSync`; move that logic to before the call. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 22:36:20 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 22:36:20 -0000 Subject: [GHC] #13362: GHC first generation of GC to be as large as largest cache size by default In-Reply-To: <045.9df30bf1acd19df01317b133116e51f6@haskell.org> References: <045.9df30bf1acd19df01317b133116e51f6@haskell.org> Message-ID: <060.b42c378f9c56266c003edd056ff603aa@haskell.org> #13362: GHC first generation of GC to be as large as largest cache size by default -------------------------------------+------------------------------------- Reporter: varosi | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: 8.6.1 Component: Runtime System | Version: 8.0.2 Resolution: | Keywords: numa cache gc 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: | -------------------------------------+------------------------------------- Comment (by varosi): I vote for this! It's not hard to be implemented I hope, but affect performance a lot on more hardware. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 22:36:46 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 22:36:46 -0000 Subject: [GHC] #14707: setNumCapabilities can cause threads to get stuck in gcWorkerThread In-Reply-To: <043.ca2e764157922265dec6f8538e826907@haskell.org> References: <043.ca2e764157922265dec6f8538e826907@haskell.org> Message-ID: <058.071162094f9ace54c3f07f16228a979e@haskell.org> #14707: setNumCapabilities can cause threads to get stuck in gcWorkerThread -------------------------------------+------------------------------------- Reporter: duog | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Runtime System | Version: 8.5 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Description changed by duog: Old description: > I have a patch with some instrumentation that proves that sometimes > threads do not leave gcWorkerThread until the following gc. > > I suspect it's caused by `idle_caps` being mutated in `scheduleDoGC` > after the call to `requestSync`. A thread enters `yieldCapability` sees > that itself is not idle, so enters `gcWorkerThread`, but then `idle_caps` > is mutated so that that thread *is* idle, and it's spin locks are not > touched by the garbage collector. > > Potential fixes: > * Don't look at `idle_caps` in the garbage collector when we're touching > the spin-locks, just do it for all capabilities. I don't *think* this > does any harm. > * Don't mutate `idle_caps` after the call to `requestSync`; move that > logic to before the call. New description: I have a patch with some instrumentation that proves that sometimes threads do not leave gcWorkerThread until the following gc. I suspect it's caused by `idle_caps` being mutated in `scheduleDoGC` after the call to `requestSync`. A thread enters `yieldCapability` sees that itself is not idle, so enters `gcWorkerThread`, but then `idle_caps` is mutated so that that thread ''is'' idle, and it's spin locks are not touched by the garbage collector. Potential fixes: * Don't look at `idle_caps` in the garbage collector when we're touching the spin-locks, just do it for all capabilities. I don't ''think'' this does any harm. * Don't mutate `idle_caps` after the call to `requestSync`; move that logic to before the call. -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 22 22:43:11 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 22 Jan 2018 22:43:11 -0000 Subject: [GHC] #14707: setNumCapabilities can cause threads to get stuck in gcWorkerThread In-Reply-To: <043.ca2e764157922265dec6f8538e826907@haskell.org> References: <043.ca2e764157922265dec6f8538e826907@haskell.org> Message-ID: <058.292844dbd7e6c82b687136a8fef596f2@haskell.org> #14707: setNumCapabilities can cause threads to get stuck in gcWorkerThread -------------------------------------+------------------------------------- Reporter: duog | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Runtime System | Version: 8.5 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Description changed by duog: Old description: > I have a patch with some instrumentation that proves that sometimes > threads do not leave gcWorkerThread until the following gc. > > I suspect it's caused by `idle_caps` being mutated in `scheduleDoGC` > after the call to `requestSync`. A thread enters `yieldCapability` sees > that itself is not idle, so enters `gcWorkerThread`, but then `idle_caps` > is mutated so that that thread ''is'' idle, and it's spin locks are not > touched by the garbage collector. > > Potential fixes: > * Don't look at `idle_caps` in the garbage collector when we're touching > the spin-locks, just do it for all capabilities. I don't ''think'' this > does any harm. > * Don't mutate `idle_caps` after the call to `requestSync`; move that > logic to before the call. New description: I have a patch with some instrumentation (Phab:D4339) that proves that sometimes threads do not leave gcWorkerThread until the following gc. I suspect it's caused by `idle_caps` being mutated in `scheduleDoGC` after the call to `requestSync`. A thread enters `yieldCapability` sees that itself is not idle, so enters `gcWorkerThread`, but then `idle_caps` is mutated so that that thread ''is'' idle, and it's spin locks are not touched by the garbage collector. Potential fixes: * Don't look at `idle_caps` in the garbage collector when we're touching the spin-locks, just do it for all capabilities. I don't ''think'' this does any harm. * Don't mutate `idle_caps` after the call to `requestSync`; move that logic to before the call. Of course, maybe I'm misunderstanding and this isn't a bug? -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 23 00:34:41 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 23 Jan 2018 00:34:41 -0000 Subject: [GHC] #8740: Deriving instance conditionally compiles In-Reply-To: <050.1c0f14a319b334387d7bd66c85f19a98@haskell.org> References: <050.1c0f14a319b334387d7bd66c85f19a98@haskell.org> Message-ID: <065.a60cc667c7797bf67bf21b0e05778946@haskell.org> #8740: Deriving instance conditionally compiles -------------------------------------+------------------------------------- Reporter: thomaseding | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 7.6.3 checker) | Keywords: GADTs, Resolution: | deriving Operating System: Unknown/Multiple | Architecture: Type of failure: GHC rejects | Unknown/Multiple valid program | Test Case: Blocked By: | Blocking: Related Tickets: #8128 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): Indeed I was bitten by this just now. This is quite an unfortunate behavior. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 23 01:08:14 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 23 Jan 2018 01:08:14 -0000 Subject: [GHC] #14669: 32-bit binaries sometimes throw a stack overflow on shutdown. In-Reply-To: <044.45c88c9a13190d9f2a70cd9b35309cc0@haskell.org> References: <044.45c88c9a13190d9f2a70cd9b35309cc0@haskell.org> Message-ID: <059.7f0545a22ec2d80158e371df2b24e98f@haskell.org> #14669: 32-bit binaries sometimes throw a stack overflow on shutdown. -----------------------------------+---------------------------------- Reporter: sergv | Owner: (none) Type: bug | Status: infoneeded Priority: normal | Milestone: Component: Runtime System | Version: 8.2.1 Resolution: | Keywords: Operating System: Windows | Architecture: x86 Type of failure: Runtime crash | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -----------------------------------+---------------------------------- Comment (by Phyx-): alright, well that's annoying.. at `-O1` or higher the optimizers optimize away the calls to `___chkstk_ms`. Which means the stack is not probed so it doesn't grow. This explains why the resulting stack access is nonsense. The optimizers need to be taught to leave this call alone. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 23 01:27:50 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 23 Jan 2018 01:27:50 -0000 Subject: [GHC] #14669: 32-bit binaries sometimes throw a stack overflow on shutdown. In-Reply-To: <044.45c88c9a13190d9f2a70cd9b35309cc0@haskell.org> References: <044.45c88c9a13190d9f2a70cd9b35309cc0@haskell.org> Message-ID: <059.00a0d9e72eeb0188f549fd7ecb261686@haskell.org> #14669: 32-bit binaries sometimes throw a stack overflow on shutdown. -----------------------------------+---------------------------------- Reporter: sergv | Owner: (none) Type: bug | Status: infoneeded Priority: normal | Milestone: Component: Runtime System | Version: 8.2.1 Resolution: | Keywords: Operating System: Windows | Architecture: x86 Type of failure: Runtime crash | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -----------------------------------+---------------------------------- Comment (by Phyx-): Hmm well actually maybe we just have to request it.. can you try again at `-O1` but this time also add `-fstack-check` when compiling that file. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 23 06:10:11 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 23 Jan 2018 06:10:11 -0000 Subject: [GHC] #14699: Library status for 8.4.1 In-Reply-To: <046.12f775ea02060174a5ac178f457055aa@haskell.org> References: <046.12f775ea02060174a5ac178f457055aa@haskell.org> Message-ID: <061.10e95c1acf5955608b2401202cee4bef@haskell.org> #14699: Library status for 8.4.1 -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: task | Status: new Priority: highest | Milestone: 8.4.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Old description: > ||= package =||= status =||= reference =|| > || `Cabal` || needs release || || > || `Win32` || on-release || || > || `array` || Needs revision || || > || `binary` || on-release || || > || `bytestring` || on-release || || > || `containers` || needs release || > https://github.com/haskell/containers/issues/501 || > || `deepseq` || needs revision || || > || `directory` || on-release || || > || `filepath` || needs release || > https://github.com/haskell/filepath/issues/65 || > || `haskeline` || ready || https://github.com/judah/haskeline/issues/75 > || > || `hpc` || needs release || || > || `mtl` || needs release || https://github.com/haskell/mtl/issues/52 || > || `parallel` || needs revision || || > || `parsec` || needs release || > https://github.com/haskell/parsec/issues/86 || > || `pretty` || needs release || > https://github.com/haskell/pretty/issues/47 || > || `primitive` || needs release || > https://github.com/haskell/primitive/issues/72 || > || `process` || ready || https://github.com/haskell/primitive/issues/72 > || > || `stm` || needs release || #14698 || > || `terminfo` || ready || https://github.com/judah/terminfo/issues/27 || > || `text` || needs release || https://github.com/haskell/text/issues/215 > || > || `time` || on-release || || > || `transformers` || ready || #14678 || > || `unix` || needs release || https://github.com/haskell/unix/issues/106 > || > || `haddock` || needs release || > https://github.com/haskell/haddock/issues/737 || New description: ||= package =||= status =||= reference =|| || `Cabal` || needs release || || || `Win32` || on-release || || || `array` || Needs revision || || || `binary` || on-release || || || `bytestring` || on-release || || || `containers` || needs release || https://github.com/haskell/containers/issues/501 || || `deepseq` || needs revision || || || `directory` || on-release || || || `filepath` || ready || https://github.com/haskell/filepath/issues/65 || || `haskeline` || ready || https://github.com/judah/haskeline/issues/75 || || `hpc` || needs release || || || `mtl` || needs release || https://github.com/haskell/mtl/issues/52 || || `parallel` || needs revision || || || `parsec` || needs release || https://github.com/haskell/parsec/issues/86 || || `pretty` || needs release || https://github.com/haskell/pretty/issues/47 || || `primitive` || needs release || https://github.com/haskell/primitive/issues/72 || || `process` || ready || https://github.com/haskell/primitive/issues/72 || || `stm` || needs release || #14698 || || `terminfo` || ready || https://github.com/judah/terminfo/issues/27 || || `text` || needs release || https://github.com/haskell/text/issues/215 || || `time` || on-release || || || `transformers` || ready || #14678 || || `unix` || needs release || https://github.com/haskell/unix/issues/106 || || `haddock` || needs release || https://github.com/haskell/haddock/issues/737 || -- Comment (by bgamari): `ghc-8.4` now points at `filepath` 1.4.2. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 23 09:45:31 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 23 Jan 2018 09:45:31 -0000 Subject: [GHC] #14683: Slow compile times for Happy-generated source In-Reply-To: <050.c267d901f7aabb72ea60ae5332333f63@haskell.org> References: <050.c267d901f7aabb72ea60ae5332333f63@haskell.org> Message-ID: <065.57cbafc8df20f1cb52ee41d218945e45@haskell.org> #14683: Slow compile times for Happy-generated source -------------------------------------+------------------------------------- Reporter: harpocrates | Owner: (none) Type: bug | Status: new Priority: high | Milestone: 8.4.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by tdammers): First thing that stands out here is long lists of type vars in the generated code. Maybe something similar to #7258 is going on here? Going to investigate. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 23 12:10:42 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 23 Jan 2018 12:10:42 -0000 Subject: [GHC] #14688: Note [Lone variables] leads to missing a case-of-case opportunity In-Reply-To: <049.49a076b467188eb35828b1dabac9ffe9@haskell.org> References: <049.49a076b467188eb35828b1dabac9ffe9@haskell.org> Message-ID: <064.86682e9943f88ae61edef09923eebace@haskell.org> #14688: Note [Lone variables] leads to missing a case-of-case opportunity -------------------------------------+------------------------------------- Reporter: mpickering | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by mpickering): Nofib results, so generally reduced allocations but very little change overall. {{{ -------------------------------------------------------------------------------- Program Size Allocs Runtime Elapsed TotalMem -------------------------------------------------------------------------------- CS 0.0% 0.0% 0.183 0.183 0.0% CSD 0.0% 0.0% -0.1% -0.1% 0.0% FS 0.0% 0.0% +0.4% +0.5% 0.0% S 0.0% 0.0% -0.4% -0.5% 0.0% VS 0.0% 0.0% +0.3% +0.3% 0.0% VSD 0.0% 0.0% 0.009 0.009 0.0% VSM 0.0% 0.0% -0.4% -0.4% 0.0% anna +0.0% +0.3% 0.062 0.062 0.0% ansi 0.0% 0.0% 0.000 0.000 0.0% atom 0.0% 0.0% 0.175 0.175 0.0% awards -0.0% -0.2% 0.000 0.000 0.0% banner 0.0% 0.0% 0.000 0.000 0.0% bernouilli 0.0% 0.0% 0.095 0.095 0.0% binary-trees 0.0% 0.0% -0.0% +0.0% 0.0% boyer 0.0% 0.0% 0.022 0.022 0.0% boyer2 +0.0% 0.0% 0.004 0.004 0.0% bspt +0.0% -0.1% 0.004 0.004 0.0% cacheprof 0.0% -0.0% -0.1% -0.1% 0.0% calendar 0.0% 0.0% 0.000 0.000 0.0% cichelli 0.0% 0.0% 0.043 0.043 0.0% circsim 0.0% 0.0% +0.3% +0.3% 0.0% clausify 0.0% 0.0% 0.020 0.020 0.0% comp_lab_zift -0.0% -0.0% 0.105 0.105 0.0% compress 0.0% 0.0% 0.073 0.073 0.0% compress2 +0.1% -0.7% 0.077 0.077 -4.0% constraints 0.0% 0.0% +0.2% +0.2% 0.0% cryptarithm1 0.0% 0.0% -0.1% +0.1% 0.0% cryptarithm2 0.0% 0.0% 0.004 0.004 0.0% cse 0.0% 0.0% 0.001 0.001 0.0% digits-of-e1 0.0% 0.0% +0.0% +0.0% 0.0% digits-of-e2 0.0% 0.0% -0.3% -0.3% 0.0% eliza +0.0% -2.4% 0.000 0.000 0.0% event 0.0% 0.0% 0.083 0.083 0.0% exact-reals -0.0% 0.0% +2.7% +2.6% 0.0% exp3_8 0.0% 0.0% 0.132 0.132 0.0% expert 0.0% 0.0% 0.000 0.000 0.0% fannkuch-redux 0.0% 0.0% -1.7% -1.7% 0.0% fasta 0.0% 0.0% -0.5% -0.5% 0.0% fem +0.0% -0.0% 0.013 0.013 0.0% fft 0.0% 0.0% 0.019 0.019 0.0% fft2 0.0% 0.0% 0.027 0.027 0.0% fibheaps 0.0% 0.0% 0.014 0.014 0.0% fish 0.0% 0.0% 0.006 0.006 0.0% fluid +0.0% +0.1% 0.004 0.004 0.0% fulsom +0.1% -13.3% 0.158 0.158 +190.0% gamteb 0.0% 0.0% 0.023 0.023 0.0% gcd 0.0% 0.0% 0.024 0.024 0.0% gen_regexps 0.0% 0.0% 0.000 0.000 0.0% genfft 0.0% 0.0% 0.018 0.018 0.0% gg +0.0% -0.1% 0.005 0.005 0.0% grep 0.0% 0.0% 0.000 0.000 0.0% hidden +0.0% 0.0% -4.2% -4.2% 0.0% hpg 0.0% 0.0% 0.048 0.048 0.0% ida +0.0% +0.3% 0.052 0.052 0.0% infer 0.0% 0.0% 0.029 0.029 0.0% integer 0.0% 0.0% -0.4% -0.4% 0.0% integrate 0.0% 0.0% 0.070 0.070 0.0% k-nucleotide 0.0% 0.0% +4.9% +4.9% 0.0% kahan 0.0% 0.0% 0.195 0.195 0.0% knights 0.0% 0.0% 0.002 0.002 0.0% lambda 0.0% 0.0% +0.3% +0.3% 0.0% last-piece 0.0% 0.0% +0.6% +0.6% 0.0% lcss 0.0% 0.0% -0.3% -0.4% 0.0% life 0.0% 0.0% 0.136 0.136 0.0% lift +0.0% -0.1% 0.001 0.001 0.0% linear 0.0% 0.0% +0.2% +0.2% 0.0% listcompr 0.0% 0.0% 0.056 0.056 0.0% listcopy 0.0% 0.0% 0.060 0.060 0.0% maillist 0.0% 0.0% 0.035 0.035 +1.9% mandel 0.0% 0.0% 0.040 0.040 0.0% mandel2 0.0% 0.0% 0.002 0.002 0.0% mate +0.0% -5.2% -3.2% -3.2% 0.0% minimax 0.0% 0.0% 0.001 0.001 0.0% mkhprog 0.0% 0.0% 0.001 0.001 0.0% multiplier 0.0% 0.0% 0.056 0.056 0.0% n-body 0.0% 0.0% -0.5% -0.5% 0.0% nucleic2 0.0% 0.0% 0.046 0.046 0.0% para -0.0% 0.0% 0.165 0.166 0.0% paraffins 0.0% 0.0% 0.064 0.064 0.0% parser +0.0% -0.0% 0.015 0.015 0.0% parstof +0.0% -0.0% 0.003 0.003 0.0% pic 0.0% 0.0% 0.004 0.004 0.0% pidigits 0.0% 0.0% +0.2% +0.1% 0.0% power 0.0% 0.0% 0.196 0.196 0.0% pretty +0.0% -2.8% 0.000 0.000 0.0% primes 0.0% 0.0% 0.040 0.040 0.0% primetest 0.0% 0.0% 0.061 0.061 0.0% prolog 0.0% 0.0% 0.001 0.001 0.0% puzzle 0.0% 0.0% 0.070 0.070 0.0% queens 0.0% 0.0% 0.008 0.008 0.0% reptile -0.0% -0.0% 0.006 0.006 0.0% reverse-complem 0.0% 0.0% 0.064 0.063 0.0% rewrite +0.1% -0.0% 0.010 0.010 0.0% rfib 0.0% 0.0% 0.009 0.009 0.0% rsa 0.0% 0.0% 0.014 0.014 0.0% scc 0.0% 0.0% 0.000 0.000 0.0% sched 0.0% 0.0% 0.011 0.011 0.0% scs +0.0% -0.0% +3.1% +3.1% 0.0% simple +0.1% -0.2% 0.112 0.112 0.0% solid +0.1% +0.0% 0.074 0.074 0.0% sorting 0.0% 0.0% 0.001 0.001 0.0% spectral-norm 0.0% 0.0% -0.7% -0.7% 0.0% sphere +0.0% -0.0% 0.029 0.029 0.0% symalg 0.0% 0.0% 0.005 0.005 0.0% tak 0.0% 0.0% 0.006 0.006 0.0% transform 0.0% 0.0% 0.192 0.192 0.0% treejoin -0.0% -0.0% 0.076 0.076 0.0% typecheck 0.0% 0.0% 0.141 0.141 0.0% veritas +0.2% -1.0% 0.001 0.001 0.0% wang +0.0% -1.6% 0.055 0.055 0.0% wave4main 0.0% 0.0% 0.156 0.156 0.0% wheel-sieve1 0.0% 0.0% -0.2% -0.2% 0.0% wheel-sieve2 +0.0% -0.0% 0.115 0.115 0.0% x2n1 0.0% 0.0% 0.001 0.001 0.0% -------------------------------------------------------------------------------- Min -0.0% -13.3% -4.2% -4.2% -4.0% Max +0.2% +0.3% +4.9% +4.9% +190.0% Geometric Mean +0.0% -0.2% -0.0% -0.0% +0.9% }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 23 12:19:16 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 23 Jan 2018 12:19:16 -0000 Subject: [GHC] #14683: Slow compile times for Happy-generated source In-Reply-To: <050.c267d901f7aabb72ea60ae5332333f63@haskell.org> References: <050.c267d901f7aabb72ea60ae5332333f63@haskell.org> Message-ID: <065.faf38bc41a46122f1706f6c51025caa8@haskell.org> #14683: Slow compile times for Happy-generated source -------------------------------------+------------------------------------- Reporter: harpocrates | Owner: (none) Type: bug | Status: new Priority: high | Milestone: 8.4.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by alexbiehl): Tobias, I saw you mentioning #7258 here. I ran over `Grammar.hs` with my sampling code from for #14461: - there are 245 non-toplevel StgRhsClosures - the deepest StgRhsClosure is nested 5 levels - Of that 245, - 168 have 0 free variables - 53 have 1 free variables - 16 have 2 free variables - 6 have 3 free variables - 1 has 4 free variables - 1 has 7 free variables - - 206 share 0 free variables with their parent - 32 share 1 free variable with their parent - 6 share 2 free variables with their parent - 1 shares 3 free variables with their parent I think this is not related to code generation. My timing shows most of the time is spent before CoreToStg. Codegen is a lot less. Our pathological cases #7258 had A LOT more (basically around 100 StgRhsClosures sharing around 150 fvs with their parents) free variable business going on. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 23 12:28:15 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 23 Jan 2018 12:28:15 -0000 Subject: [GHC] #14688: Note [Lone variables] leads to missing a case-of-case opportunity In-Reply-To: <049.49a076b467188eb35828b1dabac9ffe9@haskell.org> References: <049.49a076b467188eb35828b1dabac9ffe9@haskell.org> Message-ID: <064.f640c78498da1af9b9dc7979319b2f8c@haskell.org> #14688: Note [Lone variables] leads to missing a case-of-case opportunity -------------------------------------+------------------------------------- Reporter: mpickering | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): That's great! Let's go for it. The patch could probably do with a note to explain the significance of the changes. I'm happy to write them. Do you want to commit or shall I? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 23 13:02:02 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 23 Jan 2018 13:02:02 -0000 Subject: [GHC] #14683: Slow compile times for Happy-generated source In-Reply-To: <050.c267d901f7aabb72ea60ae5332333f63@haskell.org> References: <050.c267d901f7aabb72ea60ae5332333f63@haskell.org> Message-ID: <065.4b7000364548e1854e5307637a7fc6d3@haskell.org> #14683: Slow compile times for Happy-generated source -------------------------------------+------------------------------------- Reporter: harpocrates | Owner: (none) Type: bug | Status: new Priority: high | Milestone: 8.4.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by tdammers): Replying to [comment:12 alexbiehl]: > Tobias, I saw you mentioning #7258 here. > > I ran over `Grammar.hs` with my sampling code from for #14461: > > - there are 245 non-toplevel StgRhsClosures > - the deepest StgRhsClosure is nested 5 levels > - Of that 245, > - 168 have 0 free variables > - 53 have 1 free variables > - 16 have 2 free variables > - 6 have 3 free variables > - 1 has 4 free variables > - 1 has 7 free variables > - > - 206 share 0 free variables with their parent > - 32 share 1 free variable with their parent > - 6 share 2 free variables with their parent > - 1 shares 3 free variables with their parent > > I think this is not related to code generation. My timing shows most of the time is spent before CoreToStg. Codegen is a lot less. Our pathological cases #7258 had A LOT more (basically around 100 StgRhsClosures sharing around 150 fvs with their parents) free variable business going on. Thanks for stepping in, you seem to be much quicker at getting a clearer picture here than me. Good to know that this isn't the direction to look in. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 23 14:07:21 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 23 Jan 2018 14:07:21 -0000 Subject: [GHC] #14688: Note [Lone variables] leads to missing a case-of-case opportunity In-Reply-To: <049.49a076b467188eb35828b1dabac9ffe9@haskell.org> References: <049.49a076b467188eb35828b1dabac9ffe9@haskell.org> Message-ID: <064.e437910e12656d1c102662654c1389b3@haskell.org> #14688: Note [Lone variables] leads to missing a case-of-case opportunity -------------------------------------+------------------------------------- Reporter: mpickering | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by mpickering): You can go ahead and commit once the note is written so it's all together. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 23 14:56:52 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 23 Jan 2018 14:56:52 -0000 Subject: [GHC] #14683: Slow compile times for Happy-generated source In-Reply-To: <050.c267d901f7aabb72ea60ae5332333f63@haskell.org> References: <050.c267d901f7aabb72ea60ae5332333f63@haskell.org> Message-ID: <065.127d704edbff3b0b63150ea6d8ae888d@haskell.org> #14683: Slow compile times for Happy-generated source -------------------------------------+------------------------------------- Reporter: harpocrates | Owner: (none) Type: bug | Status: new Priority: high | Milestone: 8.4.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by tdammers): SCC profiling so far points at `simplLazyBind` in `Simplify.hs`. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 23 15:19:55 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 23 Jan 2018 15:19:55 -0000 Subject: [GHC] #14661: Cannot derive (newtype I a b = I (F a -> F b) deriving newtype Category) for type family F In-Reply-To: <051.db51abc527e2395586903121a4d671be@haskell.org> References: <051.db51abc527e2395586903121a4d671be@haskell.org> Message-ID: <066.d3b56f6d958402e0c991b1f7c4da6eb7@haskell.org> #14661: Cannot derive (newtype I a b = I (F a -> F b) deriving newtype Category) for type family F -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: feature request | Status: closed Priority: normal | Milestone: Component: Compiler | Version: 8.4.1-alpha1 Resolution: wontfix | Keywords: | DerivingStrategies, deriving, | TypeFamilies Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Iceland_jack): I don't know if this should be a separate ticket but it is another case that can be derived only by expanding constructors {{{#!hs import Data.Monoid (Endo) newtype ENDO = ENDO (forall xx. Endo xx) instance Semigroup ENDO where (<>) :: ENDO -> ENDO -> ENDO ENDO f <> ENDO g = ENDO (f <> g) instance Monoid ENDO where mempty :: ENDO mempty = ENDO mempty }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 23 15:33:36 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 23 Jan 2018 15:33:36 -0000 Subject: [GHC] #14680: GHC 8.4.1-alpha panics when optimizing function using getTag and tagToEnum# In-Reply-To: <050.ae9e72a72ce45f0a50476094399e0e2c@haskell.org> References: <050.ae9e72a72ce45f0a50476094399e0e2c@haskell.org> Message-ID: <065.3301e24ff701cb245972c4c25ca2298d@haskell.org> #14680: GHC 8.4.1-alpha panics when optimizing function using getTag and tagToEnum# -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.4.1 Component: Compiler | Version: 8.4.1-alpha1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): It turns out that this is actually generating ill typed Core, as demonstrated in this Core Lint error: {{{ $ inplace/bin/ghc-stage2 -O1 -fforce-recomp -dcore-lint ../Bug.hs [1 of 1] Compiling Bug ( ../Bug.hs, ../Bug.o ) *** Core Lint errors : in result of Simplifier *** : warning: In a case alternative: (TyFamilyEnum3) In a case alternative, data constructor isn't in scrutinee type: Scrutinee type constructor: TyFamilyEnum Data con: TyFamilyEnum3 *** Offending Program *** suc :: TyFamilyEnum -> TyFamilyEnum [LclIdX, Arity=1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [20] 33 0}] suc = \ (a_aaf8_awR :: TyFamilyEnum) -> case a_aaf8_awR `cast` (D:R:TyFamilyEnum0[0] :: (TyFamilyEnum :: *) ~R# (R:TyFamilyEnum :: *)) of nt_s2jO { __DEFAULT -> case nt_s2jO `cast` (Sym (D:R:TyFamilyEnum0[0]) :: (R:TyFamilyEnum :: *) ~R# (TyFamilyEnum :: *)) of lwild_s2k1 { __DEFAULT -> case dataToTag# @ TyFamilyEnum lwild_s2k1 of a_aaf9_awS { __DEFAULT -> (tagToEnum# @ R:TyFamilyEnum (+# a_aaf9_awS 1#)) `cast` (Sym (D:R:TyFamilyEnum0[0]) :: (R:TyFamilyEnum :: *) ~R# (TyFamilyEnum :: *)) }; TyFamilyEnum3 -> let { a_aaf9_awS :: Int# [LclId, Unf=OtherCon []] a_aaf9_awS = 2# } in lvl_s2jL } } *** End of Offense *** }}} I've highlighted the relevant part, which is the Core for `suc`. Notice how it first `cast`s the argument from type `TyFamilyEnum` (the data family tycon) to type `R:TyFamilyEnum` (the representation tycon). This part is definitely correct, since you can't pattern-match on the argument unless it's at the representation type. But immediately after this `cast`, it proceeds to `cast` it //again//, from type `R:TyFamilyEnum` back to `TyFamilyEnum`! This makes the whole `case` expression following it ill typed, and likely results in shenanigans later during compilation. Now my question is: where is this extra cast coming from? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 23 16:18:29 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 23 Jan 2018 16:18:29 -0000 Subject: [GHC] #14708: GHC panics when linking with an archive and using an annotation Message-ID: <046.3ba93269311e390d484d95c8a405c373@haskell.org> #14708: GHC panics when linking with an archive and using an annotation -------------------------------------+------------------------------------- Reporter: tchajed | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Keywords: | Operating System: Unknown/Multiple Architecture: x86_64 | Type of failure: Compile-time (amd64) | crash or panic Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- GHC panics when compiling code with an annotation and linking with an archive (a `.a` file). I think this is the same as #9438, but I have a really simple test case consisting of the following two files: {{{#!c // add.c int add2(int x, int y) { return x + y; } }}} {{{#!hs -- app.hs {-# ANN module () #-} main :: IO () main = return () }}} First I make an archive: {{{ $ gcc -c add.c -o add.o $ ar libadd.a add.o }}} And then the following fails: {{{ $ ghc -ladd -L. app.hs [1 of 1] Compiling Main ( app.hs, app.o ) ghc: panic! (the 'impossible' happened) (GHC version 8.2.2 for x86_64-apple-darwin): Loading archives not supported Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug make: *** [app] Error 1 }}} The attached tar.gz has these source files and a Makefile to run the above. I've tested it on OS X 10.11 and Linux, both with GHC 8.2.2, and the behavior is the same. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 23 16:19:14 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 23 Jan 2018 16:19:14 -0000 Subject: [GHC] #14708: GHC panics when linking with an archive and using an annotation In-Reply-To: <046.3ba93269311e390d484d95c8a405c373@haskell.org> References: <046.3ba93269311e390d484d95c8a405c373@haskell.org> Message-ID: <061.941972df0fce3c086b783167d7b9b76b@haskell.org> #14708: GHC panics when linking with an archive and using an annotation -------------------------------------+------------------------------------- Reporter: tchajed | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: x86_64 Type of failure: Compile-time | (amd64) crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by tchajed): * Attachment "ghc-archive-panic.tar.gz" added. Test case to reproduce panic -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 23 16:37:49 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 23 Jan 2018 16:37:49 -0000 Subject: [GHC] #14704: Spurious cost-centre test failures In-Reply-To: <046.aed78b7537a34d382c90181e0bd1ef41@haskell.org> References: <046.aed78b7537a34d382c90181e0bd1ef41@haskell.org> Message-ID: <061.7250788e50fe9050255123f3a6f13de8@haskell.org> #14704: Spurious cost-centre test failures -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Profiling | Version: 8.5 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by osa1): At least some of those are not spurious, for example in T12962 expected output has wrong locations for functions; blah is on line 19, not 15, niz is on line 15, not 12. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 23 16:42:46 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 23 Jan 2018 16:42:46 -0000 Subject: [GHC] #14708: GHC panics when linking with an archive and using an annotation In-Reply-To: <046.3ba93269311e390d484d95c8a405c373@haskell.org> References: <046.3ba93269311e390d484d95c8a405c373@haskell.org> Message-ID: <061.f5eecf48dc1e1e08f3381f3466fafdd3@haskell.org> #14708: GHC panics when linking with an archive and using an annotation -------------------------------------+------------------------------------- Reporter: tchajed | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: x86_64 Type of failure: Compile-time | (amd64) crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: #9438 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * related: => #9438 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 23 16:43:15 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 23 Jan 2018 16:43:15 -0000 Subject: [GHC] #9438: panic: loading archives not supported In-Reply-To: <042.626d31d9ed213d4613ac83aeb53010f5@haskell.org> References: <042.626d31d9ed213d4613ac83aeb53010f5@haskell.org> Message-ID: <057.7c498892d8b1dacc6666e68b0daf38f0@haskell.org> #9438: panic: loading archives not supported -------------------------------------+------------------------------------- Reporter: egl | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.8.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: x86_64 | (amd64) Type of failure: Other | Test Case: Blocked By: | Blocking: Related Tickets: #8164, #14708 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * related: #8164 => #8164, #14708 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 23 19:31:28 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 23 Jan 2018 19:31:28 -0000 Subject: [GHC] #8400: Migrate the RTS to use libuv (or libev, or libevent) In-Reply-To: <046.b38bad0bbb5fef315e7819ac07954a6b@haskell.org> References: <046.b38bad0bbb5fef315e7819ac07954a6b@haskell.org> Message-ID: <061.c75614bad3c8eabccb6c742970659b41@haskell.org> #8400: Migrate the RTS to use libuv (or libev, or libevent) -------------------------------------+------------------------------------- Reporter: schyler | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Runtime System | Version: Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: 635, 7353 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by michalt): * cc: michalt (added) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 23 19:41:59 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 23 Jan 2018 19:41:59 -0000 Subject: [GHC] #13763: Performance regression (~34%) in 8.2.1, poor register allocation(?) in an inner loop over an array In-Reply-To: <048.3858df3b3399782d9452f01ad23b4ddd@haskell.org> References: <048.3858df3b3399782d9452f01ad23b4ddd@haskell.org> Message-ID: <063.e7ed7976af2a7415ac318b55b5a7fbc7@haskell.org> #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: high | Milestone: 8.4.1 Component: Compiler (NCG) | Version: 8.2.1-rc2 Resolution: | Keywords: JoinPoints 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: | -------------------------------------+------------------------------------- Changes (by michalt): * cc: michalt (added) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 23 19:47:46 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 23 Jan 2018 19:47:46 -0000 Subject: [GHC] #14694: Can't coerce given assumptions In-Reply-To: <051.a24047975aac3bbc5e443262dff8c929@haskell.org> References: <051.a24047975aac3bbc5e443262dff8c929@haskell.org> Message-ID: <066.f5461c82ece6db9e7f29c7b686d01f90@haskell.org> #14694: Can't coerce given assumptions -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Roles Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Iceland_jack): I don't remember a place where we collect them, we can make one & I can go through my old tickets in search for examples. Here is another one maybe: {{{#!hs {-# Language FlexibleContexts #-} import Data.Coerce class Exp repr where int :: Int -> repr Int newtype Coerce f a = Coerce (f a) -- /tmp/Test.hs:13:9: error: -- • Couldn't match representation of type ‘f Int’ with that of ‘Int’ -- arising from a use of ‘coerce’ -- • In the expression: coerce -- In an equation for ‘int’: int = coerce -- In the instance declaration for ‘Exp (Coerce f)’ -- • Relevant bindings include -- int :: Int -> Coerce f Int (bound at /tmp/Test.hs:13:3) -- | -- 13 | int = coerce -- | ^^^^^^ instance Coercible Int (f Int) => Exp (Coerce f) where int = coerce }}} but it works with `int = Coerce . coerce`. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 23 20:23:40 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 23 Jan 2018 20:23:40 -0000 Subject: [GHC] #12470: Move LLVM code generator to LLVM bitcode format In-Reply-To: <046.2d176265e89a9f069bd8e76d6793e054@haskell.org> References: <046.2d176265e89a9f069bd8e76d6793e054@haskell.org> Message-ID: <061.f9c37fcf6d29f5cf59af00cf91afdd5c@haskell.org> #12470: Move LLVM code generator to LLVM bitcode format -------------------------------------+------------------------------------- Reporter: bgamari | Owner: angermann Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler (LLVM) | Version: 8.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by michalt): * cc: michalt (added) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 23 20:24:02 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 23 Jan 2018 20:24:02 -0000 Subject: [GHC] #11138: Kill the terrible LLVM Mangler In-Reply-To: <046.1671c4fce95e0eb48491b5a743b485ce@haskell.org> References: <046.1671c4fce95e0eb48491b5a743b485ce@haskell.org> Message-ID: <061.99ef407873ceee576a0cb43d79fcdcb5@haskell.org> #11138: Kill the terrible LLVM Mangler -------------------------------------+------------------------------------- Reporter: bgamari | Owner: angerman Type: task | Status: new Priority: normal | Milestone: Component: Compiler (LLVM) | Version: 7.11 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Other | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by michalt): * cc: michalt (added) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 23 20:31:20 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 23 Jan 2018 20:31:20 -0000 Subject: [GHC] #14701: Investigate the performance impact of code alignment In-Reply-To: <042.e11dda7ab3eddd9e4c88a6b0f72299d7@haskell.org> References: <042.e11dda7ab3eddd9e4c88a6b0f72299d7@haskell.org> Message-ID: <057.16fc2254f0ec6455e9917bd4aac8f733@haskell.org> #14701: Investigate the performance impact of code alignment -------------------------------------+------------------------------------- Reporter: nh2 | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 (CodeGen) | Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by michalt): * cc: michalt (added) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 23 20:37:49 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 23 Jan 2018 20:37:49 -0000 Subject: [GHC] #14701: Investigate the performance impact of code alignment In-Reply-To: <042.e11dda7ab3eddd9e4c88a6b0f72299d7@haskell.org> References: <042.e11dda7ab3eddd9e4c88a6b0f72299d7@haskell.org> Message-ID: <057.b2ccd70e1756acbbf609044cac8518a0@haskell.org> #14701: Investigate the performance impact of code alignment -------------------------------------+------------------------------------- Reporter: nh2 | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 (CodeGen) | Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by michalt): Somewhat related: https://github.com/ccurtsinger/stabilizer (project based on LLVM aiming to make performance comparisons more robust by randomizing memory layout during execution; seems it's no longer maintained though) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 23 21:44:57 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 23 Jan 2018 21:44:57 -0000 Subject: [GHC] #14707: setNumCapabilities can cause threads to get stuck in gcWorkerThread In-Reply-To: <043.ca2e764157922265dec6f8538e826907@haskell.org> References: <043.ca2e764157922265dec6f8538e826907@haskell.org> Message-ID: <058.5284a66356ba8af924872d4856f3cee9@haskell.org> #14707: setNumCapabilities can cause threads to get stuck in gcWorkerThread -------------------------------------+------------------------------------- Reporter: duog | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: Component: Runtime System | Version: 8.5 Resolution: invalid | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by duog): * status: new => closed * resolution: => invalid Comment: Turns out my instrumentation was wrong, but at least I learned something. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 23 22:13:48 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 23 Jan 2018 22:13:48 -0000 Subject: [GHC] #14694: Incompleteness in the Coercible constraint solver (was: Can't coerce given assumptions) In-Reply-To: <051.a24047975aac3bbc5e443262dff8c929@haskell.org> References: <051.a24047975aac3bbc5e443262dff8c929@haskell.org> Message-ID: <066.be1a8f46e3ff3ec80be89329024205a5@haskell.org> #14694: Incompleteness in the Coercible constraint solver -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Roles Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 23 22:34:30 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 23 Jan 2018 22:34:30 -0000 Subject: [GHC] #14669: 32-bit binaries sometimes throw a stack overflow on shutdown. In-Reply-To: <044.45c88c9a13190d9f2a70cd9b35309cc0@haskell.org> References: <044.45c88c9a13190d9f2a70cd9b35309cc0@haskell.org> Message-ID: <059.1c9dc841005f818975d14779b9e6b0a4@haskell.org> #14669: 32-bit binaries sometimes throw a stack overflow on shutdown. -----------------------------------+---------------------------------- Reporter: sergv | Owner: (none) Type: bug | Status: infoneeded Priority: normal | Milestone: Component: Runtime System | Version: 8.2.1 Resolution: | Keywords: Operating System: Windows | Architecture: x86 Type of failure: Runtime crash | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -----------------------------------+---------------------------------- Comment (by sergv): I have tried `-fstack-check` but that doesn't help at all. It even breaks compilation with `-O0`! Just compare the outputs below: `-O0 -fno-stack-check`: {{{ .file "StgCRun.c" .text Ltext0: .globl _win32AllocStack .def _win32AllocStack; .scl 2; .type 32; .endef _win32AllocStack: LFB210: .file 1 "rts//StgCRun.c" .loc 1 111 0 .cfi_startproc pushl %ebp .cfi_def_cfa_offset 8 .cfi_offset 5, -8 movl %esp, %ebp .cfi_def_cfa_register 5 movl $8224, %eax call ___chkstk_ms subl %eax, %esp .loc 1 113 0 movl $0, %eax .loc 1 114 0 leave .cfi_restore 5 .cfi_def_cfa 4, 4 ret .cfi_endproc }}} `-O0 -fstack-check`: {{{ .file "StgCRun.c" .text Ltext0: .globl _win32AllocStack .def _win32AllocStack; .scl 2; .type 32; .endef _win32AllocStack: LFB210: .file 1 "rts//StgCRun.c" .loc 1 111 0 .cfi_startproc pushl %ebp .cfi_def_cfa_offset 8 .cfi_offset 5, -8 movl %esp, %ebp .cfi_def_cfa_register 5 orl $0, -4096(%esp) orl $0, -8192(%esp) orl $0, -8224(%esp) subl $8224, %esp .loc 1 113 0 movl $0, %eax .loc 1 114 0 leave .cfi_restore 5 .cfi_def_cfa 4, 4 ret .cfi_endproc }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 24 02:37:02 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 24 Jan 2018 02:37:02 -0000 Subject: [GHC] #14709: Extend the plugin mechanism to access program representation Message-ID: <044.2e69c960decc5283f7ff746e6b782d96@haskell.org> #14709: Extend the plugin mechanism to access program representation -------------------------------------+------------------------------------- Reporter: lazac | Owner: (none) Type: feature | Status: new request | Priority: normal | Milestone: Component: GHC API | Version: 8.2.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: https://phabricator.haskell.org/D4342| https://ghc.haskell.org/trac/ghc/wiki/ExtendedPluginsProposal -------------------------------------+------------------------------------- This would enable development tools to access the GHC representation in the pre-existing build environment. By the inversion of control, the tool developers don't need to decide which Haskell modules have to be processed and with what configuration, because the normal build procedure could be invoked by the user with plugin flags specifying what tools to invoke. The plan is described in more details at [https://ghc.haskell.org/trac/ghc/wiki/ExtendedPluginsProposal Extended Plugins Proposal] -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 24 03:31:54 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 24 Jan 2018 03:31:54 -0000 Subject: [GHC] #14646: GHC 8.4.1 regression: rank-n types no longer parenthesized when pretty-printed In-Reply-To: <050.f6d9f92b935b2b76cf140ddb5bc8ac61@haskell.org> References: <050.f6d9f92b935b2b76cf140ddb5bc8ac61@haskell.org> Message-ID: <065.c3e188f2eab48233f9d3a87e36da5476@haskell.org> #14646: GHC 8.4.1 regression: rank-n types no longer parenthesized when pretty- printed -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: RyanGlScott Type: bug | Status: closed Priority: high | Milestone: 8.4.1 Component: GHC API | Version: 8.4.1-alpha1 Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect result | Unknown/Multiple at runtime | Test Case: th/T14646 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4298 Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * status: merge => closed * testcase: => th/T14646 * resolution: => fixed Comment: This appears to have been merged in b92fb5150bdc6a0a090ecba2927c14e19005116e. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 24 04:06:41 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 24 Jan 2018 04:06:41 -0000 Subject: [GHC] #14709: Extend the plugin mechanism to access program representation In-Reply-To: <044.2e69c960decc5283f7ff746e6b782d96@haskell.org> References: <044.2e69c960decc5283f7ff746e6b782d96@haskell.org> Message-ID: <059.9fb41243c41c3af1f83e337e99c861dd@haskell.org> #14709: Extend the plugin mechanism to access program representation -------------------------------------+------------------------------------- Reporter: lazac | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: GHC API | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | https://phabricator.haskell.org/D4342 https://ghc.haskell.org/trac/ghc/wiki/ExtendedPluginsProposal| -------------------------------------+------------------------------------- Changes (by bgamari): * cc: ezyang, alanz (added) Comment: Hmmm, interesting. AddI guess ezyang and Alan Zimmerman as I know they have both thought a fair amount about tooling. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 24 04:09:34 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 24 Jan 2018 04:09:34 -0000 Subject: [GHC] #14709: Extend the plugin mechanism to access program representation In-Reply-To: <044.2e69c960decc5283f7ff746e6b782d96@haskell.org> References: <044.2e69c960decc5283f7ff746e6b782d96@haskell.org> Message-ID: <059.4c5f0b28b7aa0f303117075f277f12fa@haskell.org> #14709: Extend the plugin mechanism to access program representation -------------------------------------+------------------------------------- Reporter: lazac | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: GHC API | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | https://phabricator.haskell.org/D4342 https://ghc.haskell.org/trac/ghc/wiki/ExtendedPluginsProposal| -------------------------------------+------------------------------------- Changes (by lazac): * cc: mpickering (added) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 24 04:21:34 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 24 Jan 2018 04:21:34 -0000 Subject: [GHC] #14709: Extend the plugin mechanism to access program representation In-Reply-To: <044.2e69c960decc5283f7ff746e6b782d96@haskell.org> References: <044.2e69c960decc5283f7ff746e6b782d96@haskell.org> Message-ID: <059.df11ade09b6cca37fe555347a866c8ff@haskell.org> #14709: Extend the plugin mechanism to access program representation -------------------------------------+------------------------------------- Reporter: lazac | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: GHC API | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | https://phabricator.haskell.org/D4342 https://ghc.haskell.org/trac/ghc/wiki/ExtendedPluginsProposal| -------------------------------------+------------------------------------- Comment (by bgamari): The description on the wiki page, specifically of the plugin interface itself, seems a bit terse. Do you think you could lay out more precisely what these new plug-ins will be be able to do? Do you anticipate being able to modify the AST or is this strictly for tooling that wishes to I spect the AST? A few more words on why front-end plug-ins are insufficient would also be helpful; is the problem that you want your plugin to run during the course of normal compilation? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 24 04:51:31 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 24 Jan 2018 04:51:31 -0000 Subject: [GHC] #14709: Extend the plugin mechanism to access program representation In-Reply-To: <044.2e69c960decc5283f7ff746e6b782d96@haskell.org> References: <044.2e69c960decc5283f7ff746e6b782d96@haskell.org> Message-ID: <059.10cca450b66c12c6e2b2158b1ada074e@haskell.org> #14709: Extend the plugin mechanism to access program representation -------------------------------------+------------------------------------- Reporter: lazac | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: GHC API | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | https://phabricator.haskell.org/D4342 https://ghc.haskell.org/trac/ghc/wiki/ExtendedPluginsProposal| -------------------------------------+------------------------------------- Comment (by lazac): I can imagine tools that modify these representations as well. The main purpose of the plugins being able to change the input is that it seemed a bit arbitrary to limit the plugins in this way. This is also present in Edsko's version. Yes, basically I would like to be able to run my tool during a normal (enhanced) compilation. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 24 04:54:09 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 24 Jan 2018 04:54:09 -0000 Subject: [GHC] #14710: GHC 8.4.1-alpha allows the use of kind polymorphism without PolyKinds Message-ID: <050.c0df5def4de65d7ecd4d01ad9668904c@haskell.org> #14710: GHC 8.4.1-alpha allows the use of kind polymorphism without PolyKinds -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: high | Milestone: 8.4.1 Component: Compiler | Version: 8.4.1-alpha1 (Type checker) | Keywords: PolyKinds | Operating System: Unknown/Multiple Architecture: | Type of failure: GHC accepts Unknown/Multiple | invalid program Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- This program: {{{#!hs {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE ImpredicativeTypes #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# OPTIONS_GHC -ddump-deriv #-} module Bug where import Data.Coerce import Data.Proxy class C a b where c :: Proxy (x :: a) -> b newtype I a = MkI a instance C x a => C x (Bug.I a) where c = coerce @(forall (z :: x). Proxy z -> a) @(forall (z :: x). Proxy z -> I a) c }}} is rightfully rejected by GHC 8.2.2: {{{ $ /opt/ghc/8.2.2/bin/ghc Bug.hs [1 of 1] Compiling Bug ( Bug.hs, Bug.o ) Bug.hs:20:16: error: Unexpected kind variables Perhaps you intended to use PolyKinds In a type argument | 20 | c = coerce @(forall (z :: x). Proxy z -> a) | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ Bug.hs:21:16: error: Unexpected kind variables Perhaps you intended to use PolyKinds In a type argument | 21 | @(forall (z :: x). Proxy z -> I a) | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ }}} But GHC 8.4.1-alpha2 actually //accepts// this program! {{{ $ /opt/ghc/8.4.1/bin/ghci Bug.hs GHCi, version 8.4.0.20180118: http://www.haskell.org/ghc/ :? for help Loaded GHCi configuration from /home/rgscott/.ghci [1 of 1] Compiling Bug ( Bug.hs, interpreted ) Ok, one module loaded. }}} This is almost certainly bogus. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 24 05:16:12 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 24 Jan 2018 05:16:12 -0000 Subject: [GHC] #14711: Machine readable output of coverage Message-ID: <050.d858ad27520ca4b1ee3c013a327a8c68@haskell.org> #14711: Machine readable output of coverage -------------------------------------+------------------------------------- Reporter: Koterpillar | Owner: (none) Type: feature | Status: new request | Priority: normal | Milestone: Component: Code Coverage | Version: 8.2.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: -------------------------------------+------------------------------------- When integrating with a CI system, it might be useful to fail the build, alert or take other actions based on coverage percentage. To do that, hpc needs to output a summary coverage report in a machine readable format. For example, the current output: {{{ 38% expressions used (1779/4624) 57% boolean coverage (16/28) 56% guards (9/16), 6 always True, 1 always False 58% 'if' conditions (7/12), 2 always False, 3 unevaluated 100% qualifiers (0/0) 7% alternatives used (103/1410) 75% local declarations used (102/136) 40% top-level declarations used (185/457) }}} can be represented as: {{{ { expressions: { total: 4624, used: 1779, percentage: 0.38 }, boolean: { total: 28, used: 16, percentage: 0.57 }, <...> } }}} This output can be then parsed to decide whether to fail the build, produce a coverage graph over time, etc. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 24 07:03:33 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 24 Jan 2018 07:03:33 -0000 Subject: [GHC] #14669: 32-bit binaries sometimes throw a stack overflow on shutdown. In-Reply-To: <044.45c88c9a13190d9f2a70cd9b35309cc0@haskell.org> References: <044.45c88c9a13190d9f2a70cd9b35309cc0@haskell.org> Message-ID: <059.ca8e3ad9c1961da0c4b8ef6397dc2243@haskell.org> #14669: 32-bit binaries sometimes throw a stack overflow on shutdown. -----------------------------------+---------------------------------- Reporter: sergv | Owner: (none) Type: bug | Status: infoneeded Priority: normal | Milestone: Component: Runtime System | Version: 8.2.1 Resolution: | Keywords: Operating System: Windows | Architecture: x86 Type of failure: Runtime crash | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -----------------------------------+---------------------------------- Comment (by Phyx-): hmm, ok. Looking closer, the issue is that at `-O1` and higher the compiler notices the space isn't used. Because it's stack allocated it won't be valid outside the frame anyway so it correctly optimizes away the allocation. I have to wait till the weekend to look at it, but things to try if you wish: - try marking the function `volatile`; - try adding `__attribute__((optimize("O0")))` to the function to disable optimizations. Second one will probably work, but isn't very portable. so I'll likely go with inline assembly. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 24 08:20:10 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 24 Jan 2018 08:20:10 -0000 Subject: [GHC] #14712: After git pull make can't work with make clean Message-ID: <044.d514c6189e84996f2384ead348b0422a@haskell.org> #14712: After git pull make can't work with make clean -------------------------------------+------------------------------------- Reporter: jiamo | Owner: (none) Type: bug | Status: new Priority: low | Milestone: Component: Build System | Version: 8.5 Keywords: | Operating System: MacOS X Architecture: x86_64 | Type of failure: Building GHC (amd64) | failed Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- In the clean master repo: configure make can work. But after git pull. Just run make. It always failed. After make clean. it can success. But it will take long time as in the clean repo. (It is not bug I can find other type to desc) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 24 08:20:39 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 24 Jan 2018 08:20:39 -0000 Subject: [GHC] #14712: After git pull make can't work with make clean In-Reply-To: <044.d514c6189e84996f2384ead348b0422a@haskell.org> References: <044.d514c6189e84996f2384ead348b0422a@haskell.org> Message-ID: <059.6739cc6712d1df1c00ec2a49ce911b20@haskell.org> #14712: After git pull make can't work with make clean -------------------------------------+------------------------------------- Reporter: jiamo | Owner: (none) Type: bug | Status: new Priority: low | Milestone: Component: Build System | Version: 8.5 Resolution: | Keywords: Operating System: MacOS X | Architecture: x86_64 Type of failure: Building GHC | (amd64) failed | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by jiamo): * Attachment "ghc_before_make_clean.txt" added. the log of make -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 24 08:21:16 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 24 Jan 2018 08:21:16 -0000 Subject: [GHC] #14712: After git pull make can't work without make clean (was: After git pull make can't work with make clean) In-Reply-To: <044.d514c6189e84996f2384ead348b0422a@haskell.org> References: <044.d514c6189e84996f2384ead348b0422a@haskell.org> Message-ID: <059.9d532db0effa2af5be2ffe31341a1fc7@haskell.org> #14712: After git pull make can't work without make clean -------------------------------------+------------------------------------- Reporter: jiamo | Owner: (none) Type: bug | Status: new Priority: low | Milestone: Component: Build System | Version: 8.5 Resolution: | Keywords: Operating System: MacOS X | Architecture: x86_64 Type of failure: Building GHC | (amd64) failed | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 24 08:29:51 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 24 Jan 2018 08:29:51 -0000 Subject: [GHC] #14712: After git pull make can't work without make clean In-Reply-To: <044.d514c6189e84996f2384ead348b0422a@haskell.org> References: <044.d514c6189e84996f2384ead348b0422a@haskell.org> Message-ID: <059.f4c3bbd2d81686495c9552c225a6cd2d@haskell.org> #14712: After git pull make can't work without make clean -------------------------------------+------------------------------------- Reporter: jiamo | Owner: (none) Type: bug | Status: new Priority: low | Milestone: Component: Build System | Version: 8.5 Resolution: | Keywords: Operating System: MacOS X | Architecture: x86_64 Type of failure: Building GHC | (amd64) failed | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by dfeuer): The entire `make`-based build system is in the process of being replaced. I think the chances of improving it significant are minuscule. I'm leaving this open to see if someone can confirm that Hadrian is likely to do a better job in this regard. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 24 08:35:17 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 24 Jan 2018 08:35:17 -0000 Subject: [GHC] #14712: After git pull make can't work without make clean In-Reply-To: <044.d514c6189e84996f2384ead348b0422a@haskell.org> References: <044.d514c6189e84996f2384ead348b0422a@haskell.org> Message-ID: <059.d47905ef9dbe86ed065d975fdd6f2481@haskell.org> #14712: After git pull make can't work without make clean -------------------------------------+------------------------------------- Reporter: jiamo | Owner: (none) Type: bug | Status: new Priority: low | Milestone: Component: Build System | Version: 8.5 Resolution: | Keywords: Operating System: MacOS X | Architecture: x86_64 Type of failure: Building GHC | (amd64) failed | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by dfeuer): * cc: dfeuer (added) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 24 09:27:39 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 24 Jan 2018 09:27:39 -0000 Subject: [GHC] #14699: Library status for 8.4.1 In-Reply-To: <046.12f775ea02060174a5ac178f457055aa@haskell.org> References: <046.12f775ea02060174a5ac178f457055aa@haskell.org> Message-ID: <061.0f4c3a279685876b11e773a0543b34ec@haskell.org> #14699: Library status for 8.4.1 -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: task | Status: new Priority: highest | Milestone: 8.4.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by dfeuer): * cc: dfeuer (added) Comment: I don't understand this table, but `containers` has been released. I could use a bit of help figuring out the backpack test issues: https://phabricator.haskell.org/harbormaster/build/40192/ -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 24 10:25:40 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 24 Jan 2018 10:25:40 -0000 Subject: [GHC] #14683: Slow compile times for Happy-generated source In-Reply-To: <050.c267d901f7aabb72ea60ae5332333f63@haskell.org> References: <050.c267d901f7aabb72ea60ae5332333f63@haskell.org> Message-ID: <065.5810f4079b56a2c50a3aca20ad29c869@haskell.org> #14683: Slow compile times for Happy-generated source -------------------------------------+------------------------------------- Reporter: harpocrates | Owner: (none) Type: bug | Status: new Priority: high | Milestone: 8.4.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by tdammers): Further profiling result: {{{ COST CENTRE MODULE SRC %time %alloc coercionKind Coercion compiler/types/Coercion.hs:1707:3-7 87.5 88.7 CoreTidy HscMain compiler/main/HscMain.hs:1253:27-67 3.1 3.3 simplCast-addCoerce Simplify compiler/simplCore/Simplify.hs:1225:53-71 2.8 2.8 simplCast Simplify compiler/simplCore/Simplify.hs:871:62-87 2.1 1.5 Stg2Stg HscMain compiler/main/HscMain.hs:1489:12-44 1.6 1.9 }}} In other words, we're spending close to 90% time and alloc on the `coercionKind` function. alexbiehl mentioned that #11735 might be related, in the sense that possible optimizations mentioned there could solve this performance problem here. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 24 10:26:42 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 24 Jan 2018 10:26:42 -0000 Subject: [GHC] #11735: Optimize coercionKind In-Reply-To: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> References: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> Message-ID: <062.d4e41a93db4af677b7636c26f2298d67@haskell.org> #11735: Optimize coercionKind -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.10.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by tdammers): * cc: tdammers (added) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 24 10:33:39 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 24 Jan 2018 10:33:39 -0000 Subject: [GHC] #11735: Optimize coercionKind In-Reply-To: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> References: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> Message-ID: <062.033be004c84779a6fbe87f67c8d9c3f6@haskell.org> #11735: Optimize coercionKind -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.10.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by tdammers): This could be a useful building block, if not the solution, for #14683. Any concrete ideas / plans on how to implement this? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 24 10:52:03 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 24 Jan 2018 10:52:03 -0000 Subject: [GHC] #14669: 32-bit binaries sometimes throw a stack overflow on shutdown. In-Reply-To: <044.45c88c9a13190d9f2a70cd9b35309cc0@haskell.org> References: <044.45c88c9a13190d9f2a70cd9b35309cc0@haskell.org> Message-ID: <059.fb8fe60f588298a55346848b0feb41c8@haskell.org> #14669: 32-bit binaries sometimes throw a stack overflow on shutdown. -----------------------------------+---------------------------------- Reporter: sergv | Owner: (none) Type: bug | Status: infoneeded Priority: normal | Milestone: Component: Runtime System | Version: 8.2.1 Resolution: | Keywords: Operating System: Windows | Architecture: x86 Type of failure: Runtime crash | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -----------------------------------+---------------------------------- Comment (by Phyx-): Hmm seems `volatile` doesn't, was a long shot anyway. but using an attribute does. I'll submit a patch tonight. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 24 11:08:00 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 24 Jan 2018 11:08:00 -0000 Subject: [GHC] #14683: Slow compile times for Happy-generated source In-Reply-To: <050.c267d901f7aabb72ea60ae5332333f63@haskell.org> References: <050.c267d901f7aabb72ea60ae5332333f63@haskell.org> Message-ID: <065.8e2af4e0496ec9638a5568c0920e5c3c@haskell.org> #14683: Slow compile times for Happy-generated source -------------------------------------+------------------------------------- Reporter: harpocrates | Owner: (none) Type: bug | Status: new Priority: high | Milestone: 8.4.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * cc: goldfire (added) Comment: > In other words, we're spending close to 90% time and alloc on the coercionKind function. Ha! A smoking gun. Well done! Moreover, it's a gun that has fired before: see #5631, and the comment in `Coercion/hs` {{{ Note [Nested InstCos] ~~~~~~~~~~~~~~~~~~~~~ In Trac #5631 we found that 70% of the entire compilation time was being spent in coercionKind! The reason was that we had (g @ ty1 @ ty2 .. @ ty100) -- The "@s" are InstCos where g :: forall a1 a2 .. a100. phi If we deal with the InstCos one at a time, we'll do this: 1. Find the kind of (g @ ty1 .. @ ty99) : forall a100. phi' 2. Substitute phi'[ ty100/a100 ], a single tyvar->type subst But this is a *quadratic* algorithm, and the blew up Trac #5631. So it's very important to do the substitution simultaneously. cf Type.applyTys (which in fact we call here) }}} But clearly the fix for #5631 isn't solving the current problem. Does the profiling info tell us anything about which calls to `coercionKind` are so expensive? I see two ways forward 1. Identify the non-linearity in `coercionKind`. It really should not be so expensive. The fix to #5631 fixed one, but presumably there is another. It's not immediately obvious how to do this. One way might be to instrument `coercionKind` so that it returns (as well as the kind) the number of recursive invocations of `coercionKind` and of `substTy`, and then print out coercions that produce big numbers for either of these. Alternatively, just fix #11735, and see if that helps. That's easy to do. 2. Resurrect #11598. I have some ideas. Actually we might want to do both. Even if we did (2) it'd just cover up badness in (1). -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 24 11:48:49 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 24 Jan 2018 11:48:49 -0000 Subject: [GHC] #14683: Slow compile times for Happy-generated source In-Reply-To: <050.c267d901f7aabb72ea60ae5332333f63@haskell.org> References: <050.c267d901f7aabb72ea60ae5332333f63@haskell.org> Message-ID: <065.2310991fe6c19a2d0f912ba1d54c24bc@haskell.org> #14683: Slow compile times for Happy-generated source -------------------------------------+------------------------------------- Reporter: harpocrates | Owner: (none) Type: bug | Status: new Priority: high | Milestone: 8.4.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by tdammers): I'll take a stab at 1., and then maybe look into 2. Would love to see some of those ideas, see if I can make any sense of it given my limited understanding. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 24 12:01:44 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 24 Jan 2018 12:01:44 -0000 Subject: [GHC] #11735: Optimize coercionKind In-Reply-To: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> References: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> Message-ID: <062.319ba22c065d90fdba3223c84823bcf9@haskell.org> #11735: Optimize coercionKind -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.10.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Let's just do this. Pretty easy. Roughly like the `InstCo` case. Here is an untested patch for `coercionKind`. {{{ diff --git a/compiler/types/Coercion.hs b/compiler/types/Coercion.hs index 3f83b09..daebf35 100644 --- a/compiler/types/Coercion.hs +++ b/compiler/types/Coercion.hs @@ -1707,17 +1707,13 @@ coercionKind co = go co go (Refl _ ty) = Pair ty ty go (TyConAppCo _ tc cos)= mkTyConApp tc <$> (sequenceA $ map go cos) go (AppCo co1 co2) = mkAppTy <$> go co1 <*> go co2 - go (ForAllCo tv1 k_co co) - = let Pair _ k2 = go k_co - tv2 = setTyVarKind tv1 k2 - Pair ty1 ty2 = go co - subst = zipTvSubst [tv1] [TyVarTy tv2 `mk_cast_ty` mkSymCo k_co] - ty2' = substTyAddInScope subst ty2 in - -- We need free vars of ty2 in scope to satisfy the invariant - -- from Note [The substitution invariant] - -- This is doing repeated substitutions and probably doesn't - -- need to, see #11735 - mkInvForAllTy <$> Pair tv1 tv2 <*> Pair ty1 ty2' + + go co@(ForAllCo tv1 k_co co1) + | isReflCo k_co = mkInvForAllTy tv1 <$> go co1 + | otherwise = go_forall empty_subst co + where + empty_subst = mkEmptyTCvSubst (mkInScopeSet $ tyCoVarsOfCo co) + go (FunCo _ co1 co2) = mkFunTy <$> go co1 <*> go co2 go (CoVarCo cv) = coVarTypes cv go (HoleCo h) = coVarTypes (coHoleCoVar h) @@ -1769,10 +1765,16 @@ coercionKind co = go co go_app (InstCo co arg) args = go_app co (arg:args) go_app co args = piResultTys <$> go co <*> (sequenceA $ map go args) - -- The real mkCastTy is too slow, and we can easily have nested ForAllCos. - mk_cast_ty :: Type -> Coercion -> Type - mk_cast_ty ty (Refl {}) = ty - mk_cast_ty ty co = CastTy ty co + go_forall subst (ForAllCo tv1 k_co co) + = mkInvForAllTy <$> Pair tv1 tv2 <*> go_forall subst' co + where + Pair _ k2 = go k_co + tv2 = setTyVarKind tv1 (substTy subst k2) + subst' | isReflCo k_co = extendTCvInScope subst tv1 + | otherwise = extendTvSubst (extendTCvInScope subst tv2) tv1 $ + TyVarTy tv2 `mkCastTy` mkSymCo k_co + go_forall subst other_co + = substTy subst `pLiftSnd` go other_co -- | Apply 'coercionKind' to multiple 'Coercion's coercionKinds :: [Coercion] -> Pair [Type] }}} '''Richard: can you check'''. We should do the same thing to `coercionKindRole`. (Tiresomely.) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 24 12:03:18 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 24 Jan 2018 12:03:18 -0000 Subject: [GHC] #11735: Optimize coercionKind In-Reply-To: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> References: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> Message-ID: <062.b2ccc088655987ab9d99822f09a050c1@haskell.org> #11735: Optimize coercionKind -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.10.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): > We should do the same thing to coercionKindRole. (Tiresomely.) Actually, looking at it, I think it'd be better to define {{{ coercionRole :: Coercion -> Role }}} directly (a simple, fast recursive function), and then define {{{ coercionKindRole :: Coercion -> (Pair Type, Role) coercionKindRole co = (coercionKind co, coercionRole co) }}} Less duplication, and (I strongly suspect) faster. Could you try that and check perf? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 24 12:37:40 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 24 Jan 2018 12:37:40 -0000 Subject: [GHC] #14710: GHC 8.4.1-alpha allows the use of kind polymorphism without PolyKinds In-Reply-To: <050.c0df5def4de65d7ecd4d01ad9668904c@haskell.org> References: <050.c0df5def4de65d7ecd4d01ad9668904c@haskell.org> Message-ID: <065.cdfddcfdd7bdd98a4e607c9f11b2195a@haskell.org> #14710: GHC 8.4.1-alpha allows the use of kind polymorphism without PolyKinds -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: high | Milestone: 8.4.1 Component: Compiler (Type | Version: 8.4.1-alpha1 checker) | Resolution: | Keywords: PolyKinds Operating System: Unknown/Multiple | Architecture: Type of failure: GHC accepts | Unknown/Multiple invalid program | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * cc: simonpj (added) Comment: This regression was introduced in commit 0257dacf228024d0cc6ba247c707130637a25580 (`Refactor bindHsQTyVars and friends`). -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 24 13:09:01 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 24 Jan 2018 13:09:01 -0000 Subject: [GHC] #14637: Simplifier Ticks Exhausted when compiling with profiling In-Reply-To: <048.f4904dcbe44c7548ff4503ec6ec99eff@haskell.org> References: <048.f4904dcbe44c7548ff4503ec6ec99eff@haskell.org> Message-ID: <063.7905541a399bb09f352575888a9897ae@haskell.org> #14637: Simplifier Ticks Exhausted when compiling with profiling -------------------------------------+------------------------------------- Reporter: cfhammill | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Linux | Architecture: x86_64 Type of failure: Compile-time | (amd64) crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by niteria): I was able to reproduce it with 8.0.2 and HEAD. I was able to reduce the reproduction case to the `bug2.hs` file and a 4 files from the `vinyl` library. To reproduce first download `bug2.hs`, `Core.hs`, `Functor.hs`, `TypeLevel.hs` and then: {{{ $ inplace/bin/ghc-stage2 bug2.hs -fforce-recomp -O -prof -fprof-auto-top -fprof-auto '-fsimpl-tick-factor=100' [1 of 5] Compiling Functor ( Functor.hs, Functor.o ) [2 of 5] Compiling TypeLevel ( TypeLevel.hs, TypeLevel.o ) [3 of 5] Compiling Core ( Core.hs, Core.o ) [4 of 5] Compiling Lens ( Lens.hs, Lens.o ) WARNING: file compiler/simplCore/SimplCore.hs, line 712 Simplifier bailing out after 4 iterations [166, 4, 4, 4] Size = {terms: 620, types: 2,587, coercions: 662, joins: 0/13} WARNING: file compiler/simplCore/SimplCore.hs, line 712 Simplifier bailing out after 4 iterations [4, 4, 4, 4] Size = {terms: 620, types: 2,587, coercions: 662, joins: 0/13} [5 of 5] Compiling Main ( bug.hs, bug.o ) Simplifier ticks exhausted When trying RuleFired Class op rlens To increase the limit, use -fsimpl-tick-factor=N (default 100). If you need to increase the limit substantially, please file a bug report and indicate the factor you needed. If GHC was unable to complete compilation even with a very large factor (a thousand or more), please consult the "Known bugs or infelicities" section in the Users Guide before filing a report. There are a few situations unlikely to occur in practical programs for which simplifier non-termination has been judged acceptable. To see detailed counts use -ddump-simpl-stats Total ticks: 111521 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 24 13:09:53 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 24 Jan 2018 13:09:53 -0000 Subject: [GHC] #14637: Simplifier Ticks Exhausted when compiling with profiling In-Reply-To: <048.f4904dcbe44c7548ff4503ec6ec99eff@haskell.org> References: <048.f4904dcbe44c7548ff4503ec6ec99eff@haskell.org> Message-ID: <063.680b79fbbaef536d7a32cac45eee6c03@haskell.org> #14637: Simplifier Ticks Exhausted when compiling with profiling -------------------------------------+------------------------------------- Reporter: cfhammill | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Linux | Architecture: x86_64 Type of failure: Compile-time | (amd64) crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by niteria): * Attachment "bug2.hs" added. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 24 13:10:02 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 24 Jan 2018 13:10:02 -0000 Subject: [GHC] #14637: Simplifier Ticks Exhausted when compiling with profiling In-Reply-To: <048.f4904dcbe44c7548ff4503ec6ec99eff@haskell.org> References: <048.f4904dcbe44c7548ff4503ec6ec99eff@haskell.org> Message-ID: <063.c032df3e8af2dce0a312e3cb5e09e74a@haskell.org> #14637: Simplifier Ticks Exhausted when compiling with profiling -------------------------------------+------------------------------------- Reporter: cfhammill | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Linux | Architecture: x86_64 Type of failure: Compile-time | (amd64) crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by niteria): * Attachment "Core.hs" added. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 24 13:10:14 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 24 Jan 2018 13:10:14 -0000 Subject: [GHC] #14637: Simplifier Ticks Exhausted when compiling with profiling In-Reply-To: <048.f4904dcbe44c7548ff4503ec6ec99eff@haskell.org> References: <048.f4904dcbe44c7548ff4503ec6ec99eff@haskell.org> Message-ID: <063.52d3c0f44f42273dbdf99a46a3456a44@haskell.org> #14637: Simplifier Ticks Exhausted when compiling with profiling -------------------------------------+------------------------------------- Reporter: cfhammill | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Linux | Architecture: x86_64 Type of failure: Compile-time | (amd64) crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by niteria): * Attachment "Functor.hs" added. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 24 13:10:24 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 24 Jan 2018 13:10:24 -0000 Subject: [GHC] #14637: Simplifier Ticks Exhausted when compiling with profiling In-Reply-To: <048.f4904dcbe44c7548ff4503ec6ec99eff@haskell.org> References: <048.f4904dcbe44c7548ff4503ec6ec99eff@haskell.org> Message-ID: <063.b1c9a57c748b32fa384a191dda4924de@haskell.org> #14637: Simplifier Ticks Exhausted when compiling with profiling -------------------------------------+------------------------------------- Reporter: cfhammill | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Linux | Architecture: x86_64 Type of failure: Compile-time | (amd64) crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by niteria): * Attachment "Lens.hs" added. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 24 13:10:33 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 24 Jan 2018 13:10:33 -0000 Subject: [GHC] #14637: Simplifier Ticks Exhausted when compiling with profiling In-Reply-To: <048.f4904dcbe44c7548ff4503ec6ec99eff@haskell.org> References: <048.f4904dcbe44c7548ff4503ec6ec99eff@haskell.org> Message-ID: <063.1b0fbd151caef6b33e9b88a0b534353c@haskell.org> #14637: Simplifier Ticks Exhausted when compiling with profiling -------------------------------------+------------------------------------- Reporter: cfhammill | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Linux | Architecture: x86_64 Type of failure: Compile-time | (amd64) crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by niteria): * Attachment "TypeLevel.hs" added. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 24 13:38:08 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 24 Jan 2018 13:38:08 -0000 Subject: [GHC] #11735: Optimize coercionKind In-Reply-To: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> References: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> Message-ID: <062.34f247f2874b75c33bc8745d7d0aca26@haskell.org> #11735: Optimize coercionKind -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.10.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by tdammers): Applying the `coercionKind` patch brings down compilation time for the `Grammar.hs` example from #14683 to about 30 seconds. Relevant profiling data: {{{ Wed Jan 24 14:33 2018 Time and Allocation Profiling Report (Final) ghc-stage2 +RTS -p -RTS -B/home/tobias/well- typed/devel/ghc/inplace/lib Grammar.hs -ddump-stg -ddump-simpl -ddump-to- file -fforce-recomp total time = 32.48 secs (32475 ticks @ 1000 us, 1 processor) total alloc = 43,424,804,608 bytes (excludes profiling overheads) COST CENTRE MODULE SRC %time %alloc CoreTidy HscMain compiler/main/HscMain.hs:1253:27-67 20.3 22.6 subst_ty TyCoRep compiler/types/TyCoRep.hs:2225:28-32 17.7 23.9 Stg2Stg HscMain compiler/main/HscMain.hs:1489:12-44 13.9 16.3 simplCast Simplify compiler/simplCore/Simplify.hs:871:62-87 12.8 10.7 simplCast-addCoerce Simplify compiler/simplCore/Simplify.hs:1225:53-71 11.6 9.2 tc_rn_src_decls TcRnDriver compiler/typecheck/TcRnDriver.hs:(494,4)-(556,7) 6.4 4.6 addCoerce-pushCoTyArg Simplify compiler/simplCore/Simplify.hs:(1236,12)-(1237,72) 5.0 4.3 preprocessFile GhcMake compiler/main/GhcMake.hs:(2416,1)-(2443,37) 1.0 0.0 coercionKind Coercion compiler/types/Coercion.hs:1707:3-7 1.0 1.9 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 24 13:42:24 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 24 Jan 2018 13:42:24 -0000 Subject: [GHC] #14637: Simplifier Ticks Exhausted when compiling with profiling In-Reply-To: <048.f4904dcbe44c7548ff4503ec6ec99eff@haskell.org> References: <048.f4904dcbe44c7548ff4503ec6ec99eff@haskell.org> Message-ID: <063.4dd59b7215af73e0e6a89e47316b5bfa@haskell.org> #14637: Simplifier Ticks Exhausted when compiling with profiling -------------------------------------+------------------------------------- Reporter: cfhammill | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Linux | Architecture: x86_64 Type of failure: Compile-time | (amd64) crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Thanks. I can repro this. For the record, changing `bug2.hs` to define just {{{ foo :: Rec Identity '["policyID" :-> Int, "statecode" :-> String, "county" :-> String, "eq_site_limit" :-> Double, "hu_site_limit" :-> Double, "fl_site_limit" :-> Double, "fr_site_limit" :-> Double, "tiv_2011" :-> Double, "tiv_2012" :-> Double, "eq_site_deductible" :-> Bool, "hu_site_deductible" :-> Double, "fl_site_deductible" :-> Bool, "fr_site_deductible" :-> Bool, "point_latitude" :-> Double, "point_longitude" :-> Double, "line" :-> String, "construction" :-> String, "point_granularity" :-> Int, "statecode" :-> String, "county" :-> String, "eq_site_limit" :-> Double, "hu_site_limit" :-> Double, "fl_site_limit" :-> Double, "fr_site_limit" :-> Double, "tiv_2011" :-> Double, "tiv_2012" :-> Double, "eq_site_deductible" :-> Bool, "hu_site_deductible" :-> Double, "fl_site_deductible" :-> Bool, "fr_site_deductible" :-> Bool, "point_latitude" :-> Double, "point_longitude" :-> Double, "line" :-> String, "construction" :-> String, "point_granularity" :-> Int] foo = mergeRows (undefined :: FL2) (undefined :: FL2) }}} without main or the (overloaded) `print`, is enough to make it go out to lunch. Moreover, this happens in the very first iteration of the simplifier. I have not got further yet. Next steps: try with a smaller `FL2` and see how the compile time (or, more precisely, simplifier ticks) goes non- linear. I say "simplifier tickes" because I would not have been suprised at non- linearity in the type checker... we are manipulating sets as lists in the type system. But I'm more surprised at non-linearity in the simplifier. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 24 13:46:05 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 24 Jan 2018 13:46:05 -0000 Subject: [GHC] #11735: Optimize coercionKind In-Reply-To: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> References: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> Message-ID: <062.d41eb30955aac63568ee5598ef3d4d84@haskell.org> #11735: Optimize coercionKind -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.10.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by tdammers): Replying to [comment:6 simonpj]: > > We should do the same thing to coercionKindRole. (Tiresomely.) > > Actually, looking at it, I think it'd be better to define > {{{ > coercionRole :: Coercion -> Role > }}} > directly (a simple, fast recursive function), and then define > {{{ > coercionKindRole :: Coercion -> (Pair Type, Role) > coercionKindRole co = (coercionKind co, coercionRole co) > }}} > Less duplication, and (I strongly suspect) faster. Could you try that and check perf? I'm not sure I understand what `coercionRole` would look like. Also, does that mean that the inline notes in the existing `coercionRoleKinds` and `coercionRole` functions don't apply anymore? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 24 14:05:21 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 24 Jan 2018 14:05:21 -0000 Subject: [GHC] #14637: Simplifier Ticks Exhausted when compiling with profiling In-Reply-To: <048.f4904dcbe44c7548ff4503ec6ec99eff@haskell.org> References: <048.f4904dcbe44c7548ff4503ec6ec99eff@haskell.org> Message-ID: <063.16138312392d873efed8ac93adfd0be2@haskell.org> #14637: Simplifier Ticks Exhausted when compiling with profiling -------------------------------------+------------------------------------- Reporter: cfhammill | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Linux | Architecture: x86_64 Type of failure: Compile-time | (amd64) crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by niteria): * cc: niteria (added) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 24 14:07:42 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 24 Jan 2018 14:07:42 -0000 Subject: [GHC] #11735: Optimize coercionKind In-Reply-To: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> References: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> Message-ID: <062.30cd6150a05ffe34c1e48259a81e1025@haskell.org> #11735: Optimize coercionKind -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.10.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by tdammers): Oh wait, I think I get it. Never mind. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 24 14:13:23 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 24 Jan 2018 14:13:23 -0000 Subject: [GHC] #14710: GHC 8.4.1-alpha allows the use of kind polymorphism without PolyKinds In-Reply-To: <050.c0df5def4de65d7ecd4d01ad9668904c@haskell.org> References: <050.c0df5def4de65d7ecd4d01ad9668904c@haskell.org> Message-ID: <065.55b15d84b62fb6a98cbecf805fb1c9b1@haskell.org> #14710: GHC 8.4.1-alpha allows the use of kind polymorphism without PolyKinds -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: high | Milestone: 8.4.1 Component: Compiler (Type | Version: 8.4.1-alpha1 checker) | Resolution: | Keywords: PolyKinds Operating System: Unknown/Multiple | Architecture: Type of failure: GHC accepts | Unknown/Multiple invalid program | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): Actually, this problem dates even further back than I imagined. Another problematic aspect of this code is that the definition of `C` alone is accepted: {{{#!hs {-# LANGUAGE KindSignatures #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# OPTIONS_GHC -ddump-deriv #-} module Bug where import Data.Coerce import Data.Proxy class C a b where c :: Proxy (x :: a) -> b }}} In fact, even GHC 8.0 accepts this! This appears to be a behavioral change from GHC 7.10.3, where this code is rejected: {{{ $ /opt/ghc/7.10.3/bin/ghc Bug.hs [1 of 1] Compiling Bug ( Bug.hs, Bug.o ) Bug.hs:10:20: Type variable ‘a’ used in a kind In the kind ‘a’ In the type ‘Proxy (x :: a) -> b’ In the class declaration for ‘C’ }}} (My guess is that commit 6746549772c5cc0ac66c0fce562f297f4d4b80a2, `Add kind equalities to GHC.`, is responsible for this.) Really, defining `C` should require `PolyKinds` (or perhaps even `TypeInType`), as the type variable `a` is also used as a kind variable within the type of `c`. You don't even need type classes for this issue to surface. Here is another problematic definition that uses plain old functions: {{{#!hs {-# LANGUAGE KindSignatures #-} {-# LANGUAGE ScopedTypeVariables #-} module Bug where import Data.Proxy f :: forall a. a -> a f x = const x g where g :: Proxy (x :: a) g = Proxy }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 24 14:16:40 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 24 Jan 2018 14:16:40 -0000 Subject: [GHC] #14710: GHC 8.4.1-alpha allows the use of kind polymorphism without PolyKinds In-Reply-To: <050.c0df5def4de65d7ecd4d01ad9668904c@haskell.org> References: <050.c0df5def4de65d7ecd4d01ad9668904c@haskell.org> Message-ID: <065.c896c0c9e69e9b44e21ef2ba2ca5679e@haskell.org> #14710: GHC 8.4.1-alpha allows the use of kind polymorphism without PolyKinds -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: high | Milestone: 8.4.1 Component: Compiler (Type | Version: 8.4.1-alpha1 checker) | Resolution: | Keywords: PolyKinds Operating System: Unknown/Multiple | Architecture: Type of failure: GHC accepts | Unknown/Multiple invalid program | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): One way to summarize this issue in that at the moment, GHC believes it can spot any code that requires `PolyKinds` at the granularity of individual type variable telescopes (for instance, `forall (a :: k). <...>` would require `PolyKinds` since the telescope `forall (a :: k)` implicitly quantifies `k`). But really this isn't true—a type variable might seem perfectly normal //within// a telescope, but elsewhere in its body it might be used as a kind variable (as in the examples above)! So it feels like we should be validity checking //uses// of type variables as well, not just their binding sites. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 24 14:19:16 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 24 Jan 2018 14:19:16 -0000 Subject: [GHC] #11735: Optimize coercionKind In-Reply-To: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> References: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> Message-ID: <062.d0a27594e1dc14fd6793fbeeace7a734@haskell.org> #11735: Optimize coercionKind -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.10.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * cc: goldfire (added) Comment: Great. Next step: 1. We should not spend 20% our time in `CoreTidy`, I think. Drill down. 2. Something is clearly wrong with `Simplify.simplCast`. I think I know what it is. Given {{{ (fun |> co) @t1 @t2 ... @tn }}} we will call `pushCoTyArg` `n` times, and hence does `n` singleton substitutions, via the `n` calls to `piResultTy`. Solution: gather up those type arguments (easy) and define {{{ pushCoTyArgs :: Coercion -> [Type] -> Maybe ([Type], Coercion) }}} using an accumulating substitution. I spent a few minutes trying to write down `pushCoTyArgs` but my brain melted in a mess of kind casts, and I ran out of time. '''Richard''' can you help with (2), please? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 24 14:32:20 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 24 Jan 2018 14:32:20 -0000 Subject: [GHC] #14710: GHC 8.4.1-alpha allows the use of kind polymorphism without PolyKinds In-Reply-To: <050.c0df5def4de65d7ecd4d01ad9668904c@haskell.org> References: <050.c0df5def4de65d7ecd4d01ad9668904c@haskell.org> Message-ID: <065.70df7235debaa5c444c9f56cb1906fe6@haskell.org> #14710: GHC 8.4.1-alpha allows the use of kind polymorphism without PolyKinds -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: high | Milestone: 8.4.1 Component: Compiler (Type | Version: 8.4.1-alpha1 checker) | Resolution: | Keywords: PolyKinds Operating System: Unknown/Multiple | Architecture: Type of failure: GHC accepts | Unknown/Multiple invalid program | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Excellent diagnosis. This can't be too hard to fix, but I'm out of cycles. Happy to advise. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 24 14:33:15 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 24 Jan 2018 14:33:15 -0000 Subject: [GHC] #11735: Optimize coercionKind In-Reply-To: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> References: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> Message-ID: <062.89709f7f1551473511d581aa4c96f8b4@haskell.org> #11735: Optimize coercionKind -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.10.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * failure: None/Unknown => Compile-time performance bug -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 24 14:44:44 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 24 Jan 2018 14:44:44 -0000 Subject: [GHC] #14713: GHCi doesn't load project. Message-ID: <054.d7ecad76c2756183240fb99c0fdc5e86@haskell.org> #14713: GHCi doesn't load project. -------------------------------------+------------------------------------- Reporter: recursion- | Owner: (none) ninja | Type: bug | Status: new Priority: normal | Milestone: Component: GHCi | Version: 8.2.2 Keywords: | Operating System: Unknown/Multiple Architecture: x86_64 | Type of failure: GHCi crash (amd64) | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- I got the following output when trying to load my Haskell project into GHCi using stack: {{{ GHCi, version 8.2.2: http://www.haskell.org/ghc/ :? for help ghc: panic! (the 'impossible' happened) (GHC version 8.2.2 for x86_64-unknown-linux): Loading temp shared object failed: /tmp/ghc3372_0/libghc_13.so: undefined symbol: numStates_g Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug }}} No other informative output was displayed. Output says report the defect, so you get a "bug report." -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 24 16:19:48 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 24 Jan 2018 16:19:48 -0000 Subject: [GHC] #11735: Optimize coercionKind In-Reply-To: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> References: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> Message-ID: <062.b73528db330749a9a5c956beec638294@haskell.org> #11735: Optimize coercionKind -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.10.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by tdammers): Refactoring `coercionRoleKinds` / `coercionRole` gives us another performance boost: {{{ Wed Jan 24 17:17 2018 Time and Allocation Profiling Report (Final) ghc-stage2 +RTS -p -RTS -B/home/tobias/well- typed/devel/ghc/inplace/lib Grammar.hs -ddump-stg -ddump-simpl -ddump-to- file -fforce-recomp total time = 24.18 secs (24176 ticks @ 1000 us, 1 processor) total alloc = 29,250,375,752 bytes (excludes profiling overheads) COST CENTRE MODULE SRC %time %alloc CoreTidy HscMain compiler/main/HscMain.hs:1253:27-67 24.8 28.5 Stg2Stg HscMain compiler/main/HscMain.hs:1489:12-44 20.1 24.2 simplCast Simplify compiler/simplCore/Simplify.hs:871:62-87 18.6 15.9 tc_rn_src_decls TcRnDriver compiler/typecheck/TcRnDriver.hs:(494,4)-(556,7) 8.1 6.9 addCoerce-pushCoTyArg Simplify compiler/simplCore/Simplify.hs:(1236,12)-(1237,72) 7.3 6.4 subst_ty TyCoRep compiler/types/TyCoRep.hs:2225:28-32 4.2 5.1 preprocessFile GhcMake compiler/main/GhcMake.hs:(2416,1)-(2443,37) 1.4 0.0 coercionKind Coercion compiler/types/Coercion.hs:1707:3-7 1.4 3.0 zonkTopDecls TcRnDriver compiler/typecheck/TcRnDriver.hs:(445,16)-(446,43) 1.3 1.1 simplExprF1-Lam Simplify compiler/simplCore/Simplify.hs:896:5-39 1.0 1.1 }}} Now on to the 25% spent on CoreTidy. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 24 16:36:42 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 24 Jan 2018 16:36:42 -0000 Subject: [GHC] #14710: GHC 8.4.1-alpha allows the use of kind polymorphism without PolyKinds In-Reply-To: <050.c0df5def4de65d7ecd4d01ad9668904c@haskell.org> References: <050.c0df5def4de65d7ecd4d01ad9668904c@haskell.org> Message-ID: <065.b44148b6a20a80d3718c6bb7366cd896@haskell.org> #14710: GHC 8.4.1-alpha allows the use of kind polymorphism without PolyKinds -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: high | Milestone: 8.4.1 Component: Compiler (Type | Version: 8.4.1-alpha1 checker) | Resolution: | Keywords: PolyKinds Operating System: Unknown/Multiple | Architecture: Type of failure: GHC accepts | Unknown/Multiple invalid program | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): Well, I'd //like// to be able to fix this, but have no solid idea of where to start. My first inclination would be to insert a validity check into the `KindedTyVar` case of [http://git.haskell.org/ghc.git/blob/f00ddea96cc856654ac90fcf7d29556a758d6648:/compiler/rename/RnTypes.hs#l1033 bindLHsTyVarBndrs]. I'd need to do roughly the following: * I'd need to figure out which variables are already bound in an enclosing scope (after all, those are the only sorts of type variables that exhibit this problem). * I'd need to partition them into type and kind variables (we only care about the kind variables). * Of those kind variables, I'd need to figure out which of them were originally bound as type variables. I'm afraid I don't know how to do any of those steps. Help? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 24 16:41:22 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 24 Jan 2018 16:41:22 -0000 Subject: [GHC] #14713: GHCi doesn't load project. In-Reply-To: <054.d7ecad76c2756183240fb99c0fdc5e86@haskell.org> References: <054.d7ecad76c2756183240fb99c0fdc5e86@haskell.org> Message-ID: <069.141dde46a2771f0a616a49cf837aeee0@haskell.org> #14713: GHCi doesn't load project. -------------------------------------+------------------------------------- Reporter: recursion-ninja | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: GHCi | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: x86_64 | (amd64) Type of failure: GHCi crash | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): Are you by any chance missing a foreign library reference in your cabal file? Is there some way I can reproduce this? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 24 16:49:24 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 24 Jan 2018 16:49:24 -0000 Subject: [GHC] #14710: GHC 8.4.1-alpha allows the use of kind polymorphism without PolyKinds In-Reply-To: <050.c0df5def4de65d7ecd4d01ad9668904c@haskell.org> References: <050.c0df5def4de65d7ecd4d01ad9668904c@haskell.org> Message-ID: <065.f39759f23e9d6cdcfbadc10d3a8fd0d8@haskell.org> #14710: GHC 8.4.1-alpha allows the use of kind polymorphism without PolyKinds -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: high | Milestone: 8.4.1 Component: Compiler (Type | Version: 8.4.1-alpha1 checker) | Resolution: | Keywords: PolyKinds Operating System: Unknown/Multiple | Architecture: Type of failure: GHC accepts | Unknown/Multiple invalid program | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): Actually, if we decide to require the use of `TypeInType` (and not just `PolyKinds`) for this featurette, then checking binding sites wouldn't be enough. It turns out the GHC currently accepts this program without `TypeInType`: {{{#!hs {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} module Bug where import Data.Proxy f :: forall k a. Proxy (a :: k) f = Proxy }}} But it seems like it shouldn't, since `k` is being quantified as a type variable but used as a kind variable. For comparison, if you tried this equivalent program: {{{#!hs {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} module Bug where import Data.Proxy f :: forall k (a :: k). Proxy a f = Proxy }}} Then GHC will bleat about `TypeInType`: {{{ $ ghci Bug.hs GHCi, version 8.2.2: http://www.haskell.org/ghc/ :? for help Loaded GHCi configuration from /home/rgscott/.ghci [1 of 1] Compiling Bug ( Bug.hs, interpreted ) Bug.hs:7:21: error: Type variable ‘k’ used in a kind. Did you mean to use TypeInType? the type signature for ‘f’ | 7 | f :: forall k (a :: k). Proxy a | ^ }}} So, in short: I'm even less sure about where to put this validity check :) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 24 17:19:24 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 24 Jan 2018 17:19:24 -0000 Subject: [GHC] #11735: Optimize coercionKind In-Reply-To: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> References: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> Message-ID: <062.7cf7c5f0a60760d8d5a8ffcd042386ec@haskell.org> #11735: Optimize coercionKind -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.10.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): > Refactoring coercionRoleKinds / coercionRole gives us another performance boost That is totally bonkers (in a good way). From 43G down to 29G from that one change. Wow. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 24 17:30:09 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 24 Jan 2018 17:30:09 -0000 Subject: [GHC] #11735: Optimize coercionKind In-Reply-To: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> References: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> Message-ID: <062.13558afcd7b9a787716ae0a7890ad994@haskell.org> #11735: Optimize coercionKind -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.10.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by goldfire): I'm dubious of the `coercionRole` refactor, as it undoes a refactoring I put in a few years ago, for performance reasons. The problem is that `coercionRole` depends on `coercionKind` in the `NthCo` case. So, if these functions are separated, then `coercionRole` recurs via both `coercionKind` and `coercionRole` sometimes, causing a lot of extra work. Note that a standalone `coercionKind` does exist, also for performance reasons. To be clear, I'm not doubting your numbers on your particular test case, but I'm not sure how far this would generalize. That said, the degree to which your case improved suggests there's some other inefficiency here. Maybe it's all the tuples? If we make them unboxed, does that fix the problem? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 24 17:30:56 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 24 Jan 2018 17:30:56 -0000 Subject: [GHC] #11735: Optimize coercionKind In-Reply-To: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> References: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> Message-ID: <062.342edb0487e0ffabdd404d056834de40@haskell.org> #11735: Optimize coercionKind -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.10.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by goldfire): I can take a look at comment:10 on Friday, but not before. Also, tdammers, thanks thanks thanks for doing this! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 24 17:34:30 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 24 Jan 2018 17:34:30 -0000 Subject: [GHC] #14675: GHC 8.4.1 regression: segfault when loading doctest on a module with ANNs on Ubuntu 16.04 or later In-Reply-To: <050.c5c190ffbc3e4175e84536f4424d1ad2@haskell.org> References: <050.c5c190ffbc3e4175e84536f4424d1ad2@haskell.org> Message-ID: <065.675948d21d1229c7cb0084a9b2569f14@haskell.org> #14675: GHC 8.4.1 regression: segfault when loading doctest on a module with ANNs on Ubuntu 16.04 or later -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: alpmestan Type: bug | Status: new Priority: highest | Milestone: 8.4.1 Component: GHC API | Version: 8.4.1-alpha1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Runtime crash | Test Case: Blocked By: | Blocking: Related Tickets: #14603 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by alpmestan): I ended up chasing down the problem with `gdb` a little bit but didn't really know where to break and stepping through everything was just not conceivable so I ended up going about it the good old way, by printing a bunch of things along the code path that leads to the error. Long story short, it looks like the `unsafeCoerce#` from `compiler/typecheck/TcSplice.hs:convertAnnotationWrapper` is the cause of the segfault. And the content of the annotation doesn't seem to matter, even `{-# ANN module () #-}` makes the program crash. You can see [https://gist.github.com/alpmestan/145fc5783f00bab9214b7302418aef49 here] my variant of `convertAnnotationWrapper` that prints a bunch of things all along, as well as the relevant section of the output (the "trace"). The program never makes it to "unsafeCoerce# went fine". I will next try to look into what the value we're coercing actually represents and why it's not what we expect. If anyone has any tips for figuring that out quickly, I'm all ears :) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 24 17:35:25 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 24 Jan 2018 17:35:25 -0000 Subject: [GHC] #11735: Optimize coercionKind In-Reply-To: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> References: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> Message-ID: <062.c9a0bb1b85e5c307bae431052b016c5d@haskell.org> #11735: Optimize coercionKind -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.10.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): > I'm dubious of the coercionRole refactor, as it undoes a refactoring I put in a few years ago, for performance reasons. I looked at what code would be needed for `coercionRole` and its a remarkably short and simple function. Tobias, would to like to post the code? Richard, did you have a concrete reason for that refactoring? Or just a general worry? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 24 17:43:58 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 24 Jan 2018 17:43:58 -0000 Subject: [GHC] #14111: strange error when using data families with levity polymorphism and unboxed sums and data families In-Reply-To: <045.61bc63eee0a790503467c9479892f97e@haskell.org> References: <045.61bc63eee0a790503467c9479892f97e@haskell.org> Message-ID: <060.77448c27bd3125c24551c9a96852f293@haskell.org> #14111: strange error when using data families with levity polymorphism and unboxed sums and data families -------------------------------------+------------------------------------- Reporter: carter | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: | Keywords: TypeFamilies Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #14457 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by carter): Did any action towards cleaning up the inference here make it into 8.4 ghc ? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 24 17:49:00 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 24 Jan 2018 17:49:00 -0000 Subject: [GHC] #14111: strange error when using data families with levity polymorphism and unboxed sums and data families In-Reply-To: <045.61bc63eee0a790503467c9479892f97e@haskell.org> References: <045.61bc63eee0a790503467c9479892f97e@haskell.org> Message-ID: <060.5a3c72ecebe0aab9b000e7d153966004@haskell.org> #14111: strange error when using data families with levity polymorphism and unboxed sums and data families -------------------------------------+------------------------------------- Reporter: carter | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: | Keywords: TypeFamilies Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #14457 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): 'Fraid not, as GHC 8.4.1 still rejects the original program and the program in comment:5. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 24 18:09:53 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 24 Jan 2018 18:09:53 -0000 Subject: [GHC] #14675: GHC 8.4.1 regression: segfault when loading doctest on a module with ANNs on Ubuntu 16.04 or later In-Reply-To: <050.c5c190ffbc3e4175e84536f4424d1ad2@haskell.org> References: <050.c5c190ffbc3e4175e84536f4424d1ad2@haskell.org> Message-ID: <065.954546dfcfa84a6e07318fff99977b34@haskell.org> #14675: GHC 8.4.1 regression: segfault when loading doctest on a module with ANNs on Ubuntu 16.04 or later -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: alpmestan Type: bug | Status: new Priority: highest | Milestone: 8.4.1 Component: GHC API | Version: 8.4.1-alpha1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Runtime crash | Test Case: Blocked By: | Blocking: Related Tickets: #14603 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): > I ended up chasing down the problem with gdb a little bit but didn't really know where to break and stepping through everything was just not conceivable so I ended up going about it the good old way, by printing a bunch of things along the code path that leads to the error. Great work so far! Indeed this is often the case; `gdb` can only get you so far. I should mention that [[http://rr-project.org/|rr]] is an extremely helpful tool in cases like this since it gives you multiple changes to trace through a given run of the program. I also have a `breakpoint` [[https://github.com/bgamari/breakpoint|package]] which makes it easy to insert debugger breakpoints into a Haskell program. While using the package in GHC may be more work than it's worth, stealing the idea should be straightforward. You also may want to try using my [[https://github.com/bgamari/ghc-utils/tree/master/gdb|gdb plugin]]. It makes inspecting the STG stack and heap significantly easier. Out of curiosity, is the issue still reproducible when GHC is built with profiling enabled? If so, it might be nice to continue debugging under this way as the profiled way includes a significant amount of information about the structure of heap objects that can be useful while debugging (e.g. type names). At this point I would do the following: 1. Insert a breakpoint right before the `unsafeCoerce#` 2. Look at the assembler that results and try to work out which register `annotation_wrapper` ends up in 3. Reproduce the issue in the debugging, look at this register, and look at its info table 4. Verify that the info table corresponds to either a thunk or a constructor of the expected type After that the decision tree will branch. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 24 19:12:41 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 24 Jan 2018 19:12:41 -0000 Subject: [GHC] #14689: Load order of .ghci config files is counterintuitive In-Reply-To: <050.b87151fcae6e630e6dfb4d15d5b0bf91@haskell.org> References: <050.b87151fcae6e630e6dfb4d15d5b0bf91@haskell.org> Message-ID: <065.1abdd1a3d11f85a8b5f69298f9f608b0@haskell.org> #14689: Load order of .ghci config files is counterintuitive -------------------------------------+------------------------------------- Reporter: hal9zillion | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: GHCi | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #14250, #6017 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by hal9zillion): Will definitely look into that. Thanks for the tip. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 24 19:19:00 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 24 Jan 2018 19:19:00 -0000 Subject: [GHC] #14504: Nofib is broken on Windows In-Reply-To: <046.cc1daf3bad5a64611f515c88109eb2f4@haskell.org> References: <046.cc1daf3bad5a64611f515c88109eb2f4@haskell.org> Message-ID: <061.86c57def21534d24941778a234c243f1@haskell.org> #14504: Nofib is broken on Windows -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: 8.6.1 Component: NoFib benchmark | Version: 8.2.1 suite | Resolution: fixed | Keywords: Operating System: Windows | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4222 Wiki Page: | -------------------------------------+------------------------------------- Changes (by AndreasK): * status: patch => closed * resolution: => fixed Comment: Works with HEAD. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 24 19:21:37 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 24 Jan 2018 19:21:37 -0000 Subject: [GHC] #11735: Optimize coercionKind In-Reply-To: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> References: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> Message-ID: <062.ed5c866084b913c71716996899733aa0@haskell.org> #11735: Optimize coercionKind -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.10.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by tdammers): Replying to [comment:16 simonpj]: > > I'm dubious of the coercionRole refactor, as it undoes a refactoring I put in a few years ago, for performance reasons. > > I looked at what code would be needed for `coercionRole` and its a remarkably short and simple function. Tobias, would to like to post the code? Of course. Here's the patch: {{{ diff --git a/compiler/types/Coercion.hs b/compiler/types/Coercion.hs index e1a5b7cde0..36874a4c4d 100644 --- a/compiler/types/Coercion.hs +++ b/compiler/types/Coercion.hs @@ -1783,77 +1783,53 @@ coercionKinds tys = sequenceA $ map coercionKind tys -- | Get a coercion's kind and role. -- Why both at once? See Note [Computing a coercion kind and role] coercionKindRole :: Coercion -> (Pair Type, Role) -coercionKindRole = go +coercionKindRole co = (coercionKind co, coercionRole co) + +-- | Retrieve the role from a coercion. +coercionRole :: Coercion -> Role +coercionRole = go where - go (Refl r ty) = (Pair ty ty, r) - go (TyConAppCo r tc cos) - = (mkTyConApp tc <$> (sequenceA $ map coercionKind cos), r) - go (AppCo co1 co2) - = let (tys1, r1) = go co1 in - (mkAppTy <$> tys1 <*> coercionKind co2, r1) - go (ForAllCo tv1 k_co co) - = let Pair _ k2 = coercionKind k_co - tv2 = setTyVarKind tv1 k2 - (Pair ty1 ty2, r) = go co - subst = zipTvSubst [tv1] [TyVarTy tv2 `mkCastTy` mkSymCo k_co] - ty2' = substTyAddInScope subst ty2 in - -- We need free vars of ty2 in scope to satisfy the invariant - -- from Note [The substitution invariant] - -- This is doing repeated substitutions and probably doesn't - -- need to, see #11735 - (mkInvForAllTy <$> Pair tv1 tv2 <*> Pair ty1 ty2', r) - go (FunCo r co1 co2) - = (mkFunTy <$> coercionKind co1 <*> coercionKind co2, r) + go (Refl r _) = r + go (TyConAppCo r _ _) = r + go (AppCo co1 _) = go co1 + go (ForAllCo _ _ co) = go co + go (FunCo r _ _) = r go (CoVarCo cv) = go_var cv go (HoleCo h) = go_var (coHoleCoVar h) - go co@(AxiomInstCo ax _ _) = (coercionKind co, coAxiomRole ax) - go (UnivCo _ r ty1 ty2) = (Pair ty1 ty2, r) - go (SymCo co) = first swap $ go co - go (TransCo co1 co2) - = let (tys1, r) = go co1 in - (Pair (pFst tys1) (pSnd $ coercionKind co2), r) + go (AxiomInstCo ax _ _) = coAxiomRole ax + go (UnivCo _ r _ _) = r + go (SymCo co) = go co + go (TransCo co1 co2) = go co1 go (NthCo d co) | Just (tv1, _) <- splitForAllTy_maybe ty1 = ASSERT( d == 0 ) - let (tv2, _) = splitForAllTy ty2 in - (tyVarKind <$> Pair tv1 tv2, Nominal) + Nominal | otherwise = let (tc1, args1) = splitTyConApp ty1 (_tc2, args2) = splitTyConApp ty2 in ASSERT2( tc1 == _tc2, ppr d $$ ppr tc1 $$ ppr _tc2 ) - ((`getNth` d) <$> Pair args1 args2, nthRole r tc1 d) + (nthRole r tc1 d) where - (Pair ty1 ty2, r) = go co - go co@(LRCo {}) = (coercionKind co, Nominal) + (Pair ty1 ty2, r) = coercionKindRole co + go (LRCo {}) = Nominal go (InstCo co arg) = go_app co [arg] - go (CoherenceCo co1 co2) - = let (Pair t1 t2, r) = go co1 in - (Pair (t1 `mkCastTy` co2) t2, r) - go co@(KindCo {}) = (coercionKind co, Nominal) - go (SubCo co) = (coercionKind co, Representational) - go co@(AxiomRuleCo ax _) = (coercionKind co, coaxrRole ax) + go (CoherenceCo co1 _) = go co1 + go (KindCo {}) = Nominal + go (SubCo _) = Representational + go (AxiomRuleCo ax _) = coaxrRole ax ------------- - go_var cv = (coVarTypes cv, coVarRole cv) + go_var = coVarRole ------------- - go_app :: Coercion -> [Coercion] -> (Pair Type, Role) + go_app :: Coercion -> [Coercion] -> Role -- Collect up all the arguments and apply all at once -- See Note [Nested InstCos] go_app (InstCo co arg) args = go_app co (arg:args) - go_app co args - = let (pair, r) = go co in - (piResultTys <$> pair <*> (sequenceA $ map coercionKind args), r) - --- | Retrieve the role from a coercion. -coercionRole :: Coercion -> Role -coercionRole = snd . coercionKindRole - -- There's not a better way to do this, because NthCo needs the *kind* - -- and role of its argument. Luckily, laziness should generally avoid - -- the need for computing kinds in other cases. + go_app co args = go co {- Note [Nested InstCos] }}} Or, for increased clarity, just the new version of `coercionRole`: {{{ -- | Retrieve the role from a coercion. coercionRole :: Coercion -> Role coercionRole = go where go (Refl r _) = r go (TyConAppCo r _ _) = r go (AppCo co1 _) = go co1 go (ForAllCo _ _ co) = go co go (FunCo r _ _) = r go (CoVarCo cv) = go_var cv go (HoleCo h) = go_var (coHoleCoVar h) go (AxiomInstCo ax _ _) = coAxiomRole ax go (UnivCo _ r _ _) = r go (SymCo co) = go co go (TransCo co1 co2) = go co1 go (NthCo d co) | Just (tv1, _) <- splitForAllTy_maybe ty1 = ASSERT( d == 0 ) Nominal | otherwise = let (tc1, args1) = splitTyConApp ty1 (_tc2, args2) = splitTyConApp ty2 in ASSERT2( tc1 == _tc2, ppr d $$ ppr tc1 $$ ppr _tc2 ) (nthRole r tc1 d) where (Pair ty1 ty2, r) = coercionKindRole co go (LRCo {}) = Nominal go (InstCo co arg) = go_app co [arg] go (CoherenceCo co1 _) = go co1 go (KindCo {}) = Nominal go (SubCo _) = Representational go (AxiomRuleCo ax _) = coaxrRole ax ------------- go_var = coVarRole ------------- go_app :: Coercion -> [Coercion] -> Role -- Collect up all the arguments and apply all at once -- See Note [Nested InstCos] go_app (InstCo co arg) args = go_app co (arg:args) go_app co args = go co }}} I didn't make an effort at completely understanding what this is supposed to do, really; what I did, in a nutshell, was: - Rename `coercionKindRole` to `coercionRole` and change its type - Remove the first tuple element from each returned value - Fix recursive calls and local functions to not take the now-redundant first parameter and not return the first tuple element - Write a new `coercionKindRole` function that simply calls `coercionKind` and `coercionRole` and tuples up the results So it's entirely possible that I did something wrong somewhere. Anyway, I don't know if this would qualify as "remarkably short", but it is fairly simple. > > Richard, did you have a concrete reason for that refactoring? Or just a general worry? I believe the explanation is in the note at the bottom: {{{ Note [Nested InstCos] ~~~~~~~~~~~~~~~~~~~~~ In Trac #5631 we found that 70% of the entire compilation time was being spent in coercionKind! The reason was that we had (g @ ty1 @ ty2 .. @ ty100) -- The "@s" are InstCos where g :: forall a1 a2 .. a100. phi If we deal with the InstCos one at a time, we'll do this: 1. Find the kind of (g @ ty1 .. @ ty99) : forall a100. phi' 2. Substitute phi'[ ty100/a100 ], a single tyvar->type subst But this is a *quadratic* algorithm, and the blew up Trac #5631. So it's very important to do the substitution simultaneously; cf Type.piResultTys (which in fact we call here). }}} I'm not entirely sure whether this still applies though; I would expect the separate `coercionRole` and `coercionKinds` functions to perform better individually than the combined one, except when both are actually needed in concert. And even then, I'm skeptical; the recursive calls would drag along both data structures (kinds and role). Is it possible that this particular bit of code looked crucially different back when #5631 was ongoing? Or did I un-refactor in a way that doesn't replicate a crucial problem from the original code? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 24 19:29:01 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 24 Jan 2018 19:29:01 -0000 Subject: [GHC] #14714: RTS Timings on windows are somewhat unreliable Message-ID: <047.56ba6ca9a911aa84ee3884738d51ff48@haskell.org> #14714: RTS Timings on windows are somewhat unreliable -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.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: -------------------------------------+------------------------------------- Times given by the RTS are very unreliable on small scales. Part of that is I assume simply the lack of precision. But CPU Time often is reported higher than wall clock time (using the single threaded RTS) as well. Examples: {{{ $ ./binary-trees 12 +RTS -t stretch tree of depth 13 check: -1 ... long lived tree of depth 12 check: -1 <> $ ./binary-trees 12 +RTS -t stretch tree of depth 13 check: -1 8192 trees of depth 4 check: -8192 ... 32 trees of depth 12 check: -32 long lived tree of depth 12 check: -1 <> }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 24 19:36:23 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 24 Jan 2018 19:36:23 -0000 Subject: [GHC] #11735: Optimize coercionKind In-Reply-To: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> References: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> Message-ID: <062.6b1c5bb2ba9f668db024451c6e8e1206@haskell.org> #11735: Optimize coercionKind -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.10.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by tdammers): Oh, and also this note further up: {{{ Note [Computing a coercion kind and role] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ To compute a coercion's kind is straightforward: see coercionKind. But to compute a coercion's role, in the case for NthCo we need its kind as well. So if we have two separate functions (one for kinds and one for roles) we can get exponentially bad behaviour, since each NthCo node makes a separate call to coercionKind, which traverses the sub-tree again. This was part of the problem in Trac #9233. Solution: compute both together; hence coercionKindRole. We keep a separate coercionKind function because it's a bit more efficient if the kind is all you want. }}} Which leads me to believe that maybe this particular input I'm testing doesn't hit the `NthCo` branch enough to make a dent there, and thus fares better with the separated-out implementation, but other code might. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 24 20:31:53 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 24 Jan 2018 20:31:53 -0000 Subject: [GHC] #14715: GHC 8.4.1-alpha regression with PartialTypeSignatures Message-ID: <050.adc4992a794b331cf0bfd2207ccd29b6@haskell.org> #14715: GHC 8.4.1-alpha regression with PartialTypeSignatures -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.4.1 Component: Compiler | Version: 8.4.1-alpha1 (Type checker) | Keywords: | Operating System: Unknown/Multiple PartialTypeSignatures | Architecture: | Type of failure: GHC rejects Unknown/Multiple | valid program Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- This bug prevents `lol-apps`' tests and benchmarks from building with GHC 8.4.1-alpha2. This is as much as I'm able to minimize the issue: {{{#!hs {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE PartialTypeSignatures #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} {-# OPTIONS_GHC -Wno-partial-type-signatures #-} module Bug (bench_mulPublic) where data Cyc r data CT zp r'q class Reduce a b type family LiftOf b bench_mulPublic :: forall z zp zq . (z ~ LiftOf zq, _) => Cyc zp -> Cyc z -> IO (zp,zq) bench_mulPublic pt sk = do ct :: CT zp (Cyc zq) <- encrypt sk pt undefined ct encrypt :: forall z zp zq. Reduce z zq => Cyc z -> Cyc zp -> IO (CT zp (Cyc zq)) encrypt = undefined }}} On GHC 8.2.2, this compiles without issue. But on GHC 8.4.1-alpha2, this errors with: {{{ $ /opt/ghc/8.4.1/bin/ghc Bug.hs [1 of 1] Compiling Bug ( Bug.hs, Bug.o ) Bug.hs:15:1: error: • Could not deduce (Reduce fsk0 zq) from the context: (z ~ LiftOf zq, Reduce fsk zq) bound by the inferred type for ‘bench_mulPublic’: forall z zp zq fsk. (z ~ LiftOf zq, Reduce fsk zq) => Cyc zp -> Cyc z -> IO (zp, zq) at Bug.hs:(15,1)-(17,14) The type variable ‘fsk0’ is ambiguous • In the ambiguity check for the inferred type for ‘bench_mulPublic’ To defer the ambiguity check to use sites, enable AllowAmbiguousTypes When checking the inferred type bench_mulPublic :: forall z zp zq fsk. (z ~ LiftOf zq, Reduce fsk zq) => Cyc zp -> Cyc z -> IO (zp, zq) | 15 | bench_mulPublic pt sk = do | ^^^^^^^^^^^^^^^^^^^^^^^^^^... }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 24 21:13:04 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 24 Jan 2018 21:13:04 -0000 Subject: [GHC] #14669: 32-bit binaries sometimes throw a stack overflow on shutdown. In-Reply-To: <044.45c88c9a13190d9f2a70cd9b35309cc0@haskell.org> References: <044.45c88c9a13190d9f2a70cd9b35309cc0@haskell.org> Message-ID: <059.8056a8916f5d7e3aa7e4e05cca10742a@haskell.org> #14669: 32-bit binaries sometimes throw a stack overflow on shutdown. -------------------------------------+------------------------------------- Reporter: sergv | Owner: (none) Type: bug | Status: patch Priority: highest | Milestone: 8.4.1 Component: Runtime System | Version: 8.2.1 Resolution: | Keywords: Operating System: Windows | Architecture: | Unknown/Multiple Type of failure: Runtime crash | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4343 Wiki Page: | -------------------------------------+------------------------------------- Changes (by Phyx-): * status: infoneeded => patch * priority: normal => highest * differential: => Phab:D4343 * architecture: x86 => Unknown/Multiple * milestone: => 8.4.1 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 24 21:13:42 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 24 Jan 2018 21:13:42 -0000 Subject: [GHC] #14669: Windows binaries sometimes throw a stack overflow. (was: 32-bit binaries sometimes throw a stack overflow on shutdown.) In-Reply-To: <044.45c88c9a13190d9f2a70cd9b35309cc0@haskell.org> References: <044.45c88c9a13190d9f2a70cd9b35309cc0@haskell.org> Message-ID: <059.e8320b025086f95054262a391052414c@haskell.org> #14669: Windows binaries sometimes throw a stack overflow. -------------------------------------+------------------------------------- Reporter: sergv | Owner: (none) Type: bug | Status: patch Priority: highest | Milestone: 8.4.1 Component: Runtime System | Version: 8.2.1 Resolution: | Keywords: Operating System: Windows | Architecture: | Unknown/Multiple Type of failure: Runtime crash | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4343 Wiki Page: | -------------------------------------+------------------------------------- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 24 21:14:55 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 24 Jan 2018 21:14:55 -0000 Subject: [GHC] #14637: Simplifier Ticks Exhausted when compiling with profiling In-Reply-To: <048.f4904dcbe44c7548ff4503ec6ec99eff@haskell.org> References: <048.f4904dcbe44c7548ff4503ec6ec99eff@haskell.org> Message-ID: <063.bf96b99f44bb0195d8212843d5dc9ea6@haskell.org> #14637: Simplifier Ticks Exhausted when compiling with profiling -------------------------------------+------------------------------------- Reporter: cfhammill | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Linux | Architecture: x86_64 Type of failure: Compile-time | (amd64) crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by niteria): Things appear to be growing exponentially: {{{ SIZE 1 Result size of Desugar (before optimization) = {terms: 158, types: 621, coercions: 257, joins: 0/19} Result size of Desugar (after optimization) = {terms: 133, types: 370, coercions: 150, joins: 0/4} Result size of Simplifier iteration=1 = {terms: 205, types: 466, coercions: 81, joins: 0/4} Total ticks: 222 SIZE 2 Result size of Desugar (before optimization) = {terms: 175, types: 903, coercions: 463, joins: 0/25} Result size of Desugar (after optimization) = {terms: 144, types: 544, coercions: 345, joins: 0/7} Result size of Simplifier iteration=1 = {terms: 411, types: 3,242, coercions: 1,533, joins: 0/32} Total ticks: 454 SIZE 3 Result size of Desugar (before optimization) = {terms: 198, types: 1,358, coercions: 823, joins: 0/33} Result size of Desugar (after optimization) = {terms: 159, types: 845, coercions: 691, joins: 0/11} Result size of Simplifier iteration=1 = {terms: 705, types: 8,184, coercions: 3,826, joins: 0/67} Total ticks: 1360 SIZE 4 Result size of Desugar (before optimization) = {terms: 227, types: 2,029, coercions: 1,398, joins: 0/43} Result size of Desugar (after optimization) = {terms: 178, types: 1,303, coercions: 1,248, joins: 0/16} Result size of Simplifier iteration=1 = {terms: 1,363, types: 20,717, coercions: 10,083, joins: 0/145} Total ticks: 4986 SIZE 5 Result size of Desugar (before optimization) = {terms: 262, types: 2,959, coercions: 2,269, joins: 0/55} Result size of Desugar (after optimization) = {terms: 201, types: 1,948, coercions: 2,096, joins: 0/22} Result size of Simplifier iteration=1 = {terms: 2,785, types: 50,660, coercions: 25,205, joins: 0/313} Total ticks: 9535 SIZE 6 Result size of Desugar (before optimization) = {terms: 303, types: 4,191, coercions: 3,525, joins: 0/69} Result size of Desugar (after optimization) = {terms: 228, types: 2,810, coercions: 3,323, joins: 0/29} Result size of Simplifier iteration=1 = {terms: 5,851, types: 120,950, coercions: 60,893, joins: 0/673} Total ticks: 18885 SIZE 7 Result size of Desugar (before optimization) = {terms: 350, types: 5,768, coercions: 5,267, joins: 0/85} Result size of Desugar (after optimization) = {terms: 259, types: 3,919, coercions: 5,029, joins: 0/37} Result size of Simplifier iteration=1 = {terms: 13,977, types: 330,419, coercions: 199,879, joins: 0/1,505} Total ticks: 38957 SIZE 8 Result size of Desugar (before optimization) = {terms: 403, types: 7,733, coercions: 7,608, joins: 0/103} Result size of Desugar (after optimization) = {terms: 294, types: 5,305, coercions: 7,326, joins: 0/46} Result size of Simplifier iteration=1 = {terms: 30,779, types: 795,941, coercions: 499,205, joins: 0/3,233} Total ticks: 82839 SIZE 9 Result size of Desugar (before optimization) = {terms: 462, types: 10,129, coercions: 10,673, joins: 0/123} Result size of Desugar (after optimization) = {terms: 333, types: 6,998, coercions: 10,338, joins: 0/56} Result size of Simplifier iteration=1 = {terms: 60,193, types: 1,647,410, coercions: 937,457, joins: 0/6,881} Total ticks: 179203 }}} If we don't run out of ticks the simplifier manages to beat down the sizes considerably (see attached `results-all`). -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 24 21:20:56 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 24 Jan 2018 21:20:56 -0000 Subject: [GHC] #14637: Simplifier Ticks Exhausted when compiling with profiling In-Reply-To: <048.f4904dcbe44c7548ff4503ec6ec99eff@haskell.org> References: <048.f4904dcbe44c7548ff4503ec6ec99eff@haskell.org> Message-ID: <063.c791bb6a00e4dd08b5628123bae3e7a8@haskell.org> #14637: Simplifier Ticks Exhausted when compiling with profiling -------------------------------------+------------------------------------- Reporter: cfhammill | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Linux | Architecture: x86_64 Type of failure: Compile-time | (amd64) crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by niteria): * Attachment "results-all" added. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 24 21:30:10 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 24 Jan 2018 21:30:10 -0000 Subject: [GHC] #11735: Optimize coercionKind In-Reply-To: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> References: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> Message-ID: <062.ebdc5b3ffdc89825339af5c92026d2a0@haskell.org> #11735: Optimize coercionKind -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.10.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): * In your `coercionRole`, `get_app` never uses its second argument! So you can get rid of it entirely I think {{{ go (InstCo co _) = go co }}} * `Note [Nested InstCos]` applies to `coercionKind` but not, I think, to `coercionRole` * `Note [Computing a coercion kind and role]` claims that computing the result of `coercionRole (NthCo d co)` requires `coercionKind`. But it manifestly does not. '''Richard''' is this note simply wrong? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 24 21:50:18 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 24 Jan 2018 21:50:18 -0000 Subject: [GHC] #14714: RTS Timings on windows are somewhat unreliable In-Reply-To: <047.56ba6ca9a911aa84ee3884738d51ff48@haskell.org> References: <047.56ba6ca9a911aa84ee3884738d51ff48@haskell.org> Message-ID: <062.81fce8ac9a53b2992213faa54ad2934f@haskell.org> #14714: RTS Timings on windows are somewhat unreliable -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: (none) Type: bug | Status: closed Priority: low | Milestone: Component: Runtime System | Version: 8.2.2 Resolution: wontfix | Keywords: Operating System: Windows | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by AndreasK): * status: new => closed * component: Compiler => Runtime System * resolution: => wontfix * os: Unknown/Multiple => Windows * priority: normal => low Comment: There seems to be no way around this. The windows cpuTime information comes from `GetProcessTimes` while the elapsed time uses `QueryPerformanceCounter`. GetProcessTimes has a lower accuracy which leads to these result for cpuTime. QueryProcessCycleTime would have better resolution but measures cycles not time. This works fine for benchmarking where one would disable frequency scaling anyway. But It would lead to confusing results otherwise. Marking this as wontfix for now as I don't think there is a better solution available currently. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 24 21:54:18 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 24 Jan 2018 21:54:18 -0000 Subject: [GHC] #5793: make nofib awesome In-Reply-To: <045.7d57713ed957ba5bcc7ab6a047de30d4@haskell.org> References: <045.7d57713ed957ba5bcc7ab6a047de30d4@haskell.org> Message-ID: <060.8aa11006b1b693acb54e191990419fc5@haskell.org> #5793: make nofib awesome -------------------------------------+------------------------------------- Reporter: dterei | Owner: michalt Type: task | Status: new Priority: normal | Milestone: ⊥ Component: NoFib benchmark | Version: suite | Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: 9571 | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by AndreasK): > Fixup the runtimes for benchmarks to be significant. This might be best done by changing the way we run benchmarks and collect results to make sure they are meaningful. Windows suffers especially from this as the cpuTime measurement has less accuracy there. See #14714 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 24 22:13:06 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 24 Jan 2018 22:13:06 -0000 Subject: [GHC] #14669: Windows binaries sometimes throw a stack overflow. In-Reply-To: <044.45c88c9a13190d9f2a70cd9b35309cc0@haskell.org> References: <044.45c88c9a13190d9f2a70cd9b35309cc0@haskell.org> Message-ID: <059.00d23031df70516e105d93aafcf4afdb@haskell.org> #14669: Windows binaries sometimes throw a stack overflow. -------------------------------------+------------------------------------- Reporter: sergv | Owner: (none) Type: bug | Status: patch Priority: highest | Milestone: 8.4.1 Component: Runtime System | Version: 8.2.1 Resolution: | Keywords: Operating System: Windows | Architecture: | Unknown/Multiple Type of failure: Runtime crash | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4343 Wiki Page: | -------------------------------------+------------------------------------- Comment (by Phyx-): @sergv Can you try out the patch attached? It should fix the issue. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 24 22:35:28 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 24 Jan 2018 22:35:28 -0000 Subject: [GHC] #14699: Library status for 8.4.1 In-Reply-To: <046.12f775ea02060174a5ac178f457055aa@haskell.org> References: <046.12f775ea02060174a5ac178f457055aa@haskell.org> Message-ID: <061.5068858efcd0565ea14a9d537de87fa0@haskell.org> #14699: Library status for 8.4.1 -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: task | Status: new Priority: highest | Milestone: 8.4.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by George): Yes containers has been released, also primitive. I believe we also need unordered-containers and hashtables but maybe I too don't understand the table -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 24 22:37:52 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 24 Jan 2018 22:37:52 -0000 Subject: [GHC] #14637: Simplifier Ticks Exhausted when compiling with profiling In-Reply-To: <048.f4904dcbe44c7548ff4503ec6ec99eff@haskell.org> References: <048.f4904dcbe44c7548ff4503ec6ec99eff@haskell.org> Message-ID: <063.4c58ee2514f7da3593cc1c0f9c1d5ad0@haskell.org> #14637: Simplifier Ticks Exhausted when compiling with profiling -------------------------------------+------------------------------------- Reporter: cfhammill | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Linux | Architecture: x86_64 Type of failure: Compile-time | (amd64) crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by niteria): It's enough to put `-fprof-auto-top` just on `Lens.hs`. Removing `{-# INLINE lens #-}` fixes exponential behavior. Interestingly I wasn't able to put enough `{-# SCC #-}` annotations to get the same effect as `-fprof-auto-top`. No matter how I try I can't put them on a class method, but perhaps I'm doing something wrong. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 25 01:27:28 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 25 Jan 2018 01:27:28 -0000 Subject: [GHC] #14715: GHC 8.4.1-alpha regression with PartialTypeSignatures In-Reply-To: <050.adc4992a794b331cf0bfd2207ccd29b6@haskell.org> References: <050.adc4992a794b331cf0bfd2207ccd29b6@haskell.org> Message-ID: <065.83fc4872bda0da8e4d9451d2b76794b4@haskell.org> #14715: GHC 8.4.1-alpha regression with PartialTypeSignatures -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.4.1 Component: Compiler (Type | Version: 8.4.1-alpha1 checker) | Keywords: Resolution: | PartialTypeSignatures Operating System: Unknown/Multiple | Architecture: Type of failure: GHC rejects | Unknown/Multiple valid program | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * cc: simonpj (added) Comment: This regression was introduced in 8dc6d645fc3384b3b8ded0578939f5c855dd2ed5 (`Re-engineer Given flatten-skolems`). -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 25 01:35:14 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 25 Jan 2018 01:35:14 -0000 Subject: [GHC] #11735: Optimize coercionKind In-Reply-To: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> References: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> Message-ID: <062.aa66a907496fcdf39d1f8bb93fbd790e@haskell.org> #11735: Optimize coercionKind -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.10.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by goldfire): Thanks for finding `Note [Computing a coercion kind and role]`. I believe this note is correct and is as relevant today as it was when I wrote it. And, I'm afraid to say that `coercionRole (NthCo ...)` manifestly '''does''' require `coercionKind`. See the call in the `where` clause in the suggested patch. However, perhaps the solution lies in including the role of an `NthCo` in the `NthCo`, essentially caching this result. I think this would be easy to do, especially as the caller of `mkNthCo` generally has to know what role its getting -- `mkNthCo` could take this role as a parameter. Lint could check that the supplied role is the same as what would have been calculated. With this change to `NthCo`, then `coercionRole` really would be independent of `coercionKind` and we could separate the functions. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 25 03:13:55 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 25 Jan 2018 03:13:55 -0000 Subject: [GHC] #14716: indexM-style accessor for arrays? Message-ID: <045.382f374145c4a013f6bcf49e8b87d85e@haskell.org> #14716: indexM-style accessor for arrays? -------------------------------------+------------------------------------- Reporter: Zemyla | Owner: (none) Type: feature | Status: new request | Priority: normal | Milestone: Component: libraries | Version: 8.2.2 (other) | Keywords: array | Operating System: Unknown/Multiple Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- Pretty much everything I've seen being done with basic `Array`s says something along the lines of "You have to force the argument; otherwise, you get a thunk that holds a reference to the array". An example of that is `fromArray` in `Data.Sequence`. But it really shouldn't be this way. The `Array` from `primitive` and the `Vector`s from `vector` have ways of obtaining a value from an array that doesn't leave a thunk hanging around. The basic prototype is {{{#!hs indexArrayM :: Monad m => Array a -> Int -> m a }}} And having this sort of thing available for standard `Array`s would be useful because `Array` is one of the first packages users see when they look for something like arrays in Haskell. Also, it's tagged `Trustworthy`, unlike `primitive` or `vector`, and there are references to them in `containers`, which is again a package lots of people use. It'd also mean that the `Functor`, `Foldable`, and `Traversable` instances don't leak memory. As a sort-of-related side note, we should also have a function `(!?)`, which functions like the similarly-named function in `vector`, and has the signature {{{#!hs (!?) :: (IArray a e, Ix i) => a i e -> i -> Maybe e }}} This would, in addition to not leaving a thunk when the `Maybe` is deconstructed, also eliminate a common use pattern when it comes to arrays: The user of `(!)` checks the bounds of the array, does something if it's outside, then passes the index to `(!)` which... checks the bounds again. Having a function which works like `lookup` on `Map`s would be a boon here. Having this work for all `IArray`s, not just `Array`, would require a new function in the `IArray` typeclass, which might break existing packages that derive a new `IArray`. However, the function added could be along the lines of: {{{#!hs unsafeAtM :: (Applicative f, Ix i) => a i e -> i -> f e unsafeAtM a i f = pure (unsafeAt a i) }}} which would be a default that, while it doesn't grant the benefits of using a monadic-type accessor, would ensure the code doesn't break while the packages that use/derive it are upgraded. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 25 07:52:08 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 25 Jan 2018 07:52:08 -0000 Subject: [GHC] #11735: Optimize coercionKind In-Reply-To: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> References: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> Message-ID: <062.d0241197e924d09c06432645e8133bbc@haskell.org> #11735: Optimize coercionKind -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.10.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by tdammers): Replying to [comment:20 goldfire]: > Thanks for finding `Note [Computing a coercion kind and role]`. I believe this note is correct and is as relevant today as it was when I wrote it. > And, I'm afraid to say that `coercionRole (NthCo ...)` manifestly '''does''' require `coercionKind`. See the call in the `where` clause in the suggested patch. Correct. The original `coercionKindRole` function recursed via the `go` worker directly, but now that I have rewritten it as `coercionRole`, the `NthCo` case still required the coercion kind to do its thing, so it calls `coercionKindRole`, which, post-unrefactoring, calls both `coercionKind` and `coercionRole`. > However, perhaps the solution lies in including the role of an `NthCo` in the `NthCo`, essentially caching this result. I think this would be easy to do, especially as the caller of `mkNthCo` generally has to know what role its getting -- `mkNthCo` could take this role as a parameter. Lint could check that the supplied role is the same as what would have been calculated. With this change to `NthCo`, then `coercionRole` really would be independent of `coercionKind` and we could separate the functions. Sounds like a reasonable plan; however, before I venture into implementing this, I would love to have some hard evidence that we actually do have a problem. Do you have any single-module example code ready that I could use to prove that the "un-refactored" code performs significantly worse than current HEAD on some inputs? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 25 07:54:08 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 25 Jan 2018 07:54:08 -0000 Subject: [GHC] #11735: Optimize coercionKind In-Reply-To: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> References: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> Message-ID: <062.0a1ff0cd6ca9dc900469c5dff3b09564@haskell.org> #11735: Optimize coercionKind -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.10.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by tdammers): Replying to [comment:19 simonpj]: > * In your `coercionRole`, `get_app` never uses its second argument! So you can get rid of it entirely I think > {{{ > go (InstCo co _) = go co > }}} Good catch, hadn't noticed. Thanks! > * `Note [Computing a coercion kind and role]` claims that computing the result of `coercionRole (NthCo d co)` requires `coercionKind`. But it manifestly does not. '''Richard''' is this note simply wrong? No, it's not wrong, see my earlier comment - `coercionRole` now recurses via `coercionKindRole` in the `where` clause. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 25 08:48:16 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 25 Jan 2018 08:48:16 -0000 Subject: [GHC] #11735: Optimize coercionKind In-Reply-To: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> References: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> Message-ID: <062.e495355f9bcd14cb64df521ea17725dc@haskell.org> #11735: Optimize coercionKind -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.10.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): > I'm afraid to say that coercionRole (NthCo ...) manifestly does require coercionKind Aha. So it does. Very well, yes let's do this * Cache the role (of the result of `NthCo i co`) in the `NthCo` data constructor * Make `mkNth` compute that cached role by calling `coercionKind` and `coercionRole` (in the final equation where we build `NthCo`). * Possible gloss: in some calls to `mkNthCo` we know the role, and we even know that the various short-cuts in `mkNthCo` won't succeed. So we can just use `NthCo` directly -- or define `mkNthCoDirect = NthCo` and call `mkNthCoDirect`. Perhaps not worth it; but when we do know the role it seems a bit silly not to use it. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 25 09:09:51 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 25 Jan 2018 09:09:51 -0000 Subject: [GHC] #11735: Optimize coercionKind In-Reply-To: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> References: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> Message-ID: <062.4e6332b132c12fa9e3452f7875ce6a5a@haskell.org> #11735: Optimize coercionKind -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.10.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): > I would love to have some hard evidence that we actually do have a problem. Well, without caching we know that getting the role of `NthCo i1 (NthCo i2 (NthCo i3 ...))` will take time at least quadratic in the nesting depth. Caching cheaply avoids nasty corner case. And not much code is involved. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 25 09:17:22 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 25 Jan 2018 09:17:22 -0000 Subject: [GHC] #14669: Windows binaries sometimes throw a stack overflow. In-Reply-To: <044.45c88c9a13190d9f2a70cd9b35309cc0@haskell.org> References: <044.45c88c9a13190d9f2a70cd9b35309cc0@haskell.org> Message-ID: <059.2f094440f0c45203d0044ce095c5a928@haskell.org> #14669: Windows binaries sometimes throw a stack overflow. -------------------------------------+------------------------------------- Reporter: sergv | Owner: (none) Type: bug | Status: patch Priority: highest | Milestone: 8.4.1 Component: Runtime System | Version: 8.2.1 Resolution: | Keywords: Operating System: Windows | Architecture: | Unknown/Multiple Type of failure: Runtime crash | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4343 Wiki Page: | -------------------------------------+------------------------------------- Comment (by sergv): @Phyx- The patch works - freshly built release RTS does not crash any more. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 25 09:50:56 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 25 Jan 2018 09:50:56 -0000 Subject: [GHC] #14717: Hidden package hints no longer display Message-ID: <047.c46b47b6ebca0c950882fdcc6a0147c6@haskell.org> #14717: Hidden package hints no longer display -------------------------------------+------------------------------------- Reporter: snoyberg | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: Poor/confusing Unknown/Multiple | error message Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- This started as a mailing list thread: https://mail.haskell.org/pipermail /haskell-cafe/2018-January/128485.html. Dan Burton demonstrated a reproduction without any build tool. With GHC 8.0.2, when you try to use a module from a hidden package, you get an error message with a helpful hint to add the package to the build- depends. With GHC 8.2.2 (and I believe 8.2.1), it appears that this hint is no longer displayed. To demonstrate, I'll copy Dan's repro: {{{ $ cat Main.hs module Main where import Data.Map main = putStrLn "It compiles" $ ghc-pkg list containers /usr/local/Cellar/ghc/8.2.2/lib/ghc-8.2.2/package.conf.d containers-0.5.10.2 $ ghc --make -hide-all-packages -package base Main.hs [1 of 1] Compiling Main ( Main.hs, Main.o ) Main.hs:2:1: error: Could not find module ‘Data.Map’ Use -v to see a list of the files searched for. | 2 | import Data.Map | ^^^^^^^^^^^^^^^ $ ghc --make -hide-all-packages -package base -package containers Main.hs [1 of 1] Compiling Main ( Main.hs, Main.o ) Linking Main ... }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 25 10:15:03 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 25 Jan 2018 10:15:03 -0000 Subject: [GHC] #11735: Optimize coercionKind In-Reply-To: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> References: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> Message-ID: <062.d7cf0a2d1b5bf31185a35712f759c43b@haskell.org> #11735: Optimize coercionKind -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.10.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by tdammers): Replying to [comment:24 simonpj]: > > I would love to have some hard evidence that we actually do have a problem. > > Well, without caching we know that getting the role of `NthCo i1 (NthCo i2 (NthCo i3 ...))` will take time at least quadratic in the nesting depth. Caching cheaply avoids nasty corner case. And not much code is involved. Fair enough, I'll get to it. Just wanted a test case for practical verification. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 25 11:22:52 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 25 Jan 2018 11:22:52 -0000 Subject: [GHC] #14644: Improve cmm/assembly for pattern matches with two constants. In-Reply-To: <047.054a8f1d3e52c239a87742662b91a120@haskell.org> References: <047.054a8f1d3e52c239a87742662b91a120@haskell.org> Message-ID: <062.70c8b9105f8fc462351cce3f2d6859b5@haskell.org> #14644: Improve cmm/assembly for pattern matches with two constants. -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: AndreasK Type: task | Status: patch Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 (CodeGen) | Keywords: Codegen, CMM, Resolution: | Patterns, Pattern Matching Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4294 Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Are we good to go on this? I.e. commit? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 25 11:31:50 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 25 Jan 2018 11:31:50 -0000 Subject: [GHC] #14068: Loopification using join points In-Reply-To: <046.e16e22cbe3c046431dc8ebed421f2e67@haskell.org> References: <046.e16e22cbe3c046431dc8ebed421f2e67@haskell.org> Message-ID: <061.44d6f73727193557cd12f81dc2eb3623@haskell.org> #14068: Loopification using join points -------------------------------------+------------------------------------- Reporter: nomeata | Owner: nomeata Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.0.1 Resolution: | Keywords: JoinPoints Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #13966 #14067 | Differential Rev(s): Phab:D3811 Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Joachim, where are we on loopification? I think you have `wip/T14068` with this commit {{{ commit b4ab3a5f1fa051be9c5689f7ecef16458b2d700d Author: Joachim Breitner Date: Fri Aug 4 15:34:11 2017 -0400 Prevent inlining of loopified programs Previously, a recursive function is not inlineable. After loopification, it turns into a non-recursive function, and suddenly it is. While this is in general desirable, it has many knock-on effects, which makes it hard to evaluate and debug loopification. Therefore, this commit (tries to) prevent this inlining. When this results in no unfixable regressions, then we can tackle the next step. It is surprisingly hard to reliably prevent inlining, it seems, so I have been playing whack-a-mole a bit: * simpl_binds has two copies of the ids around, one in the env and one in the AST. If maybeLoopify changes only one of them, then things go wrong. Worked-around that for now, but probably not ideal. TODO: Apply maybeLoopify before entering simplTopBinds * Also, worker-wrapper needs to preserve the no-inlining better }}} But I think it's in limbo? Or has it been overtaken by events? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 25 11:35:35 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 25 Jan 2018 11:35:35 -0000 Subject: [GHC] #14372: CMM contains a bunch of tail-merging opportunities In-Reply-To: <048.1c543d9c1482e4763ed7a0bf48a66309@haskell.org> References: <048.1c543d9c1482e4763ed7a0bf48a66309@haskell.org> Message-ID: <063.409ebf031087740ada76beddc6041e50@haskell.org> #14372: CMM contains a bunch of tail-merging opportunities -------------------------------------+------------------------------------- Reporter: heisenbug | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: | Keywords: CodeGen Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * keywords: => CodeGen Old description: > Compile this code to CMM > {{{#!hs > data Small = S1 | S2 | S3 | S4 deriving (Show, Enum) > > data Big = B1 | B2 | B3 | B4 | B5 | B6 | B7 | B8 | B9 | B10 deriving > (Show, Enum) > > {-# NOINLINE quux #-} > quux B1 = 'a' > quux B2 = 'b' > quux B3 = 'c' > quux B4 = 'd' > quux B5 = 'e' > quux B6 = 'f' > quux B7 = 'g' > quux B8 = 'h' > quux B9 = 'i' > quux B10 = 'j' > > {-# NOINLINE qaax #-} > qaax B1 = 'a' > qaax B2 = 'b' > qaax B3 = 'c' > qaax B4 = 'd' > qaax B5 = 'e' > > qaax B7 = 'g' > qaax B8 = 'h' > qaax B9 = 'i' > qaax B10 = 'j' > > {-# NOINLINE foo #-} > foo B1 = S1 > foo B2 = S2 > foo B3 = S3 > foo B4 = S4 > > {-# NOINLINE bar #-} > bar S1 = B1 > bar S2 = B2 > bar S3 = B3 > bar S4 = B4 > > main = do print $ take 100000 (repeat (foo <$> [B1 .. B4])) > print $ take 100000 (repeat (bar <$> [S1 .. S4])) > print $ take 100000 (repeat (quux <$> [B1 .. B10])) > print $ qaax B1 > }}} > > When `Char` or ''enum-like'' ADT is returned, I see lots of case > branches, which only differ in the first instruction. > > E.g. > {{{ > c30l: // global > R1 = stg_CHARLIKE_closure+1649; > Sp = Sp + 8; > call (P64[Sp])(R1) args: 8, res: 0, upd: 8; > c30m: // global > R1 = stg_CHARLIKE_closure+1665; > Sp = Sp + 8; > call (P64[Sp])(R1) args: 8, res: 0, upd: 8; > u30Z: // global > if (_c30p::I64 < 9) goto c30n; else goto c30o; > c30n: // global > R1 = stg_CHARLIKE_closure+1681; > Sp = Sp + 8; > call (P64[Sp])(R1) args: 8, res: 0, upd: 8; > c30o: // global > R1 = stg_CHARLIKE_closure+1697; > Sp = Sp + 8; > call (P64[Sp])(R1) args: 8, res: 0, upd: 8; > }}} > > It would be nice to factor out the common tails, e.g. by branching to the > first tail already emitted. > > Bonus points for rewriting switch tables to contain the above numbers and > compile to a lookup + common code. > > This is what I am talking about: > > {{{ > c307: // global > _s2ON::P64 = R1; > _c30j::P64 = _s2ON::P64 & 7; > switch [1 .. 7] _c30j::P64 { > case 1 : goto c30d; > case 2 : goto c30e; > case 3 : goto c30f; > case 4 : goto c30g; > case 5 : goto c30h; > ... > } > > ... > c30h: // global > R1 = stg_CHARLIKE_closure+1617; > Sp = Sp + 8; > call (P64[Sp])(R1) args: 8, res: 0, upd: 8; > c30g: // global > R1 = stg_CHARLIKE_closure+1601; > Sp = Sp + 8; > call (P64[Sp])(R1) args: 8, res: 0, upd: 8; > c30f: // global > R1 = stg_CHARLIKE_closure+1585; > Sp = Sp + 8; > call (P64[Sp])(R1) args: 8, res: 0, upd: 8; > c30e: // global > R1 = stg_CHARLIKE_closure+1569; > Sp = Sp + 8; > call (P64[Sp])(R1) args: 8, res: 0, upd: 8; > c30d: // global > R1 = stg_CHARLIKE_closure+1553; > Sp = Sp + 8; > call (P64[Sp])(R1) args: 8, res: 0, upd: 8; > }}} > > There should be an array [1553, 1569, 1585, ...] > and each case should be the same: > {{{ > R1 = stg_CHARLIKE_closure; > R1 = R1 + array[tag]; > Sp = Sp + 8; > call (P64[Sp])(R1) args: 8, res: 0, upd: 8; > }}} New description: Compile this code to CMM {{{#!hs data Small = S1 | S2 | S3 | S4 deriving (Show, Enum) data Big = B1 | B2 | B3 | B4 | B5 | B6 | B7 | B8 | B9 | B10 deriving (Show, Enum) {-# NOINLINE quux #-} quux B1 = 'a' quux B2 = 'b' quux B3 = 'c' quux B4 = 'd' quux B5 = 'e' quux B6 = 'f' quux B7 = 'g' quux B8 = 'h' quux B9 = 'i' quux B10 = 'j' {-# NOINLINE qaax #-} qaax B1 = 'a' qaax B2 = 'b' qaax B3 = 'c' qaax B4 = 'd' qaax B5 = 'e' qaax B7 = 'g' qaax B8 = 'h' qaax B9 = 'i' qaax B10 = 'j' {-# NOINLINE foo #-} foo B1 = S1 foo B2 = S2 foo B3 = S3 foo B4 = S4 {-# NOINLINE bar #-} bar S1 = B1 bar S2 = B2 bar S3 = B3 bar S4 = B4 main = do print $ take 100000 (repeat (foo <$> [B1 .. B4])) print $ take 100000 (repeat (bar <$> [S1 .. S4])) print $ take 100000 (repeat (quux <$> [B1 .. B10])) print $ qaax B1 }}} When `Char` or ''enum-like'' ADT is returned, I see lots of case branches, which only differ in the first instruction. E.g. {{{ c30l: // global R1 = stg_CHARLIKE_closure+1649; Sp = Sp + 8; call (P64[Sp])(R1) args: 8, res: 0, upd: 8; c30m: // global R1 = stg_CHARLIKE_closure+1665; Sp = Sp + 8; call (P64[Sp])(R1) args: 8, res: 0, upd: 8; u30Z: // global if (_c30p::I64 < 9) goto c30n; else goto c30o; c30n: // global R1 = stg_CHARLIKE_closure+1681; Sp = Sp + 8; call (P64[Sp])(R1) args: 8, res: 0, upd: 8; c30o: // global R1 = stg_CHARLIKE_closure+1697; Sp = Sp + 8; call (P64[Sp])(R1) args: 8, res: 0, upd: 8; }}} It would be nice to factor out the common tails, e.g. by branching to the first tail already emitted. Bonus points for rewriting switch tables to contain the above numbers and compile to a lookup + common code. This is what I am talking about: {{{ c307: // global _s2ON::P64 = R1; _c30j::P64 = _s2ON::P64 & 7; switch [1 .. 7] _c30j::P64 { case 1 : goto c30d; case 2 : goto c30e; case 3 : goto c30f; case 4 : goto c30g; case 5 : goto c30h; ... } ... c30h: // global R1 = stg_CHARLIKE_closure+1617; Sp = Sp + 8; call (P64[Sp])(R1) args: 8, res: 0, upd: 8; c30g: // global R1 = stg_CHARLIKE_closure+1601; Sp = Sp + 8; call (P64[Sp])(R1) args: 8, res: 0, upd: 8; c30f: // global R1 = stg_CHARLIKE_closure+1585; Sp = Sp + 8; call (P64[Sp])(R1) args: 8, res: 0, upd: 8; c30e: // global R1 = stg_CHARLIKE_closure+1569; Sp = Sp + 8; call (P64[Sp])(R1) args: 8, res: 0, upd: 8; c30d: // global R1 = stg_CHARLIKE_closure+1553; Sp = Sp + 8; call (P64[Sp])(R1) args: 8, res: 0, upd: 8; }}} There should be an array [1553, 1569, 1585, ...] and each case should be the same: {{{ R1 = stg_CHARLIKE_closure; R1 = R1 + array[tag]; Sp = Sp + 8; call (P64[Sp])(R1) args: 8, res: 0, upd: 8; }}} See also #14666 -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 25 11:36:31 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 25 Jan 2018 11:36:31 -0000 Subject: [GHC] #14226: Common Block Elimination pass doesn't eliminate common blocks In-Reply-To: <046.64e654c74c7432ac06e937473b6324b1@haskell.org> References: <046.64e654c74c7432ac06e937473b6324b1@haskell.org> Message-ID: <061.6658c2e9aabb096b11652a8d964713ea@haskell.org> #14226: Common Block Elimination pass doesn't eliminate common blocks -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: closed Priority: high | Milestone: 8.4.1 Component: Compiler | Version: 8.2.1 (CodeGen) | Keywords: newcomer, Resolution: fixed | CodeGen Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #9157 | Differential Rev(s): Phab:D3973, Wiki Page: | Phab:D3999 -------------------------------------+------------------------------------- Changes (by simonpj): * keywords: newcomer => newcomer, CodeGen Comment: What's the status here? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 25 11:37:49 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 25 Jan 2018 11:37:49 -0000 Subject: [GHC] #14668: Ordering of declarations can cause typechecking to fail In-Reply-To: <050.d042aa520b7fcde791e49a2b284676e9@haskell.org> References: <050.d042aa520b7fcde791e49a2b284676e9@haskell.org> Message-ID: <065.bd2369e4f15395ac9a3944887c78fc00@haskell.org> #14668: Ordering of declarations can cause typechecking to fail -------------------------------------+------------------------------------- Reporter: heptahedron | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.2.1 checker) | Resolution: | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): May, possibly, relate to #12088 or #14451 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 25 11:41:15 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 25 Jan 2018 11:41:15 -0000 Subject: [GHC] #14718: Add Boolean type families to 'base' package Message-ID: <047.060f2285544130e30b97a1cdd131ee48@haskell.org> #14718: Add Boolean type families to 'base' package -------------------------------------+------------------------------------- Reporter: chshersh | Owner: (none) Type: feature | Status: new request | Priority: normal | Milestone: Component: Core | Version: 8.5 Libraries | Keywords: base, type | Operating System: Unknown/Multiple families, Bool | Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- Sometimes you want type families to perform type level computation with booleans. Specifically: {{{#!hs type family If (p :: Bool) (ifTrue :: k) (ifFalse :: k) :: k where ... type family (a :: Bool) && (b :: Bool) :: Bool where ... type family (a :: Bool) || (b :: Bool) :: Bool where ... type family Not (a :: Bool) :: Bool where }}} Similar to existing module [https://hackage.haskell.org/package/base-4.10.1.0/docs/Data-Bool.html Data.Bool] in `base` package for boolean expressions. There's not a single package with such type families for type-level boolean computations. Even if it exists it probably would very small. And as a library author you probably don't wan extra dependencies for your package because cost of adding new dependency for your project is much bigger than cost of adding module to existing dependencies (if it's possible of course). It seems to me that such operations are kinda basic. And they just promote behavior of already existed expression-level functions to type level. And we already have type families for `Integer`, `Natural` and `String` (aka `Symbol`) and several type families returning `Bool` (`==`, `<=?`) in `base`. So I propose to add couple useful utilities to operate with `Bool` explicitly. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 25 11:43:22 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 25 Jan 2018 11:43:22 -0000 Subject: [GHC] #14677: Code generator does not correctly tag a pointer In-Reply-To: <046.7a1d900f9976c54932290e6492402f05@haskell.org> References: <046.7a1d900f9976c54932290e6492402f05@haskell.org> Message-ID: <061.1a56f175c430e4c1e800c495bf27c8f3@haskell.org> #14677: Code generator does not correctly tag a pointer -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: 14626 Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Any progress, heisenbug? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 25 11:44:48 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 25 Jan 2018 11:44:48 -0000 Subject: [GHC] #14718: Add Boolean type families to 'base' package In-Reply-To: <047.060f2285544130e30b97a1cdd131ee48@haskell.org> References: <047.060f2285544130e30b97a1cdd131ee48@haskell.org> Message-ID: <062.be5960433406dbf4100fe5eebb55e47b@haskell.org> #14718: Add Boolean type families to 'base' package -------------------------------------+------------------------------------- Reporter: chshersh | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Core Libraries | Version: 8.5 Resolution: | Keywords: base, type | families, Bool Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Description changed by chshersh: Old description: > Sometimes you want type families to perform type level computation with > booleans. > Specifically: > {{{#!hs > type family If (p :: Bool) (ifTrue :: k) (ifFalse :: k) :: k where ... > type family (a :: Bool) && (b :: Bool) :: Bool where ... > type family (a :: Bool) || (b :: Bool) :: Bool where ... > type family Not (a :: Bool) :: Bool where > }}} > > Similar to existing module > [https://hackage.haskell.org/package/base-4.10.1.0/docs/Data-Bool.html > Data.Bool] in `base` package for boolean expressions. > > There's not a single package with such type families for type-level > boolean computations. Even if it exists it probably would very small. And > as a library author you probably don't wan extra dependencies for your > package because cost of adding new dependency for your project is much > bigger than cost of adding module to existing dependencies (if it's > possible of course). > > It seems to me that such operations are kinda basic. And they just > promote behavior of already existed expression-level functions to type > level. And we already have type families for `Integer`, `Natural` and > `String` (aka `Symbol`) and several type families returning `Bool` (`==`, > `<=?`) in `base`. So I propose to add couple useful utilities to operate > with `Bool` explicitly. New description: Sometimes you want type families to perform type level computation with booleans. Specifically: {{{#!hs type family If (p :: Bool) (ifTrue :: k) (ifFalse :: k) :: k where ... type family (a :: Bool) && (b :: Bool) :: Bool where ... type family (a :: Bool) || (b :: Bool) :: Bool where ... type family Not (a :: Bool) :: Bool where }}} Similar to existing module [https://hackage.haskell.org/package/base-4.10.1.0/docs/Data-Bool.html Data.Bool] in `base` package for boolean expressions. There's not a single package with such type families for type-level boolean computations. Even if it exists it probably would very small. And as a library author you probably don't wan extra dependencies for your package because cost of adding new dependency for your project is much bigger than cost of adding module to existing dependencies (if it's possible of course). It seems to me that such operations are kinda basic. And they just promote behavior of already existed expression-level functions to type level. And we already have type families for `Integer`, `Natural` and `String` (aka `Symbol`) and several type families returning `Bool` (`==`, `<=?`) in `base`. So I propose to add couple useful utilities to operate with `Bool` explicitly. If this proposal approved I'm willing to contribute to `ghc`! -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 25 11:57:18 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 25 Jan 2018 11:57:18 -0000 Subject: [GHC] #11735: Optimize coercionKind In-Reply-To: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> References: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> Message-ID: <062.8b8d16c3996417e0a35456561d4689b3@haskell.org> #11735: Optimize coercionKind -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.10.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by tdammers): The caching approach implemented directly (i.e., adding a `Role` field to the `NthCo` constructor) is a fairly pervasive one; it turns out that many modules depend on that constructor, either directly o via the isomorphic `IfaceCoercion` type (which, I believe, should inherit the additional field, correct me if I'm wrong), so adding the extra fields is going to touch a lot of source files. Not a fundamental problem per se, but it means that this will take a little while and will deserve some extra scrutinity before unleashing it. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 25 12:22:21 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 25 Jan 2018 12:22:21 -0000 Subject: [GHC] #11735: Optimize coercionKind In-Reply-To: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> References: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> Message-ID: <062.b98fc7a058525271623acb1528852ad8@haskell.org> #11735: Optimize coercionKind -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.10.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by tdammers): OK, new profiling result: {{{ Thu Jan 25 13:11 2018 Time and Allocation Profiling Report (Final) ghc-stage2 +RTS -p -RTS -B/home/tobias/well- typed/devel/ghc/inplace/lib Grammar.hs -ddump-stg -ddump-simpl -ddump-to- file -fforce-recomp total time = 20.99 secs (20989 ticks @ 1000 us, 1 processor) total alloc = 29,250,375,256 bytes (excludes profiling overheads) COST CENTRE MODULE SRC %time %alloc CoreTidy HscMain compiler/main/HscMain.hs:1253:27-67 24.2 28.5 Stg2Stg HscMain compiler/main/HscMain.hs:1489:12-44 20.3 24.2 simplCast Simplify compiler/simplCore/Simplify.hs:871:62-87 18.7 15.9 tc_rn_src_decls TcRnDriver compiler/typecheck/TcRnDriver.hs:(494,4)-(556,7) 9.0 6.9 addCoerce-pushCoTyArg Simplify compiler/simplCore/Simplify.hs:(1236,12)-(1237,72) 7.4 6.4 subst_ty TyCoRep compiler/types/TyCoRep.hs:2237:28-32 4.3 5.1 zonkTopDecls TcRnDriver compiler/typecheck/TcRnDriver.hs:(445,16)-(446,43) 1.4 1.1 coercionKind Coercion compiler/types/Coercion.hs:1725:3-7 1.3 3.0 simplExprF1-Lam Simplify compiler/simplCore/Simplify.hs:896:5-39 1.0 1.1 }}} This is the same `Grammar.hs`, compiled with the same GHC code as before, but with `NthCo` extended with an extra `Role` field, and the kind calculation from `coercionRole` moved out into `mkNthCo`. I ended up having to make changes in 16 modules, but most of them were straightforward, discarding or forwarding the extra field in a pattern match. I think this shouldn't have any negative impact, because forwarding the role can only make things better (avoiding future calls to `coercionRole`), and discarding it retains the old status. Conclusions: - We're shaving off another 4 seconds of execution time, and allocations remain the same. So this doesn't seem to make things worse for the `Grammar.hs` case. - We are not actually reducing allocations any further. - CoreTidy is worth looking into. - In order to verify that this change really makes an impact for the better, I would still love to test this against source code that would perform badly without it. Test cases very welcome. - 20 seconds is still awfully long. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 25 12:54:38 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 25 Jan 2018 12:54:38 -0000 Subject: [GHC] #14677: Code generator does not correctly tag a pointer In-Reply-To: <046.7a1d900f9976c54932290e6492402f05@haskell.org> References: <046.7a1d900f9976c54932290e6492402f05@haskell.org> Message-ID: <061.af7174dedc1814265941aa6d0681e648@haskell.org> #14677: Code generator does not correctly tag a pointer -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: 14626 Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by heisenbug): Replying to [comment:11 simonpj]: > Any progress, heisenbug? Sure! With my latest `git push wip/T14677` I have added a testcase (at GHC root directory for the interim), which shows that invoking a function with a `newtype Event = Event Int` argument now (with the patch applied) incorrectly assumes that `Event` constructor is passed '''unpacked'''. If you build the `ghc-stage1` on this branch and compile using `-O2` you'll get failures. With `-O0` the test passes, (as does `master` and `GHC-8.2.2`). So something is still wrong. In the buggy case the tagged pointer is checked at bit position 0 so the tagged `I#` constructor is being detected, but interpreted as an `Event` = `[evtRead]`. I don't understand enough about argument unpacking to resolve this. Maybe you can have a look? The `-g` problems above are a red herring, and probably another bug. Please disregard for now. I did not try defining `Event` locally yet, maybe that changes the situation. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 25 13:11:03 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 25 Jan 2018 13:11:03 -0000 Subject: [GHC] #14675: GHC 8.4.1 regression: segfault when loading doctest on a module with ANNs on Ubuntu 16.04 or later In-Reply-To: <050.c5c190ffbc3e4175e84536f4424d1ad2@haskell.org> References: <050.c5c190ffbc3e4175e84536f4424d1ad2@haskell.org> Message-ID: <065.ff31d97df5501a1a6c2b9ccecd6d260f@haskell.org> #14675: GHC 8.4.1 regression: segfault when loading doctest on a module with ANNs on Ubuntu 16.04 or later -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: alpmestan Type: bug | Status: new Priority: highest | Milestone: 8.4.1 Component: GHC API | Version: 8.4.1-alpha1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Runtime crash | Test Case: Blocked By: | Blocking: Related Tickets: #14603 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by alpmestan): I can reproduce with a `prof`-flavoured GHC, yes. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 25 13:49:17 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 25 Jan 2018 13:49:17 -0000 Subject: [GHC] #14226: Common Block Elimination pass doesn't eliminate common blocks In-Reply-To: <046.64e654c74c7432ac06e937473b6324b1@haskell.org> References: <046.64e654c74c7432ac06e937473b6324b1@haskell.org> Message-ID: <061.392a16e9509519ac536bd0b74f018849@haskell.org> #14226: Common Block Elimination pass doesn't eliminate common blocks -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: new Priority: high | Milestone: 8.4.1 Component: Compiler | Version: 8.2.1 (CodeGen) | Keywords: newcomer, Resolution: | CodeGen Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #9157 | Differential Rev(s): Phab:D3973, Wiki Page: | Phab:D3999 -------------------------------------+------------------------------------- Changes (by bgamari): * status: closed => new * resolution: fixed => Comment: I've not yet investigated but I can certainly do so. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 25 13:56:01 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 25 Jan 2018 13:56:01 -0000 Subject: [GHC] #11735: Optimize coercionKind In-Reply-To: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> References: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> Message-ID: <062.1118c441cb7f3620b67b348c3acbc913@haskell.org> #11735: Optimize coercionKind -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.10.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): You don't need to propagate the change into `IfaceCoercion`: it's just a cache, so you can recompute it when turning `IfaceNthCo` into `NthCo`. On the whole I think it'd be better not to change `IfaceCoercion`: less redundancy in the `Iface` data types. Shaving off 4 seconds is fantastic. Take it! Also: * Yes `CoreTidy` is worth looking into * But also so is `simplCast`. See comment:10. '''Richard''' I need your help! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 25 13:58:09 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 25 Jan 2018 13:58:09 -0000 Subject: [GHC] #14068: Loopification using join points In-Reply-To: <046.e16e22cbe3c046431dc8ebed421f2e67@haskell.org> References: <046.e16e22cbe3c046431dc8ebed421f2e67@haskell.org> Message-ID: <061.839ac3419604607e20f54ae34d4f0ab2@haskell.org> #14068: Loopification using join points -------------------------------------+------------------------------------- Reporter: nomeata | Owner: nomeata Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.0.1 Resolution: | Keywords: JoinPoints Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #13966 #14067 | Differential Rev(s): Phab:D3811 Wiki Page: | -------------------------------------+------------------------------------- Changes (by nomeata): * cc: sanjitk@… (added) Comment: Loopification per se works, but it causes huge performance swings in both directions; not because of loopification itself, but because other parts of the compiler now treat the code differently. The current (disheartening) stats are at https://perf.haskell.org/ghc/#compare/af0aea9c3d5f68f2694bd7b6380788764aa3f1ff/f04fdcbc51fffa36619157defb105dae461da4b7 (this URL might stop working in the future when `wip/T14068` is rebased.) Without “Prevent inlining of loopified programs”, we now start inlining stuff that used to be recursive, which is not always a win, it seems. With this patch, we prevent that, but now other things don’t work as well as they used to. I lost steam in the fall tracking down all the regressions, but I now have a master student at Penn, Sanjit Kalapatapu, who is helping to track down them. Currently, he is looking into `SpecConstr`, which seems to stopped doing its thing (maybe because of the no-inline marker that we add…). I hope that with him there will be progress again, but I expect it to be slow progress. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 25 14:01:37 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 25 Jan 2018 14:01:37 -0000 Subject: [GHC] #14718: Add Boolean type families to 'base' package In-Reply-To: <047.060f2285544130e30b97a1cdd131ee48@haskell.org> References: <047.060f2285544130e30b97a1cdd131ee48@haskell.org> Message-ID: <062.499f416d709efb3c00fb71c004ffdd2f@haskell.org> #14718: Add Boolean type families to 'base' package -------------------------------------+------------------------------------- Reporter: chshersh | Owner: (none) Type: feature request | Status: closed Priority: normal | Milestone: Component: Core Libraries | Version: 8.5 Resolution: invalid | Keywords: base, type | families, Bool Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * status: new => closed * resolution: => invalid Comment: What you seek is already in `base`, in the [https://hackage.haskell.org/package/base-4.10.1.0/docs/Data-Type- Bool.html Data.Type.Bool] module. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 25 14:05:29 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 25 Jan 2018 14:05:29 -0000 Subject: [GHC] #14699: Library status for 8.4.1 In-Reply-To: <046.12f775ea02060174a5ac178f457055aa@haskell.org> References: <046.12f775ea02060174a5ac178f457055aa@haskell.org> Message-ID: <061.4e96c5d2c19d9142d969772e9300dcde@haskell.org> #14699: Library status for 8.4.1 -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: task | Status: new Priority: highest | Milestone: 8.4.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): To clear up some confusion: this table is only tracking libraries that are shipped with GHC itself. (Libraries like `unordered-containers` and `hashtables` are out of the scope of this issue, as they're developed independently of GHC.) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 25 14:22:43 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 25 Jan 2018 14:22:43 -0000 Subject: [GHC] #14068: Loopification using join points In-Reply-To: <046.e16e22cbe3c046431dc8ebed421f2e67@haskell.org> References: <046.e16e22cbe3c046431dc8ebed421f2e67@haskell.org> Message-ID: <061.7bc5cda076518c1afc8ed8b72e6e9133@haskell.org> #14068: Loopification using join points -------------------------------------+------------------------------------- Reporter: nomeata | Owner: nomeata Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.0.1 Resolution: | Keywords: JoinPoints Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #13966 #14067 | Differential Rev(s): Phab:D3811 Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): OK great. If you can do it on a wip branch then I can readily check it out, which will make it easier for me to offer suggestions if you need any discusison. Thanks! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 25 14:34:32 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 25 Jan 2018 14:34:32 -0000 Subject: [GHC] #14068: Loopification using join points In-Reply-To: <046.e16e22cbe3c046431dc8ebed421f2e67@haskell.org> References: <046.e16e22cbe3c046431dc8ebed421f2e67@haskell.org> Message-ID: <061.dfe58316e80c0aececc9ab2640ad6f61@haskell.org> #14068: Loopification using join points -------------------------------------+------------------------------------- Reporter: nomeata | Owner: nomeata Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.0.1 Resolution: | Keywords: JoinPoints Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #13966 #14067 | Differential Rev(s): Phab:D3811 Wiki Page: | -------------------------------------+------------------------------------- Comment (by nomeata): Well, `wip/T14068` is what we have, and you are very welcome to dabble with it, or even push to it. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 25 14:37:59 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 25 Jan 2018 14:37:59 -0000 Subject: [GHC] #14719: Caret diagnostics for GADT constructor error message don't span the whole constructor Message-ID: <050.fd67283e8ff25e6d8d4c0769f0b171e6@haskell.org> #14719: Caret diagnostics for GADT constructor error message don't span the whole constructor -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: Poor/confusing Unknown/Multiple | error message Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- Inspecting the caret diagnostics in the error message for this program: {{{#!hs {-# LANGUAGE GADTs #-} module Bug where data Foo1 where MkFoo1 :: Bool newtype Foo2 where MkFoo2 :: Foo2 }}} {{{ $ /opt/ghc/8.2.2/bin/ghc Bug.hs [1 of 1] Compiling Bug ( Bug.hs, Bug.o ) Bug.hs:5:3: error: • Data constructor ‘MkFoo1’ returns type ‘Bool’ instead of an instance of its parent type ‘Foo1’ • In the definition of data constructor ‘MkFoo1’ In the data type declaration for ‘Foo1’ | 5 | MkFoo1 :: Bool | ^ Bug.hs:8:3: error: • The constructor of a newtype must have exactly one field but ‘MkFoo2’ has none • In the definition of data constructor ‘MkFoo2’ In the newtype declaration for ‘Foo2’ | 8 | MkFoo2 :: Foo2 | ^ }}} We notice something fishy: the carets don't span the entirey of the constructor! Contrast this with the carets for the error message in this program: {{{#!hs {-# LANGUAGE GADTs #-} module Bug where data Foo where MkFoo, MkFoo :: Foo }}} {{{ $ /opt/ghc/8.2.2/bin/ghc Bug.hs [1 of 1] Compiling Bug ( Bug.hs, Bug.o ) Bug.hs:5:3: error: Multiple declarations of ‘MkFoo’ Declared at: Bug.hs:5:3 Bug.hs:5:3 | 5 | MkFoo, MkFoo :: Foo | ^^^^^^^^^^^^^^^^^^^ }}} Where the carets span everything that is relevant. I know what is causing this: patch incoming. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 25 14:42:27 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 25 Jan 2018 14:42:27 -0000 Subject: [GHC] #14719: Caret diagnostics for GADT constructor error message don't span the whole constructor In-Reply-To: <050.fd67283e8ff25e6d8d4c0769f0b171e6@haskell.org> References: <050.fd67283e8ff25e6d8d4c0769f0b171e6@haskell.org> Message-ID: <065.0c9b03d2db7d1c1974a66824db65d559@haskell.org> #14719: Caret diagnostics for GADT constructor error message don't span the whole constructor -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Poor/confusing | Unknown/Multiple error message | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4344 Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * status: new => patch * differential: => Phab:D4344 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 25 15:07:00 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 25 Jan 2018 15:07:00 -0000 Subject: [GHC] #14068: Loopification using join points In-Reply-To: <046.e16e22cbe3c046431dc8ebed421f2e67@haskell.org> References: <046.e16e22cbe3c046431dc8ebed421f2e67@haskell.org> Message-ID: <061.00f53ee20f9dee4f647e8c245a7a3526@haskell.org> #14068: Loopification using join points -------------------------------------+------------------------------------- Reporter: nomeata | Owner: nomeata Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.0.1 Resolution: | Keywords: JoinPoints Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #13966 #14067 | Differential Rev(s): Phab:D3811 Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Terrific; I doubt I'll dabble much, but am very open to discussion -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 25 15:43:56 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 25 Jan 2018 15:43:56 -0000 Subject: [GHC] #7414: plugins always trigger recompilation In-Reply-To: <045.791037be90cd943b6dd26df93dd060d8@haskell.org> References: <045.791037be90cd943b6dd26df93dd060d8@haskell.org> Message-ID: <060.8eab5a823cf7746afeaabbeb14a2f41e@haskell.org> #7414: plugins always trigger recompilation -------------------------------------+------------------------------------- Reporter: jwlato | Owner: (none) Type: feature request | Status: new Priority: high | Milestone: 8.6.1 Component: Compiler | Version: 7.6.1 Resolution: | Keywords: plugin, | RecompilationCheck Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by mpickering): * priority: normal => high * milestone: => 8.6.1 Comment: Is there anything blocking this ticket or does someone just need to implement it? It makes using plugins quite a bit more hassle than necessary. See also #12567 I really think this should be a priority for the next release (8.6) Ben said in an email thread last year that these should be the steps. But, if the implementation is slightly broken, implementing anything will be better than the current situation I posit! We can get back to the current situation by using `-fforce-recomp` after all. {{{ I think the real question is what sort of interface do plugin authors need? I suspect there are a few distinct tasks here, * compute and record module implementation hashes in interface files * to include plugin implementation hashes in the recompilation check * to provide an interface allowing a plugin to compute a hash of its arguments which can be included into the recompilation check. One way of realising this would be to add a field like the following to Plugin, pluginHash :: [CommandLineOption] -> Maybe Fingerprint -- Nothing would denote "always rebuild" Would this help in your case? This would allow us to fix the TH problem in #7277 and fix the plugins problem in #7414 and #12567 in a nearly optimal way (assuming the plugin author is able to precisely define a hash). None of this is terribly difficult and given Nick's recent work on his row types plugin, it seems like it's getting more urgent. Cheers, - Ben }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 25 17:04:21 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 25 Jan 2018 17:04:21 -0000 Subject: [GHC] #14677: Code generator does not correctly tag a pointer In-Reply-To: <046.7a1d900f9976c54932290e6492402f05@haskell.org> References: <046.7a1d900f9976c54932290e6492402f05@haskell.org> Message-ID: <061.7a500c91e4a52e1d693481c8d91b1d5d@haskell.org> #14677: Code generator does not correctly tag a pointer -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: 14626 Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Could you possibly give the example that goes wrong, in source code, tidy- core, and the wrong Cmm we get? That would be easier to discuss. I can't make sense of your question without a bit more context. Thanks! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 25 17:20:32 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 25 Jan 2018 17:20:32 -0000 Subject: [GHC] #14688: Note [Lone variables] leads to missing a case-of-case opportunity In-Reply-To: <049.49a076b467188eb35828b1dabac9ffe9@haskell.org> References: <049.49a076b467188eb35828b1dabac9ffe9@haskell.org> Message-ID: <064.9e9f683b4c027cb09bbc0a25b834ea0a@haskell.org> #14688: Note [Lone variables] leads to missing a case-of-case opportunity -------------------------------------+------------------------------------- Reporter: mpickering | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Simon Peyton Jones ): In [changeset:"06366890ba77c20198d7fccc870083b0bbfb1b11/ghc" 0636689/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="06366890ba77c20198d7fccc870083b0bbfb1b11" Fix the lone-variable case in callSiteInline See Note [Lone variables] in CoreUnfold and Note [exprIsExpandable] in CoreUtils. Helpfully pointed out by Matthew Pickering in Trac #14688 Nofib results are good: -------------------------------------------------------------------------------- Program Size Allocs Runtime Elapsed TotalMem -------------------------------------------------------------------------------- anna +0.1% +0.3% 0.151 0.151 0.0% awards +0.0% -0.2% 0.001 0.001 0.0% compress2 +0.6% -0.7% -4.8% -5.0% -4.0% eliza +0.0% -2.4% 0.001 0.001 0.0% fulsom +0.4% -13.3% -7.6% -7.6% +190.0% gamteb +0.0% -0.6% 0.062 0.062 0.0% gg +0.1% -0.4% 0.016 0.016 0.0% ida +0.1% +0.3% 0.110 0.110 0.0% kahan +0.0% -0.7% -0.9% -0.9% 0.0% mate +0.1% -5.2% -4.9% -4.9% 0.0% n-body +0.0% -0.2% -0.3% -3.0% 0.0% pretty +0.0% -2.8% 0.000 0.000 0.0% scs +0.0% -0.2% +1.6% +2.4% 0.0% simple +0.4% -0.2% -2.3% -2.3% -3.4% veritas +0.4% -1.0% 0.003 0.003 0.0% wang +0.0% -1.6% 0.165 0.165 0.0% -------------------------------------------------------------------------------- Min -0.0% -13.3% -16.2% -18.8% -4.0% Max +0.6% +0.3% +4.9% +4.9% +190.0% Geometric Mean +0.1% -0.3% -1.7% -2.4% +0.9% }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 25 17:21:17 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 25 Jan 2018 17:21:17 -0000 Subject: [GHC] #14688: Note [Lone variables] leads to missing a case-of-case opportunity In-Reply-To: <049.49a076b467188eb35828b1dabac9ffe9@haskell.org> References: <049.49a076b467188eb35828b1dabac9ffe9@haskell.org> Message-ID: <064.948f7e63df8c539c615c931bf37393ed@haskell.org> #14688: Note [Lone variables] leads to missing a case-of-case opportunity -------------------------------------+------------------------------------- Reporter: mpickering | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * status: new => closed * resolution: => fixed Comment: Thanks Matthew -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 25 17:36:53 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 25 Jan 2018 17:36:53 -0000 Subject: [GHC] #11735: Optimize coercionKind In-Reply-To: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> References: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> Message-ID: <062.341abe415f6f1bfaaf0adc5f2502fa19@haskell.org> #11735: Optimize coercionKind -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.10.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by goldfire): I still say that most uses of `mkNthCo` already know the right role -- though perhaps this role may not be as obvious to someone who isn't me. Just supplying the role would be much better than computing it, of course. I don't agree with Simon's suggestion about `mkNthCoDirect` -- this is a first step toward invariants that are not upheld. Instead, I would have `mkNthCo` require a role and make a new `mkNthCoNoRole` that computes it. The naming of the functions should discourage the use of the second. The Note explaining why I originally bundled `coercionKind` and `coercionRole` points to a test case. Does that give a concrete testing ground? You might also look in the git history around that note to see if that gives you any pointers. Agreed about not cluttering `IfaceCoercion`. And, yes, I will take a look at `simplCast` tomorrow. (Though it's deeply scary when Simon says "My brain melted" and then asks me to take a look!) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 25 17:39:26 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 25 Jan 2018 17:39:26 -0000 Subject: [GHC] #11735: Optimize coercionKind In-Reply-To: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> References: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> Message-ID: <062.c8dd34054cc911ead10eb43454c8c679@haskell.org> #11735: Optimize coercionKind -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.10.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by goldfire): By the way, if @tdammers can make the patch available (on GitHub, say), I could look into patching the patch. That might be easier. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 25 17:43:19 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 25 Jan 2018 17:43:19 -0000 Subject: [GHC] #11735: Optimize coercionKind In-Reply-To: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> References: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> Message-ID: <062.aa436bfd77dd63691a1079e3ca232c2d@haskell.org> #11735: Optimize coercionKind -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.10.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): > Instead, I would have mkNthCo require a role and make a new mkNthCoNoRole that computes it. Yes, but then `mkNthCo` relies on the caller to guarantee the invariant. That's fine; Lint will check. That's all I meant `mkNthCoDirect` to do. But I'm not fussy about naming, so long as the comments are clear. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 25 18:02:14 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 25 Jan 2018 18:02:14 -0000 Subject: [GHC] #14644: Improve cmm/assembly for pattern matches with two constants. In-Reply-To: <047.054a8f1d3e52c239a87742662b91a120@haskell.org> References: <047.054a8f1d3e52c239a87742662b91a120@haskell.org> Message-ID: <062.18e38e417c07e67cd08f7122680fafda@haskell.org> #14644: Improve cmm/assembly for pattern matches with two constants. -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: AndreasK Type: task | Status: patch Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 (CodeGen) | Keywords: Codegen, CMM, Resolution: | Patterns, Pattern Matching Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4294 Wiki Page: | -------------------------------------+------------------------------------- Comment (by AndreasK): Replying to [comment:13 simonpj]: > Are we good to go on this? I.e. commit? From my side the patch is good to go as it is. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 25 19:53:23 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 25 Jan 2018 19:53:23 -0000 Subject: [GHC] #14718: Add Boolean type families to 'base' package In-Reply-To: <047.060f2285544130e30b97a1cdd131ee48@haskell.org> References: <047.060f2285544130e30b97a1cdd131ee48@haskell.org> Message-ID: <062.ac04261a69c616b04bdad9c23ddece70@haskell.org> #14718: Add Boolean type families to 'base' package -------------------------------------+------------------------------------- Reporter: chshersh | Owner: (none) Type: feature request | Status: closed Priority: normal | Milestone: Component: Core Libraries | Version: 8.5 Resolution: invalid | Keywords: base, type | families, Bool Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by chshersh): Wow, somehow I missed this. Thanks! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 25 20:11:54 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 25 Jan 2018 20:11:54 -0000 Subject: [GHC] #11735: Optimize coercionKind In-Reply-To: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> References: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> Message-ID: <062.a7d31a0ab51a88559663bae69be49f7d@haskell.org> #11735: Optimize coercionKind -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.10.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by tdammers): Replying to [comment:29 goldfire]: > I still say that most uses of `mkNthCo` already know the right role -- though perhaps this role may not be as obvious to someone who isn't me. Just supplying the role would be much better than computing it, of course. It is indeed a bit less obvious to me; I have found a few places (2 or 3 I think) where we have a role ready that could be a candidate, but not being sure whether it would be the right thing, I opted for the conservative option. > I don't agree with Simon's suggestion about `mkNthCoDirect` -- this is a first step toward invariants that are not upheld. Instead, I would have `mkNthCo` require a role and make a new `mkNthCoNoRole` that computes it. The naming of the functions should discourage the use of the second. I have absolutely no opinion on this one; happy to implement it either way. > The Note explaining why I originally bundled `coercionKind` and `coercionRole` points to a test case. Does that give a concrete testing ground? You might also look in the git history around that note to see if that gives you any pointers. OK, will take a look. > Agreed about not cluttering `IfaceCoercion`. Yes, makes total sense. Undoing as we speak. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 25 20:12:44 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 25 Jan 2018 20:12:44 -0000 Subject: [GHC] #11735: Optimize coercionKind In-Reply-To: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> References: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> Message-ID: <062.900a74a9a19719c4ab07d40a531b7385@haskell.org> #11735: Optimize coercionKind -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.10.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by tdammers): Replying to [comment:30 goldfire]: > By the way, if @tdammers can make the patch available (on GitHub, say), I could look into patching the patch. That might be easier. Will do ASAP. I made a bit of a mess with git, but once that's cleaned up I'll upload somewhere (phab?) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 25 20:16:04 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 25 Jan 2018 20:16:04 -0000 Subject: [GHC] #14673: Unary Unboxed Tuple Type Constructor In-Reply-To: <049.d9c870f0c2ef1490b284fbb19f566786@haskell.org> References: <049.d9c870f0c2ef1490b284fbb19f566786@haskell.org> Message-ID: <064.88d7cb94f8e78eff420f9544615990f1@haskell.org> #14673: Unary Unboxed Tuple Type Constructor -------------------------------------+------------------------------------- Reporter: andrewthad | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.4.1-alpha1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by carter): this would be for the term constructors, not the type constructors, right? or vice versa? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 25 20:18:26 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 25 Jan 2018 20:18:26 -0000 Subject: [GHC] #11735: Optimize coercionKind In-Reply-To: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> References: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> Message-ID: <062.2103235a4b9960b75935fd41d81a2de2@haskell.org> #11735: Optimize coercionKind -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.10.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by tdammers): Here's what I have so far: [https://github.com/ghc/ghc/tree/wip/tdammers/T11735] -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 25 20:50:34 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 25 Jan 2018 20:50:34 -0000 Subject: [GHC] #11735: Optimize coercionKind In-Reply-To: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> References: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> Message-ID: <062.9732167c1316ac81025af796413ad19a@haskell.org> #11735: Optimize coercionKind -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.10.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by goldfire): I have a lingering concern: ''why'' did the old `coercionKindRole` perform so miserably? In a call to `coercionRole`, the kind calculations should never be forced. So what takes up all the memory? Is it really just the tuples? If so, then we've discovered a major way to speed up other areas of GHC: convert tuples to be unboxed. Even better, we've discovered a major missing optimization, which could probably automate the unboxing somehow. So I wonder if there are more opportunities here. None of this changes the current direction of travel (caching is a good idea, regardless of my question here), but perhaps suggests another future line of inquiry. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 25 20:51:27 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 25 Jan 2018 20:51:27 -0000 Subject: [GHC] #14720: GHC 8.4.1-alpha regression with TypeInType Message-ID: <050.3979775ac8fffda86c79c2a678f92178@haskell.org> #14720: GHC 8.4.1-alpha regression with TypeInType -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: high | Milestone: 8.4.1 Component: Compiler | Version: 8.4.1-alpha1 (Type checker) | Keywords: TypeInType | Operating System: Unknown/Multiple Architecture: | Type of failure: GHC rejects Unknown/Multiple | valid program Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- GHC 8.2.2 is able to typecheck this code: {{{#!hs {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeInType #-} {-# LANGUAGE TypeOperators #-} module SGenerics where import Data.Kind (Type) import Data.Type.Equality ((:~:)(..), sym, trans) import Data.Void data family Sing (z :: k) class Generic (a :: Type) where type Rep a :: Type from :: a -> Rep a to :: Rep a -> a class PGeneric (a :: Type) where type PFrom (x :: a) :: Rep a type PTo (x :: Rep a) :: a class SGeneric k where sFrom :: forall (a :: k). Sing a -> Sing (PFrom a) sTo :: forall (a :: Rep k). Sing a -> Sing (PTo a :: k) class (PGeneric k, SGeneric k) => VGeneric k where sTof :: forall (a :: k). Sing a -> PTo (PFrom a) :~: a sFot :: forall (a :: Rep k). Sing a -> PFrom (PTo a :: k) :~: a data Decision a = Proved a | Disproved (a -> Void) class SDecide k where (%~) :: forall (a :: k) (b :: k). Sing a -> Sing b -> Decision (a :~: b) default (%~) :: forall (a :: k) (b :: k). (VGeneric k, SDecide (Rep k)) => Sing a -> Sing b -> Decision (a :~: b) s1 %~ s2 = case sFrom s1 %~ sFrom s2 of Proved (Refl :: PFrom a :~: PFrom b) -> case (sTof s1, sTof s2) of (Refl, Refl) -> Proved Refl Disproved contra -> Disproved (\Refl -> contra Refl) }}} But GHC 8.4.1-alpha2 cannot: {{{ $ /opt/ghc/8.4.1/bin/ghc Bug.hs [1 of 1] Compiling SGenerics ( Bug.hs, Bug.o ) Bug.hs:44:52: error: • Could not deduce: PFrom a ~ PFrom a from the context: b ~ a bound by a pattern with constructor: Refl :: forall k (a :: k). a :~: a, in a lambda abstraction at Bug.hs:44:37-40 Expected type: PFrom a :~: PFrom b Actual type: PFrom a :~: PFrom a NB: ‘PFrom’ is a non-injective type family • In the first argument of ‘contra’, namely ‘Refl’ In the expression: contra Refl In the first argument of ‘Disproved’, namely ‘(\ Refl -> contra Refl)’ • Relevant bindings include contra :: (PFrom a :~: PFrom b) -> Void (bound at Bug.hs:44:15) s2 :: Sing b (bound at Bug.hs:40:9) s1 :: Sing a (bound at Bug.hs:40:3) (%~) :: Sing a -> Sing b -> Decision (a :~: b) (bound at Bug.hs:40:3) | 44 | Disproved contra -> Disproved (\Refl -> contra Refl) | ^^^^ }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 25 20:57:52 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 25 Jan 2018 20:57:52 -0000 Subject: [GHC] #11735: Optimize coercionKind In-Reply-To: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> References: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> Message-ID: <062.c73844ac58806ebb104943be126871fe@haskell.org> #11735: Optimize coercionKind -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.10.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): The GHC branch is `wip/tdammers/T11735` -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 25 21:37:29 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 25 Jan 2018 21:37:29 -0000 Subject: [GHC] #14669: Windows binaries sometimes throw a stack overflow. In-Reply-To: <044.45c88c9a13190d9f2a70cd9b35309cc0@haskell.org> References: <044.45c88c9a13190d9f2a70cd9b35309cc0@haskell.org> Message-ID: <059.30ae3d28e081593ba4e3d90dd466e612@haskell.org> #14669: Windows binaries sometimes throw a stack overflow. -------------------------------------+------------------------------------- Reporter: sergv | Owner: (none) Type: bug | Status: patch Priority: highest | Milestone: 8.4.1 Component: Runtime System | Version: 8.2.1 Resolution: | Keywords: Operating System: Windows | Architecture: | Unknown/Multiple Type of failure: Runtime crash | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4343 Wiki Page: | -------------------------------------+------------------------------------- Comment (by Phyx-): @serv thanks for the help and testing. I'll make sure it gets into 8.4. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 25 21:49:56 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 25 Jan 2018 21:49:56 -0000 Subject: [GHC] #14669: Windows binaries sometimes throw a stack overflow. In-Reply-To: <044.45c88c9a13190d9f2a70cd9b35309cc0@haskell.org> References: <044.45c88c9a13190d9f2a70cd9b35309cc0@haskell.org> Message-ID: <059.409cfae7c2a8e6e8a43b65ac58aa4c34@haskell.org> #14669: Windows binaries sometimes throw a stack overflow. -------------------------------------+------------------------------------- Reporter: sergv | Owner: (none) Type: bug | Status: patch Priority: highest | Milestone: 8.4.1 Component: Runtime System | Version: 8.2.1 Resolution: | Keywords: Operating System: Windows | Architecture: | Unknown/Multiple Type of failure: Runtime crash | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4343 Wiki Page: | -------------------------------------+------------------------------------- Comment (by sergv): @Phyx- Thanks for your help! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 25 22:18:26 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 25 Jan 2018 22:18:26 -0000 Subject: [GHC] #14721: internal error: stg_ap_v_ret Message-ID: <044.3a95bcd3b46d861070d4456f7d37cbec@haskell.org> #14721: internal error: stg_ap_v_ret --------------------------------------+--------------------------------- Reporter: jdm12 | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.0.2 Keywords: | Operating System: Linux Architecture: x86_64 (amd64) | Type of failure: None/Unknown Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: --------------------------------------+--------------------------------- I got the following message when trying to inspect an unboxed vector: : internal error: stg_ap_v_ret (GHC version 8.0.2 for x86_64_unknown_linux) Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug Aborted (core dumped) ... so here I am, following instructions :) I'm running Kubuntu Zesty (4.13.0-25-generic) in a VirtualBox vm on a Win10 host. I don't know what other info will help, but I'll save the code as it stands and provide details on request. If the core dump will be useful, I'm happy to provide, but will need help finding it. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 25 23:00:59 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 25 Jan 2018 23:00:59 -0000 Subject: [GHC] #14721: internal error: stg_ap_v_ret In-Reply-To: <044.3a95bcd3b46d861070d4456f7d37cbec@haskell.org> References: <044.3a95bcd3b46d861070d4456f7d37cbec@haskell.org> Message-ID: <059.1569cf41e7a8d35d783c819ab9225f30@haskell.org> #14721: internal error: stg_ap_v_ret ---------------------------------+-------------------------------------- Reporter: jdm12 | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: Component: Compiler | Version: 8.0.2 Resolution: invalid | Keywords: Operating System: Linux | Architecture: x86_64 (amd64) Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | ---------------------------------+-------------------------------------- Changes (by jdm12): * status: new => closed * resolution: => invalid Comment: I subsequently got some faulty behaviour from my vm. On rebooting, I'm unable to reproduce the bug. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Jan 25 23:37:11 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 25 Jan 2018 23:37:11 -0000 Subject: [GHC] #14720: GHC 8.4.1-alpha regression with TypeInType In-Reply-To: <050.3979775ac8fffda86c79c2a678f92178@haskell.org> References: <050.3979775ac8fffda86c79c2a678f92178@haskell.org> Message-ID: <065.c4dc316c1ec9f565adb6d7549a8bbc3b@haskell.org> #14720: GHC 8.4.1-alpha regression with TypeInType -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: high | Milestone: 8.4.1 Component: Compiler (Type | Version: 8.4.1-alpha1 checker) | Resolution: | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: Type of failure: GHC rejects | Unknown/Multiple valid program | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * cc: goldfire (added) Comment: This regression was introduced in commit 8e15e3d370e9c253ae0dbb330e25b72cb00cdb76 (`Improve error messages around kind mismatches.`). I'm unsure if this is related to #14038 (which was also triggered by the same commit). -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 26 00:01:58 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 26 Jan 2018 00:01:58 -0000 Subject: [GHC] #13352: Strange requirement for re-exported duplicate record fields In-Reply-To: <047.ff8942cd67c302be28d2cd71e3d50d5d@haskell.org> References: <047.ff8942cd67c302be28d2cd71e3d50d5d@haskell.org> Message-ID: <062.f56e2354b70e34f3826d80b7fdaff636@haskell.org> #13352: Strange requirement for re-exported duplicate record fields -------------------------------------+------------------------------------- Reporter: crockeea | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.0.2 Resolution: | Keywords: orf Operating System: Unknown/Multiple | Architecture: Type of failure: GHC rejects | Unknown/Multiple valid program | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by tejon): I've just run into this as well, with the additional observation that if module C ''re-exports'' modules A and B, then C must also have `DuplicateRecordFields`. (Of course, C needing it is the immediate intuition anyway; but it's not always true that it's only needed at (n-1 of) the definition points. This is just a slightly annoying curiosity when one controls all the relevant modules, but it seems like it shuts down the extension completely if one is working with external modules that don't have `DuplicateRecordFields` enabled (because why should they, internally there are none). -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 26 02:18:18 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 26 Jan 2018 02:18:18 -0000 Subject: [GHC] #14722: Error message points to wrong location Message-ID: <051.c333e5a6f35eca7f4991a44f21fca447@haskell.org> #14722: Error message points to wrong location -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: feature | Status: new request | Priority: normal | Milestone: Component: Compiler | Version: 8.5 Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: Incorrect Unknown/Multiple | error/warning at compile-time Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- This rightly fails, but I have an issue with the error message. I think points to the visible type application eagerly.. rather than the type annotation `(f_xx :: ())`. {{{#!hs {-# Language RankNTypes, PolyKinds, GADTs, TypeApplications, ScopedTypeVariables #-} import Data.Kind newtype Limit :: (k -> Type) -> Type where Limit :: (forall xx. f xx) -> Limit f foo :: forall f a. Limit f -> f a foo (Limit (f_xx :: ())) = f_xx @a }}} gives {{{ $ ghci -ignore-dot-ghci /tmp/Test.hs GHCi, version 8.5.20180105: http://www.haskell.org/ghc/ :? for help [1 of 1] Compiling Main ( /tmp/Test.hs, interpreted ) /tmp/Test.hs:9:28: error: • Cannot apply expression of type ‘()’ to a visible type argument ‘a’ • In the expression: f_xx @a In an equation for ‘foo’: foo (Limit (f_xx :: ())) = f_xx @a | 9 | foo (Limit (f_xx :: ())) = f_xx @a | ^^^^^^^ Failed, no modules loaded. Prelude> }}} I would have expected: {{{ /tmp/Test.hs:9:13: error: • Couldn't match expected type ‘()’ with actual type ‘f xx0’ • When checking that the pattern signature: () fits the type of its context: forall (xx :: k1). f xx In the pattern: f_xx :: () In the pattern: Limit (f_xx :: ()) • Relevant bindings include foo :: Limit f -> f a (bound at /tmp/Test.hs:9:1) }}} Thoughts -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 26 02:28:59 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 26 Jan 2018 02:28:59 -0000 Subject: [GHC] #14712: After git pull make can't work without make clean In-Reply-To: <044.d514c6189e84996f2384ead348b0422a@haskell.org> References: <044.d514c6189e84996f2384ead348b0422a@haskell.org> Message-ID: <059.0795ae49740fc2b21ca7a53982d26066@haskell.org> #14712: After git pull make can't work without make clean -------------------------------------+------------------------------------- Reporter: jiamo | Owner: (none) Type: feature request | Status: new Priority: low | Milestone: Component: Build System | Version: 8.5 Resolution: | Keywords: Operating System: MacOS X | Architecture: x86_64 Type of failure: Building GHC | (amd64) failed | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * type: bug => feature request Comment: Indeed Hadrian may be a bit better in this regard although I don't believe it's much different at the moment. Ultimately we will need to do something like https://github.com/snowleopard/hadrian/issues/416 to improve things significantly. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 26 02:36:20 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 26 Jan 2018 02:36:20 -0000 Subject: [GHC] #14723: GHC 8.4.1-alpha loops infinitely when typechecking Message-ID: <050.41938dfcc2cea4d35c5568a864ac48d8@haskell.org> #14723: GHC 8.4.1-alpha loops infinitely when typechecking -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.4.1 Component: Compiler | Version: 8.4.1-alpha1 (Type checker) | Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: Compile-time Unknown/Multiple | performance bug Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- This issue prevents `jvm-streaming` from compiling with GHC 8.4.1-alpha2. Here is my best attempt at minimizing the issue: {{{#!hs {-# LANGUAGE DataKinds #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} module Bug () where import Data.Kind (Type) import Data.Proxy (Proxy(..)) import Data.String (fromString) import Data.Int (Int64) import GHC.Stack (HasCallStack) import GHC.TypeLits (Nat, Symbol) data JType = Iface Symbol data J (a :: JType) newIterator :: IO (J ('Iface "java.util.Iterator")) newIterator = do let tblPtr :: Int64 tblPtr = undefined iterator <- (loadJavaWrappers >> (((((((qqMarker (Proxy :: Proxy "{ return new java.util.Iterator() {\n @Override\n public native boolean hasNext();\n\n @Override\n public native Object next();\n\n @Override\n public void remove() {\n throw new UnsupportedOperationException();\n }\n\n private native v oid hsFinalize(long tblPtr);\n\n @Override\n public void finalize() {\n hsFinalize($tblPtr);\n }\n } ; }")) (Proxy :: Proxy "inline__method_0")) (Proxy :: Proxy "tblPtr")) (Proxy :: Proxy 106)) (tblPtr, ())) Proxy) (((callStatic (fromString "io.tweag.inlinejava.Inline__jvmstreaming022inplace_Language_Java_Streaming")) (fromString "inline__method_0")) [coerce tblPtr]))) undefined class Coercible (a :: Type) where type Ty a :: JType class Coercibles xs (tys :: k) | xs -> tys instance Coercibles () () instance (ty ~ Ty x, Coercible x, Coercibles xs tys) => Coercibles (x, xs) '(ty, tys) qqMarker :: forall -- k -- the kind variable shows up in Core (args_tys :: k) -- JType's of arguments tyres -- JType of result (input :: Symbol) -- input string of the quasiquoter (mname :: Symbol) -- name of the method to generate (antiqs :: Symbol) -- antiquoted variables as a comma-separated list (line :: Nat) -- line number of the quasiquotation args_tuple -- uncoerced argument types b. -- uncoerced result type (tyres ~ Ty b, Coercibles args_tuple args_tys, Coercible b, HasCallStack) => Proxy input -> Proxy mname -> Proxy antiqs -> Proxy line -> args_tuple -> Proxy args_tys -> IO b -> IO b qqMarker = undefined }}} With GHC 8.2.2, this is properly rejected by the typechecker: {{{ $ /opt/ghc/8.2.2/bin/ghc Bug.hs [1 of 1] Compiling Bug ( Bug.hs, Bug.o ) Bug.hs:27:12: error: Variable not in scope: loadJavaWrappers :: IO a0 | 27 | (loadJavaWrappers >> | ^^^^^^^^^^^^^^^^ Bug.hs:36:16: error: Variable not in scope: callStatic :: t0 -> t1 -> [a2] -> IO a1 | 36 | (((callStatic | ^^^^^^^^^^ Bug.hs:40:17: error: Variable not in scope: coerce :: Int64 -> a2 | 40 | [coerce tblPtr]))) | ^^^^^^ }}} But in GHC 8.4.1-alpha2, this simply hangs forever. To make things more interesting, if you pass `-ddump-tc-trace` when compiling, you'll get a panic: {{{ $ /opt/ghc/8.4.1/bin/ghc Bug.hs -ddump-tc-trace ... kcLHsQTyVars: cusk JType [] [] [] [] * [] [] [] [] kcTyClGroup: initial kinds [rB8 :-> ATcTyCon JType :: *, rB9 :-> APromotionErr RecDataConPE] txExtendKindEnv [rB8 :-> ATcTyCon JType :: *, rB9 :-> APromotionErr RecDataConPE] kcTyClDecl { JType env2 [] tcExtendBinderStack [] env2 [] tcExtendBinderStack [] lk1 Symbol tcTyVar2a Symbol * u_tys tclvl 1 * ~ TYPE t_a1qq[tau:1] arising from a type equality * ~ TYPE t_a1qq[tau:1] u_tys tclvl 1 'GHC.Types.LiftedRep ~ t_a1qq[tau:1] arising from a type equality * ~ TYPE t_a1qq[tau:1] u_tys tclvl 1 GHC.Types.RuntimeRep ~ GHC.Types.RuntimeRep arising from a kind equality arising from t_a1qq[tau:1] ~ 'GHC.Types.LiftedRep u_tys yields no coercion writeMetaTyVar t_a1qq[tau:1] :: GHC.Types.RuntimeRep := 'GHC.Types.LiftedRep u_tys yields no coercion u_tys yields no coercion checkExpectedKind * TYPE t_a1qq[tau:1] <*>_N kcLHsQTyVars: not-cuskghc: panic! (the 'impossible' happened) (GHC version 8.4.0.20180118 for x86_64-unknown-linux): kcConDecl }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 26 02:39:23 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 26 Jan 2018 02:39:23 -0000 Subject: [GHC] #14723: GHC 8.4.1-alpha loops infinitely when typechecking In-Reply-To: <050.41938dfcc2cea4d35c5568a864ac48d8@haskell.org> References: <050.41938dfcc2cea4d35c5568a864ac48d8@haskell.org> Message-ID: <065.47e77183bfb09c37e85789993151e9d0@haskell.org> #14723: GHC 8.4.1-alpha loops infinitely when typechecking -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.4.1 Component: Compiler (Type | Version: 8.4.1-alpha1 checker) | Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Description changed by RyanGlScott: Old description: > This issue prevents `jvm-streaming` from compiling with GHC 8.4.1-alpha2. > Here is my best attempt at minimizing the issue: > > {{{#!hs > {-# LANGUAGE DataKinds #-} > {-# LANGUAGE FunctionalDependencies #-} > {-# LANGUAGE KindSignatures #-} > {-# LANGUAGE PolyKinds #-} > {-# LANGUAGE RankNTypes #-} > {-# LANGUAGE TypeFamilies #-} > {-# LANGUAGE UndecidableInstances #-} > module Bug () where > > import Data.Kind (Type) > import Data.Proxy (Proxy(..)) > import Data.String (fromString) > import Data.Int (Int64) > import GHC.Stack (HasCallStack) > import GHC.TypeLits (Nat, Symbol) > > data JType = Iface Symbol > > data J (a :: JType) > > newIterator > :: IO (J ('Iface "java.util.Iterator")) > newIterator = do > let tblPtr :: Int64 > tblPtr = undefined > iterator <- > (loadJavaWrappers >> > (((((((qqMarker > (Proxy :: > Proxy "{ return new java.util.Iterator() {\n > @Override\n public native boolean hasNext();\n\n > @Override\n public native > Object next();\n\n @Override\n public void > remove() {\n throw new > UnsupportedOperationException();\n }\n\n > private native v > oid hsFinalize(long tblPtr);\n\n @Override\n > public void finalize() {\n hsFinalize($tblPtr);\n > }\n } ; }")) > (Proxy :: Proxy "inline__method_0")) > (Proxy :: Proxy "tblPtr")) > (Proxy :: Proxy 106)) > (tblPtr, ())) > Proxy) > (((callStatic > (fromString > "io.tweag.inlinejava.Inline__jvmstreaming022inplace_Language_Java_Streaming")) > (fromString "inline__method_0")) > [coerce tblPtr]))) > undefined > > class Coercible (a :: Type) where > type Ty a :: JType > > class Coercibles xs (tys :: k) | xs -> tys > instance Coercibles () () > instance (ty ~ Ty x, Coercible x, Coercibles xs tys) => Coercibles (x, > xs) '(ty, tys) > > qqMarker > :: forall > -- k -- the kind variable shows up in Core > (args_tys :: k) -- JType's of arguments > tyres -- JType of result > (input :: Symbol) -- input string of the quasiquoter > (mname :: Symbol) -- name of the method to generate > (antiqs :: Symbol) -- antiquoted variables as a comma-separated > list > (line :: Nat) -- line number of the quasiquotation > args_tuple -- uncoerced argument types > b. -- uncoerced result type > (tyres ~ Ty b, Coercibles args_tuple args_tys, Coercible b, > HasCallStack) > => Proxy input > -> Proxy mname > -> Proxy antiqs > -> Proxy line > -> args_tuple > -> Proxy args_tys > -> IO b > -> IO b > qqMarker = undefined > }}} > > With GHC 8.2.2, this is properly rejected by the typechecker: > > {{{ > $ /opt/ghc/8.2.2/bin/ghc Bug.hs > [1 of 1] Compiling Bug ( Bug.hs, Bug.o ) > > Bug.hs:27:12: error: > Variable not in scope: loadJavaWrappers :: IO a0 > | > 27 | (loadJavaWrappers >> > | ^^^^^^^^^^^^^^^^ > > Bug.hs:36:16: error: > Variable not in scope: callStatic :: t0 -> t1 -> [a2] -> IO a1 > | > 36 | (((callStatic > | ^^^^^^^^^^ > > Bug.hs:40:17: error: Variable not in scope: coerce :: Int64 -> a2 > | > 40 | [coerce tblPtr]))) > | ^^^^^^ > }}} > > But in GHC 8.4.1-alpha2, this simply hangs forever. > > To make things more interesting, if you pass `-ddump-tc-trace` when > compiling, you'll get a panic: > > {{{ > $ /opt/ghc/8.4.1/bin/ghc Bug.hs -ddump-tc-trace > ... > kcLHsQTyVars: cusk > JType > [] > [] > [] > [] > * > [] > [] > [] > [] > kcTyClGroup: initial kinds > [rB8 :-> ATcTyCon JType :: *, rB9 :-> APromotionErr RecDataConPE] > txExtendKindEnv > [rB8 :-> ATcTyCon JType :: *, rB9 :-> APromotionErr RecDataConPE] > kcTyClDecl { JType > env2 [] > tcExtendBinderStack [] > env2 [] > tcExtendBinderStack [] > lk1 Symbol > tcTyVar2a > Symbol > * > u_tys > tclvl 1 > * ~ TYPE t_a1qq[tau:1] > arising from a type equality * ~ TYPE t_a1qq[tau:1] > u_tys > tclvl 1 > 'GHC.Types.LiftedRep ~ t_a1qq[tau:1] > arising from a type equality * ~ TYPE t_a1qq[tau:1] > u_tys > tclvl 1 > GHC.Types.RuntimeRep ~ GHC.Types.RuntimeRep > arising from a kind equality arising from > t_a1qq[tau:1] ~ 'GHC.Types.LiftedRep > u_tys yields no coercion > writeMetaTyVar > t_a1qq[tau:1] :: GHC.Types.RuntimeRep := 'GHC.Types.LiftedRep > u_tys yields no coercion > u_tys yields no coercion > checkExpectedKind > * > TYPE t_a1qq[tau:1] > <*>_N > kcLHsQTyVars: not-cuskghc: panic! (the 'impossible' happened) > (GHC version 8.4.0.20180118 for x86_64-unknown-linux): > kcConDecl > }}} New description: This issue prevents `jvm-streaming` from compiling with GHC 8.4.1-alpha2. Here is my best attempt at minimizing the issue: {{{#!hs {-# LANGUAGE DataKinds #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} module Bug () where import Data.Kind (Type) import Data.Proxy (Proxy(..)) import Data.String (fromString) import Data.Int (Int64) import GHC.Stack (HasCallStack) import GHC.TypeLits (Nat, Symbol) data JType = Iface Symbol data J (a :: JType) newIterator :: IO (J ('Iface "java.util.Iterator")) newIterator = do let tblPtr :: Int64 tblPtr = undefined iterator <- (loadJavaWrappers >> (((((((qqMarker (Proxy :: Proxy "{ return new java.util.Iterator() {\n @Override\n public native boolean hasNext();\n\n @Override\n public native Object next();\n\n @Override\n public void remove() {\n throw new UnsupportedOperationException();\n }\n\n private native void hsFinalize(long tblPtr);\n\n @Override\n public void finalize() {\n hsFinalize($tblPtr);\n }\n } ; }")) (Proxy :: Proxy "inline__method_0")) (Proxy :: Proxy "tblPtr")) (Proxy :: Proxy 106)) (tblPtr, ())) Proxy) (((callStatic (fromString "io.tweag.inlinejava.Inline__jvmstreaming022inplace_Language_Java_Streaming")) (fromString "inline__method_0")) [coerce tblPtr]))) undefined class Coercible (a :: Type) where type Ty a :: JType class Coercibles xs (tys :: k) | xs -> tys instance Coercibles () () instance (ty ~ Ty x, Coercible x, Coercibles xs tys) => Coercibles (x, xs) '(ty, tys) qqMarker :: forall -- k -- the kind variable shows up in Core (args_tys :: k) -- JType's of arguments tyres -- JType of result (input :: Symbol) -- input string of the quasiquoter (mname :: Symbol) -- name of the method to generate (antiqs :: Symbol) -- antiquoted variables as a comma-separated list (line :: Nat) -- line number of the quasiquotation args_tuple -- uncoerced argument types b. -- uncoerced result type (tyres ~ Ty b, Coercibles args_tuple args_tys, Coercible b, HasCallStack) => Proxy input -> Proxy mname -> Proxy antiqs -> Proxy line -> args_tuple -> Proxy args_tys -> IO b -> IO b qqMarker = undefined }}} With GHC 8.2.2, this is properly rejected by the typechecker: {{{ $ /opt/ghc/8.2.2/bin/ghc Bug.hs [1 of 1] Compiling Bug ( Bug.hs, Bug.o ) Bug.hs:27:12: error: Variable not in scope: loadJavaWrappers :: IO a0 | 27 | (loadJavaWrappers >> | ^^^^^^^^^^^^^^^^ Bug.hs:36:16: error: Variable not in scope: callStatic :: t0 -> t1 -> [a2] -> IO a1 | 36 | (((callStatic | ^^^^^^^^^^ Bug.hs:40:17: error: Variable not in scope: coerce :: Int64 -> a2 | 40 | [coerce tblPtr]))) | ^^^^^^ }}} But in GHC 8.4.1-alpha2, this simply hangs forever. To make things more interesting, if you pass `-ddump-tc-trace` when compiling, you'll get a panic: {{{ $ /opt/ghc/8.4.1/bin/ghc Bug.hs -ddump-tc-trace ... kcLHsQTyVars: cusk JType [] [] [] [] * [] [] [] [] kcTyClGroup: initial kinds [rB8 :-> ATcTyCon JType :: *, rB9 :-> APromotionErr RecDataConPE] txExtendKindEnv [rB8 :-> ATcTyCon JType :: *, rB9 :-> APromotionErr RecDataConPE] kcTyClDecl { JType env2 [] tcExtendBinderStack [] env2 [] tcExtendBinderStack [] lk1 Symbol tcTyVar2a Symbol * u_tys tclvl 1 * ~ TYPE t_a1qq[tau:1] arising from a type equality * ~ TYPE t_a1qq[tau:1] u_tys tclvl 1 'GHC.Types.LiftedRep ~ t_a1qq[tau:1] arising from a type equality * ~ TYPE t_a1qq[tau:1] u_tys tclvl 1 GHC.Types.RuntimeRep ~ GHC.Types.RuntimeRep arising from a kind equality arising from t_a1qq[tau:1] ~ 'GHC.Types.LiftedRep u_tys yields no coercion writeMetaTyVar t_a1qq[tau:1] :: GHC.Types.RuntimeRep := 'GHC.Types.LiftedRep u_tys yields no coercion u_tys yields no coercion checkExpectedKind * TYPE t_a1qq[tau:1] <*>_N kcLHsQTyVars: not-cuskghc: panic! (the 'impossible' happened) (GHC version 8.4.0.20180118 for x86_64-unknown-linux): kcConDecl }}} -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 26 02:49:21 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 26 Jan 2018 02:49:21 -0000 Subject: [GHC] #14723: GHC 8.4.1-alpha loops infinitely when typechecking In-Reply-To: <050.41938dfcc2cea4d35c5568a864ac48d8@haskell.org> References: <050.41938dfcc2cea4d35c5568a864ac48d8@haskell.org> Message-ID: <065.cbe5eacace19f470669b0b96ddfe5fd5@haskell.org> #14723: GHC 8.4.1-alpha loops infinitely when typechecking -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.4.1 Component: Compiler (Type | Version: 8.4.1-alpha1 checker) | Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): Wow! This regression was //also// triggered by commit 8e15e3d370e9c253ae0dbb330e25b72cb00cdb76 (`Improve error messages around kind mismatches.`), putting it in good company with #14038 and #14720. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 26 02:52:08 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 26 Jan 2018 02:52:08 -0000 Subject: [GHC] #14723: GHC 8.4.1-alpha loops infinitely when typechecking In-Reply-To: <050.41938dfcc2cea4d35c5568a864ac48d8@haskell.org> References: <050.41938dfcc2cea4d35c5568a864ac48d8@haskell.org> Message-ID: <065.3241fabbb1bba33c0f5c12eede8ae704@haskell.org> #14723: GHC 8.4.1-alpha loops infinitely when typechecking -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.4.1 Component: Compiler (Type | Version: 8.4.1-alpha1 checker) | Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * cc: goldfire (added) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 26 07:04:52 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 26 Jan 2018 07:04:52 -0000 Subject: [GHC] #14677: Code generator does not correctly tag a pointer In-Reply-To: <046.7a1d900f9976c54932290e6492402f05@haskell.org> References: <046.7a1d900f9976c54932290e6492402f05@haskell.org> Message-ID: <061.30795de18463c2a38f7e81b4871c6299@haskell.org> #14677: Code generator does not correctly tag a pointer -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: 14626 Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by alexbiehl): Gabor, I have reduced your example down to {{{ module Main where import GHC.Event import Prelude hiding (mod) f e2 = do print e2 print (e2 == evtRead) main = f evtWrite }}} Expected output {{{ [evtWrite] False }}} With Gabors branch we get {{{ [evtRead] False }}} I compared CMM from a stock ghc-8.4 alpha vs. a GHC built from your branch. Really the only significant difference in CMM is (GHC from your branch) {{{ ... R2 = PicBaseReg + (GHC.Event.Internal.evtWrite_closure+1); call Main.f1_info(R2) args: 8, res: 0, upd: 8; ... }}} (Stock ghc-8.4 alpha) {{{ ... R2 = PicBaseReg + GHC.Event.Internal.evtWrite_closure; call Main.f1_info(R2) args: 8, res: 0, upd: 8; ... -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 26 08:18:38 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 26 Jan 2018 08:18:38 -0000 Subject: [GHC] #11735: Optimize coercionKind In-Reply-To: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> References: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> Message-ID: <062.3daeb1f309390e9cbfaa78ad3c9fded7@haskell.org> #11735: Optimize coercionKind -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.10.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by tdammers): Replying to [comment:35 goldfire]: > I have a lingering concern: ''why'' did the old `coercionKindRole` perform so miserably? In a call to `coercionRole`, the kind calculations should never be forced. So what takes up all the memory? Is it really just the tuples? If so, then we've discovered a major way to speed up other areas of GHC: convert tuples to be unboxed. Even better, we've discovered a major missing optimization, which could probably automate the unboxing somehow. I think the hypothesis was something like this: Suppose we have a deeply nested `NthCo`, and we want to calculate its coercionKind. In order to do that, we need its coercionRole, which involves recursing through the whole thing (O(n)), but once we have that result, we only use it to decide whether we need to keep recursing, and then throw it away. And then in the next step, we calculate the coercionRole again. So the whole thing ends up as O(n²). Whereas if we cache the roles throughout, we only ever calculate each of them once, at construction time, so we never get the quadratic badness. So it's not that the role calculation forces the kind calculation, but the other way around - in order to calculate the correct kind for an NthCo, we need to know its role, but potentially also the roles of all of its children. So in a way, the caching serves as memoization. > So I wonder if there are more opportunities here. None of this changes the current direction of travel (caching is a good idea, regardless of my question here), but perhaps suggests another future line of inquiry. Considering how the Grammar.hs example still takes about 20 seconds to compile, and there are a few rather whopping candidates popping up in the profile, yes, I think it is very likely that we can find other opportunities. I will definitely look into the tuple unboxing thing, and also try to get to the bottom of the CoreTidy and simplCast cost centres. Who knows, maybe they're somehow related, even. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 26 08:25:29 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 26 Jan 2018 08:25:29 -0000 Subject: [GHC] #14677: Code generator does not correctly tag a pointer In-Reply-To: <046.7a1d900f9976c54932290e6492402f05@haskell.org> References: <046.7a1d900f9976c54932290e6492402f05@haskell.org> Message-ID: <061.5444caee88fa6d229ed8b5fdecea7dfa@haskell.org> #14677: Code generator does not correctly tag a pointer -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: 14626 Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by alexbiehl): Ha, got it! `evtWrite` is defined as {{{ -- | The file descriptor is ready to accept a write. evtWrite :: Event evtWrite = Event 2 }}} This compiles to this CMM: {{{ ==================== Optimised Cmm ==================== 2018-01-26 08:16:02.207998 UTC section ""data" . evtWrite1_r3aU_closure" { evtWrite1_r3aU_closure: const GHC.Types.I#_con_info; const 2; } ==================== Optimised Cmm ==================== 2018-01-26 08:16:02.209627 UTC section ""data" . T14677_1.evtWrite_closure" { T14677_1.evtWrite_closure: const stg_IND_STATIC_info; const evtWrite1_r3aU_closure+1; const 0; const 0; } }}} Now as seen in my previous comment we refer to `evtWrite_closure` like this: ``` ... R2 = PicBaseReg + (GHC.Event.Internal.evtWrite_closure+1); call Main.f1_info(R2) args: 8, res: 0, upd: 8; ... ``` Now, take a look at the CMM for `evtWrite_closure` again. `evtWrite_closure` is basically an IND_STATIC closure pointing to the actual closure data! So by tagging the pointer we don't enter and never get the desired value! Our tests were working on the address of `evtWrite1_r3aU_closure+1`. What follows is a test which confirms the theory: T14677_1.hs {{{ module T14677_1 where import Data.Bits import Data.List newtype Event = Event { toInt :: Int } deriving (Eq) evtNothing :: Event evtNothing = Event 0 {-# INLINE evtNothing #-} -- | Data is available to be read. evtRead :: Event evtRead = Event 1 {-# INLINE evtRead #-} -- | The file descriptor is ready to accept a write. evtWrite :: Event evtWrite = Event 2 {-# INLINE evtWrite #-} -- | Another thread closed the file descriptor. evtClose :: Event evtClose = Event 4 {-# INLINE evtClose #-} eventIs :: Event -> Event -> Bool eventIs (Event a) (Event b) = a .&. b /= 0 -- | @since 4.3.1.0 instance Show Event where show e = '[' : (intercalate "," . filter (not . null) $ [evtRead `so` "evtRead", evtWrite `so` "evtWrite", evtClose `so` "evtClose"]) ++ "]" where ev `so` disp | e `eventIs` ev = disp | otherwise = "" }}} T14677_2 {{{ module Main where import T14677_1 f e2 = do print (toInt e2) print e2 print (e2 == evtRead) main = f evtWrite }}} This prints for my machine: {{{ $ inplace/bin/ghc-stage1 T14677_2.hs T14677_1.hs -O2 $ ./T14677_2 4307143777 [evtRead] False }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 26 09:16:12 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 26 Jan 2018 09:16:12 -0000 Subject: [GHC] #9221: (super!) linear slowdown of parallel builds on 40 core machine In-Reply-To: <045.6b727a84a1bea97c8d082954a0b9425e@haskell.org> References: <045.6b727a84a1bea97c8d082954a0b9425e@haskell.org> Message-ID: <060.aa5a9076e2bbe91a357cfd8197a969a5@haskell.org> #9221: (super!) linear slowdown of parallel builds on 40 core machine -------------------------------------+------------------------------------- Reporter: carter | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 7.8.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: #910, #8224 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by lelf): * cc: lelf (added) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 26 09:34:05 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 26 Jan 2018 09:34:05 -0000 Subject: [GHC] #14677: Code generator does not correctly tag a pointer In-Reply-To: <046.7a1d900f9976c54932290e6492402f05@haskell.org> References: <046.7a1d900f9976c54932290e6492402f05@haskell.org> Message-ID: <061.2ab3424d03fdfc4e23a35f805847581c@haskell.org> #14677: Code generator does not correctly tag a pointer -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: 14626 Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by heisenbug): Replying to [comment:15 alexbiehl]: > Ha, got it! > > `evtWrite` is defined as > [snip] Yeah, a simple `main = print evtWrite` will show the issue. I just had a long dog walk, thanks for reducing this! Yesterday I checked the diffs in the generated Cmm and the '''only''' change was that the `evtWrite_closure+1` gets passed (instead of `evtWrite_closure`). So your analysis sounds reasonable. The callee thinks it got the dereferenced `Int`, but actually it is a tagged pointer. This is somehow related to the fact that the `newtype` is defined in another module. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 26 09:39:55 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 26 Jan 2018 09:39:55 -0000 Subject: [GHC] #14677: Code generator does not correctly tag a pointer In-Reply-To: <046.7a1d900f9976c54932290e6492402f05@haskell.org> References: <046.7a1d900f9976c54932290e6492402f05@haskell.org> Message-ID: <061.567b63b444aa36dce7ea0808ef4d2cf0@haskell.org> #14677: Code generator does not correctly tag a pointer -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: 14626 Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by heisenbug): Replying to [comment:16 heisenbug]: > Replying to [comment:15 alexbiehl]: Alex, if you manage to put together a tentative patch, feel free to check it in to the branch and push. That will trigger the CI machinery. > > Ha, got it! > > > > `evtWrite` is defined as > > > > [snip] > > Yeah, a simple `main = print evtWrite` will show the issue. I just had a long dog walk, thanks for reducing this! Yesterday I checked the diffs in the generated Cmm and the '''only''' change was that the `evtWrite_closure+1` gets passed (instead of `evtWrite_closure`). So your analysis sounds reasonable. The callee thinks it got the dereferenced `Int`, but actually it is a tagged pointer. This is somehow related to the fact that the `newtype` is defined in another module. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 26 09:46:42 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 26 Jan 2018 09:46:42 -0000 Subject: [GHC] #14677: Code generator does not correctly tag a pointer In-Reply-To: <046.7a1d900f9976c54932290e6492402f05@haskell.org> References: <046.7a1d900f9976c54932290e6492402f05@haskell.org> Message-ID: <061.4cf5177f744c8cda78b305586b7d677e@haskell.org> #14677: Code generator does not correctly tag a pointer -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: 14626 Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by alexbiehl): I think a patch might be more involved: This is the core for `evtWrite` {{{ -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} evtWrite1_r335 :: Int [GblId, Caf=NoCafRefs, Str=m] evtWrite1_r335 = GHC.Types.I# 2# -- RHS size: {terms: 1, types: 0, coercions: 2, joins: 0/0} evtWrite [InlPrag=INLINE (sat-args=0)] :: Event [GblId, Str=m, Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=0,unsat_ok=False,boring_ok=False) Tmpl= (GHC.Types.I# 2#) `cast` (Sym T14677_1.N:Event[0] :: (Int :: *) ~R# (Event :: *))}] evtWrite = evtWrite1_r335 `cast` (Sym T14677_1.N:Event[0] :: (Int :: *) ~R# (Event :: *)) }}} So it's already an indirection in Core! Maybe we shouldn't lift the integer out of `evtWrite` and make an expression of the form {{{ e `cast` co }}} where `e` is a satured constructor application. CoreToStg could spot this case and make it a proper `StgConApp` which will then be codegened into a proper constant. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 26 12:04:06 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 26 Jan 2018 12:04:06 -0000 Subject: [GHC] #14677: Code generator does not correctly tag a pointer In-Reply-To: <046.7a1d900f9976c54932290e6492402f05@haskell.org> References: <046.7a1d900f9976c54932290e6492402f05@haskell.org> Message-ID: <061.7a690b80b96eb70e16d79bf28294b1cd@haskell.org> #14677: Code generator does not correctly tag a pointer -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: 14626 Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by heisenbug): Replying to [comment:18 alexbiehl]: What happens when `stg_IND_STATIC_info` is entered? There seems to be no machine code, will that crash? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 26 12:07:46 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 26 Jan 2018 12:07:46 -0000 Subject: [GHC] #14677: Code generator does not correctly tag a pointer In-Reply-To: <046.7a1d900f9976c54932290e6492402f05@haskell.org> References: <046.7a1d900f9976c54932290e6492402f05@haskell.org> Message-ID: <061.4d9febc38f20f97ddd60f643050b893b@haskell.org> #14677: Code generator does not correctly tag a pointer -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: 14626 Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by alexbiehl): Gabor, see https://github.com/ghc/ghc/blob/master/rts/StgMiscClosures.cmm#L268. Take the indirectee, untag and enter. (Btw. why do we untag the value and enter, wouldn't we want to just return R1 if it is tagged?) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 26 12:31:32 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 26 Jan 2018 12:31:32 -0000 Subject: [GHC] #14677: Code generator does not correctly tag a pointer In-Reply-To: <046.7a1d900f9976c54932290e6492402f05@haskell.org> References: <046.7a1d900f9976c54932290e6492402f05@haskell.org> Message-ID: <061.994bf870846a6780d8a63a77ff63e53f@haskell.org> #14677: Code generator does not correctly tag a pointer -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: 14626 Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by heisenbug): Replying to [comment:20 alexbiehl]: > Gabor, > > see https://github.com/ghc/ghc/blob/master/rts/StgMiscClosures.cmm#L268. Take the indirectee, untag and enter. (Btw. why do we untag the value and enter, wouldn't we want to just return R1 if it is tagged?) So `StgInd_indirectee` grabs the value `evtWrite1_r3aU_closure+1` (why the two zeroes behind that???). If we (could?) know that `evtWrite_closure` just redirects to that, why not perform the redirection at Cmm-gen time? The unfolding TMPL surely gives a hint how to do it! > > edit: (entering the indirectee makes sense to reduce chains of IND_STATICs to the static value) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 26 13:20:04 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 26 Jan 2018 13:20:04 -0000 Subject: [GHC] #14724: ghc-8.2.2 configure script fail to extract gcc version correctly Message-ID: <047.3c856cd290cb04641a217ca765a91456@haskell.org> #14724: ghc-8.2.2 configure script fail to extract gcc version correctly -------------------------------------+------------------------------------- Reporter: hyophyop | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Keywords: | Operating System: MacOS X Architecture: x86_64 | Type of failure: Installing GHC (amd64) | failed Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- In GHC's configure script, there's a variable $fp_cv_gcc_version which contains gcc version by running one-line bash code. {{{ fp_cv_gcc_version="`$CC -v 2>&1 | grep 'version ' | sed -e 's/.*version [^0-9]*\([0-9.]*\).*/\1/g'`" }}} Following is gcc version info of my system. {{{ Apple LLVM version 9.0.0 (clang-900.0.39.2) Target: x86_64-apple-darwin17.4.0 Thread model: posix InstalledDir: /Library/Developer/CommandLineTools/usr/bin Found CUDA installation: /usr/local/cuda, version 7.5 }}} Expected value of fp_cv_gcc_version is 9.0.0. But CUDA version is extracted unexpectedly and attached to version info resulting buggy `mk/config.mk` like following. {{{ GccVersion = 9.0.0 7.5 ifeq "$(phase)" "0" CrossCompilePrefix = ... }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 26 15:28:20 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 26 Jan 2018 15:28:20 -0000 Subject: [GHC] #14709: Extend the plugin mechanism to access program representation In-Reply-To: <044.2e69c960decc5283f7ff746e6b782d96@haskell.org> References: <044.2e69c960decc5283f7ff746e6b782d96@haskell.org> Message-ID: <059.00a5a8522a27b26d1e50f77a02b51cac@haskell.org> #14709: Extend the plugin mechanism to access program representation -------------------------------------+------------------------------------- Reporter: lazac | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: GHC API | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | https://phabricator.haskell.org/D4342 https://ghc.haskell.org/trac/ghc/wiki/ExtendedPluginsProposal| -------------------------------------+------------------------------------- Comment (by bgamari): > I can imagine tools that modify these representations as well Sure. The one thing I would really like to see considered is recompilation checking. Currently the existing plugin types are borderline unusable due to the lack of recompilation avoidance (see #7414). While you don't need to solve this issue in your patch (doing so will likely require deeper changes in GHC), we should try to think through which information the plugin will need to provide for the compiler to be able to assess whether recompilation is necessary and design the interface with this need in mind. This will avoid backwards-incompatible interface changes in the future. Writing down a few motivating examples of applications of the new plugin types may be a good place to start. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 26 16:03:20 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 26 Jan 2018 16:03:20 -0000 Subject: [GHC] #14725: memory leak: forkOS not releasing thread local `Task` struct upon end of thread Message-ID: <050.9267e809dc9eb2e9ccacbd64b8668a58@haskell.org> #14725: memory leak: forkOS not releasing thread local `Task` struct upon end of thread ------------------------------------------+--------------------------- Reporter: RobertZabel | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Runtime System | Version: 8.2.2 Keywords: forkOS memory leak | Operating System: POSIX Architecture: Unknown/Multiple | Type of failure: Other Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: ------------------------------------------+--------------------------- I came to notice a memory leak in the runtime system while letting warp use `forkOS` and conducting a load test.\\ A minimal snippet to reproduce: {{{#!hs module Main where import Control.Concurrent main :: IO () main = replicateM_ 10000000 $ forkOS $ return () }}} This patch will clean up the thread local `Task` struct just before threads created by forkOS terminate. {{{ diff --git a/rts/posix/OSThreads.c b/rts/posix/OSThreads.c index c9adf4e..bd4e75d 100644 --- a/rts/posix/OSThreads.c +++ b/rts/posix/OSThreads.c @@ -223,6 +223,7 @@ forkOS_createThreadWrapper ( void * entry ) cap = rts_lock(); rts_evalStableIO(&cap, (HsStablePtr) entry, NULL); rts_unlock(cap); + rts_done(); return NULL; } }}} I think win32 platforms need an equivalent patch, but unfortunately I cannot verify that. \\ Hence I'm only targeting posix here. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 26 16:14:31 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 26 Jan 2018 16:14:31 -0000 Subject: [GHC] #14726: Add AnnTypeAt to distinguish between '@' for type application Message-ID: <044.760000f168e345a85ce2a2860ba70ece@haskell.org> #14726: Add AnnTypeAt to distinguish between '@' for type application -------------------------------------+------------------------------------- Reporter: alanz | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 (Parser) | Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: Incorrect API Unknown/Multiple | annotation Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- At the moment all uses of '@' have the same annotation. It simplifies tools to provide a different one for the `@` in visible type application. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 26 16:14:47 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 26 Jan 2018 16:14:47 -0000 Subject: [GHC] #14726: Add AnnTypeAt to distinguish between '@' for type application In-Reply-To: <044.760000f168e345a85ce2a2860ba70ece@haskell.org> References: <044.760000f168e345a85ce2a2860ba70ece@haskell.org> Message-ID: <059.ceab599c5b5a1ec27c096b4f31c255f4@haskell.org> #14726: Add AnnTypeAt to distinguish between '@' for type application -------------------------------------+------------------------------------- Reporter: alanz | Owner: alanz Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 (Parser) | Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect API | Unknown/Multiple annotation | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by alanz): * owner: (none) => alanz -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 26 16:22:55 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 26 Jan 2018 16:22:55 -0000 Subject: [GHC] #14526: GHC fails to configure on MacOS if Cuda is installed In-Reply-To: <044.b4ecd2cf118d3da39dbf347707988ebb@haskell.org> References: <044.b4ecd2cf118d3da39dbf347707988ebb@haskell.org> Message-ID: <059.d6f939ad84f34d5c265b74c5087c1a62@haskell.org> #14526: GHC fails to configure on MacOS if Cuda is installed -------------------------------------+------------------------------------- Reporter: nehal | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: 8.4.1 Component: Build System | Version: 8.0.2 Resolution: fixed | Keywords: Cuda Operating System: MacOS X | Architecture: x86_64 Type of failure: Building GHC | (amd64) failed | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: new => closed * resolution: => fixed * milestone: => 8.4.1 Comment: I believe this should be resolved with 71a423562a555ef0805bba546a3a42d437803842. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 26 16:23:18 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 26 Jan 2018 16:23:18 -0000 Subject: [GHC] #14724: ghc-8.2.2 configure script fail to extract gcc version correctly In-Reply-To: <047.3c856cd290cb04641a217ca765a91456@haskell.org> References: <047.3c856cd290cb04641a217ca765a91456@haskell.org> Message-ID: <062.c75d4e09b3a1eae3185d4e502aa8d3c8@haskell.org> #14724: ghc-8.2.2 configure script fail to extract gcc version correctly -------------------------------------+------------------------------------- Reporter: hyophyop | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.2.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: MacOS X | Architecture: x86_64 Type of failure: Installing GHC | (amd64) failed | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * milestone: => 8.2.1 Comment: I believe this should be resolved with 71a423562a555ef0805bba546a3a42d437803842. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 26 16:23:26 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 26 Jan 2018 16:23:26 -0000 Subject: [GHC] #14526: GHC fails to configure on MacOS if Cuda is installed In-Reply-To: <044.b4ecd2cf118d3da39dbf347707988ebb@haskell.org> References: <044.b4ecd2cf118d3da39dbf347707988ebb@haskell.org> Message-ID: <059.20694412e05175ec7abafc31f4953e80@haskell.org> #14526: GHC fails to configure on MacOS if Cuda is installed -------------------------------------+------------------------------------- Reporter: nehal | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: 8.2.1 Component: Build System | Version: 8.0.2 Resolution: fixed | Keywords: Cuda Operating System: MacOS X | Architecture: x86_64 Type of failure: Building GHC | (amd64) failed | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * milestone: 8.4.1 => 8.2.1 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 26 16:25:33 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 26 Jan 2018 16:25:33 -0000 Subject: [GHC] #14724: ghc-8.2.2 configure script fail to extract gcc version correctly In-Reply-To: <047.3c856cd290cb04641a217ca765a91456@haskell.org> References: <047.3c856cd290cb04641a217ca765a91456@haskell.org> Message-ID: <062.d6b4472e1da6c36e7a33c1d6147df291@haskell.org> #14724: ghc-8.2.2 configure script fail to extract gcc version correctly -------------------------------------+------------------------------------- Reporter: hyophyop | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: MacOS X | Architecture: x86_64 Type of failure: Installing GHC | (amd64) failed | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * milestone: 8.2.1 => 8.4.1 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 26 16:26:01 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 26 Jan 2018 16:26:01 -0000 Subject: [GHC] #14526: GHC fails to configure on MacOS if Cuda is installed In-Reply-To: <044.b4ecd2cf118d3da39dbf347707988ebb@haskell.org> References: <044.b4ecd2cf118d3da39dbf347707988ebb@haskell.org> Message-ID: <059.65dc85769144200139777f267fb21634@haskell.org> #14526: GHC fails to configure on MacOS if Cuda is installed -------------------------------------+------------------------------------- Reporter: nehal | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: 8.4.1 Component: Build System | Version: 8.0.2 Resolution: fixed | Keywords: Cuda Operating System: MacOS X | Architecture: x86_64 Type of failure: Building GHC | (amd64) failed | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * milestone: 8.2.1 => 8.4.1 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 26 16:30:23 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 26 Jan 2018 16:30:23 -0000 Subject: [GHC] #14725: memory leak: forkOS not releasing thread local `Task` struct upon end of thread In-Reply-To: <050.9267e809dc9eb2e9ccacbd64b8668a58@haskell.org> References: <050.9267e809dc9eb2e9ccacbd64b8668a58@haskell.org> Message-ID: <065.86d795613528bb6a9799a3d04c352111@haskell.org> #14725: memory leak: forkOS not releasing thread local `Task` struct upon end of thread -------------------------------------+------------------------------------- Reporter: RobertZabel | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Runtime System | Version: 8.2.2 Resolution: | Keywords: forkOS memory | leak Operating System: POSIX | Architecture: | Unknown/Multiple Type of failure: Other | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Description changed by RobertZabel: Old description: > I came to notice a memory leak in the runtime system while letting warp > use `forkOS` and conducting a load test.\\ > A minimal snippet to reproduce: > > {{{#!hs > module Main where > import Control.Concurrent > > main :: IO () > main = replicateM_ 10000000 $ forkOS $ return () > }}} > > This patch will clean up the thread local `Task` struct just before > threads created by forkOS terminate. > > {{{ > diff --git a/rts/posix/OSThreads.c b/rts/posix/OSThreads.c > index c9adf4e..bd4e75d 100644 > --- a/rts/posix/OSThreads.c > +++ b/rts/posix/OSThreads.c > @@ -223,6 +223,7 @@ forkOS_createThreadWrapper ( void * entry ) > cap = rts_lock(); > rts_evalStableIO(&cap, (HsStablePtr) entry, NULL); > rts_unlock(cap); > + rts_done(); > return NULL; > } > }}} > > I think win32 platforms need an equivalent patch, but unfortunately I > cannot verify that. \\ > Hence I'm only targeting posix here. New description: I came to notice a memory leak in the runtime system while letting warp use `forkOS` and conducting a load test.\\ A minimal snippet to reproduce: {{{#!hs module Main where import Control.Concurrent import Control.Monad main :: IO () main = replicateM_ 10000000 $ forkOS $ return () }}} This patch will clean up the thread local `Task` struct just before threads created by forkOS terminate. {{{ diff --git a/rts/posix/OSThreads.c b/rts/posix/OSThreads.c index c9adf4e..bd4e75d 100644 --- a/rts/posix/OSThreads.c +++ b/rts/posix/OSThreads.c @@ -223,6 +223,7 @@ forkOS_createThreadWrapper ( void * entry ) cap = rts_lock(); rts_evalStableIO(&cap, (HsStablePtr) entry, NULL); rts_unlock(cap); + rts_done(); return NULL; } }}} I think win32 platforms need an equivalent patch, but unfortunately I cannot verify that. \\ Hence I'm only targeting posix here. -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 26 16:52:03 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 26 Jan 2018 16:52:03 -0000 Subject: [GHC] #11735: Optimize coercionKind In-Reply-To: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> References: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> Message-ID: <062.665dce6f74c32cb4d971be701e2eaa2d@haskell.org> #11735: Optimize coercionKind -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.10.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by goldfire): I'm sorry -- I don't understand the first part of comment:37. Getting a kind should never require getting a role. That's why there is a version of `coercionKind` that's a standalone function. Let's assume you got these two swapped. Even then, I'm not sure what you're describing; it seems you're describing your 'un-refactored" version keeping roles and kinds separate. If they are together (as in HEAD), I don't see the quadratic behavior. And yet, something goes terribly wrong in HEAD, even without this quadratic behavior. But what?? Or maybe I'm completely missing something here. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 26 16:52:26 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 26 Jan 2018 16:52:26 -0000 Subject: [GHC] #14691: Replace EvTerm with CoreExpr In-Reply-To: <046.62945affcc6cc14a9778d709349ac741@haskell.org> References: <046.62945affcc6cc14a9778d709349ac741@haskell.org> Message-ID: <061.62921d9de214f2fb2f75f350f5d9c851@haskell.org> #14691: Replace EvTerm with CoreExpr -------------------------------------+------------------------------------- Reporter: nomeata | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.3 checker) | Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Joachim Breitner ): In [changeset:"0e022e56b130ab9d277965b794e70d8d3fb29533/ghc" 0e022e5/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="0e022e56b130ab9d277965b794e70d8d3fb29533" Turn EvTerm (almost) into CoreExpr (#14691) Ideally, I'd like to do type EvTerm = CoreExpr and the type checker builds the evidence terms as it goes. This failed, becuase the evidence for `Typeable` refers to local identifiers that are added *after* the typechecker solves constraints. Therefore, `EvTerm` stays a data type with two constructors: `EvExpr` for `CoreExpr` evidence, and `EvTypeable` for the others. Delted `Note [Memoising typeOf]`, its reference (and presumably relevance) was removed in 8fa4bf9. Differential Revision: https://phabricator.haskell.org/D4341 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 26 16:53:00 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 26 Jan 2018 16:53:00 -0000 Subject: [GHC] #14716: indexM-style accessor for arrays? In-Reply-To: <045.382f374145c4a013f6bcf49e8b87d85e@haskell.org> References: <045.382f374145c4a013f6bcf49e8b87d85e@haskell.org> Message-ID: <060.62ebc13616fe59053ea2b778248dc938@haskell.org> #14716: indexM-style accessor for arrays? -------------------------------------+------------------------------------- Reporter: Zemyla | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: libraries | Version: 8.2.2 (other) | Resolution: | Keywords: array Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * cc: core-libraries-committee@… (added) Comment: Question for the Core Libraries Committee: What is the status of `Data.Array`? As part of the Report it seems like this module subtree would fall under the CLC's purview. Do additions require a libraries proposal? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 26 16:54:07 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 26 Jan 2018 16:54:07 -0000 Subject: [GHC] #14716: indexM-style accessor for arrays? In-Reply-To: <045.382f374145c4a013f6bcf49e8b87d85e@haskell.org> References: <045.382f374145c4a013f6bcf49e8b87d85e@haskell.org> Message-ID: <060.00c15159a3f4d4bd4a1eb4995e297f49@haskell.org> #14716: indexM-style accessor for arrays? -------------------------------------+------------------------------------- Reporter: Zemyla | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: libraries | Version: 8.2.2 (other) | Resolution: | Keywords: array Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): Regarding the proposed idea, it seems quite reasonable to me. In general I would love to see `Data.Array`'s interface fleshed out to approach the completeness of, say, `vector`. It's currently needlessly painful to use. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 26 17:41:39 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 26 Jan 2018 17:41:39 -0000 Subject: [GHC] #14725: memory leak: forkOS not releasing thread local `Task` struct upon end of thread In-Reply-To: <050.9267e809dc9eb2e9ccacbd64b8668a58@haskell.org> References: <050.9267e809dc9eb2e9ccacbd64b8668a58@haskell.org> Message-ID: <065.673add16956437f3a4a7b35a92901910@haskell.org> #14725: memory leak: forkOS not releasing thread local `Task` struct upon end of thread -------------------------------------+------------------------------------- Reporter: RobertZabel | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: Component: Runtime System | Version: 8.2.2 Resolution: | Keywords: forkOS memory | leak Operating System: POSIX | Architecture: | Unknown/Multiple Type of failure: Other | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4346 Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: new => patch * differential: => Phab:D4346 Comment: Good catch and thanks for the patch! I've pushed the patch to Phab:D4346 for review. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 26 17:42:44 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 26 Jan 2018 17:42:44 -0000 Subject: [GHC] #14725: memory leak: forkOS not releasing thread local `Task` struct upon end of thread In-Reply-To: <050.9267e809dc9eb2e9ccacbd64b8668a58@haskell.org> References: <050.9267e809dc9eb2e9ccacbd64b8668a58@haskell.org> Message-ID: <065.82491a96b7d8df2a833e43170c554690@haskell.org> #14725: memory leak: forkOS not releasing thread local `Task` struct upon end of thread -------------------------------------+------------------------------------- Reporter: RobertZabel | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: Component: Runtime System | Version: 8.2.2 Resolution: | Keywords: forkOS memory | leak Operating System: POSIX | Architecture: | Unknown/Multiple Type of failure: Other | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4346 Wiki Page: | -------------------------------------+------------------------------------- Changes (by erick): * cc: erick@… (added) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 26 17:55:17 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 26 Jan 2018 17:55:17 -0000 Subject: [GHC] #14720: GHC 8.4.1-alpha regression with TypeInType In-Reply-To: <050.3979775ac8fffda86c79c2a678f92178@haskell.org> References: <050.3979775ac8fffda86c79c2a678f92178@haskell.org> Message-ID: <065.e3810cb1f58e97f8722a459457139eee@haskell.org> #14720: GHC 8.4.1-alpha regression with TypeInType -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: high | Milestone: 8.4.1 Component: Compiler (Type | Version: 8.4.1-alpha1 checker) | Resolution: | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: Type of failure: GHC rejects | Unknown/Multiple valid program | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by goldfire): I'm pretty sure this is #12919. It works on my branch, held up due to performance problems. It's being actively worked on by @alexvieth, to whom I've gratefully delegated fixing those performance problems. But when I say active, I mean it: Alex sent me some results offline this morning. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 26 18:20:09 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 26 Jan 2018 18:20:09 -0000 Subject: [GHC] #14711: Machine readable output of coverage In-Reply-To: <050.d858ad27520ca4b1ee3c013a327a8c68@haskell.org> References: <050.d858ad27520ca4b1ee3c013a327a8c68@haskell.org> Message-ID: <065.6905e7d4a09b96ea1276408b6cf5ccbe@haskell.org> #14711: Machine readable output of coverage -------------------------------------+------------------------------------- Reporter: Koterpillar | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Code Coverage | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): Indeed this sounds quite useful. Let me know if you want help taking a stab at this. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 26 18:23:53 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 26 Jan 2018 18:23:53 -0000 Subject: [GHC] #13362: GHC first generation of GC to be as large as largest cache size by default In-Reply-To: <045.9df30bf1acd19df01317b133116e51f6@haskell.org> References: <045.9df30bf1acd19df01317b133116e51f6@haskell.org> Message-ID: <060.cfad7f4cab96e7697f25b7314e6d2ca7@haskell.org> #13362: GHC first generation of GC to be as large as largest cache size by default -------------------------------------+------------------------------------- Reporter: varosi | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: 8.6.1 Component: Runtime System | Version: 8.0.2 Resolution: | Keywords: numa cache gc | newcomers 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: | -------------------------------------+------------------------------------- Changes (by bgamari): * keywords: numa cache gc => numa cache gc newcomers Comment: Auto-sizing the allocation area sounds like a reasonable idea to me. A portable solution is perhaps tricky, but I doubt a solution that works on the major operating systems is far from reach. Perhaps you want to have a look? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 26 18:40:48 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 26 Jan 2018 18:40:48 -0000 Subject: [GHC] #13362: GHC first generation of GC to be as large as largest cache size by default In-Reply-To: <045.9df30bf1acd19df01317b133116e51f6@haskell.org> References: <045.9df30bf1acd19df01317b133116e51f6@haskell.org> Message-ID: <060.9eea706a388eb09074a008aa4a4ccbe9@haskell.org> #13362: GHC first generation of GC to be as large as largest cache size by default -------------------------------------+------------------------------------- Reporter: varosi | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: 8.6.1 Component: Runtime System | Version: 8.0.2 Resolution: | Keywords: numa cache gc | newcomers 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: | -------------------------------------+------------------------------------- Comment (by carter): do we mean the Nursery or the Gen1 heap after the nursery? I'd imagine we want the nursery to fit in L1 or L2 caches (where applicable) and the Gen1 heap to fit in the rest of the Cache left in Level3 after we account for nurseries? Perhaps {{{ size of nursery = size of L2 cache per cpu core size of gen1 >= max(#capabilities * size of nursery , size of L3 cache in socket - (#capabilities * size of nursery) ) }}} we definitely (at least in many core systems) do *not* want nurseries on the same Socket creating cache thrash with eachother (ie under heavy allocation workloads)? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 26 18:53:21 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 26 Jan 2018 18:53:21 -0000 Subject: [GHC] #7414: plugins always trigger recompilation In-Reply-To: <045.791037be90cd943b6dd26df93dd060d8@haskell.org> References: <045.791037be90cd943b6dd26df93dd060d8@haskell.org> Message-ID: <060.5d93632165d6553e1d6c9caf31ee343e@haskell.org> #7414: plugins always trigger recompilation -------------------------------------+------------------------------------- Reporter: jwlato | Owner: (none) Type: feature request | Status: new Priority: high | Milestone: 8.6.1 Component: Compiler | Version: 7.6.1 Resolution: | Keywords: plugin, | RecompilationCheck Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): > Is there anything blocking this ticket or does someone just need to implement it? There's nothing particularly blocking. The plan that I wrote about may or may not be the right way to go about this. It's also quite unclear what the right way forward would be if it turned out that implementation hashes are expensive to compute. Regardless, osa1 may be looking into this for Well-Typed client at some point in the next few months. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 26 19:06:25 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 26 Jan 2018 19:06:25 -0000 Subject: [GHC] #14710: GHC 8.4.1-alpha allows the use of kind polymorphism without PolyKinds In-Reply-To: <050.c0df5def4de65d7ecd4d01ad9668904c@haskell.org> References: <050.c0df5def4de65d7ecd4d01ad9668904c@haskell.org> Message-ID: <065.df485c77669fd7ff96854ead592e5e57@haskell.org> #14710: GHC 8.4.1-alpha allows the use of kind polymorphism without PolyKinds -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: high | Milestone: 8.4.1 Component: Compiler (Type | Version: 8.4.1-alpha1 checker) | Resolution: | Keywords: PolyKinds Operating System: Unknown/Multiple | Architecture: Type of failure: GHC accepts | Unknown/Multiple invalid program | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by goldfire): You'll need to make a few changes to fix this: - `TcHsType.tcLHsKindSig` should really call `checkValidType`. This was an oversight from likely long ago. - The `tc_infer_hs_type` case that deals with `HsKindSig` should, in turn, use `tcLHsKindSig`. - `checkValidType` will need to know whether it's checking a kind. If it is, and if `-XPolyKinds` isn't on (which is implied by `-XTypeInType`, so you don't need a separate `-XTypeInType` check), then complain about variables. Alternatively, you could conceivably catch this in the renamer. `RnTypes.rnHsTyKi` knows when it's renaming a kind (vs. a type). In the `HsTyVar` case, you could bleat with `-XNoPolyKinds` and spotting a variable whose name is in the type variable namespace (as opposed to a tycon, recalling tat `HsTyVar` includes both). -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 26 19:24:28 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 26 Jan 2018 19:24:28 -0000 Subject: [GHC] #14677: Code generator does not correctly tag a pointer In-Reply-To: <046.7a1d900f9976c54932290e6492402f05@haskell.org> References: <046.7a1d900f9976c54932290e6492402f05@haskell.org> Message-ID: <061.ae52fc8f0d0fb4b0a18349bf63d93ade@haskell.org> #14677: Code generator does not correctly tag a pointer -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: 14626 Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by heisenbug): I have something along the lines of my last comment, that '''seems''' to work :-) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 26 19:40:50 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 26 Jan 2018 19:40:50 -0000 Subject: [GHC] #12158: ghc: panic! (the 'impossible' happened) translateConPatVec: lookup In-Reply-To: <047.dbe3294939f168d779839dd776514e40@haskell.org> References: <047.dbe3294939f168d779839dd776514e40@haskell.org> Message-ID: <062.44a31bebad41c74f7dbb4c36db1240fb@haskell.org> #12158: ghc: panic! (the 'impossible' happened) translateConPatVec: lookup -------------------------------------+------------------------------------- Reporter: wozgonon | Owner: gkaracha Type: bug | Status: new Priority: normal | Milestone: Component: GHCi | Version: 8.0.1 Resolution: | Keywords: | PatternMatchWarnings Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash | Test Case: Blocked By: | Blocking: Related Tickets: #13644 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Ben Gamari ): In [changeset:"983e491927a461457cc587197ce1644746db894b/ghc" 983e491/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="983e491927a461457cc587197ce1644746db894b" testsuite: Add testcase for #12158 Subscribers: rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4334 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 26 19:40:50 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 26 Jan 2018 19:40:50 -0000 Subject: [GHC] #14672: Make likelyhood of branches/conditions available throughout the compiler. In-Reply-To: <047.de2c13e36902d9be8400d9448aa09671@haskell.org> References: <047.de2c13e36902d9be8400d9448aa09671@haskell.org> Message-ID: <062.92c7bcbeafb3ffa10409d5436ec4a734@haskell.org> #14672: Make likelyhood of branches/conditions available throughout the compiler. -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4316 Wiki Page: | Phab:D4324 Phab:D4327 -------------------------------------+------------------------------------- Comment (by Ben Gamari ): In [changeset:"e7dcc7085315ea8ebc2d6808fde2d9c37fd10c67/ghc" e7dcc708/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="e7dcc7085315ea8ebc2d6808fde2d9c37fd10c67" Add ability to parse likely flags for ifs in Cmm. Adding the ability to parse likely flags in Cmm allows better codegen for cmm files. Test Plan: ci Reviewers: bgamari, simonmar Reviewed By: bgamari Subscribers: rwbarton, thomie, carter GHC Trac Issues: #14672 Differential Revision: https://phabricator.haskell.org/D4316 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 26 19:40:50 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 26 Jan 2018 19:40:50 -0000 Subject: [GHC] #14695: ghc --interactive error: "gcc: error: libgmp.so: No such file or directory" In-Reply-To: <043.14a5c82c2a46e2165050d731a268a622@haskell.org> References: <043.14a5c82c2a46e2165050d731a268a622@haskell.org> Message-ID: <058.3ff1e5cabaa63087dec9588d45cfbf5f@haskell.org> #14695: ghc --interactive error: "gcc: error: libgmp.so: No such file or directory" -------------------------------------+------------------------------------- Reporter: osa1 | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: Component: Compiler | Version: Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4330 Wiki Page: | -------------------------------------+------------------------------------- Comment (by Ben Gamari ): In [changeset:"cacba075d72473511f6924c6505952ff12a20316/ghc" cacba07/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="cacba075d72473511f6924c6505952ff12a20316" Linker: ignore empty paths in addEnvPaths Previously `splitEnv` worked like this: > splitEnv "foo:::bar::baz:" ["foo","","","bar","","baz",""] with this patch: > splitEnv working_dir "foo:::bar:baz:" ["foo",working_dir,working_dir"bar","baz",working_dir] This fixes #14695, where having a trailing `:` in the env variable caused ghci to pass empty `-B` parameter to `gcc`, which in turned caused the next parameter (`--print-file-name`) to be considered as the argument to `-B`. As a result ghci did not work. The `working_dir` argument is to have a similar behavior with POSIX: according to chapter 8.3 zero-length prefix means current working directory. Reviewers: hvr, bgamari, AndreasK, simonmar Reviewed By: bgamari, AndreasK, simonmar Subscribers: AndreasK, rwbarton, thomie, carter GHC Trac Issues: #14695 Differential Revision: https://phabricator.haskell.org/D4330 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 26 19:40:50 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 26 Jan 2018 19:40:50 -0000 Subject: [GHC] #14719: Caret diagnostics for GADT constructor error message don't span the whole constructor In-Reply-To: <050.fd67283e8ff25e6d8d4c0769f0b171e6@haskell.org> References: <050.fd67283e8ff25e6d8d4c0769f0b171e6@haskell.org> Message-ID: <065.984a8856b48e5e3672172378f5d6be74@haskell.org> #14719: Caret diagnostics for GADT constructor error message don't span the whole constructor -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Poor/confusing | Unknown/Multiple error message | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4344 Wiki Page: | -------------------------------------+------------------------------------- Comment (by Ben Gamari ): In [changeset:"59fa7b32b018a91f81773ca676251a0b2761ef56/ghc" 59fa7b32/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="59fa7b32b018a91f81773ca676251a0b2761ef56" Fix #14719 by using the setting the right SrcSpan Currently, error messages that germane to GADT constructors put the source span at only the first character in the constructor, leading to insufficient caret diagnostics. This can be easily fixed by using a source span that spans the entire constructor, instead of just the first character. Test Plan: make test TEST=T14719 Reviewers: alanz, bgamari, simonpj Reviewed By: alanz, simonpj Subscribers: simonpj, goldfire, rwbarton, thomie, carter GHC Trac Issues: #14719 Differential Revision: https://phabricator.haskell.org/D4344 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 26 19:40:50 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 26 Jan 2018 19:40:50 -0000 Subject: [GHC] #14669: Windows binaries sometimes throw a stack overflow. In-Reply-To: <044.45c88c9a13190d9f2a70cd9b35309cc0@haskell.org> References: <044.45c88c9a13190d9f2a70cd9b35309cc0@haskell.org> Message-ID: <059.cd961624ea45e8fd5e244fd788b3ec56@haskell.org> #14669: Windows binaries sometimes throw a stack overflow. -------------------------------------+------------------------------------- Reporter: sergv | Owner: (none) Type: bug | Status: patch Priority: highest | Milestone: 8.4.1 Component: Runtime System | Version: 8.2.1 Resolution: | Keywords: Operating System: Windows | Architecture: | Unknown/Multiple Type of failure: Runtime crash | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4343 Wiki Page: | -------------------------------------+------------------------------------- Comment (by Ben Gamari ): In [changeset:"a55d581f8f2923560c3444253050b13fdf2dec10/ghc" a55d581f/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="a55d581f8f2923560c3444253050b13fdf2dec10" Fix Windows stack allocations. On Windows we use the function `win32AllocStack` to do stack allocations in 4k blocks and insert a stack check afterwards to ensure the allocation returned a valid block. The problem is this function does something that by C semantics is pointless. The stack allocated value can never escape the function, and the stack isn't used so the compiler just optimizes away the entire function body. After considering a bunch of other possibilities I think the simplest fix is to just disable optimizations for the function. Alternatively inline assembly is an option but the stack check function doesn't have a very portable name as it relies on e.g. `libgcc`. Thanks to Sergey Vinokurov for helping diagnose and test. Test Plan: ./validate Reviewers: bgamari, erikd, simonmar Reviewed By: bgamari Subscribers: rwbarton, thomie, carter GHC Trac Issues: #14669 Differential Revision: https://phabricator.haskell.org/D4343 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 26 19:41:18 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 26 Jan 2018 19:41:18 -0000 Subject: [GHC] #14694: Incompleteness in the Coercible constraint solver In-Reply-To: <051.a24047975aac3bbc5e443262dff8c929@haskell.org> References: <051.a24047975aac3bbc5e443262dff8c929@haskell.org> Message-ID: <066.384042c751483456d729708cd9553561@haskell.org> #14694: Incompleteness in the Coercible constraint solver -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Roles Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by goldfire): The list of tickets on https://ghc.haskell.org/trac/ghc/wiki/Roles is short enough that I don't think it's necessary to specifically catalog the incompletnesses. When/if someone comes along ready to fix all this, we can put it together. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 26 19:49:25 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 26 Jan 2018 19:49:25 -0000 Subject: [GHC] #13362: GHC first generation of GC to be as large as largest cache size by default In-Reply-To: <045.9df30bf1acd19df01317b133116e51f6@haskell.org> References: <045.9df30bf1acd19df01317b133116e51f6@haskell.org> Message-ID: <060.6049c546555bc5f7507a7c0891ffc915@haskell.org> #13362: GHC first generation of GC to be as large as largest cache size by default -------------------------------------+------------------------------------- Reporter: varosi | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: 8.6.1 Component: Runtime System | Version: 8.0.2 Resolution: | Keywords: numa cache gc | newcomers 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: | -------------------------------------+------------------------------------- Comment (by klapaucius): Stephen M Blackburn, Perry Cheng, Kathryn S McKinley - Myths and Realities: The Performance Impact of Garbage Collection p. 10 5.4.5 Sizing the nursery "Figure 4(a) shows a small improvement with larger nurseries in mutator performance due to fewer L2 (Figure 4(e)) and TLB misses (Figure 4(f)). However, the difference in GC time dominates: smaller nurseries demand more frequent collection and thus a substantially higher load. We measured the fixed overhead of each collection <...> The garbage collection cost tapers off between 4MB and 8MB as the fixed collection costs become insignificant. These results debunk the myth that the nursery size should be matched to the L2 cache size (512KB on all three architectures)." -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 26 19:51:13 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 26 Jan 2018 19:51:13 -0000 Subject: [GHC] #11735: Optimize coercionKind In-Reply-To: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> References: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> Message-ID: <062.d2906d463b8fd586e7fa0fbea66a4baf@haskell.org> #11735: Optimize coercionKind -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.10.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by tdammers): Replying to [comment:38 goldfire]: > I'm sorry -- I don't understand the first part of comment:37. Getting a kind should never require getting a role. That's why there is a version of `coercionKind` that's a standalone function. Let's assume you got these two swapped. Even then, I'm not sure what you're describing; it seems you're describing your 'un-refactored" version keeping roles and kinds separate. I'm sorry, yes, I was being confused there; `coercionKind` and `coercionRole` are mutually recursive in the "un-refactored" version only. However, the un-refactoring *does* produce a performance improvement, so there must be *something* going on here - I assumed that the original `coercionKindRole` would ultimately amount to a similar recursion pattern, but it probably doesn't. > If they are together (as in HEAD), I don't see the quadratic behavior. > And yet, something goes terribly wrong in HEAD, even without this quadratic behavior. But what?? Or maybe I'm completely missing something here. I think I have found it. For clarity, this is the relevant code on HEAD: {{{ go (NthCo d co) | Just (tv1, _) <- splitForAllTy_maybe ty1 = ASSERT( d == 0 ) let (tv2, _) = splitForAllTy ty2 in (tyVarKind <$> Pair tv1 tv2, Nominal) | otherwise = let (tc1, args1) = splitTyConApp ty1 (_tc2, args2) = splitTyConApp ty2 in ASSERT2( tc1 == _tc2, ppr d $$ ppr tc1 $$ ppr _tc2 ) ((`getNth` d) <$> Pair args1 args2, nthRole r tc1 d) where (Pair ty1 ty2, r) = go co }}} So the rough shape of the recursion is simple - we hit the `otherwise` case repeatedly until we get to the `d == 0` case; O(n). But inside the `otherwise` branch, there's this pesky `getNth` call, which is linear in `d` (being essentially a linked-list lookup), and another one via `nthRole`. The problem goes away when we calculate the role at construction time, because we are either constructing an NthCo that doesn't wrap another NthCo, which makes the role calculation constant-time, or we are constructing one that *does* wrap another NthCo, but that one already has its role calculated, so it is also constant. Hope I'm making sense now. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 26 20:25:02 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 26 Jan 2018 20:25:02 -0000 Subject: [GHC] #11735: Optimize coercionKind In-Reply-To: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> References: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> Message-ID: <062.fe06ee3ecab8f8fe7898f53c4e45a018@haskell.org> #11735: Optimize coercionKind -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.10.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by goldfire): Sorry, still confused. :( How are `coercionKind` and `coercionRole` ''mutually'' recursive? I see that `coercionRole` calls `coercionKind` but not the other way around. But you're right that I'm trying to understand better why there's a performance improvement in this patch (even before any caching). In the nested `NthCo` case, I'm pretty sure your refactor would be worse. But in the test case at hand (which I assume doesn't have nested `NthCo`s -- haven't looked), your change is clearly an improvement. However, I don't think your analysis above is really the problem. I would expect that the running time of `coercionKind` or `coercionRole` on nested `NthCo`s to be linear in the sum of the `d`s -- that is, we'll have to add together all the indices. You've shown above that the old recursion pattern (from `coercionKindRole`) traverses down the linked list twice (once in `getNth` and once in `nthRole`), but this shouldn't change asymptotic complexity. And, usually, `d` is quite small, and so I wouldn't expect this to show up at all, really. I still don't think we've quite gotten to the bottom of why separating out `coercionKind` and `coercionRole` should effect a performance improvement. On the other hand, the separated version really is quadratic... and yet it's faster (on this test case)! That's the conundrum. Please don't let my nit-picking slow you down or discourage you. It's just that I think you've hit something quite interesting, and, well, I'm interested. :) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 26 22:22:47 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 26 Jan 2018 22:22:47 -0000 Subject: [GHC] #14644: Improve cmm/assembly for pattern matches with two constants. In-Reply-To: <047.054a8f1d3e52c239a87742662b91a120@haskell.org> References: <047.054a8f1d3e52c239a87742662b91a120@haskell.org> Message-ID: <062.7e7c4c317c1dff323dc7966ff56dc2f3@haskell.org> #14644: Improve cmm/assembly for pattern matches with two constants. -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: AndreasK Type: task | Status: patch Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 (CodeGen) | Keywords: Codegen, CMM, Resolution: | Patterns, Pattern Matching Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4294 Wiki Page: | -------------------------------------+------------------------------------- Comment (by Ben Gamari ): In [changeset:"7ff6023537fdef32bbe9b4c357012d705d9b931f/ghc" 7ff6023/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="7ff6023537fdef32bbe9b4c357012d705d9b931f" cmm: Use two equality checks for two alt switch with default For code like: f 1 = e1 f 7 = e2 f _ = e3 We can treat it as a sparse jump table, check if we are outside of the range in one direction first and then start checking the values. GHC currently does this by checking for x>7, then x <= 7 and at last x == 1. This patch changes this such that we only compare for equality against the two values and jump to the default if non are equal. The resulting code is both faster and smaller. wheel-sieve1 improves by 4-8% depending on problem size. This implements the idea from #14644 Reviewers: bgamari, simonmar, simonpj, nomeata Reviewed By: simonpj, nomeata Subscribers: nomeata, simonpj, rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4294 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Jan 26 22:41:18 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 26 Jan 2018 22:41:18 -0000 Subject: [GHC] #14723: GHC 8.4.1-alpha loops infinitely when typechecking In-Reply-To: <050.41938dfcc2cea4d35c5568a864ac48d8@haskell.org> References: <050.41938dfcc2cea4d35c5568a864ac48d8@haskell.org> Message-ID: <065.89334b241e072fc7db1f3e262b6899a4@haskell.org> #14723: GHC 8.4.1-alpha loops infinitely when typechecking -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.4.1 Component: Compiler (Type | Version: 8.4.1-alpha1 checker) | Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): Hmm, perhaps we should consider reverting this commit for 8.4. It would be sad to do so, but it seems like it is causing quite some trouble. Thanks for pinpointing these, Ryan! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Jan 27 00:39:29 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 27 Jan 2018 00:39:29 -0000 Subject: [GHC] #14634: Add print stacktrace to exception handler in runtime system In-Reply-To: <046.21083643a219f66288f6ab19ce9366f2@haskell.org> References: <046.21083643a219f66288f6ab19ce9366f2@haskell.org> Message-ID: <061.a18613973dcb5de39e808f12b69a75b7@haskell.org> #14634: Add print stacktrace to exception handler in runtime system -------------------------------------+------------------------------------- Reporter: flip101 | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): > Could this handler be moved into the RTS so that i can stacktraces with exceptions just like with error? Not easily; `HasCallStack` is implemented entirely in Haskell and the RTS has no knowledge of if. Perhaps you could teach the compiler to put the "current" `CallStack` in a known location where the RTS can find it; however, at this point you arguably might as well just build with profilng as the latter is significantly less ad-hoc and likely only slightly less efficient. If the exception you are trying to identify is produced by code that you control then you could easily capture the `CallStack` from the the throwing context. This won't work for exceptions arising from, e.g., `base`, however. One alternative that is currently unimplemented is to use DWARF stack unwinding to produce callstacks. In principle we have the ability to do this now (see wiki:DWARF/Status) and wiring it up to the exception handling subsystem is "merely" a matter of deciding an approach. See wiki:Exceptions/StackTraces and #12096 for some possible options. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Jan 27 00:41:39 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 27 Jan 2018 00:41:39 -0000 Subject: [GHC] #14536: Ghc panics while building stage2 with -dstg-lint In-Reply-To: <043.07052cd8274441bc63c2d750cdfb2370@haskell.org> References: <043.07052cd8274441bc63c2d750cdfb2370@haskell.org> Message-ID: <058.d3580fe8f0b6664c240a95617a561115@haskell.org> #14536: Ghc panics while building stage2 with -dstg-lint -------------------------------------+------------------------------------- Reporter: duog | Owner: duog Type: bug | Status: patch Priority: high | Milestone: 8.6.1 Component: Compiler | Version: 8.3 Resolution: | Keywords: stg-lint Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4242 Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * priority: normal => high * milestone: => 8.6.1 Comment: Any news on this, duog? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Jan 27 00:55:31 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 27 Jan 2018 00:55:31 -0000 Subject: [GHC] #14711: Machine readable output of coverage In-Reply-To: <050.d858ad27520ca4b1ee3c013a327a8c68@haskell.org> References: <050.d858ad27520ca4b1ee3c013a327a8c68@haskell.org> Message-ID: <065.5490c883f2e13d964bb47e65bcf11ab6@haskell.org> #14711: Machine readable output of coverage -------------------------------------+------------------------------------- Reporter: Koterpillar | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Code Coverage | Version: 8.2.2 Resolution: | Keywords: newcomers Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * keywords: => newcomers -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Jan 27 01:01:55 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 27 Jan 2018 01:01:55 -0000 Subject: [GHC] #14709: Extend the plugin mechanism to access program representation In-Reply-To: <044.2e69c960decc5283f7ff746e6b782d96@haskell.org> References: <044.2e69c960decc5283f7ff746e6b782d96@haskell.org> Message-ID: <059.118dd12a941f648daad4d57fc281acd6@haskell.org> #14709: Extend the plugin mechanism to access program representation -------------------------------------+------------------------------------- Reporter: lazac | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: GHC API | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | https://phabricator.haskell.org/D4342 https://ghc.haskell.org/trac/ghc/wiki/ExtendedPluginsProposal| -------------------------------------+------------------------------------- Comment (by lazac): The plugin should be able to tell if it requires recompilation due to change in plugin arguments or external factors, and GHC should be aware when the plugin itself changes. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Jan 27 02:59:25 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 27 Jan 2018 02:59:25 -0000 Subject: [GHC] #14727: Unboxed sum performance surprisingly poor Message-ID: <045.2f36bcb58aa862841131b518b7ebd355@haskell.org> #14727: Unboxed sum performance surprisingly poor -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.2.2 Keywords: UnboxedSums | 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: -------------------------------------+------------------------------------- I tried performing worker-wrapper manually on `Data.IntMap.lookup`: {{{#!hs lookup# :: Int -> IntMap a -> (# (# #) | a #) lookup# = -- The obvious modification of the current implementation lookup :: Int -> IntMap a -> Maybe a lookup k m = case lookup# k m of (# | a #) -> Just a _ -> Nothing }}} Unfortunately, the `lookup` benchmark ''slowed down''. I verified that the benchmark indeed performs an immediate case analysis on the result (with `fromMaybe`), so it ''should'' go faster. And yet it goes slower. Caveat: I have not yet gotten things set up to be able to check with 8.4, so if there have been improvements in `UnboxedSum` performance since `8.2.2`, this may all be silly. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Jan 27 03:14:59 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 27 Jan 2018 03:14:59 -0000 Subject: [GHC] #14644: Improve cmm/assembly for pattern matches with two constants. In-Reply-To: <047.054a8f1d3e52c239a87742662b91a120@haskell.org> References: <047.054a8f1d3e52c239a87742662b91a120@haskell.org> Message-ID: <062.91b746e1f590a17bdbf767316bf356f8@haskell.org> #14644: Improve cmm/assembly for pattern matches with two constants. -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: AndreasK Type: task | Status: closed Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.2.2 (CodeGen) | Keywords: Codegen, CMM, Resolution: fixed | Patterns, Pattern Matching Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4294 Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: patch => closed * resolution: => fixed * milestone: => 8.6.1 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Jan 27 03:16:51 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 27 Jan 2018 03:16:51 -0000 Subject: [GHC] #14695: ghc --interactive error: "gcc: error: libgmp.so: No such file or directory" In-Reply-To: <043.14a5c82c2a46e2165050d731a268a622@haskell.org> References: <043.14a5c82c2a46e2165050d731a268a622@haskell.org> Message-ID: <058.e95c706bd3837c9b05fd7f19de7cb9ce@haskell.org> #14695: ghc --interactive error: "gcc: error: libgmp.so: No such file or directory" -------------------------------------+------------------------------------- Reporter: osa1 | Owner: (none) Type: bug | Status: merge Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4330 Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: patch => merge * milestone: => 8.4.1 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Jan 27 03:17:27 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 27 Jan 2018 03:17:27 -0000 Subject: [GHC] #14669: Windows binaries sometimes throw a stack overflow. In-Reply-To: <044.45c88c9a13190d9f2a70cd9b35309cc0@haskell.org> References: <044.45c88c9a13190d9f2a70cd9b35309cc0@haskell.org> Message-ID: <059.fcf16652ecdfb32ac4304ad5eb15335d@haskell.org> #14669: Windows binaries sometimes throw a stack overflow. -------------------------------------+------------------------------------- Reporter: sergv | Owner: (none) Type: bug | Status: closed Priority: highest | Milestone: 8.4.1 Component: Runtime System | Version: 8.2.1 Resolution: fixed | Keywords: Operating System: Windows | Architecture: | Unknown/Multiple Type of failure: Runtime crash | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4343 Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: patch => closed * resolution: => fixed Comment: Merged in 8fe9f262c1ded8b5a1334e5bfcd5a99fbb396289. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Jan 27 03:18:17 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 27 Jan 2018 03:18:17 -0000 Subject: [GHC] #14719: Caret diagnostics for GADT constructor error message don't span the whole constructor In-Reply-To: <050.fd67283e8ff25e6d8d4c0769f0b171e6@haskell.org> References: <050.fd67283e8ff25e6d8d4c0769f0b171e6@haskell.org> Message-ID: <065.ec6f60bdca2ffa43fccef35aab12a532@haskell.org> #14719: Caret diagnostics for GADT constructor error message don't span the whole constructor -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.2.2 Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Poor/confusing | Unknown/Multiple error message | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4344 Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: patch => closed * resolution: => fixed * milestone: => 8.4.1 Comment: Merged to 8.4 since it is just so darn simple. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Jan 27 03:58:20 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 27 Jan 2018 03:58:20 -0000 Subject: [GHC] #11735: Optimize coercionKind In-Reply-To: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> References: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> Message-ID: <062.145743109eda31a3ecbe47d4980de14e@haskell.org> #11735: Optimize coercionKind -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.10.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by goldfire): OK. I looked at `pushCoTyArg` and friends, and I have a very simple solution: just move the `isReflexiveCo` case in `addCoerce` (a local function within `Simplify.simplCast`) to the top. That should do it. Then `pushCoTyArg` is never called with a reflexive coercion, and so the `piResultTy` case won't happen. Now, `pushCoArgs` might still call `pushCoTyArg` with a reflexive coercion, but it can be taught not to as well: Have `pushCoArgs` return a `Maybe ([CoreArg], Maybe Coercion)` and `pushCoArg` return a `Maybe (CoreArg, Maybe Coercion)`. If the second return values are `Nothing`, that means that there is no cast (i.e., that the cast would have been reflexive). The only client of `pushCoArg(s)` is `exprIsConApp_maybe`, which simply omits a cast if `pushCoArgs` returns `Nothing`. Then, we never have to bother creating the reflexive coercions. This should be an easy win all around. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Jan 27 03:59:42 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 27 Jan 2018 03:59:42 -0000 Subject: [GHC] #11735: Optimize coercionKind In-Reply-To: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> References: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> Message-ID: <062.eaaee358f3b741f8d97bdff4228b7687@haskell.org> #11735: Optimize coercionKind -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.10.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by goldfire): I've taken the liberty of pushing directly to the `wip/tdammers/T11735` branch. I've done a bit of testing, and things seem OK, but a full testsuite run is surely warranted. Also, I've done no performance study of any kind, so that will surely need to be done, too. I'm curious to see what you find! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Jan 27 06:33:57 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 27 Jan 2018 06:33:57 -0000 Subject: [GHC] #14728: Is (GeneralizedNewtypeDeriving + associated type classes) completely bogus? Message-ID: <050.b01b3d3c472df373e991905eeea1c1f9@haskell.org> #14728: Is (GeneralizedNewtypeDeriving + associated type classes) completely bogus? -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 (Type checker) | Keywords: deriving, | Operating System: Unknown/Multiple TypeFamilies | Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- In Phab:D2636, I implemented this ability to use `GeneralizedNewtypeDeriving` to derive instances of type classes with associated type families. At the time, I thought the implementation was a no-brainer, but now I'm starting to have second thoughts. To explain what I mean, consider this program: {{{#!hs {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeInType #-} module Bug where import Data.Functor.Identity import Data.Kind class C (a :: Type) where type T a (x :: a) :: Type instance C () where type T () '() = Bool deriving instance C (Identity a) }}} Quite to my surprise, this typechecks. Let's consult `-ddump-deriv` to figure out what code is being generated: {{{ $ /opt/ghc/8.2.2/bin/ghci Bug.hs -ddump-deriv GHCi, version 8.2.2: http://www.haskell.org/ghc/ :? for help Loaded GHCi configuration from /home/rgscott/.ghci [1 of 1] Compiling Bug ( Bug.hs, interpreted ) ==================== Derived instances ==================== Derived class instances: instance Bug.C (Data.Functor.Identity.Identity a) where Derived type family instances: type Bug.T (Data.Functor.Identity.Identity a1_a1M3) x_a1M5 = Bug.T a1_a1M3 x_a1M5 }}} Hm... OK. Since GHC was able to generate this code, surely we should be able to write it ourselves, right? {{{#!hs {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeInType #-} module Bug where import Data.Functor.Identity import Data.Kind class C (a :: Type) where type T a (x :: a) :: Type instance C () where type T () '() = Bool -- deriving instance C (Identity a) instance C (Identity a) where type T (Identity a) x = T a x }}} {{{ $ /opt/ghc/8.2.2/bin/ghci Bug.hs GHCi, version 8.2.2: http://www.haskell.org/ghc/ :? for help Loaded GHCi configuration from /home/rgscott/.ghci [1 of 1] Compiling Bug ( Bug.hs, interpreted ) Bug.hs:19:31: error: • Occurs check: cannot construct the infinite kind: a ~ Identity a • In the second argument of ‘T’, namely ‘x’ In the type ‘T a x’ In the type instance declaration for ‘T’ | 19 | type T (Identity a) x = T a x | ^ }}} Uh-oh. GHC gets quite angry when we try to type this in ourselves, which isn't a good sign. This raises the question: just what is GHC doing in the previous version of the program? I tried to answer that question by seeing if `T (Identity a) x` could ever reduce: {{{#!hs {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeInType #-} module Bug where import Data.Functor.Identity import Data.Kind class C (a :: Type) where type T a (x :: a) :: Type instance C () where type T () '() = Bool deriving instance C (Identity a) f :: T (Identity ()) ('Identity '()) f = True }}} And lo and behold, you get: {{{ $ /opt/ghc/8.2.2/bin/ghci Bug.hs GHCi, version 8.2.2: http://www.haskell.org/ghc/ :? for help Loaded GHCi configuration from /home/rgscott/.ghci [1 of 1] Compiling Bug ( Bug.hs, interpreted ) Bug.hs:19:5: error: • Couldn't match type ‘T () ('Identity '())’ with ‘Bool’ Expected type: T (Identity ()) ('Identity '()) Actual type: Bool • In the expression: True In an equation for ‘f’: f = True | 19 | f = True | ^^^^ }}} It appears that `T (Identity ()) ('Identity '())` reduced to `T () ('Identity '())`. At that point, it becomes stuck. (Perhaps it's for the best that it's the case—if `T () ('Identity '())` managed to reduce, who knows what kind of mischief GHC could get itself into.) But all of this leads me to wonder: is something broken in the implementation of this feature, or is `GeneralizedNewtypeDeriving` simply not sound with respect to associated type families? I certainly hope that it's not the latter, as it's quite a useful feature. But at the same time, it's hard to reconcile that usefulness with the strange behavior above. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Jan 27 06:43:54 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 27 Jan 2018 06:43:54 -0000 Subject: [GHC] #14727: Unboxed sum performance surprisingly poor In-Reply-To: <045.2f36bcb58aa862841131b518b7ebd355@haskell.org> References: <045.2f36bcb58aa862841131b518b7ebd355@haskell.org> Message-ID: <060.53245be9ee02d6f8fe1865bdcacec0de@haskell.org> #14727: Unboxed sum performance surprisingly poor -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: UnboxedSums 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: | -------------------------------------+------------------------------------- Comment (by osa1): I'd make sure `lookup` is inlined, in which case allocations should be reduced. OTOH you use one more register to return two values in `lookup#` instead of one as before so that may make some things worse. It'd be helpful to see benchmark code's Cmm for both versions (with `lookup` inlined in the unboxed sums version). -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Jan 27 06:48:48 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 27 Jan 2018 06:48:48 -0000 Subject: [GHC] #14727: Unboxed sum performance surprisingly poor In-Reply-To: <045.2f36bcb58aa862841131b518b7ebd355@haskell.org> References: <045.2f36bcb58aa862841131b518b7ebd355@haskell.org> Message-ID: <060.ebace592e02dbd9d93fc3ad551a01239@haskell.org> #14727: Unboxed sum performance surprisingly poor -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: UnboxedSums 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: | -------------------------------------+------------------------------------- Comment (by dfeuer): Replying to [comment:1 osa1]: > I'd make sure `lookup` is inlined, in which case allocations should be reduced. It is inlined. I'll have to look at allocations. Of course, it's somewhat possible that performance goes down ''because'' there's less allocation, if we're unknowingly relying on the GC to improve memory layout. > OTOH you use one more register to return two values in `lookup#` instead of one as before so that may make some things worse. > > It'd be helpful to see benchmark code's Cmm for both versions (with `lookup` inlined in the unboxed sums version). I'm not sure how much you're likely to get from a Criterion benchmark. Is there a specific thing you'd like me to try dumping? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Jan 27 08:10:51 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 27 Jan 2018 08:10:51 -0000 Subject: [GHC] #14727: Unboxed sum performance surprisingly poor In-Reply-To: <045.2f36bcb58aa862841131b518b7ebd355@haskell.org> References: <045.2f36bcb58aa862841131b518b7ebd355@haskell.org> Message-ID: <060.a836a38476d8e8b48e02af3a13fb8c25@haskell.org> #14727: Unboxed sum performance surprisingly poor -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: UnboxedSums 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: | -------------------------------------+------------------------------------- Comment (by osa1): > I'm not sure how much you're likely to get from a Criterion benchmark. Is there a specific thing you'd like me to try dumping? I think looking at `lookup` in `benchmarks/IntMap.hs` (and any functions referenced by that function) would be helpful. I also think that it may be a good idea to add `{-# NOINLINE lookup #-}` in `benchmarks/IntMap.hs` just to avoid accidentally optimising the code at the use site (i.e. the benchmarking code). -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Jan 27 10:05:38 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 27 Jan 2018 10:05:38 -0000 Subject: [GHC] #14619: Output value of program changes upon compiling with -O optimizations In-Reply-To: <044.7bc7afdc77e978715c67bc6238b57042@haskell.org> References: <044.7bc7afdc77e978715c67bc6238b57042@haskell.org> Message-ID: <059.4182364e68fa9e5138ff86d6f8b3d5c6@haskell.org> #14619: Output value of program changes upon compiling with -O optimizations -------------------------------------+------------------------------------- Reporter: sheaf | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.4.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Windows | Architecture: x86_64 Type of failure: Incorrect result | (amd64) at runtime | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by AndreasK): I shrank the repo case a bit: {{{ module Main where import Prelude hiding((*>), (<*)) type V3 = (Double, Double, Double) (<+>) :: V3 -> V3 -> V3 (<+>) (_, _, z) (_, _, z') = (0,0, z+z') (<.>) :: V3 -> V3 -> Double (<.>) (x, y, z) (x', y', z') = x*x' +y*y'+z*z' {-# NOINLINE sphereIntersection #-} sphereIntersection :: V3 -> V3 -> Maybe (V3, Double) sphereIntersection orig dir@(_, _, dirz) | b < 0 = Nothing | t1 > 0 = Just (dir, dirz) | t1 < 0 = Just (orig, dirz) | otherwise = Nothing where b = orig <.> dir sqrtDisc = sqrt b t1 = b - sqrtDisc main = print . fmap fst $ sphereIntersection (0, 0, 200) (0, 0, 1) }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Jan 27 10:46:09 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 27 Jan 2018 10:46:09 -0000 Subject: [GHC] #14606: ghc-exactprint not up to date In-Reply-To: <044.eda8c95560814c75d9806634f1da14ed@haskell.org> References: <044.eda8c95560814c75d9806634f1da14ed@haskell.org> Message-ID: <059.b8c843b6c457aa88bcfbaeb41ec68b01@haskell.org> #14606: ghc-exactprint not up to date -------------------------------------+------------------------------------- Reporter: alanz | Owner: alanz Type: task | Status: new Priority: normal | Milestone: 8.4.1 Component: GHC API | Version: 8.4.1-alpha1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by alanz): Round trip tests showed up a couple of issues, now fixed. So all is good. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Jan 27 10:46:32 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 27 Jan 2018 10:46:32 -0000 Subject: [GHC] #14606: ghc-exactprint not up to date In-Reply-To: <044.eda8c95560814c75d9806634f1da14ed@haskell.org> References: <044.eda8c95560814c75d9806634f1da14ed@haskell.org> Message-ID: <059.9026b76435c876f4699480a97f2aad0b@haskell.org> #14606: ghc-exactprint not up to date -------------------------------------+------------------------------------- Reporter: alanz | Owner: alanz Type: task | Status: closed Priority: normal | Milestone: 8.4.1 Component: GHC API | Version: 8.4.1-alpha1 Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by alanz): * status: new => closed * resolution: => fixed -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Jan 27 10:46:44 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 27 Jan 2018 10:46:44 -0000 Subject: [GHC] #14619: Output value of program changes upon compiling with -O optimizations In-Reply-To: <044.7bc7afdc77e978715c67bc6238b57042@haskell.org> References: <044.7bc7afdc77e978715c67bc6238b57042@haskell.org> Message-ID: <059.409e5fc04345b6104947ca707202734b@haskell.org> #14619: Output value of program changes upon compiling with -O optimizations -------------------------------------+------------------------------------- Reporter: sheaf | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.4.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Windows | Architecture: x86_64 Type of failure: Incorrect result | (amd64) at runtime | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by AndreasK): > I think it's a Core pass eliminating a value it shouldn't. The STG dumps are exactly the same so we can rule that out for better or worse. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Jan 27 15:47:51 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 27 Jan 2018 15:47:51 -0000 Subject: [GHC] #14709: Extend the plugin mechanism to access program representation In-Reply-To: <044.2e69c960decc5283f7ff746e6b782d96@haskell.org> References: <044.2e69c960decc5283f7ff746e6b782d96@haskell.org> Message-ID: <059.8f8663e25dec9d16c6b0fc8617ea2082@haskell.org> #14709: Extend the plugin mechanism to access program representation -------------------------------------+------------------------------------- Reporter: lazac | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: GHC API | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | https://phabricator.haskell.org/D4342 https://ghc.haskell.org/trac/ghc/wiki/ExtendedPluginsProposal| -------------------------------------+------------------------------------- Comment (by ezyang): This doesn't really have anything to do with the relative merits/demerits of the proposal, but I just wanted to point out: > ​Frontend plugins are not applicable, because their usage changes the major mode of the compiler. So if the tool developer wants to go on with the compilation procedure, he must replicate what GHC would do if the frontend plugin was not used. Furthermore, it can't be inserted into a normal build environment, since using the --frontend flag clashes with other mode flags like --make or --interactive. Out of the box these statements are true, but as I mention in http://blog.ezyang.com/2017/02/how-to-integrate-ghc-api-programs-with- cabal/ there are some relatively simple tricks you can play to solve this problem. As another example, https://github.com/ezyang/ghc-shake comes with a wrapper program which overrides the meaning of `--make` but otherwise keeps all other major modes the same. Of course, if the frontend plugin is replacing a mode like `--make`, it needs to understand all of the same arguments that `--make` would have understood, but that is what you would expect, no? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Jan 27 15:53:16 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 27 Jan 2018 15:53:16 -0000 Subject: [GHC] #14728: Is (GeneralizedNewtypeDeriving + associated type classes) completely bogus? In-Reply-To: <050.b01b3d3c472df373e991905eeea1c1f9@haskell.org> References: <050.b01b3d3c472df373e991905eeea1c1f9@haskell.org> Message-ID: <065.f4ce9d78fcfe18d7821bf7d9430d071c@haskell.org> #14728: Is (GeneralizedNewtypeDeriving + associated type classes) completely bogus? -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.2.2 checker) | Keywords: deriving, Resolution: | TypeFamilies Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): Sure enough, slightly tweaking the third program can tickle a Core Lint error: {{{#!hs {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeInType #-} module Bug where import Data.Functor.Identity import Data.Kind class C (a :: Type) where type T a (x :: a) :: Type instance C () where type T () '() = Bool deriving instance C (Identity a) f :: T (Identity ()) ('Identity '()) f = undefined }}} {{{ $ /opt/ghc/8.2.2/bin/ghc Bug.hs -dcore-lint [1 of 1] Compiling Bug ( Bug.hs, Bug.o ) *** Core Lint errors : in result of Desugar (after optimization) *** : warning: In the expression: undefined @ 'LiftedRep @ (T () ('Identity '())) $dIP_a2e7 Kind application error in type ‘T () ('Identity '())’ Function kind = forall a -> a -> * Arg kinds = [((), *), ('Identity '(), Identity ())] Bug.hs:19:1: warning: [RHS of f :: T (Identity ()) ('Identity '())] @ a2_a1bw is out of scope *** Offending Program *** $fC() [InlPrag=CONLIKE] :: C () [LclIdX[DFunId], Unf=DFun: \ -> C:C TYPE: ()] $fC() = C:C @ () $fCIdentity [InlPrag=CONLIKE] :: forall a. C (Identity a) [LclIdX[DFunId], Unf=DFun: \ (@ a_aWB) -> C:C TYPE: Identity a_aWB] $fCIdentity = \ (@ a_a2ea) -> C:C @ (Identity a_a2ea) $trModule :: Module [LclIdX] $trModule = Module (TrNameS "main"#) (TrNameS "Bug"#) $krep_a2pm [InlPrag=[~]] :: KindRep [LclId] $krep_a2pm = KindRepTyConApp $tcConstraint ([] @ KindRep) $krep_a2pl [InlPrag=[~]] :: KindRep [LclId] $krep_a2pl = KindRepFun krep$* $krep_a2pm $krep_a2po [InlPrag=[~]] :: KindRep [LclId] $krep_a2po = $WKindRepVar (I# 0#) $tcC :: TyCon [LclIdX] $tcC = TyCon 12754692886077552850## 18375870125396612007## $trModule (TrNameS "C"#) 0# $krep_a2pl $krep_a2pn [InlPrag=[~]] :: KindRep [LclId] $krep_a2pn = KindRepTyConApp $tcC (: @ KindRep $krep_a2po ([] @ KindRep)) $tc'C:C :: TyCon [LclIdX] $tc'C:C = TyCon 302756782745842909## 14248103394115774781## $trModule (TrNameS "'C:C"#) 1# $krep_a2pn $dIP_a2e7 :: HasCallStack [LclId] $dIP_a2e7 = (pushCallStack (unpackCString# "undefined"#, SrcLoc (unpackCString# "main"#) (unpackCString# "Bug"#) (unpackCString# "Bug.hs"#) (I# 19#) (I# 5#) (I# 19#) (I# 14#)) ((emptyCallStack `cast` (Sym (N:IP[0] <"callStack">_N _N) :: (CallStack :: *) ~R# ((?callStack::CallStack) :: Constraint))) `cast` (N:IP[0] <"callStack">_N _N :: ((?callStack::CallStack) :: Constraint) ~R# (CallStack :: *)))) `cast` (Sym (N:IP[0] <"callStack">_N _N) :: (CallStack :: *) ~R# ((?callStack::CallStack) :: Constraint)) f :: T (Identity ()) ('Identity '()) [LclIdX] f = (undefined @ 'LiftedRep @ (T () ('Identity '())) $dIP_a2e7) `cast` (Sub (Sym (R:TIdentityx[0] <()>_N _N <'Identity '()>_N)) :: (T () ('Identity '()) :: *) ~R# (T (Identity ()) ('Identity '()) :: *)) *** End of Offense *** : error: Compilation had errors }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Jan 27 18:37:57 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 27 Jan 2018 18:37:57 -0000 Subject: [GHC] #14728: Is (GeneralizedNewtypeDeriving + associated type classes) completely bogus? In-Reply-To: <050.b01b3d3c472df373e991905eeea1c1f9@haskell.org> References: <050.b01b3d3c472df373e991905eeea1c1f9@haskell.org> Message-ID: <065.90f39362439ca6372bbfbfa471b38d80@haskell.org> #14728: Is (GeneralizedNewtypeDeriving + associated type classes) completely bogus? -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.2.2 checker) | Keywords: deriving, Resolution: | TypeFamilies Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): I can see two ways out of this mess: 1. We should kind-check associated type family instances that are generated in derived code. This would have caught these mistakes early (and just seems like a good idea in general). Currently, we simply generate `Type`s directly in `TcGenDeriv`, so we have to take it on faith that `TcGenDeriv` is doing the right thing. 2. Disallow occurrences of the derived class's last type parameter as a //kind// within an associated type family. I believe the sketchiness witnesses above only happens when this criterion is met, so we could just disallow that wholesale. One downside is that there would actually be a small class of programs that would be ruled out by this restriction. Namely: {{{#!hs {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeInType #-} {-# LANGUAGE UndecidableInstances #-} module Bug where import Data.Kind class C (a :: Type) where type T a (x :: a) :: Type newtype Loop = Loop Loop deriving instance C Loop }}} This currently compiles (and genuinely kind-checks), but would fail to compile if we instituted the aforementioned kind validity check. But this isn't too much of a loss, as actually trying to use the `T` instance for `Loop` would, well, infinitely loop. :) Option (2) sounds much simpler, so I think I'd be inclined to favor that for the time being. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Jan 27 18:41:48 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 27 Jan 2018 18:41:48 -0000 Subject: [GHC] #14728: Is (GeneralizedNewtypeDeriving + associated type classes) completely bogus? In-Reply-To: <050.b01b3d3c472df373e991905eeea1c1f9@haskell.org> References: <050.b01b3d3c472df373e991905eeea1c1f9@haskell.org> Message-ID: <065.8cd3620e988091a8d13c94f5ad7e42a2@haskell.org> #14728: Is (GeneralizedNewtypeDeriving + associated type classes) completely bogus? -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.2.2 checker) | Keywords: deriving, Resolution: | TypeFamilies Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by goldfire): `type T (Identity a) x = T a x` is ill-kinded, sure enough. Let's write out the details: {{{ Identity :: Type -> Type 'Identity :: forall (a :: Type). a -> Identity a T :: pi (x :: Type) -> x -> Type type instance forall (a :: Type) (x :: Identity a). T (Identity a) x = T a x }}} In the last line, the `x` has the wrong kind: it has kind `Identity a`, where it really should have kind `a`. Here's the correct type instance: {{{ type instance forall (a :: Type) (x :: Identity a). T (Identity a) x = T a ('runIdentity x) }}} where I've used `'` to use the term-level `runIdentity` function in a type. I don't think this would be impossible to support. Currently, the `deriving` mechanism produces HsSyn. I suppose that makes it easier w.r.t. inferring contexts and such. But suppose we could write the RHS of type instances in Core, and use `HsCoreTy` to embed it into HsSyn. Then, `runIdentity` is just a cast by the axiom induced by the `Identity` newtype. But it gets more complicated, sadly. {{{ class D a where type S a (x :: Maybe a) deriving instance D (Identity a) }}} This would need to produce {{{ type instance forall (a :: Type) (x :: Maybe (Identity a)). S (Identity a) x = S a (x |> g) where g :: Maybe (Identity a) ~ Maybe a g = Maybe axIdentity }}} This example shows us that just using the newtype axiom isn't enough. We need to take the type of `x`, find all occurrences of `a` in it, and rewrite those to be `axIdentity` instead. Happily, GHC already has implemented this operation: it's called `Coercion.liftCoSubst`. A detailed explanation of lifting is in the "System FC with Explicit Kind Equalities" paper (among other places, I think). It's useful when you have a coercion between `ty1` and `ty2` (in our case, the newtype axiom) and you need a coercion between `ty3[ty1/a]` and `ty3[ty2/a]` -- precisely our scenario. But it gets even worse. Suppose now later parameters to the type family depend on `x`. These will have to account for the change in `x`'s type. So we need a coercion relating the old `x` to the new, casted `x`, which will then be used to cast those later parameters. Happily, I've already worked out the algorithm to deal with this more general case, and I've implemented it in my branch (github.com/goldfirere/ghc, on the wip/rae branch), in `TcFlatten.flatten_args`. This branch is not merged due to performance trouble, but the algorithm is correct. Actually, as I'm writing this all up, I realize that `FamInstEnv.normaliseType` is behind the times here. It, too, needs to take all of these challenges into account in order to produce a well- kinded output. I'll post a new bug to this effect. Is it worth doing all of these here, for GND? Probably not. And I think the idea of "just don't allow this" may be best. However, it's good to know that we ''could'' do this if we wanted. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Jan 27 18:44:37 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 27 Jan 2018 18:44:37 -0000 Subject: [GHC] #14729: normaliseType is not well-kinded Message-ID: <047.efda82c1cfd056232e208bfdc783f3d1@haskell.org> #14729: normaliseType is not well-kinded -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.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: -------------------------------------+------------------------------------- Suppose we have {{{ Proxy :: forall k. k -> Type type family F a type instance F Int = Bool }}} and we're trying to normalise the target {{{ Proxy (F Int) x }}} Clearly, for this target to be well kinded, we need `x :: F Int`. Currently, the output of `normaliseType` is `Proxy Bool x`, which is just plain wrong. I need to implement logic like in `flatten_args` on [https://github.com/goldfirere/ghc my branch] in `normaliseType` to fix this. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Jan 27 18:48:37 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 27 Jan 2018 18:48:37 -0000 Subject: [GHC] #14728: Is (GeneralizedNewtypeDeriving + associated type classes) completely bogus? In-Reply-To: <050.b01b3d3c472df373e991905eeea1c1f9@haskell.org> References: <050.b01b3d3c472df373e991905eeea1c1f9@haskell.org> Message-ID: <065.7a087112e610b09d7e58af7250965258@haskell.org> #14728: Is (GeneralizedNewtypeDeriving + associated type classes) completely bogus? -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.2.2 checker) | Keywords: deriving, Resolution: | TypeFamilies Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): Replying to [comment:3 goldfire]: > Here's the correct type instance: > > {{{ > type instance forall (a :: Type) (x :: Identity a). T (Identity a) x = T a ('runIdentity x) > }}} > > where I've used `'` to use the term-level `runIdentity` function in a type. This requires Dependent Haskell, I presume? > I don't think this would be impossible to support. Currently, the `deriving` mechanism produces HsSyn. I suppose that makes it easier w.r.t. inferring contexts and such. But suppose we could write the RHS of type instances in Core, and use `HsCoreTy` to embed it into HsSyn. Then, `runIdentity` is just a cast by the axiom induced by the `Identity` newtype. One correction: `deriving` only uses HsSyn for derived //methods//. It does in fact generate `Core` for the RHS of type instances. So what you describe might be possible today? (I'm not sure I follow the other details, so it's hard for me to say.) > This would need to produce > > {{{ > type instance forall (a :: Type) (x :: Maybe (Identity a)). S (Identity a) x = S a (x |> g) > where > g :: Maybe (Identity a) ~ Maybe a > g = Maybe axIdentity > }}} `axIdentity`? What sorcery is this? > Actually, as I'm writing this all up, I realize that `FamInstEnv.normaliseType` is behind the times here. It, too, needs to take all of these challenges into account in order to produce a well- kinded output. I'll post a new bug to this effect. Interesting. Is there a program that exhibits this bug (that doesn't leverage this GND business)? > Is it worth doing all of these here, for GND? Probably not. And I think the idea of "just don't allow this" may be best. However, it's good to know that we ''could'' do this if we wanted. Indeed. And we could quite easily change this design in the future, so I'm not too worried about being conservative for now. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Jan 27 18:48:51 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 27 Jan 2018 18:48:51 -0000 Subject: [GHC] #12690: Segmentation fault in GHC runtime system under low memory with USE_LARGE_ADDRESS_SPACE In-Reply-To: <050.65e9f032446da5356b615bc9d51ff90f@haskell.org> References: <050.65e9f032446da5356b615bc9d51ff90f@haskell.org> Message-ID: <065.4744e7dfcdec04523022b9b57b13d6ab@haskell.org> #12690: Segmentation fault in GHC runtime system under low memory with USE_LARGE_ADDRESS_SPACE -----------------------------------+-------------------------------------- Reporter: pggiarrusso | Owner: (none) Type: bug | Status: closed Priority: high | Milestone: 8.2.2 Component: Runtime System | Version: 8.0.1 Resolution: duplicate | Keywords: Operating System: Linux | Architecture: x86_64 (amd64) Type of failure: Runtime crash | Test Case: Blocked By: | Blocking: Related Tickets: #14329 | Differential Rev(s): Wiki Page: | -----------------------------------+-------------------------------------- Changes (by bgamari): * status: new => closed * resolution: => duplicate * related: => #14329 * milestone: => 8.2.2 Comment: I believe I fixed this in #14329. However, we still see segmentation faults due to low memory conditions on Harbormaster. Continuing investigation on #14329. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Jan 27 18:50:23 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 27 Jan 2018 18:50:23 -0000 Subject: [GHC] #14329: GHC 8.2.1 segfaults while bootstrapping master In-Reply-To: <046.2503a1f6f14456a42761d49ce89e96f2@haskell.org> References: <046.2503a1f6f14456a42761d49ce89e96f2@haskell.org> Message-ID: <061.4985ff566b4f308da4756dd213bcdad8@haskell.org> #14329: GHC 8.2.1 segfaults while bootstrapping master -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.2.2 Component: Compiler | Version: 8.2.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4075 Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: closed => new * resolution: fixed => Comment: It looks like the issue fixed in comment:2 isn't the only problem. We are still seeing segmentation faults on Harbormaster due to out-of-memory conditions. For instance, {{{ (gdb) run Starting program: /home/ben/ghc/inplace/lib/bin/ghc-stage1 -B/home/ben/ghc/inplace/lib -hisuf hi -osuf o -hcsuf hc -static -O0 -H64m -Wall -fllvm-fill-undef-with-garbage -Werror -Iincludes -Iincludes/dist -Iincludes/dist-derivedconstants/header -Iincludes/dist- ghcconstants/header -this-unit-id ghc-8.5 -hide-all-packages -i -icompiler/backpack -icompiler/basicTypes -icompiler/cmm -icompiler/codeGen -icompiler/coreSyn -icompiler/deSugar -icompiler/ghci -icompiler/hsSyn -icompiler/iface -icompiler/llvmGen -icompiler/main -icompiler/nativeGen -icompiler/parser -icompiler/prelude -icompiler/profiling -icompiler/rename -icompiler/simplCore -icompiler/simplStg -icompiler/specialise -icompiler/stgSyn -icompiler/stranal -icompiler/typecheck -icompiler/types -icompiler/utils -icompiler/vectorise -icompiler/stage2/build -Icompiler/stage2/build -icompiler/stage2/build/./autogen -Icompiler/stage2/build/./autogen -Icompiler/. -Icompiler/parser -Icompiler/utils -Icompiler/../rts/dist/build -Icompiler/stage2 -optP-DGHCI -optP-include -optPcompiler/stage2/build/./autogen/cabal_macros.h -package-id base-4.11.0.0 -package-id deepseq-1.4.3.0 -package-id directory-1.3.1.5 -package-id process-1.6.2.0 -package-id bytestring-0.10.8.2 -package-id binary-0.8.5.1 -package-id time-1.8.0.2 -package-id containers-0.5.10.2 -package-id array-0.5.2.0 -package-id filepath-1.4.1.2 -package-id template-haskell-2.13.0.0 -package-id hpc-0.6.0.3 -package-id transformers-0.5.5.0 -package-id ghc-boot-8.5 -package-id ghc-boot-th-8.5 -package-id ghci-8.5 -package-id unix-2.7.2.2 -package-id terminfo-0.4.1.1 -Wall -Wno-name-shadowing -Wnoncanonical-monad-instances -Wnoncanonical- monadfail-instances -Wnoncanonical-monoid-instances -this-unit-id ghc -XHaskell2010 -XNoImplicitPrelude -optc-DTHREADED_RTS -DGHCI_TABLES_NEXT_TO_CODE -DSTAGE=2 -Rghc-timing -O -dcore-lint -dno- debug-output -Wcpp-undef -no-user-package-db -rtsopts -Wnoncanonical- monad-instances -odir compiler/stage2/build -hidir compiler/stage2/build -stubdir compiler/stage2/build -dynamic-too -c compiler/types/OptCoercion.hs -o compiler/stage2/build/OptCoercion.o -dyno compiler/stage2/build/OptCoercion.dyn_o -fforce-recomp [Thread debugging using libthread_db enabled] Using host libthread_db library "/lib/x86_64-linux-gnu/libthread_db.so.1". Program received signal SIGSEGV, Segmentation fault. ---Type to continue, or q to quit--- 0x0000000002fcfe40 in alloc_mega_group () (gdb) bt #0 0x0000000002fcfe40 in alloc_mega_group () #1 0x0000000002fd038d in allocGroupOnNode () #2 0x0000000002fe3dff in alloc_todo_block () #3 0x0000000002fe3f56 in todo_block_full () #4 0x0000000000406497 in evacuate () #5 0x00000000004074ec in scavenge_block () #6 0x0000000002fe3726 in scavenge_loop () #7 0x0000000002fd0ed8 in GarbageCollect () #8 0x0000000002fc5eeb in scheduleDoGC () #9 0x0000000002fc68ce in scheduleWaitThread () #10 0x0000000002fcf010 in hs_main () #11 0x0000000000422684 in main () (gdb) }}} while building 1cb12eae648c964c411f4c83730f3db05e409f48. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Jan 27 18:50:42 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 27 Jan 2018 18:50:42 -0000 Subject: [GHC] #14329: GHC 8.2.1 segfaults while bootstrapping master In-Reply-To: <046.2503a1f6f14456a42761d49ce89e96f2@haskell.org> References: <046.2503a1f6f14456a42761d49ce89e96f2@haskell.org> Message-ID: <061.e385104715ab947d58cc47a1423bdf7a@haskell.org> #14329: GHC 8.2.1 segfaults while bootstrapping master -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.2.2 Component: Compiler | Version: 8.2.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #12960, #9065 | Differential Rev(s): Phab:D4075 Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * related: => #12960, #9065 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Jan 27 18:51:43 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 27 Jan 2018 18:51:43 -0000 Subject: [GHC] #14329: GHC 8.2.1 segfaults while bootstrapping master In-Reply-To: <046.2503a1f6f14456a42761d49ce89e96f2@haskell.org> References: <046.2503a1f6f14456a42761d49ce89e96f2@haskell.org> Message-ID: <061.6c02b75fc2d63c7bdafd62ff6853b5f4@haskell.org> #14329: GHC 8.2.1 segfaults while bootstrapping master -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.2.2 Component: Compiler | Version: 8.2.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #12960, #9065, | Differential Rev(s): Phab:D4075 #7762 | Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * related: #12960, #9065 => #12960, #9065, #7762 Comment: Unfortunately the issue only happens less than one in ten runs even under rather strong memory pressure. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Jan 27 19:36:34 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 27 Jan 2018 19:36:34 -0000 Subject: [GHC] #14729: normaliseType is not well-kinded In-Reply-To: <047.efda82c1cfd056232e208bfdc783f3d1@haskell.org> References: <047.efda82c1cfd056232e208bfdc783f3d1@haskell.org> Message-ID: <062.d392999077076a2bc650187ec32d1fdb@haskell.org> #14729: normaliseType is not well-kinded -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * cc: RyanGlScott (added) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Jan 27 19:37:32 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 27 Jan 2018 19:37:32 -0000 Subject: [GHC] #14728: Is (GeneralizedNewtypeDeriving + associated type classes) completely bogus? In-Reply-To: <050.b01b3d3c472df373e991905eeea1c1f9@haskell.org> References: <050.b01b3d3c472df373e991905eeea1c1f9@haskell.org> Message-ID: <065.0a471956c47555211585ebf305d38ea3@haskell.org> #14728: Is (GeneralizedNewtypeDeriving + associated type classes) completely bogus? -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.2.2 checker) | Keywords: deriving, Resolution: | TypeFamilies Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): And by "What sorcery is this", I mean: can the user write this incantation themselves? Or are these magicks that are only accessible in Core? > Is there a program that exhibits this bug (that doesn't leverage this GND business)? This question was answered in #14729. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Jan 27 19:51:50 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 27 Jan 2018 19:51:50 -0000 Subject: [GHC] #14619: Output value of program changes upon compiling with -O optimizations In-Reply-To: <044.7bc7afdc77e978715c67bc6238b57042@haskell.org> References: <044.7bc7afdc77e978715c67bc6238b57042@haskell.org> Message-ID: <059.b387ab6c7eb59fccfbca1c0b159db79c@haskell.org> #14619: Output value of program changes upon compiling with -O optimizations -------------------------------------+------------------------------------- Reporter: sheaf | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.4.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Windows | Architecture: x86_64 Type of failure: Incorrect result | (amd64) at runtime | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by AndreasK): I think the sinking pass is fine, the code below fails: {{{ c3Yz: // global _s3Wg::F64 = %MO_F_Add_W64(%MO_F_Add_W64(%MO_F_Mul_W64(D1, D4), %MO_F_Mul_W64(D2, D5)), %MO_F_Mul_W64(D3, D6)); if (%MO_F_Lt_W64(_s3Wg::F64, 0.0 :: W64)) goto c3Zq; else goto c3Zp; c3Zp: // global _s3We::F64 = D5; _s3Wd::F64 = D4; _s3Wc::F64 = D3; _s3Wb::F64 = D2; _s3Wa::F64 = D1; (_c3YT::F64) = call MO_F64_Sqrt(_s3Wg::F64); _s3Wn::F64 = %MO_F_Sub_W64(_s3Wg::F64, _c3YT::F64); if (%MO_F_Gt_W64(_s3Wn::F64, 0.0 :: W64)) goto c3Zn; else goto c3Zi; c3Zn: // global I64[Hp - 40] = GHC.Types.D#_con_info; F64[Hp - 32] = D6; I64[Hp - 24] = GHC.Types.D#_con_info; F64[Hp - 16] = _s3We::F64; I64[Hp - 8] = GHC.Types.D#_con_info; F64[Hp] = _s3Wd::F64; R3 = Hp - 39; R2 = Hp - 23; R1 = Hp - 7; call (P64[Sp])(R3, R2, R1) args: 8, res: 0, upd: 8; ... }}} If we respect the calling convention and MO_F_Add/Mul don't clobber their arguments the code would be fine. I guess the liveness analysis when assigning registers thinks sqrt clobbers D6/xmm6 anyway so it's free to use it as a scratch register before that. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Jan 27 20:02:00 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 27 Jan 2018 20:02:00 -0000 Subject: [GHC] #14728: Is (GeneralizedNewtypeDeriving + associated type classes) completely bogus? In-Reply-To: <050.b01b3d3c472df373e991905eeea1c1f9@haskell.org> References: <050.b01b3d3c472df373e991905eeea1c1f9@haskell.org> Message-ID: <065.e746583494367c2ddeb2bb2947f357c7@haskell.org> #14728: Is (GeneralizedNewtypeDeriving + associated type classes) completely bogus? -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.2.2 checker) | Keywords: deriving, Resolution: | TypeFamilies Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by goldfire): Good about generating Core for type instances. Then this is all doable today. `axIdentity` is the newtype axiom that comes into being when a user declares a newtype. It can be accessed by `coerce`, but is mostly internal magic. Specifically, if you write {{{ newtype N a b c = MkN (some_type) }}} then we get {{{ axN :: N a b c ~R some_type }}} as an axiom (type `CoAxiom` in GHC). -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Jan 27 20:07:34 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 27 Jan 2018 20:07:34 -0000 Subject: [GHC] #14728: Is (GeneralizedNewtypeDeriving + associated type classes) completely bogus? In-Reply-To: <050.b01b3d3c472df373e991905eeea1c1f9@haskell.org> References: <050.b01b3d3c472df373e991905eeea1c1f9@haskell.org> Message-ID: <065.a517df4432a7ce29504c1ee2c7f1e60c@haskell.org> #14728: Is (GeneralizedNewtypeDeriving + associated type classes) completely bogus? -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.2.2 checker) | Keywords: deriving, Resolution: | TypeFamilies Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): Replying to [comment:6 goldfire]: > Good about generating Core for type instances. Then this is all doable today. That's great! I can't claim to know where to proceed from here, though—the details of pushing this cast through axioms is still quite fuzzy to me. Is this blocked (at least partially) on getting your branch merged and/or fixing #14729? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Jan 27 20:15:19 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 27 Jan 2018 20:15:19 -0000 Subject: [GHC] #14730: Missing predicate for "ResourceVanished" IOException/IOErrorType Message-ID: <042.eb1cc133c5b1a8fac6a6fb09aaf9f414@haskell.org> #14730: Missing predicate for "ResourceVanished" IOException/IOErrorType -------------------------------------+------------------------------------- Reporter: bit | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: | Version: 8.2.2 libraries/base | 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: -------------------------------------+------------------------------------- `IOErrorType` has a "`ResourceVanished`" constructor: https://hackage.haskell.org/package/base-4.10.1.0/docs/src/GHC.IO.Exception.html#IOErrorType But there is no way to detect this for an `IOException` or `IOErrorType`. Here is some real-world code I found, where the author wants to catch "`ResourceVanished`", but resorts to catching all `IOException`: https://hackage.haskell.org/package/http-client-tls-0.3.5.1/docs/src /Network-HTTP-Client-TLS.html#convertConnection Docs for `hPutBuf` also mention the public existence of "`ResourceVanished`": https://hackage.haskell.org/package/base-4.10.1.0/docs/GHC-IO- Handle.html#v:hPutBuf Suggestion: We need to add functions: {{{#!haskell isResourceVanished :: IOError -> Bool resourceVanishedErrorType :: IOErrorType isResourceVanishedErrorType :: IOErrorType -> Bool }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Jan 27 20:45:42 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 27 Jan 2018 20:45:42 -0000 Subject: [GHC] #14661: Cannot derive (newtype I a b = I (F a -> F b) deriving newtype Category) for type family F In-Reply-To: <051.db51abc527e2395586903121a4d671be@haskell.org> References: <051.db51abc527e2395586903121a4d671be@haskell.org> Message-ID: <066.22353565034409ccf8b7e9686594731d@haskell.org> #14661: Cannot derive (newtype I a b = I (F a -> F b) deriving newtype Category) for type family F -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: feature request | Status: closed Priority: normal | Milestone: Component: Compiler | Version: 8.4.1-alpha1 Resolution: wontfix | Keywords: | DerivingStrategies, deriving, | TypeFamilies Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Iceland_jack): Here is an interesting one: {{{#!hs class ListLike f where nil :: f a cons :: a -> f a -> f a (·) :: f a -> f a -> f a newtype LL a = LL (forall zz. ListLike zz => zz a) }}} You can implement (but not derive) `ListLike LL`: {{{#!hs instance ListLike LL where nil :: LL a nil = LL nil cons :: a -> LL a -> LL a cons a (LL as) = LL (cons a as) (·) :: LL a -> LL a -> LL a LL as · LL bs = LL (as · bs) }}} I'll add further examples to this [https://gist.github.com/Icelandjack/b1185398719f5932b6906396fb67a9f9 gist]. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Jan 27 21:22:29 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 27 Jan 2018 21:22:29 -0000 Subject: [GHC] #14730: Missing predicate for "ResourceVanished" IOException/IOErrorType In-Reply-To: <042.eb1cc133c5b1a8fac6a6fb09aaf9f414@haskell.org> References: <042.eb1cc133c5b1a8fac6a6fb09aaf9f414@haskell.org> Message-ID: <057.36d0ebb9e7d8f897fdc6509954d043bf@haskell.org> #14730: Missing predicate for "ResourceVanished" IOException/IOErrorType -------------------------------------+------------------------------------- Reporter: bit | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: libraries/base | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): Looks like there is indeed a gap here. Would you care to offer a patch? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Jan 27 21:40:36 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 27 Jan 2018 21:40:36 -0000 Subject: [GHC] #14619: Output value of program changes upon compiling with -O optimizations In-Reply-To: <044.7bc7afdc77e978715c67bc6238b57042@haskell.org> References: <044.7bc7afdc77e978715c67bc6238b57042@haskell.org> Message-ID: <059.d994bb052dbc4d58b85dfdc92add6171@haskell.org> #14619: Output value of program changes upon compiling with -O optimizations -------------------------------------+------------------------------------- Reporter: sheaf | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.4.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Windows | Architecture: x86_64 Type of failure: Incorrect result | (amd64) at runtime | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by AndreasK): GHC-8.2 does mess up the register allocation/calling convention on the foreign call to sqrt. {{{ call sqrt # born: %r3 ... %r29 %r30 %r31 ... # w_dying: %r0 ... %r29 %r31 ... }}} The bad news is that there is a good chance that it only works on head because we use the sqrt assembly instruction instead which sidesteps the issue. {{{ ... sqrtsd %vSSE_s3Lt,%vSSE_c3O1 # born: %vSSE_c3O1 ... }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Jan 27 21:48:09 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 27 Jan 2018 21:48:09 -0000 Subject: [GHC] #11735: Optimize coercionKind In-Reply-To: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> References: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> Message-ID: <062.b735cd1194400e13222106670038219f@haskell.org> #11735: Optimize coercionKind -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.10.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by goldfire): OK. I've fixed a few testsuite failures. I think this is probably correct now. (CircleCI reports a bunch of errors in `profiling`, but I can't repro locally.) What happens when you benchmark? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Jan 27 22:30:13 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 27 Jan 2018 22:30:13 -0000 Subject: [GHC] #14729: normaliseType is not well-kinded In-Reply-To: <047.efda82c1cfd056232e208bfdc783f3d1@haskell.org> References: <047.efda82c1cfd056232e208bfdc783f3d1@haskell.org> Message-ID: <062.3706ad72c88da37d7419f6c59274dceb@haskell.org> #14729: normaliseType is not well-kinded -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by Iceland_jack): * cc: Iceland_jack (added) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Jan 27 22:31:17 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 27 Jan 2018 22:31:17 -0000 Subject: [GHC] #14728: Is (GeneralizedNewtypeDeriving + associated type classes) completely bogus? In-Reply-To: <050.b01b3d3c472df373e991905eeea1c1f9@haskell.org> References: <050.b01b3d3c472df373e991905eeea1c1f9@haskell.org> Message-ID: <065.266b2d00ed999aeb08ead173c3a4f7be@haskell.org> #14728: Is (GeneralizedNewtypeDeriving + associated type classes) completely bogus? -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.2.2 checker) | Keywords: deriving, Resolution: | TypeFamilies Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by Iceland_jack): * cc: Iceland_jack (added) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Jan 27 22:45:34 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 27 Jan 2018 22:45:34 -0000 Subject: [GHC] #14619: Output value of program changes upon compiling with -O optimizations In-Reply-To: <044.7bc7afdc77e978715c67bc6238b57042@haskell.org> References: <044.7bc7afdc77e978715c67bc6238b57042@haskell.org> Message-ID: <059.637ac2f19c12c1bebaf4ba37274bc1c7@haskell.org> #14619: Output value of program changes upon compiling with -O optimizations -------------------------------------+------------------------------------- Reporter: sheaf | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.4.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Windows | Architecture: x86_64 Type of failure: Incorrect result | (amd64) at runtime | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by AndreasK): When checking for invalidated registers we use callClobberedRegs. However this is the definition for Windows: {{{ | platformOS platform == OSMinGW32 = [rax,rcx,rdx,r8,r9,r10,r11] ++ map regSingle (floatregnos platform) }}} Which just lists ALL floating point registers. Instead we should use the information provided in CodeGen.Platform to check if they are callee-saved or not and let good things happen. I will put a patch up in the next few days. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Jan 27 22:46:22 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 27 Jan 2018 22:46:22 -0000 Subject: [GHC] #14619: Output value of program changes upon compiling with -O optimizations In-Reply-To: <044.7bc7afdc77e978715c67bc6238b57042@haskell.org> References: <044.7bc7afdc77e978715c67bc6238b57042@haskell.org> Message-ID: <059.a67978b455d7d28efdfcdd3e42f2469e@haskell.org> #14619: Output value of program changes upon compiling with -O optimizations -------------------------------------+------------------------------------- Reporter: sheaf | Owner: AndreasK Type: bug | Status: new Priority: highest | Milestone: 8.4.1 Component: Compiler | Version: 8.2.2 (CodeGen) | Resolution: | Keywords: Operating System: Windows | Architecture: x86_64 Type of failure: Incorrect result | (amd64) at runtime | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by AndreasK): * owner: (none) => AndreasK * component: Compiler => Compiler (CodeGen) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Jan 27 23:07:12 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 27 Jan 2018 23:07:12 -0000 Subject: [GHC] #14677: Code generator does not correctly tag a pointer In-Reply-To: <046.7a1d900f9976c54932290e6492402f05@haskell.org> References: <046.7a1d900f9976c54932290e6492402f05@haskell.org> Message-ID: <061.56440e8e7ff057ee7e00d18c86e9722a@haskell.org> #14677: Code generator does not correctly tag a pointer -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: 14626 Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by heisenbug): Okay, I got it working. I now simply exclude casted constructors (by looking at the unfolding template), as they seem to be implemented by IND_STATIC. (They should not, rather they could be simply alias labels?) Thus those won't get tagged closure pointers, and will be entered as before. There are 66 cases where this pessimisation is triggered in GHC, so I guess this is a low price to pay. All of those are related to the `Int -> Event` casting. Here is my fix: https://github.com/ghc/ghc/commit/eef0c057551ef860c1ace2e1c7509bcdc3c8eb91 Simon, any idea how to do this better? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 28 00:24:36 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 28 Jan 2018 00:24:36 -0000 Subject: [GHC] #14244: ghc-prim: hs_atomicread* and hs_atomicwrite* missing barriers In-Reply-To: <047.186581f2b50df1c18e1d806a1ae31c18@haskell.org> References: <047.186581f2b50df1c18e1d806a1ae31c18@haskell.org> Message-ID: <062.166310bcc77c2b6098814c50eed13f39@haskell.org> #14244: ghc-prim: hs_atomicread* and hs_atomicwrite* missing barriers -------------------------------------+------------------------------------- Reporter: trommler | Owner: trommler Type: bug | Status: closed Priority: high | Milestone: 8.4.1 Component: Prelude | Version: 8.2.1 Resolution: fixed | 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): Phab:D4009 Wiki Page: | -------------------------------------+------------------------------------- Comment (by YitzGale): Hmm, by requiring GCC 4.7, this bans GHC from RHEL/CentOS 6, which uses GCC 4.4. That OS will be supported until the end of 2020, and will continue to be used fairly widely in the enterprise until close to then. Can this requirement be avoided at least for x86, amd64, and llvm builds, where it isn't actually needed? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 28 02:10:46 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 28 Jan 2018 02:10:46 -0000 Subject: [GHC] #14731: Document alignment invariants for array types in GHC.Prim Message-ID: <048.57574daf7b44935566d768b0adc24ecb@haskell.org> #14731: Document alignment invariants for array types in GHC.Prim -------------------------------------+------------------------------------- Reporter: jberryman | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Documentation | Version: 8.2.2 Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: #2917 #9806 Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- Through a combination of reading some of the wiki entries on the RTS, some trac tickets, and experimentation I've inferred that the payloads for bytearray types will always be aligned to the machine word size, even after GC. I guess this is obvious in retrospect since otherwise non-pinned arrays would be pretty useless. I'm not sure what the promises are for all the `Foreign` stuff. It can be frustrating to use `GHC.Prim` in particular due to this sort of lack of commitment in the docs, and these compound. Usually I end up trying to find an example in `text` or `bytestring` that would be horribly broken if some undocumented behavior changed, and hang my hat on that with a sad comment in the code I'm writing. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 28 05:07:00 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 28 Jan 2018 05:07:00 -0000 Subject: [GHC] #14731: Document alignment invariants for array types in GHC.Prim In-Reply-To: <048.57574daf7b44935566d768b0adc24ecb@haskell.org> References: <048.57574daf7b44935566d768b0adc24ecb@haskell.org> Message-ID: <063.5c9aaee99a93b8a6f7541b368fccd102@haskell.org> #14731: Document alignment invariants for array types in GHC.Prim -------------------------------------+------------------------------------- Reporter: jberryman | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Documentation | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #2917 #9806 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Description changed by jberryman: Old description: > Through a combination of reading some of the wiki entries on the RTS, > some trac tickets, and experimentation I've inferred that the payloads > for bytearray types will always be aligned to the machine word size, even > after GC. I guess this is obvious in retrospect since otherwise non- > pinned arrays would be pretty useless. > > I'm not sure what the promises are for all the `Foreign` stuff. > > It can be frustrating to use `GHC.Prim` in particular due to this sort of > lack of commitment in the docs, and these compound. Usually I end up > trying to find an example in `text` or `bytestring` that would be > horribly broken if some undocumented behavior changed, and hang my hat on > that with a sad comment in the code I'm writing. New description: Through a combination of reading some of the wiki entries on the RTS, some trac tickets, and experimentation I've inferred that the payloads for bytearray types will always be aligned to the machine word size, even after GC. I guess this is obvious in retrospect since otherwise non-pinned arrays would be pretty useless. I'm not sure what the promises are for all the `Foreign` stuff. -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 28 05:11:38 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 28 Jan 2018 05:11:38 -0000 Subject: [GHC] #7414: plugins always trigger recompilation In-Reply-To: <045.791037be90cd943b6dd26df93dd060d8@haskell.org> References: <045.791037be90cd943b6dd26df93dd060d8@haskell.org> Message-ID: <060.f82136d5914204e80b16669aedc8a3bf@haskell.org> #7414: plugins always trigger recompilation -------------------------------------+------------------------------------- Reporter: jwlato | Owner: (none) Type: feature request | Status: new Priority: high | Milestone: 8.6.1 Component: Compiler | Version: 7.6.1 Resolution: | Keywords: plugin, | RecompilationCheck Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: #12567 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by osa1): * cc: osa1 (added) * related: => #12567 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 28 05:12:24 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 28 Jan 2018 05:12:24 -0000 Subject: [GHC] #12567: `ghc --make` recompiles unchanged files when using `-fplugin` OPTIONS In-Reply-To: <048.43f14cd5930ab5b814c814d30cfc4c67@haskell.org> References: <048.43f14cd5930ab5b814c814d30cfc4c67@haskell.org> Message-ID: <063.ce9fd9c521339e1ff212c738225d6865@haskell.org> #12567: `ghc --make` recompiles unchanged files when using `-fplugin` OPTIONS -------------------------------------+------------------------------------- Reporter: heisenbug | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.10.3 Resolution: | Keywords: plugin, | RecompilationCheck Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: #7414 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by osa1): * cc: osa1 (added) * related: => #7414 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 28 06:00:04 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 28 Jan 2018 06:00:04 -0000 Subject: [GHC] #14732: -fdefer-type-holes breaks a correct program Message-ID: <052.1b96714b25f21170dafc623293b00787@haskell.org> #14732: -fdefer-type-holes breaks a correct program -------------------------------------+------------------------------------- Reporter: MitchellSalad | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.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: -------------------------------------+------------------------------------- Here's a bug I discovered in `vector` that Ryan Scott identified as a regression from 7.10.3: https://github.com/haskell/vector/issues/200 Here is Ryan's minimal example: {{{#!hs {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE MultiParamTypeClasses #-} module Bug where import Prelude hiding (zip, zipWith) zipWith :: (a -> b -> c) -> Bundle v a -> Bundle v b -> Bundle v c zipWith = undefined class GVector (v :: * -> *) a instance GVector Vector a data Bundle (v :: * -> *) a data Vector a class Unbox a stream :: GVector v a => v a -> Bundle v a {-# INLINE [1] stream #-} stream = undefined zip :: (Unbox a, Unbox b) => Vector a -> Vector b -> Vector (a, b) {-# INLINE [1] zip #-} zip = undefined {-# RULES "stream/zip [Vector.Unboxed]" forall as bs . stream (zip as bs) = zipWith (,) (stream as) (stream bs) #-}{#!hs }}} Output (8.2.2): {{{ Bug.hs:29:11: error: • Could not deduce (Unbox a) arising from a use of ‘zip’ from the context: GVector Vector (a, b) bound by the RULE "stream/zip [Vector.Unboxed]" at Bug.hs:(28,11)-(30,46) Possible fix: add (Unbox a) to the context of the RULE "stream/zip [Vector.Unboxed]" • In the first argument of ‘stream’, namely ‘(zip as bs)’ In the expression: stream (zip as bs) When checking the transformation rule "stream/zip [Vector.Unboxed]" | 29 | stream (zip as bs) = zipWith (,) (stream as) | ^^^^^^^^^ }}} Similar output in 8.0.1, 8.0.2, 8.2.1 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 28 06:01:14 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 28 Jan 2018 06:01:14 -0000 Subject: [GHC] #14732: -fdefer-type-holes breaks a correct program In-Reply-To: <052.1b96714b25f21170dafc623293b00787@haskell.org> References: <052.1b96714b25f21170dafc623293b00787@haskell.org> Message-ID: <067.46417ba1d785bce85f23481c505d72fb@haskell.org> #14732: -fdefer-type-holes breaks a correct program -------------------------------------+------------------------------------- Reporter: MitchellSalad | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Description changed by MitchellSalad: Old description: > Here's a bug I discovered in `vector` that Ryan Scott identified as a > regression from 7.10.3: > > https://github.com/haskell/vector/issues/200 > > Here is Ryan's minimal example: > > {{{#!hs > > {-# LANGUAGE FlexibleInstances #-} > {-# LANGUAGE KindSignatures #-} > {-# LANGUAGE MultiParamTypeClasses #-} > module Bug where > > import Prelude hiding (zip, zipWith) > > zipWith :: (a -> b -> c) > -> Bundle v a > -> Bundle v b > -> Bundle v c > zipWith = undefined > > class GVector (v :: * -> *) a > instance GVector Vector a > > data Bundle (v :: * -> *) a > data Vector a > class Unbox a > > stream :: GVector v a => v a -> Bundle v a > {-# INLINE [1] stream #-} > stream = undefined > > zip :: (Unbox a, Unbox b) => Vector a -> Vector b -> Vector (a, b) > {-# INLINE [1] zip #-} > zip = undefined > {-# RULES "stream/zip [Vector.Unboxed]" forall as bs . > stream (zip as bs) = zipWith (,) (stream as) > (stream bs) #-}{#!hs > > }}} > > Output (8.2.2): > > {{{ > Bug.hs:29:11: error: > • Could not deduce (Unbox a) arising from a use of ‘zip’ > from the context: GVector Vector (a, b) > bound by the RULE "stream/zip [Vector.Unboxed]" > at Bug.hs:(28,11)-(30,46) > Possible fix: > add (Unbox a) to the context of > the RULE "stream/zip [Vector.Unboxed]" > • In the first argument of ‘stream’, namely ‘(zip as bs)’ > In the expression: stream (zip as bs) > When checking the transformation rule "stream/zip [Vector.Unboxed]" > | > 29 | stream (zip as bs) = zipWith (,) (stream as) > | ^^^^^^^^^ > }}} > > Similar output in 8.0.1, 8.0.2, 8.2.1 New description: Here's a bug I discovered in `vector` that Ryan Scott identified as a regression from 7.10.3: https://github.com/haskell/vector/issues/200 Here is Ryan's minimal example: {{{#!hs {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE MultiParamTypeClasses #-} module Bug where import Prelude hiding (zip, zipWith) zipWith :: (a -> b -> c) -> Bundle v a -> Bundle v b -> Bundle v c zipWith = undefined class GVector (v :: * -> *) a instance GVector Vector a data Bundle (v :: * -> *) a data Vector a class Unbox a stream :: GVector v a => v a -> Bundle v a {-# INLINE [1] stream #-} stream = undefined zip :: (Unbox a, Unbox b) => Vector a -> Vector b -> Vector (a, b) {-# INLINE [1] zip #-} zip = undefined {-# RULES "stream/zip [Vector.Unboxed]" forall as bs . stream (zip as bs) = zipWith (,) (stream as) (stream bs) #-} }}} Output (8.2.2): {{{ Bug.hs:29:11: error: • Could not deduce (Unbox a) arising from a use of ‘zip’ from the context: GVector Vector (a, b) bound by the RULE "stream/zip [Vector.Unboxed]" at Bug.hs:(28,11)-(30,46) Possible fix: add (Unbox a) to the context of the RULE "stream/zip [Vector.Unboxed]" • In the first argument of ‘stream’, namely ‘(zip as bs)’ In the expression: stream (zip as bs) When checking the transformation rule "stream/zip [Vector.Unboxed]" | 29 | stream (zip as bs) = zipWith (,) (stream as) | ^^^^^^^^^ }}} Similar output in 8.0.1, 8.0.2, 8.2.1 -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 28 06:02:36 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 28 Jan 2018 06:02:36 -0000 Subject: [GHC] #14732: -fdefer-typed-holes breaks a correct program (was: -fdefer-type-holes breaks a correct program) In-Reply-To: <052.1b96714b25f21170dafc623293b00787@haskell.org> References: <052.1b96714b25f21170dafc623293b00787@haskell.org> Message-ID: <067.162e84b82d31145db4a38309cb250d53@haskell.org> #14732: -fdefer-typed-holes breaks a correct program -------------------------------------+------------------------------------- Reporter: MitchellSalad | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 28 10:10:25 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 28 Jan 2018 10:10:25 -0000 Subject: [GHC] #14727: Unboxed sum performance surprisingly poor In-Reply-To: <045.2f36bcb58aa862841131b518b7ebd355@haskell.org> References: <045.2f36bcb58aa862841131b518b7ebd355@haskell.org> Message-ID: <060.8ee7f220c7ac46e43f73ff3c3dcab20a@haskell.org> #14727: Unboxed sum performance surprisingly poor -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: UnboxedSums 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: | -------------------------------------+------------------------------------- Changes (by michalt): * cc: michalt (added) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 28 10:36:27 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 28 Jan 2018 10:36:27 -0000 Subject: [GHC] #14619: Output value of program changes upon compiling with -O optimizations In-Reply-To: <044.7bc7afdc77e978715c67bc6238b57042@haskell.org> References: <044.7bc7afdc77e978715c67bc6238b57042@haskell.org> Message-ID: <059.1221eee1b3d0782b23b70759347b289f@haskell.org> #14619: Output value of program changes upon compiling with -O optimizations -------------------------------------+------------------------------------- Reporter: sheaf | Owner: AndreasK Type: bug | Status: patch Priority: highest | Milestone: 8.4.1 Component: Compiler | Version: 8.2.2 (CodeGen) | Resolution: | Keywords: Operating System: Windows | Architecture: x86_64 Type of failure: Incorrect result | (amd64) at runtime | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4348 Wiki Page: | -------------------------------------+------------------------------------- Changes (by AndreasK): * status: new => patch * differential: => Phab:D4348 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 28 15:01:16 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 28 Jan 2018 15:01:16 -0000 Subject: [GHC] #14619: Output value of program changes upon compiling with -O optimizations In-Reply-To: <044.7bc7afdc77e978715c67bc6238b57042@haskell.org> References: <044.7bc7afdc77e978715c67bc6238b57042@haskell.org> Message-ID: <059.2e8070760b7fb52c8c4786aa84a0a3bd@haskell.org> #14619: Output value of program changes upon compiling with -O optimizations -------------------------------------+------------------------------------- Reporter: sheaf | Owner: AndreasK Type: bug | Status: patch Priority: highest | Milestone: 8.4.1 Component: Compiler | Version: 8.2.2 (CodeGen) | Resolution: | Keywords: Operating System: Windows | Architecture: x86_64 Type of failure: Incorrect result | (amd64) at runtime | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4348 Wiki Page: | -------------------------------------+------------------------------------- Comment (by carter): @ben: this is a pretty important bug fix for windows: let’s make sure it makes it into 8.4! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 28 18:22:04 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 28 Jan 2018 18:22:04 -0000 Subject: [GHC] #10754: truncate /= double2Int In-Reply-To: <043.90ddeb54230f66037ee120962cf0eb95@haskell.org> References: <043.90ddeb54230f66037ee120962cf0eb95@haskell.org> Message-ID: <058.5d99b140e94893c1a262387a46a25342@haskell.org> #10754: truncate /= double2Int -------------------------------------+------------------------------------- Reporter: cblp | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: Component: libraries/base | Version: 7.10.2 Resolution: duplicate | Keywords: truncate, | double2Int, rewrite, rule Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect result | Unknown/Multiple at runtime | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by cblp): I don't think you can consider Infinity a nonsense because it is a valid IEEE 754 value. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 28 18:28:04 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 28 Jan 2018 18:28:04 -0000 Subject: [GHC] #3070: floor(0/0) should not be defined In-Reply-To: <046.e7310ec88130e4aef68644b0cf077a3b@haskell.org> References: <046.e7310ec88130e4aef68644b0cf077a3b@haskell.org> Message-ID: <061.ba7373cecb31f8daf9a5ab85003a7f30@haskell.org> #3070: floor(0/0) should not be defined -------------------------------------+------------------------------------- Reporter: carette | Owner: squadette Type: bug | Status: new Priority: lowest | Milestone: Component: Prelude | Version: 6.10.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: 9276 | Blocking: Related Tickets: #10754 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by cblp): * cc: cblp (added) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 28 21:45:36 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 28 Jan 2018 21:45:36 -0000 Subject: [GHC] #14716: indexM-style accessor for arrays? In-Reply-To: <045.382f374145c4a013f6bcf49e8b87d85e@haskell.org> References: <045.382f374145c4a013f6bcf49e8b87d85e@haskell.org> Message-ID: <060.f86d51c2df04f198c2b293c737a529b9@haskell.org> #14716: indexM-style accessor for arrays? -------------------------------------+------------------------------------- Reporter: Zemyla | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: libraries | Version: 8.2.2 (other) | Resolution: | Keywords: array Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by ekmett): From a personal opinion perspective, it seems to me like a good idea to help bring the APIs a little closer together here, with no particularly good reason not to do so coming to mind. Ben, `array` falls under the purview of the CLC. It is currently maintained by Dan Doel. He also maintains `vector` and `primitive`. https://wiki.haskell.org/Library_submissions#The_Libraries Zemyla, the library proposal process is the best way to get feedback on your proposal from the community at large, but you'll want to get Dan on board, as the change would run through him as maintainer. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 28 21:53:46 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 28 Jan 2018 21:53:46 -0000 Subject: [GHC] #14716: indexM-style accessor for arrays? In-Reply-To: <045.382f374145c4a013f6bcf49e8b87d85e@haskell.org> References: <045.382f374145c4a013f6bcf49e8b87d85e@haskell.org> Message-ID: <060.cc812c24cd6af65a81aa37a4819d139d@haskell.org> #14716: indexM-style accessor for arrays? -------------------------------------+------------------------------------- Reporter: Zemyla | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: libraries | Version: 8.2.2 (other) | Resolution: | Keywords: array Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by hvr): Somewhat related, in https://github.com/haskell/bytestring/pull/146 there's a minor bit of name-finding struggle on whether to introduce a `indexMaybe` or a `(!?)` verb for the total version of `index`... -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 28 22:15:42 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 28 Jan 2018 22:15:42 -0000 Subject: [GHC] #14536: Ghc panics while building stage2 with -dstg-lint In-Reply-To: <043.07052cd8274441bc63c2d750cdfb2370@haskell.org> References: <043.07052cd8274441bc63c2d750cdfb2370@haskell.org> Message-ID: <058.fdba3d1374f4999554d1afe9e31c463b@haskell.org> #14536: Ghc panics while building stage2 with -dstg-lint -------------------------------------+------------------------------------- Reporter: duog | Owner: duog Type: bug | Status: patch Priority: high | Milestone: 8.6.1 Component: Compiler | Version: 8.3 Resolution: | Keywords: stg-lint Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4242 Wiki Page: | -------------------------------------+------------------------------------- Comment (by duog): I have a half finished patch to fix all the unarisation issues. There are quite a few. I'll try and get it onto phab this week or next. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Jan 28 22:34:51 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 28 Jan 2018 22:34:51 -0000 Subject: [GHC] #2893: Implement "Quantified contexts" proposal In-Reply-To: <045.2638646abdcf216191d07c9810407703@haskell.org> References: <045.2638646abdcf216191d07c9810407703@haskell.org> Message-ID: <060.a80f51069e33c4b6841d96bc8ea01b17@haskell.org> #2893: Implement "Quantified contexts" proposal -------------------------------------+------------------------------------- Reporter: porges | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: ⊥ Component: Compiler | Version: 6.10.1 Resolution: | Keywords: | QuantifiedContexts Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): I've build an implementation of `QuantifiedConstraints`, held on `wip/T2893`. Here's the commit message {{{ commit dbcf8d0b9076ae32b9138623eb84f67c18ed3dab Author: Simon Peyton Jones Date: Sat Jan 27 14:32:34 2018 +0000 Implement QuantifiedConstraints We have wanted quantified constraints for ages and, as I hoped, they proved remarkably simple to implement. All the machinery was already in place. The main ticket is Trac #2893, but also relevant are #5927 #8516 #9123 (especially! higher kinded roles) #14070 #14317 The wiki page is https://ghc.haskell.org/trac/ghc/wiki/QuantifiedContexts Here is the relevant Note: Note [Quantified constraints] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The -XQuantifiedConstraints extension allows type-class contexts like this: data Rose f x = Rose x (f (Rose f x)) instance (Eq a, forall b. Eq b => Eq (f b)) => Eq (Rose f a) where (Rose x1 rs1) == (Rose x2 rs2) = x1==x2 && rs1 >= rs2 Note the (forall b. Eq b => Eq (f b)) in the instance contexts. This quantified constraint is needed to solve the [W] (Eq (f (Rose f x))) constraint which arises form the (==) definition. Here are the moving parts * Language extension {-# LANGUAGE QuantifiedConstraints #-} and add it to ghc-boot-th:GHC.LanguageExtensions.Type.Extension * A new form of evidence, EvDFun, that is used to discharge such wanted constraints * checkValidType gets some changes to accept forall-constraints only in the right places. * Type.PredTree gets a new constructor ForAllPred, and and classifyPredType analyses a PredType to decompose the new forall-constraints * TcSMonad.InertCans gets an extra field, inert_insts, which holds all the Given forall-constraints. In effect, such Given constraints are like local instance decls. * When trying to solve a class constraint, via TcInteract.matchInstEnv, use the InstEnv from inert_insts so that we include the local Given forall-constraints in the lookup. (See TcSMonad.getInstEnvs.) * TcCanonical.canForAll deals with solving a forall-constraint. See Note [Solving a Wanted forall-constraint] Note [Solving a Wanted forall-constraint] * We augment the kick-out code to kick out an inert forall constraint if it can be rewritten by a new type equality; see TcSMonad.kick_out_rewritable Still to come - User manual documentation - A GHC Proposal }}} I'll try to get it up on Phabricator on Monday, unless someone would care to beat me to it. Please give it a try! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 29 01:02:34 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 29 Jan 2018 01:02:34 -0000 Subject: [GHC] #14709: Extend the plugin mechanism to access program representation In-Reply-To: <044.2e69c960decc5283f7ff746e6b782d96@haskell.org> References: <044.2e69c960decc5283f7ff746e6b782d96@haskell.org> Message-ID: <059.0ed5129d991cc83bf564e0a8b7ceafe6@haskell.org> #14709: Extend the plugin mechanism to access program representation -------------------------------------+------------------------------------- Reporter: lazac | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: GHC API | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | https://phabricator.haskell.org/D4342 https://ghc.haskell.org/trac/ghc/wiki/ExtendedPluginsProposal| -------------------------------------+------------------------------------- Comment (by lazac): Your tutorial is very useful, I also tried it when I was experimenting of using frontend plugins for the same problem that I would like to solve with the source plugins. I think it is possible to extract the typechecked AST with a frontend plugin and a wrapper program setting up the frontend compiler hook. However for my tool I need other information, including loaded interfaces, renamed AST and splices evaluated. I think other tool developers will find the availability of those useful as well. From a design perspective, I would like to extend GHC in a way that doesn't alter the compilation process, and I think that normal plugins are better for that than frontend plugins. It is also generally easier to setup the build system to use a few compiler flags than to use a different compiler, and the user will not have problems if he has more than one GHC installed. Overall you are right in that the wiki page oversimplifies the matter, I will try to improve it. Thank for pointing out! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 29 01:31:43 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 29 Jan 2018 01:31:43 -0000 Subject: [GHC] #14733: Won't use (forall xx. f xx) with -XQuantifiedConstraints Message-ID: <051.d6dd7c53fb2316d2a32445d192b9d697@haskell.org> #14733: Won't use (forall xx. f xx) with -XQuantifiedConstraints -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.5 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: -------------------------------------+------------------------------------- {{{#!hs {-# Language QuantifiedConstraints #-} {-# Language GADTs #-} {-# Language ConstraintKinds #-} data D c where D :: c => D c proof :: (forall xx. f xx) => D (f a) proof = D }}} Running this program with [https://ghc.haskell.org/trac/ghc/ticket/2893#comment:28 wip/T2893] gives {{{ GHCi, version 8.5.20180128: http://www.haskell.org/ghc/ :? for help [1 of 1] Compiling Main ( 174-quantifiedconstraints.hs, interpreted ) 174-quantifiedconstraints.hs:9:9: error: • Could not deduce: f a arising from a use of ‘D’ from the context: forall xx. f xx bound by the type signature for: proof :: forall (f :: * -> Constraint) a. (forall xx. f xx) => D (f a) at 174-quantifiedconstraints.hs:8:1-37 • In the expression: D In an equation for ‘proof’: proof = D • Relevant bindings include proof :: D (f a) (bound at 174-quantifiedconstraints.hs:9:1) | 9 | proof = D | ^ }}} How can I instantiate `xx` to `a`? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 29 01:31:59 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 29 Jan 2018 01:31:59 -0000 Subject: [GHC] #14733: Won't use (forall xx. f xx) with -XQuantifiedConstraints In-Reply-To: <051.d6dd7c53fb2316d2a32445d192b9d697@haskell.org> References: <051.d6dd7c53fb2316d2a32445d192b9d697@haskell.org> Message-ID: <066.2a27002175bf3aa04b268bebb7b7c65c@haskell.org> #14733: Won't use (forall xx. f xx) with -XQuantifiedConstraints -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.5 Resolution: | Keywords: | QuantifiedContexts Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by Iceland_jack): * keywords: => QuantifiedContexts -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 29 01:40:03 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 29 Jan 2018 01:40:03 -0000 Subject: [GHC] #14734: QuantifiedConstraints conflated with impredicative polymorphism? Message-ID: <051.b13ce9a287df15f46f4472a3cecc22de@haskell.org> #14734: QuantifiedConstraints conflated with impredicative polymorphism? -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.5 Keywords: | Operating System: Unknown/Multiple QuantifiedConstraints | Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- This works: {{{#!hs {-# Language QuantifiedConstraints #-} {-# Language GADTs #-} {-# Language ConstraintKinds #-} {-# Language KindSignatures #-} {-# Language RankNTypes #-} {-# Language FlexibleInstances #-} {-# Language UndecidableInstances #-} {-# Language TypeOperators #-} import Data.Kind data D c where D :: c => D c newtype a :- b = Sub (a => D b) class (forall xx. f xx) => Limit f instance (forall xx. f xx) => Limit f proof :: Limit Eq :- Eq (Int -> Float) proof = Sub D }}} If we replace `Limit Eq` with `(forall xx. Eq xx)` it is considered impredicative polymorphism, but is it? {{{ 174-quantifiedconstraints.hs:20:10: error: • Illegal polymorphic type: forall xx. Eq xx GHC doesn't yet support impredicative polymorphism • In the type signature: proof :: (forall xx. Eq xx) :- Eq (Int -> Float) | 20 | proof :: (forall xx. Eq xx) :- Eq (Int -> Float) | ^^^^^^^^^^^^^^^^^ }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 29 01:49:34 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 29 Jan 2018 01:49:34 -0000 Subject: [GHC] #14709: Extend the plugin mechanism to access program representation In-Reply-To: <044.2e69c960decc5283f7ff746e6b782d96@haskell.org> References: <044.2e69c960decc5283f7ff746e6b782d96@haskell.org> Message-ID: <059.dcae1e29e613b6f444ef473fd771254d@haskell.org> #14709: Extend the plugin mechanism to access program representation -------------------------------------+------------------------------------- Reporter: lazac | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: GHC API | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | https://phabricator.haskell.org/D4342 https://ghc.haskell.org/trac/ghc/wiki/ExtendedPluginsProposal| -------------------------------------+------------------------------------- Comment (by lazac): Replying to [comment:5 bgamari]: > Writing down a few motivating examples of applications of the new plugin types may be a good place to start. Some of these tools exist using external libraries, but by using GHC as the backend they may be applied to more complex projects. I'm mostly interested in editing and code transformation tools, so here is a few example: - **Auto-complete**: Records the names available in a scope using interface files and type checked AST. - **Semantics aware formatting**: Auto-formatter that uses fixity information to break up complex operator expressions. Uses parsed and type checked representation. - **Semantics aware syntax highlight**: Check interfaces for recording extra information about names and use this in an editor to enhance highlighting names. - **Code generator**: Generating pattern matches and expressions in a dependent-typed fashion. - **Auto-correct**: Automatic fix common errors. Uses `-fdefer-*` flags, extracts type-checked representation. Also checks interfaces files. - **Refactoring tool**: Building a project database of syntactic and semantic information to rewrite source code. Uses all versions of syntax tree, splices, interfaces. My suggestion for recompilation checking is: - `-fplugin` change -> recompile - The hash of used plugin changes -> recompile - `-fplugin-opt` change -> ask the plugin for each module whether recompilation is needed -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 29 03:29:56 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 29 Jan 2018 03:29:56 -0000 Subject: [GHC] #14630: name shadowing warnings by record pattern synonyms + RecordWildCards or NamedFieldPuns In-Reply-To: <053.0838c2dcc7b95d4aed5fb595896d561b@haskell.org> References: <053.0838c2dcc7b95d4aed5fb595896d561b@haskell.org> Message-ID: <068.e407e5497417d6427a87338da8e5b91f@haskell.org> #14630: name shadowing warnings by record pattern synonyms + RecordWildCards or NamedFieldPuns -------------------------------------+------------------------------------- Reporter: mizunashi_mana | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: | PatternSynonyms Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect | Unknown/Multiple error/warning at compile-time | Test Case: Blocked By: | Blocking: Related Tickets: #11228, #11970 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * related: #11228 => #11228, #11970 Comment: Oh bother. Just as I finished up a patch for this, I realized that at one point in time, GHC did exactly what was described in comment:5 by having a `Parent` constructor named `PatternSynonym`. However, `PatternSynonym` was deliberately removed in e660f4bf546e90fb6719ad268ca3daaecdce4b82 (#11970)! Looking at that commit, my patch essentially just adds all of that functionality back plus some changes to `isRecFldGRE`. I'm not sure how to proceed from here—I don't want to trample on other people's work! mpickering, you authored of that commit: do you have an opinion on this? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 29 03:30:44 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 29 Jan 2018 03:30:44 -0000 Subject: [GHC] #14735: GHC Panic with QuantifiedConstraints Message-ID: <051.3a02470ddbd28d332b6dd2bb0406c5fc@haskell.org> #14735: GHC Panic with QuantifiedConstraints -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Keywords: | Operating System: Unknown/Multiple QuantifiedContexts | Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- From branch [https://ghc.haskell.org/trac/ghc/ticket/2893#comment:28 wip/T2893] {{{#!hs {-# Language QuantifiedConstraints #-} {-# Language StandaloneDeriving #-} {-# Language DataKinds #-} {-# Language TypeOperators #-} {-# Language GADTs #-} {-# Language KindSignatures #-} {-# Language FlexibleInstances #-} {-# Language UndecidableInstances #-} {-# Language MultiParamTypeClasses #-} {-# Language RankNTypes #-} {-# Language ConstraintKinds #-} import Data.Kind data D c where D :: c => D c newtype a :- b = S (a => D b) class C1 a b class C2 a b instance C1 a b => C2 a b class (forall xx. f xx) => Limit f instance (forall xx. f xx) => Limit f -- impl :: Limit (C1 a) :- Limit (C2 a) -- impl = S D infixr 5 :< data Sig a = N a | a :< Sig a data AST :: (Sig Type -> Type) -> (Sig Type -> Type) where Sym :: dom a -> AST dom a (:$) :: AST dom (xx :< a) -> AST dom (N xx) -> AST dom a deriving instance (forall xx. Show (dom xx)) => Show (AST dom a) data Arith a where Plus :: Arith (Int :< Int :< N Int) deriving instance Show (Arith a) }}} loading this program and evaluating `Sym Plus` works fine: {{{ $ ghc-stage2 --interactive hs/175-bug.hs GHCi, version 8.5.20180128: http://www.haskell.org/ghc/ :? for help [1 of 1] Compiling Main ( hs/175-bug.hs, interpreted ) Ok, one module loaded. *Main> Sym Plus Sym Plus *Main> }}} but we uncomment `impl` we get a panic! {{{ GHCi, version 8.5.20180128: http://www.haskell.org/ghc/ :? for help [1 of 1] Compiling Main ( hs/175-bug.hs, interpreted ) Ok, one module loaded. *Main> Sym Plus ghc-stage2: panic! (the 'impossible' happened) (GHC version 8.5.20180128 for x86_64-unknown-linux): nameModule system df_a2VB Call stack: CallStack (from HasCallStack): callStackDoc, called at compiler/utils/Outputable.hs:1150:37 in ghc:Outputable pprPanic, called at compiler/basicTypes/Name.hs:241:3 in ghc:Name Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug *Main> }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 29 06:28:35 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 29 Jan 2018 06:28:35 -0000 Subject: [GHC] #14699: Core library status for 8.4.1 (was: Library status for 8.4.1) In-Reply-To: <046.12f775ea02060174a5ac178f457055aa@haskell.org> References: <046.12f775ea02060174a5ac178f457055aa@haskell.org> Message-ID: <061.a9571993b277a6e6be1155a6a549c562@haskell.org> #14699: Core library status for 8.4.1 -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: task | Status: new Priority: highest | Milestone: 8.4.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Old description: > ||= package =||= status =||= reference =|| > || `Cabal` || needs release || || > || `Win32` || on-release || || > || `array` || Needs revision || || > || `binary` || on-release || || > || `bytestring` || on-release || || > || `containers` || needs release || > https://github.com/haskell/containers/issues/501 || > || `deepseq` || needs revision || || > || `directory` || on-release || || > || `filepath` || ready || https://github.com/haskell/filepath/issues/65 > || > || `haskeline` || ready || https://github.com/judah/haskeline/issues/75 > || > || `hpc` || needs release || || > || `mtl` || needs release || https://github.com/haskell/mtl/issues/52 || > || `parallel` || needs revision || || > || `parsec` || needs release || > https://github.com/haskell/parsec/issues/86 || > || `pretty` || needs release || > https://github.com/haskell/pretty/issues/47 || > || `primitive` || needs release || > https://github.com/haskell/primitive/issues/72 || > || `process` || ready || https://github.com/haskell/primitive/issues/72 > || > || `stm` || needs release || #14698 || > || `terminfo` || ready || https://github.com/judah/terminfo/issues/27 || > || `text` || needs release || https://github.com/haskell/text/issues/215 > || > || `time` || on-release || || > || `transformers` || ready || #14678 || > || `unix` || needs release || https://github.com/haskell/unix/issues/106 > || > || `haddock` || needs release || > https://github.com/haskell/haddock/issues/737 || New description: ||= package =||= status =||= reference =|| || `Cabal` || needs release || || || `Win32` || on-release || || || `array` || Needs revision || || || `binary` || on-release || || || `bytestring` || on-release || || || `containers` || needs release || https://github.com/haskell/containers/issues/501 || || `deepseq` || needs revision || || || `directory` || on-release || || || `filepath` || ready || https://github.com/haskell/filepath/issues/65 || || `haskeline` || ready || https://github.com/judah/haskeline/issues/75 || || `hpc` || needs release || || || `mtl` || needs release || https://github.com/haskell/mtl/issues/52 || || `parallel` || needs revision || || || `parsec` || needs release || https://github.com/haskell/parsec/issues/86 || || `pretty` || ready || https://github.com/haskell/pretty/issues/47 || || `primitive` || needs release || https://github.com/haskell/primitive/issues/72 || || `process` || ready || https://github.com/haskell/primitive/issues/72 || || `stm` || needs release || #14698 || || `terminfo` || ready || https://github.com/judah/terminfo/issues/27 || || `text` || needs release || https://github.com/haskell/text/issues/215 || || `time` || on-release || || || `transformers` || ready || #14678 || || `unix` || needs release || https://github.com/haskell/unix/issues/106 || || `haddock` || needs release || https://github.com/haskell/haddock/issues/737 || -- Comment (by bgamari): `pretty` `1.1.3.6` has been released and the submodule bumped. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 29 06:33:17 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 29 Jan 2018 06:33:17 -0000 Subject: [GHC] #14711: Machine readable output of coverage In-Reply-To: <050.d858ad27520ca4b1ee3c013a327a8c68@haskell.org> References: <050.d858ad27520ca4b1ee3c013a327a8c68@haskell.org> Message-ID: <065.710d9f97d6e1a9243e408190a10d6d2b@haskell.org> #14711: Machine readable output of coverage -------------------------------------+------------------------------------- Reporter: Koterpillar | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Code Coverage | Version: 8.2.2 Resolution: | Keywords: newcomers Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Koterpillar): I'll try to do this, reading through the newcomers documentation currently. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 29 08:52:36 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 29 Jan 2018 08:52:36 -0000 Subject: [GHC] #11735: Optimize coercionKind In-Reply-To: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> References: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> Message-ID: <062.adb4890827629bec4b3dcd165814d718@haskell.org> #11735: Optimize coercionKind -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.10.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by tdammers): Replying to [comment:43 goldfire]: > OK. I've fixed a few testsuite failures. I think this is probably correct now. (CircleCI reports a bunch of errors in `profiling`, but I can't repro locally.) > > What happens when you benchmark? Curiously, the latest version clocks in at about 25 seconds for Grammar.hs, so almost as fast, but not quite, as the fastest we've seen so far (~21 seconds): {{{ Mon Jan 29 09:43 2018 Time and Allocation Profiling Report (Final) ghc-stage2 +RTS -p -RTS -B/home/tobias/well- typed/devel/ghc/inplace/lib Grammar.hs -ddump-stg -ddump-simpl -ddump-to- file -fforce-recomp total time = 25.95 secs (25950 ticks @ 1000 us, 1 processor) total alloc = 33,815,717,032 bytes (excludes profiling overheads) COST CENTRE MODULE SRC %time %alloc simplCast Simplify compiler/simplCore/Simplify.hs:871:62-87 26.0 21.8 CoreTidy HscMain compiler/main/HscMain.hs:1253:27-67 19.9 24.7 Stg2Stg HscMain compiler/main/HscMain.hs:1489:12-44 17.6 20.9 addCoerce-pushCoTyArg Simplify compiler/simplCore/Simplify.hs:(1251,12)-(1254,36) 10.5 9.0 tc_rn_src_decls TcRnDriver compiler/typecheck/TcRnDriver.hs:(494,4)-(556,7) 7.3 6.0 subst_ty TyCoRep compiler/types/TyCoRep.hs:2240:28-32 3.5 4.4 coercionKind Coercion compiler/types/Coercion.hs:1711:3-7 2.1 4.6 zonkTopDecls TcRnDriver compiler/typecheck/TcRnDriver.hs:(445,16)-(446,43) 1.1 0.9 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 29 08:59:32 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 29 Jan 2018 08:59:32 -0000 Subject: [GHC] #7398: RULES don't apply to a newtype constructor In-Reply-To: <046.1bb2e495c45c32508f69b7364d934e7b@haskell.org> References: <046.1bb2e495c45c32508f69b7364d934e7b@haskell.org> Message-ID: <061.a1c1322892e1f3dda9d0f589162eb04e@haskell.org> #7398: RULES don't apply to a newtype constructor -------------------------------------+------------------------------------- Reporter: shachaf | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 7.6.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: #6082, #10418, | Differential Rev(s): #13290 | Wiki Page: | -------------------------------------+------------------------------------- Changes (by dfeuer): * milestone: => 8.6.1 Comment: I'm adding a milestone because I suspect we may have enough machinery to make this work . Consider this code: {{{#!hs import Data.Functor.Identity import Data.Coerce hello :: (a -> b) -> a -> b hello f x = f x {-# INLINE [1] hello #-} {-# RULES "not good" forall (f :: Identity a -> a) x. hello f (Identity x) = x "also bad" forall f (x :: a). hello f (Identity x :: Identity a) = x "yes good" forall (f :: Identity a -> a) x. hello f (coerce x) = x "also good" forall f (x :: a) . hello f (coerce x :: Identity a) = x "just fine" forall f (x :: a). hello f (coerce @a @(Identity a) x) = x #-} test :: (Identity a -> a) -> a -> a test f x = hello f (Identity x) {-# NOINLINE test #-} }}} The rule labeled "not good" doesn't fire, but the one labeled "yes good" fires. The only difference is the spelling of `coerce`! This seems to suggest that we can apply some of the machinery for `coerce` rules to sometimes make good things happen. In particular, it seems likely that after type checking the rule, we can simply replace each `newtype` constructor/accessor with an appropriately typed invocation of `coerce`, and make the rules engine work. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 29 09:00:52 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 29 Jan 2018 09:00:52 -0000 Subject: [GHC] #7398: RULES don't apply to a newtype constructor In-Reply-To: <046.1bb2e495c45c32508f69b7364d934e7b@haskell.org> References: <046.1bb2e495c45c32508f69b7364d934e7b@haskell.org> Message-ID: <061.34f5c4bb6d5f9973723fdadc5a3e99a5@haskell.org> #7398: RULES don't apply to a newtype constructor -------------------------------------+------------------------------------- Reporter: shachaf | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 7.6.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: #6082, #10418, | Differential Rev(s): #13290 | Wiki Page: | -------------------------------------+------------------------------------- Changes (by dfeuer): * cc: dfeuer (added) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 29 09:03:57 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 29 Jan 2018 09:03:57 -0000 Subject: [GHC] #11735: Optimize coercionKind In-Reply-To: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> References: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> Message-ID: <062.c06fb3b1376334cc845a8505a43efd35@haskell.org> #11735: Optimize coercionKind -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.10.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by tdammers): Replying to [comment:40 goldfire]: > Sorry, still confused. :( > > How are `coercionKind` and `coercionRole` ''mutually'' recursive? I see that `coercionRole` calls `coercionKind` but not the other way around. Sorry for the confusion, I shouldn't be trying to explain things I only half understand myself when tired. Looking at HEAD on `master`, we have the `coercionKindRole` function that is simply recursive for NthCo, and has the `nth` call embedded. So for nested NthCo's, its behavior should be quadratic. The un-refactored version has `coercionKind`, which is simply recursive (O(n)), and we have `coercionRole`, which recurses via `coercionKindRole`. The latter is really just a matter of calling `coercionKind` and `coercionRole` individually though; the `coercionRole` call makes `coercionRole` simply recursive (O(n)), but the `coercionKind` call introduces another O(n), making the entire thing also quadratic. Calling this "mutually recursive" is of course a brainfart on my side, since `coercionKind` never calls back into `coercionRole`. So in terms of big-O, HEAD and "un-refactored" should be the same. Why one perfoms better than the other is somewhat unclear to me though. > But you're right that I'm trying to understand better why there's a performance improvement in this patch (even before any caching). In the nested `NthCo` case, I'm pretty sure your refactor would be worse. But in the test case at hand (which I assume doesn't have nested `NthCo`s -- haven't looked), your change is clearly an improvement. > > However, I don't think your analysis above is really the problem. I would expect that the running time of `coercionKind` or `coercionRole` on nested `NthCo`s to be linear in the sum of the `d`s -- that is, we'll have to add together all the indices. You've shown above that the old recursion pattern (from `coercionKindRole`) traverses down the linked list twice (once in `getNth` and once in `nthRole`), but this shouldn't change asymptotic complexity. And, usually, `d` is quite small, and so I wouldn't expect this to show up at all, really. I still don't think we've quite gotten to the bottom of why separating out `coercionKind` and `coercionRole` should effect a performance improvement. Indeed, it's not the problem, or rather, the un-refactoring alone doesn't fix anything - if it makes a difference at all, then it's most likely just a constant-factor improvement, nothing fundamental. But that's not why we did it anyway; the reason we did it was so that we could more easily implement the caching (storing precalculated roles in the NthCo itself), which breaks down one of the linear terms to constant. > On the other hand, the separated version really is quadratic... and yet it's faster (on this test case)! That's the conundrum. Yes, but we don't know if it's actually big-O-faster, or just happens have a more favorable constant factor. > Please don't let my nit-picking slow you down or discourage you. It's just that I think you've hit something quite interesting, and, well, I'm interested. :) Absolutely not, your input has been super helpful, and I much prefer hard criticism over empty praise. Bring it on :) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 29 09:11:34 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 29 Jan 2018 09:11:34 -0000 Subject: [GHC] #14672: Make likelyhood of branches/conditions available throughout the compiler. In-Reply-To: <047.de2c13e36902d9be8400d9448aa09671@haskell.org> References: <047.de2c13e36902d9be8400d9448aa09671@haskell.org> Message-ID: <062.2ca35e469decdb7f5c26959ead63fd12@haskell.org> #14672: Make likelyhood of branches/conditions available throughout the compiler. -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4316 Wiki Page: | Phab:D4324 Phab:D4327 -------------------------------------+------------------------------------- Comment (by simonpj): Do we have any documentation of our Cmm-source syntax? It would be Jolly Good to have one. It seems poor to have `Foo.cmm` files with zero documentation of what's allowed in them. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 29 09:29:13 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 29 Jan 2018 09:29:13 -0000 Subject: [GHC] #14731: Document alignment invariants for array types in GHC.Prim In-Reply-To: <048.57574daf7b44935566d768b0adc24ecb@haskell.org> References: <048.57574daf7b44935566d768b0adc24ecb@haskell.org> Message-ID: <063.689924d4caf4a6f85bded1baa3ae3e8d@haskell.org> #14731: Document alignment invariants for array types in GHC.Prim -------------------------------------+------------------------------------- Reporter: jberryman | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Documentation | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #2917 #9806 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Documenting the promises would be really good. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 29 11:16:56 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 29 Jan 2018 11:16:56 -0000 Subject: [GHC] #11735: Optimize coercionKind In-Reply-To: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> References: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> Message-ID: <062.c590850342b5620be34eb36e814fcbeb@haskell.org> #11735: Optimize coercionKind -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.10.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by tdammers): I ran a selection of commits against two test inputs: Grammar.hs, as above, and the `test_rules2.hs` file from #5631. Here's a list of execution times for both: {{{ --- ./cases/Grammar.hs --- 452dee3ff4: 245.51 4572849929: 19.62 4eb140f564: 12.25 8a6aa5030d: 12.26 d74b37d565: 16.14 --- ./cases/test_rules2.hs --- 452dee3ff4: 1.20 4572849929: 1.19 4eb140f564: 1.19 8a6aa5030d: 1.23 d74b37d565: 1.18 }}} The commits are: {{{ 452dee3ff4: GHC `master` before branching off on this issue (should be the same as GHC HEAD) 4572849929: Simon's patch from [comment:5] applied. 4eb140f564: After "un-refactoring" 8a6aa5030d: With coercion roles cached, and mkNthCo taking an extra Role argument d74b37d565: current HEAD of wip/tdammers/T11735 }}} (Note that the execution times are a bit faster overall in this run because I didn't pass any `-ddump` flags, so GHC spends no time pretty- printing the dumps). So, conclusions: - The [comment:5] patch makes a huge difference for `Grammar.hs` (down to less than 10% in execution time) - "un-refactoring", strangely enough, improves performance on `Grammar.hs` by roughly another 25% or so - caching coercion rules in NthCo doesn't seem to make a difference at all, and even makes things slightly worse (this one is truly baffling IMO) - improvements from [comment:41] make the `Grammar.hs` test case worse (this, too, is unexpected) - none of the changes here seem to affect performance for the `test_rules2.hs` case much, if at all -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 29 11:48:03 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 29 Jan 2018 11:48:03 -0000 Subject: [GHC] #8258: GHC accepts `data Foo where` in H2010 mode In-Reply-To: <042.7ae0b1be303dde5e66c52f6566614572@haskell.org> References: <042.7ae0b1be303dde5e66c52f6566614572@haskell.org> Message-ID: <057.ed7a1eecfdac838dad6b134638ef7269@haskell.org> #8258: GHC accepts `data Foo where` in H2010 mode -------------------------------------+------------------------------------- Reporter: hvr | Owner: sighingnow Type: bug | Status: new Priority: low | Milestone: Component: Compiler | Version: 7.0.4 (Parser) | Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: GHC accepts | Test Case: parser/T8258, invalid program | parser/T8258NoGADTs Blocked By: | Blocking: 11384 Related Tickets: | Differential Rev(s): Phab:D4350 Wiki Page: | -------------------------------------+------------------------------------- Changes (by sighingnow): * owner: (none) => sighingnow * testcase: => parser/T8258, parser/T8258NoGADTs * differential: => Phab:D4350 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 29 12:49:16 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 29 Jan 2018 12:49:16 -0000 Subject: [GHC] #14709: Extend the plugin mechanism to access program representation In-Reply-To: <044.2e69c960decc5283f7ff746e6b782d96@haskell.org> References: <044.2e69c960decc5283f7ff746e6b782d96@haskell.org> Message-ID: <059.977679aa715d18e5b3d0cf3b07f84c2f@haskell.org> #14709: Extend the plugin mechanism to access program representation -------------------------------------+------------------------------------- Reporter: lazac | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: GHC API | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | https://phabricator.haskell.org/D4342 https://ghc.haskell.org/trac/ghc/wiki/ExtendedPluginsProposal| -------------------------------------+------------------------------------- Comment (by mpickering): These examples are useful for discussing the problems with recompilation but I don't think they should stop the progress of this patch. If we all agree that this is a good direction, which I think we should, we should consider each of the proposed plugins and decide whether each of them is desirable in turn. To summarise, here are the five proposed extensions. {{{ parsedResultAction :: [CommandLineOption] -> ModSummary -> HsParsedModule needsRenamedSyntax :: [CommandLineOption] -> ModSummary -> Hsc Bool typeCheckResultAction :: [CommandLineOption] -> ModSummary -> TcGblEnv spliceRunAction :: [CommandLineOption] -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc) interfaceLoadAction :: forall lcl . [CommandLineOption] -> ModIface -> IfM lcl ModIface }}} I think that `parsedResultAction`, `typecheckResultAction` and `splitRunAction` are well motivated hooks which we should definitely include. I am indifferent towards `interfaceLoadAction`, I don't see a more direct place to implement this but feel the hook should instead run after the interface is type checked. I won't accept a patch which includes the `needsRenamedSyntax` hook which is ad-hoc. Can other interested parties please comment on these specific so we can move this patch forward in a reasonable time frame? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 29 13:27:14 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 29 Jan 2018 13:27:14 -0000 Subject: [GHC] #14709: Extend the plugin mechanism to access program representation In-Reply-To: <044.2e69c960decc5283f7ff746e6b782d96@haskell.org> References: <044.2e69c960decc5283f7ff746e6b782d96@haskell.org> Message-ID: <059.fddc307e086d67be5eb7808cb80c2755@haskell.org> #14709: Extend the plugin mechanism to access program representation -------------------------------------+------------------------------------- Reporter: lazac | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: GHC API | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | https://phabricator.haskell.org/D4342 https://ghc.haskell.org/trac/ghc/wiki/ExtendedPluginsProposal| -------------------------------------+------------------------------------- Comment (by alanz): As a fellow tool-writer, in principle I am in favour of this patch. One thing that confuses me though, is the motivating examples are to extract information, but the plugins allow changes on the fly. I am concerned that we open a pandora's box of arbitrary transformations via plugins, that will make it ***harder*** for tool writers, as we now need to know what other things are happening under the hood. That said, I do believe it would be incredibly useful to be able to make changes to some part of a given AST, and push it down the pipeline to either validate a proposed change to the code, or to gather type information based on the change. And to do that modification is required. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 29 13:46:39 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 29 Jan 2018 13:46:39 -0000 Subject: [GHC] #11735: Optimize coercionKind In-Reply-To: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> References: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> Message-ID: <062.935f078ebbde1eaaf75f22fa0cb9b0d0@haskell.org> #11735: Optimize coercionKind -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.10.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by tdammers): Currently doing a full test run, and I don't have the full result yet, but it seems that many tests are failing. Not sure if this is due to these particular code changes though, I will look into it once the run finishes. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 29 14:22:26 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 29 Jan 2018 14:22:26 -0000 Subject: [GHC] #14735: GHC Panic with QuantifiedConstraints In-Reply-To: <051.3a02470ddbd28d332b6dd2bb0406c5fc@haskell.org> References: <051.3a02470ddbd28d332b6dd2bb0406c5fc@haskell.org> Message-ID: <066.47e6b9e53dffbfa52b79315efb106954@haskell.org> #14735: GHC Panic with QuantifiedConstraints -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: | QuantifiedContexts Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): Perhaps this is just me, but I think that it's pretty early to be submitting bug reports about `-XQuantifiedContexts`, since this is a feature that: 1. Hasn't even landed in GHC itself (let alone been formally submitted for review) 2. Is still subject to change My suggestion would be to hold off until there's a Phabricator Diff for this, at which point you can dump all of your findings there :) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 29 14:40:13 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 29 Jan 2018 14:40:13 -0000 Subject: [GHC] #14704: Spurious cost-centre test failures In-Reply-To: <046.aed78b7537a34d382c90181e0bd1ef41@haskell.org> References: <046.aed78b7537a34d382c90181e0bd1ef41@haskell.org> Message-ID: <061.e0fa298a6b5c25f59f38f449d5908a40@haskell.org> #14704: Spurious cost-centre test failures -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Profiling | Version: 8.5 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4351 Wiki Page: | -------------------------------------+------------------------------------- Changes (by osa1): * differential: => Phab:D4351 Comment: I fixed these in Phab:D4351. FWIW I get some other failures in profiling tests on my laptop related: {{{ /tmp/ghctest-eh09_t6n/test spaces/./profiling/should_run/scc001.run scc001 [bad stdout] (ghci-ext-prof) /tmp/ghctest-eh09_t6n/test spaces/./profiling/should_run/T949.run T949 [bad exit code] (prof_hc_hb) /tmp/ghctest-eh09_t6n/test spaces/./profiling/should_run/T5363.run T5363 [bad stdout] (ghci-ext-prof) }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 29 14:56:48 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 29 Jan 2018 14:56:48 -0000 Subject: [GHC] #14704: Spurious cost-centre test failures In-Reply-To: <046.aed78b7537a34d382c90181e0bd1ef41@haskell.org> References: <046.aed78b7537a34d382c90181e0bd1ef41@haskell.org> Message-ID: <061.c1a8c17fcfbafc0770eb3d2e3030b1e8@haskell.org> #14704: Spurious cost-centre test failures -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: Component: Profiling | Version: 8.5 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4351 Wiki Page: | -------------------------------------+------------------------------------- Changes (by osa1): * status: new => patch -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 29 15:28:05 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 29 Jan 2018 15:28:05 -0000 Subject: [GHC] #14735: GHC Panic with QuantifiedConstraints In-Reply-To: <051.3a02470ddbd28d332b6dd2bb0406c5fc@haskell.org> References: <051.3a02470ddbd28d332b6dd2bb0406c5fc@haskell.org> Message-ID: <066.e9fb27c2e174dadb44ce8ba32c1096b6@haskell.org> #14735: GHC Panic with QuantifiedConstraints -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: | QuantifiedContexts Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): I like having the bug reports though, and it does no harm to have them as separate tickets, provided they are clearly signposted as being on a branch, which this one is. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 29 15:33:38 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 29 Jan 2018 15:33:38 -0000 Subject: [GHC] #14699: Core library status for 8.4.1 In-Reply-To: <046.12f775ea02060174a5ac178f457055aa@haskell.org> References: <046.12f775ea02060174a5ac178f457055aa@haskell.org> Message-ID: <061.0d0e123598b37f4f6e2e3deb8cf3009b@haskell.org> #14699: Core library status for 8.4.1 -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: task | Status: new Priority: highest | Milestone: 8.4.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Description changed by bgamari: Old description: > ||= package =||= status =||= reference =|| > || `Cabal` || needs release || || > || `Win32` || on-release || || > || `array` || Needs revision || || > || `binary` || on-release || || > || `bytestring` || on-release || || > || `containers` || needs release || > https://github.com/haskell/containers/issues/501 || > || `deepseq` || needs revision || || > || `directory` || on-release || || > || `filepath` || ready || https://github.com/haskell/filepath/issues/65 > || > || `haskeline` || ready || https://github.com/judah/haskeline/issues/75 > || > || `hpc` || needs release || || > || `mtl` || needs release || https://github.com/haskell/mtl/issues/52 || > || `parallel` || needs revision || || > || `parsec` || needs release || > https://github.com/haskell/parsec/issues/86 || > || `pretty` || ready || https://github.com/haskell/pretty/issues/47 || > || `primitive` || needs release || > https://github.com/haskell/primitive/issues/72 || > || `process` || ready || https://github.com/haskell/primitive/issues/72 > || > || `stm` || needs release || #14698 || > || `terminfo` || ready || https://github.com/judah/terminfo/issues/27 || > || `text` || needs release || https://github.com/haskell/text/issues/215 > || > || `time` || on-release || || > || `transformers` || ready || #14678 || > || `unix` || needs release || https://github.com/haskell/unix/issues/106 > || > || `haddock` || needs release || > https://github.com/haskell/haddock/issues/737 || New description: ||= package =||= status =||= reference =|| || `Cabal` || needs release || https://github.com/haskell/cabal/issues/5075 || || `Win32` || on-release || || || `array` || Needs revision || || || `binary` || on-release || || || `bytestring` || on-release || || || `containers` || needs release || https://github.com/haskell/containers/issues/501 || || `deepseq` || needs revision || || || `directory` || on-release || || || `filepath` || ready || https://github.com/haskell/filepath/issues/65 || || `haskeline` || ready || https://github.com/judah/haskeline/issues/75 || || `hpc` || needs release || || || `mtl` || needs release || https://github.com/haskell/mtl/issues/52 || || `parallel` || needs revision || || || `parsec` || needs release || https://github.com/haskell/parsec/issues/86 || || `pretty` || ready || https://github.com/haskell/pretty/issues/47 || || `primitive` || needs release || https://github.com/haskell/primitive/issues/72 || || `process` || ready || https://github.com/haskell/primitive/issues/72 || || `stm` || needs release || #14698 || || `terminfo` || ready || https://github.com/judah/terminfo/issues/27 || || `text` || needs release || https://github.com/haskell/text/issues/215 || || `time` || on-release || || || `transformers` || ready || #14678 || || `unix` || needs release || https://github.com/haskell/unix/issues/106 || || `haddock` || needs release || https://github.com/haskell/haddock/issues/737 || -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 29 15:41:12 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 29 Jan 2018 15:41:12 -0000 Subject: [GHC] #14706: T11489 fails if run as root In-Reply-To: <046.a14b90f533f833e4ef6e5c85c8add140@haskell.org> References: <046.a14b90f533f833e4ef6e5c85c8add140@haskell.org> Message-ID: <061.e0c6bd0dc6f9876df1509c11a7d3b150@haskell.org> #14706: T11489 fails if run as root -------------------------------------+------------------------------------- Reporter: bgamari | Owner: dfeuer Type: bug | Status: new Priority: normal | Milestone: Component: Continuous | Version: 8.5 Integration | Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * owner: bgamari => dfeuer -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 29 15:41:29 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 29 Jan 2018 15:41:29 -0000 Subject: [GHC] #11735: Optimize coercionKind In-Reply-To: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> References: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> Message-ID: <062.082b9667245ea9319e9a3669424d6b89@haskell.org> #11735: Optimize coercionKind -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.10.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): There are a number of different things going on. 1. comment:5 gets rid of a non-linearity in `coercionKind` for the `ForallCo` case. This is a big win. We definitely want it. 2. The same non-linearity is present in `coercionKindRole` so I suggested getting rid of the duplication between the two. That seems possible by caching the role in `NthCo`. Doing so doesn't solve any known performance problems, but seems to be nicer code. 3. We have a clear problem in `simplCast`, which comes from transforming {{{ (f |> co) @t1 @t2 ... @tn ===> ((f @t1') |> co1) @t2 ... @tn ===> (etc) (f @t1' @t2' ... @tn') |> con }}} Doing these steps one at a time gives clearly non-linear behaviour. Hence comment:10. I think comment:41 is in this territory. I think it'd be helpful to separate these issues, possibly into separate tickets. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 29 15:57:14 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 29 Jan 2018 15:57:14 -0000 Subject: [GHC] #14329: GHC 8.2.1 segfaults while bootstrapping master In-Reply-To: <046.2503a1f6f14456a42761d49ce89e96f2@haskell.org> References: <046.2503a1f6f14456a42761d49ce89e96f2@haskell.org> Message-ID: <061.039499525daa2738ea00069ba6e0258b@haskell.org> #14329: GHC 8.2.1 segfaults while bootstrapping master -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.2.2 Component: Compiler | Version: 8.2.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #12960, #9065, | Differential Rev(s): Phab:D4075 #7762 | Wiki Page: | -------------------------------------+------------------------------------- Comment (by osa1): Same failure https://phabricator.haskell.org/harbormaster/build/40458/ -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 29 16:09:25 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 29 Jan 2018 16:09:25 -0000 Subject: [GHC] #14594: 2 modules / 2500LOC takes nearly 3 minutes to build In-Reply-To: <046.b60bf688db171cb4139d3998a57394f4@haskell.org> References: <046.b60bf688db171cb4139d3998a57394f4@haskell.org> Message-ID: <061.c5fc75102137d936ab74896f2d6a6834@haskell.org> #14594: 2 modules / 2500LOC takes nearly 3 minutes to build -------------------------------------+------------------------------------- Reporter: schyler | Owner: dfeuer Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.0.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by dfeuer): I tried generating a bunch of modules with derived data instances. A module with 29 single-field instances desugars to 5201 terms, 13488 types, 145 coercions. This is a similar number of terms as `Data.Set.Internal`, but about twice as many types. Core tidy is 11,705 terms, 21,960 types, and 1,479 coercions. GHC allocates 2,222,336,112 bytes compiling this compared to 1,663,610,072 for compiling `Data.Set.Internal`. I also noticed that there's actually a strong non-linearity at the low end: types with small umbers of fields have high incremental costs. For 50 definitions, using 0,1,2,3, and 4 fields each, I get 2.49, 3.85, 4.92, 5.51 and 5.66 GB of GHC allocation, respectively. I need to explore this a bit more. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 29 16:24:02 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 29 Jan 2018 16:24:02 -0000 Subject: [GHC] #11735: Optimize coercionKind In-Reply-To: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> References: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> Message-ID: <062.82ed2816e3a7dd68fcaaf3da5b95b33b@haskell.org> #11735: Optimize coercionKind -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.10.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by goldfire): Replying to [comment:45 tdammers]: > Looking at HEAD on `master`, we have the `coercionKindRole` function that is simply recursive for NthCo, and has the `nth` call embedded. So for nested NthCo's, its behavior should be quadratic. I disagree here. I think the old `coercionKindRole` was not quadratic in this way (ignoring the `ForAllCo` change). Every `coercionKindRole` recurrence calls `getNth` (twice), but that doesn't lead to quadratic behavior in the depth of `NthCo` nesting, which is what we're worried about. It does mean that running time will be proportional to the sum of the indices in the `NthCo`s, but that's to be expected. Let's put this another way: pretend all the indices in the `NthCo`s are 1, a constant. (This is fairly close to reality, anyway.) Then, we're linear, not quadratic. > > The un-refactored version has `coercionKind`, which is simply recursive (O(n)), and we have `coercionRole`, which recurses via `coercionKindRole`. The latter is really just a matter of calling `coercionKind` and `coercionRole` individually though; the `coercionRole` call makes `coercionRole` simply recursive (O(n)), but the `coercionKind` call introduces another O(n), making the entire thing also quadratic. Agreed here. But note that this would remain quadratic even if all the indices in the `NthCo`s were 1. So, if you call the original `coercionKindRole` quadratic, then this would be ''cubic'' (but I don't think that's a fair characterization -- there's nothing raised to the third power here). > > So in terms of big-O, HEAD and "un-refactored" should be the same. Why one perfoms better than the other is somewhat unclear to me though. Disagree here, as explained above. The old `coercionKindRole` was asymptotically better. But now that we cache roles, it should be good again. > > On the other hand, the separated version really is quadratic... and yet it's faster (on this test case)! That's the conundrum. > > Yes, but we don't know if it's actually big-O-faster, or just happens have a more favorable constant factor. Fair enough. I'm stymied as to why my patches make things worse. Maybe moving the `isReflexiveCo` check in `addCoerce` to the top was a bad idea? Try moving that back to where it was and then try again. The `simplCast` stuff should be vastly better than it was! Thanks! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 29 16:44:57 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 29 Jan 2018 16:44:57 -0000 Subject: [GHC] #11735: Optimize coercionKind In-Reply-To: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> References: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> Message-ID: <062.2df916b3accd3f205ef67ed606d04079@haskell.org> #11735: Optimize coercionKind -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.10.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Let's get (1) and (2) nailed before starting in on (3) and (4). Maybe move (3) and (4) to fresh tickets. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 29 17:02:07 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 29 Jan 2018 17:02:07 -0000 Subject: [GHC] #7398: RULES don't apply to a newtype constructor In-Reply-To: <046.1bb2e495c45c32508f69b7364d934e7b@haskell.org> References: <046.1bb2e495c45c32508f69b7364d934e7b@haskell.org> Message-ID: <061.954f4e24439b0b6f25878738c10f51c4@haskell.org> #7398: RULES don't apply to a newtype constructor -------------------------------------+------------------------------------- Reporter: shachaf | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 7.6.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: #6082, #10418, | Differential Rev(s): #13290 | Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Currently, wen you have {{{ {-# RULES "foo" forall x. f (g x) = h x #-} }}} we have to delay inlining `g` until the rule has had a decent chance to fire. We currently do this manually, usually thus {{{ {-# NOINLINE[1] f,g #-} }}} The obvious thing for newtypes (and indeed other data constructors, if they have wrappers that unpack their arguments) is to delay inlining them. Something like {{{ newtype T a = MkT (Maybe a) {-# NOINLINE[1] MkT #-} }}} We don't support that right now, but we could. The alternative is to try to make the rule work ''after'' inlining `MkT`, by being clever about casts. That might be possible. But it doesn't work for data constructors like {{{ data S = MkS {-# UNPACK #-} !Int }}} where the wrapper evaluates and unboxes the argument. After inlining, the original `(f (MkS x))` turns into `f (case x ov I# y -> MkS y)`, which is a lot harder to match. So I think my suggestion, for now, is that we might want to allow users to put a NOINLINE pragma on data constructors. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 29 17:05:34 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 29 Jan 2018 17:05:34 -0000 Subject: [GHC] #14630: name shadowing warnings by record pattern synonyms + RecordWildCards or NamedFieldPuns In-Reply-To: <053.0838c2dcc7b95d4aed5fb595896d561b@haskell.org> References: <053.0838c2dcc7b95d4aed5fb595896d561b@haskell.org> Message-ID: <068.01591d905f5914ac1a2d833afc6a3be1@haskell.org> #14630: name shadowing warnings by record pattern synonyms + RecordWildCards or NamedFieldPuns -------------------------------------+------------------------------------- Reporter: mizunashi_mana | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: | PatternSynonyms Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect | Unknown/Multiple error/warning at compile-time | Test Case: Blocked By: | Blocking: Related Tickets: #11228, #11970 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Adam Gundry: you may want to comment too. I'm not sure that the overloaded-record-field stuff is causing all this pain, but it's certainly complicating it. I don't have it anything lie paged in so I'd love it if you felt able to take a careful look. (I think you've been considering some simplifications of the overloaded-record-field stuff that may make things simpler, too.) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 29 17:06:25 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 29 Jan 2018 17:06:25 -0000 Subject: [GHC] #14536: Ghc panics while building stage2 with -dstg-lint In-Reply-To: <043.07052cd8274441bc63c2d750cdfb2370@haskell.org> References: <043.07052cd8274441bc63c2d750cdfb2370@haskell.org> Message-ID: <058.63f7f5c785051589c01613d01070ffa5@haskell.org> #14536: Ghc panics while building stage2 with -dstg-lint -------------------------------------+------------------------------------- Reporter: duog | Owner: duog Type: bug | Status: patch Priority: high | Milestone: 8.6.1 Component: Compiler | Version: 8.3 Resolution: | Keywords: stg-lint Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4242 Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): > I have a half finished patch to fix all the unarisation issues. There are quite a few. Thanks! Can you enumerate what the "unarisation issues" are, precisely? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 29 17:11:40 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 29 Jan 2018 17:11:40 -0000 Subject: [GHC] #14732: -fdefer-typed-holes breaks a correct program In-Reply-To: <052.1b96714b25f21170dafc623293b00787@haskell.org> References: <052.1b96714b25f21170dafc623293b00787@haskell.org> Message-ID: <067.d619040d498bf78f9bc51ffed17915d8@haskell.org> #14732: -fdefer-typed-holes breaks a correct program -------------------------------------+------------------------------------- Reporter: MitchellSalad | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): What exactly is the bug here, and how can I reproduce it? What has it got to do with `-fdefer-type-errors`? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 29 17:37:04 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 29 Jan 2018 17:37:04 -0000 Subject: [GHC] #14727: Unboxed sum performance surprisingly poor In-Reply-To: <045.2f36bcb58aa862841131b518b7ebd355@haskell.org> References: <045.2f36bcb58aa862841131b518b7ebd355@haskell.org> Message-ID: <060.ecca9ea1b289abf67e98396b8d08e8a1@haskell.org> #14727: Unboxed sum performance surprisingly poor -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: UnboxedSums 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: | -------------------------------------+------------------------------------- Comment (by simonpj): It'd be great to make a reproducible test case that Omer (the author of unboxed sums) can look at. Thanks! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 29 17:45:52 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 29 Jan 2018 17:45:52 -0000 Subject: [GHC] #14722: Error message points to wrong location In-Reply-To: <051.c333e5a6f35eca7f4991a44f21fca447@haskell.org> References: <051.c333e5a6f35eca7f4991a44f21fca447@haskell.org> Message-ID: <066.1d7774e97e14d16c81e01582f49ce2fa@haskell.org> #14722: Error message points to wrong location -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.5 Resolution: | Keywords: | TypeApplications Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect | Unknown/Multiple error/warning at compile-time | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * keywords: => TypeApplications Comment: You're right. This is a consequence of the fact that (currently) GHC reports visible-type-application errors "eagerly", as soon as it encounters them, discarding all pending errors. In this case the error you want reported will be pending (in the constraints being gathered) but it never gets a chance to be reported. Richard: it'd be good to find a way to defer the visible-type-application error. But we don't have a way to do that yet. A `HoleCan` isn't right. A constraint `[W] () ~ forall a. ???` doesn't seem right because we have nothing to put for the `??`. I suppose we could invent a new kind of deferred error constraint, perhaps generalising `HoleCan`. See [wiki:TypeApplication] for a list of other VTA-related tickets; I have not checked but I bet that some are like this one. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 29 18:16:10 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 29 Jan 2018 18:16:10 -0000 Subject: [GHC] #7398: RULES don't apply to a newtype constructor In-Reply-To: <046.1bb2e495c45c32508f69b7364d934e7b@haskell.org> References: <046.1bb2e495c45c32508f69b7364d934e7b@haskell.org> Message-ID: <061.d98a2ab464884eff0be52f6d529a640b@haskell.org> #7398: RULES don't apply to a newtype constructor -------------------------------------+------------------------------------- Reporter: shachaf | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 7.6.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: #6082, #10418, | Differential Rev(s): #13290 | Wiki Page: | -------------------------------------+------------------------------------- Comment (by nomeata): > The alternative is to try to make the rule work after inlining MkT, by being clever about casts. That might be possible. We somewhat do this already: We have {{{ {-# RULES "map/coerce" [1] map coerce = coerce #-} }}} which fires in all these cases: {{{ foo :: [Int] -> [Int] foo = map id fooAge :: [Int] -> [Age] fooAge = map Age fooCoerce :: [Int] -> [Age] fooCoerce = map coerce fooUnsafeCoerce :: [Int] -> [Age] fooUnsafeCoerce = map unsafeCoerce }}} (this is `testsuite/tests/simplCore/should_run/T2110.hs`). -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 29 18:47:45 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 29 Jan 2018 18:47:45 -0000 Subject: [GHC] #14672: Make likelyhood of branches/conditions available throughout the compiler. In-Reply-To: <047.de2c13e36902d9be8400d9448aa09671@haskell.org> References: <047.de2c13e36902d9be8400d9448aa09671@haskell.org> Message-ID: <062.53b8085edaca6550f18363bb4e215974@haskell.org> #14672: Make likelyhood of branches/conditions available throughout the compiler. -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4316 Wiki Page: | Phab:D4324 Phab:D4327 -------------------------------------+------------------------------------- Comment (by bgamari): Sadly not really; the closest thing we have is some notes at the top of `CmmParse.y`. I agree that this is a terrible situation, especially given that some performance-critical user packages actually use C--. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 29 18:50:37 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 29 Jan 2018 18:50:37 -0000 Subject: [GHC] #14244: ghc-prim: hs_atomicread* and hs_atomicwrite* missing barriers In-Reply-To: <047.186581f2b50df1c18e1d806a1ae31c18@haskell.org> References: <047.186581f2b50df1c18e1d806a1ae31c18@haskell.org> Message-ID: <062.ad9e34550c809440e2d7d92a951f3356@haskell.org> #14244: ghc-prim: hs_atomicread* and hs_atomicwrite* missing barriers -------------------------------------+------------------------------------- Reporter: trommler | Owner: trommler Type: bug | Status: closed Priority: high | Milestone: 8.4.1 Component: Prelude | Version: 8.2.1 Resolution: fixed | 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): Phab:D4009 Wiki Page: | -------------------------------------+------------------------------------- Comment (by trommler): If that helps, GCC 4.7 and up is only a build-time requirement. There are newer versions of GCC available for RHEL and CentOS as part of the Red Hat Developer Toolset for instance. In the case of the LLVM-backend you need a fairly recent (and IIRC an exact) version both at build-time and at run-time. If you are going to install LLVM then you could use clang that comes with it. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 29 19:38:04 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 29 Jan 2018 19:38:04 -0000 Subject: [GHC] #14536: Ghc panics while building stage2 with -dstg-lint In-Reply-To: <043.07052cd8274441bc63c2d750cdfb2370@haskell.org> References: <043.07052cd8274441bc63c2d750cdfb2370@haskell.org> Message-ID: <058.698b66aae3697384c1a0e9062e1a839f@haskell.org> #14536: Ghc panics while building stage2 with -dstg-lint -------------------------------------+------------------------------------- Reporter: duog | Owner: duog Type: bug | Status: patch Priority: high | Milestone: 8.6.1 Component: Compiler | Version: 8.3 Resolution: | Keywords: stg-lint Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4242 Wiki Page: | -------------------------------------+------------------------------------- Comment (by duog): Replying to [comment:7 simonpj]: > Thanks! Can you enumerate what the "unarisation issues" are, precisely? This is mostly from memory, so may not be as precise as I would like, however: * StgLint does not currently account for the fact that the types and number of arguments to `StgRhsCon`, `StgConApp` and `StgApp` change after unarisation. * StgLint does try to account for the unarisation changes in case scrutinees and Alts, but it's not quite right. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 29 20:15:32 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 29 Jan 2018 20:15:32 -0000 Subject: [GHC] #14736: unknown opcode in interpretBCO doesn't cause process termination in some circumstances Message-ID: <048.0feddee2e38487d10728e415c10a48f5@haskell.org> #14736: unknown opcode in interpretBCO doesn't cause process termination in some circumstances ----------------------------------------+--------------------------------- Reporter: alpmestan | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.4.1-alpha1 Keywords: | Operating System: Linux Architecture: Unknown/Multiple | Type of failure: None/Unknown Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: ----------------------------------------+--------------------------------- As part of my work on #14675, I ended up in a situation where `rts/Interpreter.c:interpretBCO` falls into its default case, which just does this: {{{#!c barf("interpretBCO: unknown or unimplemented opcode %d", (int)(bci & 0xFF)); }}} Which is fine. In the program from #14675, we are not processing the annotations with an external interpreter, the same runtime is compiling some module and running some code for the annotations, if my understanding is correct. And that process should therefore terminate. Except that it doesn't, not right away! And the example that uses the GHC API to load some simple module with an annotation just happily proceeds until it segfaults because `interpretBCO` didn't run to completion, probably therefore not pushing a suitable closure address or two somewhere or something along those lines. The expected behaviour here would be that the program crashes with the "unknown opcode" error message from above. So far the problem from #14675 has only been reproduced on ubuntu 16.04 with 8.4.1 alpha1, however I suspect that the bug I'm describing -- the program not terminating when we call `barf` while running code that we will splice in some module that we are compiling using the GHC API -- is independent of the particular distro or maybe even OS? Not sure, I haven't looked into that. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 29 20:33:28 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 29 Jan 2018 20:33:28 -0000 Subject: [GHC] #14735: GHC Panic with QuantifiedConstraints In-Reply-To: <051.3a02470ddbd28d332b6dd2bb0406c5fc@haskell.org> References: <051.3a02470ddbd28d332b6dd2bb0406c5fc@haskell.org> Message-ID: <066.26ad4a91ea02dae66312402772b842ac@haskell.org> #14735: GHC Panic with QuantifiedConstraints -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: wipT2893 | QuantifiedContexts Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by Iceland_jack): * keywords: QuantifiedContexts => wipT2893 QuantifiedContexts Comment: I have no issue either way, if I do make new ones I will use the keyword `wipT2893` so they're easier to track down -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 29 20:34:02 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 29 Jan 2018 20:34:02 -0000 Subject: [GHC] #14734: QuantifiedConstraints conflated with impredicative polymorphism? In-Reply-To: <051.b13ce9a287df15f46f4472a3cecc22de@haskell.org> References: <051.b13ce9a287df15f46f4472a3cecc22de@haskell.org> Message-ID: <066.fb3574aab361ee8b95195a4104658c86@haskell.org> #14734: QuantifiedConstraints conflated with impredicative polymorphism? -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.5 Resolution: | Keywords: | QuantifiedConstraints wipT2893 Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by Iceland_jack): * keywords: QuantifiedConstraints => QuantifiedConstraints wipT2893 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 29 21:02:47 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 29 Jan 2018 21:02:47 -0000 Subject: [GHC] #14733: Won't use (forall xx. f xx) with -XQuantifiedConstraints In-Reply-To: <051.d6dd7c53fb2316d2a32445d192b9d697@haskell.org> References: <051.d6dd7c53fb2316d2a32445d192b9d697@haskell.org> Message-ID: <066.61e2904fc461c9966406574814bfda33@haskell.org> #14733: Won't use (forall xx. f xx) with -XQuantifiedConstraints -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.5 Resolution: | Keywords: | QuantifiedContexts wipT2893 Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by Iceland_jack): * keywords: QuantifiedContexts => QuantifiedContexts wipT2893 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 29 21:08:54 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 29 Jan 2018 21:08:54 -0000 Subject: [GHC] #14709: Extend the plugin mechanism to access program representation In-Reply-To: <044.2e69c960decc5283f7ff746e6b782d96@haskell.org> References: <044.2e69c960decc5283f7ff746e6b782d96@haskell.org> Message-ID: <059.6feefaacada16aea5a9afb75e97d005e@haskell.org> #14709: Extend the plugin mechanism to access program representation -------------------------------------+------------------------------------- Reporter: lazac | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: GHC API | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | https://phabricator.haskell.org/D4342 https://ghc.haskell.org/trac/ghc/wiki/ExtendedPluginsProposal| -------------------------------------+------------------------------------- Comment (by bgamari): First: thanks, lazac, for the patch. GHC's plugin framework has long been waiting for someone to flesh it out and this patch looks like a great step in that direction. However, GHC's plugin interfaces are part of the compiler's public interface and as such will be supported for the foreseeable future. Consequently, we want to be careful that we don't end up introducing an interface that we will later come to regret. I discussed your patch with the Simons this morning and there was a general consensus that the proposal and the Haskell tooling community (some of whom have yet to comment here) would both benefit immensely from having the design in written form as a [[https://github.com/ghc-proposals /ghc-proposals|formal proposal]]. This would allow us to collect enough use-cases to better evaluate your proposed interfaces. I would be happy to lend a hand in developing, proof-reading, or otherwise facilitating this proposal if you like to help. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 29 23:17:29 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 29 Jan 2018 23:17:29 -0000 Subject: [GHC] #14675: GHC 8.4.1 regression: segfault when loading doctest on a module with ANNs on Ubuntu 16.04 or later In-Reply-To: <050.c5c190ffbc3e4175e84536f4424d1ad2@haskell.org> References: <050.c5c190ffbc3e4175e84536f4424d1ad2@haskell.org> Message-ID: <065.d43cf2ae5d0c717c20f17fd9a9faf882@haskell.org> #14675: GHC 8.4.1 regression: segfault when loading doctest on a module with ANNs on Ubuntu 16.04 or later -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: alpmestan Type: bug | Status: new Priority: highest | Milestone: 8.4.1 Component: GHC API | Version: 8.4.1-alpha1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Runtime crash | Test Case: Blocked By: | Blocking: Related Tickets: #14603 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by alpmestan): I made some more progress on this. It turns out that when not using an external interpreter -- like in the program from this ticket -- we run/evaluate annotations with the same runtime system that runs the program. I set a breakpoint on the evaluation of the `unsafeCoerce# ...` expression and tried to follow the execution along in gdb and in the source code of the RTS. I first saw some `Data.Data` related symbol/closure and was the led into the scheduler to later land in `rts/Interpreter.c:interpretBCO`. That function successfully interprets a few opcodes but at some point the `switch` takes the `default` branch: {{{#!c default: barf("interpretBCO: unknown or unimplemented opcode %d", (int)(bci & 0xFF)); }}} with `bci & 0xFF` equal to 32. In other words, the bytecode object interpreter gives up and we would expect the program to crash at that point, with the given error message. Except that it looks like even if we're not using an external interpreter, this does _not_ shut down the runtime system. Instead, the RTS happily goes back to compiling our module, as if the BCO interpreter had completed successfully. This unsurprisingly causes a problem just further down the road, when we're actually trying to read the result of the BCO interpreter as a Haskell value of type `AnnotationWrapper`. I have documented this unexpected behaviour in #14736, but this is not the end of the story as far as this ticket is concerned. Also, Ben pointed out to me that: {{{#!c #define bci_PUSH_APPLY_PP 32 }}} So it looks to me like we _should_ be able handle that opcode... Anyway, now that I know a lot more about what's going on, I'll set some more interesting breakpoints tomorrow, e.g on `interpretBCO`, and try to trace exactly what the interpreter reads. Similarly, I would like to see if I can pinpoint where exactly we "produce" the input to the interpreter (that we `unsafeCoerce#` to an `AnnotationWrapper`). I should eventually converge on the problem. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 29 23:31:23 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 29 Jan 2018 23:31:23 -0000 Subject: [GHC] #2893: Implement "Quantified contexts" proposal In-Reply-To: <045.2638646abdcf216191d07c9810407703@haskell.org> References: <045.2638646abdcf216191d07c9810407703@haskell.org> Message-ID: <060.e5cad4452dcafc0164c6f39eeaebdd7f@haskell.org> #2893: Implement "Quantified contexts" proposal -------------------------------------+------------------------------------- Reporter: porges | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: ⊥ Component: Compiler | Version: 6.10.1 Resolution: | Keywords: | QuantifiedContexts Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4353 Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * differential: => Phab:D4353 Comment: You can review the code at Phab:D4353 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 29 23:45:10 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 29 Jan 2018 23:45:10 -0000 Subject: [GHC] #14733: Won't use (forall xx. f xx) with -XQuantifiedConstraints In-Reply-To: <051.d6dd7c53fb2316d2a32445d192b9d697@haskell.org> References: <051.d6dd7c53fb2316d2a32445d192b9d697@haskell.org> Message-ID: <066.bcfb55b6470803422e124fcf07ee61df@haskell.org> #14733: Won't use (forall xx. f xx) with -XQuantifiedConstraints -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.5 Resolution: | Keywords: | QuantifiedContexts wipT2893 Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Currently this is by-design, but we could change the design. These forall-constraints currently behave just like a local version of a top-level instance declaration, and those are all for classes. You can't say {{{ instance ... => f Int }}} although it'd make sense to do so. So similarly you currently can't do that with the local-foralld constraints. * If we retain the restriction to class constraints only, we should reject the type signature with a civilised error message. * How bad is the restriction? You can always say {{{ class f a => C f a proof :: (forall xx. C f xx) => D (f a) }}} Would that do? Or what do your use-cases look like? It'd be a moderate pain to generalise the facility, mainly because `InstEnv` (in which we look up instances) has class constraints as a deeply-baked-in assumption. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Jan 29 23:49:09 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 29 Jan 2018 23:49:09 -0000 Subject: [GHC] #14709: Extend the plugin mechanism to access program representation In-Reply-To: <044.2e69c960decc5283f7ff746e6b782d96@haskell.org> References: <044.2e69c960decc5283f7ff746e6b782d96@haskell.org> Message-ID: <059.574ad9f31f31ee0dc69dd85af4f7fa61@haskell.org> #14709: Extend the plugin mechanism to access program representation -------------------------------------+------------------------------------- Reporter: lazac | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: GHC API | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | https://phabricator.haskell.org/D4342 https://ghc.haskell.org/trac/ghc/wiki/ExtendedPluginsProposal| -------------------------------------+------------------------------------- Comment (by simonpj): Yes, GHC's API and plugin interface exists to make it possible (and as easy as possible) to build new tools on top of GHC. It has evolved over time, but needs love, and thoughtful development. So thank you for offering some concrete suggestions. Clearly we want any new extensions to serve as wide a group of clients as possible. Sharing the proposals as a GHC proposal has proved to be a very effective way to improve ideas by discussing them with others. It would really help to have a couple of example use-cases to motivate each of the proposed plugin extensions. Thanks! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 30 00:05:50 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 30 Jan 2018 00:05:50 -0000 Subject: [GHC] #14381: Consider making ghc-pkg fill in abi-depends based on depends In-Reply-To: <045.a757b4d974e51bd6ab6f6869ba65de4c@haskell.org> References: <045.a757b4d974e51bd6ab6f6869ba65de4c@haskell.org> Message-ID: <060.6a58d1af70c59c6ebeaf3833a517c241@haskell.org> #14381: Consider making ghc-pkg fill in abi-depends based on depends -------------------------------------+------------------------------------- Reporter: ezyang | Owner: thoughtpolice Type: bug | Status: new Priority: high | Milestone: 8.2.3 Component: ghc-pkg | Version: 8.2.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4159 Wiki Page: | -------------------------------------+------------------------------------- Comment (by juhpetersen): I am going to try this patch on 8.2.2, for Fedora 28 development. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 30 00:25:11 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 30 Jan 2018 00:25:11 -0000 Subject: [GHC] #14732: -fdefer-typed-holes breaks a correct program In-Reply-To: <052.1b96714b25f21170dafc623293b00787@haskell.org> References: <052.1b96714b25f21170dafc623293b00787@haskell.org> Message-ID: <067.1ff6dfcf5f13fae1bb542d849e247df8@haskell.org> #14732: -fdefer-typed-holes breaks a correct program -------------------------------------+------------------------------------- Reporter: MitchellSalad | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): You need to compile the program with `-fdefer-typed-holes` to trigger the error: {{{ $ /opt/ghc/8.2.2/bin/ghc -fdefer-typed-holes Bug.hs [1 of 1] Compiling Bug ( Bug.hs, Bug.o ) Bug.hs:29:11: error: • Could not deduce (Unbox a) arising from a use of ‘zip’ from the context: GVector Vector (a, b) bound by the RULE "stream/zip [Vector.Unboxed]" at Bug.hs:(28,11)-(30,46) Possible fix: add (Unbox a) to the context of the RULE "stream/zip [Vector.Unboxed]" • In the first argument of ‘stream’, namely ‘(zip as bs)’ In the expression: stream (zip as bs) When checking the transformation rule "stream/zip [Vector.Unboxed]" | 29 | stream (zip as bs) = zipWith (,) (stream as) | ^^^^^^^^^ }}} This regression was introduced in 6746549772c5cc0ac66c0fce562f297f4d4b80a2 (`Add kind equalities to GHC.`). -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 30 07:03:35 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 30 Jan 2018 07:03:35 -0000 Subject: [GHC] #11735: Optimize coercionKind In-Reply-To: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> References: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> Message-ID: <062.d6ab0e7e2b18de7b9a8090f9be730533@haskell.org> #11735: Optimize coercionKind -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.10.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by tdammers): Replying to [comment:49 goldfire]: > It does mean that running time will be proportional to the sum of the indices in the `NthCo`s, but that's to be expected. Ah, you are right, this is where I went wrong - the `nth` calls follow the indices, not the nested NthCos themselves. Also explains why I'm not seeing the kind of differences in the profiles that I expected. > > > > > The un-refactored version has `coercionKind`, which is simply recursive (O(n)), and we have `coercionRole`, which recurses via `coercionKindRole`. The latter is really just a matter of calling `coercionKind` and `coercionRole` individually though; the `coercionRole` call makes `coercionRole` simply recursive (O(n)), but the `coercionKind` call introduces another O(n), making the entire thing also quadratic. > > Agreed here. But note that this would remain quadratic even if all the indices in the `NthCo`s were 1. So, if you call the original `coercionKindRole` quadratic, then this would be ''cubic'' (but I don't think that's a fair characterization -- there's nothing raised to the third power here). > > > > > So in terms of big-O, HEAD and "un-refactored" should be the same. Why one perfoms better than the other is somewhat unclear to me though. > > Disagree here, as explained above. The old `coercionKindRole` was asymptotically better. But now that we cache roles, it should be good again. Profiling results don't agree, but other than that it seems plausible. Maybe we're hitting some sort of edge case here? > > > > On the other hand, the separated version really is quadratic... and yet it's faster (on this test case)! That's the conundrum. > > > > Yes, but we don't know if it's actually big-O-faster, or just happens have a more favorable constant factor. > > Fair enough. > > I'm stymied as to why my patches make things worse. Maybe moving the `isReflexiveCo` check in `addCoerce` to the top was a bad idea? Try moving that back to where it was and then try again. The `simplCast` stuff should be vastly better than it was! This one has me baffled as well. There's a slight possibility that the profiling runs I did were contaminated with other activity on the same machine, so I might do another run on a separate machine with nothing else going on. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 30 07:41:18 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 30 Jan 2018 07:41:18 -0000 Subject: [GHC] #14737: Improve performance of Simplify.simplCast Message-ID: <047.69092b5e7fccc6314d7cb05c5e8b2174@haskell.org> #14737: Improve performance of Simplify.simplCast -------------------------------------+------------------------------------- Reporter: tdammers | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: Compile-time Unknown/Multiple | performance bug Test Case: | Blocked By: Blocking: | Related Tickets: #11735 #14683 Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- Splitting off task 3 from #11735. When compiling [https://ghc.haskell.org/trac/ghc/attachment/ticket/14683/Grammar.hs], `simplCast` eats up more execution time than we think it should. From [https://ghc.haskell.org/trac/ghc/ticket/11735#comment:10]: > Something is clearly wrong with `Simplify.simplCast`. I think I know what it is. Given > {{{ > (fun |> co) @t1 @t2 ... @tn > }}} > we will call `pushCoTyArg` `n` times, and hence does `n` singleton substitutions, via the `n` calls to `piResultTy`. > > Solution: gather up those type arguments (easy) and define > {{{ > pushCoTyArgs :: Coercion -> [Type] -> Maybe ([Type], Coercion) > }}} And [https://ghc.haskell.org/trac/ghc/ticket/11735#comment:41]: > OK. I looked at `pushCoTyArg` and friends, and I have a very simple solution: just move the `isReflexiveCo` case in `addCoerce` (a local function within `Simplify.simplCast`) to the top. That should do it. Then `pushCoTyArg` is never called with a reflexive coercion, and so the `piResultTy` case won't happen. > > Now, `pushCoArgs` might still call `pushCoTyArg` with a reflexive coercion, but it can be taught not to as well: Have `pushCoArgs` return a `Maybe ([CoreArg], Maybe Coercion)` and `pushCoArg` return a `Maybe (CoreArg, Maybe Coercion)`. If the second return values are `Nothing`, that means that there is no cast (i.e., that the cast would have been reflexive). The only client of `pushCoArg(s)` is `exprIsConApp_maybe`, which simply omits a cast if `pushCoArgs` returns `Nothing`. Then, we never have to bother creating the reflexive coercions. > > This should be an easy win all around. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 30 07:41:52 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 30 Jan 2018 07:41:52 -0000 Subject: [GHC] #11735: Optimize coercionKind In-Reply-To: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> References: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> Message-ID: <062.f3fc7825e5bb2e16454f659e37fd15a9@haskell.org> #11735: Optimize coercionKind -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.10.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by tdammers): Split off the `simplCast` part into #14737, suggest we continue the discussion there. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 30 08:06:25 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 30 Jan 2018 08:06:25 -0000 Subject: [GHC] #14709: Extend the plugin mechanism to access program representation In-Reply-To: <044.2e69c960decc5283f7ff746e6b782d96@haskell.org> References: <044.2e69c960decc5283f7ff746e6b782d96@haskell.org> Message-ID: <059.ecc31500536a1de91cd66ddee4d03d86@haskell.org> #14709: Extend the plugin mechanism to access program representation -------------------------------------+------------------------------------- Reporter: lazac | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: GHC API | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | https://phabricator.haskell.org/D4342 https://ghc.haskell.org/trac/ghc/wiki/ExtendedPluginsProposal| -------------------------------------+------------------------------------- Comment (by lazac): I created a formal propasal as it was requested. It is available in the pull request [https://github.com/ghc-proposals/ghc-proposals/pull/107]. Feel free to contribute to the proposal. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 30 08:49:31 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 30 Jan 2018 08:49:31 -0000 Subject: [GHC] #14723: GHC 8.4.1-alpha loops infinitely when typechecking In-Reply-To: <050.41938dfcc2cea4d35c5568a864ac48d8@haskell.org> References: <050.41938dfcc2cea4d35c5568a864ac48d8@haskell.org> Message-ID: <065.7068c6471d308851c7e22136cd21f20b@haskell.org> #14723: GHC 8.4.1-alpha loops infinitely when typechecking -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.4.1 Component: Compiler (Type | Version: 8.4.1-alpha1 checker) | Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Here's a diagnosis. We have {{{ class Coercibles k k1 (xs :: k) (tys :: k1) | xs -> tys instance forall k (ty :: JType) x xs (tys :: k). (ty ~ Ty x, Coercible x, Coercibles * k xs tys) => Coercibles * (JType, k) (x, xs) '(ty, tys) }}} and a wanted constraint {{{ [WD] $dCoercibles_a2K3 :: Coercibles * (JType, k_a2My[tau:1]) (Int64, ()) args_tys_a2JU[tau:1] where args_tys_a2JU :: (JType, kappa1) }}} Now, from the fundep `xs -> tys` we generate {{{ [D] arg_tys_a2JU ~ (ty::JType, tys::kappa2) }}} where `ty`, `tys`, and `kappa2` are all ''fresh unification variables''. They are fresh because they they are not directly fixed by `(x,xs)` in the instance decl, but only indirectly via the context of the instance decl (so-called "liberal" fundeps). This is legitimate. But this new derived equality is hetero-kinded, so we "park" it (as a `CIrredCan`) and emit a derived equality on the kinds {{{ [D] (JType, kappa1) ~ (JType, kappa2) }}} We solve this, by `kappa1 := kappa2`. That kicks out the two inert, unsolved constraints, both of which mention `kappa1`: {{{ [WD] $dCoercibles_a2K3 :: Coercibles * (JType, k_a2My[tau:1]) (Int64, ()) args_tys_a2JU[tau:1] [D] arg_tys_a2JU ~ (ty::JType, tys::kappa2) }}} Alas, we choose the ''former'' to solve; and that simply repeats the entire process from the beginning. If instead we chose the derived equality constraint, the `kappa1 := kappa2` would make the equality homo-kinded, so we'd solve with `args_tys_a2JU := (ty,tys)`; and now the `Coercibles` constraint matches the instance and can be solved. And even if the `Coercibles` constraint doesn't (yet) match an instance, (maybe there's another parameter to the class that prevents the match) provided we've processed all the equalities coming from the fundeps first, we'll find that, if we generate fundeps again, they are all no-ops. Bottom line: one fix would be to prioritise equality constraints, even if they are Derived. Currently we priorities Wanted constraints in the work-list over Derived, on the grounds that if we solve all the Wanted constraints we may never need to process those Derived ones at all. Another (possibly better) approach might be to remember when we have generated fundeps from a class constraint, and refrain from doing so a second time. But that seems hard, because as we rewrite the class constraint we may learn more about some of its arguments, and therefore expose more possible fundeps. So it's hard to say when we "have generated the fundeps" from a class constraint. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 30 09:14:37 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 30 Jan 2018 09:14:37 -0000 Subject: [GHC] #14738: Investigate performance of CoreTidy Message-ID: <047.ebb0353d7bf2252edbe2d77e554f7e84@haskell.org> #14738: Investigate performance of CoreTidy -------------------------------------+------------------------------------- Reporter: tdammers | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: Compile-time Unknown/Multiple | performance bug Test Case: | Blocked By: Blocking: | Related Tickets: #11735 #14683 Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- Considering the following profile output (compiling [https://ghc.haskell.org/trac/ghc/attachment/ticket/14683/Grammar.hs]): {{{ Thu Jan 25 13:11 2018 Time and Allocation Profiling Report (Final) ghc-stage2 +RTS -p -RTS -B/home/tobias/well- typed/devel/ghc/inplace/lib Grammar.hs -ddump-stg -ddump-simpl -ddump-to- file -fforce-recomp total time = 20.99 secs (20989 ticks @ 1000 us, 1 processor) total alloc = 29,250,375,256 bytes (excludes profiling overheads) COST CENTRE MODULE SRC %time %alloc CoreTidy HscMain compiler/main/HscMain.hs:1253:27-67 24.2 28.5 Stg2Stg HscMain compiler/main/HscMain.hs:1489:12-44 20.3 24.2 simplCast Simplify compiler/simplCore/Simplify.hs:871:62-87 18.7 15.9 tc_rn_src_decls TcRnDriver compiler/typecheck/TcRnDriver.hs:(494,4)-(556,7) 9.0 6.9 addCoerce-pushCoTyArg Simplify compiler/simplCore/Simplify.hs:(1236,12)-(1237,72) 7.4 6.4 subst_ty TyCoRep compiler/types/TyCoRep.hs:2237:28-32 4.3 5.1 zonkTopDecls TcRnDriver compiler/typecheck/TcRnDriver.hs:(445,16)-(446,43) 1.4 1.1 coercionKind Coercion compiler/types/Coercion.hs:1725:3-7 1.3 3.0 simplExprF1-Lam Simplify compiler/simplCore/Simplify.hs:896:5-39 1.0 1.1 }}} ...the amount of time spent in `CoreTidy` is striking, and should be investigated. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 30 09:14:55 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 30 Jan 2018 09:14:55 -0000 Subject: [GHC] #11735: Optimize coercionKind In-Reply-To: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> References: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> Message-ID: <062.3f0970f96bac850ddb129d1171ffe229@haskell.org> #11735: Optimize coercionKind -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.10.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by tdammers): `CoreTidy` performance (part 4) moved to #14738. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 30 09:15:19 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 30 Jan 2018 09:15:19 -0000 Subject: [GHC] #14738: Investigate performance of CoreTidy In-Reply-To: <047.ebb0353d7bf2252edbe2d77e554f7e84@haskell.org> References: <047.ebb0353d7bf2252edbe2d77e554f7e84@haskell.org> Message-ID: <062.59fb7eb155dcf859dbc502a48da93535@haskell.org> #14738: Investigate performance of CoreTidy -------------------------------------+------------------------------------- Reporter: tdammers | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: #11735 #14683 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by tdammers): * cc: tdammers (added) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 30 10:30:29 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 30 Jan 2018 10:30:29 -0000 Subject: [GHC] #14630: name shadowing warnings by record pattern synonyms + RecordWildCards or NamedFieldPuns In-Reply-To: <053.0838c2dcc7b95d4aed5fb595896d561b@haskell.org> References: <053.0838c2dcc7b95d4aed5fb595896d561b@haskell.org> Message-ID: <068.5eb0b83bb3369762e5dd0ae3aa16a645@haskell.org> #14630: name shadowing warnings by record pattern synonyms + RecordWildCards or NamedFieldPuns -------------------------------------+------------------------------------- Reporter: mizunashi_mana | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: | PatternSynonyms Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect | Unknown/Multiple error/warning at compile-time | Test Case: Blocked By: | Blocking: Related Tickets: #11228, #11970 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by mpickering): Do you have your patch Ryan? comment:5 seems to suggest to me implementing `isRecFldGRE` directly rather than indirectly by checking about anything to do with the parent. This is however not what Adam suggested but by disentangle I would imagine two distinct data types, one which tracks parenthood and and one which tracks whether a GRE is a record field. However, if this is the only place in the whole compiler where it matters then perhaps the implementation of this bit should be reconsidered before threading through this extra information everywhere. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 30 11:06:15 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 30 Jan 2018 11:06:15 -0000 Subject: [GHC] #14673: Unary Unboxed Tuple Type Constructor In-Reply-To: <049.d9c870f0c2ef1490b284fbb19f566786@haskell.org> References: <049.d9c870f0c2ef1490b284fbb19f566786@haskell.org> Message-ID: <064.b30881d48edc41c21170ebfc1b606ad9@haskell.org> #14673: Unary Unboxed Tuple Type Constructor -------------------------------------+------------------------------------- Reporter: andrewthad | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.4.1-alpha1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by hsyl20): Replying to [comment:4 simonpj]: > Yes, we have > > * Boxed tuple constructors: `()`, `Unit`, `(,)`, `(,,)`, etc > * Unboxed tuple constructors: `(##)`, `Unit#`, `(#,#)`, `(#,,#)`, etc The peculiarity of the one-tuple is unfortunate. Couldn't we aim towards something like this: - Boxed tuple constructors: `()*`, `(**)`, `(*,*)`, `(*,,*)`, etc. - Unboxed tuple constructors: `()#`, `(##)`, `(#,#)`, `(#,,#)`, etc. - Syntactic sugar: `()`, `(,)`, `(,,)`, etc. default to boxed tuples This would avoid the bikeshedding and fix the use of the name "unit" for a one-tuple. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 30 11:11:35 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 30 Jan 2018 11:11:35 -0000 Subject: [GHC] #14673: Unary Unboxed Tuple Type Constructor In-Reply-To: <049.d9c870f0c2ef1490b284fbb19f566786@haskell.org> References: <049.d9c870f0c2ef1490b284fbb19f566786@haskell.org> Message-ID: <064.ca24f1f3e411da0536b8afe2261ff5a6@haskell.org> #14673: Unary Unboxed Tuple Type Constructor -------------------------------------+------------------------------------- Reporter: andrewthad | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.4.1-alpha1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Bikeshedding about built-in syntax is even ''more'' difficult than bikeshedding about ordinary names! `Solo` and `Solo#` seem good to me. But in any case the libraries committee should rule on this! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 30 11:25:26 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 30 Jan 2018 11:25:26 -0000 Subject: [GHC] #11735: Optimize coercionKind In-Reply-To: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> References: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> Message-ID: <062.cd16e6e44f71afa1d3cbb9c2c7910b18@haskell.org> #11735: Optimize coercionKind -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.10.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by tdammers): Re-running my profiling job on a pristine machine without significant background noise gives me this: {{{ --- ./cases/Grammar.hs --- d74b37d565: 16.21 8ac966971e: 12.87 4eb140f564: 12.38 73a99750e1: 20.00 4572849929: 19.67 452dee3ff4: 256.07 --- ./cases/test_rules2.hs --- d74b37d565: 1.12 8ac966971e: 1.10 4eb140f564: 1.10 73a99750e1: 1.10 4572849929: 1.07 452dee3ff4: 1.03 }}} Again, with meanings: {{{ d74b37d565: simplCore improvements 8ac966971e: With NthCo Role caching 4eb140f564: Un-refactored 73a99750e1: Added some SCC's 4572849929: Simon's patch applied 452dee3ff4: baseline, GHC `master` before branching off }}} Which mostly confirms the earlier conclusions. The `test_rules2.hs` example seems to get worse as we proceed through the changes though. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 30 11:38:52 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 30 Jan 2018 11:38:52 -0000 Subject: [GHC] #11735: Optimize coercionKind In-Reply-To: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> References: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> Message-ID: <062.f260889bae9ed3a400d96a2b657d70b9@haskell.org> #11735: Optimize coercionKind -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.10.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Do you have allocation numbers for these runs? The mysterious thing is that `NthCo` caching makes things slightly worse. Of course the `NthCo` constructors have an extra field, but I'm still quite surprised that's a visible worsening. So I think it might be worth a little more digging into the worsening in `8ac966971e`, really just to discover if we have accidentally left money on the table. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 30 11:39:28 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 30 Jan 2018 11:39:28 -0000 Subject: [GHC] #11735: Optimize coercionKind In-Reply-To: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> References: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> Message-ID: <062.505fb5e13af1be03a829efd980509d4e@haskell.org> #11735: Optimize coercionKind -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.10.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): NB: the final one, `d74b37d565: simplCore improvements` is the domain of #14737 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 30 11:44:39 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 30 Jan 2018 11:44:39 -0000 Subject: [GHC] #14717: Hidden package hints no longer display In-Reply-To: <047.c46b47b6ebca0c950882fdcc6a0147c6@haskell.org> References: <047.c46b47b6ebca0c950882fdcc6a0147c6@haskell.org> Message-ID: <062.9615547db3e9e2ec2007202548a361bc@haskell.org> #14717: Hidden package hints no longer display -------------------------------------+------------------------------------- Reporter: snoyberg | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Poor/confusing | Unknown/Multiple error message | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by hvr): I wouldn't call this a bug as IIRC this was a known side-effect of the Backpack patch, but I'm surprised it wasn't pointed out in the release notes for GHC 8.2.1 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 30 12:19:01 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 30 Jan 2018 12:19:01 -0000 Subject: [GHC] #14672: Make likelyhood of branches/conditions available throughout the compiler. In-Reply-To: <047.de2c13e36902d9be8400d9448aa09671@haskell.org> References: <047.de2c13e36902d9be8400d9448aa09671@haskell.org> Message-ID: <062.dc1cac4f937b766e435db14415195ccf@haskell.org> #14672: Make likelyhood of branches/conditions available throughout the compiler. -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4316 Wiki Page: | Phab:D4324 Phab:D4327 -------------------------------------+------------------------------------- Comment (by AndreasK): Ideally we would add human readable examples to the Parser file and update https://ghc.haskell.org/trac/ghc/wiki/Commentary/Compiler/CmmType as well. But that's not a small task and outside of the scope of this. I might at least add examples for the if syntax though. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 30 12:21:27 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 30 Jan 2018 12:21:27 -0000 Subject: [GHC] #14717: Hidden package hints no longer display In-Reply-To: <047.c46b47b6ebca0c950882fdcc6a0147c6@haskell.org> References: <047.c46b47b6ebca0c950882fdcc6a0147c6@haskell.org> Message-ID: <062.8d9c0c2b0be152aa7ffbf1b18bcffcba@haskell.org> #14717: Hidden package hints no longer display -------------------------------------+------------------------------------- Reporter: snoyberg | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Poor/confusing | Unknown/Multiple error message | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * cc: ezyang (added) Comment: OK.. but perhaps a description of //why// Backpack changed this behavior would be useful since, from the perspective of someone who isn't familiar with how this works, this seems like a significant regression in error message quality. Perhaps ezyang can shed some light on the matter. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 30 12:33:51 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 30 Jan 2018 12:33:51 -0000 Subject: [GHC] #11735: Optimize coercionKind In-Reply-To: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> References: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> Message-ID: <062.6c6d8706409e7bca7710889b6defddb5@haskell.org> #11735: Optimize coercionKind -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.10.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by tdammers): Replying to [comment:55 simonpj]: > Do you have allocation numbers for these runs? > > The mysterious thing is that `NthCo` caching makes things slightly worse. Of course the `NthCo` constructors have an extra field, but I'm still quite surprised that's a visible worsening. So I think it might be worth a little more digging into the worsening in `8ac966971e`, really just to discover if we have accidentally left money on the table. Yes, of course. This is `8ac966971e`: {{{ Tue Jan 30 11:25 2018 Time and Allocation Profiling Report (Final) ghc-stage2 +RTS -p -RTS -B/home/tobias/well- typed/devel/ghc/inplace/lib ./cases/Grammar.hs -o ./a -fforce-recomp total time = 12.87 secs (12865 ticks @ 1000 us, 1 processor) total alloc = 14,385,409,080 bytes (excludes profiling overheads) COST CENTRE MODULE SRC %time %alloc simplCast Simplify compiler/simplCore/Simplify.hs:871:62-87 33.7 32.4 addCoerce-pushCoTyArg Simplify compiler/simplCore/Simplify.hs:(1236,12)-(1237,72) 13.1 13.1 tc_rn_src_decls TcRnDriver compiler/typecheck/TcRnDriver.hs:(494,4)-(556,7) 12.3 14.0 subst_ty TyCoRep compiler/types/TyCoRep.hs:2237:28-32 6.7 10.4 CoreTidy HscMain compiler/main/HscMain.hs:1253:27-67 4.4 3.9 coercionKind Coercion compiler/types/Coercion.hs:1725:3-7 2.6 6.0 zonkTopDecls TcRnDriver compiler/typecheck/TcRnDriver.hs:(445,16)-(446,43) 2.0 2.2 load'.checkHowMuch GhcMake compiler/main/GhcMake.hs:(270,9)-(272,27) 2.0 0.0 simplCast-simplCoercion Simplify compiler/simplCore/Simplify.hs:1224:57-77 1.6 1.5 simplExprF1-Lam Simplify compiler/simplCore/Simplify.hs:896:5-39 1.6 2.2 deSugar HscMain compiler/main/HscMain.hs:511:7-44 1.5 1.3 simplCast-addCoerce Simplify compiler/simplCore/Simplify.hs:1225:53-71 1.4 1.3 tcRnImports TcRnDriver compiler/typecheck/TcRnDriver.hs:240:20-50 1.0 0.1 Parser HscMain compiler/main/HscMain.hs:(316,5)-(384,20) 0.9 1.6 }}} Which isn't actually significantly worse than `4eb140f564`: {{{ Tue Jan 30 11:45 2018 Time and Allocation Profiling Report (Final) ghc-stage2 +RTS -p -RTS -B/home/tobias/well- typed/devel/ghc/inplace/lib ./cases/Grammar.hs -o ./a -fforce-recomp total time = 12.38 secs (12380 ticks @ 1000 us, 1 processor) total alloc = 14,385,403,880 bytes (excludes profiling overheads) COST CENTRE MODULE SRC %time %alloc simplCast Simplify compiler/simplCore/Simplify.hs:871:62-87 34.3 32.4 addCoerce-pushCoTyArg Simplify compiler/simplCore/Simplify.hs:(1236,12)-(1237,72) 13.3 13.1 tc_rn_src_decls TcRnDriver compiler/typecheck/TcRnDriver.hs:(494,4)-(556,7) 12.7 14.0 subst_ty TyCoRep compiler/types/TyCoRep.hs:2225:28-32 7.0 10.4 CoreTidy HscMain compiler/main/HscMain.hs:1253:27-67 4.5 3.9 coercionKind Coercion compiler/types/Coercion.hs:1707:3-7 2.9 6.0 zonkTopDecls TcRnDriver compiler/typecheck/TcRnDriver.hs:(445,16)-(446,43) 2.0 2.2 simplExprF1-Lam Simplify compiler/simplCore/Simplify.hs:896:5-39 1.8 2.2 simplCast-simplCoercion Simplify compiler/simplCore/Simplify.hs:1224:57-77 1.7 1.5 deSugar HscMain compiler/main/HscMain.hs:511:7-44 1.6 1.3 simplCast-addCoerce Simplify compiler/simplCore/Simplify.hs:1225:53-71 1.4 1.3 simplIdF Simplify compiler/simplCore/Simplify.hs:868:61-79 1.0 0.5 Parser HscMain compiler/main/HscMain.hs:(316,5)-(384,20) 1.0 1.6 }}} This is only about 4% more execution time, and 0.000035% more allocations. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 30 12:47:09 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 30 Jan 2018 12:47:09 -0000 Subject: [GHC] #14672: Make likelyhood of branches/conditions available throughout the compiler. In-Reply-To: <047.de2c13e36902d9be8400d9448aa09671@haskell.org> References: <047.de2c13e36902d9be8400d9448aa09671@haskell.org> Message-ID: <062.c9935ba695fa7c7d669f82de7017635c@haskell.org> #14672: Make likelyhood of branches/conditions available throughout the compiler. -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4316 Wiki Page: | Phab:D4324 Phab:D4327 -------------------------------------+------------------------------------- Comment (by AndreasK): [https://phabricator.haskell.org/D4327 D4327] will add likeliness Information at the STG stage. Some of the next tasks to improve on this: * Take more advantage of this in the backend. - Allow the cmm parser to process likely information in switch statements. - Build switches in a manner that the most likely path is the fastest one. - Use this information for code layout optimization. - Add hints to more cmm code used within GHC. - Investigate other use cases. * Find a good way for users to provide this information. - Bikeshedding: Syntax, Semantics etc. for HsSyn - How to represent und use this in the core Pipeline - Simon M recommended using ticks for this. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 30 12:57:03 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 30 Jan 2018 12:57:03 -0000 Subject: [GHC] #11735: Optimize coercionKind In-Reply-To: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> References: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> Message-ID: <062.9c8aa9eb78773d7132dd8794f73c9667@haskell.org> #11735: Optimize coercionKind -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.10.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by tdammers): Split off tasks 1 (the original patch from [comment:5]) and 2 (further refactoring of coercionKind/Role) into separate branches, cherry-picking commits onto current GHC HEAD. Branches are `wip/tdammers/T11735-1` and `wip/tdammers/T11735-2` (the latter also contains commits from the former, because I figured that would make more sense). I also pushed the patch for task 1 to phabricator [https://phabricator.haskell.org/D4355 D4355]. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 30 13:41:25 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 30 Jan 2018 13:41:25 -0000 Subject: [GHC] #14717: Hidden package hints no longer display In-Reply-To: <047.c46b47b6ebca0c950882fdcc6a0147c6@haskell.org> References: <047.c46b47b6ebca0c950882fdcc6a0147c6@haskell.org> Message-ID: <062.3d6c83fdc6a968b05e5f9b5541b01e5e@haskell.org> #14717: Hidden package hints no longer display -------------------------------------+------------------------------------- Reporter: snoyberg | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Poor/confusing | Unknown/Multiple error message | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by taylorfausak): Thanks for reporting this! I noticed this change in behavior but didn't think too much about it. It hasn't affected my day-to-day that much because I know which packages most modules I use come from. However it would be nice to get the old suggestion back. And since I don't see the old suggestion in this thread yet, here it is: {{{ > cat Main.hs import Data.Map main = pure () > stack --resolver ghc-8.0.2 exec -- ghc -hide-all-packages -package base Main.hs [1 of 1] Compiling Main ( Main.hs, Main.o ) Main.hs:1:1: error: Failed to load interface for ‘Data.Map’ It is a member of the hidden package ‘containers-0.5.7.1’. Use -v to see a list of the files searched for. }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 30 13:51:55 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 30 Jan 2018 13:51:55 -0000 Subject: [GHC] #11735: Optimize coercionKind In-Reply-To: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> References: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> Message-ID: <062.16ac0231622e930ac8d77a5070d79ca8@haskell.org> #11735: Optimize coercionKind -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.10.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): So the allocations are really close. Where does the extra time go? Can you show mutator and GC times? Maybe residency, and hence GC time, is higher? Perhaps just an accident of the moments at which major GC happens. What happens if you use use just one generation? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 30 14:27:18 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 30 Jan 2018 14:27:18 -0000 Subject: [GHC] #11735: Optimize coercionKind In-Reply-To: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> References: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> Message-ID: <062.a629dccb19f59d158e2151dafb410305@haskell.org> #11735: Optimize coercionKind -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.10.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by goldfire): I think I see what's going on here. The "cached role" results are from commit 8ac966971ec6c30cc3681a913fb9fb1c2342f6cc. This version eagerly computes the role for an `NthCo` in `mkNthCo`. This means that every (`seq`ed) `NthCo` requires a role calculation. Perhaps sometimes, we create an `NthCo` and never ever check its role. If that's the case, then 8ac96 will be worse. On the other hand, what if you try my commit 8a6aa5030d34592200fbe799bf38abf3701544db? (Do not be thrown off by the same first two characters of the hash! I was.) That commit supplies the role to `mkNthCo`, as it can often be deduced by the caller of `mkNthCo` without too much trouble. No redundant role computation. This one should really be a clear win. By the way, I changed slightly the way I cached the role: I allowed a more permissive role in the `NthCo`. For example, suppose you have `g :: [a] ~N [b]` and you want `h :: a ~R b`. Before these patches, you would use `h = SubCo (NthCo 0 g)`. With the patch, you can now say `h = NthCo Representational 0 g`, where Lint checks to make sure that the role is appropriate. Because of this new degree of freedom, it became necessary to serialize the role in iface files. (The serializer could instead be clever and convert an `NthCo` into a `SubCo` and an `NthCo`, but that seemed not to be worth it.) I forget if this realization about iface files made it into the original patch -- that change might be in a later commit. But the commit I referenced above should work fine outside of iface files. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 30 14:27:24 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 30 Jan 2018 14:27:24 -0000 Subject: [GHC] #14630: name shadowing warnings by record pattern synonyms + RecordWildCards or NamedFieldPuns In-Reply-To: <053.0838c2dcc7b95d4aed5fb595896d561b@haskell.org> References: <053.0838c2dcc7b95d4aed5fb595896d561b@haskell.org> Message-ID: <068.60fe6af8800e4f32a9b6e8f0f73e0c61@haskell.org> #14630: name shadowing warnings by record pattern synonyms + RecordWildCards or NamedFieldPuns -------------------------------------+------------------------------------- Reporter: mizunashi_mana | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: | PatternSynonyms Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect | Unknown/Multiple error/warning at compile-time | Test Case: Blocked By: | Blocking: Related Tickets: #11228, #11970 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): mpickering, my patch is located here: https://github.com/RyanGlScott/ghc/commit/e1262b33092e8b3e2d8bfed588334d14aaed7041 . The main highlights are that it adds a new constructor to `AvailInfo` and `Parent` corresponding to pattern synonym record fields. As I discovered, this is remarkably close to what the state of affairs was pre-#11970 (although back then the information tracked whether a name was a pattern synonym, not necessarily a pattern synonym record field, so perhaps I'm comparing apples to oranges). I'd certainly be open to a simpler approach, although it's not entirely clear to me at the moment what that would be. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 30 14:30:35 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 30 Jan 2018 14:30:35 -0000 Subject: [GHC] #12567: `ghc --make` recompiles unchanged files when using `-fplugin` OPTIONS In-Reply-To: <048.43f14cd5930ab5b814c814d30cfc4c67@haskell.org> References: <048.43f14cd5930ab5b814c814d30cfc4c67@haskell.org> Message-ID: <063.b4b3a527886764fd2cac4b9916c2655a@haskell.org> #12567: `ghc --make` recompiles unchanged files when using `-fplugin` OPTIONS -------------------------------------+------------------------------------- Reporter: heisenbug | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.10.3 Resolution: | Keywords: plugin, | RecompilationCheck Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: #7414 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by mpickering): I wrote a proposal which would resolve this issue. https://github.com/ghc-proposals/ghc-proposals/pull/108 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 30 14:31:22 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 30 Jan 2018 14:31:22 -0000 Subject: [GHC] #14735: GHC Panic with QuantifiedConstraints In-Reply-To: <051.3a02470ddbd28d332b6dd2bb0406c5fc@haskell.org> References: <051.3a02470ddbd28d332b6dd2bb0406c5fc@haskell.org> Message-ID: <066.589179431bfdda368249223090508d7d@haskell.org> #14735: GHC Panic with QuantifiedConstraints -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: wipT2893 | QuantifiedContexts Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): Ah, OK. If Simon is alright with this state of affairs, then I have no objection :) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 30 14:44:31 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 30 Jan 2018 14:44:31 -0000 Subject: [GHC] #14739: Cannot compile ghc 8.2.1 or 8.2.2 on armv7l architectures Message-ID: <046.1ed8f551eed623189a3adefebbf7dccb@haskell.org> #14739: Cannot compile ghc 8.2.1 or 8.2.2 on armv7l architectures -------------------------------------+------------------------------------- Reporter: mitchty | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: Building GHC Unknown/Multiple | failed Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- Noticed while trying to build ghc 8.2.1, and ghc 8.2.2 on alpine linux armhf as well as nixos. Opening this ticket as I previously thought this was just some quirk of the alpine linux port but managed to find out from dhess on irc that nixos hits the same issue for both as well on armv7l arches. What happens. 8.2.1 logs, 8.2.2 has similar or the same issues, I was just double checking that 8.2.1 has the same problems. {{{ "inplace/bin/ghc-stage2" -hisuf dyn_hi -osuf dyn_o -hcsuf dyn_hc -fPIC -dynamic -H32m -O -Wall -hide-all-packag es -i -iutils/haddock/driver -iutils/haddock/haddock-api/src -iutils/haddock/haddock-library/vendor/attoparsec-0.13.1. 0 -iutils/haddock/haddock-library/src -iutils/haddock/dist/build -Iutils/haddock/dist/build -iutils/haddock/dist/build /haddock/autogen -Iutils/haddock/dist/build/haddock/autogen -optP- DIN_GHC_TREE -optP-include -optPutils/haddock/dis t/build/haddock/autogen/cabal_macros.h -package-id base-4.10.0.0 -package- id filepath-1.4.1.2 -package-id directory-1. 3.0.2 -package-id containers-0.5.10.2 -package-id deepseq-1.4.3.0 -package-id array-0.5.2.0 -package-id xhtml-3000.2.2 -package-id Cabal-2.0.0.2 -package-id ghc-boot-8.2.1 -package-id ghc-8.2.1 -package-id bytestring-0.10.8.2 -package-i d transformers-0.5.2.0 -funbox-strict-fields -Wall -fwarn-tabs -O2 -threaded -XHaskell2010 -no-user-package-db -rtsop ts -Wno-unused-imports -Wno-deprecations -Wnoncanonical-monad- instances -odir utils/haddock/dist/build -hidir uti ls/haddock/dist/build -stubdir utils/haddock/dist/build -c utils/haddock/haddock-api/src/Haddock/Backends/Hyperlink er/Types.hs -o utils/haddock/dist/build/Haddock/Backends/Hyperlinker/Types.dyn_o "inplace/bin/ghc-stage2" -hisuf dyn_hi -osuf dyn_o -hcsuf dyn_hc -fPIC -dynamic -H32m -O -Wall -hide-all-packag es -i -iutils/haddock/driver -iutils/haddock/haddock-api/src -iutils/haddock/haddock-library/vendor/attoparsec-0.13.1. 0 -iutils/haddock/haddock-library/src -iutils/haddock/dist/build -Iutils/haddock/dist/build -iutils/haddock/dist/build /haddock/autogen -Iutils/haddock/dist/build/haddock/autogen -optP- DIN_GHC_TREE -optP-include -optPutils/haddock/dis t/build/haddock/autogen/cabal_macros.h -package-id base-4.10.0.0 -package- id filepath-1.4.1.2 -package-id directory-1. 3.0.2 -package-id containers-0.5.10.2 -package-id deepseq-1.4.3.0 -package-id array-0.5.2.0 -package-id xhtml-3000.2.2 -package-id Cabal-2.0.0.2 -package-id ghc-boot-8.2.1 -package-id ghc-8.2.1 -package-id bytestring-0.10.8.2 -package-i d transformers-0.5.2.0 -funbox-strict-fields -Wall -fwarn-tabs -O2 -threaded -XHaskell2010 -no-user-package-db -rtsop ts -Wno-unused-imports -Wno-deprecations -Wnoncanonical-monad- instances -odir utils/haddock/dist/build -hidir uti ls/haddock/dist/build -stubdir utils/haddock/dist/build -c utils/haddock/haddock-library/src/Documentation/Haddock/ Types.hs -o utils/haddock/dist/build/Documentation/Haddock/Types.dyn_o make[1]: *** [utils/haddock/ghc.mk:21: utils/haddock/dist/build/Documentation/Haddock/Types.dyn_o] Segmentation fault (core dumped) make[1]: *** Waiting for unfinished jobs.... make[1]: *** [utils/haddock/ghc.mk:21: utils/haddock/dist/build/ResponseFile.dyn_o] Segmentation fault (core dumped) make[1]: *** [utils/haddock/ghc.mk:21: utils/haddock/dist/build/Haddock/GhcUtils.dyn_o] Segmentation fault (core dumpe d) make[1]: *** [utils/haddock/ghc.mk:21: utils/haddock/dist/build/Haddock/Backends/Hyperlinker/Types.dyn_o] Segmentation fault (core dumped) $ gdb /home/build/aports/community/ghc/src/ghc-8.2.1/inplace/lib/bin/ghc- stage2 src/ghc-8.2.1/core GNU gdb (GDB) 7.12.1 Copyright (C) 2017 Free Software Foundation, Inc. License GPLv3+: GNU GPL version 3 or later This is free software: you are free to change and redistribute it. There is NO WARRANTY, to the extent permitted by law. Type "show copying" and "show warranty" for details. This GDB was configured as "armv6-alpine-linux-musleabihf". Type "show configuration" for configuration details. For bug reporting instructions, please see: . Find the GDB manual and other documentation resources online at: . For help, type "help". Type "apropos word" to search for commands related to "word"... Reading symbols from /home/build/aports/community/ghc/src/ghc-8.2.1/inplace/lib/bin/ghc- stage2...done. [New LWP 24905] [New LWP 24908] bt Core was generated by `/home/build/aports/community/ghc/src/ghc-8.2.1/inplace/lib/bin/ghc-stage2 -B/ho'. Program terminated with signal SIGSEGV, Segmentation fault. #0 0x0019d628 in stg_IND_STATIC_info () [Current thread is 1 (LWP 24905)] (gdb) bt #0 0x0019d628 in stg_IND_STATIC_info () #1 0xaffcfe1c in stg_newAlignedPinnedByteArrayzh$def () from /home/build/aports/community/ghc/src/ghc-8.2.1/rts/dist/build /libHSrts_thr-ghc8.2.1.so Backtrace stopped: previous frame identical to this frame (corrupt stack?) (gdb) }}} I've been poking around but i'm a bit out of my depth here in understanding the ghc rts here and debugging it as well. But its curious that only the stage2 compiler is having issues being built and not stage0 or stage1. If needed/desired I can provide access/login to this box for debugging but its sloooow, ~29 hours to do a build to this point. But I'm willing to help move things along, ghc on arm is one of the main reaons for the port to alpine linux and 8.0.2 works fine. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 30 14:47:34 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 30 Jan 2018 14:47:34 -0000 Subject: [GHC] #14630: name shadowing warnings by record pattern synonyms + RecordWildCards or NamedFieldPuns In-Reply-To: <053.0838c2dcc7b95d4aed5fb595896d561b@haskell.org> References: <053.0838c2dcc7b95d4aed5fb595896d561b@haskell.org> Message-ID: <068.d730237bd25f5964b8393c92aaeb96eb@haskell.org> #14630: name shadowing warnings by record pattern synonyms + RecordWildCards or NamedFieldPuns -------------------------------------+------------------------------------- Reporter: mizunashi_mana | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: | PatternSynonyms Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect | Unknown/Multiple error/warning at compile-time | Test Case: Blocked By: | Blocking: Related Tickets: #11228, #11970 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by mpickering): If the check happened later and you could use `Id`s then calling `isRecordSelector` would be appropriate. However, this check looks far too aggressive anyway, if you ever shadow a selector in a module with `RecordWildCards` enabled then you don't get a warning. {{{ {-# LANGUAGE RecordWildCards #-} module Foo where data T = T {a :: Int } -- No warning about a qux (T b) = let a = 2 in 5 }}} In general it looks like the code dealing with shadowing could do with some attention. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 30 14:50:01 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 30 Jan 2018 14:50:01 -0000 Subject: [GHC] #14630: name shadowing warnings by record pattern synonyms + RecordWildCards or NamedFieldPuns In-Reply-To: <053.0838c2dcc7b95d4aed5fb595896d561b@haskell.org> References: <053.0838c2dcc7b95d4aed5fb595896d561b@haskell.org> Message-ID: <068.22124c8e5e57c0399e32c1000bda63b9@haskell.org> #14630: name shadowing warnings by record pattern synonyms + RecordWildCards or NamedFieldPuns -------------------------------------+------------------------------------- Reporter: mizunashi_mana | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: | PatternSynonyms Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect | Unknown/Multiple error/warning at compile-time | Test Case: Blocked By: | Blocking: Related Tickets: #11228, #11970 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): Replying to [comment:10 mpickering]: > In general it looks like the code dealing with shadowing could do with some attention. I fully agree with you there. That being said, my sole motivation was to get normal record selectors and pattern synonym record selectors on equal footing, not to fix every issue with record selectors under the sun :) For the time being, at least, the most direct path forward would be finding the minimum API change that would be necessary to achieve the former goal. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 30 14:51:50 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 30 Jan 2018 14:51:50 -0000 Subject: [GHC] #14630: name shadowing warnings by record pattern synonyms + RecordWildCards or NamedFieldPuns In-Reply-To: <053.0838c2dcc7b95d4aed5fb595896d561b@haskell.org> References: <053.0838c2dcc7b95d4aed5fb595896d561b@haskell.org> Message-ID: <068.4a234cb5f2863f01a28fe920a51fed47@haskell.org> #14630: name shadowing warnings by record pattern synonyms + RecordWildCards or NamedFieldPuns -------------------------------------+------------------------------------- Reporter: mizunashi_mana | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: | PatternSynonyms Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect | Unknown/Multiple error/warning at compile-time | Test Case: Blocked By: | Blocking: Related Tickets: #11228, #11970 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by mpickering): I would just tell the user to turn off the shadowing warning rather than commit to a +150 line patch which may never be improved. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 30 14:56:58 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 30 Jan 2018 14:56:58 -0000 Subject: [GHC] #14739: Cannot compile ghc 8.2.1 or 8.2.2 on armv7l architectures In-Reply-To: <046.1ed8f551eed623189a3adefebbf7dccb@haskell.org> References: <046.1ed8f551eed623189a3adefebbf7dccb@haskell.org> Message-ID: <061.e4b44f88a77e56012ee65c30a75b3863@haskell.org> #14739: Cannot compile ghc 8.2.1 or 8.2.2 on armv7l architectures -------------------------------------+------------------------------------- Reporter: mitchty | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Building GHC | Unknown/Multiple failed | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by mitchty): A bit of poking around on an 8.2.2 core: {{{ (gdb) bt #0 0x0019fb54 in ghczmprim_GHCziTypes_Izh_con_info () #1 0xaffa03e8 in ?? () from /home/build/ghc/src/ghc-8.2.2/rts/dist/build /libHSrts_thr_debug-ghc8.2.2.so Backtrace stopped: previous frame identical to this frame (corrupt stack?) (gdb) pinfo 0x0019fb54 $1 = {layout = {payload = {ptrs = 28673, nptrs = 57991}, bitmap = 3800526849, large_bitmap_offset = -494440447, selector_offset = 3800526849}, type = 65296, srt_bitmap = 57647, code = 0x19fb54 ""} (gdb) p16 0x0019fb54 0x19fb90 : 0xe5950000 0x19fb8c : 0xe12fff10 0x19fb88 : 0xe2877001 0x19fb84 : 0xe5950000 0x19fb80 : 0xe12fff10 0x19fb7c : 0xe2877001 0x19fb78 : 0xe5950000 0x19fb74 : 0xe12fff10 0x19fb70 : 0xe2877001 0x19fb6c : 0xe5950000 0x19fb68 : 0xe12fff10 0x19fb64 : 0xe2877001 0x19fb60 : 0xe5950000 0x19fb5c : 0xe12fff10 0x19fb58 : 0xe2877001 0x19fb54 : 0xe5950000 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 30 15:12:45 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 30 Jan 2018 15:12:45 -0000 Subject: [GHC] #14673: Unary Unboxed Tuple Type Constructor In-Reply-To: <049.d9c870f0c2ef1490b284fbb19f566786@haskell.org> References: <049.d9c870f0c2ef1490b284fbb19f566786@haskell.org> Message-ID: <064.c858a29aec277cc0ff10a2ed023da479@haskell.org> #14673: Unary Unboxed Tuple Type Constructor -------------------------------------+------------------------------------- Reporter: andrewthad | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.4.1-alpha1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by andrewthad): What's the procedure for getting the core libraries committee to rule on something? Can I just send an email to core-libraries-committee AT haskell.org linking to all the relevant discussion and asking them to decide on a name. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 30 15:15:05 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 30 Jan 2018 15:15:05 -0000 Subject: [GHC] #14673: Unary Unboxed Tuple Type Constructor In-Reply-To: <049.d9c870f0c2ef1490b284fbb19f566786@haskell.org> References: <049.d9c870f0c2ef1490b284fbb19f566786@haskell.org> Message-ID: <064.de8b4a4192c4958d24aa18061f43cf3b@haskell.org> #14673: Unary Unboxed Tuple Type Constructor -------------------------------------+------------------------------------- Reporter: andrewthad | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.4.1-alpha1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by andrewthad): Also, to address carter's question, my intent was that this would be for both the type constructors and the term constructors. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 30 15:18:09 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 30 Jan 2018 15:18:09 -0000 Subject: [GHC] #14672: Make likelyhood of branches/conditions available throughout the compiler. In-Reply-To: <047.de2c13e36902d9be8400d9448aa09671@haskell.org> References: <047.de2c13e36902d9be8400d9448aa09671@haskell.org> Message-ID: <062.3472ce19289b5a668c7ae8f95606729c@haskell.org> #14672: Make likelyhood of branches/conditions available throughout the compiler. -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4316 Wiki Page: | Phab:D4324 Phab:D4327 -------------------------------------+------------------------------------- Comment (by svenpanne): Just a general remark: [https://phabricator.haskell.org/D4327 D4327] talks about annotations as a source of likelihood values, which is fine, but having actual data from previous runs, i.e. using profile-guided optimization, would probably have much more potential. Humans are notoriously bad at guessing what actually eats performace, so manual annotations can only get you so far. As an example: The performance of the CPython interpreter itself increases by roughly 10% if it is compiled with PGO and LTO (link-time optimization), see e.g. * https://bugs.python.org/issue24915 * https://www.activestate.com/blog/2014/06/python-performance-boost- using-profile-guided-optimization Of course the effect of PGO heavily depends on the actual program and the programming language, but I think it is something which should be considered in the long run. Perhaps our LLVM backend already has some (relatively) easy way to make profile data available to the LLVM pipeline, but I might be wrong here. https://msdn.microsoft.com/en-us/library/e7k32f4k.aspx lists a few PGOs, and some are definitely worthwhile for GHC, e.g. using profile data in the register allocator to decide which registers to spill etc. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 30 15:18:19 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 30 Jan 2018 15:18:19 -0000 Subject: [GHC] #14674: Deferring more levity polymorphism checks in indefinite backpack modules In-Reply-To: <049.f63f9dc5c6b5c2a7debe049513b8ff01@haskell.org> References: <049.f63f9dc5c6b5c2a7debe049513b8ff01@haskell.org> Message-ID: <064.2ba3f171988510e5fc7abaef4e254a64@haskell.org> #14674: Deferring more levity polymorphism checks in indefinite backpack modules -------------------------------------+------------------------------------- Reporter: andrewthad | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.4.1-alpha1 Resolution: | Keywords: backpack Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by andrewthad): Another more simple solution to this problem would be to add a flag that could only be used with indefinite modules named `-fdefer-levity-check`. This would entirely disable the binder rule for indefinite modules where it was turned on. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 30 17:06:06 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 30 Jan 2018 17:06:06 -0000 Subject: [GHC] #14740: Unboxed tuple allowed in context: ((##)) => () Message-ID: <051.8b8e98ba0843035c110393441bb1b895@haskell.org> #14740: Unboxed tuple allowed in context: ((##)) => () -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 (Parser) | Keywords: UnboxedTuples | 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 have a feeling this is not intended {{{ GHCi, version 8.5.20180128: http://www.haskell.org/ghc/ :? for help Prelude> :set -XUnboxedTuples Prelude> let x :: ((##)) => (); x = () Prelude> :t x x :: () Prelude> x () Prelude> }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 30 17:06:19 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 30 Jan 2018 17:06:19 -0000 Subject: [GHC] #14740: Unboxed tuple allowed in context: ((##)) => () In-Reply-To: <051.8b8e98ba0843035c110393441bb1b895@haskell.org> References: <051.8b8e98ba0843035c110393441bb1b895@haskell.org> Message-ID: <066.174cb9da38d50ef62a9c4f81f9f09b73@haskell.org> #14740: Unboxed tuple allowed in context: ((##)) => () -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.5 (Parser) | Resolution: | Keywords: UnboxedTuples Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by Iceland_jack): * version: 8.2.2 => 8.5 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 30 18:27:10 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 30 Jan 2018 18:27:10 -0000 Subject: [GHC] #14661: Cannot derive (newtype I a b = I (F a -> F b) deriving newtype Category) for type family F In-Reply-To: <051.db51abc527e2395586903121a4d671be@haskell.org> References: <051.db51abc527e2395586903121a4d671be@haskell.org> Message-ID: <066.bfc5c578feb92fd796fb8642f549e49c@haskell.org> #14661: Cannot derive (newtype I a b = I (F a -> F b) deriving newtype Category) for type family F -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: feature request | Status: closed Priority: normal | Milestone: Component: Compiler | Version: 8.4.1-alpha1 Resolution: wontfix | Keywords: | DerivingStrategies, deriving, | TypeFamilies Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): Your example in comment:12 is quite interesting. It only fails because GHC attempts to generate the constraint `Semigroup (forall xx. Endo xx)` and immediately chokes. But we never intended to generate that constraint—we wanted `forall xx. Semigroup (Endo xx)`, a quantified constraint! I would posit that if we derive instances that require slapping a class onto a type, we should be pushing the class through `forall`s and other constraints. For instance, if we want to apply `Semigroup` to `forall xx. Endo xx`, we should push `Semigroup` through `forall xx` to obtain `forall xx. Show (Endo xx)`, and then chuck //that// into the constraint solver. (I think this same strategy would work with the program in comment:13, as we really want to generate the constraint `forall zz. ListLike zz => ListLike zz`, which could be discharged immediately. But that might require #14733 to be fixed, so perhaps it's not as good of a motivating example.) All of this assumes `QuantifiedConstraints`, of course, so it's not really actionable right now. Iceland_jack, perhaps you could open a separate ticket for this? (With the keyword `deriving` in there so that I can find it later.) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 30 18:48:45 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 30 Jan 2018 18:48:45 -0000 Subject: [GHC] #14672: Make likelyhood of branches/conditions available throughout the compiler. In-Reply-To: <047.de2c13e36902d9be8400d9448aa09671@haskell.org> References: <047.de2c13e36902d9be8400d9448aa09671@haskell.org> Message-ID: <062.a91d9917e4d379eddf25297907fde633@haskell.org> #14672: Make likelyhood of branches/conditions available throughout the compiler. -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4316 Wiki Page: | Phab:D4324 Phab:D4327 -------------------------------------+------------------------------------- Comment (by Ben Gamari ): In [changeset:"1205629228064537545a0be9c2e9a995aa2dcd03/ghc" 12056292/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="1205629228064537545a0be9c2e9a995aa2dcd03" Add likely annotation to cmm files in a few obvious places. Provide information about paths more likely to be taken in the cmm files used by the rts. This leads to slightly better assembly being generated. Reviewers: bgamari, erikd, simonmar Subscribers: alexbiehl, rwbarton, thomie, carter GHC Trac Issues: #14672 Differential Revision: https://phabricator.haskell.org/D4324 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 30 19:10:05 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 30 Jan 2018 19:10:05 -0000 Subject: [GHC] #14741: High-memory usage during compilation using Template Haskell Message-ID: <048.2e25a805133a398645ff22a5c79e588c@haskell.org> #14741: High-memory usage during compilation using Template Haskell -------------------------------------+------------------------------------- Reporter: donatello | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.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: -------------------------------------+------------------------------------- When trying to embed some files into an executable using Template Haskell, I find that memory usage during compilation exceeds 4GB and often crashes my laptop. The files I am trying to embed are only about 25MB in size (totally 35MB in size). I made a somewhat minimal example to demonstrate this problem. To embed the files, I am using the [https://hackage.haskell.org/package/file-embed `file-embed`] package (the issue persists when using the alternative [https://hackage.haskell.org/package/wai-app-static `wai-app-static`] package too. The code to demonstrate runs in Linux and is available here - https://github.com/donatello/file-embed-exp. To try it out, just clone the repository and run Make (it uses the Haskell Stack tool and the Linux dd utility). This appear to be an issue in GHC. Is there anyway to mitigate the issue in the current version? Related discussion: https://github.com/snoyberg/file-embed/issues/24 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 30 19:12:50 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 30 Jan 2018 19:12:50 -0000 Subject: [GHC] #14741: High-memory usage during compilation using Template Haskell In-Reply-To: <048.2e25a805133a398645ff22a5c79e588c@haskell.org> References: <048.2e25a805133a398645ff22a5c79e588c@haskell.org> Message-ID: <063.181fc6cb6061ed35feb549e0b607dbc8@haskell.org> #14741: High-memory usage during compilation using Template Haskell -------------------------------------+------------------------------------- Reporter: donatello | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Old description: > When trying to embed some files into an executable using Template > Haskell, I find that memory usage during compilation exceeds 4GB and > often crashes my laptop. The files I am trying to embed are only about > 25MB in size (totally 35MB in size). > > I made a somewhat minimal example to demonstrate this problem. To embed > the files, I am using the [https://hackage.haskell.org/package/file-embed > `file-embed`] package (the issue persists when using the alternative > [https://hackage.haskell.org/package/wai-app-static `wai-app-static`] > package too. The code to demonstrate runs in Linux and is available here > - https://github.com/donatello/file-embed-exp. To try it out, just clone > the repository and run Make (it uses the Haskell Stack tool and the Linux > dd utility). > > This appear to be an issue in GHC. Is there anyway to mitigate the issue > in the current version? > > Related discussion: https://github.com/snoyberg/file-embed/issues/24 New description: When trying to embed some files into an executable using Template Haskell, I find that memory usage during compilation exceeds 4GB and often crashes my laptop. The files I am trying to embed are only about 25MB in size (totally 35MB in size). I made a somewhat minimal example to demonstrate this problem. To embed the files, I am using the [https://hackage.haskell.org/package/file-embed `file-embed`] package (the issue persists when using the alternative [https://hackage.haskell.org/package/wai-app-static `wai-app-static`] package too. The code to demonstrate runs in Linux and is available here - https://github.com/donatello/file-embed-exp. To try it out, just clone the repository and run `make` (it uses the Haskell Stack tool and the Linux dd utility). This appear to be an issue in GHC. Is there anyway to mitigate the issue in the current version? Related discussion: https://github.com/snoyberg/file-embed/issues/24 -- Comment (by donatello): Fixed typo. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 30 19:18:20 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 30 Jan 2018 19:18:20 -0000 Subject: [GHC] #14704: Spurious cost-centre test failures In-Reply-To: <046.aed78b7537a34d382c90181e0bd1ef41@haskell.org> References: <046.aed78b7537a34d382c90181e0bd1ef41@haskell.org> Message-ID: <061.73eb6caecdca1a9bd63c1240dae79385@haskell.org> #14704: Spurious cost-centre test failures -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: Component: Profiling | Version: 8.5 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4351 Wiki Page: | -------------------------------------+------------------------------------- Comment (by Ben Gamari ): In [changeset:"5e8d314d9ab5a65d329170681db2938cf2d250a3/ghc" 5e8d314d/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="5e8d314d9ab5a65d329170681db2938cf2d250a3" Update outputs of T12962, scc003 - T12962: just fix function locations - scc003: reorder cost centres, cost centre `f.(...)` renamed to `f.x'` Reviewers: bgamari Subscribers: rwbarton, thomie, carter GHC Trac Issues: #14704 Differential Revision: https://phabricator.haskell.org/D4351 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 30 19:35:52 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 30 Jan 2018 19:35:52 -0000 Subject: [GHC] #7414: plugins always trigger recompilation In-Reply-To: <045.791037be90cd943b6dd26df93dd060d8@haskell.org> References: <045.791037be90cd943b6dd26df93dd060d8@haskell.org> Message-ID: <060.efa24ae278e42b9ff47d0b45fbedae54@haskell.org> #7414: plugins always trigger recompilation -------------------------------------+------------------------------------- Reporter: jwlato | Owner: (none) Type: feature request | Status: new Priority: high | Milestone: 8.6.1 Component: Compiler | Version: 7.6.1 Resolution: | Keywords: plugin, | RecompilationCheck Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: #12567 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): mpickering has written a [[ttps://github.com/ghc-proposals/ghc- proposals/pull/108|proposal]] describing one way to fix this for core-to- core plugins. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 30 19:44:25 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 30 Jan 2018 19:44:25 -0000 Subject: [GHC] #14226: Common Block Elimination pass doesn't eliminate common blocks In-Reply-To: <046.64e654c74c7432ac06e937473b6324b1@haskell.org> References: <046.64e654c74c7432ac06e937473b6324b1@haskell.org> Message-ID: <061.a95dfbc8c10f460c96516b856fd637b6@haskell.org> #14226: Common Block Elimination pass doesn't eliminate common blocks -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: new Priority: high | Milestone: 8.4.1 Component: Compiler | Version: 8.2.1 (CodeGen) | Keywords: newcomer, Resolution: | CodeGen Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #9157 | Differential Rev(s): Phab:D3973, Wiki Page: | Phab:D3999 -------------------------------------+------------------------------------- Changes (by michalt): * cc: michalt (added) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 30 20:15:07 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 30 Jan 2018 20:15:07 -0000 Subject: [GHC] #14672: Make likelyhood of branches/conditions available throughout the compiler. In-Reply-To: <047.de2c13e36902d9be8400d9448aa09671@haskell.org> References: <047.de2c13e36902d9be8400d9448aa09671@haskell.org> Message-ID: <062.3bec9cf4f1165acac23025925363f60a@haskell.org> #14672: Make likelyhood of branches/conditions available throughout the compiler. -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4316 Wiki Page: | Phab:D4324 Phab:D4327 -------------------------------------+------------------------------------- Comment (by AndreasK): Replying to [comment:8 svenpanne]: > Just a general remark: [https://phabricator.haskell.org/D4327 D4327] talks about annotations as a source of likelihood values, which is fine, but having actual data from previous runs, i.e. using profile-guided optimization, would probably have much more potential. I was talking about annotations primarily because they seem like the low hanging fruit. As far as the native codegen is concerned it makes no difference if the data comes from user suggestions or actual measurements. Having good data on all code paths would certainly be better then just an estimate for some paths the user annotated. Once we have a way to pass/use the information throughout the passes adding PGO is the next logical step and should be possible without touching anything past core. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 30 20:56:57 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 30 Jan 2018 20:56:57 -0000 Subject: [GHC] #14742: Unboxed sums can treat Int#s as Word#s Message-ID: <043.f2ad58847922732aad4c3d717b7bb370@haskell.org> #14742: Unboxed sums can treat Int#s as Word#s -------------------------------------+------------------------------------- Reporter: duog | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Keywords: UnboxedSums | Operating System: Unknown/Multiple Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- Consider the following module: {{{ {-# language MagicHash, UnboxedSums #-} {-# options_ghc -ddump-stg -dppr-debug -fprint-explicit-kinds -ddump-to- file #-} module Bug where import GHC.Prim import GHC.Types mkUnboxedSum :: () -> (# Float# | Int# #) mkUnboxedSum _ = (# | 9# #) {-# noinline mkUnboxedSum #-} foo :: Int foo = case mkUnboxedSum () of (# | i# #) -> I# i# (# f# | #) -> 8 }}} The full .dump-stg is attached. An abbreviation of the case statement in foo is: {{{ case (...) of (...) { ghc-prim:GHC.Prim.(#,,#){(w) d 89} ((us_g1h9{v} [lid] :: ghc- prim:GHC.Types.Any{(w) tc 35K} (ghc- prim:GHC.Prim.TYPE{(w) tc 32Q} 'ghc-prim:GHC.Types.WordRep{(w) d 63J})) :: ghc- prim:GHC.Types.Any{(w) tc 35K} (ghc- prim:GHC.Prim.TYPE{(w) tc 32Q} 'ghc- prim:GHC.Types.WordRep{(w) d 63J})) ((us_g1ha{v} [lid] :: ghc- prim:GHC.Types.Any{(w) tc 35K} (ghc- prim:GHC.Prim.TYPE{(w) tc 32Q} 'ghc-prim:GHC.Types.WordRep{(w) d 63J})) :: ghc- prim:GHC.Types.Any{(w) tc 35K} (ghc- prim:GHC.Prim.TYPE{(w) tc 32Q} 'ghc- prim:GHC.Types.WordRep{(w) d 63J})) ((us_g1hb{v} [lid] :: ghc- prim:GHC.Types.Any{(w) tc 35K} (ghc- prim:GHC.Prim.TYPE{(w) tc 32Q} 'ghc-prim:GHC.Types.FloatRep{(w) d 63V})) :: ghc- prim:GHC.Types.Any{(w) tc 35K} (ghc- prim:GHC.Prim.TYPE{(w) tc 32Q} 'ghc- prim:GHC.Types.FloatRep{(w) d 63V})) -> case (us_g1h9{v} [lid] :: ghc-prim:GHC.Types.Any{(w) tc 35K} (ghc-prim:GHC.Prim.TYPE{(w) tc 32Q} 'ghc- prim:GHC.Types.WordRep{(w) d 63J})) :: Prim IntRep of ((tag_g1hc{v} [lid] :: ghc-prim:GHC.Prim.Int#{(w) tc 3s}) :: ghc-prim:GHC.Prim.Int#{(w) tc 3s}) { __DEFAULT -> ghc-prim:GHC.Types.I#{(w) d 6i} [8#]; 2# -> ghc-prim:GHC.Types.I#{(w) d 6i} [(us_g1ha{v} [lid] :: ghc-prim:GHC.Types.Any{(w) tc 35K} (ghc-prim:GHC.Prim.TYPE{(w) tc 32Q} 'ghc-prim:GHC.Types.WordRep{(w) d 63J}))]; }; }}} Note that: * `us_g1h9 :: Any (TYPE WordRep)`; * `us_g1ha :: Any (Type WordRep)`; * `tag_g1hc :: Int#`; * The `2#` alternative passes `us_g1ha` to an `I#` constructor. This seems wrong to me. It comes about because `slotPrimRep . primRepSlot` (in RepType) is not the identity. StgLint found this while I was working on ticket:14541 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 30 20:57:25 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 30 Jan 2018 20:57:25 -0000 Subject: [GHC] #14742: Unboxed sums can treat Int#s as Word#s In-Reply-To: <043.f2ad58847922732aad4c3d717b7bb370@haskell.org> References: <043.f2ad58847922732aad4c3d717b7bb370@haskell.org> Message-ID: <058.7e9ad1009b1fe25820aec3c1896a8764@haskell.org> #14742: Unboxed sums can treat Int#s as Word#s -------------------------------------+------------------------------------- Reporter: duog | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: UnboxedSums Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by duog): * Attachment "Bug.dump-stg" added. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 30 21:00:52 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 30 Jan 2018 21:00:52 -0000 Subject: [GHC] #14742: Unboxed sums can treat Word#s as Int#s (was: Unboxed sums can treat Int#s as Word#s) In-Reply-To: <043.f2ad58847922732aad4c3d717b7bb370@haskell.org> References: <043.f2ad58847922732aad4c3d717b7bb370@haskell.org> Message-ID: <058.592a9c443f01eaec5b623dd7dbd1cd2d@haskell.org> #14742: Unboxed sums can treat Word#s as Int#s -------------------------------------+------------------------------------- Reporter: duog | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: UnboxedSums Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Description changed by duog: Old description: > Consider the following module: > {{{ > {-# language MagicHash, UnboxedSums #-} > > {-# options_ghc -ddump-stg -dppr-debug -fprint-explicit-kinds -ddump-to- > file #-} > > module Bug where > import GHC.Prim > import GHC.Types > > mkUnboxedSum :: () -> (# Float# | Int# #) > mkUnboxedSum _ = (# | 9# #) > {-# noinline mkUnboxedSum #-} > > foo :: Int > foo = case mkUnboxedSum () of > (# | i# #) -> I# i# > (# f# | #) -> 8 > }}} > > The full .dump-stg is attached. An abbreviation of the case statement in > foo is: > {{{ > case (...) > of > (...) > { ghc-prim:GHC.Prim.(#,,#){(w) d 89} ((us_g1h9{v} [lid] :: ghc- > prim:GHC.Types.Any{(w) tc 35K} > (ghc-prim:GHC.Prim.TYPE{(w) tc 32Q} > 'ghc-prim:GHC.Types.WordRep{(w) d 63J})) > :: ghc- > prim:GHC.Types.Any{(w) tc 35K} > (ghc- > prim:GHC.Prim.TYPE{(w) tc 32Q} > 'ghc- > prim:GHC.Types.WordRep{(w) d 63J})) > ((us_g1ha{v} [lid] :: ghc- > prim:GHC.Types.Any{(w) tc 35K} > (ghc-prim:GHC.Prim.TYPE{(w) tc 32Q} > 'ghc-prim:GHC.Types.WordRep{(w) d 63J})) > :: ghc- > prim:GHC.Types.Any{(w) tc 35K} > (ghc- > prim:GHC.Prim.TYPE{(w) tc 32Q} > 'ghc- > prim:GHC.Types.WordRep{(w) d 63J})) > ((us_g1hb{v} [lid] :: ghc- > prim:GHC.Types.Any{(w) tc 35K} > (ghc-prim:GHC.Prim.TYPE{(w) tc 32Q} > 'ghc-prim:GHC.Types.FloatRep{(w) d 63V})) > :: ghc- > prim:GHC.Types.Any{(w) tc 35K} > (ghc- > prim:GHC.Prim.TYPE{(w) tc 32Q} > 'ghc- > prim:GHC.Types.FloatRep{(w) d 63V})) -> > case > (us_g1h9{v} [lid] :: ghc-prim:GHC.Types.Any{(w) tc 35K} > (ghc-prim:GHC.Prim.TYPE{(w) tc > 32Q} > 'ghc- > prim:GHC.Types.WordRep{(w) d 63J})) :: Prim IntRep > of > ((tag_g1hc{v} [lid] :: ghc-prim:GHC.Prim.Int#{(w) tc 3s}) > :: ghc-prim:GHC.Prim.Int#{(w) tc 3s}) > { __DEFAULT -> ghc-prim:GHC.Types.I#{(w) d 6i} [8#]; > 2# -> > ghc-prim:GHC.Types.I#{(w) d 6i} [(us_g1ha{v} [lid] :: > ghc-prim:GHC.Types.Any{(w) tc 35K} > (ghc-prim:GHC.Prim.TYPE{(w) tc 32Q} > 'ghc-prim:GHC.Types.WordRep{(w) d 63J}))]; > }; > }}} > > Note that: > * `us_g1h9 :: Any (TYPE WordRep)`; > * `us_g1ha :: Any (Type WordRep)`; > * `tag_g1hc :: Int#`; > * The `2#` alternative passes `us_g1ha` to an `I#` constructor. > > This seems wrong to me. > > It comes about because `slotPrimRep . primRepSlot` (in RepType) is not > the identity. > > StgLint found this while I was working on ticket:14541 New description: Consider the following module: {{{ {-# language MagicHash, UnboxedSums #-} {-# options_ghc -ddump-stg -dppr-debug -fprint-explicit-kinds -ddump-to- file #-} module Bug where import GHC.Prim import GHC.Types mkUnboxedSum :: () -> (# Float# | Int# #) mkUnboxedSum _ = (# | 9# #) {-# noinline mkUnboxedSum #-} foo :: Int foo = case mkUnboxedSum () of (# | i# #) -> I# i# (# f# | #) -> 8 }}} The full .dump-stg is attached. An abbreviation of the case statement in foo is: {{{ case (...) of (...) { ghc-prim:GHC.Prim.(#,,#){(w) d 89} ((us_g1h9{v} [lid] :: ghc- prim:GHC.Types.Any{(w) tc 35K} (ghc- prim:GHC.Prim.TYPE{(w) tc 32Q} 'ghc-prim:GHC.Types.WordRep{(w) d 63J})) :: ghc- prim:GHC.Types.Any{(w) tc 35K} (ghc- prim:GHC.Prim.TYPE{(w) tc 32Q} 'ghc- prim:GHC.Types.WordRep{(w) d 63J})) ((us_g1ha{v} [lid] :: ghc- prim:GHC.Types.Any{(w) tc 35K} (ghc- prim:GHC.Prim.TYPE{(w) tc 32Q} 'ghc-prim:GHC.Types.WordRep{(w) d 63J})) :: ghc- prim:GHC.Types.Any{(w) tc 35K} (ghc- prim:GHC.Prim.TYPE{(w) tc 32Q} 'ghc- prim:GHC.Types.WordRep{(w) d 63J})) ((us_g1hb{v} [lid] :: ghc- prim:GHC.Types.Any{(w) tc 35K} (ghc- prim:GHC.Prim.TYPE{(w) tc 32Q} 'ghc-prim:GHC.Types.FloatRep{(w) d 63V})) :: ghc- prim:GHC.Types.Any{(w) tc 35K} (ghc- prim:GHC.Prim.TYPE{(w) tc 32Q} 'ghc- prim:GHC.Types.FloatRep{(w) d 63V})) -> case (us_g1h9{v} [lid] :: ghc-prim:GHC.Types.Any{(w) tc 35K} (ghc-prim:GHC.Prim.TYPE{(w) tc 32Q} 'ghc- prim:GHC.Types.WordRep{(w) d 63J})) :: Prim IntRep of ((tag_g1hc{v} [lid] :: ghc-prim:GHC.Prim.Int#{(w) tc 3s}) :: ghc-prim:GHC.Prim.Int#{(w) tc 3s}) { __DEFAULT -> ghc-prim:GHC.Types.I#{(w) d 6i} [8#]; 2# -> ghc-prim:GHC.Types.I#{(w) d 6i} [(us_g1ha{v} [lid] :: ghc-prim:GHC.Types.Any{(w) tc 35K} (ghc-prim:GHC.Prim.TYPE{(w) tc 32Q} 'ghc-prim:GHC.Types.WordRep{(w) d 63J}))]; }; }}} Note that: * `us_g1h9 :: Any (TYPE WordRep)`; * `us_g1ha :: Any (TYPE WordRep)`; * `tag_g1hc :: Int#`; * The `2#` alternative passes `us_g1ha` to an `I#` constructor. This seems wrong to me. It comes about because `slotPrimRep . primRepSlot` (in RepType) is not the identity. StgLint found this while I was working on ticket:14541 -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 30 21:38:08 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 30 Jan 2018 21:38:08 -0000 Subject: [GHC] #14742: Unboxed sums can treat Word#s as Int#s In-Reply-To: <043.f2ad58847922732aad4c3d717b7bb370@haskell.org> References: <043.f2ad58847922732aad4c3d717b7bb370@haskell.org> Message-ID: <058.e1658f8504c55ab77d1da94178f7febf@haskell.org> #14742: Unboxed sums can treat Word#s as Int#s -------------------------------------+------------------------------------- Reporter: duog | Owner: osa1 Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: UnboxedSums Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * cc: osa1 (added) * owner: (none) => osa1 Comment: Omer would you like to look into this? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 30 21:39:25 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 30 Jan 2018 21:39:25 -0000 Subject: [GHC] #14741: High-memory usage during compilation using Template Haskell In-Reply-To: <048.2e25a805133a398645ff22a5c79e588c@haskell.org> References: <048.2e25a805133a398645ff22a5c79e588c@haskell.org> Message-ID: <063.4318a4e0e0650c7bcda10fc5d8fd03d5@haskell.org> #14741: High-memory usage during compilation using Template Haskell -------------------------------------+------------------------------------- Reporter: donatello | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Old description: > When trying to embed some files into an executable using Template > Haskell, I find that memory usage during compilation exceeds 4GB and > often crashes my laptop. The files I am trying to embed are only about > 25MB in size (totally 35MB in size). > > I made a somewhat minimal example to demonstrate this problem. To embed > the files, I am using the [https://hackage.haskell.org/package/file-embed > `file-embed`] package (the issue persists when using the alternative > [https://hackage.haskell.org/package/wai-app-static `wai-app-static`] > package too. The code to demonstrate runs in Linux and is available here > - https://github.com/donatello/file-embed-exp. To try it out, just clone > the repository and run `make` (it uses the Haskell Stack tool and the > Linux dd utility). > > This appear to be an issue in GHC. Is there anyway to mitigate the issue > in the current version? > > Related discussion: https://github.com/snoyberg/file-embed/issues/24 New description: When trying to embed some files into an executable using Template Haskell, I find that memory usage during compilation exceeds 4GB and often crashes my laptop. The files I am trying to embed are only about 25MB in size (totally 35MB in size). I made a somewhat minimal example to demonstrate this problem. To embed the files, I am using the [https://hackage.haskell.org/package/file-embed `file-embed`] package (the issue persists when using the alternative [https://hackage.haskell.org/package/wai-app-static `wai-app-static`] package too). The code to demonstrate runs in Linux and is available here - https://github.com/donatello/file-embed-exp. To try it out, just clone the repository and run `make` (it uses the Haskell Stack tool and the Linux dd utility). This appear to be an issue in GHC. Is there anyway to mitigate the issue in the current version? Related discussion: https://github.com/snoyberg/file-embed/issues/24 -- Comment (by donatello): Fix typo. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 30 21:42:26 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 30 Jan 2018 21:42:26 -0000 Subject: [GHC] #14740: Unboxed tuple allowed in context: ((##)) => () In-Reply-To: <051.8b8e98ba0843035c110393441bb1b895@haskell.org> References: <051.8b8e98ba0843035c110393441bb1b895@haskell.org> Message-ID: <066.8f35a08bfc970f2b1b2b1b293ac19aa1@haskell.org> #14740: Unboxed tuple allowed in context: ((##)) => () -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.5 (Parser) | Resolution: | Keywords: UnboxedTuples Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Correct: not intended. If someone would like to investigate I'm happy to help. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 30 22:07:22 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 30 Jan 2018 22:07:22 -0000 Subject: [GHC] #11735: Optimize coercionKind In-Reply-To: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> References: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> Message-ID: <062.ecf6eb1ab773f065daa6e41f92d4dc65@haskell.org> #11735: Optimize coercionKind -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.10.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): It's nice that `OptCoercion` for `NthCo` gets simpler when we have the role cached. > I allowed a more permissive role in the NthCo OK, but * I didn't see a change to `mkSubCo` that would take advantage of this (by changing the role rather than wrapping in `SubCo`) * The comment on the constructor `NthCo` should state the invariant. Given `(NthCo r n co)` we require that `lteRole r (nthRole (coercionRole co) n))` or something like that. * Why does't the same flexibility apply for the other coercions that cache roles: `FunCo`, `Refl`, `TyConAppCo`, `UnivCo`? We should state their invariants too... -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 30 23:18:10 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 30 Jan 2018 23:18:10 -0000 Subject: [GHC] #14715: GHC 8.4.1-alpha regression with PartialTypeSignatures In-Reply-To: <050.adc4992a794b331cf0bfd2207ccd29b6@haskell.org> References: <050.adc4992a794b331cf0bfd2207ccd29b6@haskell.org> Message-ID: <065.1d6767272d935cbf57aca67b4f401b8e@haskell.org> #14715: GHC 8.4.1-alpha regression with PartialTypeSignatures -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.4.1 Component: Compiler (Type | Version: 8.4.1-alpha1 checker) | Keywords: Resolution: | PartialTypeSignatures Operating System: Unknown/Multiple | Architecture: Type of failure: GHC rejects | Unknown/Multiple valid program | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): I'm on this; turned out to be easy -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Jan 30 23:38:58 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 30 Jan 2018 23:38:58 -0000 Subject: [GHC] #3134: encodeFloat . decodeFloat In-Reply-To: <045.24712bc58e93c54f33f4f129effc8533@haskell.org> References: <045.24712bc58e93c54f33f4f129effc8533@haskell.org> Message-ID: <060.e8c50f72467d4826d2c9620191e8ce84@haskell.org> #3134: encodeFloat . decodeFloat -------------------------------------+------------------------------------- Reporter: roland | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: ⊥ Component: Prelude | Version: 6.10.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by lelf): * cc: lelf (added) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 31 00:06:55 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 31 Jan 2018 00:06:55 -0000 Subject: [GHC] #14693: Computing imp_finst can take up significant amount of time In-Reply-To: <046.a9caa20b4ad6e8f61c2910051e03ba80@haskell.org> References: <046.a9caa20b4ad6e8f61c2910051e03ba80@haskell.org> Message-ID: <061.76b7030ff62410a94d834e0ee5d9ba8d@haskell.org> #14693: Computing imp_finst can take up significant amount of time -------------------------------------+------------------------------------- Reporter: niteria | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: checker) | Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Any progress? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 31 03:03:23 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 31 Jan 2018 03:03:23 -0000 Subject: [GHC] #11735: Optimize coercionKind In-Reply-To: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> References: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> Message-ID: <062.db6032261ea89b64ea404cc81ef362e7@haskell.org> #11735: Optimize coercionKind -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.10.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by goldfire): All good points. Reconsidering this, I think it's probably best for me to undo this choice -- it adds a subtle complication to the theory for a very tiny upside. I probably won't get to do this until Friday, but I'll make this tweak. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 31 03:03:55 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 31 Jan 2018 03:03:55 -0000 Subject: [GHC] #11735: Optimize coercionKind In-Reply-To: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> References: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> Message-ID: <062.8220806326fd0b15351e32585ccbd0b7@haskell.org> #11735: Optimize coercionKind -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.10.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by goldfire): Note that this last point should have almost no effect at all on performance, and so any data collected now would still be valid. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 31 06:28:55 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 31 Jan 2018 06:28:55 -0000 Subject: [GHC] #14743: `UnsafeReenter` test hangs Message-ID: <043.cf7e44020eaed9a14557dc6193e09fc7@haskell.org> #14743: `UnsafeReenter` test hangs -------------------------------------+------------------------------------- Reporter: osa1 | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.5 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: -------------------------------------+------------------------------------- After a `./validate --slow` run `UnsafeReenter` process hangs forever, using CPU as well. Not sure if this happens in fast or normal validate yet, or which way do I need to reproduce. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 31 07:21:19 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 31 Jan 2018 07:21:19 -0000 Subject: [GHC] #14742: Unboxed sums can treat Word#s as Int#s In-Reply-To: <043.f2ad58847922732aad4c3d717b7bb370@haskell.org> References: <043.f2ad58847922732aad4c3d717b7bb370@haskell.org> Message-ID: <058.116ebbc7e38f914f00f71bbdc4e5a021@haskell.org> #14742: Unboxed sums can treat Word#s as Int#s -------------------------------------+------------------------------------- Reporter: duog | Owner: osa1 Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: UnboxedSums Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by osa1): I think this is by design and we should relax the STG lint check if it's becoming a problem (or maybe we can add a special case for unboxed sums). The whole point of unboxed sums is to have a compact and unboxed layout. Compactness here means same memory slot (in registers or stack or heap locations) should be able to used for values of different types. `primRepSlot` is what decides what slots can a value be put into in an unboxed sum, and mapping larger number of prim reps to smaller number of slot types means we can share same slot for values of different types/prim reps. This seemingly ill-typed STG happens because we have to give unboxed sum data cons types, but we can't really say "anything that fits into a word slot" in our current type system, so we give it the type `Word`. This leads to seemingly ill-typed STG. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 31 07:27:13 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 31 Jan 2018 07:27:13 -0000 Subject: [GHC] #14672: Make likelyhood of branches/conditions available throughout the compiler. In-Reply-To: <047.de2c13e36902d9be8400d9448aa09671@haskell.org> References: <047.de2c13e36902d9be8400d9448aa09671@haskell.org> Message-ID: <062.813e132d09c5c1b4d02a7916e28303ec@haskell.org> #14672: Make likelyhood of branches/conditions available throughout the compiler. -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4316 Wiki Page: | Phab:D4324 Phab:D4327 -------------------------------------+------------------------------------- Comment (by svenpanne): Replying to [comment:10 AndreasK]: > I was talking about annotations primarily because they seem like the low hanging fruit. I assumed that, and it's definitely the right way to start. And annotations can sometimes be really useful, e.g. GCC has ''_builtin_expect'' for a reason. :-) In general, it's just a bit hard to find the places for such annotations: You have to profile your code, identify the hot spots, and figure out if a branch hint helps. PGO automates that process. > [...] Once we have a way to pass/use the information throughout the passes adding PGO is the next logical step and should be possible without touching anything past core. PGO is not about branch hints alone, it is e.g. tremendously helpful to have an estimate how often a looping construct actually loops, know the usual target of an indirect branch etc. (Well, in a sense these are all some kind of branch hint, but in a much broader sense.) So it might be a good idea to plan for something more general than a relative branch frequency. But I guess even threading that simple information through the compiler and use it wisely is not a simple task, so let's not overengineer in the beginning... -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 31 08:32:38 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 31 Jan 2018 08:32:38 -0000 Subject: [GHC] #14741: High-memory usage during compilation using Template Haskell In-Reply-To: <048.2e25a805133a398645ff22a5c79e588c@haskell.org> References: <048.2e25a805133a398645ff22a5c79e588c@haskell.org> Message-ID: <063.6fb4f6708911d351235857eb6a66cf3a@haskell.org> #14741: High-memory usage during compilation using Template Haskell -------------------------------------+------------------------------------- Reporter: donatello | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by mpickering): If you compile with `-O0`, does that make a difference? Could you reduce the dependency footprint further to just rely on "cabal" and perhaps inline the specific parts of `file-embed` which you need? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 31 08:35:40 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 31 Jan 2018 08:35:40 -0000 Subject: [GHC] #14740: Unboxed tuple allowed in context: ((##)) => () In-Reply-To: <051.8b8e98ba0843035c110393441bb1b895@haskell.org> References: <051.8b8e98ba0843035c110393441bb1b895@haskell.org> Message-ID: <066.ce9e0ac703191f63735ebeeed7f12022@haskell.org> #14740: Unboxed tuple allowed in context: ((##)) => () -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: sighingnow Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.5 (Parser) | Resolution: | Keywords: UnboxedTuples Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by sighingnow): * owner: (none) => sighingnow -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 31 08:49:54 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 31 Jan 2018 08:49:54 -0000 Subject: [GHC] #2893: Implement "Quantified contexts" proposal In-Reply-To: <045.2638646abdcf216191d07c9810407703@haskell.org> References: <045.2638646abdcf216191d07c9810407703@haskell.org> Message-ID: <060.65c08a5a7da569b1909f7edd4ed4d3d1@haskell.org> #2893: Implement "Quantified contexts" proposal -------------------------------------+------------------------------------- Reporter: porges | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: ⊥ Component: Compiler | Version: 6.10.1 Resolution: | Keywords: | QuantifiedConstraints Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4353 Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * keywords: QuantifiedContexts => QuantifiedConstraints -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 31 08:50:10 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 31 Jan 2018 08:50:10 -0000 Subject: [GHC] #5927: A type-level "implies" constraint on Constraints In-Reply-To: <048.176646aa6f5f9bdf7a2953e1f3bc3e76@haskell.org> References: <048.176646aa6f5f9bdf7a2953e1f3bc3e76@haskell.org> Message-ID: <063.124129cc635ae61d7fb7ff6de5e5b929@haskell.org> #5927: A type-level "implies" constraint on Constraints -------------------------------------+------------------------------------- Reporter: illissius | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 7.4.1 checker) | Keywords: Resolution: | QuantifiedConstraints Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * keywords: QuantifiedContexts => QuantifiedConstraints -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 31 08:50:18 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 31 Jan 2018 08:50:18 -0000 Subject: [GHC] #8516: Add (->) representation and the Invariant class to GHC.Generics In-Reply-To: <046.4bd98a18c7a25f1a7eb2c50c7cbb4858@haskell.org> References: <046.4bd98a18c7a25f1a7eb2c50c7cbb4858@haskell.org> Message-ID: <061.995906a7132f9647c4faac9ee3e6fcf1@haskell.org> #8516: Add (->) representation and the Invariant class to GHC.Generics -------------------------------------+------------------------------------- Reporter: nfrisby | Owner: (none) Type: feature request | Status: new Priority: low | Milestone: Component: Compiler (Type | Version: 7.7 checker) | Keywords: Generics, Resolution: | QuantifiedConstraints Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * keywords: Generics, QuantifiedContexts => Generics, QuantifiedConstraints -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 31 08:50:28 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 31 Jan 2018 08:50:28 -0000 Subject: [GHC] #9123: Need for higher kinded roles In-Reply-To: <046.743e1f5edf878b0ae2d2d6b5081e6a33@haskell.org> References: <046.743e1f5edf878b0ae2d2d6b5081e6a33@haskell.org> Message-ID: <061.88a8051fa13eb6b2d23f82ee8350c713@haskell.org> #9123: Need for higher kinded roles -------------------------------------+------------------------------------- Reporter: simonpj | Owner: goldfire Type: bug | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 7.8.2 checker) | Keywords: Roles, Resolution: | QuantifiedConstraints Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * keywords: Roles, QuantifiedContexts => Roles, QuantifiedConstraints -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 31 08:50:36 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 31 Jan 2018 08:50:36 -0000 Subject: [GHC] #13153: Several Traversable instances have an extra fmap In-Reply-To: <045.14b8729ab63f00afb666b5ab8f62ee3b@haskell.org> References: <045.14b8729ab63f00afb666b5ab8f62ee3b@haskell.org> Message-ID: <060.4ec563408e490263601f9f1f6bae082b@haskell.org> #13153: Several Traversable instances have an extra fmap -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: dfeuer Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Core Libraries | Version: 8.1 Resolution: | Keywords: | QuantifiedConstraints 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: | -------------------------------------+------------------------------------- Changes (by simonpj): * keywords: QuantifiedContexts => QuantifiedConstraints -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 31 08:50:49 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 31 Jan 2018 08:50:49 -0000 Subject: =?utf-8?b?UmU6IFtHSENdICMxNDA3MDogQWxsb3cg4oCYdW5zYWZl4oCZIGRl?= =?utf-8?q?riving_strategy=2C_deriving_code_with_=E2=80=98unsafeC?= =?utf-8?b?b2VyY2XigJk=?= In-Reply-To: <051.0e42ce81d7ed5c83d414a8f7e3942e84@haskell.org> References: <051.0e42ce81d7ed5c83d414a8f7e3942e84@haskell.org> Message-ID: <066.ef2d82f26b99d787e428f1cb0c363e25@haskell.org> #14070: Allow ‘unsafe’ deriving strategy, deriving code with ‘unsafeCoerce’ -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.0.1 Resolution: | Keywords: | QuantifiedConstraints, deriving Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * keywords: QuantifiedContexts, deriving => QuantifiedConstraints, deriving -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 31 08:50:58 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 31 Jan 2018 08:50:58 -0000 Subject: [GHC] #14317: Solve Coercible constraints over type constructors In-Reply-To: <051.6e7c0afa9b7a89daa70b165c438f90b5@haskell.org> References: <051.6e7c0afa9b7a89daa70b165c438f90b5@haskell.org> Message-ID: <066.0a052d5e19df37408e9770846b30c725@haskell.org> #14317: Solve Coercible constraints over type constructors -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: | Keywords: Roles, | QuantifiedConstraints Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #14386 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * keywords: Roles, QuantifiedContexts => Roles, QuantifiedConstraints -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 31 08:51:10 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 31 Jan 2018 08:51:10 -0000 Subject: [GHC] #14733: Won't use (forall xx. f xx) with -XQuantifiedConstraints In-Reply-To: <051.d6dd7c53fb2316d2a32445d192b9d697@haskell.org> References: <051.d6dd7c53fb2316d2a32445d192b9d697@haskell.org> Message-ID: <066.f590fa0e71106b360b79114052c2022c@haskell.org> #14733: Won't use (forall xx. f xx) with -XQuantifiedConstraints -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.5 Resolution: | Keywords: | QuantifiedConstraints, wipT2893 Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * keywords: QuantifiedContexts wipT2893 => QuantifiedConstraints, wipT2893 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 31 08:51:23 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 31 Jan 2018 08:51:23 -0000 Subject: [GHC] #14735: GHC Panic with QuantifiedConstraints In-Reply-To: <051.3a02470ddbd28d332b6dd2bb0406c5fc@haskell.org> References: <051.3a02470ddbd28d332b6dd2bb0406c5fc@haskell.org> Message-ID: <066.06f35d5fc05f28d8970c44a6ed089ce9@haskell.org> #14735: GHC Panic with QuantifiedConstraints -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: wipT2893, | QuantifiedConstraints Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * keywords: wipT2893 QuantifiedContexts => wipT2893, QuantifiedConstraints -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 31 08:52:32 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 31 Jan 2018 08:52:32 -0000 Subject: [GHC] #2893: Implement "Quantified constraints" proposal (was: Implement "Quantified contexts" proposal) In-Reply-To: <045.2638646abdcf216191d07c9810407703@haskell.org> References: <045.2638646abdcf216191d07c9810407703@haskell.org> Message-ID: <060.7e00d033e2a4d24a638970d49fa09dfb@haskell.org> #2893: Implement "Quantified constraints" proposal -------------------------------------+------------------------------------- Reporter: porges | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: ⊥ Component: Compiler | Version: 6.10.1 Resolution: | Keywords: | QuantifiedConstraints Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4353 Wiki Page: | -------------------------------------+------------------------------------- Description changed by simonpj: Old description: > See: [wiki:QuantifiedContexts] New description: See: [wiki:QuantifiedContexts Quantified constraints wiki page] -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 31 08:59:11 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 31 Jan 2018 08:59:11 -0000 Subject: [GHC] #11735: Optimize coercionKind In-Reply-To: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> References: <047.4a7a4b5184d1293c5e3d53524b93fe89@haskell.org> Message-ID: <062.22e17704d7eaf893bb84b86155a0e70f@haskell.org> #11735: Optimize coercionKind -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.10.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Fine. In undoing, could you also add the invariants for all Role annotations to the data type itself? * The comment on the constructor NthCo should state the invariant. Given (NthCo r n co) we require that lteRole r (nthRole (coercionRole co) n)) or something like that. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 31 09:05:08 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 31 Jan 2018 09:05:08 -0000 Subject: [GHC] #14744: Non-exhaustive patterns in case in GHCi with quantified class contexts Message-ID: <047.58553665d8f7e6e9a44403047690aa6b@haskell.org> #14744: Non-exhaustive patterns in case in GHCi with quantified class contexts -------------------------------------+------------------------------------- Reporter: kosmikus | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.5 Keywords: wipT2893, | Operating System: Unknown/Multiple QuantifiedConstraints | Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- This appears in the wip/T2893 branch. To reproduce, create the following module {{{ {-# LANGUAGE ConstraintKinds, GADTs, KindSignatures, QuantifiedConstraints #-} module Bug where import GHC.Exts data Foo :: (* -> Constraint) -> * where MkFoo :: (forall a . c a => c (f a), c a) => (f a) -> Foo c }}} and load it into GHCi: {{{ Bug> foo = MkFoo "foo" :: Foo Show *** Exception: compiler/typecheck/TcType.hs:(1965,9)-(1985,76): Non- exhaustive patterns in case }}} Putting the same declaration into the module itself does not seem to trigger the bug. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 31 09:05:58 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 31 Jan 2018 09:05:58 -0000 Subject: [GHC] #14742: Unboxed sums can treat Word#s as Int#s In-Reply-To: <043.f2ad58847922732aad4c3d717b7bb370@haskell.org> References: <043.f2ad58847922732aad4c3d717b7bb370@haskell.org> Message-ID: <058.90dbbcd14691e555a1a4263e31dfd034@haskell.org> #14742: Unboxed sums can treat Word#s as Int#s -------------------------------------+------------------------------------- Reporter: duog | Owner: osa1 Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: UnboxedSums Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Then the right thing is to document the invariant, and make Lint check it. What ''is'' the invariant? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 31 09:06:05 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 31 Jan 2018 09:06:05 -0000 Subject: [GHC] #14744: Non-exhaustive patterns in case in GHCi with quantified class contexts In-Reply-To: <047.58553665d8f7e6e9a44403047690aa6b@haskell.org> References: <047.58553665d8f7e6e9a44403047690aa6b@haskell.org> Message-ID: <062.4ea2831afd2070db7f7ca3608c8e7535@haskell.org> #14744: Non-exhaustive patterns in case in GHCi with quantified class contexts -------------------------------------+------------------------------------- Reporter: kosmikus | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.5 checker) | Keywords: wipT2893, Resolution: | QuantifiedConstraints Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: GHCi crash | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by kosmikus): * failure: None/Unknown => GHCi crash * component: Compiler => Compiler (Type checker) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 31 09:54:15 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 31 Jan 2018 09:54:15 -0000 Subject: [GHC] #14740: Unboxed tuple allowed in context: ((##)) => () In-Reply-To: <051.8b8e98ba0843035c110393441bb1b895@haskell.org> References: <051.8b8e98ba0843035c110393441bb1b895@haskell.org> Message-ID: <066.04d7961a0444b2efa748e9f1afb897a5@haskell.org> #14740: Unboxed tuple allowed in context: ((##)) => () -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: sighingnow Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.5 (Parser) | Resolution: | Keywords: UnboxedTuples Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: T14740 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4359 Wiki Page: | -------------------------------------+------------------------------------- Changes (by sighingnow): * testcase: => T14740 * differential: => Phab:D4359 Comment: In Phab:D4359, `let x :: ((##)) => (); x = ()` will raise an error: {{{ T14740.hs:5:7: Expecting a lifted type, but ‘(# #)’ is unlifted In the type signature: x :: ((# #)) => () }}} But I'm not sure when `-XConstraintKinds` is enabled, whether the declaration `let x :: (()) => (); x = ()` is valid. The documentation of `-XConstraintKinds` says that constraints could be: > Tuples, all of whose component types have kind Constraint. To my limited knowledge, in Haskell2010 empty tuples can't be used as context constraints. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 31 11:36:25 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 31 Jan 2018 11:36:25 -0000 Subject: [GHC] #14715: GHC 8.4.1-alpha regression with PartialTypeSignatures In-Reply-To: <050.adc4992a794b331cf0bfd2207ccd29b6@haskell.org> References: <050.adc4992a794b331cf0bfd2207ccd29b6@haskell.org> Message-ID: <065.45e831b66aeb7306ec1153f9d22ae6cb@haskell.org> #14715: GHC 8.4.1-alpha regression with PartialTypeSignatures -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.4.1 Component: Compiler (Type | Version: 8.4.1-alpha1 checker) | Keywords: Resolution: | PartialTypeSignatures Operating System: Unknown/Multiple | Architecture: Type of failure: GHC rejects | Unknown/Multiple valid program | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Simon Peyton Jones ): In [changeset:"e7c3878dacbad8120aacbe4423857b5ca9b43eb4/ghc" e7c3878d/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="e7c3878dacbad8120aacbe4423857b5ca9b43eb4" Move zonkWC to the right place in simplfyInfer runTcSWithEvBinds does some unification, so the zonkWC must be after, not before! Yikes. An outright bug. This fixes Trac #14715. }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 31 11:42:11 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 31 Jan 2018 11:42:11 -0000 Subject: [GHC] #14715: GHC 8.4.1-alpha regression with PartialTypeSignatures In-Reply-To: <050.adc4992a794b331cf0bfd2207ccd29b6@haskell.org> References: <050.adc4992a794b331cf0bfd2207ccd29b6@haskell.org> Message-ID: <065.4cd4fcf10fa2c619b7f60b9d0c6ecdc9@haskell.org> #14715: GHC 8.4.1-alpha regression with PartialTypeSignatures -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: merge Priority: highest | Milestone: 8.4.1 Component: Compiler (Type | Version: 8.4.1-alpha1 checker) | Keywords: Resolution: | PartialTypeSignatures Operating System: Unknown/Multiple | Architecture: Type of failure: GHC rejects | Unknown/Multiple valid program | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * status: new => merge Comment: Merge if possible. Thanks for reporting this. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 31 12:03:16 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 31 Jan 2018 12:03:16 -0000 Subject: [GHC] #14735: GHC Panic with QuantifiedConstraints In-Reply-To: <051.3a02470ddbd28d332b6dd2bb0406c5fc@haskell.org> References: <051.3a02470ddbd28d332b6dd2bb0406c5fc@haskell.org> Message-ID: <066.b1d1a5ce75a7df4a76d4026630d448d9@haskell.org> #14735: GHC Panic with QuantifiedConstraints -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: fixed | Keywords: wipT2893, | QuantifiedConstraints Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * status: new => closed * resolution: => fixed Comment: I think I've fixed this. Try again7 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 31 12:04:27 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 31 Jan 2018 12:04:27 -0000 Subject: [GHC] #14735: GHC Panic with QuantifiedConstraints In-Reply-To: <051.3a02470ddbd28d332b6dd2bb0406c5fc@haskell.org> References: <051.3a02470ddbd28d332b6dd2bb0406c5fc@haskell.org> Message-ID: <066.284212fec9e6acc75aa24e280c4ba309@haskell.org> #14735: GHC Panic with QuantifiedConstraints -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: fixed | Keywords: wipT2893, | QuantifiedConstraints Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Commit is {{{ commit e0d5286c8cea23ca27163abe76d63c1f10719fa2 Author: Simon Peyton Jones Date: Wed Jan 31 11:54:32 2018 +0000 Move SCC on evidence binds to post-desguaring This fixes Trac #14735, and is generally nicer anyway. }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 31 12:04:59 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 31 Jan 2018 12:04:59 -0000 Subject: [GHC] #14744: Non-exhaustive patterns in case in GHCi with quantified class contexts In-Reply-To: <047.58553665d8f7e6e9a44403047690aa6b@haskell.org> References: <047.58553665d8f7e6e9a44403047690aa6b@haskell.org> Message-ID: <062.c3d092d8e03aa56c73cf96acc1605758@haskell.org> #14744: Non-exhaustive patterns in case in GHCi with quantified class contexts -------------------------------------+------------------------------------- Reporter: kosmikus | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: Component: Compiler (Type | Version: 8.5 checker) | Keywords: wipT2893, Resolution: fixed | QuantifiedConstraints Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: GHCi crash | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * status: new => closed * resolution: => fixed Comment: Fixed by {{{ commit 8c3a134045ad4f25080996917b3fe77cb506b17b Author: Simon Peyton Jones Date: Wed Jan 31 12:00:43 2018 +0000 Add missing cases for ForAllPred Should fix Trac #14744 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 31 12:16:14 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 31 Jan 2018 12:16:14 -0000 Subject: [GHC] #6087: Join points need strictness analysis In-Reply-To: <046.87e3f1b25b2500e98f2a686fd50954f8@haskell.org> References: <046.87e3f1b25b2500e98f2a686fd50954f8@haskell.org> Message-ID: <061.15a0c4e37afed3ad609d5955cc0be93a@haskell.org> #6087: Join points need strictness analysis -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: infoneeded Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 7.4.1 Resolution: | Keywords: JoinPoints 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: | -------------------------------------+------------------------------------- Comment (by osa1): GHC 8.2.2 does not generate such `Int` allocations with `-O2`. `-flate- dmd-anal` makes no difference in `possibleMoves` output. I think we can close this as fixed. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 31 12:26:14 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 31 Jan 2018 12:26:14 -0000 Subject: [GHC] #6087: Join points need strictness analysis In-Reply-To: <046.87e3f1b25b2500e98f2a686fd50954f8@haskell.org> References: <046.87e3f1b25b2500e98f2a686fd50954f8@haskell.org> Message-ID: <061.318a90198a309c2749aa708677b32a6e@haskell.org> #6087: Join points need strictness analysis -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: infoneeded Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 7.4.1 Resolution: | Keywords: JoinPoints 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: | -------------------------------------+------------------------------------- Comment (by simonpj): Hang on. So late-dmd-anal may make no difference in this particular, but I bet it makes a difference sometimes. And if so we should switch it on for -02. Could you do a nofib run with and without late-dmd-anal, to see? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 31 12:53:25 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 31 Jan 2018 12:53:25 -0000 Subject: [GHC] #14745: Functional dependency conflicts in givens Message-ID: <046.c122d934273a7fed5dfa73b01bd65ef1@haskell.org> #14745: Functional dependency conflicts in givens -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.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: -------------------------------------+------------------------------------- Consider this {{{ {-# LANGUAGE FlexibleContexts, MultiParamTypeClasses, FunctionalDependencies #-} module FunDep where class C a b c | a -> b c instance C Int Bool Char f :: (C Int b c) => a -> c f = undefined }}} When doing the ambiguity check we effectively ask whether this would typecheck {{{ g :: (C Int b c) => a -> c g = f }}} We instantiate `f`'s type, and try to solve from `g`'s type signature. So we end up with {{{ [G] d1: C Int b c [W] d2: C Int beta c }}} Now, from the fundeps we get {{{ Interact d1 with the instance: [D] b ~ Bool, [D] c ~ Char Ineract d2 with the instance: [D] beta ~ Bool, [D] c ~ Char Interact d1 with d2 [D] beta ~ b }}} What is annoying is that if we unify `beta := b`, we can solve the [W] constraint from [G], leaving only [D] constraints which we don't even always report (see discussion on #12466). But if, randomly, we instead unify `beta := Bool`, we get an insoluble constraint `[W] C Int Bool c`, which we report. So whether or not typechecking succeeds is rather random; very unsatisfactory. What is really wrong? Well, that Given constraint `(C Int b c)` is in conflict with the top-level instance decl. Maybe we should fail if that happens? But see #12466... and `Note [Given errors]` in `TcErrors`. The test program in Trac #13651 is just like this, only with type functions rather than type classes. I'm not sure what to do, but I'm leaving this ticket as a record that all is not well. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 31 13:13:13 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 31 Jan 2018 13:13:13 -0000 Subject: [GHC] #14745: Functional dependency conflicts in givens In-Reply-To: <046.c122d934273a7fed5dfa73b01bd65ef1@haskell.org> References: <046.c122d934273a7fed5dfa73b01bd65ef1@haskell.org> Message-ID: <061.d2731e3bfc3f42538511a74e654274d4@haskell.org> #14745: Functional dependency conflicts in givens -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: FunDeps Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * keywords: => FunDeps -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 31 13:15:53 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 31 Jan 2018 13:15:53 -0000 Subject: [GHC] #14734: QuantifiedConstraints conflated with impredicative polymorphism? In-Reply-To: <051.b13ce9a287df15f46f4472a3cecc22de@haskell.org> References: <051.b13ce9a287df15f46f4472a3cecc22de@haskell.org> Message-ID: <066.cb20e88b3cc1875209a4caeb407459d9@haskell.org> #14734: QuantifiedConstraints conflated with impredicative polymorphism? -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: Component: Compiler | Version: 8.5 Resolution: invalid | Keywords: | QuantifiedConstraints wipT2893 Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * status: new => closed * resolution: => invalid Comment: > it is considered impredicative polymorphism, but is it? Yes it is. You are instantiating a type variable (the `a` from `newtype a :- b`) with a polymorphic type. I think you need impredicativity here. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 31 13:24:36 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 31 Jan 2018 13:24:36 -0000 Subject: [GHC] #14745: Functional dependency conflicts in givens In-Reply-To: <046.c122d934273a7fed5dfa73b01bd65ef1@haskell.org> References: <046.c122d934273a7fed5dfa73b01bd65ef1@haskell.org> Message-ID: <061.a9314faa80c026f91b8d7c3ee6b2900e@haskell.org> #14745: Functional dependency conflicts in givens -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: FunDeps Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Simon Peyton Jones ): In [changeset:"efba054640d3418d7477316ae0c1e992d0aa0f22/ghc" efba0546/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="efba054640d3418d7477316ae0c1e992d0aa0f22" Prioritise equalities when solving, incl deriveds We already prioritise equalities when solving, but Trac #14723 showed that we were not doing so consistently enough, and as a result the type checker could go into a loop. Yikes. See Note [Prioritise equalities] in TcSMonad. Fixng this bug changed the solve order enough to demonstrate a problem with fundeps: Trac #14745. }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 31 13:24:36 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 31 Jan 2018 13:24:36 -0000 Subject: [GHC] #14723: GHC 8.4.1-alpha loops infinitely when typechecking In-Reply-To: <050.41938dfcc2cea4d35c5568a864ac48d8@haskell.org> References: <050.41938dfcc2cea4d35c5568a864ac48d8@haskell.org> Message-ID: <065.3f90178765441a666b5521ffcb0ada9f@haskell.org> #14723: GHC 8.4.1-alpha loops infinitely when typechecking -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.4.1 Component: Compiler (Type | Version: 8.4.1-alpha1 checker) | Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Simon Peyton Jones ): In [changeset:"efba054640d3418d7477316ae0c1e992d0aa0f22/ghc" efba0546/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="efba054640d3418d7477316ae0c1e992d0aa0f22" Prioritise equalities when solving, incl deriveds We already prioritise equalities when solving, but Trac #14723 showed that we were not doing so consistently enough, and as a result the type checker could go into a loop. Yikes. See Note [Prioritise equalities] in TcSMonad. Fixng this bug changed the solve order enough to demonstrate a problem with fundeps: Trac #14745. }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 31 13:26:09 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 31 Jan 2018 13:26:09 -0000 Subject: [GHC] #14733: Won't use (forall xx. f xx) with -XQuantifiedConstraints In-Reply-To: <051.d6dd7c53fb2316d2a32445d192b9d697@haskell.org> References: <051.d6dd7c53fb2316d2a32445d192b9d697@haskell.org> Message-ID: <066.0a5927b6de64ad91060df04ebd371a76@haskell.org> #14733: Won't use (forall xx. f xx) with -XQuantifiedConstraints -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.5 Resolution: | Keywords: | QuantifiedConstraints, wipT2893 Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by sjoerd_visscher): How about adding the workaround internally? I.e. add {{{ class c => SomeInteralClass c instance c => SomeInternalClass c }}} and translate `(forall xx. f xx)` to `(forall xx. SomeInternalClass (f xx))` -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 31 13:27:21 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 31 Jan 2018 13:27:21 -0000 Subject: [GHC] #14723: GHC 8.4.1-alpha loops infinitely when typechecking In-Reply-To: <050.41938dfcc2cea4d35c5568a864ac48d8@haskell.org> References: <050.41938dfcc2cea4d35c5568a864ac48d8@haskell.org> Message-ID: <065.b4e0fc5f14067ca9a4aa379be4f42673@haskell.org> #14723: GHC 8.4.1-alpha loops infinitely when typechecking -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: merge Priority: highest | Milestone: 8.4.1 Component: Compiler (Type | Version: 8.4.1-alpha1 checker) | Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * status: new => merge Comment: This is a bad bug, now fixed. Merge if poss. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 31 13:40:51 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 31 Jan 2018 13:40:51 -0000 Subject: [GHC] #6087: Join points need strictness analysis In-Reply-To: <046.87e3f1b25b2500e98f2a686fd50954f8@haskell.org> References: <046.87e3f1b25b2500e98f2a686fd50954f8@haskell.org> Message-ID: <061.d9d1b78c31f57c97626d332511c70b33@haskell.org> #6087: Join points need strictness analysis -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: infoneeded Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 7.4.1 Resolution: | Keywords: JoinPoints 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: | -------------------------------------+------------------------------------- Changes (by osa1): * Attachment "analyse" added. nofib using GHC HEAD, compare default with -flate-dmd-anal -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 31 13:43:49 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 31 Jan 2018 13:43:49 -0000 Subject: [GHC] #14735: GHC Panic with QuantifiedConstraints In-Reply-To: <051.3a02470ddbd28d332b6dd2bb0406c5fc@haskell.org> References: <051.3a02470ddbd28d332b6dd2bb0406c5fc@haskell.org> Message-ID: <066.02bb6e6be63f68645e88735ca180e9d5@haskell.org> #14735: GHC Panic with QuantifiedConstraints -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: fixed | Keywords: wipT2893, | QuantifiedConstraints Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Iceland_jack): It works now, thanks -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 31 13:46:46 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 31 Jan 2018 13:46:46 -0000 Subject: [GHC] #6087: Join points need strictness analysis In-Reply-To: <046.87e3f1b25b2500e98f2a686fd50954f8@haskell.org> References: <046.87e3f1b25b2500e98f2a686fd50954f8@haskell.org> Message-ID: <061.16bf8da81ae030c2ffb9190a2e6a1e86@haskell.org> #6087: Join points need strictness analysis -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: infoneeded Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 7.4.1 Resolution: | Keywords: JoinPoints 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: | -------------------------------------+------------------------------------- Comment (by osa1): I've attached the nofib-analyse output. For reference, here's the wiki page on late demand analysis: https://ghc.haskell.org/trac/ghc/wiki/LateDmd. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 31 13:54:48 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 31 Jan 2018 13:54:48 -0000 Subject: [GHC] #6087: Join points need strictness analysis In-Reply-To: <046.87e3f1b25b2500e98f2a686fd50954f8@haskell.org> References: <046.87e3f1b25b2500e98f2a686fd50954f8@haskell.org> Message-ID: <061.8955f3ed0892ad62d710c8ff1421a2b9@haskell.org> #6087: Join points need strictness analysis -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: infoneeded Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 7.4.1 Resolution: | Keywords: JoinPoints 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: | -------------------------------------+------------------------------------- Comment (by simonpj): Interesting. * These are `-O` vs `-O + late-dmd-anal` I assume. It'd be worth doing the same with `-O2` vis `-O2 + late-dmd-anal` * Did you recompile all the libraries, or just nofib? * A 4.6% increase in compiler allocations and compile time. * We get some small wins. * Can you see what is happening with the 5% allocation increase in `mate`? * I think that HEAD has indeed abandoned the "clever .hi file scheme", so we don't need to worry about that part. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 31 14:02:57 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 31 Jan 2018 14:02:57 -0000 Subject: [GHC] #6087: Join points need strictness analysis In-Reply-To: <046.87e3f1b25b2500e98f2a686fd50954f8@haskell.org> References: <046.87e3f1b25b2500e98f2a686fd50954f8@haskell.org> Message-ID: <061.17258245acbca9de9c64fb266edfec56@haskell.org> #6087: Join points need strictness analysis -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: infoneeded Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 7.4.1 Resolution: | Keywords: JoinPoints 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: | -------------------------------------+------------------------------------- Comment (by osa1): > These are -O vs -O + late-dmd-anal I assume. It'd be worth doing the same with -O2 vis -O2 + late-dmd-anal nofib runs with -O2 by default. Here's an example command that nofib runs to compile of the benchmarks: {{{ ghc-stage2 -O2 -Rghc-timing -H32m -hisuf hi -rtsopts -c Main.hs -o Main.o }}} with `-flate-dmd-anal`: {{{ ghc-stage2 -O2 -Rghc-timing -H32m -hisuf hi -flate-dmd-anal -rtsopts -c Main.hs -o Main.o }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 31 14:28:13 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 31 Jan 2018 14:28:13 -0000 Subject: [GHC] #14732: -fdefer-typed-holes breaks a correct program In-Reply-To: <052.1b96714b25f21170dafc623293b00787@haskell.org> References: <052.1b96714b25f21170dafc623293b00787@haskell.org> Message-ID: <067.df60902bbec675d9e46f3d5675c64bba@haskell.org> #14732: -fdefer-typed-holes breaks a correct program -------------------------------------+------------------------------------- Reporter: MitchellSalad | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Simon Peyton Jones ): In [changeset:"e9ae0cae9eb6a340473b339b5711ae76c6bdd045/ghc" e9ae0ca/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="e9ae0cae9eb6a340473b339b5711ae76c6bdd045" Look inside implications in simplifyRule Trac #14732 was a perpelexing bug in which -fdefer-typed-holes caused a mysterious type error in a RULE. This turned out to be because we are more aggressive about creating implications when deferring (see TcUnify.implicationNeeded), and the rule mechanism hadn't caught up. This fixes it. }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 31 14:29:23 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 31 Jan 2018 14:29:23 -0000 Subject: [GHC] #14732: -fdefer-typed-holes breaks a correct program In-Reply-To: <052.1b96714b25f21170dafc623293b00787@haskell.org> References: <052.1b96714b25f21170dafc623293b00787@haskell.org> Message-ID: <067.4894eed57c772baf67f553f6e071313f@haskell.org> #14732: -fdefer-typed-holes breaks a correct program -------------------------------------+------------------------------------- Reporter: MitchellSalad | Owner: (none) Type: bug | Status: merge Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: | typecheck/should_compile/T14732 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * testcase: => typecheck/should_compile/T14732 * status: new => merge -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 31 14:29:59 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 31 Jan 2018 14:29:59 -0000 Subject: [GHC] #14723: GHC 8.4.1-alpha loops infinitely when typechecking In-Reply-To: <050.41938dfcc2cea4d35c5568a864ac48d8@haskell.org> References: <050.41938dfcc2cea4d35c5568a864ac48d8@haskell.org> Message-ID: <065.ebb94b36d853a2ae2f3930ffd77896b6@haskell.org> #14723: GHC 8.4.1-alpha loops infinitely when typechecking -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: merge Priority: highest | Milestone: 8.4.1 Component: Compiler (Type | Version: 8.4.1-alpha1 checker) | Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Compile-time | Test Case: performance bug | polykinds/T14723 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * testcase: => polykinds/T14723 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 31 14:59:39 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 31 Jan 2018 14:59:39 -0000 Subject: [GHC] #14733: Won't use (forall xx. f xx) with -XQuantifiedConstraints In-Reply-To: <051.d6dd7c53fb2316d2a32445d192b9d697@haskell.org> References: <051.d6dd7c53fb2316d2a32445d192b9d697@haskell.org> Message-ID: <066.e1c41d12d9bf366a47a3cdee73dbb11d@haskell.org> #14733: Won't use (forall xx. f xx) with -XQuantifiedConstraints -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.5 Resolution: | Keywords: | QuantifiedConstraints, wipT2893 Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Iceland_jack): Only moderate? ;-) I have listed some things this rules out as Phabricator comments: * ([https://phabricator.haskell.org/D4353#121416 Phab]) A (categorical) vocabulary for constraints: `uncurry :: (a => b => c) :- ((a, b) => c)` * ([https://phabricator.haskell.org/D4353#121383 Phab]) Defining `(>>=) @(Free cls)` needs a `cls` instance for `Free cls b` but it can't range over `b`. {{{#!hs newtype Free cls a = Free (forall xx. cls xx => (a -> xx) -> xx) bind :: cls (Free cls b) => Free cls a -> (a -> Free cls b) -> Free cls b bind (Free free) f = free f }}} Instead: {{{#!hs instance (forall xx. cls (Free cls xx)) => Monad (Free cls) }}} * ([https://phabricator.haskell.org/D4353#121403 Phab]) Works: but what we really want is an instance of `Free mon` for any `forall xx. Monoid xx => mon xx` {{{#!hs instance Foldable (Free Monoid) where foldMap :: Monoid m => (a -> m) -> (Free Monoid a -> m) foldMap f (Free free) = free f instance Foldable (Free Monoid) where foldMap :: Monoid m => (a -> m) -> (Free Monoid a -> m) foldMap f (Free free) = free f }}} Your `class f a => C f a` solution didn't work for me (using latest version): here is my [https://gist.github.com/Icelandjack/6b42e7e19c7f130f2ca947495e09ca54 full code and error messages]. Echoing Sjoerd if there is a mechanical translation `class f a => C f a` can GHC do it? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 31 15:21:51 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 31 Jan 2018 15:21:51 -0000 Subject: [GHC] #6087: Join points need strictness analysis In-Reply-To: <046.87e3f1b25b2500e98f2a686fd50954f8@haskell.org> References: <046.87e3f1b25b2500e98f2a686fd50954f8@haskell.org> Message-ID: <061.9395f022ce3bf7ce795b16b0971d5d6d@haskell.org> #6087: Join points need strictness analysis -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: infoneeded Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 7.4.1 Resolution: | Keywords: JoinPoints 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: | -------------------------------------+------------------------------------- Comment (by osa1): > Did you recompile all the libraries, or just nofib? Just nofib. > Can you see what is happening with the 5% allocation increase in mate? Sure, I'll update. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 31 15:26:56 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 31 Jan 2018 15:26:56 -0000 Subject: [GHC] #14746: Provide PDEP and PEXT instructions Message-ID: <049.ef44b4776191ae1428773ffad0b1f134@haskell.org> #14746: Provide PDEP and PEXT instructions -------------------------------------+------------------------------------- Reporter: andrewthad | Owner: (none) Type: feature | Status: new request | Priority: normal | Milestone: Component: Compiler | Version: 8.2.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: -------------------------------------+------------------------------------- The PDEP (parallel bit deposit) and PEXT (parallel bit extract) instructions are super cool and could be very naturally expressed in GHC as: {{{ packedBitDeposit :: Word# -> Word# -> Word# packedBitExtract :: Word# -> Word# -> Word# }}} I requesting that these be added to GHC.Prim (or more accurately, I'm requesting approval for these be added to GHC.Prim, by me or by any other interested party, possibly at a more distant point in the future). -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 31 15:48:58 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 31 Jan 2018 15:48:58 -0000 Subject: [GHC] #14746: Provide PDEP and PEXT instructions In-Reply-To: <049.ef44b4776191ae1428773ffad0b1f134@haskell.org> References: <049.ef44b4776191ae1428773ffad0b1f134@haskell.org> Message-ID: <064.626a312698f9cfe411674336a15d6989@haskell.org> #14746: Provide PDEP and PEXT instructions -------------------------------------+------------------------------------- Reporter: andrewthad | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by alexbiehl): Andrew, these are already in GHC-HEAD: https://github.com/ghc/ghc/commit/f855769690eb998ea25818ee794714957852af48 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 31 15:58:37 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 31 Jan 2018 15:58:37 -0000 Subject: [GHC] #14733: Won't use (forall xx. f xx) with -XQuantifiedConstraints In-Reply-To: <051.d6dd7c53fb2316d2a32445d192b9d697@haskell.org> References: <051.d6dd7c53fb2316d2a32445d192b9d697@haskell.org> Message-ID: <066.158083e075c255afba37b2bf04a7d642@haskell.org> #14733: Won't use (forall xx. f xx) with -XQuantifiedConstraints -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.5 Resolution: | Keywords: | QuantifiedConstraints, wipT2893 Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Iceland_jack): Replying to [comment:3 simonpj]: > Currently this is by-design, but we could change the design. I'm +1 on change but that's easy to say, is it a task that takes deep GHC knowhow? > How bad is the restriction? Hard to say. If it's a matter of encoding them class aliases then it is a huge improvement over the current situation, otherwise may rule out a lot of fun examples. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 31 17:18:41 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 31 Jan 2018 17:18:41 -0000 Subject: [GHC] #9123: Need for higher kinded roles In-Reply-To: <046.743e1f5edf878b0ae2d2d6b5081e6a33@haskell.org> References: <046.743e1f5edf878b0ae2d2d6b5081e6a33@haskell.org> Message-ID: <061.aa7f838059d3e19db1aa0854ba6b86b1@haskell.org> #9123: Need for higher kinded roles -------------------------------------+------------------------------------- Reporter: simonpj | Owner: goldfire Type: bug | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 7.8.2 checker) | Keywords: Roles, Resolution: | QuantifiedConstraints Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Now that we have [wiki:QuantifiedContexts quantified constraints] (currently just on `wip/T2983`) we want to take advantage of them to do roles, along the lines of comment:29. But alas this does not work {{{ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE QuantifiedConstraints #-} {-# LANGUAGE UndecidableInstances #-} module T2893b where import Data.Coerce newtype Wrap m a = Wrap (m a) class Monad' m where join' :: m (m a) -> m a instance (forall p q. Coercible p q => Coercible (m p) (m q), Monad' m) => Monad' (Wrap m) where join' :: forall a. Wrap m (Wrap m a) -> Wrap m a join' = coerce @(m (m a) -> m a) @(Wrap m (Wrap m a) -> Wrap m a) join' }}} We get {{{ T2893b.hs:16:10: error: • Couldn't match representation of type ‘m (m a)’ with that of ‘m (Wrap m a)’ NB: We cannot know what roles the parameters to ‘m’ have; we must assume that the role is nominal • In the ambiguity check for an instance declaration To defer the ambiguity check to use sites, enable AllowAmbiguousTypes In the instance declaration for ‘Monad' (Wrap m)’ }}} And I can see why. We have {{{ [W] Coercible (m (m a) -> m a) (Wrap m (Wrap m a) -> Wrap m a) }}} That doesn't match the local instance declaration for `Coercible`, so we reduce it to {{{ [W] (~R#) (m (m a) -> m a) (Wrap m (Wrap m a) -> Wrap m a) }}} Now we can decompose on the arrow, to get {{{ [W] (~R#) (m (m a)) (Wrap m (Wrap m a)) [W] (~R#) (m a) (Wrap m a) }}} The latter can be solved by newtype unwrapping, but if we do newtype unwrappign on the former we get {{{ [W] (~R#) (m (m a)) (m (Wrap m a) }}} and now we are stuck. If only we were looking for {{{ [W] Coercible (m (m a)) (m (Wrap m a)) }}} we could use the local instance; but alas we "gone down" to `~R#` from `Coercible`. I guess the same would happen for equality `(~)`; again, the constraint solver works over the primitive equality `(~N#)`, so local instances for `(~)` may not help. Why doesn't this happen when we have a non-quantified constraint `Coercible s t` a given? Because in that case we proactively spit out its superclasses and hence can solve `s ~R# t`. A vaguely similar situation could be {{{ f :: forall f. (Ord b, forall a. Ord a => Ord (f a)) => b -> b f = ....[W] Eq (f b).... }}} Here we have `Eq (f b)`, which ''could'' be solved (via superclass) from `Ord (f a)`; which we could get via the local instance and the `Ord b` constraint. Similar because it involves a superclass. We could make an ad hoc solution for `(~R#)` and `(~N#)`. But I don't see a general solution. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 31 17:54:49 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 31 Jan 2018 17:54:49 -0000 Subject: [GHC] #14733: Won't use (forall xx. f xx) with -XQuantifiedConstraints In-Reply-To: <051.d6dd7c53fb2316d2a32445d192b9d697@haskell.org> References: <051.d6dd7c53fb2316d2a32445d192b9d697@haskell.org> Message-ID: <066.4a8c6b1271fe46bdf7dadf6380bfa575@haskell.org> #14733: Won't use (forall xx. f xx) with -XQuantifiedConstraints -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.5 Resolution: | Keywords: | QuantifiedConstraints, wipT2893 Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): Replying to [comment:5 sjoerd_visscher]: > How about adding the workaround internally? I.e. add > > {{{ > class c => SomeInteralClass c > instance c => SomeInternalClass c > }}} > > and translate `(forall xx. f xx)` to `(forall xx. SomeInternalClass (f xx))` That's one idea. But does that idea even work if you write it out by hand? I tried: {{{#!hs {-# Language QuantifiedConstraints #-} {-# Language GADTs #-} {-# Language ConstraintKinds #-} {-# Language FlexibleInstances #-} {-# Language UndecidableInstances #-} {-# Language UndecidableSuperClasses #-} class c => SomeInternalClass c instance c => SomeInternalClass c data D c where D :: c => D c proof :: (forall xx. SomeInternalClass (f xx)) => D (f a) proof = D }}} But that fails with: {{{ Bug.hs:15:9: error: • Could not deduce: f a arising from a use of ‘D’ from the context: forall xx. SomeInternalClass (f xx) bound by the type signature for: proof :: forall (f :: * -> Constraint) a. (forall xx. SomeInternalClass (f xx)) => D (f a) at Bug.hs:14:1-57 • In the expression: D In an equation for ‘proof’: proof = D • Relevant bindings include proof :: D (f a) (bound at Bug.hs:15:1) | 15 | proof = D | ^ }}} Granted, it does work if you change the `proof` to: {{{#!hs proof :: (forall xx. SomeInternalClass (f xx)) => D (SomeInternalClass (f a)) proof = D }}} But that would require pervasively inserting `SomeInternalClass` everywhere in your program, and not just on the quantified constraints which lack an explicit type class constructor. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 31 18:07:30 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 31 Jan 2018 18:07:30 -0000 Subject: [GHC] #14746: Provide PDEP and PEXT instructions In-Reply-To: <049.ef44b4776191ae1428773ffad0b1f134@haskell.org> References: <049.ef44b4776191ae1428773ffad0b1f134@haskell.org> Message-ID: <064.988cff02828ea50ccba0a5dfe0b7fe44@haskell.org> #14746: Provide PDEP and PEXT instructions -------------------------------------+------------------------------------- Reporter: andrewthad | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by andrewthad): My phone lacks an emoji smiling big enough to express how I feel. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 31 18:08:02 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 31 Jan 2018 18:08:02 -0000 Subject: [GHC] #14746: Provide PDEP and PEXT instructions In-Reply-To: <049.ef44b4776191ae1428773ffad0b1f134@haskell.org> References: <049.ef44b4776191ae1428773ffad0b1f134@haskell.org> Message-ID: <064.50ab5ed8fde30fddfe3f81a39ac4b227@haskell.org> #14746: Provide PDEP and PEXT instructions -------------------------------------+------------------------------------- Reporter: andrewthad | Owner: (none) Type: feature request | Status: closed Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by andrewthad): * status: new => closed * resolution: => fixed -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 31 18:10:33 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 31 Jan 2018 18:10:33 -0000 Subject: [GHC] #9123: Need for higher kinded roles In-Reply-To: <046.743e1f5edf878b0ae2d2d6b5081e6a33@haskell.org> References: <046.743e1f5edf878b0ae2d2d6b5081e6a33@haskell.org> Message-ID: <061.a46cfd6c5cc44b6f5659461c8ba86e36@haskell.org> #9123: Need for higher kinded roles -------------------------------------+------------------------------------- Reporter: simonpj | Owner: goldfire Type: bug | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 7.8.2 checker) | Keywords: Roles, Resolution: | QuantifiedConstraints Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by goldfire): I wonder if you stumbled on the solution there: perhaps processing a quantified constraint ''should'' proactively spit out superclass constraints. That is, we can imagine that `forall p q. Coercible p q => Coercible (m p) (m q)` proactively produces `forall p q. Coercible p q => m p ~R# m q`, based on the superclass constraint to `Coercible`. Note that this works nicely in general. If you have `forall x. D x => Ord x` and find yourself needing `Eq t`, then we can use the quantified constraint and reduce `Eq t` to `D t`. This more general solution would solve this problem here nicely, I think. And it just seems Right. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 31 19:57:46 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 31 Jan 2018 19:57:46 -0000 Subject: [GHC] #14675: GHC 8.4.1 regression: segfault when loading doctest on a module with ANNs on Ubuntu 16.04 or later In-Reply-To: <050.c5c190ffbc3e4175e84536f4424d1ad2@haskell.org> References: <050.c5c190ffbc3e4175e84536f4424d1ad2@haskell.org> Message-ID: <065.56f5b0c2f09890ed5a28efcd48411133@haskell.org> #14675: GHC 8.4.1 regression: segfault when loading doctest on a module with ANNs on Ubuntu 16.04 or later -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: alpmestan Type: bug | Status: new Priority: highest | Milestone: 8.4.1 Component: GHC API | Version: 8.4.1-alpha1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Runtime crash | Test Case: Blocked By: | Blocking: Related Tickets: #14603 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by alpmestan): Below is a summary of how things go in `interpretBCO`. Here's how things look when we enter that function: {{{#!c (gdb) x/8a $rbp 0x7fffffffe0f0: 0x7fffffffe140 0x2cc3186 0x7fffffffe100: 0x33e7d40 0x33c7ac0 0x7fffffffe110: 0x33c7ac0 0x2cc73fd 0x7fffffffe120: 0x33c7ad8 0x2033c7ac0 (gdb) x/8a Sp 0x42001fcb28: 0x2cf4728 0x42003b2e70 0x42001fcb38: 0x2cf34e8 0x42003b2eb0 0x42001fcb48: 0x10202e0 0x2cf34e8 0x42001fcb58: 0x420012ec20 0x2cf34e8 (gdb) ghc closure 0x42003b2e70 BCO (gdb) ghc closure 0x42003b2eb0 AP(0x42003b2e70) }}} This leads us to entering this block from `interpretBCO`: {{{#!c else if (SpW(0) == (W_)&stg_apply_interp_info) { obj = UNTAG_CLOSURE((StgClosure *)SpW(1)); Sp_addW(2); goto run_BCO_fun; } }}} We successfully retrieve `obj`, which is a `BCO`: {{{#!c (gdb) 0x0000000002cc8c62 in interpretBCO (cap=0x33c7ac0 ) at rts/Interpreter.c:354 354 obj = UNTAG_CLOSURE((StgClosure *)SpW(1)); (gdb) 355 Sp_addW(2); (gdb) print obj $5 = (StgClosure *) 0x42003b2e70 (gdb) ghc closure obj BCO }}} We then jump to `run_BCO_fun` (see [https://github.com/ghc/ghc/blob/cca2d6b78f97bfb79bef4dc3f75d6c4d15b94680/rts/Interpreter.c#L936 here]). The stack & heap checks go well and we jump straight to `run_BCO` (right below `run_BCO_fun` in the source code), which starts like this {{{#!c register int bciPtr = 0; /* instruction pointer */ register StgWord16 bci; register StgBCO* bco = (StgBCO*)obj; register StgWord16* instrs = (StgWord16*)(bco->instrs->payload); register StgWord* literals = (StgWord*)(&bco->literals->payload[0]); register StgPtr* ptrs = (StgPtr*)(&bco->ptrs->payload[0]); #if defined(DEBUG) int bcoSize; bcoSize = bco->instrs->bytes / sizeof(StgWord16); }}} {{{#!c (gdb) print bcoSize $14 = 8 (gdb) print (*instrs)@8 $16 = {11, 0, 11, 1, 32, 11, 2, 58} }}} The `ptrs` and `literals` field among others seem to have been optimized out. And we then start processing the instructions. For reference, the opcodes for instructions are defined [https://github.com/ghc/ghc/blob/cca2d6b78f97bfb79bef4dc3f75d6c4d15b94680/includes/rts/Bytecodes.h#L26 here]. {{{#!c bci = BCO_NEXT; /* ... */ switch (bci & 0xFF) { }}} {{{#!c (gdb) print bci $15 = 11 }}} `11 & 0xFF = 11`, which is `bci_PUSH_G`. Here's how it's handled: {{{#!c case bci_PUSH_G: { int o1 = BCO_GET_LARGE_ARG; SpW(-1) = BCO_PTR(o1); Sp_subW(1); goto nextInsn; } /* definitions for the macros: */ #define BCO_GET_LARGE_ARG ((bci & bci_FLAG_LARGE_ARGS) ? BCO_READ_NEXT_WORD : BCO_NEXT) #define bci_FLAG_LARGE_ARGS 0x8000 #define BCO_PTR(n) (W_)ptrs[n] }}} In our case, `bci = 11`, `11 & 0x8000 = 0` so we get `BCO_NEXT` which just reads the next instruction. In our case, `o1 = 0`, so we get the first `StgMutArrPtrs` that comes with the BCO (`gdb` won't let me look at them, it says the value has been optimized out), we push the address on the stack and move to the next instruction, `11` (`bci_PUSH_G` again). This time, `o1 = 1`. We proceed as before but with the second `StgMutArrPtrs`. We end up with: {{{#!c (gdb) x/8a Sp 0x42001fcb28: 0x407a0540 0x401618a8 0x42001fcb38: 0x2cf34e8 0x42003b2eb0 0x42001fcb48: 0x10202e0 0x2cf34e8 0x42001fcb58: 0x420012ec20 0x2cf34e8 }}} We read the next instruction, `bci = 32`, which is, as you can see [https://github.com/ghc/ghc/blob/cca2d6b78f97bfb79bef4dc3f75d6c4d15b94680/includes/rts/Bytecodes.h#L57 here]: {{{#!c #define bci_PUSH_APPLY_PP 32 }}} This leads us to this bit of code in `interpretBCO`: {{{#!c case bci_PUSH_APPLY_PP: Sp_subW(1); SpW(0) = (W_)&stg_ap_pp_info; goto nextInsn; }}} After executing this code, we have, as expected: {{{#!c (gdb) x/8a Sp 0x42001fcb20: 0x2cfa6a0 0x407a0540 0x42001fcb30: 0x401618a8 0x2cf34e8 0x42001fcb40: 0x42003b2eb0 0x10202e0 0x42001fcb50: 0x2cf34e8 0x420012ec20 }}} The next instruction is `11`, so `bci_PUSH_G` again. This time, `o1 = 2` and: {{{#!c (gdb) x/8a Sp 0x42001fcb18: 0x407c6c20 0x2cfa6a0 0x42001fcb28: 0x407a0540 0x401618a8 0x42001fcb38: 0x2cf34e8 0x42003b2eb0 0x42001fcb48: 0x10202e0 0x2cf34e8 }}} Next instruction, `bci = 58`, [https://github.com/ghc/ghc/blob/cca2d6b78f97bfb79bef4dc3f75d6c4d15b94680/includes/rts/Bytecodes.h#L83 which is]: {{{#!c #define bci_ENTER 58 }}} and brings us to this code: {{{#!c case bci_ENTER: // Context-switch check. We put it here to ensure that // the interpreter has done at least *some* work before // context switching: sometimes the scheduler can invoke // the interpreter with context_switch == 1, particularly // if the -C0 flag has been given on the cmd line. if (cap->r.rHpLim == NULL) { Sp_subW(1); SpW(0) = (W_)&stg_enter_info; RETURN_TO_SCHEDULER(ThreadInterpret, ThreadYielding); } goto eval; }}} In our case, `cap->r.rHpLim` is not null and we hit the `goto`, bringing us [https://github.com/ghc/ghc/blob/cca2d6b78f97bfb79bef4dc3f75d6c4d15b94680/rts/Interpreter.c#L370 here]. {{{#!c eval: tagged_obj = (StgClosure*)SpW(0); Sp_addW(1); eval_obj: obj = UNTAG_CLOSURE(tagged_obj); // ... to be continued ... }}} `gdb` (well, Ben's gdb plugin) reports this closure as off-heap. We then get to: {{{#!c switch ( get_itbl(obj)->type ) { }}} and in our case: {{{#!c (gdb) print (StgInfoTable)(*(obj->header.info - 1)) $50 = {layout = {payload = {ptrs = 0, nptrs = 0}, bitmap = 0, large_bitmap_offset = 0, __pad_large_bitmap_offset = 0, selector_offset = 0}, type = 14, srt_bitmap = 0, code = 0x405268e8 "I\203\304\030M;\245X\003"} }}} `type = 14` corresponds to: {{{#!c #define FUN_STATIC 14 }}} . Therefore no need to evaluate anything (the switch just `break`s for this case). We then move [https://github.com/ghc/ghc/blob/cca2d6b78f97bfb79bef4dc3f75d6c4d15b94680/rts/Interpreter.c#L534 here]. {{{#!c // ------------------------------------------------------------------------ // We now have an evaluated object (tagged_obj). The next thing to // do is return it to the stack frame on top of the stack. do_return: obj = UNTAG_CLOSURE(tagged_obj); ASSERT(closure_HNF(obj)); /* ... */ switch (get_itbl((StgClosure *)Sp)->type) { }}} In our case: {{{#!c (gdb) print (StgInfoTable)(*(c->header.info - 1)) $49 = {layout = {payload = {ptrs = 2, nptrs = 0}, bitmap = 2, large_bitmap_offset = 2, __pad_large_bitmap_offset = 2, selector_offset = 2}, type = 30, srt_bitmap = 0, code = 0x2cfa6a0 "\200<%Rw<\003"} }}} So `type = 30`, which is: {{{#!c #define RET_SMALL 30 }}} which makes us hit the `RET_SMALL` case. {{{#!c case RET_SMALL: { const StgInfoTable *info; // NOTE: not using get_itbl(). info = ((StgClosure *)Sp)->header.info; if (info == (StgInfoTable *)&stg_restore_cccs_info || info == (StgInfoTable *)&stg_restore_cccs_eval_info) { cap->r.rCCCS = (CostCentreStack*)SpW(1); Sp_addW(2); goto do_return; } if (info == (StgInfoTable *)&stg_ap_v_info) { n = 1; m = 0; goto do_apply; } if (info == (StgInfoTable *)&stg_ap_f_info) { n = 1; m = 1; goto do_apply; } if (info == (StgInfoTable *)&stg_ap_d_info) { n = 1; m = sizeofW(StgDouble); goto do_apply; } if (info == (StgInfoTable *)&stg_ap_l_info) { n = 1; m = sizeofW(StgInt64); goto do_apply; } if (info == (StgInfoTable *)&stg_ap_n_info) { n = 1; m = 1; goto do_apply; } if (info == (StgInfoTable *)&stg_ap_p_info) { n = 1; m = 1; goto do_apply; } if (info == (StgInfoTable *)&stg_ap_pp_info) { n = 2; m = 2; goto do_apply; } if (info == (StgInfoTable *)&stg_ap_ppp_info) { n = 3; m = 3; goto do_apply; } if (info == (StgInfoTable *)&stg_ap_pppp_info) { n = 4; m = 4; goto do_apply; } if (info == (StgInfoTable *)&stg_ap_ppppp_info) { n = 5; m = 5; goto do_apply; } if (info == (StgInfoTable *)&stg_ap_pppppp_info) { n = 6; m = 6; goto do_apply; } goto do_return_unrecognised; } }}} We take the `info == (StgInfoTable *)&stg_ap_pp_info` branch and head to `do_apply` [https://github.com/ghc/ghc/blob/cca2d6b78f97bfb79bef4dc3f75d6c4d15b94680/rts/Interpreter.c#L730 here]. There we just hit the default branch: {{{#!c default: defer_apply_to_sched: IF_DEBUG(interpreter, debugBelch("Cannot apply compiled function; yielding to scheduler\n")); Sp_subW(2); SpW(1) = (W_)tagged_obj; SpW(0) = (W_)&stg_enter_info; RETURN_TO_SCHEDULER_NO_PAUSE(ThreadRunGHC, ThreadYielding); /* where: */ #define SAVE_STACK_POINTERS \ cap->r.rCurrentTSO->stackobj->sp = Sp; #define SAVE_THREAD_STATE() \ SAVE_STACK_POINTERS #endif #define RETURN_TO_SCHEDULER_NO_PAUSE(todo,retcode) \ SAVE_THREAD_STATE(); \ cap->r.rCurrentTSO->what_next = (todo); \ cap->r.rRet = (retcode); \ return cap; }}} FWIW, right before we return to the scheduler, the stack looks like: {{{#!c (gdb) x/8a Sp 0x42001fcb10: 0x2cf5900 0x407c6c20 0x42001fcb20: 0x2cfa6a0 0x407a0540 0x42001fcb30: 0x401618a8 0x2cf34e8 0x42001fcb40: 0x42003b2eb0 0x10202e0 }}} But then, when I continue executing the program instruction by instruction, gdb shows me {{{#!c default: barf("interpretBCO: unknown or unimplemented opcode %d", (int)(bci & 0xFF)); }}} which is the default case for the switch on the opcode we read from a BCO. Not sure what's going on here, because there's just no way the control flow leads us there. So I quickly tried another run, but setting a breakpoint on `barf`, and we just never call it. This suggests that `interpretBCO` in fact goes well and that it does set things up properly on the stack and saves the stack in the capability's state. And `gdb` just points me to `default` for lack of a better line, when it is executing the function, I suppose? Next I'll look at what goes on when `convertAnnotationWrapper` picks this up. By quickly skimming through it in `gdb` I see some allocations, some `Data.Data` related symbol (comes from `AnnotationWrapper`'s constructor IIRC), some pinned byte array related ones as well. Hopefully this step will reveal the actual problem... -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 31 20:12:49 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 31 Jan 2018 20:12:49 -0000 Subject: [GHC] #14416: CI with CircleCI In-Reply-To: <043.af09c8504e7db798b11a186aefc2b2d5@haskell.org> References: <043.af09c8504e7db798b11a186aefc2b2d5@haskell.org> Message-ID: <058.f1cce6e06824427e85269fd1b0ff739a@haskell.org> #14416: CI with CircleCI -------------------------------------+------------------------------------- Reporter: chak | Owner: bgamari Type: task | Status: new Priority: highest | Milestone: 8.6.1 Component: Continuous | Version: Integration | Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: x86_64 | (amd64) Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | ContinuousIntegration | -------------------------------------+------------------------------------- Changes (by bgamari): * milestone: 8.4.1 => 8.6.1 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 31 20:48:48 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 31 Jan 2018 20:48:48 -0000 Subject: [GHC] #14742: Unboxed sums can treat Word#s as Int#s In-Reply-To: <043.f2ad58847922732aad4c3d717b7bb370@haskell.org> References: <043.f2ad58847922732aad4c3d717b7bb370@haskell.org> Message-ID: <058.84b3cb6ca1844cba95a4db729cd33aa0@haskell.org> #14742: Unboxed sums can treat Word#s as Int#s -------------------------------------+------------------------------------- Reporter: duog | Owner: osa1 Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: UnboxedSums Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by duog): Why does `RuntimeRep` have both `WordRep` and `IntRep` constructors? I had a grep and the only difference I could find is in foreign calls. Modifying the program in the description to: {{{ {-# language MagicHash, UnboxedSums, UnliftedFFITypes #-} {-# options_ghc -ddump-stg -dppr-debug -fprint-explicit-kinds -ddump-to- file -ddump-cmm #-} foreign import ccall "bar" bar :: Int# -> Int mkUnboxedSum :: () -> (# Float# | Int# #) mkUnboxedSum _ = (# | 9# #) {-# noinline mkUnboxedSum #-} foo :: Int foo = case mkUnboxedSum () of (# | i# #) -> bar i# (# f# | #) -> bar 1# }}} The cmm for the two calls to bar are: {{{ (_s1hz::I64) = call "ccall" arg hints: [‘signed’] result hints: [‘signed’] (_c1j0::I64)(_c1j1::I64); }}} and {{{ (_s1hE::I64) = call "ccall" arg hints: [] result hints: [‘signed’] (_c1j9::I64)(_c1ja::I64); }}} Presumably these arg hints exist because we can get problems without them? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 31 20:49:08 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 31 Jan 2018 20:49:08 -0000 Subject: [GHC] #14742: Unboxed sums can treat Word#s as Int#s In-Reply-To: <043.f2ad58847922732aad4c3d717b7bb370@haskell.org> References: <043.f2ad58847922732aad4c3d717b7bb370@haskell.org> Message-ID: <058.6ef9a64526dfab601f33ed4e9e1e93d1@haskell.org> #14742: Unboxed sums can treat Word#s as Int#s -------------------------------------+------------------------------------- Reporter: duog | Owner: osa1 Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: UnboxedSums Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by duog): * Attachment "Bug.dump-cmm" added. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 31 21:46:09 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 31 Jan 2018 21:46:09 -0000 Subject: [GHC] #14630: name shadowing warnings by record pattern synonyms + RecordWildCards or NamedFieldPuns In-Reply-To: <053.0838c2dcc7b95d4aed5fb595896d561b@haskell.org> References: <053.0838c2dcc7b95d4aed5fb595896d561b@haskell.org> Message-ID: <068.3e98a33a79c65039a60503d8f41a48dc@haskell.org> #14630: name shadowing warnings by record pattern synonyms + RecordWildCards or NamedFieldPuns -------------------------------------+------------------------------------- Reporter: mizunashi_mana | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: | PatternSynonyms Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect | Unknown/Multiple error/warning at compile-time | Test Case: Blocked By: | Blocking: Related Tickets: #11228, #11970 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by adamgundry): In the past (prior to Phab:D761), the `RecFieldEnv` stored the set of record field names defined in the current module, and `is_shadowed_gre` used this set for local identifiers and `isRecordSelector` for imported identifiers. We could go back to doing something similar. However, in order to implement `DuplicateRecordFields`, it's helpful for a GRE to simply know whether or not it is a record field (and the field label, if it is), because the renamer ends up special-casing the treatment of multiple in-scope GREs when they are all fields. I think we should keep doing this, and moreover make it correct for record pattern synonym fields, as a step towards #11228. That is, I think we should do something like Ryan's patch. The price we end up paying is a slightly more complicated definition of `AvailInfo`, but I don't think that's too terrible, is it? > I would imagine two distinct data types, one which tracks parenthood and and one which tracks whether a GRE is a record field. Yes, I think this would be worth doing instead of a new constructor in `Parent`. In the presence of record pattern synonyms, these two properties are independent, and they could simply be two separate fields of `GlobalRdrElt`. Unfortunately I doubt we can really make things fundamentally simpler without doing away with `DuplicateRecordFields` altogether; the simplifications I'm considering will move work from the typechecker to the renamer, but the issues here are all about the renamer. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 31 21:57:50 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 31 Jan 2018 21:57:50 -0000 Subject: [GHC] #14747: DisambiguateRecordFields fails for PatternSynonyms Message-ID: <049.f08f8caee266cae142af76acb98feb02@haskell.org> #14747: DisambiguateRecordFields fails for PatternSynonyms -------------------------------------+------------------------------------- Reporter: adamgundry | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 (Type checker) | Keywords: | Operating System: Unknown/Multiple PatternSynonyms | Architecture: | Type of failure: GHC rejects Unknown/Multiple | valid program Test Case: | Blocked By: Blocking: | Related Tickets: #11283 Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- Consider: {{{#!hs {-# LANGUAGE PatternSynonyms #-} module A where pattern S{x} = [x] }}} {{{#!hs {-# LANGUAGE PatternSynonyms, DisambiguateRecordFields #-} module B where import A pattern T{x} = [x] e = S { x = 42 } }}} Compiling module B fails with `Ambiguous occurrence ‘x’` in the definition of `e`. In principle, `DisambiguateRecordFields` should select the field belonging to the `S` "data constructor". However, the current implementation of this works by identifying the parent type constructor, which doesn't exist for a pattern synonym. This continues to fail if `T` is replaced by a data type with a field `x`. If `S` is replaced by a data type, however, it starts working. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 31 23:12:19 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 31 Jan 2018 23:12:19 -0000 Subject: [GHC] #9123: Need for higher kinded roles In-Reply-To: <046.743e1f5edf878b0ae2d2d6b5081e6a33@haskell.org> References: <046.743e1f5edf878b0ae2d2d6b5081e6a33@haskell.org> Message-ID: <061.70a96f071eded65994c3b2e392f04b6a@haskell.org> #9123: Need for higher kinded roles -------------------------------------+------------------------------------- Reporter: simonpj | Owner: goldfire Type: bug | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 7.8.2 checker) | Keywords: Roles, Resolution: | QuantifiedConstraints Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): I think Coercible is a special case because `Coercible p q` and `p ~R# q` really are inter-convertible. Not so for `Eq a` and `Ord a`. And there might be many classes that happen to have `Eq a` (perhaps distantly transitively) as a superclass. Are we really going to search for a solution via all of those? Now we are into backtracking. It can go wrong with `~R#` too. Suppose we said {{{ class (a ~R# b) => C a b where op :: a -> b }}} Now if we want `t1 ~R# t2`, one route might be by seeking `C t1 t2`. This way lies madness. I could live with a special case for `Corecible`/`~R#` and `~`/`~N#`. But the general case looks swampy. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 31 23:20:35 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 31 Jan 2018 23:20:35 -0000 Subject: [GHC] #14687: Investigate differences in Int-In/Outlining In-Reply-To: <047.b0b99a4233b5f30dbf7b15ebf4360dd1@haskell.org> References: <047.b0b99a4233b5f30dbf7b15ebf4360dd1@haskell.org> Message-ID: <062.23143a4d7cc25ea970c90688753a9c84@haskell.org> #14687: Investigate differences in Int-In/Outlining -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: mpickering Type: task | Status: new Priority: lowest | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by mpickering): Here is what is happening. I don't know if there are any bugs here or not. The core for `func` looks like {{{ -- RHS size: {terms: 17, types: 4, coercions: 0, joins: 0/0} func :: Int# -> Int# -> Int [LclIdX, Arity=2, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [50 40] 90 0}] func = \ (ds_dWL :: Int#) (ds_dWM :: Int#) -> case ds_dWL of { __DEFAULT -> fail_sXf void#; 1# -> case ds_dWM of { __DEFAULT -> fail_sXf void#; 1# -> lvl_sXg; 2# -> lvl_sXh } } }}} whilst the core for `foo` looks like {{{ -- RHS size: {terms: 23, types: 5, coercions: 0, joins: 0/0} foo :: Int# -> Int# -> Int [LclIdX, Arity=2, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [100 60] 130 0}] foo = \ (ds_dWG :: Int#) (ds_dWH :: Int#) -> case ds_dWG of { __DEFAULT -> fail_sXk void#; 1# -> case ds_dWH of { __DEFAULT -> fail_sXk void#; 1# -> lvl_sXl }; 2# -> case ds_dWH of { __DEFAULT -> fail_sXk void#; 1# -> lvl_sXm } } }}} It is key to note at this stage that the size of `func` is 90 whilst the size of `foo` is 130. GHC has already dutifully floated out the integers at this stage so how do they reappear? `foo` is then W/W but `func` is not. The reason for this is that GHC decides that `func` will certainly get inlined due to the following line in `CoreUnfold` {{{ , size - (10 * (arity + 1)) <= ufUseThreshold dflags }}} As the size of `func` is 90, this condition returns `True` (90-30 = 60, ufUseThreshold=60). So then what happens to `foo`? Well it is W/Wed and then the constants appear in the worker immediately in `post-worker-wrapper` simplifier run. It looks likely because the worker has a case-of-case opportunity which then leaves the variable in a case position. However I didn't verify exactly why the variable is inlined as it didn't appear in `-ddump- inlinings`. The worker is then inlined back into the wrapper and thus they reappear in the definition. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 31 23:41:11 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 31 Jan 2018 23:41:11 -0000 Subject: [GHC] #14705: ghc-iserv sometimes segfaults in profiled way In-Reply-To: <046.be67f06c8a68b32fb302ce316ee26108@haskell.org> References: <046.be67f06c8a68b32fb302ce316ee26108@haskell.org> Message-ID: <061.a0a75a0bbefa80734f8ee6d4342acb26@haskell.org> #14705: ghc-iserv sometimes segfaults in profiled way -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Profiling | Version: 8.5 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Runtime crash | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Ben Gamari ): In [changeset:"55aea8fda42dfa29face29292b298994fabfb962/ghc" 55aea8f/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="55aea8fda42dfa29face29292b298994fabfb962" testsuite: Mark scc001 and T5363 as broken due to #14705 These two tests have been failing on CircleCI. }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Jan 31 23:52:43 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 31 Jan 2018 23:52:43 -0000 Subject: [GHC] #14741: High-memory usage during compilation using Template Haskell In-Reply-To: <048.2e25a805133a398645ff22a5c79e588c@haskell.org> References: <048.2e25a805133a398645ff22a5c79e588c@haskell.org> Message-ID: <063.8e80fae9694c4493c6b62fc4e62e8bd3@haskell.org> #14741: High-memory usage during compilation using Template Haskell -------------------------------------+------------------------------------- Reporter: donatello | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by donatello): No, compiling with `-O0` or `-O2` has no effect. I see that embedding a 3MB file takes over 2.5GB of RAM! I have updated the code to use only cabal and have managed to inline specific parts of `file-embed` (I am not very familiar with template haskell) - the problem still persists. Now I am only trying to embed a 3MB file (created by the Makefile). https://github.com/donatello/file-embed-exp Pasting some relevant bits of code here: == EmbedFile.hs {{{ {-# LANGUAGE TemplateHaskell #-} module EmbedFile (embedFile) where import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as B8 import Data.ByteString.Unsafe (unsafePackAddressLen) import Language.Haskell.TH.Syntax (Exp (AppE, ListE, LitE, SigE, TupE, VarE), Lit (IntegerL, StringL, StringPrimL), Q, Quasi (qAddDependentFile), loc_filename, qLocation, runIO) import System.IO.Unsafe (unsafePerformIO) bsToExp :: B.ByteString -> Q Exp bsToExp bs = return $ VarE 'unsafePerformIO `AppE` (VarE 'unsafePackAddressLen `AppE` LitE (IntegerL $ fromIntegral $ B8.length bs) `AppE` LitE (StringPrimL $ B.unpack bs)) embedFile :: FilePath -> Q Exp embedFile fp = qAddDependentFile fp >> (runIO $ B.readFile fp) >>= bsToExp }}} == Static.hs {{{ {-# LANGUAGE TemplateHaskell #-} module Static ( embedList ) where import qualified Data.ByteString as B import System.IO (FilePath) import EmbedFile (embedFile) embedList :: [(FilePath, B.ByteString)] embedList = [("mypath", $(embedFile "build/3mb"))] }}} -- Ticket URL: GHC The Glasgow Haskell Compiler