From ghc-devs at haskell.org Sun Oct 1 01:44:13 2017 From: ghc-devs at haskell.org (GHC) Date: Sun, 01 Oct 2017 01:44:13 -0000 Subject: [GHC] #10229: setThreadAffinity assumes a certain CPU virtual core layout In-Reply-To: <042.260955fa92da12cf89056e026fcec607@haskell.org> References: <042.260955fa92da12cf89056e026fcec607@haskell.org> Message-ID: <057.b4293fc40cbb15f82555ec6dc6420597@haskell.org> #10229: setThreadAffinity assumes a certain CPU virtual core layout -------------------------------------+------------------------------------- Reporter: nh2 | Owner: simonmar Type: bug | Status: new Priority: normal | Milestone: Component: Runtime System | Version: 7.10.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: #1741 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by pacak): * cc: pacak (added) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Oct 1 04:12:17 2017 From: ghc-devs at haskell.org (GHC) Date: Sun, 01 Oct 2017 04:12:17 -0000 Subject: [GHC] #14301: ghc: panic! (the 'impossible' happened) Message-ID: <048.12cdc4241e93baffab4a9d06a2f1c6cd@haskell.org> #14301: ghc: panic! (the 'impossible' happened) -------------------------------------+------------------------------------- Reporter: mcapodici | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.0.2 Keywords: | Operating System: Unknown/Multiple Architecture: x86_64 | Type of failure: None/Unknown (amd64) | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- **When I build my program I get this:** {{{ play-0.1.0.0: build (exe) Preprocessing executable 'play' for play-0.1.0.0... [1 of 1] Compiling Main ( src/Main.hs, .stack-work/dist/x86_64 -linux-nopie/Cabal-1.24.2.0/build/play/play-tmp/Main.o ) ghc: panic! (the 'impossible' happened) (GHC version 8.0.2 for x86_64-unknown-linux): initTc: unsolved constraints WC {wc_insol = [W] interactD_aL2 :: t_aL1[tau:1] (CHoleCan: interactD) [W] interactD_aLt :: t_aLs[tau:1] (CHoleCan: interactD)} Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug }}} **The code:** {{{ {-# LANGUAGE GADTs #-} module Main where import Control.Monad.Trans.Cont import Control.Monad.Trans.Class --main :: IO () {-- CONTT -- main = evalContT contt contt :: ContT () IO () contt = do k <- do callCC $ \exit -> do lift $ putStrLn "Entry" exit $ \_ -> do putStrLn "Exit" lift $ putStrLn "Inside" lift $ k () --} {-- class Monad m => Interact m where get :: m String say :: String -> m () instance Interact IO where get = getLine say = putStrLn prog :: Interact a => a () prog = do say "Hello what is your name?" name <- get say $ "Hello " ++ name ++ ", I am prog! Goodbye" main :: IO () main = prog --} data InteractD m = InteractD { getD :: m String , sayD :: String -> m () } interactDIO :: InteractD IO interactDIO = interactD getLine putStrLn interactDIO2 :: InteractD IO interactDIO2 = interactD (return "James") putStrLn }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Oct 1 09:05:31 2017 From: ghc-devs at haskell.org (GHC) Date: Sun, 01 Oct 2017 09:05:31 -0000 Subject: [GHC] #14289: Pretty-printing of derived multi-parameter classes omits necessary parentheses In-Reply-To: <050.12237887bf2722a5c0ca5d51c4478a96@haskell.org> References: <050.12237887bf2722a5c0ca5d51c4478a96@haskell.org> Message-ID: <065.53d1bb44151fada14aef7a21c324fa86@haskell.org> #14289: Pretty-printing of derived multi-parameter classes omits necessary parentheses -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: alanz Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 (Parser) | 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 alanz): * owner: (none) => alanz -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Oct 1 13:58:24 2017 From: ghc-devs at haskell.org (GHC) Date: Sun, 01 Oct 2017 13:58:24 -0000 Subject: [GHC] #14301: ghc: panic! (the 'impossible' happened) In-Reply-To: <048.12cdc4241e93baffab4a9d06a2f1c6cd@haskell.org> References: <048.12cdc4241e93baffab4a9d06a2f1c6cd@haskell.org> Message-ID: <063.4932f0e267a817006fc4c071cb6352fe@haskell.org> #14301: ghc: panic! (the 'impossible' happened) -------------------------------------+------------------------------------- Reporter: mcapodici | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: Component: Compiler | Version: 8.0.2 Resolution: duplicate | 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: | -------------------------------------+------------------------------------- Changes (by monoidal): * status: new => closed * resolution: => duplicate Comment: Thank you for the report. This bug is a duplicate of #12921 and fixed in GHC 8.2. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Oct 1 16:27:30 2017 From: ghc-devs at haskell.org (GHC) Date: Sun, 01 Oct 2017 16:27:30 -0000 Subject: [GHC] #14282: tagToEnum# . dataToTag# not optimized away In-Reply-To: <045.5438ce0b3dc299cc3f08e924d6abe37c@haskell.org> References: <045.5438ce0b3dc299cc3f08e924d6abe37c@haskell.org> Message-ID: <060.618a0c70250a839c1e49016d9cdd4252@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 dfeuer): Hrm... I tried that, and it looks like `wild_00` has no unfolding. Is there a way to give it one? Or am I barking up the wrong tree? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Oct 1 18:24:19 2017 From: ghc-devs at haskell.org (GHC) Date: Sun, 01 Oct 2017 18:24:19 -0000 Subject: [GHC] #14302: ghc panic on simple program Message-ID: <046.b583c84b0e8f058de22ae295867759fd@haskell.org> #14302: ghc panic on simple program -------------------------------------+------------------------------------- Reporter: aberent | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 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 am experimenting with Haskell, and am attempting to write a simple maze solver. ghci gives meaningful errors for it, and doesn't crash, but ghc gives {{{ ~/haskell/course$ ghc tiltmaze.hs [1 of 1] Compiling Main ( tiltmaze.hs, tiltmaze.o ) ghc: panic! (the 'impossible' happened) (GHC version 8.0.2 for x86_64-unknown-linux): initTc: unsolved constraints WC {wc_insol = [W] m'_a5Wy :: t_a5Wx[tau:1] (CHoleCan: m') [W] sx'_a5WB :: t_a5WA[tau:1] (CHoleCan: sx') [W] sy'_a5WE :: t_a5WD[tau:1] (CHoleCan: sy')} Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug }}} The code is: {{{ import Data.Sequence as Sequence -- A maze is a grid of empty cells and walls -- true means wall data Maze = Seq (Seq Bool) data Direction = North | South | East | West directions = [North, South, East, West] step :: Direction -> Int -> Int -> (Int, Int) step d x y | North = (x, y-1) | South = (x, y+1) | East = (x+1, y) | West = (x-1, y) solve :: Maze -> Int -> Int -> Int -> Int -> Bool solve m sx sy tx ty | sx == tx && sy == ty = True | otherwise = let solved m x y d | x' < 0 = False | y' < 0 = False | x' >= Sequence.length m = False | y' >= Sequence.length $ m `index` x' = False | not ((m `index` x') `index` y') = False | otherwise = solve m' x' y' tx ty where (x', y') = step d m' = update y False (m `index` x) in any (solved m' sx' sy') directions }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Oct 1 18:55:25 2017 From: ghc-devs at haskell.org (GHC) Date: Sun, 01 Oct 2017 18:55:25 -0000 Subject: [GHC] #14302: ghc panic on simple program In-Reply-To: <046.b583c84b0e8f058de22ae295867759fd@haskell.org> References: <046.b583c84b0e8f058de22ae295867759fd@haskell.org> Message-ID: <061.cbae1b4059213e718711f2114a33a61b@haskell.org> #14302: ghc panic on simple program -------------------------------------+------------------------------------- Reporter: aberent | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 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 aberent): This appears to be an error in the error handling. Once I fix the compilation errors reported by ghci, ghc is happy to compile it. FYI my fixed code is: {{{ module Tiltmaze (solve) where import Data.Sequence as Sequence -- A maze is a grid of empty cells and walls -- true means wall type Maze = Seq (Seq Bool) data Direction = North | South | East | West deriving (Eq, Show) directions = [North, South, East, West] step :: Direction -> Int -> Int -> (Int, Int) step d x y | d == North = (x, y-1) | d == South = (x, y+1) | d == East = (x+1, y) | d == West = (x-1, y) solve :: Maze -> Int -> Int -> Int -> Int -> Bool solve m sx sy tx ty | sx == tx && sy == ty = True | otherwise = let solved m x y d | x' < 0 = False | y' < 0 = False | x' >= Sequence.length m = False | y' >= Sequence.length (m `index` x') = False | not ((m `index` x') `index` y') = False | otherwise = solve m' x' y' tx ty where (x', y') = step d x y m' = update x (update y False (m `index` x)) m in any (solved m sx sy) directions }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Oct 1 19:32:31 2017 From: ghc-devs at haskell.org (GHC) Date: Sun, 01 Oct 2017 19:32:31 -0000 Subject: [GHC] #14289: Pretty-printing of derived multi-parameter classes omits necessary parentheses In-Reply-To: <050.12237887bf2722a5c0ca5d51c4478a96@haskell.org> References: <050.12237887bf2722a5c0ca5d51c4478a96@haskell.org> Message-ID: <065.567a004559fa4a976d62ada9008232f1@haskell.org> #14289: Pretty-printing of derived multi-parameter classes omits necessary parentheses -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: alanz Type: bug | Status: patch Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 (Parser) | 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:D4056 Wiki Page: | -------------------------------------+------------------------------------- Changes (by alanz): * status: new => patch * differential: => Phab:D4056 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Oct 1 20:39:39 2017 From: ghc-devs at haskell.org (GHC) Date: Sun, 01 Oct 2017 20:39:39 -0000 Subject: [GHC] #14303: HasField ambiguity error Message-ID: <048.ee05ddbaf4b72d53660393c71b4f3051@haskell.org> #14303: HasField ambiguity error -------------------------------------+------------------------------------- Reporter: cloudhead | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- Both of these functions fail to compile with the error below: {{{#!haskell {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} import Control.Monad.Reader import GHC.Records import Data.Proxy askField :: forall x a m r. (HasField x r a, MonadReader r m) => m a askField = asks (getField @x) askField' :: forall x a m r. (HasField x r a, MonadReader r m) => m a askField' = asks (getFieldWithProxy (Proxy :: Proxy x)) where getFieldWithProxy :: forall proxy. proxy x -> r -> a getFieldWithProxy = const getField }}} {{{ Test.hs:12:14: error: • Could not deduce (HasField x0 r a) from the context: (HasField x r a, MonadReader r m) bound by the type signature for: askField' :: forall x a (m :: * -> *) r. (HasField x r a, MonadReader r m) => m a at Test.hs:12:14-69 The type variable ‘x0’ is ambiguous • In the ambiguity check for ‘askField'’ To defer the ambiguity check to use sites, enable AllowAmbiguousTypes In the type signature: askField' :: forall x a m r. (HasField x r a, MonadReader r m) => m a | 12 | askField' :: forall x a m r. (HasField x r a, MonadReader r m) => m a | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ }}} I hope I'm not missing something, but one of these should compile. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Oct 1 22:13:12 2017 From: ghc-devs at haskell.org (GHC) Date: Sun, 01 Oct 2017 22:13:12 -0000 Subject: [GHC] #14302: ghc panic on simple program In-Reply-To: <046.b583c84b0e8f058de22ae295867759fd@haskell.org> References: <046.b583c84b0e8f058de22ae295867759fd@haskell.org> Message-ID: <061.35a87e9614b5b45580560e77e29dd0f2@haskell.org> #14302: ghc panic on simple program -------------------------------------+------------------------------------- Reporter: aberent | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 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): Thanks for the bug report. This 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 Sun Oct 1 22:13:35 2017 From: ghc-devs at haskell.org (GHC) Date: Sun, 01 Oct 2017 22:13:35 -0000 Subject: [GHC] #14302: ghc panic on simple program In-Reply-To: <046.b583c84b0e8f058de22ae295867759fd@haskell.org> References: <046.b583c84b0e8f058de22ae295867759fd@haskell.org> Message-ID: <061.011b33c731e0ce92ac7edaa704f5e88e@haskell.org> #14302: ghc panic on simple program -------------------------------------+------------------------------------- Reporter: aberent | Owner: (none) Type: bug | Status: closed Priority: normal | 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 * version: 8.2.1 => 8.0.2 * resolution: => duplicate * related: => #13106 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Oct 1 22:22:03 2017 From: ghc-devs at haskell.org (GHC) Date: Sun, 01 Oct 2017 22:22:03 -0000 Subject: [GHC] #14303: HasField ambiguity error In-Reply-To: <048.ee05ddbaf4b72d53660393c71b4f3051@haskell.org> References: <048.ee05ddbaf4b72d53660393c71b4f3051@haskell.org> Message-ID: <063.f52d98ce84a6b3f066a345c74fbbf824@haskell.org> #14303: HasField ambiguity error -------------------------------------+------------------------------------- Reporter: cloudhead | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 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 RyanGlScott): * status: new => closed * resolution: => invalid Comment: This is expected behavior. GHC reports that these constraints are ambiguous because it can't determine what `x` is from the types on the right-hand sides of each function. Notice that `m a` doesn't mention `x`, and `x` isn't determined by a functional dependency like the `r` in `MonadReader r m`. There is a way to make ambiguous type signatures like this compile, however, by using the aptly named extension `AllowAmbiguousTypes` (which is often needed in `TypeApplications`-heavy code like what you have here). With `AllowAmbiguousTypes`, `askField` compiles without any further changes: {{{#!hs {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} import Control.Monad.Reader import GHC.Records import Data.Proxy askField :: forall x a m r. (HasField x r a, MonadReader r m) => m a askField = asks (getField @x) }}} Making `askField'` compile takes a little extra work, since GHC is unable to figure out that you meant to use `getField` at type `x`. To fix this, use another type application: {{{#!hs {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} import Control.Monad.Reader import GHC.Records import Data.Proxy askField' :: forall x a m r. (HasField x r a, MonadReader r m) => m a askField' = asks (getFieldWithProxy (Proxy :: Proxy x)) where getFieldWithProxy :: forall proxy. proxy x -> r -> a getFieldWithProxy = const (getField @x) }}} Which makes it compile as well. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Oct 1 23:38:44 2017 From: ghc-devs at haskell.org (GHC) Date: Sun, 01 Oct 2017 23:38:44 -0000 Subject: [GHC] #13604: ghci no longer loads dynamic .o files by default if they were built with -O In-Reply-To: <045.626a6b40d9101c93e2935653ef7e4668@haskell.org> References: <045.626a6b40d9101c93e2935653ef7e4668@haskell.org> Message-ID: <060.0684ddca2e8beb1b64f634116b29cbcb@haskell.org> #13604: ghci no longer loads dynamic .o files by default if they were built with -O -------------------------------------+------------------------------------- Reporter: George | Owner: dfeuer Type: bug | Status: new Priority: high | Milestone: 8.2.2 Component: Compiler | Version: 8.2.1-rc1 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): Phab:D3514 Wiki Page: | -------------------------------------+------------------------------------- Comment (by elaforge): Sorry about the delay, I guess trac doesn't email me when tickets are updated. The desired end result is that I have a bunch of .o files compiled with -O, and I need to load them into the GHC API. Similarly, I have a set of .o files compiled with -fhpc, and I need to load them into ghci. Any solution that reaches that result will probably work for me! [ bgamari ] > I'm not sure teaching ghci to ignore -O and -fhpc is a great idea since there may be users that want to use these flags from within an > interactive session. I don't understand this, ghci already ignores -O and -fhpc, and as far as I know always has, whether or not people want to use them. So the request is to continue ignoring those flags as always, but to be able to load files compiled with them... which presumably means include them in the hash. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 2 01:27:21 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 02 Oct 2017 01:27:21 -0000 Subject: [GHC] #14115: GHC segfaults trying to use TH code when ghc is compiled as DYNAMIC_GHC_PROGRAMS=NO In-Reply-To: <044.b3cd3c1bf232141df45df0c09168c130@haskell.org> References: <044.b3cd3c1bf232141df45df0c09168c130@haskell.org> Message-ID: <059.871b8c6dddf231edb1c817fe65e62ae8@haskell.org> #14115: GHC segfaults trying to use TH code when ghc is compiled as DYNAMIC_GHC_PROGRAMS=NO -------------------------------------+------------------------------------- Reporter: pacak | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: Component: Runtime System | Version: 8.2.1 (Linker) | Resolution: | Keywords: Operating System: Linux | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D3983 Wiki Page: | -------------------------------------+------------------------------------- Comment (by pacak): Still the case for 8.2.2rc -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 2 01:55:36 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 02 Oct 2017 01:55:36 -0000 Subject: [GHC] #14304: Instantiated libraries (Backpack) don't get linked with enough deps Message-ID: <045.7b75a2a889015ade587229e80d5bf80e@haskell.org> #14304: Instantiated libraries (Backpack) don't get linked with enough deps -------------------------------------+------------------------------------- Reporter: ezyang | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.2.2 Component: Compiler | Version: 8.2.1 (Linking) | 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: -------------------------------------+------------------------------------- One downstream instance of this reported at https://github.com/haskell/cabal/issues/4755 Basically, if you instantiate a library q with library p, you need to make sure libHSp.so shows up in its linker dependencies. This is not the case right now. Patch coming (I filed this to get a bug number :) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 2 02:24:00 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 02 Oct 2017 02:24:00 -0000 Subject: [GHC] #14305: Missing COMPLETE pragmas in release notes for version 8.2.1 Message-ID: <042.4751e422f40af59897721170938f7554@haskell.org> #14305: Missing COMPLETE pragmas in release notes for version 8.2.1 -------------------------------------+------------------------------------- Reporter: asr | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.2.2 Component: Documentation | 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: -------------------------------------+------------------------------------- From comment ticket:8779#comment:57 it seems `COMPLETE` pragmas were added in 8.2.1 but I couldn't find them in its [https://downloads.haskell.org/~ghc/8.2.1/docs/html/users_guide/8.2.1-notes.html release notes]. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 2 02:46:35 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 02 Oct 2017 02:46:35 -0000 Subject: [GHC] #14304: Instantiated libraries (Backpack) don't get linked with enough deps In-Reply-To: <045.7b75a2a889015ade587229e80d5bf80e@haskell.org> References: <045.7b75a2a889015ade587229e80d5bf80e@haskell.org> Message-ID: <060.5e11070e1704e35885bf6a99b52153ee@haskell.org> #14304: Instantiated libraries (Backpack) don't get linked with enough deps -------------------------------------+------------------------------------- Reporter: ezyang | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: 8.2.2 Component: Compiler | Version: 8.2.1 (Linking) | 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): Phab:D4057 Wiki Page: | -------------------------------------+------------------------------------- Changes (by ezyang): * status: new => patch * differential: => Phab:D4057 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 2 07:32:35 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 02 Oct 2017 07:32:35 -0000 Subject: [GHC] #14288: ScopedTypeVariables with nested foralls broken since 8.0.2 In-Reply-To: <054.12a8b47c33ef278049d5dc75803a77fb@haskell.org> References: <054.12a8b47c33ef278049d5dc75803a77fb@haskell.org> Message-ID: <069.5b20cf1daee9bc4b6324e2bbd44c04b1@haskell.org> #14288: ScopedTypeVariables with nested foralls broken since 8.0.2 -------------------------------------+------------------------------------- Reporter: MikolajKonarski | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.2.1 checker) | Resolution: | Keywords: Operating System: Linux | Architecture: x86_64 Type of failure: GHC rejects | (amd64) valid program | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): FWIW I don't have a very strong opinion here. I'd like to know what others think. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 2 07:39:56 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 02 Oct 2017 07:39:56 -0000 Subject: [GHC] #14282: tagToEnum# . dataToTag# not optimized away In-Reply-To: <045.5438ce0b3dc299cc3f08e924d6abe37c@haskell.org> References: <045.5438ce0b3dc299cc3f08e924d6abe37c@haskell.org> Message-ID: <060.0f921c530b6f96b4c0385a7bebeabc8e@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 simonpj): No, case binders don't get that unfolding... doing so might duplicate work. Reason it's case-bound is that it's a can-fail primop; see `Note [dataToTag#]` in `primops.txt.pp`. It's the `let/app invariant` in action. Rats. I suggest you put a comment with `dataToTagRule` explaining why this is tricky and pointing to this ticket, and then leave it. It's tiresome but I don't think it's important enough to merit further investment. (FWIW ultimately I think the right solution might be to make `dataToTag#` CONLIKE, and arrange to give unfoldings to the case binder of a case on a CONLIKE application. But I can't forsee all the consequences of that.) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 2 12:43:38 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 02 Oct 2017 12:43:38 -0000 Subject: [GHC] #14288: ScopedTypeVariables with nested foralls broken since 8.0.2 In-Reply-To: <054.12a8b47c33ef278049d5dc75803a77fb@haskell.org> References: <054.12a8b47c33ef278049d5dc75803a77fb@haskell.org> Message-ID: <069.18549ee0860752a83884fd426a8d20b0@haskell.org> #14288: ScopedTypeVariables with nested foralls broken since 8.0.2 -------------------------------------+------------------------------------- Reporter: MikolajKonarski | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.2.1 checker) | Resolution: | Keywords: Operating System: Linux | Architecture: x86_64 Type of failure: GHC rejects | (amd64) valid program | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): Actually, the issue I mentioned about pattern synonyms applies //today//. That it, this typechecks: {{{#!hs {-# LANGUAGE GADTs #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} data T a where MkT :: forall a b. (Show b) => a -> b -> T a pattern ExNumPat :: forall a. (Num a, Eq a) => forall b. (Show b) => b -> T a pattern ExNumPat x <- MkT 42 x where ExNumPat x = MkT @a 42 x }}} But this (with `@b`) doesn't! {{{#!hs {-# LANGUAGE GADTs #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} data T a where MkT :: forall a b. (Show b) => a -> b -> T a pattern ExNumPat :: forall a. (Num a, Eq a) => forall b. (Show b) => b -> T a pattern ExNumPat x <- MkT 42 x where ExNumPat x = MkT @a @b 42 x }}} Moreover, there's no workaround for this, since one can't combine the two `forall`s in the pattern signature for the reasons discussed in comment:6. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 2 12:47:42 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 02 Oct 2017 12:47:42 -0000 Subject: [GHC] #13707: xmobar crashes with segmentation faults? In-Reply-To: <046.fbf7af7bdea4e00dc6b71cd4d89ec01e@haskell.org> References: <046.fbf7af7bdea4e00dc6b71cd4d89ec01e@haskell.org> Message-ID: <061.d9032f0328a194dbd4a8d153d74966d4@haskell.org> #13707: xmobar crashes with segmentation faults? -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.2.1 Component: Compiler | Version: 8.2.1-rc2 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 bgamari): Thanks Rufflewind; I left an `xmobar` instance running in the background all of last week but sadly I still have yet to see a crash. I'll try your reproducer shortly. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 2 12:49:06 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 02 Oct 2017 12:49:06 -0000 Subject: [GHC] #14288: ScopedTypeVariables with nested foralls broken since 8.0.2 In-Reply-To: <054.12a8b47c33ef278049d5dc75803a77fb@haskell.org> References: <054.12a8b47c33ef278049d5dc75803a77fb@haskell.org> Message-ID: <069.e8fa588a721f48180b2fbe93667b8393@haskell.org> #14288: ScopedTypeVariables with nested foralls broken since 8.0.2 -------------------------------------+------------------------------------- Reporter: MikolajKonarski | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.2.1 checker) | Resolution: | Keywords: Operating System: Linux | Architecture: x86_64 Type of failure: GHC rejects | (amd64) valid program | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Yes, that's pretty convincing. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 2 12:54:23 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 02 Oct 2017 12:54:23 -0000 Subject: [GHC] #14288: ScopedTypeVariables with nested foralls broken since 8.0.2 In-Reply-To: <054.12a8b47c33ef278049d5dc75803a77fb@haskell.org> References: <054.12a8b47c33ef278049d5dc75803a77fb@haskell.org> Message-ID: <069.6cd8a78f50d934873f52ac9bf46e785e@haskell.org> #14288: ScopedTypeVariables with nested foralls broken since 8.0.2 -------------------------------------+------------------------------------- Reporter: MikolajKonarski | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.2.1 checker) | Resolution: | Keywords: Operating System: Linux | Architecture: x86_64 Type of failure: GHC rejects | (amd64) valid program | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): That being said, I'm sympathetic to the desire to have a consistent, predictable way to determine when exactly a `forall`'d variable from a type signature is brought into scope, so I don't want to hammer too hard on this point unless goldfire is on board too. I'm sure goldfire has a convincing example in comment:8, but I'm having trouble understanding what makes it convincing. I'm grasping at straws here, but is the concern that something like this (with invisible patterns written out explicitly) should "intuitively" typecheck: {{{#!hs f1 :: forall a. a -> Int -> forall b. (a, b) f1 @a x i @b = const (x, undefined :: b) i }}} But in the eta-reduced version: {{{#!hs f2 :: forall a. a -> Int -> forall b. (a, b) f2 @a x = const (x, undefined :: b {-?-}) }}} `b` isn't bound by an invisible pattern? Or is there some other reason why this should be considered "strange"? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 2 13:15:22 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 02 Oct 2017 13:15:22 -0000 Subject: [GHC] #14288: ScopedTypeVariables with nested foralls broken since 8.0.2 In-Reply-To: <054.12a8b47c33ef278049d5dc75803a77fb@haskell.org> References: <054.12a8b47c33ef278049d5dc75803a77fb@haskell.org> Message-ID: <069.6284ca9a9052655f02df86f0f05ce333@haskell.org> #14288: ScopedTypeVariables with nested foralls broken since 8.0.2 -------------------------------------+------------------------------------- Reporter: MikolajKonarski | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.2.1 checker) | Resolution: | Keywords: Operating System: Linux | Architecture: x86_64 Type of failure: GHC rejects | (amd64) valid program | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by goldfire): comment:13 has it. That's why it's strange. When I program in Haskell, I implicitly believe I'm programming in something quite like F_omega, but the compiler puts in gobs of annotations. And I find it disturbing and strange when the compiler rearranges my expressions. Also, what happens when you replace the right-hand side of the expression with `undefined`? Consider {{{#!hs f3 :: forall a b. a -> Int -> (a, b) f3 x = undefined f4 :: forall a. a -> Int -> forall b. (a, b) f4 x = undefined }}} Evaluating {{{f3 True `seq` ()}}} diverges, while {{{f4 True `seq` ()}}} returns `()`. This is because `f4 True` is really a lambda, due to the parameter-swizzling. I argue once we have a proper story for visible type patterns, `f4 True` will also be able to diverge, and then my original example becomes ever stranger. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 2 13:26:38 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 02 Oct 2017 13:26:38 -0000 Subject: [GHC] #13875: ApplicativeDo desugaring is lazier than standard desugaring In-Reply-To: <045.2eda858359df0999208d04da5f95a1da@haskell.org> References: <045.2eda858359df0999208d04da5f95a1da@haskell.org> Message-ID: <060.420dc2cca5f5fa5d1b16986a9d99b9a1@haskell.org> #13875: ApplicativeDo desugaring is lazier than standard desugaring -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: simonmar Type: bug | Status: closed Priority: high | Milestone: 8.2.1 Component: Compiler | Version: 8.3 Resolution: fixed | Keywords: ApplicativeDo Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Other | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D3681 Wiki Page: | -------------------------------------+------------------------------------- Comment (by andrewthad): I'm not sure if this has already been done, but the "Existentials patterns and GADTs" section of the user manual should probably be removed. https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/glasgow_exts.html #existential-patterns-and-gadts -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 2 13:37:27 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 02 Oct 2017 13:37:27 -0000 Subject: [GHC] #14288: ScopedTypeVariables with nested foralls broken since 8.0.2 In-Reply-To: <054.12a8b47c33ef278049d5dc75803a77fb@haskell.org> References: <054.12a8b47c33ef278049d5dc75803a77fb@haskell.org> Message-ID: <069.9e5f9f6a17961bc64f3d5eb305965ef0@haskell.org> #14288: ScopedTypeVariables with nested foralls broken since 8.0.2 -------------------------------------+------------------------------------- Reporter: MikolajKonarski | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.2.1 checker) | Resolution: | Keywords: Operating System: Linux | Architecture: x86_64 Type of failure: GHC rejects | (amd64) valid program | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): OK. I tried out a similar example in Idris to see how it handles an example like `f4` from comment:14, and it turns out that Idris rejects it as well. So I'm now convinced that we shouldn't attempt to support examples like that. In light of this, what if we changed `foralls` from comment:7 to just this? * `foralls(forall a_1 ... a_k. T) = {a_1, ..., a_k} ∪ foralls (T)` * `foralls(C => T) = foralls(T)` That is, simply remove the `foralls(b -> c) = foralls(c)` case. This means that of these examples from comment:5: {{{#!hs f1 :: forall a. forall b. blah f2 :: forall a. a -> forall b. blah f3 :: forall a. Eq a => forall b. blah }}} Then in `f1` and `f3`, `a` and `b` will be lexically scoped, but in `f2`, only `a` will be lexically scoped. Does that sound agreeable? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 2 13:42:24 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 02 Oct 2017 13:42:24 -0000 Subject: [GHC] #14288: ScopedTypeVariables with nested foralls broken since 8.0.2 In-Reply-To: <054.12a8b47c33ef278049d5dc75803a77fb@haskell.org> References: <054.12a8b47c33ef278049d5dc75803a77fb@haskell.org> Message-ID: <069.855885baebb912ee26922ca2172e4377@haskell.org> #14288: ScopedTypeVariables with nested foralls broken since 8.0.2 -------------------------------------+------------------------------------- Reporter: MikolajKonarski | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.2.1 checker) | Resolution: | Keywords: Operating System: Linux | Architecture: x86_64 Type of failure: GHC rejects | (amd64) valid program | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Good with me. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 2 13:44:23 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 02 Oct 2017 13:44:23 -0000 Subject: [GHC] #14306: pretty-printer missing parens for infix class declaration Message-ID: <044.1b8c19a623e4ae13057bf12d94e7fdd2@haskell.org> #14306: pretty-printer missing parens for infix class declaration -------------------------------------+------------------------------------- Reporter: alanz | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: #14289 Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- {{{#!hs class (a `C` b) c }}} Is pretty printed as {{{#!hs class a `C` b c }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 2 13:56:50 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 02 Oct 2017 13:56:50 -0000 Subject: [GHC] #13943: Compiler infinite loop with GHC-8.2 In-Reply-To: <048.054af5c39346b78fae836436fb73b68c@haskell.org> References: <048.054af5c39346b78fae836436fb73b68c@haskell.org> Message-ID: <063.e64b757e4e0d0c042093210b92460fad@haskell.org> #13943: Compiler infinite loop with GHC-8.2 -------------------------------------+------------------------------------- Reporter: vagarenko | Owner: dfeuer Type: bug | Status: new Priority: high | Milestone: 8.2.3 Component: Compiler | Version: 8.2.1-rc3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #12791 | 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 Mon Oct 2 13:58:18 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 02 Oct 2017 13:58:18 -0000 Subject: [GHC] #14230: Gruesome kind mismatch errors for associated data family instances In-Reply-To: <050.be2138b3feceaf8cddb1acd9189d3e67@haskell.org> References: <050.be2138b3feceaf8cddb1acd9189d3e67@haskell.org> Message-ID: <065.adb01ae5e4bc22ac70b1d89c2dbbc4b4@haskell.org> #14230: Gruesome kind mismatch errors for associated data family instances -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: goldfire Type: bug | Status: new Priority: high | Milestone: 8.4.1 Component: Compiler (Type | Version: 8.3 checker) | Resolution: | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: Type of failure: Poor/confusing | Unknown/Multiple error message | Test Case: Blocked By: | Blocking: Related Tickets: #14175 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * owner: (none) => goldfire * priority: normal => high * milestone: => 8.4.1 Comment: Richard and I discussed this. It's firmly on his radar. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 2 14:16:11 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 02 Oct 2017 14:16:11 -0000 Subject: [GHC] #11963: GHC introduces kind equality without TypeInType In-Reply-To: <045.559d5b56cb415a48409d0ecee32c5ab8@haskell.org> References: <045.559d5b56cb415a48409d0ecee32c5ab8@haskell.org> Message-ID: <060.db459cd25263d22ce7fad22bd18c3158@haskell.org> #11963: GHC introduces kind equality without TypeInType -------------------------------------+------------------------------------- Reporter: ezyang | Owner: johnleo Type: bug | Status: closed Priority: normal | Milestone: 8.2.2 Component: Compiler (Type | Version: 8.0.1-rc2 checker) | Resolution: fixed | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: | typecheck/should_fail/T11963 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): Reverted from `ghc-8.2` in 5e2d3e6d06a051dd30c0ce1919cd2d3d0ece087b as it causes a few programs from Hackage to be rejected, which we'd like to avoid in a point release. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 2 14:16:19 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 02 Oct 2017 14:16:19 -0000 Subject: [GHC] #11963: GHC introduces kind equality without TypeInType In-Reply-To: <045.559d5b56cb415a48409d0ecee32c5ab8@haskell.org> References: <045.559d5b56cb415a48409d0ecee32c5ab8@haskell.org> Message-ID: <060.634a134e6ac53c665bc6e2ff4d68172d@haskell.org> #11963: GHC introduces kind equality without TypeInType -------------------------------------+------------------------------------- Reporter: ezyang | Owner: johnleo Type: bug | Status: closed Priority: normal | Milestone: 8.4.1 Component: Compiler (Type | Version: 8.0.1-rc2 checker) | Resolution: fixed | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: | typecheck/should_fail/T11963 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * milestone: 8.2.2 => 8.4.1 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 2 14:18:40 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 02 Oct 2017 14:18:40 -0000 Subject: [GHC] #13897: Ship check-ppr in bindist and compile during testsuite run In-Reply-To: <046.c1d9498de95e82cc15e6c9fd657e4d84@haskell.org> References: <046.c1d9498de95e82cc15e6c9fd657e4d84@haskell.org> Message-ID: <061.732fcc7dec638108498b18f3c2a1b3ce@haskell.org> #13897: Ship check-ppr in bindist and compile during testsuite run -------------------------------------+------------------------------------- Reporter: bgamari | Owner: alanz Type: task | Status: upstream Priority: normal | Milestone: 8.4.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: 13716 Related Tickets: | Differential Rev(s): Phab:D4039 Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: patch => upstream -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 2 14:26:43 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 02 Oct 2017 14:26:43 -0000 Subject: [GHC] #14299: GHCi for GHC 8.2.1 crashed with simple function? In-Reply-To: <048.a4a45b6e4f4301891e63f7e5dbc2d991@haskell.org> References: <048.a4a45b6e4f4301891e63f7e5dbc2d991@haskell.org> Message-ID: <063.7b4ba8891c4ce7bd490d79c1aa16168a@haskell.org> #14299: GHCi for GHC 8.2.1 crashed with simple function? -------------------------------+-------------------------------------- Reporter: mathiassm | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: GHCi | Version: 8.2.1 Resolution: | Keywords: Operating System: MacOS X | Architecture: x86_64 (amd64) Type of failure: GHCi crash | Test Case: Blocked By: | Blocking: Related Tickets: #11771 | Differential Rev(s): Wiki Page: | -------------------------------+-------------------------------------- Changes (by bgamari): * related: => #11771 Comment: This looks very similar to #11771. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 2 14:27:07 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 02 Oct 2017 14:27:07 -0000 Subject: [GHC] #11771: ghc.exe: `panic'! (the 'impossible' happened); thread blocked indefinitely in an MVar operation In-Reply-To: <048.fac6b544c2d3d144dfdcb6fd33b2e2c7@haskell.org> References: <048.fac6b544c2d3d144dfdcb6fd33b2e2c7@haskell.org> Message-ID: <063.28f44a6bdc684ad79414227da04ba303@haskell.org> #11771: ghc.exe: `panic'! (the 'impossible' happened); thread blocked indefinitely in an MVar operation -------------------------------+---------------------------------------- Reporter: YoYoYonnY | Owner: (none) Type: bug | Status: new Priority: low | Milestone: Component: GHCi | Version: 7.10.3 Resolution: | Keywords: Operating System: Windows | Architecture: Unknown/Multiple Type of failure: GHCi crash | Test Case: Blocked By: | Blocking: Related Tickets: #14299 | Differential Rev(s): Wiki Page: | -------------------------------+---------------------------------------- Changes (by bgamari): * related: => #14299 Comment: This looks quite similar to #14299. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 2 14:30:02 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 02 Oct 2017 14:30:02 -0000 Subject: [GHC] #14294: IndexError: pop from empty list In-Reply-To: <048.d023a95248a740b652c7c9c06b669e05@haskell.org> References: <048.d023a95248a740b652c7c9c06b669e05@haskell.org> Message-ID: <063.d23a7bcb548eee1f9f6c5752e7814400@haskell.org> #14294: IndexError: pop from empty list -------------------------------------+------------------------------------- Reporter: heisenbug | Owner: bgamari 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): Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * owner: (none) => bgamari Comment: Alright, I'll need to look into this. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 2 14:54:10 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 02 Oct 2017 14:54:10 -0000 Subject: [GHC] #12822: Cleanup GHC verbosity flags In-Reply-To: <045.4d9fca09f9ab247dee7b220b1a06e9a9@haskell.org> References: <045.4d9fca09f9ab247dee7b220b1a06e9a9@haskell.org> Message-ID: <060.c0e097a7856c6fb9c6e13130685d7585@haskell.org> #12822: Cleanup GHC verbosity flags -------------------------------------+------------------------------------- Reporter: hsyl20 | Owner: (none) Type: task | Status: new Priority: low | Milestone: Component: Compiler | Version: 8.0.1 Resolution: | Keywords: | newcomer,flags Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Other | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): I wrote this in response to captaintrunky's query on `ghc-devs`, > Sergey Bykov writes: > >> Hi, I'm working with the #12822 task, which is a refactoring for the >> verbosity flag. It should be reimplemented in a way, similar to the >> 'optimization' flag. After studying the codebase, specifically >> *optLevelFlags*, I'm stuck with the following questions: >> >> 1. Should I add a new data 'VerbosityFlag' similar to GeneralFlag, >> DumpFlag, etc or should I extend any of existing data types? >> 2. How to determine a set of verbosity options to implement? Is >> grepping through all the codebase and adding corresponding options a >> good approach? >> > As I understand it, the task is to split up the current -v flags into > distinct flags. The current role of -v is described roughly in > Note [Verbosity levels] (although it references -ddump-most and > -ddump-all, which don't exist anymore). > > Grepping the source tree (e.g. for "verbosity dflags") would indeed be a > good way to find the various places it's used. For now let's just add > the new flags to GeneralFlag. If there are enough that GeneralFlags > becomes bloated we can refactor later. > -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 2 14:54:38 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 02 Oct 2017 14:54:38 -0000 Subject: [GHC] #12822: Cleanup GHC verbosity flags In-Reply-To: <045.4d9fca09f9ab247dee7b220b1a06e9a9@haskell.org> References: <045.4d9fca09f9ab247dee7b220b1a06e9a9@haskell.org> Message-ID: <060.fb817ddf62d05731b7bf1521bf3ccca7@haskell.org> #12822: Cleanup GHC verbosity flags -------------------------------------+------------------------------------- Reporter: hsyl20 | Owner: (none) Type: task | Status: new Priority: low | Milestone: Component: Compiler | Version: 8.0.1 Resolution: | Keywords: | newcomer,flags Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Other | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): For the record, here are the relevant uses of `verbosity` that I was able to quickly find, {{{ $ ag "verbosity .*dflags" compiler/backpack/DriverBkp.hs 514: | verbosity (hsc_dflags hsc_env) >= 2 -> showMsg "Skipping " "" compiler/ghci/Linker.hs 1463: = when (verbosity dflags > 1) $ compiler/main/Finder.hs 659: | verbosity dflags < 3 = 775: | verbosity dflags < 3 = compiler/main/DynFlags.hs 1998: || (verbosity dflags >= 4 && enableIfVerbose f) 2203: | verbosity dflags >= 4 = ["-v"] compiler/main/HscMain.hs 810: | verbosity (hsc_dflags hsc_env) >= 2 -> showMsg "Skipping " "" compiler/main/ErrUtils.hs 554: | verbosity dflags >= val = act 613: if verbosity dflags >= 2 684: = do { let verb = verbosity dflags ghc/Main.hs 233: case verbosity dflags6 of 736: let verb = verbosity dflags ghc/GHCi/UI.hs 553: when (isNothing maybe_exprs && verbosity dflags > 0) $ 588: let show_prompt = verbosity dflags > 0 || is_tty 618: liftIO $ when (verbosity dflags > 0) $ putStrLn "Leaving GHCi." 1818: when (verbosity dflags > 0) $ 2634: when (verbosity dflags2 > 0) $ }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 2 15:00:22 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 02 Oct 2017 15:00:22 -0000 Subject: [GHC] #14305: Missing COMPLETE pragmas in release notes for version 8.2.1 In-Reply-To: <042.4751e422f40af59897721170938f7554@haskell.org> References: <042.4751e422f40af59897721170938f7554@haskell.org> Message-ID: <057.5f44a950d3b41c4fb15aac7c133c18ff@haskell.org> #14305: Missing COMPLETE pragmas in release notes for version 8.2.1 -------------------------------------+------------------------------------- Reporter: asr | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: 8.2.2 Component: Documentation | 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:D4059 Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: new => patch * differential: => Phab:D4059 Comment: Good catch. See Phab:D4059 for a patch. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 2 15:05:51 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 02 Oct 2017 15:05:51 -0000 Subject: [GHC] #14282: tagToEnum# . dataToTag# not optimized away In-Reply-To: <045.5438ce0b3dc299cc3f08e924d6abe37c@haskell.org> References: <045.5438ce0b3dc299cc3f08e924d6abe37c@haskell.org> Message-ID: <060.abc5397ec10edf8ce8f7e3a2c12509b5@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 dfeuer): Yes, I think you're likely right about `CONLIKE` things, unless the inliner will end up actually inlining the applications and lead to some absurdity like `case dataToTag# x of DEFAULT -> case dataToTag# x of DEFAULT -> ....`. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 2 15:21:56 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 02 Oct 2017 15:21:56 -0000 Subject: [GHC] #14306: pretty-printer missing parens for infix class declaration In-Reply-To: <044.1b8c19a623e4ae13057bf12d94e7fdd2@haskell.org> References: <044.1b8c19a623e4ae13057bf12d94e7fdd2@haskell.org> Message-ID: <059.7e014fa1b1447ed59c3bc99e6657ae42@haskell.org> #14306: pretty-printer missing parens for infix class declaration -------------------------------------+------------------------------------- Reporter: alanz | Owner: alanz 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: #14289 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by alanz): * owner: (none) => alanz -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 2 15:33:00 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 02 Oct 2017 15:33:00 -0000 Subject: [GHC] #13397: Optimise calls to tagToEnum# In-Reply-To: <046.429e0ae0551e63067642e3cbde6e3fef@haskell.org> References: <046.429e0ae0551e63067642e3cbde6e3fef@haskell.org> Message-ID: <061.e18216ac3fd2574b3fd539dd9b0b04c4@haskell.org> #13397: Optimise calls to tagToEnum# -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: Component: Compiler | Version: 8.0.1 Resolution: fixed | 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: | -------------------------------------+------------------------------------- Changes (by dfeuer): * status: new => closed * resolution: => fixed -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 2 15:39:46 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 02 Oct 2017 15:39:46 -0000 Subject: [GHC] #9198: large performance regression in type checker speed in 7.8 In-Reply-To: <045.f5a457d59b89d5fb7ca7aaa1ff3c4984@haskell.org> References: <045.f5a457d59b89d5fb7ca7aaa1ff3c4984@haskell.org> Message-ID: <060.1b6a771c82010abe06f7c22ed337bc85@haskell.org> #9198: large performance regression in type checker speed in 7.8 -------------------------------------+------------------------------------- Reporter: carter | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Research Component: Compiler (Type | needed checker) | 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: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * priority: high => normal Comment: Dropping priority since we don't have any idea how to solve it! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 2 15:41:05 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 02 Oct 2017 15:41:05 -0000 Subject: [GHC] #12482: Infinite compilation time when using wrongly ordered constraints In-Reply-To: <046.385955bbc36fdf0c78384562d17bec02@haskell.org> References: <046.385955bbc36fdf0c78384562d17bec02@haskell.org> Message-ID: <061.28e1dc32997ce96107442299b5a1c346@haskell.org> #12482: Infinite compilation time when using wrongly ordered constraints -------------------------------------+------------------------------------- Reporter: danilo2 | Owner: (none) Type: bug | Status: infoneeded Priority: normal | Milestone: 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 simonpj): * priority: high => normal Comment: danilo2, I'm going to decrease priority because we can't make progress on this until we have something to go on. Simon -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 2 15:47:57 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 02 Oct 2017 15:47:57 -0000 Subject: [GHC] #12437: 20% regression in max_bytes_used for T1969 In-Reply-To: <047.090b2624111211cac9a272929b897b02@haskell.org> References: <047.090b2624111211cac9a272929b897b02@haskell.org> Message-ID: <062.3bc662cf14d61e3b571f231e86032d40@haskell.org> #12437: 20% regression in max_bytes_used for T1969 -------------------------------------+------------------------------------- Reporter: simonmar | Owner: bgamari Type: bug | Status: new Priority: highest | Milestone: 8.4.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): * owner: dfeuer => bgamari Comment: David is going to continue work on this, in part as a proxy for #7258 and #13426. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 2 17:15:03 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 02 Oct 2017 17:15:03 -0000 Subject: [GHC] #14288: ScopedTypeVariables with nested foralls broken since 8.0.2 In-Reply-To: <054.12a8b47c33ef278049d5dc75803a77fb@haskell.org> References: <054.12a8b47c33ef278049d5dc75803a77fb@haskell.org> Message-ID: <069.771e9ecfb4855eee312e5bcd3678e914@haskell.org> #14288: ScopedTypeVariables with nested foralls broken since 8.0.2 -------------------------------------+------------------------------------- Reporter: MikolajKonarski | Owner: RyanGlScott Type: bug | Status: new Priority: normal | Milestone: 8.4.1 Component: Compiler (Type | Version: 8.2.1 checker) | Resolution: | Keywords: Operating System: Linux | Architecture: x86_64 Type of failure: GHC rejects | (amd64) valid program | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * owner: (none) => RyanGlScott * milestone: => 8.4.1 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 2 18:15:31 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 02 Oct 2017 18:15:31 -0000 Subject: [GHC] #14306: pretty-printer missing parens for infix class declaration In-Reply-To: <044.1b8c19a623e4ae13057bf12d94e7fdd2@haskell.org> References: <044.1b8c19a623e4ae13057bf12d94e7fdd2@haskell.org> Message-ID: <059.4fae539b440352de5263d821186e9f16@haskell.org> #14306: pretty-printer missing parens for infix class declaration -------------------------------------+------------------------------------- Reporter: alanz | Owner: alanz 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: #14289 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Alan Zimmerman ): In [changeset:"0e9681268a38cbc15c9c2b50979624732c9077ce/ghc" 0e96812/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="0e9681268a38cbc15c9c2b50979624732c9077ce" Pretty-printer missing parens for infix class declaration class (a `C` b) c Is pretty printed as class a `C` b c Fixes #14306 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 2 18:58:43 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 02 Oct 2017 18:58:43 -0000 Subject: [GHC] #14298: Let Template Haskell dynamically add something with which to link (was: Let Template Haskell dynamically add a library against which to link) In-Reply-To: <050.5b84ef44d6dba8c28fe71b17d035f8a7@haskell.org> References: <050.5b84ef44d6dba8c28fe71b17d035f8a7@haskell.org> Message-ID: <065.3d467b36ce101cd32651cf19de79f8bd@haskell.org> #14298: Let Template Haskell dynamically add something with which to link -------------------------------------+------------------------------------- Reporter: harpocrates | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Template Haskell | 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: | -------------------------------------+------------------------------------- Description changed by harpocrates: Old description: > As of today, Template Haskell supports emitting foreign files (for C > compiler languages) via `addForeignFile`. In doing so, GHC takes on the > work of compiling these, linking against them, and then cleaning up any > other files. > > This makes packages like `inline-c` > ([https://hackage.haskell.org/package/inline-c]) possible, where you can > write C snippets in quasiquotes and these can interact with your Haskell > code. The user doesn't need to pass extra options to GHC (except to > enable the right language extensions), and they don't have to see any of > the intermediate generated artifacts. > > Unfortunately, that breaks down for non C compiler languages. It would be > nice for TH to also support directly adding a static library, since then > one could > > * use TH's `runIO` to generate static libraries by calling out to > whatever other compilers > * add the contents of those libraries via TH > * delete the temporary files created in the process (again using > `runIO`) > * have GHC statically link against the content (from the second bullet > point) > > I'm not sure what the API for this could be, but maybe adding a > `StaticLibrary` constructor to the `ForeignSrcLang` data type (so one > could use `addForeignFile :: ForeignSrcLang -> String -> Q ()`)? New description: As of today, Template Haskell supports emitting foreign files (for C compiler languages) via `addForeignFile`. In doing so, GHC takes on the work of compiling these, linking them, and then cleaning up any other files. This makes packages like `inline-c` ([https://hackage.haskell.org/package/inline-c]) possible, where you can write C snippets in quasiquotes and these can interact with your Haskell code. The user doesn't need to pass extra options to GHC (except to enable the right language extensions), and they don't have to see any of the intermediate generated artifacts. Unfortunately, that breaks down for non C compiler languages. It would be nice for TH to also support directly adding something to pass to the linker, since then one could * use TH's `runIO` to generate libraries or object files by calling out to whatever other compilers * add those via TH * have GHC statically link against the content (from the second bullet point) I'm not sure what the API for this could be, but maybe 1. add a `LangLinkable` constructor to the `ForeignSrcLang` data type 2. add a `qAddForeignFilePath :: ForeignSrcLang -> FilePath -> m ()` method to `Quasi m` -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 2 19:16:41 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 02 Oct 2017 19:16:41 -0000 Subject: [GHC] #14298: Let Template Haskell dynamically add something with which to link In-Reply-To: <050.5b84ef44d6dba8c28fe71b17d035f8a7@haskell.org> References: <050.5b84ef44d6dba8c28fe71b17d035f8a7@haskell.org> Message-ID: <065.171c0eca4e7fa4683d10f1da931c8e6a@haskell.org> #14298: Let Template Haskell dynamically add something with which to link -------------------------------------+------------------------------------- Reporter: harpocrates | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Template Haskell | 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 harpocrates): I have a functional first-pass implementation of this complete. Is this feature something GHC would eventually consider merging in? If so, what is the process for doing that, and where would discussion for settling on the right TH API take place? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 2 19:22:35 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 02 Oct 2017 19:22:35 -0000 Subject: [GHC] #14298: Let Template Haskell dynamically add something with which to link In-Reply-To: <050.5b84ef44d6dba8c28fe71b17d035f8a7@haskell.org> References: <050.5b84ef44d6dba8c28fe71b17d035f8a7@haskell.org> Message-ID: <065.fffe10faef23fa18dbc1edb6ff1cbb26@haskell.org> #14298: Let Template Haskell dynamically add something with which to link -------------------------------------+------------------------------------- Reporter: harpocrates | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Template Haskell | 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): TH is a bit of a gray area. Non-TH language features go through the [https://github.com/ghc-proposals/ghc-proposals ghc-proposals] process, but TH features tend not to. I would recommend posting to ghc-devs. That will reach the people that care deeply about TH and would be able to evaluate this idea. (I care deeply about TH, but I have a very weak understanding of how the FFI works, and so I don't have an informed opinion here.) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 2 20:32:38 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 02 Oct 2017 20:32:38 -0000 Subject: [GHC] #13884: To an automatic compilation of file-header LANGUAGE pragmas in GHC. In-Reply-To: <044.5438e0b55f2f96ccdf324b161ad363cb@haskell.org> References: <044.5438e0b55f2f96ccdf324b161ad363cb@haskell.org> Message-ID: <059.4b195b5379b603537a8cf1972c18421a@haskell.org> #13884: To an automatic compilation of file-header LANGUAGE pragmas in GHC. -------------------------------------+------------------------------------- Reporter: vanto | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.0.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: | -------------------------------------+------------------------------------- Comment (by AntC): Replying to [comment:8 vanto]: > Replying to [[span(style=color: #FF0000, goldfire )]]\\ -1 from me. I usually want to use a minimum of flags; the compiler messages help me switch them on in a controlled, deliberate sequence. Flags/pragmas around Overlaps and `IncoherentInstances` I would never want to be enabled automatically: if I've written instances needing incoherence, I've done something wrong. I echo @goldfire's suggestion to use the established process, not Trac, to get a wider opinion. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 2 21:04:00 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 02 Oct 2017 21:04:00 -0000 Subject: [GHC] #14288: ScopedTypeVariables with nested foralls broken since 8.0.2 In-Reply-To: <054.12a8b47c33ef278049d5dc75803a77fb@haskell.org> References: <054.12a8b47c33ef278049d5dc75803a77fb@haskell.org> Message-ID: <069.acdfe960b04ccc36a516c6ac5121239d@haskell.org> #14288: ScopedTypeVariables with nested foralls broken since 8.0.2 -------------------------------------+------------------------------------- Reporter: MikolajKonarski | Owner: RyanGlScott Type: bug | Status: new Priority: normal | Milestone: 8.4.1 Component: Compiler (Type | Version: 8.2.1 checker) | Resolution: | Keywords: Operating System: Linux | Architecture: x86_64 Type of failure: GHC rejects | (amd64) valid program | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): Hm. Implementing the renaming part of this patch is a breeze, but modifying the typechecker is proving to be a pain. The source of my headaches can be traced down to this [http://git.haskell.org/ghc.git/blob/0e9681268a38cbc15c9c2b50979624732c9077ce:/compiler/typecheck/TcMType.hs#l437 tcInstType] function: {{{#!hs tcInstType :: ([TyVar] -> TcM (TCvSubst, [TcTyVar])) -- ^ How to instantiate the type variables -> Id -- ^ Type to instantiate -> TcM ([(Name, TcTyVar)], TcThetaType, TcType) -- ^ Result -- (type vars, preds (incl equalities), rho) }}} The problem is that at the moment, the first part of the triple that `tcInstType` returns corresponds to the lexically scoped type variables. But there's an assumption that these variables will all appear consecutively, uninterrupted by a `TcThetaType`. With the proposed changes in this ticket, this assumption will no longer hold true. But I can't just return more type variables in the first part of the triple, because almost all call sites of `tcInstType` reconstruct the instantiated type with something like `forall . => `. In other words, cramming more type variables would cause the wrong types to be constructed! So `tcInstType` just seems to be designed the wrong way for what I want to accomplish, but I can't figure out how to redesign it sensibly... -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 2 21:35:30 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 02 Oct 2017 21:35:30 -0000 Subject: [GHC] #14307: Nonexistent constructor name + NamedFieldPuns + DuplicateRecordFields can cause ambiguous occurrence message Message-ID: <046.4bb60103aff0450ac9d1c7696050c9a0@haskell.org> #14307: Nonexistent constructor name + NamedFieldPuns + DuplicateRecordFields can cause ambiguous occurrence message -------------------------------------+------------------------------------- Reporter: mgsloan | Owner: (none) Type: feature | Status: new request | Priority: low | Milestone: Component: Compiler | Version: 8.2.1 Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- This is a minor issue with error message clarity. I was confused for a few minutes because in a more complicated example I did not see the out of scope error, and was instead focused on the ambiguity error. {{{ {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE NamedFieldPuns #-} data A = A { field :: Int } data B = B { field :: Int } f :: A -> Int f C { field } = field }}} yields {{{ duplicate_records_bug.hs:8:3: error: Not in scope: data constructor ‘C’ | 8 | f C { field } = field | ^ duplicate_records_bug.hs:8:7: error: Ambiguous occurrence ‘field’ It could refer to either the field ‘field’, defined at duplicate_records_bug.hs:5:14 or the field ‘field’, defined at duplicate_records_bug.hs:4:14 | 8 | f C { field } = field | ^^^^^ }}} I actually think it would make sense to allow ambiguous identifiers in field puns even if DuplicateRecordFields is not enabled. This makes sense, because for an unambiguous constructor, a particular field name is always unambiguous. So, that might be another way to frame this issue: Should ambiguous field identifiers always be allowed in puns? In particular, this would make things more consistent with RecordWildCards, which does not care if the field names shadow anything that is in scope / other field names. I realize that broadening the code allowed by NamedFieldPuns could lead to issues where code written for newer GHC versions does not work with older GHC versions. This certainly will not change the meaning of older code. What's the policy on this? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 2 22:18:53 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 02 Oct 2017 22:18:53 -0000 Subject: [GHC] #12759: Latest Debian GCC breaks GHC In-Reply-To: <044.486464eb4c2bd2fafaa87b512dadd156@haskell.org> References: <044.486464eb4c2bd2fafaa87b512dadd156@haskell.org> Message-ID: <059.4e4823358fa2dc69a1fdca22346a85b1@haskell.org> #12759: Latest Debian GCC breaks GHC -------------------------------------+------------------------------------- Reporter: erikd | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: 8.0.2 Component: Compiler | Version: 8.0.1 Resolution: fixed | Keywords: Operating System: Linux | Architecture: | Unknown/Multiple Type of failure: Other | Test Case: Blocked By: | Blocking: Related Tickets: #12755, #11834, | Differential Rev(s): Phab:D2707 #9007 | Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): For the record, old (pre-8.0.2) compiler installations can be retrofitted to work with newer gccs by locating the compiler's `settings` file (e.g. `/usr/lib/ghc-7.10.3/settings`) and adding `-no-pie` to `C compiler link flags`. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 2 22:32:40 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 02 Oct 2017 22:32:40 -0000 Subject: [GHC] #14292: Coercing between constraints of newtypes In-Reply-To: <051.e9d001b6d6e7069b1e2d96a31ac34922@haskell.org> References: <051.e9d001b6d6e7069b1e2d96a31ac34922@haskell.org> Message-ID: <066.1fcbba4022532c75ff53cb7a0e6dedf9@haskell.org> #14292: Coercing between constraints of newtypes -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 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 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 2 23:32:07 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 02 Oct 2017 23:32:07 -0000 Subject: [GHC] #14308: GHC panic with invalid expression Message-ID: <042.d6a55a0cfdfc4d972f163c729be99318@haskell.org> #14308: GHC panic with invalid expression ----------------------------------------+--------------------------------- Reporter: d6e | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 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: ----------------------------------------+--------------------------------- Hi, I recently discovered this expression causes GHC to panic. Shouldn't it handle this more gracefully? Perhaps saying something like "That expression is not valid. " Invalid expression: {{{#!hs g :: (a->b) a }}} {{{ Prelude> g :: (a->b) a ghc: panic! (the 'impossible' happened) (GHC version 8.2.1 for x86_64-apple-darwin): repSplitAppTys a_a1Lz[sk:1] b_a1LA[sk:1] [] 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/types/Type.hs:808:9 in ghc:Type 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 Oct 3 00:05:13 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 03 Oct 2017 00:05:13 -0000 Subject: [GHC] #14298: Let Template Haskell dynamically add something with which to link In-Reply-To: <050.5b84ef44d6dba8c28fe71b17d035f8a7@haskell.org> References: <050.5b84ef44d6dba8c28fe71b17d035f8a7@haskell.org> Message-ID: <065.98171cacfc1dd05326f6bc798615ba31@haskell.org> #14298: Let Template Haskell dynamically add something with which to link -------------------------------------+------------------------------------- Reporter: harpocrates | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Template Haskell | 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 bgamari): I'm a bit skeptical of this; what should happen when GHC is invoked in single-shot mode (e.g. `-c`)? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 3 00:14:36 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 03 Oct 2017 00:14:36 -0000 Subject: [GHC] #13561: Remove unsafe Chan combinators In-Reply-To: <046.9b8c966d23c3a50c08be628b9e43df65@haskell.org> References: <046.9b8c966d23c3a50c08be628b9e43df65@haskell.org> Message-ID: <061.f781e74f64d1e8350095b117e4c757c8@haskell.org> #13561: Remove unsafe Chan combinators -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: task | Status: patch Priority: high | Milestone: 8.4.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: #4154 | Differential Rev(s): Phab:D4060 Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: new => patch * differential: => Phab:D4060 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 3 00:16:33 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 03 Oct 2017 00:16:33 -0000 Subject: [GHC] #14116: STG lint error while compiling master In-Reply-To: <046.64b3c05e81659fe1cbefd837174d080f@haskell.org> References: <046.64b3c05e81659fe1cbefd837174d080f@haskell.org> Message-ID: <061.04ff4a59577a7f09ec097a821a8c88c3@haskell.org> #14116: STG lint error while compiling master -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: closed Priority: high | 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:D3856 Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: patch => closed * resolution: => fixed Comment: f17f1063a29452843195c59e6cca2191b9d46c7f fixes this by giving up on checking of types in STG lint. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 3 01:06:56 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 03 Oct 2017 01:06:56 -0000 Subject: [GHC] #14298: Let Template Haskell dynamically add something with which to link In-Reply-To: <050.5b84ef44d6dba8c28fe71b17d035f8a7@haskell.org> References: <050.5b84ef44d6dba8c28fe71b17d035f8a7@haskell.org> Message-ID: <065.4c34057b8a2d60f6ac4ddc432b49bfc3@haskell.org> #14298: Let Template Haskell dynamically add something with which to link -------------------------------------+------------------------------------- Reporter: harpocrates | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Template Haskell | 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 harpocrates): Let me reply to those two points in reverse order. :) > It seems like in generate this feature would need support from external tools (e.g. cabal) to work properly. I'm not sure that is the case. TH already has support for adding in C source files, compiling them, and linking them. This feature request is requesting a way to hook into ''just'' the linking part of the pipeline that was built in https://phabricator.haskell.org/D3280 (instead of also running a C compiler). I don't think cabal factors into the existing `qAddForeignFile`, so I don't see why it should factor into my proposed `qAddForeignFilePath`. > I'm a bit skeptical of this; what should happen when GHC is invoked in single-shot mode (e.g. `-c`)? I'd expect to see the same thing that would happen if GHC where invoked in single-shot mode on something involving `addForeignFile`, that is to say: `cannot find object file './Support.dyn_o'` where `Support` is the module containing the TH. That said, my understanding of `-c` is that it shouldn't work on any module that uses TH from another module. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 3 04:31:47 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 03 Oct 2017 04:31:47 -0000 Subject: [GHC] #14257: Heap profiling with ghc and hp2ps and strict function application ($!) gives samples out of sequence (regression) In-Reply-To: <049.0b02f45f092991ff71d90010f90c58a1@haskell.org> References: <049.0b02f45f092991ff71d90010f90c58a1@haskell.org> Message-ID: <064.3b5b67e1773f8d49824231fc8ff55b09@haskell.org> #14257: Heap profiling with ghc and hp2ps and strict function application ($!) gives samples out of sequence (regression) -------------------------------------+------------------------------------- Reporter: carlostome | Owner: bgamari Type: bug | Status: new Priority: high | Milestone: 8.4.1 Component: Runtime 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: #14006 | 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 Oct 3 04:32:44 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 03 Oct 2017 04:32:44 -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.aad030ac480686e8cdd2a74b488261b7@haskell.org> #14006: Heap profiling ghc gives hp2ps error -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.4.1 Component: Runtime System | Version: 8.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Debugging | Unknown/Multiple information is incorrect | Test Case: Blocked By: | Blocking: Related Tickets: #11645 | 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 Oct 3 06:44:42 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 03 Oct 2017 06:44:42 -0000 Subject: [GHC] #14306: pretty-printer missing parens for infix class declaration In-Reply-To: <044.1b8c19a623e4ae13057bf12d94e7fdd2@haskell.org> References: <044.1b8c19a623e4ae13057bf12d94e7fdd2@haskell.org> Message-ID: <059.f606efaf30a99d8bb6a67bbec4314462@haskell.org> #14306: pretty-printer missing parens for infix class declaration -------------------------------------+------------------------------------- Reporter: alanz | Owner: alanz Type: bug | Status: closed Priority: normal | Milestone: 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: #14289 | 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 Tue Oct 3 07:24:13 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 03 Oct 2017 07:24:13 -0000 Subject: [GHC] #14308: GHC panic with invalid expression In-Reply-To: <042.d6a55a0cfdfc4d972f163c729be99318@haskell.org> References: <042.d6a55a0cfdfc4d972f163c729be99318@haskell.org> Message-ID: <057.1d64336c141688a16f5ae9a5811b867b@haskell.org> #14308: GHC panic with invalid expression ---------------------------------+---------------------------------------- Reporter: d6e | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 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: | ---------------------------------+---------------------------------------- Comment (by simonpj): Maybe this has been fixed? {{{ GHCi, version 8.2.1.20170831: http://www.haskell.org/ghc/ :? for help Prelude> id :: (a->b) a :1:7: error: • Expecting one fewer arguments to ‘a -> b’ Expected kind ‘* -> *’, but ‘a -> b’ has kind ‘*’ • In an expression type signature: (a -> b) a In the expression: id :: (a -> b) a In an equation for ‘it’: it = id :: (a -> b) a }}} Looks very like #14232, #14110 and friends -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 3 09:04:46 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 03 Oct 2017 09:04:46 -0000 Subject: [GHC] #14307: Nonexistent constructor name + NamedFieldPuns + DuplicateRecordFields can cause ambiguous occurrence message In-Reply-To: <046.4bb60103aff0450ac9d1c7696050c9a0@haskell.org> References: <046.4bb60103aff0450ac9d1c7696050c9a0@haskell.org> Message-ID: <061.448692fd342646fb11de22454a7a40ce@haskell.org> #14307: Nonexistent constructor name + NamedFieldPuns + DuplicateRecordFields can cause ambiguous occurrence message -------------------------------------+------------------------------------- Reporter: mgsloan | Owner: (none) Type: feature request | Status: new Priority: low | 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 nh2): * cc: nh2 (added) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 3 09:50:33 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 03 Oct 2017 09:50:33 -0000 Subject: [GHC] #14307: NamedFieldPuns should allow "ambiguous" field names (was: Nonexistent constructor name + NamedFieldPuns + DuplicateRecordFields can cause ambiguous occurrence message) In-Reply-To: <046.4bb60103aff0450ac9d1c7696050c9a0@haskell.org> References: <046.4bb60103aff0450ac9d1c7696050c9a0@haskell.org> Message-ID: <061.d278cce74fafd5a49a161b9188e38b1f@haskell.org> #14307: NamedFieldPuns should allow "ambiguous" field names -------------------------------------+------------------------------------- Reporter: mgsloan | Owner: (none) Type: feature request | Status: new Priority: low | 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: | -------------------------------------+------------------------------------- Description changed by mgsloan: Old description: > This is a minor issue with error message clarity. I was confused for a > few minutes because in a more complicated example I did not see the out > of scope error, and was instead focused on the ambiguity error. > > {{{ > {-# LANGUAGE DuplicateRecordFields #-} > {-# LANGUAGE NamedFieldPuns #-} > > data A = A { field :: Int } > data B = B { field :: Int } > > f :: A -> Int > f C { field } = field > }}} > > yields > > {{{ > duplicate_records_bug.hs:8:3: error: > Not in scope: data constructor ‘C’ > | > 8 | f C { field } = field > | ^ > > duplicate_records_bug.hs:8:7: error: > Ambiguous occurrence ‘field’ > It could refer to either the field ‘field’, > defined at duplicate_records_bug.hs:5:14 > or the field ‘field’, defined at > duplicate_records_bug.hs:4:14 > | > 8 | f C { field } = field > | ^^^^^ > }}} > > I actually think it would make sense to allow ambiguous identifiers in > field puns even if DuplicateRecordFields is not enabled. This makes > sense, because for an unambiguous constructor, a particular field name is > always unambiguous. So, that might be another way to frame this issue: > Should ambiguous field identifiers always be allowed in puns? > > In particular, this would make things more consistent with > RecordWildCards, which does not care if the field names shadow anything > that is in scope / other field names. > > I realize that broadening the code allowed by NamedFieldPuns could lead > to issues where code written for newer GHC versions does not work with > older GHC versions. This certainly will not change the meaning of older > code. What's the policy on this? New description: Consider the following example: {{{#!haskell {-# LANGUAGE NamedFieldPuns #-} import DupType data A = A { field :: Int } f :: A -> Int f A { field } = field }}} with {{{#!haskell module DupType where data B = B { field :: Int } }}} This results in the following error: {{{ A.hs:8:7: error: Ambiguous occurrence ‘field’ It could refer to either ‘DupType.field’, imported from ‘DupType’ at A.hs:3:1-14 (and originally defined at DupType.hs:3:14-18) or ‘Main.field’, defined at A.hs:5:14 | 8 | f A { field } = field | ^^^^^ }}} This seems like poor behavior, because since a particular constructor is used, it is unambiguous which field is intended. In particular, this is inconsistent with `RecordWildCards`. Consider that `f A { .. } = field` compiles perfectly fine. I actually encountered this issue in a bit of a different usecase. I was using `NamedFieldPuns` along with `DuplicateFieldNames`. However, I got the constructor name wrong. After the scope error in the output, there was an ambiguous field name error. This was quite confusing because `DuplicateFieldNames` was on, so ambiguity should be fine! Took me a while to realize that the scope error was the root issue. With the constructor name fixed, the code compiled. If the constructor was used to resolve field names, then the 2nd error wouldn't have been emitted. I realize that broadening the code allowed by `NamedFieldPuns` could lead to issues where code written for newer GHC versions does not work with older GHC versions. This certainly will not change the meaning of older code. What's the policy on this? -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 3 11:37:05 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 03 Oct 2017 11:37:05 -0000 Subject: [GHC] #14288: ScopedTypeVariables with nested foralls broken since 8.0.2 In-Reply-To: <054.12a8b47c33ef278049d5dc75803a77fb@haskell.org> References: <054.12a8b47c33ef278049d5dc75803a77fb@haskell.org> Message-ID: <069.ce3962e22e29b2025cbe173bcf4a3c31@haskell.org> #14288: ScopedTypeVariables with nested foralls broken since 8.0.2 -------------------------------------+------------------------------------- Reporter: MikolajKonarski | Owner: RyanGlScott Type: bug | Status: new Priority: normal | Milestone: 8.4.1 Component: Compiler (Type | Version: 8.2.1 checker) | Resolution: | Keywords: Operating System: Linux | Architecture: x86_64 Type of failure: GHC rejects | (amd64) valid program | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Yes, this is awkward. When we instantiate a type signature, we currently instantiate only the outer foralls and context. See `TcSigs.tcInstSig`. The scoped type variables come from the `sig_inst_skols`. Very similar story in `TcBinds.tcPolyCheck`. I suppose we can generalise this story. Instead of having {{{ data TcIdSigInst = TISI { ... , sig_inst_skols :: [(Name, TcTyVar)] , sig_inst_theta :: TcThetaType ... } }}} I suppose we could have a list of pairs of those things: {{{ data TcIdSigInst = TISI { ... , sig_inst_prefis :: [([(Name, TcTyVar)], TcThetaType)] ... } }}} Or maybe, more uniformly: {{{ data TcIdSigInst = TISI { ... , sig_inst_prefis :: [SigInstSpec] ... } data SigInstSpec = SITyVar Name TcTyVar | SIPred TcPredType }}} Then `tcInstType` might have type {{{ tcInstType :: (...) -> Id -> TcM ([SigInstSpec], TcRhoType) }}} I think we could carry this through uniformly. But I haven't tried. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 3 12:23:53 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 03 Oct 2017 12:23:53 -0000 Subject: [GHC] #14298: Let Template Haskell dynamically add something with which to link In-Reply-To: <050.5b84ef44d6dba8c28fe71b17d035f8a7@haskell.org> References: <050.5b84ef44d6dba8c28fe71b17d035f8a7@haskell.org> Message-ID: <065.49c6700d2231183ccc15d1f57443478a@haskell.org> #14298: Let Template Haskell dynamically add something with which to link -------------------------------------+------------------------------------- Reporter: harpocrates | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Template Haskell | 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 hsyl20): About the API, I would prefer: {{{#!hs addForeignObject :: ByteString -> Q () }}} in order to directly produce objects from TH without having to generate temporary object files. Then it should be enough to use [https://www.stackage.org/haddock/lts-9.6 /template-haskell-2.11.1.0/Language-Haskell-TH- Syntax.html#v:addDependentFile addDependentFile] and `Data.ByteString.getContents` to write the `addForeignObjectFile :: FilePath -> Q ()` helper function. (People from Tweag I/O were also interested in this: https://www.reddit.com/r/haskell/comments/6p1aqo/building_inlinec_projects_just_got_a_lot_easier/dkn2w8w/) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 3 13:10:48 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 03 Oct 2017 13:10:48 -0000 Subject: [GHC] #14292: Coercing between constraints of newtypes In-Reply-To: <051.e9d001b6d6e7069b1e2d96a31ac34922@haskell.org> References: <051.e9d001b6d6e7069b1e2d96a31ac34922@haskell.org> Message-ID: <066.e267d78134381653e9f18b9bca6d2805@haskell.org> #14292: Coercing between constraints of newtypes -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 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 started a [https://www.reddit.com/r/haskell/comments/72zdwm/use_cases_for_type_classes_with_representational/ reddit discussion]. * `type role Coercible representational representational` is an example of a "type class" with representational roles. * [http://www.well-typed.com/blog/2015/07/checked-exceptions/ Well-Typed] has a `representational` example that could be `phantom` (`class Throws e`). * [https://www.reddit.com/r/haskell/comments/2iqrr5/video_simon_peyton_jones_zerocost_coercions_in/cl6k9ik/ Sjoerd Visscher] wants this as early as 2 years ago. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 3 13:23:30 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 03 Oct 2017 13:23:30 -0000 Subject: [GHC] #13819: TypeApplications-related GHC panic In-Reply-To: <051.cbfd374163652d5209657cd86d4948f0@haskell.org> References: <051.cbfd374163652d5209657cd86d4948f0@haskell.org> Message-ID: <066.b9f30bd04948b9219fc68bebc64b9236@haskell.org> #13819: TypeApplications-related GHC panic -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: goldfire Type: bug | Status: merge Priority: high | Milestone: 8.4.1 Component: Compiler (Type | Version: 8.2.1-rc2 checker) | Keywords: Resolution: | TypeApplications Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Compile-time | Test Case: crash or panic | typecheck/should_fail/T13819 Blocked By: | Blocking: Related Tickets: #13846, #13850 | Differential Rev(s): Phab:D3754 Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): Ben, I take it that commit c2417b87ff59c92fbfa8eceeff2a0d6152b11a47 (`Fix #13819 by refactoring TypeEqOrigin.uo_thing`) isn't going to be merged into 8.2.2? If so, we ought to close this. It's interesting to note that even though that commit hasn't been merged to 8.2.2, the program in this ticket not longer panics on GHC 8.2.2! It turns out that commit cbf472384b5b583c24d1a1a32f3fa58d4f1501b1 (`Small refactor of getRuntimeRep`) //separately// fixed this panic, and that commit was backported to 8.2.2. So that's nice. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 3 13:24:48 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 03 Oct 2017 13:24:48 -0000 Subject: [GHC] #14308: GHC panic with invalid expression In-Reply-To: <042.d6a55a0cfdfc4d972f163c729be99318@haskell.org> References: <042.d6a55a0cfdfc4d972f163c729be99318@haskell.org> Message-ID: <057.82c2b9ee3bb8b4dd998244b26e192474@haskell.org> #14308: GHC panic with invalid expression ---------------------------------+---------------------------------------- Reporter: d6e | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: duplicate | Keywords: Operating System: MacOS X | Architecture: Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #13819 | Differential Rev(s): Wiki Page: | ---------------------------------+---------------------------------------- Changes (by RyanGlScott): * status: new => closed * resolution: => duplicate * related: => #13819 Comment: Indeed, this is a duplicate of #13819. It's definitely fixed in GHC 8.4, and it happens to be fixed in GHC 8.2.2, too (see https://ghc.haskell.org/trac/ghc/ticket/13819#comment:16). -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 3 13:26:10 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 03 Oct 2017 13:26:10 -0000 Subject: [GHC] #14232: Invalid type signature prokoves error in GHCi In-Reply-To: <046.50af05586dbbb6aeb886c7ddeb6828b1@haskell.org> References: <046.50af05586dbbb6aeb886c7ddeb6828b1@haskell.org> Message-ID: <061.4fbaa6524ddd0acb22219d3f95b28848@haskell.org> #14232: Invalid type signature prokoves error in GHCi -------------------------------------+------------------------------------- Reporter: walling | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: Component: GHCi | Version: 8.2.1 Resolution: duplicate | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Poor/confusing | Unknown/Multiple error message | Test Case: Blocked By: | Blocking: Related Tickets: #13819 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * status: new => closed * os: MacOS X => Unknown/Multiple * resolution: => duplicate * architecture: x86_64 (amd64) => Unknown/Multiple * related: => #13819 Comment: This is a duplicate of #13819. It's definitely fixed in GHC 8.4, since it was fixed in commit c2417b87ff59c92fbfa8eceeff2a0d6152b11a47 (`Fix #13819 by refactoring TypeEqOrigin.uo_thing`). It happens to be fixed in GHC 8.2.2, too (see https://ghc.haskell.org/trac/ghc/ticket/13819#comment:16). -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 3 13:26:52 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 03 Oct 2017 13:26:52 -0000 Subject: [GHC] #14110: GHC Panic on over-saturated associated type family In-Reply-To: <051.1263d9a5acf3e7421486ab720a352305@haskell.org> References: <051.1263d9a5acf3e7421486ab720a352305@haskell.org> Message-ID: <066.ef1dd9aef13162502630028662811b51@haskell.org> #14110: GHC Panic on over-saturated associated type family -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: Iceland_jack Type: bug | Status: closed Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: | polykinds/T14110 Blocked By: | Blocking: Related Tickets: #13819 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * related: => #13819 Comment: This was triggered by #13819. It's definitely fixed in GHC 8.4, since it was fixed in commit c2417b87ff59c92fbfa8eceeff2a0d6152b11a47 (`Fix #13819 by refactoring TypeEqOrigin.uo_thing`). It happens to be fixed in GHC 8.2.2, too (see https://ghc.haskell.org/trac/ghc/ticket/13819#comment:16). -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 3 13:27:02 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 03 Oct 2017 13:27:02 -0000 Subject: [GHC] #14308: GHC panic with invalid expression In-Reply-To: <042.d6a55a0cfdfc4d972f163c729be99318@haskell.org> References: <042.d6a55a0cfdfc4d972f163c729be99318@haskell.org> Message-ID: <057.da805369c36167cccdbd170418f9139c@haskell.org> #14308: GHC panic with invalid expression -------------------------------------+------------------------------------- Reporter: d6e | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: duplicate | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #13819 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * os: MacOS X => Unknown/Multiple -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 3 13:35:55 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 03 Oct 2017 13:35:55 -0000 Subject: [GHC] #14307: NamedFieldPuns should allow "ambiguous" field names In-Reply-To: <046.4bb60103aff0450ac9d1c7696050c9a0@haskell.org> References: <046.4bb60103aff0450ac9d1c7696050c9a0@haskell.org> Message-ID: <061.f690a59f1a13322a87e59c9fdb16df7e@haskell.org> #14307: NamedFieldPuns should allow "ambiguous" field names -------------------------------------+------------------------------------- Reporter: mgsloan | Owner: (none) Type: feature request | Status: new Priority: low | 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 simonpj): > This seems like poor behavior, because since a particular constructor is used, it is unambiguous which field is intended. Yes, but you need `-XDisambiguateRecordFields` for that ([http://downloads.haskell.org/~ghc/master/users-guide/glasgow_exts.html #record-field-disambiguation user manual entry]). Haskell 2010 specifies that the code is should be rejected. So I think GHC is behaving right here. Incidentally, `-XDisambiguateRecordFields` is also implied by `-XDuplicateRecordFields`. > I actually encountered this issue in a bit of a different usecase. Yes, here's the code {{{ {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE NamedFieldPuns #-} module T14307 where data A = A { field :: Int } data B = B { field :: Int } f (C { field }) = field }}} You get two errors with 8.2 {{{ T14307.hs:10:4: error: Not in scope: data constructor ‘C’ | 10 | f (C { field }) = field | ^ T14307.hs:10:8: error: Ambiguous occurrence ‘field’ It could refer to either the field ‘field’, defined at T14307.hs:7:14 or the field ‘field’, defined at T14307.hs:6:14 | 10 | f (C { field }) = field | ^^^^^ }}} I think your point is that you'd like the second to be suppressed. I see the point. Are you also ok with getting just one error message from {{{ f (A { fld = x }) = ... }}} namely `'A' is not in scope`; but no `fld is not in scope`? That is: if the data constructor is not in scope, suppress out-of-scope or ambiguity messages for the fields. I think that'd be fine. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 3 13:45:22 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 03 Oct 2017 13:45:22 -0000 Subject: [GHC] #13943: Compiler infinite loop with GHC-8.2 In-Reply-To: <048.054af5c39346b78fae836436fb73b68c@haskell.org> References: <048.054af5c39346b78fae836436fb73b68c@haskell.org> Message-ID: <063.7cb9050a49a07466789e750b8a6a5d50@haskell.org> #13943: Compiler infinite loop with GHC-8.2 -------------------------------------+------------------------------------- Reporter: vagarenko | Owner: dfeuer Type: bug | Status: new Priority: high | Milestone: 8.2.3 Component: Compiler | Version: 8.2.1-rc3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #12791 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Simon Peyton Jones ): In [changeset:"a8fde1831f4b99885b8ed444f9cd7dffd9252150/ghc" a8fde18/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="a8fde1831f4b99885b8ed444f9cd7dffd9252150" Fix bug in the short-cut solver Trac #13943 showed that the relatively-new short-cut solver for class constraints (aka -fsolve-constant-dicts) was wrong. In particular, see "Type families" under Note [Shortcut solving] in TcInteract. The short-cut solver recursively solves sub-goals, but it doesn't flatten type-family applications, and as a result it erroneously thought that C (F a) cannot possibly match (C 0), which is simply untrue. That led to an inifinte loop in the short-cut solver. The significant change is the one line + , all isTyFamFree preds -- See "Type families" in + -- Note [Shortcut solving] but, as ever, I do some other refactoring. (E.g. I changed the name of the function to shortCutSolver rather than the more generic trySolveFromInstance.) I also made the short-cut solver respect the solver-depth limit, so that if this happens again it won't just produce an infinite loop. A bit of other refactoring, notably moving isTyFamFree from TcValidity to TcType }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 3 13:45:22 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 03 Oct 2017 13:45:22 -0000 Subject: [GHC] #14307: NamedFieldPuns should allow "ambiguous" field names In-Reply-To: <046.4bb60103aff0450ac9d1c7696050c9a0@haskell.org> References: <046.4bb60103aff0450ac9d1c7696050c9a0@haskell.org> Message-ID: <061.ca128d716ad0915520430ef74631c414@haskell.org> #14307: NamedFieldPuns should allow "ambiguous" field names -------------------------------------+------------------------------------- Reporter: mgsloan | Owner: (none) Type: feature request | Status: new Priority: low | 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 Simon Peyton Jones ): In [changeset:"cb767542307b41c91061e743a4a4f448949b34cf/ghc" cb767542/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="cb767542307b41c91061e743a4a4f448949b34cf" Suppress error cascade in record fields When a record contruction or pattern uses a data constructor that isn't in scope, we may produce spurious ambiguous-field errors (Trac #14307). E.g. f (A { fld = x }) = e where 'A' is not in scope. We want to draw attention to the out-of-scope data constructor first; once that is fixed we can think about the fields. This patch suppresses the field errors if the data con is out of scope. }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 3 13:45:22 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 03 Oct 2017 13:45:22 -0000 Subject: [GHC] #14285: Entered absent arg - triggered by INLINEABLE, regression from 8.0.2 In-Reply-To: <049.09fbd6d1ad4f0a97bcd76579dd68ae8a@haskell.org> References: <049.09fbd6d1ad4f0a97bcd76579dd68ae8a@haskell.org> Message-ID: <064.b9ff6638ff9c86747000a0aee3cee4ce@haskell.org> #14285: Entered absent arg - triggered by INLINEABLE, regression from 8.0.2 ---------------------------------+-------------------------------------- Reporter: j.waldmann | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 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: | ---------------------------------+-------------------------------------- Comment (by Simon Peyton Jones ): In [changeset:"dbbee1bacef1a8accc630908c31cf267a3cb98a9/ghc" dbbee1ba/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="dbbee1bacef1a8accc630908c31cf267a3cb98a9" Fix nasty bug in w/w for absence analysis This dark corner was exposed by Trac #14285. It involves the interaction between absence analysis and INLINABLE pragmas. There is a full explanation in Note [aBSENT_ERROR_ID] in MkCore, which you can read there. The changes in this patch are * Make exprIsHNF return True for absentError, treating absentError like an honorary data constructor. * Make absentError /not/ be diverging, unlike other error Ids. This is all a bit horrible. * While doing this I found that exprOkForSpeculation didn't have a case for value lambdas so I added one. It's not really called on lifted types much, but it seems like the right thing }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 3 13:48:57 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 03 Oct 2017 13:48:57 -0000 Subject: [GHC] #13943: Compiler infinite loop with GHC-8.2 In-Reply-To: <048.054af5c39346b78fae836436fb73b68c@haskell.org> References: <048.054af5c39346b78fae836436fb73b68c@haskell.org> Message-ID: <063.be34137b02c4f6f473fc1ac421e8f69a@haskell.org> #13943: Compiler infinite loop with GHC-8.2 -------------------------------------+------------------------------------- Reporter: vagarenko | Owner: dfeuer Type: bug | Status: closed Priority: high | Milestone: 8.2.3 Component: Compiler | Version: 8.2.1-rc3 Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: | typecheck/should_compile/T13943 Blocked By: | Blocking: Related Tickets: #12791 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * status: new => closed * testcase: => typecheck/should_compile/T13943 * resolution: => fixed Comment: > I think it's basically wrong for the specializer to select a top-level instance that might be overlapped by one that's given Yes; and it doesn't, in fact. There was just an outright bug, as in the commit message above. Simon -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 3 13:49:25 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 03 Oct 2017 13:49:25 -0000 Subject: [GHC] #13943: Compiler infinite loop with GHC-8.2 In-Reply-To: <048.054af5c39346b78fae836436fb73b68c@haskell.org> References: <048.054af5c39346b78fae836436fb73b68c@haskell.org> Message-ID: <063.253c5ff42b956f546da7972824c97ace@haskell.org> #13943: Compiler infinite loop with GHC-8.2 -------------------------------------+------------------------------------- Reporter: vagarenko | Owner: dfeuer Type: bug | Status: merge Priority: high | Milestone: 8.2.3 Component: Compiler | Version: 8.2.1-rc3 Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: | typecheck/should_compile/T13943 Blocked By: | Blocking: Related Tickets: #12791 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * status: closed => merge Comment: I think it'd be fine to merge this to any future 8.2 version. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 3 13:50:17 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 03 Oct 2017 13:50:17 -0000 Subject: [GHC] #14307: NamedFieldPuns should allow "ambiguous" field names In-Reply-To: <046.4bb60103aff0450ac9d1c7696050c9a0@haskell.org> References: <046.4bb60103aff0450ac9d1c7696050c9a0@haskell.org> Message-ID: <061.d22bff718fdf4cf0c90d0814644d953b@haskell.org> #14307: NamedFieldPuns should allow "ambiguous" field names -------------------------------------+------------------------------------- Reporter: mgsloan | Owner: (none) Type: feature request | Status: closed Priority: low | Milestone: Component: Compiler | Version: 8.2.1 Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: | rename/should_fail/T14307 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * status: new => closed * testcase: => rename/should_fail/T14307 * resolution: => fixed Comment: OK I've done that. We can revert if we decide we want both errors after all. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 3 13:51:36 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 03 Oct 2017 13:51:36 -0000 Subject: [GHC] #14285: Entered absent arg - triggered by INLINEABLE, regression from 8.0.2 In-Reply-To: <049.09fbd6d1ad4f0a97bcd76579dd68ae8a@haskell.org> References: <049.09fbd6d1ad4f0a97bcd76579dd68ae8a@haskell.org> Message-ID: <064.92cbfef5eab04f2adb64b931d18a4b88@haskell.org> #14285: Entered absent arg - triggered by INLINEABLE, regression from 8.0.2 -------------------------------------+------------------------------------- Reporter: j.waldmann | Owner: (none) Type: bug | Status: merge Priority: normal | Milestone: 8.2.2 Component: Compiler | Version: 8.2.1 Resolution: | Keywords: Operating System: Linux | Architecture: x86_64 | (amd64) Type of failure: None/Unknown | Test Case: | stranal/should_run/T14285 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * status: new => merge * testcase: => stranal/should_run/T14285 * milestone: => 8.2.2 Comment: I can't say I'm proud of this fix, but it certainly fixes it. Which is important. Could merge to future 8.2 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 3 13:53:03 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 03 Oct 2017 13:53:03 -0000 Subject: [GHC] #9725: Constraint deduction failure In-Reply-To: <048.ce87721a06dc31147070f2a0751cf107@haskell.org> References: <048.ce87721a06dc31147070f2a0751cf107@haskell.org> Message-ID: <063.c038fdc2700435cbea6e44fd06acb5ab@haskell.org> #9725: Constraint deduction failure -------------------------------------+------------------------------------- Reporter: heisenbug | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 7.8.3 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 RyanGlScott): I'm arriving at this bug quite late, but it appears that https://ghc.haskell.org/trac/ghc/attachment/ticket/9725/9725.hs works on GHC 8.0.1 and later without a hitch. Perhaps it's time to consider this bug fixed? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 3 14:03:45 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 03 Oct 2017 14:03:45 -0000 Subject: [GHC] #14266: AllowAmbiguousTypes doesn't play well with default class methods In-Reply-To: <051.38c1a194c842b23e120b2589c2db8665@haskell.org> References: <051.38c1a194c842b23e120b2589c2db8665@haskell.org> Message-ID: <066.53435487ff01d6efd6bead35a2087936@haskell.org> #14266: AllowAmbiguousTypes doesn't play well with default class methods -------------------------------------+------------------------------------- Reporter: chris-martin | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.0.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): Here's my problem. Consider {{{ class A t where f :: forall x m. Monoid x => t m -> m instance A [] where f :: forall m x. Semigroup x => [m] -> m f = blah }}} (Reminder: `SemiGroup` is a superclass of `Monoid`.) Assume that `blah` really only uses `SemiGroup`. So in this instance declaration the definition of `f`, and its type signature, are strictly more general than the ones required. Just for fun I put the type arguments in a different order. So this should typecheck. But there is some real impedance matching to do. If I write it out with explicit type and dictionary applications it might be like this {{{ inst_f :: forall m x. Semigroup x => [m] -> m inst_f = /\ m x. \(ds:SemiGroup x). blah instance A [] where f = /\ x m. \(dm:Monoid x). inst_f @m @x (sc_select dm) }}} Here `inst_f` is the function as declared by the user in the instance decl. The code in the instance decl itself I have to swizzle the type arguments, and do a superclass selection on the dictionary argument before calling `inst_f`. So there is work to do! GHC has to work out how to get a `[W] SemiGroup x0` from a `[G] Monoid x`, where `x0` is unification variable. A good guess is to set `x0 := x` but GHC's solver doesn't guess. Do you see the problem? But the programmer says "I wasn't doing any of this more-general-type nonsense. I wrote down precisely the instantiated type so it's ''obvious'' how to match things up". And that seems like a reasonable observation. I suppose that we could say that when the instantiated method type ''precisely matches'' the user-specified signature, then we just match things up in the obvious way. That seems like a very ''ad hoc'' hack. But I can't see any other way. Any other ideas? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 3 14:07:17 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 03 Oct 2017 14:07:17 -0000 Subject: [GHC] #9725: Constraint deduction failure In-Reply-To: <048.ce87721a06dc31147070f2a0751cf107@haskell.org> References: <048.ce87721a06dc31147070f2a0751cf107@haskell.org> Message-ID: <063.2a7ce381329206d415aa51adf64c1712@haskell.org> #9725: Constraint deduction failure -------------------------------------+------------------------------------- Reporter: heisenbug | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 7.8.3 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 simonpj): The comment stream suggests that it should work when we get kind equalities, which we now have. So yes, let's add a test and declare victory! Make sure Lint is happy. Simon -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 3 14:07:18 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 03 Oct 2017 14:07:18 -0000 Subject: [GHC] #13203: Implement Bits Natural clearBit In-Reply-To: <044.036af31a947c4008bf1dfa61730885bd@haskell.org> References: <044.036af31a947c4008bf1dfa61730885bd@haskell.org> Message-ID: <059.cb7eec52ef7b5d3ef1cca52dd09219ec@haskell.org> #13203: Implement Bits Natural clearBit -------------------------------------+------------------------------------- Reporter: dylex | Owner: supersven Type: bug | Status: new Priority: lowest | Milestone: Component: libraries/base | Version: 8.0.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 supersven): Hey, I did a small experiment to check that GHC.Natural behaves as expected. How to reproduce (that `clearBit` doesn't work): {{{ [nix-shell:~/src/ghc]$ inplace/bin/ghc-stage2 --interactive GHCi, version 8.3.20170930: http://www.haskell.org/ghc/ :? for help Prelude> import GHC.Natural Prelude GHC.Natural> import Data.Bits Prelude GHC.Natural Data.Bits> clearBit (naturalFromInteger 1) 0 *** Exception: Bits.complement: Natural complement undefined }}} `setBit` and `complementBit` work as expected: {{{ Prelude GHC.Natural Data.Bits> setBit (naturalFromInteger 0) 0 1 Prelude GHC.Natural Data.Bits> setBit (naturalFromInteger 1) 0 1 Prelude GHC.Natural Data.Bits> complementBit (naturalFromInteger 0) 0 1 Prelude GHC.Natural Data.Bits> complementBit (naturalFromInteger 1) 0 0 }}} == Plan == - Implement `clearBit` as proposed by vlopez. - Remove the todo. - Add test. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 3 14:12:40 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 03 Oct 2017 14:12:40 -0000 Subject: [GHC] #9725: Constraint deduction failure In-Reply-To: <048.ce87721a06dc31147070f2a0751cf107@haskell.org> References: <048.ce87721a06dc31147070f2a0751cf107@haskell.org> Message-ID: <063.fbb4cc24c4ca53493a878b581b9b3478@haskell.org> #9725: Constraint deduction failure -------------------------------------+------------------------------------- Reporter: heisenbug | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 7.8.3 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 Ryan Scott ): In [changeset:"a02039c7dcb4300b0aca80a994466a8f3039a3fc/ghc" a02039c/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="a02039c7dcb4300b0aca80a994466a8f3039a3fc" Add regression test for #9725 Kind equalities saves the day! }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 3 14:13:39 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 03 Oct 2017 14:13:39 -0000 Subject: [GHC] #9725: Constraint deduction failure In-Reply-To: <048.ce87721a06dc31147070f2a0751cf107@haskell.org> References: <048.ce87721a06dc31147070f2a0751cf107@haskell.org> Message-ID: <063.be2c2cc57cda4ae0ea9d2566e473b659@haskell.org> #9725: Constraint deduction failure -------------------------------------+------------------------------------- Reporter: heisenbug | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: Component: Compiler (Type | Version: 7.8.3 checker) | Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: GHC rejects | Test Case: valid program | polykinds/T9725 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * status: new => closed * testcase: => polykinds/T9725 * resolution: => fixed -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 3 14:18:53 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 03 Oct 2017 14:18:53 -0000 Subject: [GHC] #14266: AllowAmbiguousTypes doesn't play well with default class methods In-Reply-To: <051.38c1a194c842b23e120b2589c2db8665@haskell.org> References: <051.38c1a194c842b23e120b2589c2db8665@haskell.org> Message-ID: <066.ac7f7301358c1a2929453ed61fba1673@haskell.org> #14266: AllowAmbiguousTypes doesn't play well with default class methods -------------------------------------+------------------------------------- Reporter: chris-martin | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.0.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): I'm a bit lost here. Your "reduced" example seems to be asking a lot more out of GHC than what the original example demands! That is, the original example is simply: {{{#!hs class A t where f :: forall x m. Monoid x => t m -> m instance A [] where f :: forall x m. Monoid x => [m] -> m f = blah }}} No superclass relationships. No argument swizzling. I'd be content with just this, since that's all that `DefaultSignatures` needs! Does that make the problem easier? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 3 14:34:28 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 03 Oct 2017 14:34:28 -0000 Subject: [GHC] #14308: GHC panic with invalid expression In-Reply-To: <042.d6a55a0cfdfc4d972f163c729be99318@haskell.org> References: <042.d6a55a0cfdfc4d972f163c729be99318@haskell.org> Message-ID: <057.52aafffa586bce966d1a0e5b5a0d1aee@haskell.org> #14308: GHC panic with invalid expression -------------------------------------+------------------------------------- Reporter: d6e | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: 8.2.2 Component: Compiler | Version: 8.2.1 Resolution: duplicate | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #13819 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * milestone: => 8.2.2 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 3 14:36:17 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 03 Oct 2017 14:36:17 -0000 Subject: [GHC] #13819: TypeApplications-related GHC panic In-Reply-To: <051.cbfd374163652d5209657cd86d4948f0@haskell.org> References: <051.cbfd374163652d5209657cd86d4948f0@haskell.org> Message-ID: <066.03e3c9d9b700129ffeddd6a8e5c983c6@haskell.org> #13819: TypeApplications-related GHC panic -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: goldfire Type: bug | Status: closed Priority: high | Milestone: 8.4.1 Component: Compiler (Type | Version: 8.2.1-rc2 checker) | Keywords: Resolution: fixed | TypeApplications Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Compile-time | Test Case: crash or panic | typecheck/should_fail/T13819 Blocked By: | Blocking: Related Tickets: #13846, #13850 | Differential Rev(s): Phab:D3754 Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: merge => closed * resolution: => fixed Comment: Indeed I think it's out of the running for 8.2.2 and, given its size, perhaps out of scope for 8.2 on the whole. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 3 14:47:11 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 03 Oct 2017 14:47:11 -0000 Subject: [GHC] #14298: Let Template Haskell dynamically add something with which to link In-Reply-To: <050.5b84ef44d6dba8c28fe71b17d035f8a7@haskell.org> References: <050.5b84ef44d6dba8c28fe71b17d035f8a7@haskell.org> Message-ID: <065.fc01831f84fbb0ae893464d2fb9a4b28@haskell.org> #14298: Let Template Haskell dynamically add something with which to link -------------------------------------+------------------------------------- Reporter: harpocrates | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Template Haskell | 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 bgamari): > That said, my understanding of `-c` is that it shouldn't work on any module that uses TH from another module. That isn't quite true. TH will work perfectly well in single-shot mode. However, as usual, the user must guarantee that any needed modules are compiled for whatever way GHC will want to load to evaluate splices. For instance, {{{ $ pwd /opt/exp/ghc/ghc-landing/testsuite/tests/th $ ghc -c TH_NestedSplices_Lib.hs -dynamic-too -fforce-recomp $ ghc -c TH_NestedSplices.hs -fforce-recomp }}} It's important that this behavior be preserved since Cabal is slowly moving towards using single-shot mode to improve module-level build parallelism. > About the API, I would prefer: > {{{ > addForeignObject :: ByteString -> Q () > }}} The interface in comment:6 sounds plausible. The worry that I have with just allowing the user to specify an object file path as in the original proposal is that it makes it seem as though they can safely `addForeignObject` the same object file from multiple modules. However, this is not safe as they will encounter conflicting symbol errors when they attempt to link the final object. Of course, we could in principle document our way out of this issue. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 3 14:55:20 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 03 Oct 2017 14:55:20 -0000 Subject: [GHC] #14279: Type families interfere with specialisation rewrite rules In-Reply-To: <051.c770f0db94d1fbd7b1e66a5d39f244a4@haskell.org> References: <051.c770f0db94d1fbd7b1e66a5d39f244a4@haskell.org> Message-ID: <066.83af456e005d82e3aa02f5fe8220e0cc@haskell.org> #14279: Type families interfere with specialisation rewrite rules -------------------------------------+------------------------------------- Reporter: IvanTimokhin | 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: Other | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Your analysis is right. We have something like {{{ test = replace @ 'Z @ '[Int] @ '[Int] @ Int (Test.$WLZ `cast` ((Length (Sym (Test.D:R:Remove[0] _N <'[]>_N)))_R :: (Length '[] :: *) ~R# (Length (Remove 'Z '[Int]) :: *))) (Test.$WLS @ '[] @ Int Test.$WLZ) (Test.$WIZ @ Int @ '[]) (Test.$WVInL @ Int @ '[]) (Test.$WVInL @ Int @ '[] (GHC.Types.I# 2#))) }}} where the RHS of `replace` has various occurrences of `Remove n as`. If we inline `replace` for this call site, those occurrences become `Remove 'Z '[Int]`, which you'd like to see reduced to `'[]`. But the rule matcher does not match modulo function reduction. Perhaps it should. But it't not clear to me how. Suppose we have an axiom {{{ ax :: F Int ~ Bool }}} and we have a call {{{ ...(f @(Maybe (F Int)) e1 e2)... }}} Perhaps, before (or somehow during) the matching of a rule for `f`, we should transform to {{{ ...(f @(Maybe Bool) e1 e2)... }}} But that isn't well typed; we'd need to do some `liftCoSubst` kind of thing. Suppose {{{ f :: forall a. ty and co :: s1 ~ s2 -- s2 is a normalised version of s1 }}} Then perhaps we can rewrite {{{ f @s1 ===> f @s2 |> ty[sym co/a] }}} Perhaps something like this (maybe a bit more; e.g. on binder types) can replace the handful of uses of `topNormaliseType_maybe` in the simplifier. Or, more generally, perhaps we can do this normalisation in `simplType`. It would make sense for the simplifier to aggressively normalise types, as inlining happens, just as it normalises terms. Why do fundeps work? I think it's because the function appliation does not appear nested inside `replace`, but rather is passed as an argument to `replace`, and hence can be normalised in the caller. I wonder if other people have tripped over this lack of normalisation in types in the simplifier? I don't think this would be hard to try out. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 3 14:57:30 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 03 Oct 2017 14:57:30 -0000 Subject: [GHC] #14266: AllowAmbiguousTypes doesn't play well with default class methods In-Reply-To: <051.38c1a194c842b23e120b2589c2db8665@haskell.org> References: <051.38c1a194c842b23e120b2589c2db8665@haskell.org> Message-ID: <066.fefef97c2a7e4435e140c33564cf4384@haskell.org> #14266: AllowAmbiguousTypes doesn't play well with default class methods -------------------------------------+------------------------------------- Reporter: chris-martin | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.0.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'd be content with just this, That's what I was suggesting when I said "I suppose that we could say that when the instantiated method type precisely matches the user-specified signature, then we just match things up in the obvious way." But GHC currently does the more general thing which, I bet, someone someday will report as a bug if we insist on a precise match. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 3 15:01:12 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 03 Oct 2017 15:01:12 -0000 Subject: [GHC] #14266: AllowAmbiguousTypes doesn't play well with default class methods In-Reply-To: <051.38c1a194c842b23e120b2589c2db8665@haskell.org> References: <051.38c1a194c842b23e120b2589c2db8665@haskell.org> Message-ID: <066.2343872cddd23186f2df0c758ddb2f9a@haskell.org> #14266: AllowAmbiguousTypes doesn't play well with default class methods -------------------------------------+------------------------------------- Reporter: chris-martin | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.0.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): I'm incredibly confused. We seem to be talking about two different issues here: * The fact that `InstanceSigs`' "more-general-than" check gets confused when `AllowAmbiguousTypes` comes into play. That is indeed a perplexing issue, and I can't offer a suggestion on how to fix it. But it's a distraction, since I was only using `InstanceSigs` to motivate the original issue, which is... * `DefaultSignatures` gets confused when interacting with `AllowAmbiguousTypes`. We needn't bother with any sort of "more-general- than" check here, because `DefaultSignatures` emits code that doesn't use any instance signatures, right? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 3 15:03:59 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 03 Oct 2017 15:03:59 -0000 Subject: [GHC] #14266: AllowAmbiguousTypes doesn't play well with default class methods In-Reply-To: <051.38c1a194c842b23e120b2589c2db8665@haskell.org> References: <051.38c1a194c842b23e120b2589c2db8665@haskell.org> Message-ID: <066.ffabea5d79f34333a5f07bd86f7bb3d5@haskell.org> #14266: AllowAmbiguousTypes doesn't play well with default class methods -------------------------------------+------------------------------------- Reporter: chris-martin | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.0.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): Its nothing to do with `AllowAmbiguousTypes`, except that the latter is needed to allow you to write the signature at all. What I wrote all happens after the signature is accepted. > because DefaultSignatures emits code that doesn't use any instance signatures, right I don't understand that. Your example made essential use of instance signatures. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 3 15:04:13 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 03 Oct 2017 15:04:13 -0000 Subject: [GHC] #14300: FreeBSD 10.3 toolchain is terribly broken In-Reply-To: <046.2e6e216e2555895c84fcbcae84e4e04e@haskell.org> References: <046.2e6e216e2555895c84fcbcae84e4e04e@haskell.org> Message-ID: <061.0fcfd33ce501de2ce5635fbecd5d0c78@haskell.org> #14300: FreeBSD 10.3 toolchain is terribly broken ---------------------------------+---------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: fixed | Keywords: Operating System: FreeBSD | Architecture: Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #13974 | Differential Rev(s): Wiki Page: | ---------------------------------+---------------------------------------- Changes (by bgamari): * status: new => closed * resolution: => fixed Old description: > == `clang`, `ld.bfd` with `SplitSections=NO` > > Fails in the final bindist test with, > {{{ > /usr/bin/install -c -m 755 libraries/gen_contents_index "/usr/home/ben > /bin- > dist-8.2.1.20170929-FreeBSD/test/inst/share/doc/ghc-8.2.1.20170929/html/libraries/" > [1 of 1] Compiling Main ( /usr/home/ben/bin- > dist-8.2.1.20170929-FreeBSD/test/hi.hs, /usr/home/ben/bin- > dist-8.2.1.20170929-FreeBSD/test/hi.o ) > Linking /usr/home/ben/bin-dist-8.2.1.20170929-FreeBSD/test/hi ... > /usr/bin/ld: Base__199.o: access beyond end of merged section (-24) > /usr/bin/ld: Base__201.o: access beyond end of merged section (-24) > ... > }}} > > == `clang`, `ld.bfd` with `SplitSections=YES` > > fails with, > {{{ > bindisttest/"install dir"/bin/ghc --make bindisttest/HelloWorld > [1 of 1] Compiling Main ( bindisttest/HelloWorld.lhs, > bindisttest/HelloWorld.o ) > Linking bindisttest/HelloWorld ... > /usr/home/ben/bin-dist-8.2.1.20170929-FreeBSD/ghc/bindisttest/install > dir/lib/ghc-8.2.1.20170929/base-4.10.0.0/libHSbase-4.10.0.0.a(Base.o):base_ControlziExceptionziBase_absentError_info: > warning: relocation refers to discarded section > /usr/home/ben/bin-dist-8.2.1.20170929-FreeBSD/ghc/bindisttest/install > dir/lib/ghc-8.2.1.20170929/base-4.10.0.0/libHSbase-4.10.0.0.a(Base.o)(.text.r3zN_info+0x44): > warning: relocation refers to discarded section > /usr/home/ben/bin-dist-8.2.1.20170929-FreeBSD/ghc/bindisttest/install > dir/lib/ghc-8.2.1.20170929/base-4.10.0.0/libHSbase-4.10.0.0.a(Base.o)(.text.r3zP_info+0x44): > warning: relocation refers to discarded section > /usr/home/ben/bin-dist-8.2.1.20170929-FreeBSD/ghc/bindisttest/install > dir/lib/ghc-8.2.1.20170929/base-4.10.0.0/libHSbase-4.10.0.0.a(Base.o)(.text.r3zR_info+0x44): > warning: relocation refers to discarded section > ... > }}} > > == `clang`, `ld.gold`, `SplitSections=NO` > > {{{ > ... > }}} New description: == `clang`, `ld.bfd` with `SplitSections=NO` Fails in the final bindist test with, {{{ /usr/bin/install -c -m 755 libraries/gen_contents_index "/usr/home/ben /bin- dist-8.2.1.20170929-FreeBSD/test/inst/share/doc/ghc-8.2.1.20170929/html/libraries/" [1 of 1] Compiling Main ( /usr/home/ben/bin- dist-8.2.1.20170929-FreeBSD/test/hi.hs, /usr/home/ben/bin- dist-8.2.1.20170929-FreeBSD/test/hi.o ) Linking /usr/home/ben/bin-dist-8.2.1.20170929-FreeBSD/test/hi ... /usr/bin/ld: Base__199.o: access beyond end of merged section (-24) /usr/bin/ld: Base__201.o: access beyond end of merged section (-24) ... }}} == `clang`, `ld.bfd` with `SplitSections=YES` fails with, {{{ bindisttest/"install dir"/bin/ghc --make bindisttest/HelloWorld [1 of 1] Compiling Main ( bindisttest/HelloWorld.lhs, bindisttest/HelloWorld.o ) Linking bindisttest/HelloWorld ... /usr/home/ben/bin-dist-8.2.1.20170929-FreeBSD/ghc/bindisttest/install dir/lib/ghc-8.2.1.20170929/base-4.10.0.0/libHSbase-4.10.0.0.a(Base.o):base_ControlziExceptionziBase_absentError_info: warning: relocation refers to discarded section /usr/home/ben/bin-dist-8.2.1.20170929-FreeBSD/ghc/bindisttest/install dir/lib/ghc-8.2.1.20170929/base-4.10.0.0/libHSbase-4.10.0.0.a(Base.o)(.text.r3zN_info+0x44): warning: relocation refers to discarded section /usr/home/ben/bin-dist-8.2.1.20170929-FreeBSD/ghc/bindisttest/install dir/lib/ghc-8.2.1.20170929/base-4.10.0.0/libHSbase-4.10.0.0.a(Base.o)(.text.r3zP_info+0x44): warning: relocation refers to discarded section /usr/home/ben/bin-dist-8.2.1.20170929-FreeBSD/ghc/bindisttest/install dir/lib/ghc-8.2.1.20170929/base-4.10.0.0/libHSbase-4.10.0.0.a(Base.o)(.text.r3zR_info+0x44): warning: relocation refers to discarded section ... }}} == `clang`, `ld.gold`, `SplitSections=NO` {{{ ... }}} == `gcc`, `ld.gold`, `SplitSections=NO` {{{ /usr/local/bin/ld.gold: fatal error: cannot mix -r with dynamic object /usr/lib/libthr.so collect2: error: ld returned 1 exit status `gcc' failed in phase `Linker'. (Exit code: 1) gmake[1]: *** [iserv/ghc.mk:93: iserv/stage2_p/build/GHCi/Utils.p_o] Error 1 }}} -- Comment: Indeed `gcc5` and `ld.gold` with `SplitSections=NO` appears to work. I didn't try `SplitSections=YES`. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 3 15:11:10 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 03 Oct 2017 15:11:10 -0000 Subject: [GHC] #14266: AllowAmbiguousTypes doesn't play well with default class methods In-Reply-To: <051.38c1a194c842b23e120b2589c2db8665@haskell.org> References: <051.38c1a194c842b23e120b2589c2db8665@haskell.org> Message-ID: <066.ff81c3d5711abbb1037746d64fcdf1ff@haskell.org> #14266: AllowAmbiguousTypes doesn't play well with default class methods -------------------------------------+------------------------------------- Reporter: chris-martin | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.0.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): I thoroughly regret ever mentioning `InstanceSigs`, because that has nothing to do with the underlying issue here, and it has completely derailed the discussion. Here is the code that should compile, but doesn't (from comment:2): {{{#!hs {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE ExplicitForAll #-} {-# LANGUAGE TypeApplications #-} class A t where f :: forall x m. Monoid x => t m -> m instance A [] where f = df @[] df :: forall t. A t => forall x m. Monoid x => t m -> m df = undefined }}} This is precisely what gets emitted with `DefaultSignatures` (module naming). No `InstanceSigs` to be found. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 3 15:11:56 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 03 Oct 2017 15:11:56 -0000 Subject: [GHC] #14298: Let Template Haskell dynamically add something with which to link In-Reply-To: <050.5b84ef44d6dba8c28fe71b17d035f8a7@haskell.org> References: <050.5b84ef44d6dba8c28fe71b17d035f8a7@haskell.org> Message-ID: <065.e5bfa28b20562319adacd010ac972b96@haskell.org> #14298: Let Template Haskell dynamically add something with which to link -------------------------------------+------------------------------------- Reporter: harpocrates | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Template Haskell | 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 harpocrates): I really appreciate all of the detailed explanations! Thanks! > `addForeignObject :: ByteString -> Q ()` Seems like this would solve most of the problems brought up, and I prefer it too. It's worth noting that `bytestring` isn't currently a dependency of `template-haskell` though. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 3 15:25:46 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 03 Oct 2017 15:25:46 -0000 Subject: [GHC] #14300: FreeBSD 10.3 toolchain is terribly broken In-Reply-To: <046.2e6e216e2555895c84fcbcae84e4e04e@haskell.org> References: <046.2e6e216e2555895c84fcbcae84e4e04e@haskell.org> Message-ID: <061.0a7a3a4f3cec148db985ce15a77d58d3@haskell.org> #14300: FreeBSD 10.3 toolchain is terribly broken ---------------------------------+---------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: fixed | Keywords: Operating System: FreeBSD | Architecture: Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #13974 | Differential Rev(s): Wiki Page: | ---------------------------------+---------------------------------------- Comment (by pgj): FreeBSD has a very old {{{ld}}} (2.17.50) in the base system (as {{{/usr/bin/ld}}}) due to licensing issues. Newer versions of {{{gcc}}} and {{{ld}}} come in GPLv3 flavor, that is what the developers aim to avoid as much as possible. That is why the README indeed recommends to install the {{{lang/gcc}}} port that will give you GCC 5.4 nowadays and it will also pull the {{{devel/binutils}}} port in, that ships GNU {{{ld}}} 2.28 (as {{{/usr/local/bin/ld}}}). -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 3 15:42:25 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 03 Oct 2017 15:42:25 -0000 Subject: [GHC] #14307: NamedFieldPuns should allow "ambiguous" field names In-Reply-To: <046.4bb60103aff0450ac9d1c7696050c9a0@haskell.org> References: <046.4bb60103aff0450ac9d1c7696050c9a0@haskell.org> Message-ID: <061.c1da2607fc501ed1ef0f6a496cc523f4@haskell.org> #14307: NamedFieldPuns should allow "ambiguous" field names -------------------------------------+------------------------------------- Reporter: mgsloan | Owner: (none) Type: feature request | Status: closed Priority: low | Milestone: Component: Compiler | Version: 8.2.1 Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: | rename/should_fail/T14307 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by mgsloan): Great, thanks for the quick fix Simon! > Yes, but you need -XDisambiguateRecordFields for that (​user manual entry). Haskell 2010 specifies that the code is should be rejected. So I think GHC is behaving right here. Interesting, I didn't know about that one, cool! Glad there's a way around that one. Perhaps the error message could mention the extension since it's a rarer one? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 3 15:52:12 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 03 Oct 2017 15:52:12 -0000 Subject: [GHC] #14309: Expand comment in hPutStrLn Message-ID: <045.d57739ec737fed854d627d9f1df20af7@haskell.org> #14309: Expand comment in hPutStrLn -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: (none) Type: task | Status: new Priority: normal | Milestone: 8.4.1 Component: Core | Version: 8.2.1 Libraries | Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: Documentation Unknown/Multiple | bug Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- A comment on `hPutStrLn` reads > An optimisation: we treat `hPutStrLn` specially, to avoid the > overhead of a single `putChar '\n'`, which is quite high now that we > have to encode eagerly. This should reference some code or comment that explains why the cost is high, why we have to encode eagerly, what it even ''means'' to encode eagerly, etc. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 3 15:52:18 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 03 Oct 2017 15:52:18 -0000 Subject: [GHC] #14298: Let Template Haskell dynamically add something with which to link In-Reply-To: <050.5b84ef44d6dba8c28fe71b17d035f8a7@haskell.org> References: <050.5b84ef44d6dba8c28fe71b17d035f8a7@haskell.org> Message-ID: <065.44f733a868dd8cd1218dd84f649688b1@haskell.org> #14298: Let Template Haskell dynamically add something with which to link -------------------------------------+------------------------------------- Reporter: harpocrates | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Template Haskell | 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 hsyl20): > It's worth noting that `bytestring` isn't currently a dependency of template-haskell though. Then maybe we should avoid `bytestring` with something like: {{{#!hs addForeignObjectFromMem :: Word -> Ptr () -> Q () }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 3 16:53:02 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 03 Oct 2017 16:53:02 -0000 Subject: [GHC] #14310: Assertion triggered by STM invariant. Message-ID: <042.9c3fac38bbd2247bedc1f2616e6e2820@haskell.org> #14310: Assertion triggered by STM invariant. --------------------------------------+---------------------------------- Reporter: mbw | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 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: --------------------------------------+---------------------------------- The program attached depends on the async and stm packages. It will push some numbers through a pipeline, while keeping track of some state. If invoked without arguments, the program will output the state and result of each iteration. If invoked via "./repro check", an STM invariant will be installed when the state is initialized. This invariant will cause the program to a) hangup, presumably due to a livelock, if the program has been compiled without "-debug", b) crash with the following error: "internal error: ASSERTION FAILED: file rts/RaiseAsync.c, line 1001", if the "-debug" flag has been used for compilation. The latter case also happens with GHC 8.0.2: "internal error: ASSERTION FAILED: file rts/RaiseAsync.c, line 997". Furthermore, this problem only occurs if the program is compiled using the additional flags "-rtsopts -threaded -with-rtsopts=-N". -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 3 16:58:34 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 03 Oct 2017 16:58:34 -0000 Subject: [GHC] #14310: Assertion triggered by STM invariant. In-Reply-To: <042.9c3fac38bbd2247bedc1f2616e6e2820@haskell.org> References: <042.9c3fac38bbd2247bedc1f2616e6e2820@haskell.org> Message-ID: <057.753aeaece1adb77350be78872a8389e9@haskell.org> #14310: Assertion triggered by STM invariant. ----------------------------------+-------------------------------------- Reporter: mbw | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 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): Wiki Page: | ----------------------------------+-------------------------------------- Changes (by mbw): * Attachment "Main.hs" added. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 3 17:50:14 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 03 Oct 2017 17:50:14 -0000 Subject: [GHC] #14311: PowerPC: Symbol already defined Message-ID: <047.517ec9911119ab317a73da8842dce7f3@haskell.org> #14311: PowerPC: Symbol already defined --------------------------------+---------------------------------------- Reporter: trommler | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.3 Keywords: | Operating System: Unknown/Multiple Architecture: powerpc | Type of failure: Building GHC failed Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: --------------------------------+---------------------------------------- Building HEAD I get the following error from the stage 1 compiler: {{{ /tmp/ghc9106_0/ghc_4.s:796:0: error: Error: symbol `.Lc2l' is already defined | 796 | .Lc2l: | ^ `gcc' failed in phase `Assembler'. (Exit code: 1) rts/ghc.mk:269: recipe for target 'rts/dist/build/Exception.o' failed }}} The relevant assembly code is: {{{ .section ".opd","aw" .align 3 .LcV: .quad ..LcV,.TOC. at tocbase,0 .previous .type .LcV, @function ..LcV: .LcV: ld 31, 8(22) }}} Note: The label has changed during recompile. This affects powerpc64 (ELF 1.9) and powerpc64le (ELF 2.0) on Linux and I suspect also AIX. This could be a fallout from: changeset:8b007abbeb3045900a11529d907a835080129176 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 3 18:38:00 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 03 Oct 2017 18:38:00 -0000 Subject: [GHC] #9725: Constraint deduction failure In-Reply-To: <048.ce87721a06dc31147070f2a0751cf107@haskell.org> References: <048.ce87721a06dc31147070f2a0751cf107@haskell.org> Message-ID: <063.0e2ff7e004d83b8cb3cbd93ca6a01a24@haskell.org> #9725: Constraint deduction failure -------------------------------------+------------------------------------- Reporter: heisenbug | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: Component: Compiler (Type | Version: 7.8.3 checker) | Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: GHC rejects | Test Case: valid program | polykinds/T9725 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by heisenbug): Thanks to everybody involved! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 3 18:38:24 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 03 Oct 2017 18:38:24 -0000 Subject: [GHC] #14312: Head does not build on Windows with the default make config. Message-ID: <047.086b87bb9b3dcf2f7a921149fa31eda2@haskell.org> #14312: Head does not build on Windows with the default make config. -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Build System | Version: 8.2.1 Keywords: | Operating System: Windows Architecture: | Type of failure: Building GHC Unknown/Multiple | failed Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- Cloning head and just running: {{{ ./boot ./configure --enable-tarballs-autodownload make }}} Fails since at least two weeks and still does as of a4ee28978acbcf68da9dfb6f198cb6e1ff38ccca The main issue is the directory library fails to build. Creating a build.mk file and setting the Flavour to quick GHC does build as expected. What triggers the failure seems to be the windows.h file created by the directory library which in some way includes itself in a loop until the preprocessor/c-compiler gives up. Renaming the file locally seems to be a viable workaround. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 3 18:39:35 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 03 Oct 2017 18:39:35 -0000 Subject: [GHC] #14312: Head does not build on Windows with the default make config. In-Reply-To: <047.086b87bb9b3dcf2f7a921149fa31eda2@haskell.org> References: <047.086b87bb9b3dcf2f7a921149fa31eda2@haskell.org> Message-ID: <062.7498f82bb9dffacd7efbebd287842091@haskell.org> #14312: Head does not build on Windows with the default make config. -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Build System | Version: 8.2.1 Resolution: | Keywords: Operating System: Windows | Architecture: Type of failure: Building GHC | Unknown/Multiple failed | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Description changed by AndreasK: Old description: > Cloning head and just running: > > {{{ > ./boot > ./configure --enable-tarballs-autodownload > make > }}} > > Fails since at least two weeks and still does as of > a4ee28978acbcf68da9dfb6f198cb6e1ff38ccca > > The main issue is the directory library fails to build. > > Creating a build.mk file and setting the Flavour to quick GHC does build > as expected. > > What triggers the failure seems to be the windows.h file created by the > directory library which in some way includes itself in a loop until the > preprocessor/c-compiler gives up. > > Renaming the file locally seems to be a viable workaround. New description: Cloning head and just running: {{{ ./boot ./configure --enable-tarballs-autodownload make }}} Fails since at least two weeks and still does as of a4ee28978acbcf68da9dfb6f198cb6e1ff38ccca The main issue is the directory library fails to build. Creating a build.mk file and setting the Flavour to quick GHC does build as expected. What triggers the failure seems to be the windows.h file created by the directory library which in some way includes itself in a loop until the preprocessor/c-compiler gives up. Renaming the file locally seems to be a viable workaround. I used https://github.com/Mistuke/GhcDevelChoco to set up a build environment and it happens on both my machines so doesn't seem to be a fluke. -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 3 19:20:29 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 03 Oct 2017 19:20:29 -0000 Subject: [GHC] #14310: Assertion triggered by STM invariant. In-Reply-To: <042.9c3fac38bbd2247bedc1f2616e6e2820@haskell.org> References: <042.9c3fac38bbd2247bedc1f2616e6e2820@haskell.org> Message-ID: <057.60dda4dae228d63a603384af0e319396@haskell.org> #14310: Assertion triggered by STM invariant. ----------------------------------+-------------------------------------- Reporter: mbw | Owner: (none) Type: bug | Status: new Priority: high | Milestone: 8.4.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): Wiki Page: | ----------------------------------+-------------------------------------- Changes (by bgamari): * priority: normal => high * milestone: => 8.4.1 Old description: > The program attached depends on the async and stm packages. It will push > some numbers through a pipeline, while keeping track of some state. > > If invoked without arguments, the program will output the state and > result of each iteration. If invoked via "./repro check", an STM > invariant will be installed when the state is initialized. This invariant > will cause the program to > > a) hangup, presumably due to a livelock, if the program has been compiled > without "-debug", > > > b) crash with the following error: > "internal error: ASSERTION FAILED: file rts/RaiseAsync.c, line 1001", > if the "-debug" flag has been used for compilation. > > The latter case also happens with GHC 8.0.2: "internal error: ASSERTION > FAILED: file rts/RaiseAsync.c, line 997". > > Furthermore, this problem only occurs if the program is compiled using > the additional flags "-rtsopts -threaded -with-rtsopts=-N". New description: The program attached depends on the async and stm packages. It will push some numbers through a pipeline, while keeping track of some state. If invoked without arguments, the program will output the state and result of each iteration. If invoked via `./repro check`, an STM invariant will be installed when the state is initialized. This invariant will cause the program to 1. hangup, presumably due to a livelock, if the program has been compiled without `-debug`, or 2. crash with the following error: {{{ internal error: ASSERTION FAILED: file rts/RaiseAsync.c, line 1001", }}} if the "-debug" flag has been used for compilation. The latter case also happens with GHC 8.0.2: {{{ internal error: ASSERTION FAILED: file rts/RaiseAsync.c, line 997 }}} Furthermore, this problem only occurs if the program is compiled using the additional flags `-rtsopts -threaded -with-rtsopts=-N`. -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 3 19:28:03 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 03 Oct 2017 19:28:03 -0000 Subject: [GHC] #13324: Allow PartialTypeSignatures in the instance context of a standalone deriving declaration In-Reply-To: <050.05d716a2c5be2cade611e1ab44e0e3c6@haskell.org> References: <050.05d716a2c5be2cade611e1ab44e0e3c6@haskell.org> Message-ID: <065.352485b0f16154291d561218355dd9e4@haskell.org> #13324: Allow PartialTypeSignatures in the instance context of a standalone deriving declaration -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.0.1 checker) | Resolution: | Keywords: deriving Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #10607 | 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 Oct 3 19:39:41 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 03 Oct 2017 19:39:41 -0000 Subject: [GHC] #14312: Head does not build on Windows with the default make config. In-Reply-To: <047.086b87bb9b3dcf2f7a921149fa31eda2@haskell.org> References: <047.086b87bb9b3dcf2f7a921149fa31eda2@haskell.org> Message-ID: <062.aaff057a54ebda33165cebf18fbc295b@haskell.org> #14312: Head does not build on Windows with the default make config. -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Build System | Version: 8.2.1 Resolution: | Keywords: Operating System: Windows | Architecture: Type of failure: Building GHC | Unknown/Multiple failed | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by AndreasK): Worth mentioning validate builds despite this. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 3 21:00:41 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 03 Oct 2017 21:00:41 -0000 Subject: [GHC] #14266: AllowAmbiguousTypes doesn't play well with default class methods In-Reply-To: <051.38c1a194c842b23e120b2589c2db8665@haskell.org> References: <051.38c1a194c842b23e120b2589c2db8665@haskell.org> Message-ID: <066.ea0c58e56b4ed502c2f3203b7aa5e0b1@haskell.org> #14266: AllowAmbiguousTypes doesn't play well with default class methods -------------------------------------+------------------------------------- Reporter: chris-martin | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.0.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): I've been only loosely following along. But comment:15 has a very clear "here is the code that should compile". And so I tried it. And it doesn't. But of course it doesn't, as `df` has no way of knowing that the `Monoid x` instance in scope in the instance definition for `f` is the one to use. To bring the type variable `x` into scope, it's necessary to use `InstanceSigs` so that you can write a type signature bringing `x` into scope. (By the way, if you use an expression type signature, the problem is no better.) What I argue should compile is this: {{{#!hs class A t where f :: forall x m. Monoid x => t m -> m instance A [] where f :: forall x m. Monoid x => [m] -> m f = df @[] @x df :: forall t. A t => forall x m. Monoid x => t m -> m df = undefined }}} But this, too, doesn't compile because of the "more-general-than" check in `InstanceSigs`, which can't be informed about what to do for `x`. While I don't see any technical complications with allowing the user to direct the "more-general-than" check, I can't think of any concrete syntax that isn't nightmarish. Perhaps we're simply barking up the wrong tree here, though. Suppose I could write {{{#!hs instance A [] where f @x = df @[] @x }}} where `f @x` is a visible type pattern. That would bring the right `x` into scope (no `InstanceSigs`!) And then the "more-general-than" comparison is not needed. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 3 21:05:01 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 03 Oct 2017 21:05:01 -0000 Subject: [GHC] #14279: Type families interfere with specialisation rewrite rules In-Reply-To: <051.c770f0db94d1fbd7b1e66a5d39f244a4@haskell.org> References: <051.c770f0db94d1fbd7b1e66a5d39f244a4@haskell.org> Message-ID: <066.7fe33ce0fb3dfd7557e1836b2e7de9f4@haskell.org> #14279: Type families interfere with specialisation rewrite rules -------------------------------------+------------------------------------- Reporter: IvanTimokhin | 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: Other | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by goldfire): I argue that (related to my musings in #14119), patterns -- such as that LHS of rules -- should not mention type families at all. In other words, we should change any `F ty` in rule LHS to a fresh type variable `a` and then require `F ty ~ a`. Which, as it turns out, is precisely what's done in my [http://cs.brynmawr.edu/~rae/papers/2017/partiality/partiality.pdf Constrained Type Families] paper. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 3 21:56:03 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 03 Oct 2017 21:56:03 -0000 Subject: [GHC] #11721: GADT-syntax data constructors don't work well with TypeApplications In-Reply-To: <047.d3cda57aa918919c3cdf02eb21c0a581@haskell.org> References: <047.d3cda57aa918919c3cdf02eb21c0a581@haskell.org> Message-ID: <062.385dc2cd3b3d12c1cffa32426cac2a84@haskell.org> #11721: GADT-syntax data constructors don't work well with TypeApplications -------------------------------------+------------------------------------- Reporter: goldfire | Owner: RyanGlScott Type: bug | Status: patch Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.1 Resolution: | Keywords: | TypeApplications Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #13848, #12025 | Differential Rev(s): Phab:D3687 Wiki Page: | -------------------------------------+------------------------------------- Comment (by Ben Gamari ): In [changeset:"ef26182e2014b0a2a029ae466a4b121bf235e4e4/ghc" ef26182/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="ef26182e2014b0a2a029ae466a4b121bf235e4e4" Track the order of user-written tyvars in DataCon After typechecking a data constructor's type signature, its type variables are partitioned into two distinct groups: the universally quantified type variables and the existentially quantified type variables. Then, when prompted for the type of the data constructor, GHC gives this: ```lang=haskell MkT :: forall . (...) ``` For H98-style datatypes, this is a fine thing to do. But for GADTs, this can sometimes produce undesired results with respect to `TypeApplications`. For instance, consider this datatype: ```lang=haskell data T a where MkT :: forall b a. b -> T a ``` Here, the user clearly intended to have `b` be available for visible type application before `a`. That is, the user would expect `MkT @Int @Char` to be of type `Int -> T Char`, //not// `Char -> T Int`. But alas, up until now that was not how GHC operated—regardless of the order in which the user actually wrote the tyvars, GHC would give `MkT` the type: ```lang=haskell MkT :: forall a b. b -> T a ``` Since `a` is universal and `b` is existential. This makes predicting what order to use for `TypeApplications` quite annoying, as demonstrated in #11721 and #13848. This patch cures the problem by tracking more carefully the order in which a user writes type variables in data constructor type signatures, either explicitly (with a `forall`) or implicitly (without a `forall`, in which case the order is inferred). This is accomplished by adding a new field `dcUserTyVars` to `DataCon`, which is a subset of `dcUnivTyVars` and `dcExTyVars` that is permuted to the order in which the user wrote them. For more details, refer to `Note [DataCon user type variables]` in `DataCon.hs`. An interesting consequence of this design is that more data constructors require wrappers. This is because the workers always expect the first arguments to be the universal tyvars followed by the existential tyvars, so when the user writes the tyvars in a different order, a wrapper type is needed to swizzle the tyvars around to match the order that the worker expects. For more details, refer to `Note [Data con wrappers and GADT syntax]` in `MkId.hs`. Test Plan: ./validate Reviewers: austin, goldfire, bgamari, simonpj Reviewed By: goldfire, simonpj Subscribers: ezyang, goldfire, rwbarton, thomie GHC Trac Issues: #11721, #13848 Differential Revision: https://phabricator.haskell.org/D3687 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 3 21:56:03 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 03 Oct 2017 21:56:03 -0000 Subject: [GHC] #14304: Instantiated libraries (Backpack) don't get linked with enough deps In-Reply-To: <045.7b75a2a889015ade587229e80d5bf80e@haskell.org> References: <045.7b75a2a889015ade587229e80d5bf80e@haskell.org> Message-ID: <060.c5ece6ff8db67f600f267075ecec65f3@haskell.org> #14304: Instantiated libraries (Backpack) don't get linked with enough deps -------------------------------------+------------------------------------- Reporter: ezyang | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: 8.2.2 Component: Compiler | Version: 8.2.1 (Linking) | 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): Phab:D4057 Wiki Page: | -------------------------------------+------------------------------------- Comment (by Ben Gamari ): In [changeset:"f3f624aeb1360c1f902930b3cc62346d2e5201c0/ghc" f3f624a/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="f3f624aeb1360c1f902930b3cc62346d2e5201c0" Include libraries which fill holes as deps when linking. Fixes the issue reported at https://github.com/haskell/cabal/issues/4755 and fixes #14304 in the GHC tracker. Signed-off-by: Edward Z. Yang Test Plan: validate Reviewers: bgamari, austin, goldfire Reviewed By: bgamari Subscribers: rwbarton, thomie GHC Trac Issues: #14304 Differential Revision: https://phabricator.haskell.org/D4057 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 3 21:56:03 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 03 Oct 2017 21:56:03 -0000 Subject: [GHC] #13561: Remove unsafe Chan combinators In-Reply-To: <046.9b8c966d23c3a50c08be628b9e43df65@haskell.org> References: <046.9b8c966d23c3a50c08be628b9e43df65@haskell.org> Message-ID: <061.2cb1dbe1fa85824edb1402ccc7597b15@haskell.org> #13561: Remove unsafe Chan combinators -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: task | Status: patch Priority: high | Milestone: 8.4.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: #4154 | Differential Rev(s): Phab:D4060 Wiki Page: | -------------------------------------+------------------------------------- Comment (by Ben Gamari ): In [changeset:"361af6280d7025ac3e24d79c209b465db6f231f8/ghc" 361af62/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="361af6280d7025ac3e24d79c209b465db6f231f8" base: Remove deprecated Chan combinators Removes isEmptyChan and unGetChan, which have been deprecated for a very long time. See #13561. Test Plan: Validate Reviewers: austin, hvr Subscribers: rwbarton, thomie GHC Trac Issues: #13561 Differential Revision: https://phabricator.haskell.org/D4060 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 3 21:56:03 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 03 Oct 2017 21:56:03 -0000 Subject: [GHC] #14305: Missing COMPLETE pragmas in release notes for version 8.2.1 In-Reply-To: <042.4751e422f40af59897721170938f7554@haskell.org> References: <042.4751e422f40af59897721170938f7554@haskell.org> Message-ID: <057.819daabe38dcf51f8b515cfd93be663f@haskell.org> #14305: Missing COMPLETE pragmas in release notes for version 8.2.1 -------------------------------------+------------------------------------- Reporter: asr | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: 8.2.2 Component: Documentation | 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:D4059 Wiki Page: | -------------------------------------+------------------------------------- Comment (by Ben Gamari ): In [changeset:"3201d85f48e47ea10a49d4222ca0570824aa81d8/ghc" 3201d85f/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="3201d85f48e47ea10a49d4222ca0570824aa81d8" user-guide: Mention COMPLETE pragma in release notes Reviewers: austin Subscribers: rwbarton, thomie GHC Trac Issues: #14305 Differential Revision: https://phabricator.haskell.org/D4059 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 3 21:56:02 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 03 Oct 2017 21:56:02 -0000 Subject: [GHC] #13848: Unexpected order of variable quantification with GADT constructor In-Reply-To: <050.1bdc037c5d3daf9f53281904769def22@haskell.org> References: <050.1bdc037c5d3daf9f53281904769def22@haskell.org> Message-ID: <065.99b4cb81064017374d646b5933add5c5@haskell.org> #13848: Unexpected order of variable quantification with GADT constructor -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: Component: Compiler (Type | Version: 8.0.1 checker) | Keywords: Resolution: duplicate | TypeApplications Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #11721 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Ben Gamari ): In [changeset:"ef26182e2014b0a2a029ae466a4b121bf235e4e4/ghc" ef26182/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="ef26182e2014b0a2a029ae466a4b121bf235e4e4" Track the order of user-written tyvars in DataCon After typechecking a data constructor's type signature, its type variables are partitioned into two distinct groups: the universally quantified type variables and the existentially quantified type variables. Then, when prompted for the type of the data constructor, GHC gives this: ```lang=haskell MkT :: forall . (...) ``` For H98-style datatypes, this is a fine thing to do. But for GADTs, this can sometimes produce undesired results with respect to `TypeApplications`. For instance, consider this datatype: ```lang=haskell data T a where MkT :: forall b a. b -> T a ``` Here, the user clearly intended to have `b` be available for visible type application before `a`. That is, the user would expect `MkT @Int @Char` to be of type `Int -> T Char`, //not// `Char -> T Int`. But alas, up until now that was not how GHC operated—regardless of the order in which the user actually wrote the tyvars, GHC would give `MkT` the type: ```lang=haskell MkT :: forall a b. b -> T a ``` Since `a` is universal and `b` is existential. This makes predicting what order to use for `TypeApplications` quite annoying, as demonstrated in #11721 and #13848. This patch cures the problem by tracking more carefully the order in which a user writes type variables in data constructor type signatures, either explicitly (with a `forall`) or implicitly (without a `forall`, in which case the order is inferred). This is accomplished by adding a new field `dcUserTyVars` to `DataCon`, which is a subset of `dcUnivTyVars` and `dcExTyVars` that is permuted to the order in which the user wrote them. For more details, refer to `Note [DataCon user type variables]` in `DataCon.hs`. An interesting consequence of this design is that more data constructors require wrappers. This is because the workers always expect the first arguments to be the universal tyvars followed by the existential tyvars, so when the user writes the tyvars in a different order, a wrapper type is needed to swizzle the tyvars around to match the order that the worker expects. For more details, refer to `Note [Data con wrappers and GADT syntax]` in `MkId.hs`. Test Plan: ./validate Reviewers: austin, goldfire, bgamari, simonpj Reviewed By: goldfire, simonpj Subscribers: ezyang, goldfire, rwbarton, thomie GHC Trac Issues: #11721, #13848 Differential Revision: https://phabricator.haskell.org/D3687 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 3 21:57:34 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 03 Oct 2017 21:57:34 -0000 Subject: [GHC] #11721: GADT-syntax data constructors don't work well with TypeApplications In-Reply-To: <047.d3cda57aa918919c3cdf02eb21c0a581@haskell.org> References: <047.d3cda57aa918919c3cdf02eb21c0a581@haskell.org> Message-ID: <062.38a1b68936380819b78fa0e1f6b4ebae@haskell.org> #11721: GADT-syntax data constructors don't work well with TypeApplications -------------------------------------+------------------------------------- Reporter: goldfire | Owner: RyanGlScott Type: bug | Status: closed Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.1 Resolution: fixed | Keywords: | TypeApplications Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #13848, #12025 | Differential Rev(s): Phab:D3687 Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: patch => closed * resolution: => fixed Old description: > Consider > > {{{ > data X a where > MkX :: b -> Proxy a -> X a > }}} > > According to the rules around specified vs. generalized variables around > `TypeApplications`, the type of `MkX` should be > > {{{ > MkX :: forall {k} (b :: *) (a :: k). b -> Proxy a -> X a > }}} > > A few things to note: > * The `k` isn't available for `TypeApplications` (that's why it's in > braces), because it is not user-written. > * The `b` is quantified before the `a`, because `b` comes before `a` in > the user-written type signature for `MkX`. > > Both of these bullets are currently violated. GHCi reports `MkX`'s type > as > > {{{ > MkX :: forall k (a :: k) b. b -> Proxy a -> X a > }}} > > It turns out that this is a hard to fix. The problem is that GHC expects > data constructors to have their universal variables followed by their > existential variables, always. And yet that's violated in the desired > type for `MkX`. Furthermore, given the way that GHC deals with GADT > return types ("rejigging", in technical parlance), it's inconvenient to > get the specified/generalized distinction correct. > > Given time constraints, I'm afraid fixing this all won't make it for 8.0. > > Happily, there is are easy-to-articulate rules governing GHC's current > (wrong) behavior. In a GADT-syntax data constructor: > * All kind and type variables are considered specified and available for > visible type application. > * Universal variables always come first, in precisely the order they > appear in the tycon. Note that universals that are constrained by a GADT > return type are missing from the datacon. > * Existential variables come next. Their order is determined by a user- > written `forall`; or, if there is none, by taking the left-to-right order > in the datacon's type and doing a stable topological sort. (This stable > topological sort step is the same as for other user-written type > signatures.) > > Despite the existence of these rules, it would still be better not to > have special rules for GADT-syntax data constructors. This ticket is > intended to capture that eventual goal. New description: Consider {{{#!hs data X a where MkX :: b -> Proxy a -> X a }}} According to the rules around specified vs. generalized variables around `TypeApplications`, the type of `MkX` should be {{{#!hs MkX :: forall {k} (b :: *) (a :: k). b -> Proxy a -> X a }}} A few things to note: * The `k` isn't available for `TypeApplications` (that's why it's in braces), because it is not user-written. * The `b` is quantified before the `a`, because `b` comes before `a` in the user-written type signature for `MkX`. Both of these bullets are currently violated. GHCi reports `MkX`'s type as {{{ MkX :: forall k (a :: k) b. b -> Proxy a -> X a }}} It turns out that this is a hard to fix. The problem is that GHC expects data constructors to have their universal variables followed by their existential variables, always. And yet that's violated in the desired type for `MkX`. Furthermore, given the way that GHC deals with GADT return types ("rejigging", in technical parlance), it's inconvenient to get the specified/generalized distinction correct. Given time constraints, I'm afraid fixing this all won't make it for 8.0. Happily, there is are easy-to-articulate rules governing GHC's current (wrong) behavior. In a GADT-syntax data constructor: * All kind and type variables are considered specified and available for visible type application. * Universal variables always come first, in precisely the order they appear in the tycon. Note that universals that are constrained by a GADT return type are missing from the datacon. * Existential variables come next. Their order is determined by a user- written `forall`; or, if there is none, by taking the left-to-right order in the datacon's type and doing a stable topological sort. (This stable topological sort step is the same as for other user-written type signatures.) Despite the existence of these rules, it would still be better not to have special rules for GADT-syntax data constructors. This ticket is intended to capture that eventual goal. -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 3 21:58:30 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 03 Oct 2017 21:58:30 -0000 Subject: [GHC] #14304: Instantiated libraries (Backpack) don't get linked with enough deps In-Reply-To: <045.7b75a2a889015ade587229e80d5bf80e@haskell.org> References: <045.7b75a2a889015ade587229e80d5bf80e@haskell.org> Message-ID: <060.aeb2757e451e494056c57a5b3d8a5177@haskell.org> #14304: Instantiated libraries (Backpack) don't get linked with enough deps -------------------------------------+------------------------------------- Reporter: ezyang | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: 8.2.2 Component: Compiler | Version: 8.2.1 (Linking) | Resolution: fixed | Keywords: backpack Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4057 Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: patch => closed * resolution: => fixed Comment: Merged to `ghc-8.2` as 876fec04c04061d5a2257675fcd0deb35ecb0aaf. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 3 21:58:43 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 03 Oct 2017 21:58:43 -0000 Subject: [GHC] #13561: Remove unsafe Chan combinators In-Reply-To: <046.9b8c966d23c3a50c08be628b9e43df65@haskell.org> References: <046.9b8c966d23c3a50c08be628b9e43df65@haskell.org> Message-ID: <061.7eadc025c213b15e577eb2204fb77404@haskell.org> #13561: Remove unsafe Chan combinators -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: task | Status: closed Priority: high | 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: #4154 | Differential Rev(s): Phab:D4060 Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: patch => closed * resolution: => fixed -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 3 21:58:51 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 03 Oct 2017 21:58:51 -0000 Subject: [GHC] #14305: Missing COMPLETE pragmas in release notes for version 8.2.1 In-Reply-To: <042.4751e422f40af59897721170938f7554@haskell.org> References: <042.4751e422f40af59897721170938f7554@haskell.org> Message-ID: <057.764a2a1db19bb58554188df439203d2b@haskell.org> #14305: Missing COMPLETE pragmas in release notes for version 8.2.1 -------------------------------------+------------------------------------- Reporter: asr | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: 8.2.2 Component: Documentation | 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:D4059 Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: patch => closed * resolution: => fixed -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 3 22:14:46 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 03 Oct 2017 22:14:46 -0000 Subject: [GHC] #13652: Add integer division to GHC.TypeLits In-Reply-To: <048.b9612e3f8a829526a91743f198cf1ed8@haskell.org> References: <048.b9612e3f8a829526a91743f198cf1ed8@haskell.org> Message-ID: <063.f87896a86aad033e3b825ee9c0d21dfd@haskell.org> #13652: Add integer division to GHC.TypeLits -------------------------------------+------------------------------------- Reporter: vagarenko | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Core Libraries | 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 RyanGlScott): Commit fa8035e3ee83aff5a20fc5e7e2697bac1686d6a6 added type-level versions of `Div` and `Mod` to `GHC.TypeNats`. The only remaining question—which I will ask to vagarenko—is it important to you to have a `DivMod` type family in `base` that uses the value-level `divMod` under the hood? I ask since one //could// define `DivMod` in terms of `Div` and `Mod`, but perhaps you're wanting something more performant than that. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 3 22:34:22 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 03 Oct 2017 22:34:22 -0000 Subject: [GHC] #14266: AllowAmbiguousTypes doesn't play well with default class methods In-Reply-To: <051.38c1a194c842b23e120b2589c2db8665@haskell.org> References: <051.38c1a194c842b23e120b2589c2db8665@haskell.org> Message-ID: <066.2172905ecf14f4559de32c87b2f617e9@haskell.org> #14266: AllowAmbiguousTypes doesn't play well with default class methods -------------------------------------+------------------------------------- Reporter: chris-martin | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.0.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): I like Richard's visible type pattern suggestion far more than trying to fiddle with `InstanceSigs`. (Well, except for the fact that we don't currently have visible type patterns. But I'll try not to be impatient.) If we do go down this route, I suppose we'd need to eta-expand //all// arguments of a default function when desugaring `DefaultSignatures` so that something like this would work: {{{#!hs class A t where f :: forall m. t m -> forall x. Monoid x -> m instance A [] where f @m tm @x = df @[] @m tm @x }}} Since I believe we'd need to visibly apply `@x` there in order to avoid being ensnared in ambiguity. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 4 00:02:51 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 04 Oct 2017 00:02:51 -0000 Subject: [GHC] #14310: Assertion triggered by STM invariant. In-Reply-To: <042.9c3fac38bbd2247bedc1f2616e6e2820@haskell.org> References: <042.9c3fac38bbd2247bedc1f2616e6e2820@haskell.org> Message-ID: <057.8afc75096aabd7c26c0d206b9790b3a2@haskell.org> #14310: Assertion triggered by STM invariant. ----------------------------------+-------------------------------------- Reporter: mbw | Owner: (none) Type: bug | Status: new Priority: high | Milestone: 8.4.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): Wiki Page: | ----------------------------------+-------------------------------------- Comment (by bgamari): Well, the good news is that this is reproducible with `+RTS -Dm` (STM debugging enabled). The bad news is that it produces 170MB of output before crashing. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 4 00:35:40 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 04 Oct 2017 00:35:40 -0000 Subject: [GHC] #14310: Assertion triggered by STM invariant. In-Reply-To: <042.9c3fac38bbd2247bedc1f2616e6e2820@haskell.org> References: <042.9c3fac38bbd2247bedc1f2616e6e2820@haskell.org> Message-ID: <057.1cfc8cbd78ce4a980d4ae1856e5443ec@haskell.org> #14310: Assertion triggered by STM invariant. ----------------------------------+-------------------------------------- Reporter: mbw | Owner: (none) Type: bug | Status: new Priority: high | Milestone: 8.4.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): Wiki Page: | ----------------------------------+-------------------------------------- Changes (by bgamari): * Attachment "Main2.hs" added. Variant that doesn't rely on async -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 4 00:36:02 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 04 Oct 2017 00:36:02 -0000 Subject: [GHC] #14310: Assertion triggered by STM invariant. In-Reply-To: <042.9c3fac38bbd2247bedc1f2616e6e2820@haskell.org> References: <042.9c3fac38bbd2247bedc1f2616e6e2820@haskell.org> Message-ID: <057.0a4e1b760664b32770d386ab8092c20f@haskell.org> #14310: Assertion triggered by STM invariant. ----------------------------------+-------------------------------------- Reporter: mbw | Owner: (none) Type: bug | Status: new Priority: high | Milestone: 8.4.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): Wiki Page: | ----------------------------------+-------------------------------------- Comment (by bgamari): It turns out that `async` isn't strictly necessary to reproduce this, thankfully. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 4 01:20:17 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 04 Oct 2017 01:20:17 -0000 Subject: [GHC] #14310: Assertion triggered by STM invariant. In-Reply-To: <042.9c3fac38bbd2247bedc1f2616e6e2820@haskell.org> References: <042.9c3fac38bbd2247bedc1f2616e6e2820@haskell.org> Message-ID: <057.041134b519ce1f0f140ea26cbbfce6df@haskell.org> #14310: Assertion triggered by STM invariant. ----------------------------------+-------------------------------------- Reporter: mbw | Owner: (none) Type: bug | Status: new Priority: high | Milestone: 8.4.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): Wiki Page: | ----------------------------------+-------------------------------------- Comment (by bgamari): For the record, the assertion in question was originally introduced in 96757f6a4ec72dc609468d3da442db38a73df23e, essentially the beginning of time. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 4 01:24:26 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 04 Oct 2017 01:24:26 -0000 Subject: [GHC] #14310: Assertion triggered by STM invariant. In-Reply-To: <042.9c3fac38bbd2247bedc1f2616e6e2820@haskell.org> References: <042.9c3fac38bbd2247bedc1f2616e6e2820@haskell.org> Message-ID: <057.1e06694c80092465d886fda57e3b5616@haskell.org> #14310: Assertion triggered by STM invariant. ----------------------------------+-------------------------------------- Reporter: mbw | Owner: (none) Type: bug | Status: new Priority: high | Milestone: 8.4.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): Wiki Page: | ----------------------------------+-------------------------------------- Comment (by bgamari): I mention this because I'm a bit skeptical of the assertion itself; it looks like it appeared a fair bit before the invariant work. If you look at `stg_atomically_frame` it seems pretty clear that we will end up with nested transactions in the normal course of checking invariants. Obviously there is still something wrong since the problem deadlocks without the debug RTS, but I'm wondering whether the assert is really pointing in the right direction. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 4 01:32:27 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 04 Oct 2017 01:32:27 -0000 Subject: [GHC] #14310: Assertion triggered by STM invariant. In-Reply-To: <042.9c3fac38bbd2247bedc1f2616e6e2820@haskell.org> References: <042.9c3fac38bbd2247bedc1f2616e6e2820@haskell.org> Message-ID: <057.fb7f0fc3ee6325ba920d412d20b35928@haskell.org> #14310: Assertion triggered by STM invariant. ----------------------------------+-------------------------------------- Reporter: mbw | Owner: (none) Type: bug | Status: new Priority: high | Milestone: 8.4.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): Wiki Page: | ----------------------------------+-------------------------------------- Comment (by bgamari): I'll also say that the comment right below the assertion doesn't instill confidence, {{{ // The ATOMICALLY_FRAME expects to be returned a // result from the transaction, which it stores in the // stack frame. Hence we arrange to return a dummy // result, so that the GC doesn't get upset (#3578). // Perhaps a better way would be to have a different // ATOMICALLY_FRAME instance for condemned // transactions, but I don't fully understand the // interaction with STM invariants. }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 4 01:37:01 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 04 Oct 2017 01:37:01 -0000 Subject: [GHC] #14310: Assertion triggered by STM invariant. In-Reply-To: <042.9c3fac38bbd2247bedc1f2616e6e2820@haskell.org> References: <042.9c3fac38bbd2247bedc1f2616e6e2820@haskell.org> Message-ID: <057.7ea5e7429706153aafe90792afc42b22@haskell.org> #14310: Assertion triggered by STM invariant. ----------------------------------+-------------------------------------- Reporter: mbw | Owner: (none) Type: bug | Status: new Priority: high | Milestone: 8.4.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): Wiki Page: | ----------------------------------+-------------------------------------- Comment (by bgamari): If I compile without the debug RTS and run the test program in the same way, I find that the program isn't actually dead-locked. Rather it is live-locked with two threads apparently spinning against one another: {{{ pthread_cond_wait@@GLIBC_2.3.2 () at ../sysdeps/unix/sysv/linux/x86_64/pthread_cond_wait.S:185 185 in ../sysdeps/unix/sysv/linux/x86_64/pthread_cond_wait.S >>> info threads Id Target Id Frame * 1 Thread 0x7f88ade01740 (LWP 4341) "Main" pthread_cond_wait@@GLIBC_2.3.2 () at ../sysdeps/unix/sysv/linux/x86_64/pthread_cond_wait.S:185 2 Thread 0x7f88abec5700 (LWP 4342) "ghc_worker" 0x00007f88ac9650f3 in epoll_wait () at ../sysdeps/unix/syscall-template.S:84 3 Thread 0x7f88ab6c4700 (LWP 4343) "ghc_ticker" 0x00007f88ad08b20d in read () at ../sysdeps/unix/syscall-template.S:84 4 Thread 0x7f88aaec3700 (LWP 4344) "ghc_worker" 0x00007f88ac9650f3 in epoll_wait () at ../sysdeps/unix/syscall-template.S:84 5 Thread 0x7f88aa6c2700 (LWP 4345) "ghc_worker" 0x00007f88ac95b6ad in poll () at ../sysdeps/unix/syscall-template.S:84 6 Thread 0x7f88a9ec1700 (LWP 4346) "ghc_worker" 0x00000000004a3c21 in stg_atomically_frame_info () 7 Thread 0x7f88a96c0700 (LWP 4347) "ghc_worker" stmAbortTransaction (cap=0x4e01b0, trec=0x42000d2238) at rts/STM.c:1020 >>> thread 6 [Switching to thread 6 (Thread 0x7f88a9ec1700 (LWP 4346))] #0 0x00000000004a3c21 in stg_atomically_frame_info () >>> bt #0 0x00000000004a3c21 in stg_atomically_frame_info () #1 0x0000000000000000 in ?? () >>> x/8a $rbp 0x42002d7338: 0x4a3bb8 0x42002fd510 0x42002d7348: 0x42001d56d8 0x4daed9 0x42002d7358: 0x413bf0 0x42002fd538 0x42002d7368: 0x49feb0 0x0 >>> thread 7 [Switching to thread 7 (Thread 0x7f88a96c0700 (LWP 4347))] #0 stmAbortTransaction (cap=0x4e01b0, trec=0x42000d2238) at rts/STM.c:1020 1020 rts/STM.c: No such file or directory. >>> bt #0 stmAbortTransaction (cap=0x4e01b0, trec=0x42000d2238) at rts/STM.c:1020 #1 0x00000000004a3c14 in stg_atomically_frame_info () #2 0x0000000000000000 in ?? () >>> up #1 0x00000000004a3c14 in stg_atomically_frame_info () >>> x/8a $rbp 0x42002d54a0: 0x4a3bb8 0x420029d690 0x42002d54b0: 0x42000d2218 0x4daed9 0x42002d54c0: 0x413bf0 0x420029d6b8 0x42002d54d0: 0x49feb0 0x0 >>> }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 4 01:54:21 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 04 Oct 2017 01:54:21 -0000 Subject: [GHC] #14310: Assertion triggered by STM invariant. In-Reply-To: <042.9c3fac38bbd2247bedc1f2616e6e2820@haskell.org> References: <042.9c3fac38bbd2247bedc1f2616e6e2820@haskell.org> Message-ID: <057.6fa808c96be5483af19b7cf86be877cc@haskell.org> #14310: Assertion triggered by STM invariant. ----------------------------------+-------------------------------------- Reporter: mbw | Owner: (none) Type: bug | Status: new Priority: high | Milestone: 8.4.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): Wiki Page: | ----------------------------------+-------------------------------------- Comment (by bgamari): For the record, STM invariant support was added in 9cef40bd4dd2536c7a370a1a9b78461c152805cc, quite a while after the commit which added the assert. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 4 01:59:29 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 04 Oct 2017 01:59:29 -0000 Subject: [GHC] #14310: Assertion triggered by STM invariant. In-Reply-To: <042.9c3fac38bbd2247bedc1f2616e6e2820@haskell.org> References: <042.9c3fac38bbd2247bedc1f2616e6e2820@haskell.org> Message-ID: <057.59fd3324e3bbea9b0a1788afb458da71@haskell.org> #14310: Assertion triggered by STM invariant. ----------------------------------+-------------------------------------- Reporter: mbw | Owner: (none) Type: bug | Status: new Priority: high | Milestone: 8.4.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): Wiki Page: | ----------------------------------+-------------------------------------- Comment (by bgamari): Here is a representative snipped from the `+RTS -Dm` output of a run of the testcase, {{{ ... 7fcb1bfff700: STM: 0x42002fdea0 : stmCommitTransaction()=0 7fcb1bfff700: STM: 0x505e28 : stmStartTransaction with 611 tokens 7fcb1bfff700: STM: 0x505e28 : stmStartTransaction()=0x42002fdea0 7fcb1bfff700: STM: 0x42002fdea0 : stmReadTVar(0x42002ff8f8) 7fcb1bfff700: STM: 0x42002fdea0 : get_entry_for TVar 0x42002ff8f8 7fcb1bfff700: STM: 0x42002fdea0 : FOR_EACH_ENTRY, current_chunk=0x42002ff3f8 limit=0 7fcb1bfff700: STM: 0x42002fdea0 : read_current_value(0x42002ff8f8)=0x42002ff919 7fcb1bfff700: STM: 0x42002fdea0 : stmReadTVar(0x42002ff8f8)=0x42002ff919 7fcb1bfff700: STM: 0x42002fdea0 : stmReadTVar(0x42002ff938) 7fcb1bfff700: STM: 0x42002fdea0 : get_entry_for TVar 0x42002ff938 7fcb1bfff700: STM: 0x42002fdea0 : FOR_EACH_ENTRY, current_chunk=0x42002ff3f8 limit=1 7fcb1bfff700: STM: 0x42002fdea0 : read_current_value(0x42002ff938)=0x42002ff95a 7fcb1bfff700: STM: 0x42002fdea0 : stmReadTVar(0x42002ff938)=0x42002ff95a 7fcb1bfff700: STM: 0x42002fdea0 : stmWriteTVar(0x42002ff8f8, 0x420002eee9) 7fcb1bfff700: STM: 0x42002fdea0 : get_entry_for TVar 0x42002ff8f8 7fcb1bfff700: STM: 0x42002fdea0 : FOR_EACH_ENTRY, current_chunk=0x42002ff3f8 limit=2 7fcb1bfff700: STM: 0x42002fdea0 : stmWriteTVar done 7fcb1bfff700: STM: 0x42002fdea0 : stmReadTVar(0x42002ff970) 7fcb1bfff700: STM: 0x42002fdea0 : get_entry_for TVar 0x42002ff970 7fcb1bfff700: STM: 0x42002fdea0 : FOR_EACH_ENTRY, current_chunk=0x42002ff3f8 limit=2 7fcb1bfff700: STM: 0x42002fdea0 : read_current_value(0x42002ff970)=0x42002ff991 7fcb1bfff700: STM: 0x42002fdea0 : stmReadTVar(0x42002ff970)=0x42002ff991 7fcb1bfff700: STM: 0x42002fdea0 : stmWriteTVar(0x42002ff9b0, 0x420002efd2) 7fcb1bfff700: STM: 0x42002fdea0 : get_entry_for TVar 0x42002ff9b0 7fcb1bfff700: STM: 0x42002fdea0 : FOR_EACH_ENTRY, current_chunk=0x42002ff3f8 limit=3 7fcb1bfff700: STM: 0x42002fdea0 : read_current_value(0x42002ff9b0)=0x4fe191 7fcb1bfff700: STM: 0x42002fdea0 : stmWriteTVar done 7fcb1bfff700: STM: 0x42002fdea0 : stmWriteTVar(0x42002ff970, 0x420002efe9) 7fcb1bfff700: STM: 0x42002fdea0 : get_entry_for TVar 0x42002ff970 7fcb1bfff700: STM: 0x42002fdea0 : FOR_EACH_ENTRY, current_chunk=0x42002ff3f8 limit=4 7fcb1bfff700: STM: 0x42002fdea0 : stmWriteTVar done 7fcb1bfff700: STM: 0x42002fdea0 : stmReadTVar(0x42002ff688) 7fcb1bfff700: STM: 0x42002fdea0 : get_entry_for TVar 0x42002ff688 7fcb1bfff700: STM: 0x42002fdea0 : FOR_EACH_ENTRY, current_chunk=0x42002ff3f8 limit=4 7fcb1bfff700: STM: 0x42002fdea0 : read_current_value(0x42002ff688)=0x42002ff230 7fcb1bfff700: STM: 0x42002fdea0 : stmReadTVar(0x42002ff688)=0x42002ff230 7fcb1bfff700: STM: 0x42002fdea0 : stmWriteTVar(0x42002ff688, 0x420002a088) 7fcb1bfff700: STM: 0x42002fdea0 : get_entry_for TVar 0x42002ff688 7fcb1bfff700: STM: 0x42002fdea0 : FOR_EACH_ENTRY, current_chunk=0x42002ff3f8 limit=5 7fcb1bfff700: STM: 0x42002fdea0 : stmWriteTVar done 7fcb1bfff700: STM: 0x42002fdea0 : stmGetInvariantsToCheck, head was 0x505e18 7fcb1bfff700: STM: 0x42002fdea0 : lock_stm() 7fcb1bfff700: STM: 0x42002fdea0 : lock_tvar(0x42002ff8f8) 7fcb1bfff700: STM: 0x42002fdea0 : checking for invariants on 0x42002ff8f8 7fcb1bfff700: STM: 0x42002fdea0 : unlock_tvar(0x42002ff8f8, 0x42002ff919) 7fcb1bfff700: STM: 0x42002fdea0 : lock_tvar(0x42002ff970) 7fcb1bfff700: STM: 0x42002fdea0 : checking for invariants on 0x42002ff970 7fcb1bfff700: STM: 0x42002fdea0 : unlock_tvar(0x42002ff970, 0x42002ff991) 7fcb1bfff700: STM: 0x42002fdea0 : lock_tvar(0x42002ff9b0) 7fcb1bfff700: STM: 0x42002fdea0 : checking for invariants on 0x42002ff9b0 7fcb1bfff700: STM: 0x42002fdea0 : unlock_tvar(0x42002ff9b0, 0x4fe191) 7fcb1bfff700: STM: 0x42002fdea0 : lock_tvar(0x42002ff688) 7fcb1bfff700: STM: 0x42002fdea0 : checking for invariants on 0x42002ff688 7fcb1bfff700: STM: 0x42002fdea0 : Touching invariant 0x42002ffd50 7fcb1bfff700: STM: 0x42002fdea0 : Not already found 0x42002ffd50 7fcb1bfff700: STM: 0x42002fdea0 : unlock_tvar(0x42002ff688, 0x42002ff230) 7fcb1bfff700: STM: 0x42002fdea0 : unlock_stm() 7fcb1bfff700: STM: 0x42002fdea0 : stmGetInvariantsToCheck, head now 0x420002c6d8 7fcb1bfff700: STM: 0x42002fdea0 : stmStartTransaction with 610 tokens 7fcb1bfff700: STM: 0x42002fdea0 : stmStartTransaction()=0x420002c6f8 7fcb1bfff700: STM: 0x420002c6f8 : stmReadTVar(0x42002ff688) 7fcb1bfff700: STM: 0x420002c6f8 : get_entry_for TVar 0x42002ff688 7fcb1bfff700: STM: 0x420002c6f8 : FOR_EACH_ENTRY, current_chunk=0x420002c720 limit=0 7fcb1bfff700: STM: 0x42002fdea0 : FOR_EACH_ENTRY, current_chunk=0x42002ff3f8 limit=5 7fcb1bfff700: STM: 0x420002c6f8 : stmReadTVar(0x42002ff688)=0x420002a088 7fcb1bfff700: STM: 0x420002c6f8 : stmAbortTransaction 7fcb1bfff700: STM: 0x420002c6f8 : lock_stm() 7fcb1bfff700: STM: 0x420002c6f8 : retaining read-set into parent 0x42002fdea0 7fcb1bfff700: STM: 0x420002c6f8 : FOR_EACH_ENTRY, current_chunk=0x420002c720 limit=1 7fcb1bfff700: STM: 0x42002fdea0 : FOR_EACH_ENTRY, current_chunk=0x42002ff3f8 limit=5 7fcb1bfff700: STM: 0x420002c6f8 : unlock_stm() 7fcb1bfff700: STM: 0x420002c6f8 : stmAbortTransaction done 7fcb1bfff700: STM: 0x42002fdea0 : stmCommitTransaction() 7fcb1bfff700: STM: 0x42002fdea0 : lock_stm() 7fcb1bfff700: STM: 0x42002fdea0 : locking invariants 7fcb1bfff700: STM: 0x42002fdea0 : locking invariant 0x42002ffd50 7fcb1bfff700: STM: 0x42002fdea0 : failed to lock 0x42002ffd50 7fcb1bfff700: STM: 0x42002fdea0 : finished locking invariants 7fcb1bfff700: STM: 0x42002fdea0 : FOR_EACH_ENTRY, current_chunk=0x42002ff3f8 limit=5 7fcb1bfff700: STM: 0x42002fdea0 : unlock_stm() 7fcb1bfff700: STM: 0x42002fdea0 : stmCommitTransaction()=0 }}} AFAICT the log essentially consists of tens of thousands of repeats similar to this. The `failed to lock` line is quite intriguing; -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 4 02:15:41 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 04 Oct 2017 02:15:41 -0000 Subject: [GHC] #14310: Assertion triggered by STM invariant. In-Reply-To: <042.9c3fac38bbd2247bedc1f2616e6e2820@haskell.org> References: <042.9c3fac38bbd2247bedc1f2616e6e2820@haskell.org> Message-ID: <057.7918e2129af5942cf04c4d5eac70ea21@haskell.org> #14310: Assertion triggered by STM invariant. ----------------------------------+-------------------------------------- Reporter: mbw | Owner: (none) Type: bug | Status: new Priority: high | Milestone: 8.4.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): Wiki Page: | ----------------------------------+-------------------------------------- Comment (by bgamari): So I think I see one issue: in the event that `validate_and_acquire_ownership(cap, trec, (!use_read_phase), true);` in `stmCommitTransaction` returns `false` we will never unlock the invariants that we previously locked. I suspect we'll want something like this, {{{#!patch diff --git a/rts/STM.c b/rts/STM.c index 5c8fd4ff40..02ac22519b 100644 --- a/rts/STM.c +++ b/rts/STM.c @@ -1441,6 +1441,17 @@ StgBool stmCommitTransaction(Capability *cap, StgTRecHeader *trec) { } else { revert_ownership(cap, trec, false); } + } else { + // we encountered inconsistency; unlock the invariants that we locked as we + // are giving up on committing. + if (touched_invariants) { + StgInvariantCheckQueue *q = trec -> invariants_to_check; + while (q != END_INVARIANT_CHECK_QUEUE) { + StgAtomicInvariant *inv = q -> invariant; + unlock_inv(inv); + q = q -> next_queue_entry; + } + } } unlock_stm(trec); }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 4 02:28:54 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 04 Oct 2017 02:28:54 -0000 Subject: =?utf-8?q?=5BGHC=5D_=2314313=3A_=E2=80=9CResult_signatures_are_n?= =?utf-8?q?o_longer_supported_in_pattern_matches=E2=80=9D_lost?= Message-ID: <046.f81b72f51154afa43f3605001c35a3f2@haskell.org> #14313: “Result signatures are no longer supported in pattern matches” lost -------------------------------------+------------------------------------- Reporter: nomeata | Owner: (none) Type: task | Status: new Priority: low | Milestone: Component: Compiler | Version: 8.2.1 Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: #2310 Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- This commit (b98ff25f4c8cb4bf18b784c848fabaaa6e4b11b8) from two years ago broke the error message (at least according to when `T2310.stderr` was modified): {{{ T2310.hs:5:22: Illegal result type signature ‘a’ Result signatures are no longer supported in pattern matches In a lambda abstraction: \ x :: a -> (x :: a) }}} that was displayed previously. Either we do want that error message (then this is a bug) or we don’t care about this error message any more, then probably we can remove the `m_type` field of `Match` in `HsExpr`. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 4 02:43:55 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 04 Oct 2017 02:43:55 -0000 Subject: [GHC] #14298: Let Template Haskell dynamically add something with which to link In-Reply-To: <050.5b84ef44d6dba8c28fe71b17d035f8a7@haskell.org> References: <050.5b84ef44d6dba8c28fe71b17d035f8a7@haskell.org> Message-ID: <065.7317c7bf3266e42bbac639ac617a8658@haskell.org> #14298: Let Template Haskell dynamically add something with which to link -------------------------------------+------------------------------------- Reporter: harpocrates | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Template Haskell | 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:D4064 Wiki Page: | -------------------------------------+------------------------------------- Changes (by harpocrates): * differential: => Phab:D4064 Comment: Here's a patch which implements the API from comment:6. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 4 02:52:41 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 04 Oct 2017 02:52:41 -0000 Subject: [GHC] #14310: Assertion triggered by STM invariant. In-Reply-To: <042.9c3fac38bbd2247bedc1f2616e6e2820@haskell.org> References: <042.9c3fac38bbd2247bedc1f2616e6e2820@haskell.org> Message-ID: <057.2257e9901ec765525c1d94d6af4a194d@haskell.org> #14310: Assertion triggered by STM invariant. ----------------------------------+-------------------------------------- Reporter: mbw | Owner: (none) Type: bug | Status: new Priority: high | Milestone: 8.4.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: | ----------------------------------+-------------------------------------- Changes (by bgamari): * differential: => Phab:D4065 Comment: Unfortunately the patch in comment:10 doesn't fix the assertion failure. Nevertheless, I strongly suspect that the patch is correct. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 4 03:33:56 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 04 Oct 2017 03:33:56 -0000 Subject: [GHC] #14310: Assertion triggered by STM invariant. In-Reply-To: <042.9c3fac38bbd2247bedc1f2616e6e2820@haskell.org> References: <042.9c3fac38bbd2247bedc1f2616e6e2820@haskell.org> Message-ID: <057.d82575ae4663d815241639b38cb4af1d@haskell.org> #14310: Assertion triggered by STM invariant. ----------------------------------+-------------------------------------- Reporter: mbw | Owner: (none) Type: bug | Status: new Priority: high | Milestone: 8.4.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: | ----------------------------------+-------------------------------------- Comment (by bgamari): Actually, disregard comment:11; I was testing with the wrong compiler. It (with some tweaks; see the Diff) actually appears to resolve both issues. I would still like to hear the opinion of someone in the know, however. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 4 03:52:29 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 04 Oct 2017 03:52:29 -0000 Subject: [GHC] #14310: Assertion triggered by STM invariant. In-Reply-To: <042.9c3fac38bbd2247bedc1f2616e6e2820@haskell.org> References: <042.9c3fac38bbd2247bedc1f2616e6e2820@haskell.org> Message-ID: <057.fd4545ab14615afabdf027a97c6554d5@haskell.org> #14310: Assertion triggered by STM invariant. ----------------------------------+-------------------------------------- Reporter: mbw | Owner: (none) Type: bug | Status: new Priority: high | Milestone: 8.4.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: | ----------------------------------+-------------------------------------- Comment (by bgamari): Unfortunately I'm still seeing occasional assertion failures with the patch. Frankly, I'm very confused by the treatment of invariants in `stmCommitTransaction`; it seems to me like we will happily proceed with committing a transaction (and touching invariants) even if we aren't able to lock all invariants (see the `break` around line 1350 of `STM.c`). This seems quite suspicious. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 4 04:01:30 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 04 Oct 2017 04:01:30 -0000 Subject: [GHC] #14310: Assertion triggered by STM invariant. In-Reply-To: <042.9c3fac38bbd2247bedc1f2616e6e2820@haskell.org> References: <042.9c3fac38bbd2247bedc1f2616e6e2820@haskell.org> Message-ID: <057.e34c40ae8fa2ea6493877aa64ac8f5f1@haskell.org> #14310: Assertion triggered by STM invariant. -------------------------------------+------------------------------------- Reporter: mbw | Owner: (none) Type: bug | Status: patch Priority: high | Milestone: 8.4.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 -------------------------------------+------------------------------------- Changes (by bgamari): * status: new => patch * differential: Phab:D4065 => Phab:D4065, Phab:D4067 Comment: Alright, I believe the combination of Phab:D4065 and Phab:D4067 should nail this. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 4 07:51:45 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 04 Oct 2017 07:51:45 -0000 Subject: [GHC] #14266: AllowAmbiguousTypes doesn't play well with default class methods In-Reply-To: <051.38c1a194c842b23e120b2589c2db8665@haskell.org> References: <051.38c1a194c842b23e120b2589c2db8665@haskell.org> Message-ID: <066.15b998eb9609d9d1d58fd7799605a559@haskell.org> #14266: AllowAmbiguousTypes doesn't play well with default class methods -------------------------------------+------------------------------------- Reporter: chris-martin | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.0.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): Re comment:15; ah yes, I see, thanks. I was writing in response to comment:4. However, note that * All I wrote in comment:10 applies regardless of any stuff to do with type patterns. If you write an instance sig, it needs to be matched up with the class decl. * If you ''do'' write an instance sig, then the difficulties of comment:15 can be dealt with by emitting a suitable instance sig, which in turn supports visible type application. So I still say that comment:10 describes the number-1 problem. Yes, type patterns might be nice too. The last para of comment:10 describes a solution that might be workable -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 4 09:38:38 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 04 Oct 2017 09:38:38 -0000 Subject: [GHC] #14279: Type families interfere with specialisation rewrite rules In-Reply-To: <051.c770f0db94d1fbd7b1e66a5d39f244a4@haskell.org> References: <051.c770f0db94d1fbd7b1e66a5d39f244a4@haskell.org> Message-ID: <066.ed532a4158c142df6bd4814719b39e06@haskell.org> #14279: Type families interfere with specialisation rewrite rules -------------------------------------+------------------------------------- Reporter: IvanTimokhin | 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: Other | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): But the LHS of the rule does ''not'' mention a type family, so comment:3 is irrelevant to this particular ticket. Here is the rule: {{{ ==================== Tidy Core rules ==================== "vinr/0" forall (@ (as :: [*])). vinr @ '[] @ as = (vinr0 @ as) `cast` (_R ->_R _R ->_R (VSum (Sym (D:R:++[0] _N)))_R :: Coercible (Length '[] -> VSum as -> VSum as) (Length '[] -> VSum as -> VSum ('[] ++ as))) }}} The trouble is that type family appears in the term we are matching the rule against. And it appears in the form `Remove 'Z '[Int]`. We can reduce that to `'[]`, which matches the rule. But we don't: hence my suggestions in comment:2. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 4 09:57:23 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 04 Oct 2017 09:57:23 -0000 Subject: =?utf-8?b?UmU6IFtHSENdICMxNDMxMzog4oCcUmVzdWx0IHNpZ25hdHVyZXMg?= =?utf-8?q?are_no_longer_supported_in_pattern_matches=E2=80=9D_lo?= =?utf-8?q?st?= In-Reply-To: <046.f81b72f51154afa43f3605001c35a3f2@haskell.org> References: <046.f81b72f51154afa43f3605001c35a3f2@haskell.org> Message-ID: <061.a6e77e1404fb46b6a0376807883705a5@haskell.org> #14313: “Result signatures are no longer supported in pattern matches” lost -------------------------------------+------------------------------------- Reporter: nomeata | Owner: (none) Type: task | Status: new Priority: low | 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: #2310 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Yes. See also #2310 (9 yrs ago) in which result type signatures are not supported. Let's kill off `m_type` entirely. Can you do that or shall I? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 4 10:29:52 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 04 Oct 2017 10:29:52 -0000 Subject: [GHC] #12747: INLINE vs NOINLINE vs give three different results; two would be better In-Reply-To: <054.339f6462cfb9fb131ebe3aa0fa842cb7@haskell.org> References: <054.339f6462cfb9fb131ebe3aa0fa842cb7@haskell.org> Message-ID: <069.28d8a04c485b472a3fc7e6043436dac2@haskell.org> #12747: INLINE vs NOINLINE vs give three different results; two would be better -------------------------------------+------------------------------------- Reporter: MikolajKonarski | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.0.1 Resolution: | Keywords: Inlining Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #12603 #12781 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by mpickering): * keywords: => Inlining -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 4 12:00:13 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 04 Oct 2017 12:00:13 -0000 Subject: [GHC] #14231: Core lint error "in result of Static argument" In-Reply-To: <049.27a154799be5fe4aee7dcfb662d1a005@haskell.org> References: <049.27a154799be5fe4aee7dcfb662d1a005@haskell.org> Message-ID: <064.86fba813ca2fe42c97dc46b5ef9506d7@haskell.org> #14231: Core lint error "in result of Static argument" -------------------------------------+------------------------------------- Reporter: mpickering | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: | Keywords: | StaticArgumentTransformation 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): > Would that be preferable here as well? I'm not sure. If it's still relevant, could you give a standalone example to show what you mean? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 4 12:19:54 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 04 Oct 2017 12:19:54 -0000 Subject: [GHC] #14307: NamedFieldPuns should allow "ambiguous" field names In-Reply-To: <046.4bb60103aff0450ac9d1c7696050c9a0@haskell.org> References: <046.4bb60103aff0450ac9d1c7696050c9a0@haskell.org> Message-ID: <061.d2d3f5290b679ca074e2ea1051d88572@haskell.org> #14307: NamedFieldPuns should allow "ambiguous" field names -------------------------------------+------------------------------------- Reporter: mgsloan | Owner: (none) Type: feature request | Status: closed Priority: low | Milestone: Component: Compiler | Version: 8.2.1 Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: | rename/should_fail/T14307 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): > Perhaps the error message could mention the extension since it's a rarer one? That's a good idea, but as the code stands it would be fiddly to implement. I had a look at the tricky logic in `RnEnv.lookupSubBndrOcc_helper` and backed off. Surely this code can be made more perspicuous! If anyone wants to have a go I'd be happy to help. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 4 12:20:06 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 04 Oct 2017 12:20:06 -0000 Subject: [GHC] #14307: NamedFieldPuns should allow "ambiguous" field names In-Reply-To: <046.4bb60103aff0450ac9d1c7696050c9a0@haskell.org> References: <046.4bb60103aff0450ac9d1c7696050c9a0@haskell.org> Message-ID: <061.279cfa5d58cd22a2312831257d81d26e@haskell.org> #14307: NamedFieldPuns should allow "ambiguous" field names -------------------------------------+------------------------------------- Reporter: mgsloan | Owner: (none) Type: feature request | Status: new Priority: low | Milestone: Component: Compiler | Version: 8.2.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: | rename/should_fail/T14307 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * status: closed => new * resolution: fixed => -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 4 12:37:53 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 04 Oct 2017 12:37:53 -0000 Subject: [GHC] #14310: Assertion triggered by STM invariant. In-Reply-To: <042.9c3fac38bbd2247bedc1f2616e6e2820@haskell.org> References: <042.9c3fac38bbd2247bedc1f2616e6e2820@haskell.org> Message-ID: <057.64f1a757404dbcf3b4d5d1ea64376b77@haskell.org> #14310: Assertion triggered by STM invariant. -------------------------------------+------------------------------------- Reporter: mbw | Owner: (none) Type: bug | Status: patch Priority: high | Milestone: 8.4.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 -------------------------------------+------------------------------------- Comment (by fryguybob): I'll take a look at this later today. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 4 12:42:46 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 04 Oct 2017 12:42:46 -0000 Subject: [GHC] #14310: Assertion triggered by STM invariant. In-Reply-To: <042.9c3fac38bbd2247bedc1f2616e6e2820@haskell.org> References: <042.9c3fac38bbd2247bedc1f2616e6e2820@haskell.org> Message-ID: <057.1fc681de70f49a7d4ceb10a28b96feb2@haskell.org> #14310: Assertion triggered by STM invariant. -------------------------------------+------------------------------------- Reporter: mbw | Owner: (none) Type: bug | Status: patch Priority: high | Milestone: 8.4.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 -------------------------------------+------------------------------------- Comment (by bgamari): For what it's worth, I left the testcase, compiled with these patches, running in a loop overnight. It still had not crashed this morning. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 4 12:47:06 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 04 Oct 2017 12:47:06 -0000 Subject: [GHC] #14307: NamedFieldPuns should allow "ambiguous" field names In-Reply-To: <046.4bb60103aff0450ac9d1c7696050c9a0@haskell.org> References: <046.4bb60103aff0450ac9d1c7696050c9a0@haskell.org> Message-ID: <061.5a29e823a115d9adce6cebff5dbe2c77@haskell.org> #14307: NamedFieldPuns should allow "ambiguous" field names -------------------------------------+------------------------------------- Reporter: mgsloan | Owner: (none) Type: feature request | Status: new Priority: low | Milestone: Component: Compiler | Version: 8.2.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: | rename/should_fail/T14307 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by mpickering): I've refactored that function once recently and I think the logic in this area is inherently tricky! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 4 13:12:28 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 04 Oct 2017 13:12:28 -0000 Subject: [GHC] #14314: Consider changing CC detection strategy Message-ID: <046.f2f957a6c1f36f56b761cd38af9c581b@haskell.org> #14314: Consider changing CC detection strategy -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- Currently we grep through the `$CC --version` output to identify the C compiler (see `FP_GCC_VERSION` in `aclocal.m4`). This is error prone (see Phab:D4069). Phyx suggests that we instead just rely on CPP macros. There is a handy list of these [[https://sourceforge.net/p/predef/wiki/Compilers/|here]]. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 4 13:22:39 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 04 Oct 2017 13:22:39 -0000 Subject: [GHC] #11721: GADT-syntax data constructors don't work well with TypeApplications In-Reply-To: <047.d3cda57aa918919c3cdf02eb21c0a581@haskell.org> References: <047.d3cda57aa918919c3cdf02eb21c0a581@haskell.org> Message-ID: <062.a651bf77231215b8b7d82e72a98d510f@haskell.org> #11721: GADT-syntax data constructors don't work well with TypeApplications -------------------------------------+------------------------------------- Reporter: goldfire | Owner: RyanGlScott Type: bug | Status: closed Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.1 Resolution: fixed | Keywords: | TypeApplications Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #13848, #12025 | Differential Rev(s): Phab:D3687, Wiki Page: | Phab:D4070 -------------------------------------+------------------------------------- Changes (by RyanGlScott): * differential: Phab:D3687 => Phab:D3687, Phab:D4070 Comment: Phab:D4070 updates Template Haskell accordingly. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 4 14:02:34 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 04 Oct 2017 14:02:34 -0000 Subject: [GHC] #13990: Core Lint error on empty case In-Reply-To: <047.23c384a179f5b63bb15fe7bf4b3c30b5@haskell.org> References: <047.23c384a179f5b63bb15fe7bf4b3c30b5@haskell.org> Message-ID: <062.59f5df004a745d3489ed0f8dc3513d00@haskell.org> #13990: Core Lint error on empty case -------------------------------------+------------------------------------- Reporter: mbieleck | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.2.3 Component: Compiler | Version: 8.2.1-rc3 Resolution: | Keywords: core-lint | case 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 bgamari): * milestone: 8.2.2 => 8.2.3 Comment: It doesn't seem like this will happen for 8.2.2. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 4 14:03:17 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 04 Oct 2017 14:03:17 -0000 Subject: [GHC] #11959: Importing doubly exported pattern synonym and associated pattern synonym panics In-Reply-To: <046.6ec5a340ae5bc3bfa0a1a054dcc8ecc7@haskell.org> References: <046.6ec5a340ae5bc3bfa0a1a054dcc8ecc7@haskell.org> Message-ID: <061.045f43a06da5df150007d651fd5cbf61@haskell.org> #11959: Importing doubly exported pattern synonym and associated pattern synonym panics -------------------------------------+------------------------------------- Reporter: darchon | Owner: (none) Type: bug | Status: new Priority: high | Milestone: 8.2.3 Component: Compiler | Version: 8.0.1-rc3 Resolution: | Keywords: | PatternSynonyms Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D2132, Wiki Page: | Phab:D2133 -------------------------------------+------------------------------------- Changes (by bgamari): * milestone: 8.2.2 => 8.2.3 Comment: Sadly this won't be fixed for 8.2.2 either. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 4 14:16:27 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 04 Oct 2017 14:16:27 -0000 Subject: [GHC] #14315: GHC panic caused by destructuring with qualified name Message-ID: <044.26f17c3ac52a90e1d1e8dba16c816fb3@haskell.org> #14315: GHC panic caused by destructuring with qualified name ----------------------------------------+--------------------------------- Reporter: bloxx | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Keywords: | Operating System: Linux Architecture: Unknown/Multiple | Type of failure: None/Unknown Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: ----------------------------------------+--------------------------------- I have a cabal project with the following files: {{{#!hs -- src/Alt.hs module Alt where data Pizza = Pizza { filling :: String } -- =========== -- src/Main.hs module Main where import qualified Alt as A data Pizza = Pizza { filling :: String } unpizza :: A.Pizza -> String -- to fix it, replace "filling" with "A.filling" unpizza A.Pizza { filling = filling } = filling main :: IO () main = putStrLn "Hello Haskell!" }}} Of course, this is not valid code. "filling" belongs to "Pizza" and "A.filling" belongs to "A.Pizza". But it causes a panic in GHC 8.2.1 instead of an error, so I suppose it is a bug. Can you reproduce this behavior? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 4 14:16:54 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 04 Oct 2017 14:16:54 -0000 Subject: [GHC] #14315: GHC panic caused by destructuring with qualified name In-Reply-To: <044.26f17c3ac52a90e1d1e8dba16c816fb3@haskell.org> References: <044.26f17c3ac52a90e1d1e8dba16c816fb3@haskell.org> Message-ID: <059.a8a7ada00fd0ee30f658fcfa163c3047@haskell.org> #14315: GHC panic caused by destructuring with qualified name -------------------------------------+------------------------------------- Reporter: bloxx | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: | Keywords: Operating System: Linux | 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 bloxx): * failure: None/Unknown => Compile-time crash or panic -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 4 14:19:37 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 04 Oct 2017 14:19:37 -0000 Subject: [GHC] #14315: GHC panic caused by destructuring with qualified name In-Reply-To: <044.26f17c3ac52a90e1d1e8dba16c816fb3@haskell.org> References: <044.26f17c3ac52a90e1d1e8dba16c816fb3@haskell.org> Message-ID: <059.9f9d1b8fa3b67e0c915840d603cdcd3d@haskell.org> #14315: GHC panic caused by destructuring with qualified name -------------------------------------+------------------------------------- Reporter: bloxx | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: | Keywords: Operating System: Linux | Architecture: Other Type of failure: Compile-time | Test Case: crash or panic | Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by bloxx): * architecture: Unknown/Multiple => Other Old description: > I have a cabal project with the following files: > {{{#!hs > -- src/Alt.hs > module Alt where > > data Pizza = Pizza { filling :: String } > > -- =========== > -- src/Main.hs > module Main where > > import qualified Alt as A > > data Pizza = Pizza { filling :: String } > > unpizza :: A.Pizza -> String > -- to fix it, replace "filling" with "A.filling" > unpizza A.Pizza { filling = filling } = filling > > main :: IO () > main = putStrLn "Hello Haskell!" > }}} > > Of course, this is not valid code. "filling" belongs to "Pizza" and > "A.filling" belongs to "A.Pizza". But it causes a panic in GHC 8.2.1 > instead of an error, so I suppose it is a bug. Can you reproduce this > behavior? New description: I have a cabal project with the following files: {{{#!hs -- src/Alt.hs module Alt where data Pizza = Pizza { filling :: String } -- =========== -- src/Main.hs module Main where import qualified Alt as A data Pizza = Pizza { filling :: String } unpizza :: A.Pizza -> String -- to fix it, replace "filling" with "A.filling" unpizza A.Pizza { filling = filling } = filling main :: IO () main = putStrLn "Hello Haskell!" }}} Of course, this is not valid code. "filling" belongs to "Pizza" and "A.filling" belongs to "A.Pizza". But it causes a panic in GHC 8.2.1 instead of an error, so I suppose it is a bug. Can you reproduce this behavior? Edit: GHC tells me: : error: ghc: panic! (the 'impossible' happened) (GHC version 8.2.1 for x86_64-unknown-linux): translateConPatVec: lookup -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 4 14:20:19 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 04 Oct 2017 14:20:19 -0000 Subject: [GHC] #14292: Coercing between constraints of newtypes In-Reply-To: <051.e9d001b6d6e7069b1e2d96a31ac34922@haskell.org> References: <051.e9d001b6d6e7069b1e2d96a31ac34922@haskell.org> Message-ID: <066.7832f2d4b4bc4197027ac4547440bbcd@haskell.org> #14292: Coercing between constraints of newtypes -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 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 vagarenko): * cc: vagarenko (added) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 4 14:28:55 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 04 Oct 2017 14:28:55 -0000 Subject: =?utf-8?b?UmU6IFtHSENdICMxNDMxMzog4oCcUmVzdWx0IHNpZ25hdHVyZXMg?= =?utf-8?q?are_no_longer_supported_in_pattern_matches=E2=80=9D_lo?= =?utf-8?q?st?= In-Reply-To: <046.f81b72f51154afa43f3605001c35a3f2@haskell.org> References: <046.f81b72f51154afa43f3605001c35a3f2@haskell.org> Message-ID: <061.3ab32111c57dc48dee91d35a4052012a@haskell.org> #14313: “Result signatures are no longer supported in pattern matches” lost -------------------------------------+------------------------------------- Reporter: nomeata | Owner: nomeata Type: task | Status: new Priority: low | 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: #2310 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by nomeata): * owner: (none) => nomeata Comment: I’ll give it a shot. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 4 14:46:13 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 04 Oct 2017 14:46:13 -0000 Subject: [GHC] #13652: Add integer division to GHC.TypeLits In-Reply-To: <048.b9612e3f8a829526a91743f198cf1ed8@haskell.org> References: <048.b9612e3f8a829526a91743f198cf1ed8@haskell.org> Message-ID: <063.7e34f921995005373a6eab0fa4a4a274@haskell.org> #13652: Add integer division to GHC.TypeLits -------------------------------------+------------------------------------- Reporter: vagarenko | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Core Libraries | 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 vagarenko): Replying to [comment:2 RyanGlScott]: > one could define DivMod in terms of Div and Mod like this: {{{#!hs type DivMod a b = (Div a b, Mod a b) }}} ? Why would it be less performant than baked in `DivMod`? Because `a` and `b` would be reduced twice? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 4 14:46:52 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 04 Oct 2017 14:46:52 -0000 Subject: [GHC] #13652: Add integer division to GHC.TypeLits In-Reply-To: <048.b9612e3f8a829526a91743f198cf1ed8@haskell.org> References: <048.b9612e3f8a829526a91743f198cf1ed8@haskell.org> Message-ID: <063.a08d6d17f146d2c0a0228517b9069c62@haskell.org> #13652: Add integer division to GHC.TypeLits -------------------------------------+------------------------------------- Reporter: vagarenko | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Core Libraries | 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): D4002 Wiki Page: | -------------------------------------+------------------------------------- Changes (by vagarenko): * differential: => D4002 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 4 14:52:25 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 04 Oct 2017 14:52:25 -0000 Subject: [GHC] #14316: Precedence of type-level operators Message-ID: <048.ecc056a771d599ed97d05ecbecba044c@haskell.org> #14316: Precedence of type-level operators -------------------------------------+------------------------------------- Reporter: lspitzner | Owner: (none) Type: feature | Status: new request | Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Keywords: precedence | Operating System: Unknown/Multiple TypeOperators DataKinds | Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- `a ': b ~ c ': d` seems to be parsed as `a ': (b ~ (c ': d))`. This is kind of unfortunate; It seems to me that (~) having a lower precedence would make more sense, i.e. have it parse as `(a ': b) ~ (c ': d)`. What //are// the precedences of (~) and XDataKind-lifted operators? The userguide mentions precedences when discussing TypeOperators, but not in combination with DataKinds, or the type-equality-constraint. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 4 15:13:18 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 04 Oct 2017 15:13:18 -0000 Subject: [GHC] #14315: GHC panic caused by destructuring with qualified name In-Reply-To: <044.26f17c3ac52a90e1d1e8dba16c816fb3@haskell.org> References: <044.26f17c3ac52a90e1d1e8dba16c816fb3@haskell.org> Message-ID: <059.0e64463cd1690d06c7771ee8d55db16f@haskell.org> #14315: GHC panic caused by destructuring with qualified name -------------------------------------+------------------------------------- Reporter: bloxx | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: duplicate | Keywords: Operating System: Linux | Architecture: Other Type of failure: Compile-time | Test Case: crash or panic | Blocked By: | Blocking: Related Tickets: #13644 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * status: new => closed * resolution: => duplicate * related: => #13644 Comment: Thanks for the bug report. This is a duplicate of #13644, and has been fixed in GHC 8.4. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 4 15:28:30 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 04 Oct 2017 15:28:30 -0000 Subject: =?utf-8?b?UmU6IFtHSENdICMxNDMxMzog4oCcUmVzdWx0IHNpZ25hdHVyZXMg?= =?utf-8?q?are_no_longer_supported_in_pattern_matches=E2=80=9D_lo?= =?utf-8?q?st?= In-Reply-To: <046.f81b72f51154afa43f3605001c35a3f2@haskell.org> References: <046.f81b72f51154afa43f3605001c35a3f2@haskell.org> Message-ID: <061.323141695c63380b5f99b80992e5f562@haskell.org> #14313: “Result signatures are no longer supported in pattern matches” lost -------------------------------------+------------------------------------- Reporter: nomeata | Owner: nomeata Type: task | Status: patch Priority: low | 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: #2310 | Differential Rev(s): Phab:D4066 Wiki Page: | -------------------------------------+------------------------------------- Changes (by nomeata): * status: new => patch * differential: => Phab:D4066 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 4 16:03:22 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 04 Oct 2017 16:03:22 -0000 Subject: [GHC] #14317: Solve Coercible constraints over type constructors Message-ID: <051.6e7c0afa9b7a89daa70b165c438f90b5@haskell.org> #14317: Solve Coercible constraints over type constructors -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: feature | Status: new request | Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- The core question is, could `fails` type check? {{{#!hs import Data.Type.Coercion works :: Identity a `Coercion` Compose Identity Identity a works = Coercion -- • Couldn't match representation of type ‘Identity’ -- with that of ‘Compose Identity Identity’ -- arising from a use of ‘Coercion’ -- • In the expression: -- Coercion :: Identity `Coercion` Compose Identity Identity fails :: Identity `Coercion` Compose Identity Identity fails = Coercion }}} ---- This arises from playing with [https://duplode.github.io/posts/traversable-a-remix.html Traversable: A Remix]. Given `coerce :: Compose Identity Identity ~> Identity` I wanted to capture that `id1` and `id2` are actually the same arrow (up to representation) {{{#!hs (<%<) :: (Functor f, Functor g) => (b -> g c) -> (a -> f b) -> (a -> Compose f g c) g <%< f = Compose . fmap g . f id1 :: a -> Identity a id1 = Identity id2 :: a -> Compose Identity Identity a id2 = Identity <%< Identity }}} So I define {{{#!hs data F :: (k -> Type) -> (Type -> k -> Type) where MkF :: Coercible f f' => (a -> f' b) -> F f a b id1F :: Coercible Identity f => F f a a id1F = MkF id1 id2F :: Coercible (Compose Identity Identity) f => F f b b id2F = MkF id2 }}} but we can not unify the types of `id1F` and `id2F`. Does this require quantified class constraints? I'm not sure where they would go -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 4 16:04:31 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 04 Oct 2017 16:04:31 -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.9c20db506045d22acba65ff2616cd720@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, | 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: => Roles, QuantifiedContexts -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 4 16:23:00 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 04 Oct 2017 16:23:00 -0000 Subject: [GHC] #14318: TH shadowing bind statement triggers -Wunused-matches Message-ID: <044.951fdf427e51c6e07b18c7fa19ddd812@haskell.org> #14318: TH shadowing bind statement triggers -Wunused-matches -------------------------------------+------------------------------------- Reporter: lyxia | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Template | Version: 8.2.1 Haskell | 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: -------------------------------------+------------------------------------- {{{ $(newName "x" >>= \x -> newName "f" >>= \f -> lamE [varP f, varP x] (doE [ bindS (varP x) (listE [varE f `appE` varE x]) , noBindS (varE x)]) ) }}} generates the following expression: {{{ \f x -> do x <- f x x }}} and `-Wunused-matches` complains that `x` is not used, while both bound occurrences are in fact used. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 4 16:54:22 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 04 Oct 2017 16:54:22 -0000 Subject: [GHC] #14319: Stuck kind families can lead to lousy error messages Message-ID: <045.325a1c439073c01e464a5d95796bd31d@haskell.org> #14319: Stuck kind families can lead to lousy error messages -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.3 (Type checker) | Keywords: TypeInType, | Operating System: Unknown/Multiple TypeFamilies | Architecture: | Type of failure: Poor/confusing Unknown/Multiple | error message Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- {{{#!hs {-# language TypeFamilies, TypeInType, ScopedTypeVariables #-} module ArityError where import Data.Kind import GHC.TypeLits import Data.Proxy type family F (s :: Symbol) :: Type type family G (s :: Symbol) :: F s type instance G "Hi" = Maybe }}} This produces the error message {{{#!hs ArityError.hs:10:24: error: • Expecting one more argument to ‘Maybe’ Expected kind ‘F "Hi"’, but ‘Maybe’ has kind ‘* -> *’ • In the type ‘Maybe’ In the type instance declaration for ‘G’ | 10 | type instance G "Hi" = Maybe | ^^^^^ }}} This looks utterly bogus: `F "Hi"` is stuck, so we have no idea what arity it indicates. What I ''think'' is a term level version of this, {{{#!hs f :: forall (s :: Symbol). Proxy s -> F s f _ = Just }}} gives a much less confusing message: {{{ ArityError.hs:14:7: error: • Couldn't match expected type ‘F s’ with actual type ‘a0 -> Maybe a0’ The type variable ‘a0’ is ambiguous • In the expression: Just In an equation for ‘f’: f _ = Just • Relevant bindings include f :: Proxy s -> F s (bound at ArityError.hs:14:1) | 14 | f _ = Just | ^^^^ }}} The fix (I think) is to refrain from reporting arity errors when we don't know enough about the relevant arities. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 4 16:57:51 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 04 Oct 2017 16:57:51 -0000 Subject: [GHC] #14319: Stuck kind families can lead to lousy error messages In-Reply-To: <045.325a1c439073c01e464a5d95796bd31d@haskell.org> References: <045.325a1c439073c01e464a5d95796bd31d@haskell.org> Message-ID: <060.feec8048bd402a261a91733168f0d8ca@haskell.org> #14319: Stuck kind families can lead to lousy error messages -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.4.1 Component: Compiler (Type | Version: 8.3 checker) | Keywords: TypeInType, Resolution: | TypeFamilies 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 dfeuer): Actually, no. I can get just as bad an error message at the term level: {{{#!hs f :: forall (s :: Symbol). Proxy s -> F s f _ _ = undefined }}} produces {{{ ArityError.hs:14:1: error: • Couldn't match expected type ‘F s’ with actual type ‘p0 -> a0’ The type variables ‘p0’, ‘a0’ are ambiguous • The equation(s) for ‘f’ have two arguments, but its type ‘Proxy s -> F s’ has only one • Relevant bindings include f :: Proxy s -> F s (bound at ArityError.hs:14:1) | 14 | f _ _ = undefined | ^^^^^^^^^^^^^^^^^ }}} So we have the same problem there. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 4 17:00:48 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 04 Oct 2017 17:00:48 -0000 Subject: [GHC] #14319: Stuck type families can lead to lousy error messages (was: Stuck kind families can lead to lousy error messages) In-Reply-To: <045.325a1c439073c01e464a5d95796bd31d@haskell.org> References: <045.325a1c439073c01e464a5d95796bd31d@haskell.org> Message-ID: <060.38fba9df508d28f79f8f05e3e61f54bd@haskell.org> #14319: Stuck type families can lead to lousy error messages -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.4.1 Component: Compiler (Type | Version: 8.3 checker) | Keywords: TypeInType, Resolution: | TypeFamilies 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: | -------------------------------------+------------------------------------- Description changed by dfeuer: Old description: > {{{#!hs > {-# language TypeFamilies, TypeInType, ScopedTypeVariables #-} > > module ArityError where > import Data.Kind > import GHC.TypeLits > import Data.Proxy > > type family F (s :: Symbol) :: Type > type family G (s :: Symbol) :: F s > type instance G "Hi" = Maybe > }}} > > This produces the error message > > {{{#!hs > ArityError.hs:10:24: error: > • Expecting one more argument to ‘Maybe’ > Expected kind ‘F "Hi"’, but ‘Maybe’ has kind ‘* -> *’ > • In the type ‘Maybe’ > In the type instance declaration for ‘G’ > | > 10 | type instance G "Hi" = Maybe > | ^^^^^ > }}} > > This looks utterly bogus: `F "Hi"` is stuck, so we have no idea what > arity it indicates. What I ''think'' is a term level version of this, > > {{{#!hs > f :: forall (s :: Symbol). Proxy s -> F s > f _ = Just > }}} > > gives a much less confusing message: > > {{{ > ArityError.hs:14:7: error: > • Couldn't match expected type ‘F s’ > with actual type ‘a0 -> Maybe a0’ > The type variable ‘a0’ is ambiguous > • In the expression: Just > In an equation for ‘f’: f _ = Just > • Relevant bindings include > f :: Proxy s -> F s (bound at ArityError.hs:14:1) > | > 14 | f _ = Just > | ^^^^ > }}} > > The fix (I think) is to refrain from reporting arity errors when we don't > know enough about the relevant arities. New description: I first noticed this problem at the type level: {{{#!hs {-# language TypeFamilies, TypeInType, ScopedTypeVariables #-} module ArityError where import Data.Kind import GHC.TypeLits import Data.Proxy type family F (s :: Symbol) :: Type type family G (s :: Symbol) :: F s type instance G "Hi" = Maybe }}} This produces the error message {{{#!hs ArityError.hs:10:24: error: • Expecting one more argument to ‘Maybe’ Expected kind ‘F "Hi"’, but ‘Maybe’ has kind ‘* -> *’ • In the type ‘Maybe’ In the type instance declaration for ‘G’ | 10 | type instance G "Hi" = Maybe | ^^^^^ }}} This looks utterly bogus: `F "Hi"` is stuck, so we have no idea what arity it indicates. ---- I just realized we have a similar problem at the term level: {{{#!hs f :: forall (s :: Symbol). Proxy s -> F s f _ _ = undefined }}} produces {{{#!hs ArityError.hs:14:1: error: • Couldn't match expected type ‘F s’ with actual type ‘p0 -> a0’ The type variables ‘p0’, ‘a0’ are ambiguous • The equation(s) for ‘f’ have two arguments, but its type ‘Proxy s -> F s’ has only one • Relevant bindings include f :: Proxy s -> F s (bound at ArityError.hs:14:1) | 14 | f _ _ = undefined | ^^^^^^^^^^^^^^^^^ }}} The claim that `Proxy s -> F s` has only one argument is bogus; we only know that it has ''at least'' one argument. The fix (I imagine) is to refrain from reporting arity errors when we don't know enough about the relevant arities. -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 4 17:02:56 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 04 Oct 2017 17:02:56 -0000 Subject: [GHC] #14316: Precedence of type-level operators In-Reply-To: <048.ecc056a771d599ed97d05ecbecba044c@haskell.org> References: <048.ecc056a771d599ed97d05ecbecba044c@haskell.org> Message-ID: <063.f3389c8b5a2e0b6acd88cf9bf9652704@haskell.org> #14316: Precedence of type-level operators -------------------------------------+------------------------------------- Reporter: lspitzner | Owner: (none) Type: feature request | Status: closed Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: duplicate | Keywords: precedence | TypeOperators DataKinds Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #10056, #10059, | Differential Rev(s): #10431 | Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * status: new => closed * resolution: => duplicate * related: => #10056, #10059, #10431 Comment: There are two questions here: 1. What are the precedences of data constructors that are promoted to types via `DataKinds`? This has a simple answer: they have the same precedences as their value-level counterparts. Since `(:)` is `infixr 5` at the value level, `'(:)` is also `infixr 5` at the type level. 2. What is the precedence of `(~)`? Alas, this is a simple question with an ugly answer. For unfortunate historical reasons, `(~)` is not a proper type operator, but rather a specially parsed symbol that happens to //look// like a type operator. As such, it does not have a well defined precedence (#10056), and you can't even ask GHCi for its precedence with `:info` (#10059). This is obviously not a great situation, since it leads to all sorts of confusing parser oddities like the one observed here. The plan laid out in #10056 will hopefully make the story a little more palatable. The plan is (roughly): * Remove as much special treatment for `(~)` from the parser as possible * Define `(~)` as a plain old type operator somewhere in `base`. For backwards compatibility purposes, this will probably need to always be in scope (otherwise, it'd be possible to hide it via Haskell's module system, which is something that you can't do with `(~)` today). * Give `(~)` a precedence of `infix -1` (i.e., lower than `(->)`). * Enable the use of `(~)` via a new language extension (`-XEqualityConstraints` has been proposed in #10431). For backwards compatibility, `-XGADTs` and `-XTypeFamilies` would also continue to allow the use of `(~)`. Given that this ticket is essentially just a symptom of #10056, I'll close this as a duplicate in favor of #10056. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 4 17:03:33 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 04 Oct 2017 17:03:33 -0000 Subject: [GHC] #10056: Inconsistent precedence of ~ In-Reply-To: <047.6a12b15cc084aa108be95f499dfa0014@haskell.org> References: <047.6a12b15cc084aa108be95f499dfa0014@haskell.org> Message-ID: <062.93e3a78b7d50d1a66a9d3a56f17d2284@haskell.org> #10056: Inconsistent precedence of ~ -------------------------------------+------------------------------------- Reporter: crockeea | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.8.4 (Parser) | Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: GHC rejects | Unknown/Multiple valid program | Test Case: Blocked By: | Blocking: Related Tickets: #10059, #10431, | Differential Rev(s): #14316 | Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * related: #10059, #10431 => #10059, #10431, #14316 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 4 17:07:02 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 04 Oct 2017 17:07:02 -0000 Subject: [GHC] #13652: Add integer division to GHC.TypeLits In-Reply-To: <048.b9612e3f8a829526a91743f198cf1ed8@haskell.org> References: <048.b9612e3f8a829526a91743f198cf1ed8@haskell.org> Message-ID: <063.d3ae061292333e7317cf7bd6abcb22f6@haskell.org> #13652: Add integer division to GHC.TypeLits -------------------------------------+------------------------------------- Reporter: vagarenko | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Core Libraries | 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): Phab:D4002 Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * differential: D4002 => Phab:D4002 Comment: Replying to [comment:3 vagarenko]: > like this: > {{{#!hs > type DivMod a b = (Div a b, Mod a b) > }}} > ? Yes. > Why would it be less performant than baked in `DivMod`? Because `a` and `b` would be reduced twice? Indeed. Internally, `div` and `mod` (on which the type-level `Div` and `Mod` are based) are defined in terms of `divMod`, so this definition of `DivMod` would likely compute `divMod` twice. I can't give you an accurate estimate of how many CPU cycles that would waste, but there is certainly some inefficiency there. But then again, this is your feature request, so I'll leave the final call up to you. Is the status quo (having just `Div` and `Mod`) acceptable for you? Or do you want to see `base` have the full trifecta of `Div`, `Mod`, and `DivMod`, each of which are based on their respective machine arithmetic operations? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 4 17:31:27 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 04 Oct 2017 17:31:27 -0000 Subject: [GHC] #14316: Precedence of type-level operators In-Reply-To: <048.ecc056a771d599ed97d05ecbecba044c@haskell.org> References: <048.ecc056a771d599ed97d05ecbecba044c@haskell.org> Message-ID: <063.ae61d6398d5e9ebb9d63807afd632d34@haskell.org> #14316: Precedence of type-level operators -------------------------------------+------------------------------------- Reporter: lspitzner | Owner: (none) Type: feature request | Status: closed Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: duplicate | Keywords: precedence | TypeOperators DataKinds Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #10056, #10059, | Differential Rev(s): #10431 | Wiki Page: | -------------------------------------+------------------------------------- Comment (by lspitzner): Sure, thanks for the explanation. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 4 17:44:14 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 04 Oct 2017 17:44:14 -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.4119b8261b77dd3b40569150a687a8c6@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, | 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): You're asking about two different (incomplete) programs, so I'm forced to guess at what your intention was. I'll tackle them in reverse order. For the second program, I'm guessing this is what you meant? I had to add some imports and language extensions to make this go through: {{{#!hs {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE PolyKinds #-} import Data.Coerce import Data.Functor.Compose import Data.Functor.Identity import Data.Kind (<%<) :: (Functor f, Functor g) => (b -> g c) -> (a -> f b) -> (a -> Compose f g c) g <%< f = Compose . fmap g . f id1 :: a -> Identity a id1 = Identity id2 :: a -> Compose Identity Identity a id2 = Identity <%< Identity data F :: (k -> Type) -> (Type -> k -> Type) where MkF :: Coercible f f' => (a -> f' b) -> F f a b id1F :: Coercible Identity f => F f a a id1F = MkF id1 id2F :: Coercible (Compose Identity Identity) f => F f b b id2F = MkF id2 }}} But importantly, this program does typecheck! So I'm not sure what bug you're alluding to here. (You mention "we can not unify the types of `id1F` and `id2F`", but I'm not sure what is meant by that statement.) For the first program, I also needed to add some imports and language extensions: {{{#!hs {-# LANGUAGE TypeOperators #-} import Data.Functor.Compose import Data.Functor.Identity import Data.Type.Coercion works :: Identity a `Coercion` Compose Identity Identity a works = Coercion fails :: Identity `Coercion` Compose Identity Identity fails = Coercion }}} But this time, I can reproduce the error you reported for this program. The error is right on the mark—you can't `coerce` between `Identity` and `Compose Identity Identity` because they're not representationally equal. Full stop. Try as you might, there's no way to derive a `Coercible Identity (Compose Identity Identity)` constraint. I think you might be inclined to believe that because `Identity a` is representationally equal to `(Compose Identity Identity) a`, that GHC can conclude that `Identity` is representationally equal to `Compose Identity Identity`. But to my knowledge, there's no reasoning principle which states that `f a ~R g a` implies `f ~R g`. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 4 18:01:50 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 04 Oct 2017 18:01:50 -0000 Subject: [GHC] #14320: Brackets change meaning of value-constructor type Message-ID: <041.3c8f20a47f3244d2b4af7e2826cc272d@haskell.org> #14320: Brackets change meaning of value-constructor type -------------------------------------+------------------------------------- Reporter: nr | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 (Type checker) | Keywords: GADT, | Operating System: Linux existential type | Architecture: x86_64 | Type of failure: GHC rejects (amd64) | valid program Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- Some legacy code from GHC 7.x does not compile under 8.0 or 8.2. The issue seems to be that I have wrapped brackets around the type of a value constructor, and 8.x does not want to see those brackets. To try to learn if this change was deliberate, I have searched the release notes. Found nothing. I am hoping this is an actual bug, as I would hope to be able to wrap any type or term in brackets without changing its meaning (except of course for fixity). -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 4 18:02:35 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 04 Oct 2017 18:02:35 -0000 Subject: [GHC] #14320: Brackets change meaning of value-constructor type In-Reply-To: <041.3c8f20a47f3244d2b4af7e2826cc272d@haskell.org> References: <041.3c8f20a47f3244d2b4af7e2826cc272d@haskell.org> Message-ID: <056.11a4ed0d8205d90a5f71e4a43748db3b@haskell.org> #14320: Brackets change meaning of value-constructor type -------------------------------------+------------------------------------- Reporter: nr | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.2.1 checker) | Keywords: GADT, Resolution: | existential type Operating System: Linux | Architecture: x86_64 Type of failure: GHC rejects | (amd64) valid program | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by nr): * Attachment "Badgadt.hs" added. Shows value constructor `TEBad`, which should be accepted but isn't. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 4 18:44:28 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 04 Oct 2017 18:44:28 -0000 Subject: [GHC] #14321: -fsolve-constant-dicts is not very robust when dealing with GADTs Message-ID: <049.8d1618ab392fdd059f93e4254ed0603b@haskell.org> #14321: -fsolve-constant-dicts is not very robust when dealing with GADTs -------------------------------------+------------------------------------- Reporter: mpickering | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: #9701 Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- I expected `-fsolve-constant-dicts` to nail #9701, it didn't fire at all but a slightly modified version does. {{{ {-# LANGUAGE GADTs #-} {-# LANGUAGE TypeApplications #-} module Foo where data Silly a where Silly :: Ord a => a -> Silly a isItSilly :: a -> Silly a -> Bool isItSilly a (Silly x) = a < x isItSillyIntTA :: Int -> Silly Int -> Bool isItSillyIntTA = isItSilly @Int isItSillyInt :: Int -> Silly Int -> Bool isItSillyInt a x = isItSilly a x isItSillyInt2 :: Int -> Silly Int -> Bool isItSillyInt2 a (Silly x) = a < x isItSillyInt3 :: Int -> Silly Int -> Bool isItSillyInt3 a (Silly x) = isItSilly a (Silly x) }}} Both versions 2 and 3 specialise nicely using the `Int` `Ord` dictionary. The first two versions don't. I'm unsure whether it *should* fire or not but I am making this ticket to record this fact. Clonable code and core dump - https://gist.github.com/mpickering/f84a5f842861211e8e731c63e82d5c01 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 4 19:04:27 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 04 Oct 2017 19:04:27 -0000 Subject: [GHC] #14320: Brackets change meaning of value-constructor type In-Reply-To: <041.3c8f20a47f3244d2b4af7e2826cc272d@haskell.org> References: <041.3c8f20a47f3244d2b4af7e2826cc272d@haskell.org> Message-ID: <056.0f815da54135f8a9b3bbcedd5d2cfa71@haskell.org> #14320: Brackets change meaning of value-constructor type -------------------------------------+------------------------------------- Reporter: nr | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.2.1 checker) | Keywords: GADT, Resolution: | existential type Operating System: Linux | Architecture: x86_64 Type of failure: GHC rejects | (amd64) valid program | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): Just to make sure: your file has the following GADT: {{{#!hs newtype TypedExpToo :: * -> * where TEBad :: (forall a . (Exp -> (TypedExp a))) }}} Did you mean for `TEBad`'s return type to actually be `TypedExpToo a`? (I'll assume the answer is "yes".) This is another oddity caused by the fact that we validity check GADT constructor type signatures on source syntax instead of Core. In this case, the `HsParTy` constructor is throwing a wrench into things. Supporting this use case doesn't seem like it would be particularly difficult: we'd just need to have `splitLHsForAllTy` and `splitLHsQualTy` looks through parentheses: {{{#!diff diff --git a/compiler/hsSyn/HsTypes.hs b/compiler/hsSyn/HsTypes.hs index b9cd946..1864aa2 100644 --- a/compiler/hsSyn/HsTypes.hs +++ b/compiler/hsSyn/HsTypes.hs @@ -1053,10 +1053,12 @@ splitLHsSigmaTy ty splitLHsForAllTy :: LHsType pass -> ([LHsTyVarBndr pass], LHsType pass) splitLHsForAllTy (L _ (HsForAllTy { hst_bndrs = tvs, hst_body = body })) = (tvs, body) +splitLHsForAllTy (L _ (HsParTy t)) = splitLHsForAllTy t splitLHsForAllTy body = ([], body) splitLHsQualTy :: LHsType pass -> (LHsContext pass, LHsType pass) splitLHsQualTy (L _ (HsQualTy { hst_ctxt = ctxt, hst_body = body })) = (ctxt, body) +splitLHsQualTy (L _ (HsParTy t)) = splitLHsQualTy t splitLHsQualTy body = (noLoc [], body) splitLHsInstDeclTy :: LHsSigType GhcRn }}} This makes `Badgadt.hs` typecheck (after correcting the return type of `TEBad`). Do others think this is reasonable? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 4 19:47:44 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 04 Oct 2017 19:47:44 -0000 Subject: [GHC] #14322: Simplifying an instance context makes a rewrite rule no longer typecheck Message-ID: <050.30330d7e50a52292e871021a8b94cbb6@haskell.org> #14322: Simplifying an instance context makes a rewrite rule no longer typecheck -------------------------------------+------------------------------------- Reporter: RyanGlScott | 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: GHC rejects Unknown/Multiple | valid program Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- This code (taken from the `reducers` package) compiles: {{{#!hs {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} import Prelude (Applicative(..), Functor(..), (.)) class Semigroup m where (<>) :: m -> m -> m class Semigroup m => Reducer c m where snoc :: m -> c -> m newtype Traversal f = Traversal { getTraversal :: f () } instance Applicative f => Semigroup (Traversal f) where Traversal a <> Traversal b = Traversal (a *> b) instance Applicative f => Reducer (f a) (Traversal f) where Traversal a `snoc` b = Traversal (() <$ (a *> b)) snocTraversal :: Reducer (f ()) (Traversal f) => Traversal f -> f () -> Traversal f snocTraversal a = (<>) a . Traversal {-# RULES "snocTraversal" snoc = snocTraversal #-} }}} But on GHC 8.2.1 and later, it gives this warning: {{{ GHCi, version 8.2.1: http://www.haskell.org/ghc/ :? for help Loaded GHCi configuration from /home/rgscott/.ghci [1 of 1] Compiling Main ( Bug.hs, interpreted ) Bug.hs:21:18: warning: [-Wsimplifiable-class-constraints] • The constraint ‘Reducer (f ()) (Traversal f)’ matches an instance declaration instance Applicative f => Reducer (f a) (Traversal f) -- Defined at Bug.hs:18:10 This makes type inference for inner bindings fragile; either use MonoLocalBinds, or simplify it using the instance • In the type signature: snocTraversal :: Reducer (f ()) (Traversal f) => Traversal f -> f () -> Traversal f | 21 | snocTraversal :: Reducer (f ()) (Traversal f) => Traversal f -> f () -> Traversal f | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ }}} I decided to follow GHC's orders and reduce the `Reducer (f ()) (Traversal f)` context to just `Applicative f`: {{{#!hs {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} import Prelude (Applicative(..), Functor(..), (.)) class Semigroup m where (<>) :: m -> m -> m class Semigroup m => Reducer c m where snoc :: m -> c -> m newtype Traversal f = Traversal { getTraversal :: f () } instance Applicative f => Semigroup (Traversal f) where Traversal a <> Traversal b = Traversal (a *> b) instance Applicative f => Reducer (f a) (Traversal f) where Traversal a `snoc` b = Traversal (() <$ (a *> b)) snocTraversal :: Applicative f => Traversal f -> f () -> Traversal f snocTraversal a = (<>) a . Traversal {-# RULES "snocTraversal" snoc = snocTraversal #-} }}} But after doing so, the file no longer typechecks! {{{ GHCi, version 8.2.1: http://www.haskell.org/ghc/ :? for help Loaded GHCi configuration from /home/rgscott/.ghci [1 of 1] Compiling Main ( Bug.hs, interpreted ) Bug.hs:23:34: error: • Could not deduce (Applicative f) arising from a use of ‘snocTraversal’ from the context: Reducer (f ()) (Traversal f) bound by the RULE "snocTraversal" at Bug.hs:23:11-46 Possible fix: add (Applicative f) to the context of the RULE "snocTraversal" • In the expression: snocTraversal When checking the transformation rule "snocTraversal" | 23 | {-# RULES "snocTraversal" snoc = snocTraversal #-} | ^^^^^^^^^^^^^ }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 4 20:09:40 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 04 Oct 2017 20:09:40 -0000 Subject: [GHC] #14321: -fsolve-constant-dicts is not very robust when dealing with GADTs In-Reply-To: <049.8d1618ab392fdd059f93e4254ed0603b@haskell.org> References: <049.8d1618ab392fdd059f93e4254ed0603b@haskell.org> Message-ID: <064.4c6e53779b5672b0ea3ebd4b37bc68a6@haskell.org> #14321: -fsolve-constant-dicts is not very robust when dealing with GADTs -------------------------------------+------------------------------------- Reporter: mpickering | 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: #9701 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): I'm not sure what you are expecting here. `isItSilly` tyepchecks and elaborates thus: {{{ isItSilly (v::a) (Silly (d:: Ord a) (x::a)) = (<) d v x }}} It can't do anyting else. `isItSillyIntTA` is simply a call to `isItSilly`. No dictionaries at all; solving constant dictionries doesn't arise. Ditto `isItSillyInt`. Look as if it's all behaving precisely as advertised. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 4 20:28:00 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 04 Oct 2017 20:28:00 -0000 Subject: [GHC] #14322: Simplifying an instance context makes a rewrite rule no longer typecheck In-Reply-To: <050.30330d7e50a52292e871021a8b94cbb6@haskell.org> References: <050.30330d7e50a52292e871021a8b94cbb6@haskell.org> Message-ID: <065.88fbdf53d85ca93315677cec4af205fc@haskell.org> #14322: Simplifying an instance context makes a rewrite rule no longer typecheck -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.2.1 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 simonpj): Here's a simpler example: {{{ {-# LANGUAGE GADTs, FlexibleContexts, NoMonoLocalBinds #-} data T a where MkT :: Eq a => a -> T a f :: T [b] -> Bool f (MkT xs) = g xs g :: Eq [b] => [b] -> Bool g xs = xs == xs }}} We get {{{ T14322.hs:12:6: warning: [-Wsimplifiable-class-constraints] * The constraint `Eq [b]' matches an instance declaration instance Eq a => Eq [a] -- Defined in `GHC.Classes' This makes type inference for inner bindings fragile; either use MonoLocalBinds, or simplify it using the instance }}} But you can't simplify `g`'s type signature, becuase then at the call site in `f` we get a wanted `Eq a` dictionary which we can't get from a given `Eq [a]` dictionary bound by the existential. The exact same thing is happening with your RULE. I don't see a great solution here. Personally I's use `MonoLocalBinds` to suppress the warning. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 4 20:29:32 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 04 Oct 2017 20:29:32 -0000 Subject: [GHC] #14321: -fsolve-constant-dicts is not very robust when dealing with GADTs In-Reply-To: <049.8d1618ab392fdd059f93e4254ed0603b@haskell.org> References: <049.8d1618ab392fdd059f93e4254ed0603b@haskell.org> Message-ID: <064.ec77825cc441192701c575fd911c4314@haskell.org> #14321: -fsolve-constant-dicts is not very robust when dealing with GADTs -------------------------------------+------------------------------------- Reporter: mpickering | 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: #9701 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by mpickering): In `isItSillyIntTA`, if `isItSilly` was inlined.. {{{ isItSillyIntTA = (\@a1 -> \(a :: a1) -> \(s :: Silly1 a1) -> case s of (Silly1 ($dOrd :: Ord a1) (x :: a1)) -> (< $dOrd) a x) @Int }}} Then beta reduction on the type argument leaves you with {{{ isItSillyIntTA = (\(a : Int) -> \(s :: Silly1 Int) -> case s of (Silly1 ($dOrd :: Ord Int) (x :: Int) -> (< $dOrd) a x)) }}} So is the dictionary not statically known here in the same sense that -fsolve-constant-dicts is meant to solve? I think I am subtly misunderstanding the scope of the flag. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 4 20:29:35 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 04 Oct 2017 20:29:35 -0000 Subject: [GHC] #14320: Brackets change meaning of value-constructor type In-Reply-To: <041.3c8f20a47f3244d2b4af7e2826cc272d@haskell.org> References: <041.3c8f20a47f3244d2b4af7e2826cc272d@haskell.org> Message-ID: <056.48e192dee24245fb8e4f642891a132db@haskell.org> #14320: Brackets change meaning of value-constructor type -------------------------------------+------------------------------------- Reporter: nr | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.2.1 checker) | Keywords: GADT, Resolution: | existential type Operating System: Linux | Architecture: x86_64 Type of failure: GHC rejects | (amd64) valid program | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): I think that'd be good, yes. Parens should not get in the way. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 4 20:32:45 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 04 Oct 2017 20:32:45 -0000 Subject: [GHC] #14321: -fsolve-constant-dicts is not very robust when dealing with GADTs In-Reply-To: <049.8d1618ab392fdd059f93e4254ed0603b@haskell.org> References: <049.8d1618ab392fdd059f93e4254ed0603b@haskell.org> Message-ID: <064.b5821cb9356d783ffe2a9290ea6b855b@haskell.org> #14321: -fsolve-constant-dicts is not very robust when dealing with GADTs -------------------------------------+------------------------------------- Reporter: mpickering | 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: #9701 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): ALl constraint solving is done on the original source programming. No inlining, nothing. When simplification/inlining starts, constraint solving is over. Nothign more than that. The flag controls only what happens at constraint-solving time. Maybe it should be better documented -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 4 20:34:30 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 04 Oct 2017 20:34:30 -0000 Subject: [GHC] #14322: Simplifying an instance context makes a rewrite rule no longer typecheck In-Reply-To: <050.30330d7e50a52292e871021a8b94cbb6@haskell.org> References: <050.30330d7e50a52292e871021a8b94cbb6@haskell.org> Message-ID: <065.683c20847d5693828195b262874b3a13@haskell.org> #14322: Simplifying an instance context makes a rewrite rule no longer typecheck -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: Component: Compiler (Type | Version: 8.2.1 checker) | Resolution: invalid | 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: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * status: new => closed * resolution: => invalid Comment: Very well. I suppose then that the warning is as accurate as it can possibly be in this scenario, since it advertises `MonoLocalBinds`. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 4 20:51:34 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 04 Oct 2017 20:51:34 -0000 Subject: [GHC] #14316: Precedence of type-level operators In-Reply-To: <048.ecc056a771d599ed97d05ecbecba044c@haskell.org> References: <048.ecc056a771d599ed97d05ecbecba044c@haskell.org> Message-ID: <063.13416413ebb44f1c91c13f1f50278b0e@haskell.org> #14316: Precedence of type-level operators -------------------------------------+------------------------------------- Reporter: lspitzner | Owner: (none) Type: feature request | Status: closed Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: duplicate | Keywords: precedence | TypeOperators DataKinds Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #10056, #10059, | Differential Rev(s): #10431 | Wiki Page: | -------------------------------------+------------------------------------- Comment (by Iceland_jack): While the plan is being implemented can some of that be mentioned in `:info ~`? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 4 20:54:09 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 04 Oct 2017 20:54:09 -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.08421b080b9be3715d6d5d9a1cc99161@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, | 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 adamse): Slightly on a tangent but: This program typechecks in 8.0.2 but fails in 8.2.1 {{{#!haskell {-# LANGUAGE TypeOperators #-} {-# LANGUAGE GADTs #-} import Data.Coerce newtype (f ... g) a = C (f (g a)) newtype I a = I a data F f a b where MkF :: Coercible (f b) (f' b) => (a -> f' b) -> F f a b id1 :: a -> I a id1 = I id1F :: Coercible b (f b) => F f b b id1F = MkF I }}} {{{ /Users/adam/src/doodles/co.hs:17:8: error: • Could not deduce: Coercible b (f b) arising from a use of ‘MkF’ from the context: Coercible b (f b) bound by the type signature for: id1F :: forall b (f :: * -> *). Coercible b (f b) => F f b b at /Users/adam/src/doodles/co.hs:16:1-36 ‘b’ is a rigid type variable bound by the type signature for: id1F :: forall b (f :: * -> *). Coercible b (f b) => F f b b at /Users/adam/src/doodles/co.hs:16:1-36 • In the expression: MkF I In an equation for ‘id1F’: id1F = MkF I • Relevant bindings include id1F :: F f b b (bound at /Users/adam/src/doodles/co.hs:17:1) | 17 | id1F = MkF I | ^^^^^ }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 4 21:16:04 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 04 Oct 2017 21:16:04 -0000 Subject: [GHC] #14316: Precedence of type-level operators In-Reply-To: <048.ecc056a771d599ed97d05ecbecba044c@haskell.org> References: <048.ecc056a771d599ed97d05ecbecba044c@haskell.org> Message-ID: <063.a73aef18ee2c094037951098cfcf340e@haskell.org> #14316: Precedence of type-level operators -------------------------------------+------------------------------------- Reporter: lspitzner | Owner: (none) Type: feature request | Status: closed Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: duplicate | Keywords: precedence | TypeOperators DataKinds Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #10056, #10059, | Differential Rev(s): #10431 | Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): The plan as I described it is a summary of the discussion in #10056. #10059 concerns `:info (~)` in particular. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 4 21:28:36 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 04 Oct 2017 21:28:36 -0000 Subject: [GHC] #14320: Brackets change meaning of value-constructor type In-Reply-To: <041.3c8f20a47f3244d2b4af7e2826cc272d@haskell.org> References: <041.3c8f20a47f3244d2b4af7e2826cc272d@haskell.org> Message-ID: <056.b4205db7e31bdf2c1661c8819a1abbd0@haskell.org> #14320: Brackets change meaning of value-constructor type -------------------------------------+------------------------------------- Reporter: nr | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: Component: Compiler (Type | Version: 8.2.1 checker) | Keywords: GADT, Resolution: | existential type 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:D4072 Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * status: new => patch * differential: => Phab:D4072 * os: Linux => Unknown/Multiple * architecture: x86_64 (amd64) => Unknown/Multiple -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 4 22:43:12 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 04 Oct 2017 22:43:12 -0000 Subject: [GHC] #14312: Head does not build on Windows with the default make config. In-Reply-To: <047.086b87bb9b3dcf2f7a921149fa31eda2@haskell.org> References: <047.086b87bb9b3dcf2f7a921149fa31eda2@haskell.org> Message-ID: <062.819231e7b6cdd97309c37a35b35e261d@haskell.org> #14312: Head does not build on Windows with the default make config. -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: (none) Type: bug | Status: upstream Priority: normal | Milestone: Component: Build System | Version: 8.2.1 Resolution: | Keywords: Operating System: Windows | Architecture: Type of failure: Building GHC | Unknown/Multiple failed | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by Phyx-): * status: new => upstream Comment: The first offending command is {{{ "inplace/bin/ghc-stage1.exe" -hisuf p_hi -osuf p_o -hcsuf p_hc -static -prof -eventlog -H32m -O -Wall -this-unit-id directory-1.3.1.2 -hide-all-packages -i -ilibraries/directory/. -ilibraries/directory/dist- install/build -Ilibraries/directory/dist-install/build -ilibraries/directory/dist-install/build/./autogen -Ilibraries/directory /dist-install/build/./autogen -Ilibraries/directory/. -optP-include -optPlibraries/directory/dist-install/build/./autogen/cabal_macros.h -package-id base-4.11.0.0 -package-id time-1.8.0.2 -package-id filepath-1.4.1.2 -package-id Win32-2.5.4.1 -Wall -XHaskell2010 -O2 -no- user-package-db -rtsopts -Wno-unused-imports -Wno-deprecated-flags -Wnoncanonical-monad-instances -odir libraries/directory/dist- install/build -hidir libraries/directory/dist-install/build -stubdir libraries/directory/dist-install/build -split-objs -c libraries/directory/./System/Directory/Internal/Config.hs -o libraries/directory/dist- install/build/System/Directory/Internal/Config.p_o }}} which is trying to compile `libraries/directory/./System/Directory/Internal/Config.hs` which is also the folder that also contains the `windows.h` dummy implementation for `directory`. This corresponds to the following `gcc` command {{{ "E:\ghc-dev\msys64\home\Tamar\ghc\inplace\lib/../mingw/bin/gcc.exe" "-fno- stack-protector" "-DTABLES_NEXT_TO_CODE" "-DTRACING" "-DPROFILING" "-x" "c" "E:\ghc-dev\msys64\tmp\ghc5148_0\ghc_4.c" "-o" "E:\ghc- dev\msys64\tmp\ghc5148_0\ghc_5.s" "-no-pie" "-Wimplicit" "-S" "-O2" "-include" "E:/ghc-dev/msys64/home/Tamar/ghc/includes\ghcversion.h" "-Ilibraries\directory\System\Directory\Internal" "-Ilibraries/directory /dist-install/build" "-Ilibraries/directory/dist-install/build" "-Ilibraries/directory/dist-install/build/./autogen" "-Ilibraries/directory/." "-IE:\ghc- dev\msys64\home\Tamar\ghc\libraries\time\lib/include" "-IE:\ghc- dev\msys64\home\Tamar\ghc\libraries\Win32\include" "-IE:\ghc- dev\msys64\home\Tamar\ghc\libraries\bytestring\include" "-IE:\ghc- dev\msys64\home\Tamar\ghc\libraries\base\include" "-IE:\ghc- dev\msys64\home\Tamar\ghc\libraries\integer-gmp\include" "-IE:/ghc- dev/msys64/home/Tamar/ghc/rts/dist/build" "-IE:/ghc- dev/msys64/home/Tamar/ghc/includes" "-IE:/ghc- dev/msys64/home/Tamar/ghc/includes/dist-derivedconstants/header" }}} The problem is the `"-Ilibraries\directory\System\Directory\Internal"` that GCC adds, this line comes from `let cmdline_include_paths = includePaths dflags` in `runPhase (RealPhase cc_phase) input_fn dflags`. This particularly entry comes from a modification we do to the include paths: `dflags1 { includePaths = current_dir : old_paths ...` So we always add the current directory to the include paths. Normally this wouldn't be an issue as system include paths should take precedence over user ones. The problem however is that Windows doesn't have such a concept, and I suspect the `mingw` compilers just append extra `-I`. This can be confirmed by the output of standard search directories for this call {{{ GNU C11 (Rev2, Built by MSYS2 project) version 6.3.0 (x86_64-w64-mingw32) compiled by GNU C version 6.3.0, GMP version 6.1.2, MPFR version 3.1.5-p2, MPC version 1.0.3, isl version 0.15 GGC heuristics: --param ggc-min-expand=100 --param ggc-min-heapsize=131072 ignoring duplicate directory "E:/ghc- dev/msys64/home/Tamar/ghc/inplace/mingw/bin/../lib/gcc/x86_64-w64-mingw32/6.3.0/include" ignoring duplicate directory "E:/ghc- dev/msys64/home/Tamar/ghc/inplace/mingw/bin/../lib/gcc/x86_64-w64-mingw32/6.3.0 /include-fixed" ignoring duplicate directory "E:/ghc- dev/msys64/home/Tamar/ghc/inplace/mingw/lib/gcc/../../lib/gcc/x86_64-w64-mingw32/6.3.0/include" ignoring nonexistent directory "C:/building/msys64/mingw64/include" ignoring nonexistent directory "/mingw64/include" ignoring duplicate directory "E:/ghc- dev/msys64/home/Tamar/ghc/inplace/mingw/lib/gcc/../../lib/gcc/x86_64-w64-mingw32/6.3.0 /include-fixed" ignoring duplicate directory "E:/ghc- dev/msys64/home/Tamar/ghc/inplace/mingw/lib/gcc/../../lib/gcc/x86_64-w64-mingw32/6.3.0/../../../../x86_64-w64-mingw32/include" ignoring nonexistent directory "C:/building/msys64/mingw64/x86_64-w64-mingw32/include" ignoring duplicate directory "libraries/directory/dist-install/build" #include "..." search starts here: #include <...> search starts here: libraries\\directory\\System\\Directory\\Internal libraries/directory/dist-install/build libraries/directory/dist-install/build/./autogen libraries/directory/. E:\\ghc-dev\\msys64\\home\\Tamar\\ghc\\libraries\\time\\lib/include E:\\ghc-dev\\msys64\\home\\Tamar\\ghc\\libraries\\Win32\\include E:\\ghc-dev\\msys64\\home\\Tamar\\ghc\\libraries\\bytestring\\include E:\\ghc-dev\\msys64\\home\\Tamar\\ghc\\libraries\\base\\include E:\\ghc-dev\\msys64\\home\\Tamar\\ghc\\libraries\\integer-gmp\\include E:/ghc-dev/msys64/home/Tamar/ghc/rts/dist/build E:/ghc-dev/msys64/home/Tamar/ghc/includes E:/ghc-dev/msys64/home/Tamar/ghc/includes/dist-derivedconstants/header E://ghc- dev//msys64//home//Tamar//ghc//inplace//mingw//bin/../lib/gcc/x86_64-w64-mingw32/6.3.0/include E://ghc- dev//msys64//home//Tamar//ghc//inplace//mingw//bin/../lib/gcc/x86_64-w64-mingw32/6.3.0 /include-fixed E:/ghc- dev/msys64/home/Tamar/ghc/inplace/mingw/bin/../lib/gcc/x86_64-w64-mingw32/6.3.0/../../../../include E:/ghc- dev/msys64/home/Tamar/ghc/inplace/mingw/bin/../lib/gcc/x86_64-w64-mingw32/6.3.0/../../../../x86_64-w64-mingw32/include End of search list. GNU C11 (Rev2, Built by MSYS2 project) version 6.3.0 (x86_64-w64-mingw32) compiled by GNU C version 6.3.0, GMP version 6.1.2, MPFR version 3.1.5-p2, MPC version 1.0.3, isl version 0.15 }}} So the problem seems to be an upstream one. I'm not sure what's the best way to solve this. Ideally the mingw-w64 compilers should recognize their own core include directories as system includes. For now, `directory` can work around this issue by renaming this `windows.h` file. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 4 22:48:31 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 04 Oct 2017 22:48:31 -0000 Subject: [GHC] #14323: Occurs check regressions in GHC 8.2.1 (and HEAD) Message-ID: <050.dbbfdd1cdcddb65fbaceda43a16d7074@haskell.org> #14323: Occurs check regressions in GHC 8.2.1 (and HEAD) -------------------------------------+------------------------------------- Reporter: RyanGlScott | 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: -------------------------------------+------------------------------------- Inspired by adamse's comment at https://ghc.haskell.org/trac/ghc/ticket/14317#comment:3, I've discovered some programs which behave differently on GHC 8.0.2, 8.2.1, and HEAD. ----- First, there's this program: {{{#!hs {-# LANGUAGE GADTs #-} hm1 :: b ~ f b => b -> f b hm1 x = x }}} On GHC 8.0.2, this compiles (with a warning): {{{ GHCi, version 8.0.2: http://www.haskell.org/ghc/ :? for help Loaded GHCi configuration from /home/rgscott/.ghci [1 of 1] Compiling Main ( Bug.hs, interpreted ) Bug.hs:4:1: warning: [-Woverlapping-patterns] Pattern match is redundant In an equation for ‘hm1’: hm1 x = ... }}} But on GHC 8.2.1, it errors: {{{ GHCi, version 8.2.1: http://www.haskell.org/ghc/ :? for help Loaded GHCi configuration from /home/rgscott/.ghci [1 of 1] Compiling Main ( Bug.hs, interpreted ) Bug.hs:4:9: error: • Could not deduce: b ~ f b from the context: b ~ f b bound by the type signature for: hm1 :: forall b (f :: * -> *). b ~ f b => b -> f b at Bug.hs:3:1-26 ‘b’ is a rigid type variable bound by the type signature for: hm1 :: forall b (f :: * -> *). b ~ f b => b -> f b at Bug.hs:3:1-26 • In the expression: x In an equation for ‘hm1’: hm1 x = x • Relevant bindings include x :: b (bound at Bug.hs:4:5) hm1 :: b -> f b (bound at Bug.hs:4:1) | 4 | hm1 x = x | ^ }}} And on GHC HEAD, it fails with a different error! {{{ GHCi, version 8.3.20171004: http://www.haskell.org/ghc/ :? for help Loaded GHCi configuration from /home/rgscott/.ghci [1 of 1] Compiling Main ( Bug.hs, interpreted ) Bug.hs:4:9: error: • Occurs check: cannot construct the infinite type: b ~ f b • In the expression: x In an equation for ‘hm1’: hm1 x = x • Relevant bindings include x :: b (bound at Bug.hs:4:5) hm1 :: b -> f b (bound at Bug.hs:4:1) | 4 | hm1 x = x | ^ }}} The same errors occur if you give `hm1` the type `hm1 :: b ~ f b => f b -> b`. ----- What happens if you try `Coercible` instead of `(~)`? Consider this variant of the program above: {{{#!hs {-# LANGUAGE GADTs #-} import Data.Coerce hm2 :: Coercible b (f b) => b -> f b hm2 = coerce }}} On GHC 8.0.2, 8.2.1, and HEAD, this compiles (without warnings). Good. But if you change the type to use the symmetric version of that constraint: {{{#!hs {-# LANGUAGE GADTs #-} import Data.Coerce hm3 :: Coercible (f b) b => b -> f b hm3 = coerce }}} Then on GHC 8.0.2, it compiles without warnings, but on 8.2.1 and HEAD it fails! Here is the error with 8.2.1: {{{ Bug3.hs:6:7: error: • Could not deduce: Coercible b (f b) arising from a use of ‘coerce’ from the context: Coercible (f b) b bound by the type signature for: hm3 :: forall (f :: * -> *) b. Coercible (f b) b => b -> f b at Bug3.hs:5:1-36 ‘b’ is a rigid type variable bound by the type signature for: hm3 :: forall (f :: * -> *) b. Coercible (f b) b => b -> f b at Bug3.hs:5:1-36 • In the expression: coerce In an equation for ‘hm3’: hm3 = coerce • Relevant bindings include hm3 :: b -> f b (bound at Bug3.hs:6:1) | 6 | hm3 = coerce | ^^^^^^ }}} And on HEAD: {{{ Bug3.hs:6:7: error: • Occurs check: cannot construct the infinite type: b ~ f b arising from a use of ‘coerce’ • In the expression: coerce In an equation for ‘hm3’: hm3 = coerce • Relevant bindings include hm3 :: b -> f b (bound at Bug3.hs:6:1) | 6 | hm3 = coerce | ^^^^^^ }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 4 22:48:56 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 04 Oct 2017 22:48:56 -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.dabcd2df332bb844911c54c1226b2016@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, | 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): Good catch. I've opened #14323 for this. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 4 22:51:19 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 04 Oct 2017 22:51:19 -0000 Subject: [GHC] #14312: Head does not build on Windows with the default make config. In-Reply-To: <047.086b87bb9b3dcf2f7a921149fa31eda2@haskell.org> References: <047.086b87bb9b3dcf2f7a921149fa31eda2@haskell.org> Message-ID: <062.fb142df93bde834f0c7244a27ec09b81@haskell.org> #14312: Head does not build on Windows with the default make config. -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: (none) Type: bug | Status: upstream Priority: normal | Milestone: Component: Build System | Version: 8.2.1 Resolution: | Keywords: Operating System: Windows | Architecture: Type of failure: Building GHC | Unknown/Multiple failed | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Phyx-): One possible solution to this is to make sure these "system" paths come first in the in our GCC driver. We know about them, and we can calculate the rest. This would be the least effort. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 4 22:54:54 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 04 Oct 2017 22:54:54 -0000 Subject: [GHC] #14291: Tests tend to fail in the ext-interp way when split sections is enabled In-Reply-To: <046.50939ac6d09fd8ac7c487275ec7ee681@haskell.org> References: <046.50939ac6d09fd8ac7c487275ec7ee681@haskell.org> Message-ID: <061.84c78a82e86aaa22d907bc0e59a59e2f@haskell.org> #14291: Tests tend to fail in the ext-interp way when split sections is enabled -------------------------------------+------------------------------------- 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: 13716 Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): So I plugged away at this a bit today. I'm increasingly suspicious of 1c83fd814b12754be8af211a387cec906ca198b3 which touches a large amount of ELF linker logic. Unfortunately it's not terribly easy to revert. In particular, I've traced one failure down to what appears to be a section-name relocation. Namely, {{{#!objdump 00000000001ee308 : 1ee308: 48 8d 45 f0 lea -0x10(%rbp),%rax 1ee30c: 4c 39 f8 cmp %r15,%rax 1ee30f: 72 23 jb 1ee334 1ee311: 48 c7 45 f0 00 00 00 movq $0x0,-0x10(%rbp) 1ee318: 00 1ee315: R_X86_64_32S stg_upd_frame_info 1ee319: 48 89 5d f8 mov %rbx,-0x8(%rbp) 1ee31d: be 00 00 00 00 mov $0x0,%esi 1ee31e: R_X86_64_32 .data+0xe6db }}} Specifically, the relocation at 0x1ee31e. In the linked result this ends up pointing into the middle of `base_DataziData_zdfDataAnyzuzdcgunfold_closure`, which can't possibly be right. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 4 23:21:56 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 04 Oct 2017 23:21:56 -0000 Subject: [GHC] #14291: Tests tend to fail in the ext-interp way when split sections is enabled In-Reply-To: <046.50939ac6d09fd8ac7c487275ec7ee681@haskell.org> References: <046.50939ac6d09fd8ac7c487275ec7ee681@haskell.org> Message-ID: <061.4bd78f734423e3bf23bfdc60643264e4@haskell.org> #14291: Tests tend to fail in the ext-interp way when split sections is enabled -------------------------------------+------------------------------------- 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: 13716 Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): Hmm, this is quite suspicious. The `ObjectCode` corresponding to the `HSbase` object has `oc->n_sections == 19` yet the section header according to `objdump` looks like, {{{ Sections: Idx Name Size VMA LMA File off Algn 0 .text 004786ba 0000000000000000 0000000000000000 00000040 2**4 CONTENTS, ALLOC, LOAD, RELOC, READONLY, CODE 1 .data 00082138 000000000002a030 000000000002a030 00478700 2**3 CONTENTS, ALLOC, LOAD, RELOC, DATA 2 .bss 00000000 0000000000000000 0000000000000000 004fa838 2**0 ALLOC 3 .rodata 0000f62a 00000000004786c0 00000000004786c0 004fa840 2**4 CONTENTS, ALLOC, LOAD, RELOC, READONLY, DATA 4 .data.rel.ro 0002a030 0000000000000000 0000000000000000 00509e80 2**5 CONTENTS, ALLOC, LOAD, RELOC, DATA 5 .init_array 00000008 0000000000000000 0000000000000000 00533eb0 2**3 CONTENTS, ALLOC, LOAD, RELOC, DATA 6 .eh_frame 00000bd0 0000000000000000 0000000000000000 00533eb8 2**3 CONTENTS, ALLOC, LOAD, RELOC, READONLY, DATA 7 .comment 00000038 0000000000000000 0000000000000000 00534a88 2**0 CONTENTS, READONLY 8 .note.GNU-stack 00000000 0000000000000000 0000000000000000 00a42a80 2**0 CONTENTS, READONLY }}} `oc->sections[*].size` looks like, {{{ >>> python >for i in range(19): > print(i, hex(gdb.parse_and_eval('objects->sections[%d].size' % i))) 0 0x0 1 0x4786ba 2 0x82138 3 0x0 4 0xf62a 5 0x2a030 6 0x8 7 0xbd0 8 0x38 9 0x108048 10 0x39bfd0 11 0x64770 12 0x18 13 0xb40 14 0x4ce0 15 0x0 16 0x1fa5e0 17 0x202de8 18 0x8e }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 4 23:37:52 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 04 Oct 2017 23:37:52 -0000 Subject: [GHC] #14291: Tests tend to fail in the ext-interp way when split sections is enabled In-Reply-To: <046.50939ac6d09fd8ac7c487275ec7ee681@haskell.org> References: <046.50939ac6d09fd8ac7c487275ec7ee681@haskell.org> Message-ID: <061.d6911e60c4723c08f2ec85cbfa86bc61@haskell.org> #14291: Tests tend to fail in the ext-interp way when split sections is enabled -------------------------------------+------------------------------------- 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: 13716 Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): Well this is peculiar, {{{ 0x00000000013e100c in addSection (s=0x17d1e30, kind=SECTIONKIND_OTHER, alloc=SECTION_NOMEM, start=0x7f0d68b99000, size=0, mapped_offset=0, mapped_start=0x0, mapped_size=0) at rts/Linker.c:1763 1763 s->start = start; /* actual start of section in memory */ >>> bt #0 0x00000000013e100c in addSection (s=0x17d1e30, kind=SECTIONKIND_OTHER, alloc=SECTION_NOMEM, start=0x7f0d68b99000, size=0, mapped_offset=0, mapped_start=0x0, mapped_size=0) at rts/Linker.c:1763 #1 0x0000000001400499 in ocGetNames_ELF (oc=0x17d1b90) at rts/linker/Elf.c:795 #2 0x00000000013e092e in loadOc (oc=0x17d1b90) at rts/Linker.c:1514 #3 0x00000000013e07c5 in loadObj_ (path=0x420001b730 "/mnt/work/ghc/ghc- compare-2/libraries/base/dist-install/build/HSbase-4.10.0.0.o") at rts/Linker.c:1450 #4 0x00000000013e0850 in loadObj (path=0x420001b730 "/mnt/work/ghc/ghc- compare-2/libraries/base/dist-install/build/HSbase-4.10.0.0.o") at rts/Linker.c:1466 #5 0x0000000000b3a4a6 in s5az_info () #6 0x0000000000000000 in ?? () >>> up #1 0x0000000001400499 in ocGetNames_ELF (oc=0x17d1b90) at rts/linker/Elf.c:795 795 addSection(&oc->sections[i], kind, alloc, oc->image+offset, size, >>> print shdr[0] $16 = { sh_name = 0, sh_type = 0, sh_flags = 0, sh_addr = 0, sh_offset = 0, sh_size = 0, sh_link = 0, sh_info = 0, sh_addralign = 0, sh_entsize = 0 } >>> print ehdr[0] $17 = { e_ident = "\177ELF\002\001\001\000\000\000\000\000\000\000\000", e_type = 1, e_machine = 62, e_version = 1, e_entry = 0, e_phoff = 0, e_shoff = 14941912, e_flags = 0, e_ehsize = 64, e_phentsize = 0, e_phnum = 0, e_shentsize = 64, e_shnum = 19, e_shstrndx = 18 } }}} The RTS really does seem to be under the impression that there are 19 sections, despite what `objdump` claims. Hmmm, someone is clearly lying. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 4 23:41:43 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 04 Oct 2017 23:41:43 -0000 Subject: [GHC] #14291: Tests tend to fail in the ext-interp way when split sections is enabled In-Reply-To: <046.50939ac6d09fd8ac7c487275ec7ee681@haskell.org> References: <046.50939ac6d09fd8ac7c487275ec7ee681@haskell.org> Message-ID: <061.f8dae297cadc275df120abc1f1fb0a50@haskell.org> #14291: Tests tend to fail in the ext-interp way when split sections is enabled -------------------------------------+------------------------------------- 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: 13716 Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): Alright, well `readelf -S` appears to agree with GHC. I think `objdump` is just lying. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 4 23:59:19 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 04 Oct 2017 23:59:19 -0000 Subject: [GHC] #14291: Tests tend to fail in the ext-interp way when split sections is enabled In-Reply-To: <046.50939ac6d09fd8ac7c487275ec7ee681@haskell.org> References: <046.50939ac6d09fd8ac7c487275ec7ee681@haskell.org> Message-ID: <061.c885af17f3a63a00476309f6d7d05122@haskell.org> #14291: Tests tend to fail in the ext-interp way when split sections is enabled -------------------------------------+------------------------------------- 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: 13716 Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): I think the issue may not be in the RTS linker; rather, I suspect the issue is that the system linker is rearranging our sections. In `Data/Data.o` I see {{{ $ readelf -W -s /mnt/work/ghc/ghc-compare-2/libraries/base/dist- install/build/Data/Data.o | grep DataAnyzuzdcgunfold 14326: 0000000000000000 0 OBJECT GLOBAL DEFAULT 5790 base_DataziData_zdfDataAnyzuzdcgunfold_closure 14327: 0000000000000020 68 OBJECT GLOBAL DEFAULT 5794 base_DataziData_zdfDataAnyzuzdcgunfold_info }}} With the sections 5790 and 5794 being {{{ [5790] .data.base_DataziData_zdfDataAnyzuzdcgunfold_closure PROGBITS 0000000000000000 033940 000010 00 WA 0 0 8 [5794] .text.base_DataziData_zdfDataAnyzuzdcgunfold_info PROGBITS 0000000000000000 033990 000064 00 AX 0 0 8 }}} Whereas in the merged object file I see, {{{ $ readelf -W -s /mnt/work/ghc/ghc-compare-2/libraries/base/dist- install/build/HSbase-4.10.0.0.o | grep DataAnyzuzdcgunfold 81410: 0000000000076338 68 OBJECT GLOBAL DEFAULT 1 base_DataziData_zdfDataAnyzuzdcgunfold_info 81411: 000000000000e6d0 0 OBJECT GLOBAL DEFAULT 2 base_DataziData_zdfDataAnyzuzdcgunfold_closure }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 5 01:14:56 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 05 Oct 2017 01:14:56 -0000 Subject: [GHC] #14291: Tests tend to fail in the ext-interp way when split sections is enabled In-Reply-To: <046.50939ac6d09fd8ac7c487275ec7ee681@haskell.org> References: <046.50939ac6d09fd8ac7c487275ec7ee681@haskell.org> Message-ID: <061.ba1a7ef1d6073d2cce00f679c1611309@haskell.org> #14291: Tests tend to fail in the ext-interp way when split sections is enabled -------------------------------------+------------------------------------- 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: 13716 Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by angerman): @bgamari, could you note down which linker your system linker is, and what version? And maybe also the command how it merges the final object file? Reordering in itself (as long as the relocations are properly adjusted) shouldn't be an issue I would assume. The RTS Linker might still be at fault. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 5 01:40:05 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 05 Oct 2017 01:40:05 -0000 Subject: [GHC] #14324: Consider deprecating STM invariant mechanism Message-ID: <046.7d9457872c0d5f0243f1b38705442b7b@haskell.org> #14324: Consider deprecating STM invariant mechanism -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: task | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.2.1 Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- fryguybob and I were recently discussing the STM invariant mechanism. This mechanism is, presumably, intended to expose problems from odd interleavings of transactions. However, fryguybob pointed out that the implementation currently takes so many locks that it very likely prevents these odd interleavings from occurring. In addition, * the implementation doesn't handle nested STM invariants correctly (#7930) * the locking behavior of the implementation was, until very recently, utterly wrong (#14310) * the feature introduces quite a bit of complexity in the RTS * the interface has essentially no users, as evidenced by a Hackage search and the fact that #14310 went unnoticed for years All of this raises the question: Is the STM invariants feature really where we want to spend our complexity budget? Perhaps it is time for this feature to quietly pass (after an appropriate deprecation period, of course). -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 5 01:41:55 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 05 Oct 2017 01:41:55 -0000 Subject: [GHC] #14324: Consider deprecating STM invariant mechanism In-Reply-To: <046.7d9457872c0d5f0243f1b38705442b7b@haskell.org> References: <046.7d9457872c0d5f0243f1b38705442b7b@haskell.org> Message-ID: <061.e2e1ab94f554a35be97fd952ea87d95b@haskell.org> #14324: Consider deprecating STM invariant mechanism -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: task | Status: new 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: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Description changed by bgamari: Old description: > fryguybob and I were recently discussing the STM invariant mechanism. > This mechanism is, presumably, intended to expose problems from odd > interleavings of transactions. However, fryguybob pointed out that the > implementation currently takes so many locks that it very likely prevents > these odd interleavings from occurring. > > In addition, > * the implementation doesn't handle nested STM invariants correctly > (#7930) > * the locking behavior of the implementation was, until very recently, > utterly wrong (#14310) > * the feature introduces quite a bit of complexity in the RTS > * the interface has essentially no users, as evidenced by a Hackage > search and the fact that #14310 went unnoticed for years > > All of this raises the question: Is the STM invariants feature really > where we want to spend our complexity budget? Perhaps it is time for this > feature to quietly pass (after an appropriate deprecation period, of > course). New description: fryguybob and I were recently discussing the STM invariant mechanism (e.g. `Control.Monad.STM.check`). This mechanism is, presumably, intended to expose problems from odd interleavings of transactions. However, fryguybob pointed out that the implementation currently takes so many locks that it very likely prevents these odd interleavings from occurring. In addition, * the implementation doesn't handle nested STM invariants correctly (#7930) * the locking behavior of the implementation was, until very recently, utterly wrong (#14310) * the feature introduces quite a bit of complexity in the RTS * the interface has essentially no users, as evidenced by a Hackage search and the fact that #14310 went unnoticed for years All of this raises the question: Is the STM invariants feature really where we want to spend our complexity budget? Perhaps it is time for this feature to quietly pass (after an appropriate deprecation period, of course). -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 5 01:59:02 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 05 Oct 2017 01:59:02 -0000 Subject: [GHC] #14291: Tests tend to fail in the ext-interp way when split sections is enabled In-Reply-To: <046.50939ac6d09fd8ac7c487275ec7ee681@haskell.org> References: <046.50939ac6d09fd8ac7c487275ec7ee681@haskell.org> Message-ID: <061.176649dcb2ffd7b0956e35a16274553a@haskell.org> #14291: Tests tend to fail in the ext-interp way when split sections is enabled -------------------------------------+------------------------------------- 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: 13716 Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): After a bit more investigation I think my conclusion from comment:13 was utterly wrong. I had misinterpreted the symbols involved. I am using `GNU gold (GNU Binutils for Debian 2.28) 1.14`. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 5 03:11:23 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 05 Oct 2017 03:11:23 -0000 Subject: [GHC] #14310: Assertion triggered by STM invariant. In-Reply-To: <042.9c3fac38bbd2247bedc1f2616e6e2820@haskell.org> References: <042.9c3fac38bbd2247bedc1f2616e6e2820@haskell.org> Message-ID: <057.709098b5e7fa9602837e1dd0dbb87f19@haskell.org> #14310: Assertion triggered by STM invariant. -------------------------------------+------------------------------------- Reporter: mbw | Owner: (none) Type: bug | Status: patch Priority: high | Milestone: 8.4.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 -------------------------------------+------------------------------------- Comment (by bgamari): fryguybob had some very useful feedback on these patches. It seems like there is yet another issue: the assertion in `raiseAsync` is itself wrong (as I suspected in comment:5). To summarize: Normal top-level STM transactions (e.g. initiated by an `atomically` call in Haskell) by definition should have `enclosing_trec == NO_TREC`. The `ATOMICALLY_FRAME` handler in `raiseAsync` checks this invariant with an assert. In the case of nested transactions initiated by `orElse` we will hit a `CATCH_RETRY_FRAME` before hitting an `ATOMICALLY_FRAME`, avoiding this assertion. However, in the case of nested transactions started by the STM machinery for the purpose that we are checking invariants we have no such `CATCH_RETRY_FRAME`. `stg_atomically_frame` just pushes an `ATOMICALLY_FRAME`. Since this frame will have `enclosing_trec != NO_TREC`, this trips the assertion. Instead we should be asserting something like, {{{#!c DEBUG_ONLY(StgAtomicallyFrame *atomically = (StgAtomicallyFrame *) frame); ASSERT(tso->trec->enclosing_trec == NO_TREC || atomically->next_invariant_to_check != END_INVARIANT_CHECK_QUEUE); }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 5 03:12:43 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 05 Oct 2017 03:12:43 -0000 Subject: [GHC] #14312: Head does not build on Windows with the default make config. In-Reply-To: <047.086b87bb9b3dcf2f7a921149fa31eda2@haskell.org> References: <047.086b87bb9b3dcf2f7a921149fa31eda2@haskell.org> Message-ID: <062.62ce5e2dafd6d2e50081aa9313adc7d3@haskell.org> #14312: Head does not build on Windows with the default make config. -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: (none) Type: bug | Status: upstream Priority: normal | Milestone: Component: Build System | Version: 8.2.1 Resolution: | Keywords: Operating System: Windows | Architecture: Type of failure: Building GHC | Unknown/Multiple failed | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Phyx-): Actually the GCC manual states: {{{ The most commonly-used option is -Idir, which causes dir to be searched after the current directory (for the quote form of the directive) and ahead of the standard system directories. You can specify multiple -I options on the command line, in which case the directories are searched in left-to-right order. }}} Which means `-I` override system include directories. GCC is doing exactly what It was told to. SO dunno what the correct fix here is. short term, directory should just rename this file. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 5 03:12:52 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 05 Oct 2017 03:12:52 -0000 Subject: [GHC] #14310: Assertion triggered by STM invariant. In-Reply-To: <042.9c3fac38bbd2247bedc1f2616e6e2820@haskell.org> References: <042.9c3fac38bbd2247bedc1f2616e6e2820@haskell.org> Message-ID: <057.682ea5fd177b7da21333a0ffef83ceee@haskell.org> #14310: Assertion triggered by STM invariant. -------------------------------------+------------------------------------- Reporter: mbw | Owner: (none) Type: bug | Status: patch Priority: high | Milestone: 8.4.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): * differential: Phab:D4065, Phab:D4067 => Phab:D4065, Phab:D4067, Phab:D4073 Comment: Okay, I think the last piece of this is Phab:D4073. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 5 03:20:24 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 05 Oct 2017 03:20:24 -0000 Subject: [GHC] #14291: Tests tend to fail in the ext-interp way when split sections is enabled In-Reply-To: <046.50939ac6d09fd8ac7c487275ec7ee681@haskell.org> References: <046.50939ac6d09fd8ac7c487275ec7ee681@haskell.org> Message-ID: <061.9985d65981e7e5dfe9e0d0f95a20aa10@haskell.org> #14291: Tests tend to fail in the ext-interp way when split sections is enabled -------------------------------------+------------------------------------- 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: 13716 Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): For the record, both `HSbase-4.10.0.0.o` and `Data.o` are available at http://home.smart-cactus.org/~ben/. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 5 03:34:03 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 05 Oct 2017 03:34:03 -0000 Subject: [GHC] #14291: Tests tend to fail in the ext-interp way when split sections is enabled In-Reply-To: <046.50939ac6d09fd8ac7c487275ec7ee681@haskell.org> References: <046.50939ac6d09fd8ac7c487275ec7ee681@haskell.org> Message-ID: <061.56fcd59b36e7f85f4ca9c3c8660ddee8@haskell.org> #14291: Tests tend to fail in the ext-interp way when split sections is enabled -------------------------------------+------------------------------------- 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: 13716 Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): So, to recap, it appears that my theory from comment:13 is wrong: the relocation in `s1MQ_info` (see comment:9) appears to be consistent with what `objdump` says the target should be and with where the RTS says it mapped the target section. However, it occurred to me that maybe I'm focusing on the wrong relocation: the crash occurs when we attempt a `jmpq *($rbx)` where `$rbx` was computed (through quite a long chain) from the bits mentioned in comment:9. Perhaps instead it is a relocation at the address `*($rbx)` (which resolves to `base_DataziData_zdfDataAnyzuzdcgfoldl_closure`) that is the at fault. `objdump` says the following about this symbol, {{{ 00000000000386f0 : ... 386f0: R_X86_64_64 base_DataziData_zdfDataAnyzuzdcgfoldl_info }}} So indeed there is a relocation there. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 5 04:07:18 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 05 Oct 2017 04:07:18 -0000 Subject: [GHC] #14291: Tests tend to fail in the ext-interp way when split sections is enabled In-Reply-To: <046.50939ac6d09fd8ac7c487275ec7ee681@haskell.org> References: <046.50939ac6d09fd8ac7c487275ec7ee681@haskell.org> Message-ID: <061.ebacc2ad2fdcd1d59bc3c505551728ea@haskell.org> #14291: Tests tend to fail in the ext-interp way when split sections is enabled -------------------------------------+------------------------------------- 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: 13716 Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): Actually, the data at `0x41453420` is valid: it is code, {{{ >>> x/8i 0x41453420 0x41453420: add $0x18,%r12 0x41453424: cmp 0x358(%r13),%r12 0x4145342b: ja 0x41453450 0x4145342d: movq $0x414533d0,-0x10(%r12) 0x41453436: mov %rsi,(%r12) }}} This is precisely the code that I would expect given the object file. I don't know why my previous watchpoint didn't catch this being mapped (oh, perhaps gdb doesn't catch changes due to `mmap` events; that would explain it). Anyways, in this case I'm quite confused: the relocations all appear to be correct but we appear to be doing an indirect jump through `0x41453420`, clearly expecting it to be an address where in fact it is code. This suggests that things went awry quite a bit earlier. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 5 04:12:04 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 05 Oct 2017 04:12:04 -0000 Subject: [GHC] #14291: Tests tend to fail in the ext-interp way when split sections is enabled In-Reply-To: <046.50939ac6d09fd8ac7c487275ec7ee681@haskell.org> References: <046.50939ac6d09fd8ac7c487275ec7ee681@haskell.org> Message-ID: <061.d4fda3a8d20cc51bc3ce58ba66f42a9d@haskell.org> #14291: Tests tend to fail in the ext-interp way when split sections is enabled -------------------------------------+------------------------------------- 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: 13716 Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): In fact, the instruction that we crash on, `0x41755b3f`, resolves to `base_GHCziStackziTypes_getCallStack_info`. Furthermore, the few addresses on the Haskell stack are `base_GHCziException_prettyCallStack_info` and `base_GHCziException_zdfExceptionSomeExceptionzuzdctoException_info`, which suggests that something has gone awry (although in a rather graceful way). -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 5 04:24:46 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 05 Oct 2017 04:24:46 -0000 Subject: [GHC] #14312: Head does not build on Windows with the default make config. In-Reply-To: <047.086b87bb9b3dcf2f7a921149fa31eda2@haskell.org> References: <047.086b87bb9b3dcf2f7a921149fa31eda2@haskell.org> Message-ID: <062.7cf01378af3e8d44e2b18fa3116bcb99@haskell.org> #14312: Head does not build on Windows with the default make config. -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: (none) Type: bug | Status: upstream Priority: normal | Milestone: Component: Build System | Version: 8.2.1 Resolution: | Keywords: Operating System: Windows | Architecture: Type of failure: Building GHC | Unknown/Multiple failed | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Rufflewind): What about `-iquote` instead of `-I`? According to the manual `-iquote` only affects `#include "..."` but not `#include <...>`. Alternatively, one could also try something like {{{ cd $original_dir gcc -x c - <$temp_input }}} It seems GCC always uses the current working directory when stdin is used as input. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 5 08:02:30 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 05 Oct 2017 08:02:30 -0000 Subject: [GHC] #14324: Consider deprecating STM invariant mechanism In-Reply-To: <046.7d9457872c0d5f0243f1b38705442b7b@haskell.org> References: <046.7d9457872c0d5f0243f1b38705442b7b@haskell.org> Message-ID: <061.903b836ffee9733a018cf85e2e6a326d@haskell.org> #14324: Consider deprecating STM invariant mechanism -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: task | Status: new 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: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): > All of this raises the question: Is the STM invariants feature really where we want to spend our complexity budget? I think that's an excellent question. I suspect you are right. If we want to go that way we should advertise our (provisional) intention on ghc-users to see if anyone pops up. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 5 08:46:44 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 05 Oct 2017 08:46:44 -0000 Subject: [GHC] #14222: Simple text fusion example results in rather duplicative code In-Reply-To: <046.acf3e774499e29f098fdca7495f195f8@haskell.org> References: <046.acf3e774499e29f098fdca7495f195f8@haskell.org> Message-ID: <061.28aa8328135f37da79959b9637ce3120@haskell.org> #14222: Simple text fusion example results in rather duplicative code -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: | Keywords: CSE Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D3990 Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * differential: => Phab:D3990 Comment: Phab:D3990 is start on comment:4 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 5 09:41:35 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 05 Oct 2017 09:41:35 -0000 Subject: [GHC] #14323: Occurs check regressions in GHC 8.2.1 (and HEAD) In-Reply-To: <050.dbbfdd1cdcddb65fbaceda43a16d7074@haskell.org> References: <050.dbbfdd1cdcddb65fbaceda43a16d7074@haskell.org> Message-ID: <065.3bbda5de644c80ef04020cfba80abfae@haskell.org> #14323: Occurs check regressions in GHC 8.2.1 (and HEAD) -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.2.1 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): Here's what is happening * The given `b ~ f b` has an occurs check, so it's insoluble. It's a bit like saying {{{ f :: (Int ~ Bool) => blah }}} * In the long discussion on #12466 (see `Note [Given errors]` in `TcErrors` we decided not to complain about insoluble givens. * So the given `b ~ f b` is just parked. * Now we try to solve `b ~ f b`. Lo, it has an occurs-check error. Which we report. Seems reasonable to me, except for the lack of a complaint about the insoluble given; better ideas welcome (but look at #12466). -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 5 09:58:54 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 05 Oct 2017 09:58:54 -0000 Subject: [GHC] #14323: Occurs check regressions in GHC 8.2.1 (and HEAD) In-Reply-To: <050.dbbfdd1cdcddb65fbaceda43a16d7074@haskell.org> References: <050.dbbfdd1cdcddb65fbaceda43a16d7074@haskell.org> Message-ID: <065.d0adad70daa8c6d89ec01c034464c2b7@haskell.org> #14323: Occurs check regressions in GHC 8.2.1 (and HEAD) -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.2.1 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 RyanGlScott): And what of the second and third programs (with `Coercible` instead of `(~)`)? Those constraints aren't insoluble. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 5 10:32:05 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 05 Oct 2017 10:32:05 -0000 Subject: [GHC] #14323: Occurs check regressions in GHC 8.2.1 (and HEAD) In-Reply-To: <050.dbbfdd1cdcddb65fbaceda43a16d7074@haskell.org> References: <050.dbbfdd1cdcddb65fbaceda43a16d7074@haskell.org> Message-ID: <065.e119e8ffa24eb2457959d2b98f6e1b46@haskell.org> #14323: Occurs check regressions in GHC 8.2.1 (and HEAD) -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.2.1 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): Well, this is annoying. The definition of `Coercible` is roughly this {{{ class (a ~R# b) => Coercible a b }}} So then * When we have `[G] Coercible b (f b)` we put that into the inert set, and add its superclasses `[G] b ~R# f b`. * The given `[G] b ~R# f b` has an occurs check, so we "park" it in the insolubles. * Now we try `[W] Coercible b (f b)`. Aha! We have precisely that inert in the inert set, so we solve it. If we switch te type sig to `Coercible (f b) b` then something slightly different happens: * `[G] Coercible (f b) b` is put into the inert set; then add its superclasses `[G] f b ~R# b`. * The given `[G] f b ~R# b` normalised to `b ~R# f b` but has an occurs check, so we "park" it in the insolubles. * Now we try `[W] Coercible b (f b)`. Alas! No matching dictionary exists, so is reported as "can't solve". The inconsistency here is that when the givens are insoluble we may not (indeed cannot) fully normalise them and use them to solve the wanteds. But it's hard to spot that the `Coercible` dictionary (just another class to the solver) is insoluble because its superclass is. I'm not sure what to do here. Since it's all to do with a wrong program anyhow, maybe it does not matter too much. Incidentally the same thing can happen with nominal equality: {{{ class (a~b) => C a b foo :: C a b => a -> b foo x = x hm2 :: C b (f b) => b -> f b hm2 x = foo x hm3 :: C (f b) b => b -> f b hm3 x = foo x }}} Here `hm2` typechecks because of the exactly-matching given `C b (f b)` dictionary, but `hm3` does not. (Actually `hm3` fails to typecheck but regrettably does not emit an error message. That's a separate bug which I'm fixing.) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 5 10:37:37 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 05 Oct 2017 10:37:37 -0000 Subject: [GHC] #14323: Occurs check regressions in GHC 8.2.1 (and HEAD) In-Reply-To: <050.dbbfdd1cdcddb65fbaceda43a16d7074@haskell.org> References: <050.dbbfdd1cdcddb65fbaceda43a16d7074@haskell.org> Message-ID: <065.bbc7cc61c2cb1887257eac6fef4959c1@haskell.org> #14323: Occurs check regressions in GHC 8.2.1 (and HEAD) -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.2.1 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 RyanGlScott): I'm quite confused. Why should an occurs check ever fire in the first place for `b ~R# f b`? This is a perfectly legitimate constraint that can be witnessed, for instance, by letting `f` be `Identity` (since `b` is representationally equal to `Identity b`). Thus, I'd argue that `hm2` and `hm3` are //not// wrong programs. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 5 10:52:27 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 05 Oct 2017 10:52:27 -0000 Subject: [GHC] #14323: Occurs check regressions in GHC 8.2.1 (and HEAD) In-Reply-To: <050.dbbfdd1cdcddb65fbaceda43a16d7074@haskell.org> References: <050.dbbfdd1cdcddb65fbaceda43a16d7074@haskell.org> Message-ID: <065.17057f8f4234366447e940e5856315f6@haskell.org> #14323: Occurs check regressions in GHC 8.2.1 (and HEAD) -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.2.1 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): > Thus, I'd argue that hm2 and hm3 are not wrong programs. Hmm. That's a good point. But we solve constraints, both `~#` and `~R#` by normalising and then rewriteing. So if we have {{{ [G] b ~R# f b [W] b ~R# blah }}} then we can use the given to rewrite the wanted to {{{ [W] b ~R# blah ==> [W] f b ~R# blah ==> [W] f (f b) ~R# blah ..etc... }}} We don't want to do that. So we park the given and don't use it for rewriting. So maybe the point is not that the code is inaccessible, but rather that we don't have a complete solver. Hmm. I wonder what Richard and Stephanie think? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 5 13:07:27 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 05 Oct 2017 13:07:27 -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.662d7cfd43ecd2c2dfdcbd0c4e394e09@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, | 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 Iceland_jack): My goal was to specialize `id1F`, `id2F` to {{{#!hs id1F :: F (Compose Identity Identity) a a id2F :: F Identity a a }}} such that `F f` can be made a `Category` (less useful than I originally thought). This works with Adam's code (on 8.0.1) {{{#!hs data F' f a b where MkF' :: Coercible (f b) (f' b) => (a -> f' b) -> F' f a b id1F :: Coercible (f a) a => F' f a a id1F = MkF' Identity a :: F' Identity a a a = id1F b :: F' (Compose Identity Identity) a a b = id1F }}} which cannot be made into a `Category` because the representation of `a` leaks into the signature. Replying to [comment:2 RyanGlScott]: > I think you might be inclined to believe that because `Identity a` is representationally equal to `(Compose Identity Identity) a`, that GHC can conclude that `Identity` is representationally equal to `Compose Identity Identity`. Yes that's right > But to my knowledge, there's no reasoning principle which states that `f a ~R g a` implies `f ~R g`. Can there not be some kind of pseudo rule? {{{#!hs instance (forall xx. f xx `Coercible` g xx) => Coercible f g }}} I don't understand the purpose + rules for polykinded `Coercible` {{{#!hs newtype MAYBE a = M (Maybe a) newtype EITHER a b = E (Either a b) newtype PAIR a b = P ((,) a b) works :: Coercion Maybe MAYBE works = Coercion works2 :: Coercion PAIR (,) works2 = Coercion -- ! fails :: Coercion Either EITHER fails = Coercion }}} `coerce` and `coerceWith` only work with `Type`s.. maybe it is used to assist the constraint solver in ways I don't get -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 5 13:07:42 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 05 Oct 2017 13:07:42 -0000 Subject: [GHC] #14320: Brackets change meaning of value-constructor type In-Reply-To: <041.3c8f20a47f3244d2b4af7e2826cc272d@haskell.org> References: <041.3c8f20a47f3244d2b4af7e2826cc272d@haskell.org> Message-ID: <056.e0ed0f531799dda9b16d3559e807b404@haskell.org> #14320: Brackets change meaning of value-constructor type -------------------------------------+------------------------------------- Reporter: nr | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: Component: Compiler (Type | Version: 8.2.1 checker) | Keywords: GADT, Resolution: | existential type 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:D4072 Wiki Page: | -------------------------------------+------------------------------------- Comment (by nr): @RyanGIScott, yes thanks, sorry about the botch on the return type of `TEBad`. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 5 13:11:28 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 05 Oct 2017 13:11:28 -0000 Subject: [GHC] #14291: Tests tend to fail in the ext-interp way when split sections is enabled In-Reply-To: <046.50939ac6d09fd8ac7c487275ec7ee681@haskell.org> References: <046.50939ac6d09fd8ac7c487275ec7ee681@haskell.org> Message-ID: <061.8973fc6c063dd444fc8397eadf063714@haskell.org> #14291: Tests tend to fail in the ext-interp way when split sections is enabled -------------------------------------+------------------------------------- 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: 13716 Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): I'm now looking specifically at the crashing function (`getCallStack`): I can confirm that the argument is completely crazy: {{{ >>> ghc closure $r14 off-heap(0x400c5dd8) >>> ghc symbol 0x400c5dd8 8 bytes into base_DataziData_zdfDataAnyzuzdcgunfold_closure (starts at 0x400c5dd0) }}} That is, the argument is an off-heap value that doesn't even begin on defined symbol. Sheer madness. Let's try to see why. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 5 13:25:37 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 05 Oct 2017 13:25:37 -0000 Subject: [GHC] #14291: Tests tend to fail in the ext-interp way when split sections is enabled In-Reply-To: <046.50939ac6d09fd8ac7c487275ec7ee681@haskell.org> References: <046.50939ac6d09fd8ac7c487275ec7ee681@haskell.org> Message-ID: <061.40e9422c39c65b1c7ee2c78abed77bc8@haskell.org> #14291: Tests tend to fail in the ext-interp way when split sections is enabled -------------------------------------+------------------------------------- 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: 13716 Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): Prior we pass through `base_GHCziException_zdfShowErrorCallzuzdcshowsPrec_info`, {{{#!hs GHC.Exception.$fShowErrorCall_$cshowsPrec [InlPrag=INLINE[0]] :: GHC.Types.Int -> GHC.Exception.ErrorCall -> GHC.Show.ShowS }}} In this case the second argument is somewhat reasonable, {{{ >>> ghc closure $rsi constr(base:GHC.Exception.ErrorCallWithLocation) }}} The first argument also looks fine, {{{ >>> x/2a $r14 0x154dcf8: 0x13c2fa8 0x0 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 5 14:21:09 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 05 Oct 2017 14:21:09 -0000 Subject: [GHC] #14291: Tests tend to fail in the ext-interp way when split sections is enabled In-Reply-To: <046.50939ac6d09fd8ac7c487275ec7ee681@haskell.org> References: <046.50939ac6d09fd8ac7c487275ec7ee681@haskell.org> Message-ID: <061.c5e0663c1f7469db0d3d0f5f8feeb7d7@haskell.org> #14291: Tests tend to fail in the ext-interp way when split sections is enabled -------------------------------------+------------------------------------- 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: 13716 Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): Indeed there is some weird stuff that happens before we leave `base_GHCziException_zdfShowErrorCallzuzdcshowsPrec_info`: We encounter this instruction sequence, {{{ 0x00000000415cbdf8 ? mov 0xf(%rbx),%rsi 0x00000000415cbdfc ? mov 0x7(%rbx),%r14 0x00000000415cbe00 ? add $0x8,%rbp 0x00000000415cbe04 ? jmpq 0x415cbd00 }}} Where {{{ >>> ghc symbol 0x415cbd00 152 bytes into base_GHCziException_zdfExceptionSomeExceptionzuzdctoException_info (starts at 0x415cbc68) }}} There are a few things that are odd about this: 1. we are jumping into the middle of a procedure 2. the procedure seems to have nothing to do with showing an `ErrorCall` The Haskell this is derived from is, {{{#!hs instance Show ErrorCall where showsPrec _ (ErrorCallWithLocation err "") = showString err showsPrec _ (ErrorCallWithLocation err loc) = showString (err ++ '\n' : loc) }}} And the assembler that GHC produces for this particular block is, {{{ block_c4mu_info: _c4mu: movq 15(%rbx),%rsi movq 7(%rbx),%r14 addq $8,%rbp jmp GHC.Exception.$w$cshowsPrec1_info .size GHC.Exception.$fShowErrorCall_$cshowsPrec_info, .-GHC.Exception.$fShowErrorCall_$cshowsPrec_info }}} Strangely enough I can't find `GHC.Exception.$w$cshowsPrec1_info` in the RTS symbol table. According to `objdump` the relocation of the `jmp` looks like, {{{ 1eedc4: e9 00 00 00 00 jmpq 1eedc9 1eedc5: R_X86_64_PC32 base_GHCziException_zdwzdcshowsPrec1_info-0x4 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 5 15:26:11 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 05 Oct 2017 15:26:11 -0000 Subject: [GHC] #14291: Tests tend to fail in the ext-interp way when split sections is enabled In-Reply-To: <046.50939ac6d09fd8ac7c487275ec7ee681@haskell.org> References: <046.50939ac6d09fd8ac7c487275ec7ee681@haskell.org> Message-ID: <061.f2c9f481470d211c1841157f9184acd9@haskell.org> #14291: Tests tend to fail in the ext-interp way when split sections is enabled -------------------------------------+------------------------------------- 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: 13716 Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): Hmm, or perhaps not: it looks like the assembler at `0x415cbd00` matches what `objdump` says I should expect in `base_GHCziException_zdwzdcshowsPrec1_info`. It turns out I had a sign error in the [[https://github.com/bgamari/ghc- utils/commit/21f7c7f967f7a51bf3081617896225284116f9a6|Python code]] I was using to extract symbols out of the RTS. Silly silly me. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 5 15:37:34 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 05 Oct 2017 15:37:34 -0000 Subject: [GHC] #14256: GHCi is faster than compiled code In-Reply-To: <049.81e3e16f4addaa1f394251f9117591e6@haskell.org> References: <049.81e3e16f4addaa1f394251f9117591e6@haskell.org> Message-ID: <064.c104db1d8bb4b6c0f2b80cb6a2e4341b@haskell.org> #14256: GHCi is faster than compiled code -------------------------------------+------------------------------------- Reporter: mpickering | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by saep): I experienced the same thing with scotty and servant with ghc 8.0.2 (stackage snapshot lts-9.5). I ran it on nixos and debian (both 64 bit linux). The numbers I measured are very close to those above. The code was also very similar to the mentioned benchmark, so I don't think it's worth posting. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 5 15:42:06 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 05 Oct 2017 15:42:06 -0000 Subject: [GHC] #14279: Type families interfere with specialisation rewrite rules In-Reply-To: <051.c770f0db94d1fbd7b1e66a5d39f244a4@haskell.org> References: <051.c770f0db94d1fbd7b1e66a5d39f244a4@haskell.org> Message-ID: <066.7ea97b876f21119ccdfaccdf44292232@haskell.org> #14279: Type families interfere with specialisation rewrite rules -------------------------------------+------------------------------------- Reporter: IvanTimokhin | 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: Other | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by goldfire): Ah yes. The unreduced type family is in the ''target'', not the rule. I was skimming too quickly. In agreement with comment:2, I argue this is very much like my new `flatten_args` (see Phab:D3848). GHC's flattener is a component of its constraint solver that essentially implements a strongly-typed rewrite system, where the equations of the rewrite system are 1) type family equations, 2) assumed equalities (e.g., from GADTs), and 3) filled-in metavariables. Of course, a RULE is just an equation to be used in a rewrite system, just the same. The problem is that the two rewrite system implementations are utterly distinct within GHC, where it seems like they should be combined somehow. And, following on from comment:2, the new logic in my Phab:D3848 patch would need to be applied here, too. Interesting. I think this is doable, but I don't think it's done lightly (unlike Simon's conclusion above). -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 5 16:05:21 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 05 Oct 2017 16:05:21 -0000 Subject: [GHC] #14291: Tests tend to fail in the ext-interp way when split sections is enabled In-Reply-To: <046.50939ac6d09fd8ac7c487275ec7ee681@haskell.org> References: <046.50939ac6d09fd8ac7c487275ec7ee681@haskell.org> Message-ID: <061.7da95ab907c9a51584b5d6218b52f6ee@haskell.org> #14291: Tests tend to fail in the ext-interp way when split sections is enabled -------------------------------------+------------------------------------- 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: 13716 Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): Alright, so let's recap, When we enter `base_GHCziException_zdfShowErrorCallzuzdcshowsPrec_info` we have two perfectly valid looking arguments (an `I# 0` and a `ErrorCallWithLocation` constructor carrying a `:` constructor). From there we eventually jump to `base_GHCziException_zdwzdcshowsPrec1_info`, {{{#!hs GHC.Exception.$w$cshowsPrec1 [InlPrag=[0]] :: GHC.Base.String -> GHC.Base.String -> GHC.Show.ShowS }}} Here we have a reasonable-looking cons cell as the first argument. The second argument looked a bit suspicious at first but seems to check out {{{ >>> ghc closure $rsi THUNK (0x415cf708) Ptr: off-heap(0x0) Ptr: off-heap(0x400c5ddb) >>> ghc sym 0x415cf708 1216 bytes into base_GHCziException_prettyCallStack_info (starts at 0x415cf248) }}} This address appears to correspond to a certain `sat_s4i3 [Occ=Once] :: GHC.Base.String` We eventually end up entering this thunk. In this thunk we perform a call to `base_GHCziStackziTypes_getCallStack_info` {{{ GHC.Stack.Types.getCallStack [Occ=LoopBreaker] :: GHC.Stack.Types.CallStack -> [([GHC.Types.Char], GHC.Stack.Types.SrcLoc)] }}} which is given a rather odd looking argument, {{{ >>> print/a $r14 $13 = 0x400c5ddb >>> x/8a $r14 & ~7 0x400c5dd8: 0x0 0x41453420 0x400c5de8: 0x0 0x414534c8 0x400c5df8: 0x0 0x41453520 }}} It looks like **this** is the first real sign of trouble. which eventually leads to the crash when it we attempt an indirect jump to -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 5 16:17:56 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 05 Oct 2017 16:17:56 -0000 Subject: =?utf-8?b?UmU6IFtHSENdICMxNDMxMzog4oCcUmVzdWx0IHNpZ25hdHVyZXMg?= =?utf-8?q?are_no_longer_supported_in_pattern_matches=E2=80=9D_lo?= =?utf-8?q?st?= In-Reply-To: <046.f81b72f51154afa43f3605001c35a3f2@haskell.org> References: <046.f81b72f51154afa43f3605001c35a3f2@haskell.org> Message-ID: <061.1e10398b3a345614a08c209b6ac2bb20@haskell.org> #14313: “Result signatures are no longer supported in pattern matches” lost -------------------------------------+------------------------------------- Reporter: nomeata | Owner: nomeata Type: task | Status: patch Priority: low | 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: #2310 | Differential Rev(s): Phab:D4066 Wiki Page: | -------------------------------------+------------------------------------- Comment (by Joachim Breitner ): In [changeset:"d8d87fa2b22404b7939956974f53858c41ec7769/ghc" d8d87fa2/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="d8d87fa2b22404b7939956974f53858c41ec7769" Remove m_type from Match (#14313) this is a remains from supporting Result Type Signaturs in the ancient past. Differential Revision: https://phabricator.haskell.org/D4066 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 5 16:27:38 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 05 Oct 2017 16:27:38 -0000 Subject: [GHC] #14291: Tests tend to fail in the ext-interp way when split sections is enabled In-Reply-To: <046.50939ac6d09fd8ac7c487275ec7ee681@haskell.org> References: <046.50939ac6d09fd8ac7c487275ec7ee681@haskell.org> Message-ID: <061.4b8b3e8e41553b08548e0a2f4b063196@haskell.org> #14291: Tests tend to fail in the ext-interp way when split sections is enabled -------------------------------------+------------------------------------- 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: 13716 Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by hsyl20): Replying to [comment:9 bgamari]: > So I plugged away at this a bit today. I'm increasingly suspicious of 1c83fd814b12754be8af211a387cec906ca198b3 which touches a large amount of ELF linker logic. Unfortunately it's not terribly easy to revert. I don't know if it is related to this bug but the patch you mention has introduced the [https://git.haskell.org/ghc.git/blob/1c83fd814b12754be8af211a387cec906ca198b3:/rts/linker/Elf.c#l182 following line]: {{{#!hs oc->info->sectionHeaderStrtab = (char*)((uint8_t*)oc->image + oc->info->sectionHeader[oc->info->elfHeader->e_shstrndx].sh_offset); }}} which may be wrong when there are too many sections (splitSections...). Could you try replacing `oc->info->elfHeader->e_shstrndx` with `elf_shstrndx(oc->info->elfHeader)`? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 5 16:37:40 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 05 Oct 2017 16:37:40 -0000 Subject: [GHC] #14291: Tests tend to fail in the ext-interp way when split sections is enabled In-Reply-To: <046.50939ac6d09fd8ac7c487275ec7ee681@haskell.org> References: <046.50939ac6d09fd8ac7c487275ec7ee681@haskell.org> Message-ID: <061.5d6b99b2c52a3f2d3359557b763b8141@haskell.org> #14291: Tests tend to fail in the ext-interp way when split sections is enabled -------------------------------------+------------------------------------- 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: 13716 Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): hsyl20, that is a fair observation; unfortunately it's almost certainly not the cause of this issue as we are loading merged object files which have only around two dozen sections each. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 5 16:37:49 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 05 Oct 2017 16:37:49 -0000 Subject: [GHC] #14325: Erroneous program emits no errors Message-ID: <046.40df183102ba61ea001c050698aa9aba@haskell.org> #14325: Erroneous program emits no errors -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- Consider this (which arose in #14323): {{{ class (a~b) => C a b foo :: C a b => a -> b foo x = x hm3 :: C (f b) b => b -> f b hm3 x = foo x }}} With GHC 8.2 it compiles without error, but it definitely has a type error; try `-ddump-simpl`: {{{ hm3 :: forall (f :: * -> *) b. C (f b) b => b -> f b [GblId, Arity=2, Str=x] hm3 = \ (@ (f_a126 :: * -> *)) (@ b_a127) ($dC_a129 :: C (f_a126 b_a127) b_a127) _ [Occ=Dead] -> case GHC.Types.HEq_sc @ * @ * @ (f_a126 b_a127) @ b_a127 ($dC_a129 `cast` ((T14323.N:C[0] ; Data.Type.Equality.N:~[0] <*>_N) _N _N :: (C (f_a126 b_a127) b_a127 :: Constraint) ~R# ((f_a126 b_a127 :: *) ~~ (b_a127 :: *) :: Constraint))) of cobox_a12p { __DEFAULT -> case Control.Exception.Base.typeError @ 'GHC.Types.LiftedRep @ (C b_a127 (f_a126 b_a127)) "T14323.hs:28:9: error:\n\ \ \\226\\128\\162 Could not deduce (C b (f b)) arising from a use of \\226\\128\\152foo\\226\\128\\153\n\ \ from the context: C (f b) b\n\ \ bound by the type signature for:\n\ \ hm3 :: forall (f :: * -> *) b. C (f b) b => b -> f b\n\ \ at T14323.hs:27:1-28\n\ \ \\226\\128\\162 In the expression: foo x\n\ \ In an equation for \\226\\128\\152hm3\\226\\128\\153: hm3 x = foo x\n\ \(deferred type error)"# of wild_00 { } } }}} Reason: bug in the error suppression logic in `TcErrors` -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 5 16:42:20 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 05 Oct 2017 16:42:20 -0000 Subject: [GHC] #14291: Tests tend to fail in the ext-interp way when split sections is enabled In-Reply-To: <046.50939ac6d09fd8ac7c487275ec7ee681@haskell.org> References: <046.50939ac6d09fd8ac7c487275ec7ee681@haskell.org> Message-ID: <061.eb1f6dfab80c4b4e3c03acd84a0b8d88@haskell.org> #14291: Tests tend to fail in the ext-interp way when split sections is enabled -------------------------------------+------------------------------------- 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: 13716 Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): I've confirmed that the fix suggested in comment:25 has no effect on the issue at hand. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 5 17:05:36 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 05 Oct 2017 17:05:36 -0000 Subject: [GHC] #14326: Panic on COMPLETE pragma with mismatched type variable order Message-ID: <048.f5deafb28158a29aed954593a07be038@haskell.org> #14326: Panic on COMPLETE pragma with mismatched type variable order -------------------------------------+------------------------------------- Reporter: dailectic | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 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: -------------------------------------+------------------------------------- The motivating example is to allow patterns with phantom types to interact nicely with TypeApplications, so in the below we can do `L @Int :: a -> L a Int` to specify the phantom. {{{#!hs data E a b = L' a | R b pattern L :: forall b a. a -> E a b pattern L a = L' a {-# COMPLETE L, R #-} }}} The compiler balks {{{ ghc: panic! (the 'impossible' happened) (GHC version 8.2.1 for x86_64-unknown-linux): mkOneConFull: Not TyConApp: c_a50V 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/Check.hs:976:30 in ghc:Check 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 Thu Oct 5 17:38:02 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 05 Oct 2017 17:38:02 -0000 Subject: [GHC] #14326: Panic on COMPLETE pragma with mismatched type variable order In-Reply-To: <048.f5deafb28158a29aed954593a07be038@haskell.org> References: <048.f5deafb28158a29aed954593a07be038@haskell.org> Message-ID: <063.8f82f0b5feb94d229b194d06718abe24@haskell.org> #14326: Panic on COMPLETE pragma with mismatched type variable order -------------------------------------+------------------------------------- Reporter: dailectic | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 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 RyanGlScott): I feel like you're leaving out some important information here. I tried loading this file (I had to add some language extensions that you left out): {{{#!hs {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ScopedTypeVariables #-} module Bug where data E a b = L' a | R b pattern L :: forall b a. a -> E a b pattern L a = L' a {-# COMPLETE L, R #-} }}} I compiled this with 8.2.1, but it did not panic. What am I missing? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 5 18:14:06 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 05 Oct 2017 18:14:06 -0000 Subject: [GHC] #14291: Tests tend to fail in the ext-interp way when split sections is enabled In-Reply-To: <046.50939ac6d09fd8ac7c487275ec7ee681@haskell.org> References: <046.50939ac6d09fd8ac7c487275ec7ee681@haskell.org> Message-ID: <061.53295285706d5def3c21feb5ea90836f@haskell.org> #14291: Tests tend to fail in the ext-interp way when split sections is enabled -------------------------------------+------------------------------------- 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: 13716 Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): For the record, building both Stage2 and the libraries with `-fwhole- archive-hs-libs` seems to make no difference. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 5 18:15:36 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 05 Oct 2017 18:15:36 -0000 Subject: [GHC] #14326: Panic on COMPLETE pragma with mismatched type variable order In-Reply-To: <048.f5deafb28158a29aed954593a07be038@haskell.org> References: <048.f5deafb28158a29aed954593a07be038@haskell.org> Message-ID: <063.873a2b0d50d541f43d39b02a1eba1679@haskell.org> #14326: Panic on COMPLETE pragma with mismatched type variable order -------------------------------------+------------------------------------- Reporter: dailectic | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 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: | -------------------------------------+------------------------------------- Description changed by dailectic: Old description: > The motivating example is to allow patterns with phantom types to > interact nicely with TypeApplications, so in the below we can do `L @Int > :: a -> L a Int` to specify the phantom. > {{{#!hs > data E a b = L' a | R b > pattern L :: forall b a. a -> E a b > pattern L a = L' a > {-# COMPLETE L, R #-} > }}} > > The compiler balks > > {{{ > ghc: panic! (the 'impossible' happened) > (GHC version 8.2.1 for x86_64-unknown-linux): > mkOneConFull: Not TyConApp: > c_a50V > 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/Check.hs:976:30 in ghc:Check > > Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug > > }}} New description: The motivating example is to allow patterns with phantom types to interact nicely with TypeApplications, so in the below we can do `L @Int :: a -> L a Int` to specify the phantom. {{{#!hs data E a b = L' a | R b pattern L :: forall b a. a -> E a b pattern L a = L' a {-# COMPLETE L, R #-} }}} Issues occur when nesting cases {{{ {-# OPTIONS_GHC -fwarn-incomplete-patterns #-} testMono :: E (E Int Int) Int -> Int testMono x = case x of L (L _) -> 0 L (R _) -> 1 R _ -> 2 }}} And GHC panics when polymorphic {{{ {-# OPTIONS_GHC -fwarn-incomplete-patterns #-} testPoly :: E (E a b) c -> Int testPoly x = case x of L (L _) -> 0 L (R _) -> 1 R _ -> 2 }}} The compiler balks {{{ ghc: panic! (the 'impossible' happened) (GHC version 8.2.1 for x86_64-unknown-linux): mkOneConFull: Not TyConApp: c_a50V 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/Check.hs:976:30 in ghc:Check Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug }}} So it seems like there's two related issues here: 1. The COMPLETE pragma does not work in nesting for out-of-order type variables 2. Some printing logic is missing for the error in this polymorphic case Note that if we define {{{ pattern L :: forall a b. a -> E a b pattern L a = L' a }}} Note that we do not get the incomplete warning or the panic, so it seems directly related to the order of the variables, rather than explicit quantification in general -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 5 18:18:32 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 05 Oct 2017 18:18:32 -0000 Subject: [GHC] #14326: Panic on COMPLETE pragma with mismatched type variable order In-Reply-To: <048.f5deafb28158a29aed954593a07be038@haskell.org> References: <048.f5deafb28158a29aed954593a07be038@haskell.org> Message-ID: <063.1d8d3bc07b4dae3ae5b339382bb248a6@haskell.org> #14326: Panic on COMPLETE pragma with mismatched type variable order -------------------------------------+------------------------------------- Reporter: dailectic | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 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: | -------------------------------------+------------------------------------- Description changed by dailectic: Old description: > The motivating example is to allow patterns with phantom types to > interact nicely with TypeApplications, so in the below we can do `L @Int > :: a -> L a Int` to specify the phantom. > {{{#!hs > data E a b = L' a | R b > pattern L :: forall b a. a -> E a b > pattern L a = L' a > {-# COMPLETE L, R #-} > }}} > > Issues occur when nesting cases > > {{{ > {-# OPTIONS_GHC -fwarn-incomplete-patterns #-} > testMono :: E (E Int Int) Int -> Int > testMono x = case x of > L (L _) -> 0 > L (R _) -> 1 > R _ -> 2 > }}} > > And GHC panics when polymorphic > > {{{ > {-# OPTIONS_GHC -fwarn-incomplete-patterns #-} > testPoly :: E (E a b) c -> Int > testPoly x = case x of > L (L _) -> 0 > L (R _) -> 1 > R _ -> 2 > }}} > > The compiler balks > > {{{ > ghc: panic! (the 'impossible' happened) > (GHC version 8.2.1 for x86_64-unknown-linux): > mkOneConFull: Not TyConApp: > c_a50V > 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/Check.hs:976:30 in ghc:Check > > Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug > > }}} > > So it seems like there's two related issues here: > 1. The COMPLETE pragma does not work in nesting for out-of-order type > variables > 2. Some printing logic is missing for the error in this polymorphic case > > Note that if we define > > {{{ > pattern L :: forall a b. a -> E a b > pattern L a = L' a > }}} > > Note that we do not get the incomplete warning or the panic, so it seems > directly related to the order of the variables, rather than explicit > quantification in general New description: The motivating example is to allow patterns with phantom types to interact nicely with TypeApplications, so in the below we can do `L @Int :: a -> L a Int` to specify the phantom. {{{#!hs {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ExplicitForAll #-} data E a b = L' a | R b pattern L :: forall b a. a -> E a b pattern L a = L' a {-# COMPLETE L, R #-} }}} Issues occur when nesting cases {{{ {-# OPTIONS_GHC -fwarn-incomplete-patterns #-} testMono :: E (E Int Int) Int -> Int testMono x = case x of L (L _) -> 0 L (R _) -> 1 R _ -> 2 }}} And GHC panics when polymorphic {{{ {-# OPTIONS_GHC -fwarn-incomplete-patterns #-} testPoly :: E (E a b) c -> Int testPoly x = case x of L (L _) -> 0 L (R _) -> 1 R _ -> 2 }}} The compiler balks {{{ ghc: panic! (the 'impossible' happened) (GHC version 8.2.1 for x86_64-unknown-linux): mkOneConFull: Not TyConApp: c_a50V 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/Check.hs:976:30 in ghc:Check Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug }}} So it seems like there's two related issues here: 1. The COMPLETE pragma does not work in nesting for out-of-order type variables 2. Some printing logic is missing for the error in this polymorphic case Note that if we define {{{ pattern L :: forall a b. a -> E a b pattern L a = L' a }}} Note that we do not get the incomplete warning or the panic, so it seems directly related to the order of the variables, rather than explicit quantification in general -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 5 18:19:56 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 05 Oct 2017 18:19:56 -0000 Subject: [GHC] #14326: Panic on COMPLETE pragma with mismatched type variable order In-Reply-To: <048.f5deafb28158a29aed954593a07be038@haskell.org> References: <048.f5deafb28158a29aed954593a07be038@haskell.org> Message-ID: <063.66be1262fc1becbea4bd86703e7f284a@haskell.org> #14326: Panic on COMPLETE pragma with mismatched type variable order -------------------------------------+------------------------------------- Reporter: dailectic | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 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 dailectic): Replying to [comment:1 RyanGlScott]: > I feel like you're leaving out some important information here. I tried loading this file (I had to add some language extensions that you left out): > > {{{#!hs > {-# LANGUAGE PatternSynonyms #-} > {-# LANGUAGE ScopedTypeVariables #-} > module Bug where > > data E a b = L' a | R b > pattern L :: forall b a. a -> E a b > pattern L a = L' a > {-# COMPLETE L, R #-} > }}} > > I compiled this with 8.2.1, but it did not panic. What am I missing? Thanks, I was mistaken and the source seems to be in interaction with nested pattern matches rather than just the declaration. I've edited the ticket to reflect this. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 5 19:07:41 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 05 Oct 2017 19:07:41 -0000 Subject: [GHC] #14326: Panic on COMPLETE pragma with mismatched type variable order In-Reply-To: <048.f5deafb28158a29aed954593a07be038@haskell.org> References: <048.f5deafb28158a29aed954593a07be038@haskell.org> Message-ID: <063.5694c3766548a6b102b18e75f9eae67a@haskell.org> #14326: Panic on COMPLETE pragma with mismatched type variable order -------------------------------------+------------------------------------- Reporter: dailectic | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: | Keywords: | PatternSynonyms 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 RyanGlScott): * keywords: => PatternSynonyms Comment: Thanks for the update. Interestingly, this does //not// panic on GHC HEAD, which in some ways makes this like an inverse of #14135 (which panics with a `mkOneConFull` error on HEAD, but not 8.2.1). -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 5 19:23:37 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 05 Oct 2017 19:23:37 -0000 Subject: [GHC] #14291: Tests tend to fail in the ext-interp way when split sections is enabled In-Reply-To: <046.50939ac6d09fd8ac7c487275ec7ee681@haskell.org> References: <046.50939ac6d09fd8ac7c487275ec7ee681@haskell.org> Message-ID: <061.c098582d5fa870023a6cf46b2efab400@haskell.org> #14291: Tests tend to fail in the ext-interp way when split sections is enabled -------------------------------------+------------------------------------- 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: 13716 Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): Well, as noted in the conclusion of comment:25 it looks like this is a bug in `ld.gold` which decides to mangle our object files while merging. I don't yet know what in particular triggers the issue, however. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 5 19:26:45 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 05 Oct 2017 19:26:45 -0000 Subject: [GHC] #14291: Tests tend to fail in the ext-interp way when split sections is enabled In-Reply-To: <046.50939ac6d09fd8ac7c487275ec7ee681@haskell.org> References: <046.50939ac6d09fd8ac7c487275ec7ee681@haskell.org> Message-ID: <061.92f98c1f037e485508a5dd5533660046@haskell.org> #14291: Tests tend to fail in the ext-interp way when split sections is enabled -------------------------------------+------------------------------------- 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: 13716 Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): Well, at least `ld.gold` does slightly better than `ld.lld` (version 5.0), which simply segfaults. I hate linkers. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 5 19:36:24 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 05 Oct 2017 19:36:24 -0000 Subject: [GHC] #14326: Panic on COMPLETE pragma with mismatched type variable order In-Reply-To: <048.f5deafb28158a29aed954593a07be038@haskell.org> References: <048.f5deafb28158a29aed954593a07be038@haskell.org> Message-ID: <063.9c4e403091efdfff7255c65c21245297@haskell.org> #14326: Panic on COMPLETE pragma with mismatched type variable order -------------------------------------+------------------------------------- Reporter: dailectic | Owner: RyanGlScott Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: | Keywords: | PatternSynonyms 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 RyanGlScott): * owner: (none) => RyanGlScott Comment: Sure enough, the commit that fixed this bug (but also introduced the bug in #14135) was 6b77914cd37b697354611bcd87897885c1e5b4a6 (`Fix instantiation of pattern synonyms`). I'll add a regression test. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 5 19:48:36 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 05 Oct 2017 19:48:36 -0000 Subject: [GHC] #14326: Panic on COMPLETE pragma with mismatched type variable order In-Reply-To: <048.f5deafb28158a29aed954593a07be038@haskell.org> References: <048.f5deafb28158a29aed954593a07be038@haskell.org> Message-ID: <063.ca8fe20d3f079e85e328165daa196823@haskell.org> #14326: Panic on COMPLETE pragma with mismatched type variable order -------------------------------------+------------------------------------- Reporter: dailectic | Owner: RyanGlScott Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: | Keywords: | PatternSynonyms 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 Ryan Scott ): In [changeset:"429fafb5b2b1ac02fd04d9a98e30b5991125692c/ghc" 429fafb5/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="429fafb5b2b1ac02fd04d9a98e30b5991125692c" Add regression test for #14326 Commit 6b77914cd37b697354611bcd87897885c1e5b4a6 wound up fixing #14326. Let's add a regression test so that it stays that way. }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 5 19:49:27 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 05 Oct 2017 19:49:27 -0000 Subject: [GHC] #14326: Panic on COMPLETE pragma with mismatched type variable order In-Reply-To: <048.f5deafb28158a29aed954593a07be038@haskell.org> References: <048.f5deafb28158a29aed954593a07be038@haskell.org> Message-ID: <063.02d1d2235d2279e26e42907bc8e79442@haskell.org> #14326: Panic on COMPLETE pragma with mismatched type variable order -------------------------------------+------------------------------------- Reporter: dailectic | Owner: RyanGlScott Type: bug | Status: closed Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.2.1 Resolution: fixed | Keywords: | PatternSynonyms Operating System: Unknown/Multiple | Architecture: x86_64 | (amd64) Type of failure: Compile-time | Test Case: crash or panic | patsyn/should_compile/T14326 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * status: new => closed * testcase: => patsyn/should_compile/T14326 * resolution: => fixed * milestone: => 8.4.1 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 5 20:15:51 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 05 Oct 2017 20:15:51 -0000 Subject: [GHC] #14291: Tests tend to fail in the ext-interp way when split sections is enabled In-Reply-To: <046.50939ac6d09fd8ac7c487275ec7ee681@haskell.org> References: <046.50939ac6d09fd8ac7c487275ec7ee681@haskell.org> Message-ID: <061.9ac3d478921bbf9b018fa493e3c3eccf@haskell.org> #14291: Tests tend to fail in the ext-interp way when split sections is enabled -------------------------------------+------------------------------------- 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: 13716 Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): Alright, the `ld.gold` issue is still present as of `binutils` commit 2fd9d7ca17539ce983862b25e0abc27cfb706189. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 5 21:00:36 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 05 Oct 2017 21:00:36 -0000 Subject: [GHC] #14291: Tests tend to fail in the ext-interp way when split sections is enabled In-Reply-To: <046.50939ac6d09fd8ac7c487275ec7ee681@haskell.org> References: <046.50939ac6d09fd8ac7c487275ec7ee681@haskell.org> Message-ID: <061.81ccb6033623283e4509ca01cb50892b@haskell.org> #14291: Tests tend to fail in the ext-interp way when split sections is enabled -------------------------------------+------------------------------------- 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: 13716 Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): Hmmm, so it seems to have something to do with our `merge-sections.ld` linker script. I've reduced this down to a rather minimal [[https://github.com/bgamari/T14291-repro|reproduction case]] which still fails under `ld.gold` and `ld.lld`. Curiously, removing any of the remaining linker script sections in this testcase seems to prevent the issue. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 5 22:02:56 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 05 Oct 2017 22:02:56 -0000 Subject: [GHC] #14327: Type error in program caused by unrelated definition Message-ID: <050.d67f833bc4eee22a8647fc91e337b28e@haskell.org> #14327: Type error in program caused by unrelated definition -------------------------------------+------------------------------------- Reporter: lexi.lambda | 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: Incorrect Unknown/Multiple | error/warning at compile-time Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- ''Adapted from [https://stackoverflow.com/q/46595162/465378 this Stack Overflow question].'' The following program raises two type errors: {{{#!hs import Prelude hiding (readFile, writeFile) import Control.Monad.Free import Data.Functor.Sum data FileSystemF a = ReadFile FilePath (String -> a) | WriteFile FilePath String a deriving (Functor) data ConsoleF a = WriteLine String a deriving (Functor) data CloudF a = GetStackInfo String (String -> a) deriving (Functor) type App = Free (Sum FileSystemF (Sum ConsoleF CloudF)) readFile :: FilePath -> App String readFile path = liftF (InL (ReadFile path id)) writeFile :: FilePath -> String -> App () writeFile path contents = liftF (InL (WriteFile path contents ())) writeLine :: String -> App () writeLine line = liftF (InR (WriteLine line ())) }}} {{{ /private/tmp/free-sandbox/src/FreeSandbox.hs:26:27: error: • Couldn't match type ‘ConsoleF’ with ‘Sum ConsoleF CloudF’ arising from a functional dependency between constraints: ‘MonadFree (Sum FileSystemF (Sum ConsoleF CloudF)) (Free (Sum FileSystemF (Sum ConsoleF CloudF)))’ arising from a use of ‘liftF’ at src/FreeSandbox.hs:26:27-66 ‘MonadFree (Sum FileSystemF ConsoleF) (Free (Sum FileSystemF (Sum ConsoleF CloudF)))’ arising from a use of ‘liftF’ at src/FreeSandbox.hs:29:18-48 • In the expression: liftF (InL (WriteFile path contents ())) In an equation for ‘writeFile’: writeFile path contents = liftF (InL (WriteFile path contents ())) | 26 | writeFile path contents = liftF (InL (WriteFile path contents ())) | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ /private/tmp/free-sandbox/src/FreeSandbox.hs:29:18: error: • Couldn't match type ‘Sum ConsoleF CloudF’ with ‘ConsoleF’ arising from a functional dependency between: constraint ‘MonadFree (Sum FileSystemF ConsoleF) (Free (Sum FileSystemF (Sum ConsoleF CloudF)))’ arising from a use of ‘liftF’ instance ‘MonadFree f (Free f)’ at • In the expression: liftF (InR (WriteLine line ())) In an equation for ‘writeLine’: writeLine line = liftF (InR (WriteLine line ())) | 29 | writeLine line = liftF (InR (WriteLine line ())) | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ }}} The second of the two errors (the one on line 29) makes sense—it’s an error I would expect (there is a missing use of `InL`). However, the first error seems incorrect, as the definition of `writeFile` is, in fact, well- typed. In fact, if the definition of `writeLine` is commented out, the program typechecks! It gets weirder: if the definition of `writeLine` is moved in between the definitions of `readFile` and `writeFile`, then the unexpected error is reported for the definition of ''`readFile`'', and if `writeLine` is moved above both of them, then the error isn’t reported at all! This implies that a well-typed function (`writeFile`) can actually become ill-typed after the addition of an unrelated, ill-typed definition (`writeLine`). That seems like a bug to me. I was able to reproduce this issue on GHC 7.10.3, 8.0.2, and 8.2.1. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 5 22:27:56 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 05 Oct 2017 22:27:56 -0000 Subject: [GHC] #14328: ld.gold -r brokenness breaks SplitSections=YES builds Message-ID: <046.4964a55f6e0726ca18cbbd2bccaf25b7@haskell.org> #14328: ld.gold -r brokenness breaks SplitSections=YES builds -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: 14291 | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- See https://sourceware.org/bugzilla/show_bug.cgi?id=22266. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 5 22:28:07 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 05 Oct 2017 22:28:07 -0000 Subject: [GHC] #14328: ld.gold -r brokenness breaks SplitSections=YES builds In-Reply-To: <046.4964a55f6e0726ca18cbbd2bccaf25b7@haskell.org> References: <046.4964a55f6e0726ca18cbbd2bccaf25b7@haskell.org> Message-ID: <061.843238b9d037cc91ac9d71c46d60590f@haskell.org> #14328: ld.gold -r brokenness breaks SplitSections=YES builds -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: upstream 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: 14291 Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: new => upstream -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 5 22:28:43 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 05 Oct 2017 22:28:43 -0000 Subject: [GHC] #14291: Tests tend to fail in the ext-interp way when split sections is enabled In-Reply-To: <046.50939ac6d09fd8ac7c487275ec7ee681@haskell.org> References: <046.50939ac6d09fd8ac7c487275ec7ee681@haskell.org> Message-ID: <061.df4987eeba9ad40a4df2a317b613bc52@haskell.org> #14291: Tests tend to fail in the ext-interp way when split sections is enabled -------------------------------------+------------------------------------- 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: 13716 Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * blockedby: 14328 => Comment: I have opened #14328 to track the `ld.gold` brokenness since this really isn't a GHC issue. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 5 22:30:06 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 05 Oct 2017 22:30:06 -0000 Subject: [GHC] #14291: Tests tend to fail in the ext-interp way when split sections is enabled In-Reply-To: <046.50939ac6d09fd8ac7c487275ec7ee681@haskell.org> References: <046.50939ac6d09fd8ac7c487275ec7ee681@haskell.org> Message-ID: <061.35631923f6575d5628b52bb6a073df07@haskell.org> #14291: Tests tend to fail in the ext-interp way when split sections is enabled -------------------------------------+------------------------------------- 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: 14328 | Blocking: 13716 Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * blockedby: => 14328 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 5 22:43:41 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 05 Oct 2017 22:43:41 -0000 Subject: [GHC] #14327: Type error in program caused by unrelated definition In-Reply-To: <050.d67f833bc4eee22a8647fc91e337b28e@haskell.org> References: <050.d67f833bc4eee22a8647fc91e337b28e@haskell.org> Message-ID: <065.2f9a560da1466de3b0ed61fdacaddc35@haskell.org> #14327: Type error in program caused by unrelated definition -------------------------------------+------------------------------------- Reporter: lexi.lambda | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.2.1 checker) | 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 dfeuer): Even weirder: when I added the definitions of the relevant functions and classes from `Control.Monad.Free` to the test module (to remove the dependency on `free`), I found that the problem is now sensitive to the definition order in a ''different way''. {{{#!hs {-# language DeriveFunctor, FunctionalDependencies , MultiParamTypeClasses, FlexibleInstances #-} module T14327 where import Prelude hiding (readFile, writeFile) import Data.Functor.Sum data Free f a = Pure a | Free (f (Free f a)) deriving (Functor) class Monad m => MonadFree f m | m -> f where wrap :: f (m a) -> m a instance MonadFree f (Free f) where wrap = Free liftF :: (Functor f, MonadFree f m) => f a -> m a liftF fa = wrap (return <$> fa) data FileSystemF a = ReadFile FilePath (String -> a) | WriteFile FilePath String a deriving (Functor) data ConsoleF a = WriteLine String a deriving (Functor) data CloudF a = GetStackInfo String (String -> a) deriving (Functor) type App = Free (Sum FileSystemF (Sum ConsoleF CloudF)) }}} The surprising error does not occur with the three functions defined in their original order, but it ''does'' occur if `writeLine` appears ''before'' at least one of the other definitions. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 5 22:44:23 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 05 Oct 2017 22:44:23 -0000 Subject: [GHC] #14327: Type error in program caused by unrelated definition In-Reply-To: <050.d67f833bc4eee22a8647fc91e337b28e@haskell.org> References: <050.d67f833bc4eee22a8647fc91e337b28e@haskell.org> Message-ID: <065.f456c50f19e36c60a7585877fc1f4706@haskell.org> #14327: Type error in program caused by unrelated definition -------------------------------------+------------------------------------- Reporter: lexi.lambda | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.4.1 Component: Compiler (Type | Version: 8.2.1 checker) | 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: | -------------------------------------+------------------------------------- Changes (by dfeuer): * cc: dfeuer (added) * milestone: => 8.4.1 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 5 22:58:39 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 05 Oct 2017 22:58:39 -0000 Subject: [GHC] #14324: Consider deprecating STM invariant mechanism In-Reply-To: <046.7d9457872c0d5f0243f1b38705442b7b@haskell.org> References: <046.7d9457872c0d5f0243f1b38705442b7b@haskell.org> Message-ID: <061.7596709f163eb60f6d1704780a37703e@haskell.org> #14324: Consider deprecating STM invariant mechanism -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: task | Status: new 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: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): I've opened a [[https://github.com/ghc-proposals/ghc-proposals/pull/77|GHC proposal]]. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 6 00:16:00 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 06 Oct 2017 00:16:00 -0000 Subject: [GHC] #14309: Expand comment in hPutStrLn In-Reply-To: <045.d57739ec737fed854d627d9f1df20af7@haskell.org> References: <045.d57739ec737fed854d627d9f1df20af7@haskell.org> Message-ID: <060.30fa337931313aa44b8807eec1d33930@haskell.org> #14309: Expand comment in hPutStrLn -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: (none) Type: task | Status: new Priority: normal | Milestone: 8.4.1 Component: Core Libraries | Version: 8.2.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Documentation | Unknown/Multiple bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): This is a reference to the change made in 62c11c91879a26187f79575391842f44e770f2d5. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 6 00:18:50 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 06 Oct 2017 00:18:50 -0000 Subject: [GHC] #14300: FreeBSD 10.3 toolchain is terribly broken In-Reply-To: <046.2e6e216e2555895c84fcbcae84e4e04e@haskell.org> References: <046.2e6e216e2555895c84fcbcae84e4e04e@haskell.org> Message-ID: <061.8d857cbc64afe1a0cecea91dce26daae@haskell.org> #14300: FreeBSD 10.3 toolchain is terribly broken ---------------------------------+---------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: fixed | Keywords: Operating System: FreeBSD | Architecture: Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #13974 | Differential Rev(s): Wiki Page: | ---------------------------------+---------------------------------------- Comment (by bgamari): Thanks for the context! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 6 00:27:36 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 06 Oct 2017 00:27:36 -0000 Subject: [GHC] #14115: GHC segfaults trying to use TH code when ghc is compiled as DYNAMIC_GHC_PROGRAMS=NO In-Reply-To: <044.b3cd3c1bf232141df45df0c09168c130@haskell.org> References: <044.b3cd3c1bf232141df45df0c09168c130@haskell.org> Message-ID: <059.e417e6db4e3e82c73a8fb15aa61459ff@haskell.org> #14115: GHC segfaults trying to use TH code when ghc is compiled as DYNAMIC_GHC_PROGRAMS=NO -------------------------------------+------------------------------------- Reporter: pacak | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: Component: Runtime System | Version: 8.2.1 (Linker) | Resolution: | Keywords: Operating System: Linux | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D3983 Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): I suspect that this may be another manifestation of #14328. pacak, are you using `ld.gold`? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 6 00:33:24 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 06 Oct 2017 00:33:24 -0000 Subject: [GHC] #14115: GHC segfaults trying to use TH code when ghc is compiled as DYNAMIC_GHC_PROGRAMS=NO In-Reply-To: <044.b3cd3c1bf232141df45df0c09168c130@haskell.org> References: <044.b3cd3c1bf232141df45df0c09168c130@haskell.org> Message-ID: <059.3bb4e0d1aa6cb2901925eef866585885@haskell.org> #14115: GHC segfaults trying to use TH code when ghc is compiled as DYNAMIC_GHC_PROGRAMS=NO -------------------------------------+------------------------------------- Reporter: pacak | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: Component: Runtime System | Version: 8.2.1 (Linker) | Resolution: | Keywords: Operating System: Linux | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D3983 Wiki Page: | -------------------------------------+------------------------------------- Comment (by pacak): Looks like it, but that's what ghc decided to use on it's own free will. {{{ % egrep ^LD= config.log LD='ld.gold' }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 6 00:43:07 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 06 Oct 2017 00:43:07 -0000 Subject: [GHC] #14327: Type error in program caused by unrelated definition In-Reply-To: <050.d67f833bc4eee22a8647fc91e337b28e@haskell.org> References: <050.d67f833bc4eee22a8647fc91e337b28e@haskell.org> Message-ID: <065.0bc5edaeae81192185acbecf7674d2f1@haskell.org> #14327: Type error in program caused by unrelated definition -------------------------------------+------------------------------------- Reporter: lexi.lambda | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.4.1 Component: Compiler (Type | Version: 8.2.1 checker) | 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 RyanGlScott): I'm a bit confused here. The program in comment:1 is incomplete, and it's not clear to me where you put `writeLine` and friends after the fact. Can you post the complete version of the programs you're running, with and without the reordering of `writeLine`? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 6 00:46:34 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 06 Oct 2017 00:46:34 -0000 Subject: [GHC] #14328: ld.gold -r brokenness breaks SplitSections=YES builds In-Reply-To: <046.4964a55f6e0726ca18cbbd2bccaf25b7@haskell.org> References: <046.4964a55f6e0726ca18cbbd2bccaf25b7@haskell.org> Message-ID: <061.79a78e9d2b2c98c3d51fad91b35d1397@haskell.org> #14328: ld.gold -r brokenness breaks SplitSections=YES builds -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: upstream 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: 14291 Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Description changed by bgamari: Old description: > See https://sourceware.org/bugzilla/show_bug.cgi?id=22266. New description: See https://sourceware.org/bugzilla/show_bug.cgi?id=22266. Repro: https://github.com/bgamari/T14291-repro -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 6 00:50:21 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 06 Oct 2017 00:50:21 -0000 Subject: [GHC] #14324: Consider deprecating STM invariant mechanism In-Reply-To: <046.7d9457872c0d5f0243f1b38705442b7b@haskell.org> References: <046.7d9457872c0d5f0243f1b38705442b7b@haskell.org> Message-ID: <061.d60a463d3ff5efa4eb8e90c722b55bc3@haskell.org> #14324: Consider deprecating STM invariant mechanism -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: task | Status: new 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: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): fryguybob notes that he has a commit removing the feature: https://github.com/fryguybob/ghc/commit/38befad8a05406f1c553aba1f5e42929b68eba13 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 6 02:22:34 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 06 Oct 2017 02:22:34 -0000 Subject: [GHC] #14115: GHC segfaults trying to use TH code when ghc is compiled as DYNAMIC_GHC_PROGRAMS=NO In-Reply-To: <044.b3cd3c1bf232141df45df0c09168c130@haskell.org> References: <044.b3cd3c1bf232141df45df0c09168c130@haskell.org> Message-ID: <059.2c7ad70ce18f97b45a2404d6a486c41b@haskell.org> #14115: GHC segfaults trying to use TH code when ghc is compiled as DYNAMIC_GHC_PROGRAMS=NO -------------------------------------+------------------------------------- Reporter: pacak | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: Component: Runtime System | Version: 8.2.1 (Linker) | Resolution: | Keywords: Operating System: Linux | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D3983 Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): Indeed compiling with `ld.bfd` instead seems to avoid this. I strongly suspect this is a duplicate of #14328. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 6 02:24:12 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 06 Oct 2017 02:24:12 -0000 Subject: [GHC] #14323: Occurs check regressions in GHC 8.2.1 (and HEAD) In-Reply-To: <050.dbbfdd1cdcddb65fbaceda43a16d7074@haskell.org> References: <050.dbbfdd1cdcddb65fbaceda43a16d7074@haskell.org> Message-ID: <065.89632d9767fc4ad8bdac25447d7e86b8@haskell.org> #14323: Occurs check regressions in GHC 8.2.1 (and HEAD) -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.2.1 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 goldfire): Some reactions to all this: * comment:3 talks about parking `Coercible` constraints in the insolubles. I hope we don't -- they're not insoluble. I imagine you mean that they're parked in the "irreducibles", which is more sensible. * The representational equality solver is known to be incomplete. I believe the problem is simply undecidable. Perhaps this could be better documented, but its incompleteness is precisely in recursive situations. * I agree that the reason for occurs-checks isn't about solubility, but rather about keeping the solver from going into gratuitous loops. Bottom line: I don't have any better ideas. I doubt we can make the `Coercible` solver more complete without gross hacks. And, absent a Real Use Case, I'm not keen on trying. I have not digested all of #12466 about nominal equalities, which I tend to think are more worrisome. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 6 02:24:29 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 06 Oct 2017 02:24:29 -0000 Subject: [GHC] #14327: Type error in program caused by unrelated definition In-Reply-To: <050.d67f833bc4eee22a8647fc91e337b28e@haskell.org> References: <050.d67f833bc4eee22a8647fc91e337b28e@haskell.org> Message-ID: <065.1b8e7fd222c0df6a11c6ee9bdcd3dcf8@haskell.org> #14327: Type error in program caused by unrelated definition -------------------------------------+------------------------------------- Reporter: lexi.lambda | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: 8.4.1 Component: Compiler (Type | Version: 8.2.1 checker) | Resolution: duplicate | Keywords: FunDeps Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect | Unknown/Multiple error/warning at compile-time | Test Case: Blocked By: | Blocking: Related Tickets: #13506 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * keywords: => FunDeps * status: new => closed * resolution: => duplicate * related: => #13506 Comment: OK, it turns out this is actually a duplicate of #13506. First, here is the program that I tested, for the sake of posterity: {{{#!hs {-# language DeriveFunctor, FunctionalDependencies , MultiParamTypeClasses, FlexibleInstances #-} module T14327 where import Prelude hiding (readFile, writeFile) import Data.Functor.Sum data Free f a = Pure a | Free (f (Free f a)) deriving (Functor) class Monad m => MonadFree f m | m -> f where wrap :: f (m a) -> m a instance Functor f => Applicative (Free f) instance Functor f => Monad (Free f) instance Functor f => MonadFree f (Free f) where wrap = Free liftF :: (Functor f, MonadFree f m) => f a -> m a liftF fa = wrap (return <$> fa) data FileSystemF a = ReadFile FilePath (String -> a) | WriteFile FilePath String a deriving (Functor) data ConsoleF a = WriteLine String a deriving (Functor) data CloudF a = GetStackInfo String (String -> a) deriving (Functor) type App = Free (Sum FileSystemF (Sum ConsoleF CloudF)) writeLine :: String -> App () writeLine line = liftF (InR (WriteLine line ())) readFile :: FilePath -> App String readFile path = liftF (InL (ReadFile path id)) writeFile :: FilePath -> String -> App () writeFile path contents = liftF (InL (WriteFile path contents ())) }}} On GHC 8.2.1 and earlier, this does indeed spuriously give more errors than it should: {{{ GHCi, version 8.2.1: http://www.haskell.org/ghc/ :? for help Loaded GHCi configuration from /home/rgscott/.ghci [1 of 1] Compiling T14327 ( /u/rgscott/Documents/Hacking/Haskell/Bug.hs, interpreted ) /u/rgscott/Documents/Hacking/Haskell/Bug.hs:37:18: error: • Couldn't match type ‘Sum ConsoleF CloudF’ with ‘ConsoleF’ arising from a functional dependency between: constraint ‘MonadFree (Sum FileSystemF ConsoleF) (Free (Sum FileSystemF (Sum ConsoleF CloudF)))’ arising from a use of ‘liftF’ instance ‘MonadFree f (Free f)’ at /u/rgscott/Documents/Hacking/Haskell/Bug.hs:15:10-42 • In the expression: liftF (InR (WriteLine line ())) In an equation for ‘writeLine’: writeLine line = liftF (InR (WriteLine line ())) | 37 | writeLine line = liftF (InR (WriteLine line ())) | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ /u/rgscott/Documents/Hacking/Haskell/Bug.hs:40:17: error: • Couldn't match type ‘ConsoleF’ with ‘Sum ConsoleF CloudF’ arising from a functional dependency between constraints: ‘MonadFree (Sum FileSystemF (Sum ConsoleF CloudF)) (Free (Sum FileSystemF (Sum ConsoleF CloudF)))’ arising from a use of ‘liftF’ at /u/rgscott/Documents/Hacking/Haskell/Bug.hs:40:17-46 ‘MonadFree (Sum FileSystemF ConsoleF) (Free (Sum FileSystemF (Sum ConsoleF CloudF)))’ arising from a use of ‘liftF’ at /u/rgscott/Documents/Hacking/Haskell/Bug.hs:37:18-48 • In the expression: liftF (InL (ReadFile path id)) In an equation for ‘readFile’: readFile path = liftF (InL (ReadFile path id)) | 40 | readFile path = liftF (InL (ReadFile path id)) | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ }}} But on GHC HEAD, it doesn't! {{{ GHCi, version 8.3.20171004: http://www.haskell.org/ghc/ :? for help Loaded GHCi configuration from /home/rgscott/.ghci [1 of 1] Compiling T14327 ( /u/rgscott/Documents/Hacking/Haskell/Bug.hs, interpreted ) /u/rgscott/Documents/Hacking/Haskell/Bug.hs:37:18: error: • Couldn't match type ‘Sum ConsoleF CloudF’ with ‘ConsoleF’ arising from a functional dependency between: constraint ‘MonadFree (Sum FileSystemF ConsoleF) (Free (Sum FileSystemF (Sum ConsoleF CloudF)))’ arising from a use of ‘liftF’ instance ‘MonadFree f (Free f)’ at /u/rgscott/Documents/Hacking/Haskell/Bug.hs:15:10-42 • In the expression: liftF (InR (WriteLine line ())) In an equation for ‘writeLine’: writeLine line = liftF (InR (WriteLine line ())) | 37 | writeLine line = liftF (InR (WriteLine line ())) | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ }}} It turns out that commit 48daaaf0bba279b6e362ee5c632de69ed31ab65d (`Don't report fundep wanted/wanted errors`) fixed this problem. This led me to realize that this entire ticket is simply a more involved version of the program in #13506 (which concerns error cascades with functional dependencies), the ticket that the aforementioned commit originally fixed. So I'll close this as a duplicate. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 6 02:28:46 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 06 Oct 2017 02:28:46 -0000 Subject: [GHC] #14323: Occurs check regressions in GHC 8.2.1 (and HEAD) In-Reply-To: <050.dbbfdd1cdcddb65fbaceda43a16d7074@haskell.org> References: <050.dbbfdd1cdcddb65fbaceda43a16d7074@haskell.org> Message-ID: <065.1868bb10660d83306f81482ef85141ed@haskell.org> #14323: Occurs check regressions in GHC 8.2.1 (and HEAD) -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.2.1 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 RyanGlScott): Given that the incompleteness of the representational equality solver has spawned at least a couple of Track tickets (this one and #14247, off the top of my head), it would be nice to document all of this somewhere. (Perhaps `Data.Coerce`?) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 6 02:58:30 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 06 Oct 2017 02:58:30 -0000 Subject: [GHC] #14319: Stuck type families can lead to lousy error messages In-Reply-To: <045.325a1c439073c01e464a5d95796bd31d@haskell.org> References: <045.325a1c439073c01e464a5d95796bd31d@haskell.org> Message-ID: <060.7db3f997cb149c05b24e99d7c28b45e1@haskell.org> #14319: Stuck type families can lead to lousy error messages -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.4.1 Component: Compiler (Type | Version: 8.3 checker) | Keywords: TypeInType, Resolution: | TypeFamilies 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 goldfire): While I agree that these error messages are perhaps misleading, I argue that we should protect the common case from erosion. What I mean here is that the vast majority of these kinds of errors are, I'm sure, places where arities ''are'' known, and I would want to continue to report those. I would even want to do this if, sometimes, an error message is a bit wrong -- the cognoscenti that write the code leading to the error messages will know better, anyway. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 6 03:02:20 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 06 Oct 2017 03:02:20 -0000 Subject: [GHC] #14319: Stuck type families can lead to lousy error messages In-Reply-To: <045.325a1c439073c01e464a5d95796bd31d@haskell.org> References: <045.325a1c439073c01e464a5d95796bd31d@haskell.org> Message-ID: <060.90219593bb6a17924eb4009bdcae0b47@haskell.org> #14319: Stuck type families can lead to lousy error messages -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.4.1 Component: Compiler (Type | Version: 8.3 checker) | Keywords: TypeInType, Resolution: | TypeFamilies 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 dfeuer): How hard would it be to report an arity error only when we know the arity is wrong? And how often do we not know for sure? I don't want erosion of the common case either, but I don't see why it would be likely here. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 6 04:00:07 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 06 Oct 2017 04:00:07 -0000 Subject: [GHC] #14115: GHC segfaults trying to use TH code when ghc is compiled as DYNAMIC_GHC_PROGRAMS=NO In-Reply-To: <044.b3cd3c1bf232141df45df0c09168c130@haskell.org> References: <044.b3cd3c1bf232141df45df0c09168c130@haskell.org> Message-ID: <059.1f1e8197bea8f996c49e9c6ee6dd7d1e@haskell.org> #14115: GHC segfaults trying to use TH code when ghc is compiled as DYNAMIC_GHC_PROGRAMS=NO -------------------------------------+------------------------------------- Reporter: pacak | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: Component: Runtime System | Version: 8.2.1 (Linker) | Resolution: | Keywords: Operating System: Linux | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D3983 Wiki Page: | -------------------------------------+------------------------------------- Comment (by pacak): Using `ld` as a linker also helped, feel free to close this bug as duplicate. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 6 09:03:23 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 06 Oct 2017 09:03:23 -0000 Subject: [GHC] #14323: Occurs check regressions in GHC 8.2.1 (and HEAD) In-Reply-To: <050.dbbfdd1cdcddb65fbaceda43a16d7074@haskell.org> References: <050.dbbfdd1cdcddb65fbaceda43a16d7074@haskell.org> Message-ID: <065.8e8afa09c0c4a00dd8fa044d906ed7b9@haskell.org> #14323: Occurs check regressions in GHC 8.2.1 (and HEAD) -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.2.1 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): > comment:3 talks about parking Coercible constraints in the insolubles Actually the `Coercible b (f b)` constraint is parked in the inert dicts. But the `b ~R# f b` constraint is parked in insolubles. It probably shouldn't be. But in fact I want to kill off the insolubles altogether, and combine then with tie irreducibles. I don't think the distinction pays its way. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 6 13:04:58 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 06 Oct 2017 13:04:58 -0000 Subject: [GHC] #14256: GHCi is faster than compiled code In-Reply-To: <049.81e3e16f4addaa1f394251f9117591e6@haskell.org> References: <049.81e3e16f4addaa1f394251f9117591e6@haskell.org> Message-ID: <064.5cad66eebbed110a176c60921281ce7f@haskell.org> #14256: GHCi is faster than compiled code -------------------------------------+------------------------------------- Reporter: mpickering | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by saep): I think the problem is with the benchmarking tool. I used apache bench and got the same results as above. Just today, a colleague recommended to use wrk (https://github.com/wg/wrk) for benchmarking and with it, the compiled binary was always faster. I initially suspected that the threaded runtime of the compiled binary could have been responsible for the slow-down because running the server from ghci only occupied 1 core whereas the binary used all my 8(ish) cores. When I only use "-O2" and not "-O2 -threaded -rtsopts -with- rtsopts=-N", the apache bench measurements of the compiled binary were, as intuitively expected, better than the ghci ones. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 6 13:13:24 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 06 Oct 2017 13:13:24 -0000 Subject: [GHC] #14256: GHCi is faster than compiled code In-Reply-To: <049.81e3e16f4addaa1f394251f9117591e6@haskell.org> References: <049.81e3e16f4addaa1f394251f9117591e6@haskell.org> Message-ID: <064.0f76cdfa4cfc8ff8bcb5b5a4c843d82c@haskell.org> #14256: GHCi is faster than compiled code -------------------------------------+------------------------------------- Reporter: mpickering | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): Thanks for looking into this saep! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 6 13:24:20 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 06 Oct 2017 13:24:20 -0000 Subject: [GHC] #14329: GHC 8.2.1 segfaults while bootstrapping master Message-ID: <046.2503a1f6f14456a42761d49ce89e96f2@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 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: -------------------------------------+------------------------------------- Earlier this week the Linux/amd64 Harbormaster started failing somewhat reliably during validation. It seems the stage0 compiler (GHC 8.2.1) often fails with a segmentation fault. This seems to have started with ef26182e2014b0a2a029ae466a4b121bf235e4e4 although I suspect this isn't causal. I was able to capture a core dump of the crashing stage0 compiler which implicates the allocator, {{{ Reading symbols from /opt/ghc/8.2.1/lib/ghc-8.2.1/bin/ghc...(no debugging symbols found)...done. [New LWP 25151] [New LWP 25160] [New LWP 25156] [New LWP 25158] [New LWP 25157] [Thread debugging using libthread_db enabled] Using host libthread_db library "/lib/x86_64-linux-gnu/libthread_db.so.1". Core was generated by `/opt/ghc/8.2.1/lib/ghc-8.2.1/bin/ghc -B/opt/ghc/8.2.1/lib/ghc-8.2.1 -hisuf hi -'. Program terminated with signal SIGSEGV, Segmentation fault. #0 0x00007f836aaa2c90 in ?? () from /opt/ghc/8.2.1/lib/ghc-8.2.1/bin/../rts/libHSrts_thr-ghc8.2.1.so [Current thread is 1 (Thread 0x7f83711b5340 (LWP 25151))] (gdb) bt #0 0x00007f836aaa2c90 in ?? () from /opt/ghc/8.2.1/lib/ghc-8.2.1/bin/../rts/libHSrts_thr-ghc8.2.1.so #1 0x00007f836aaa3211 in allocGroupOnNode () from /opt/ghc/8.2.1/lib/ghc-8.2.1/bin/../rts/libHSrts_thr-ghc8.2.1.so #2 0x00007f836aa9dd41 in ?? () from /opt/ghc/8.2.1/lib/ghc-8.2.1/bin/../rts/libHSrts_thr-ghc8.2.1.so #3 0x00007f836aa9deb9 in ?? () from /opt/ghc/8.2.1/lib/ghc-8.2.1/bin/../rts/libHSrts_thr-ghc8.2.1.so #4 0x00007f836aa82a39 in ?? () from /opt/ghc/8.2.1/lib/ghc-8.2.1/bin/../rts/libHSrts_thr-ghc8.2.1.so #5 0x00007f836aa7fc06 in ?? () from /opt/ghc/8.2.1/lib/ghc-8.2.1/bin/../rts/libHSrts_thr-ghc8.2.1.so #6 0x00007f836aa9d461 in ?? () from /opt/ghc/8.2.1/lib/ghc-8.2.1/bin/../rts/libHSrts_thr-ghc8.2.1.so #7 0x00007f836aaa423a in ?? () from /opt/ghc/8.2.1/lib/ghc-8.2.1/bin/../rts/libHSrts_thr-ghc8.2.1.so #8 0x00007f836aaa4b3c in ?? () from /opt/ghc/8.2.1/lib/ghc-8.2.1/bin/../rts/libHSrts_thr-ghc8.2.1.so #9 0x00007f836aa8bbc8 in ?? () from /opt/ghc/8.2.1/lib/ghc-8.2.1/bin/../rts/libHSrts_thr-ghc8.2.1.so #10 0x00007f836aa8c912 in ?? () from /opt/ghc/8.2.1/lib/ghc-8.2.1/bin/../rts/libHSrts_thr-ghc8.2.1.so #11 0x00007f836aa8da01 in scheduleWaitThread () from /opt/ghc/8.2.1/lib/ghc-8.2.1/bin/../rts/libHSrts_thr-ghc8.2.1.so #12 0x00007f836aa99fae in hs_main () from /opt/ghc/8.2.1/lib/ghc-8.2.1/bin/../rts/libHSrts_thr-ghc8.2.1.so #13 0x0000000000427038 in ?? () #14 0x00007f83694fd2b1 in __libc_start_main (main=0x426fd0, argc=119, argv=0x7fffcfee8078, init=, fini=, rtld_fini=, stack_end=0x7fffcfee8068) at ../csu/libc- start.c:291 #15 0x0000000000427069 in ?? () }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 6 13:44:58 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 06 Oct 2017 13:44:58 -0000 Subject: [GHC] #14330: Sparks are not started promptly Message-ID: <049.15689449c051500fed95f985fcea2e55@haskell.org> #14330: Sparks are not started promptly -------------------------------------+------------------------------------- Reporter: andrewthad | Owner: (none) Type: feature | Status: new request | Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Keywords: sparks | 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 was a question on StackOverflow. With some prompting from Yuras, I've decided to open this as an issue. Here is the original question (which has been satisfactorily answered): https://stackoverflow.com/questions/46586941/why-are-ghc-sparks- fizzling/46603680?noredirect=1#comment80163830_46603680 Here is a more narrowly tailored version of the code I have posted there: {{{#!hs {-# LANGUAGE BangPatterns #-} {-# OPTIONS_GHC -O2 -Wall -threaded -fforce-recomp #-} import Criterion.Main import Control.Parallel.Strategies (runEval,rpar,rseq) import qualified Data.Vector.Primitive as PV main :: IO () main = do let fewNumbers = PV.replicate 10000000 1.00000001 manyNumbers = PV.replicate 100000000 1.00000001 defaultMain [ bgroup "serial" [ bench "few" $ whnf serialProduct fewNumbers , bench "many" $ whnf serialProduct manyNumbers ] , bgroup "parallel" [ bench "few" $ whnf parallelProduct fewNumbers , bench "many" $ whnf parallelProduct manyNumbers ] ] serialProduct :: PV.Vector Double -> Double serialProduct v = let !len = PV.length v go :: Double -> Int -> Double go !d !ix = if ix < len then go (d * PV.unsafeIndex v ix) (ix + 1) else d in go 1.0 0 -- | This only works when the vector length is a multiple of 4. parallelProduct :: PV.Vector Double -> Double parallelProduct v = runEval $ do let chunk = div (PV.length v) 4 p2 <- rpar (serialProduct (PV.slice (chunk * 1) chunk v)) p3 <- rpar (serialProduct (PV.slice (chunk * 2) chunk v)) p4 <- rpar (serialProduct (PV.slice (chunk * 3) chunk v)) p1 <- rseq (serialProduct (PV.slice (chunk * 0) chunk v)) rseq (p1 * p2 * p3 * p4) }}} We can build and run this with: {{{ > ghc -threaded parallel_compute.hs > ./parallel_compute +RTS -N6 }}} On my eight-core laptop, here are the results we get: {{{ benchmarking serial/few time 11.46 ms (11.29 ms .. 11.61 ms) 0.999 R² (0.998 R² .. 1.000 R²) mean 11.52 ms (11.44 ms .. 11.62 ms) std dev 222.8 μs (140.9 μs .. 299.6 μs) benchmarking serial/many time 118.1 ms (116.1 ms .. 120.0 ms) 1.000 R² (1.000 R² .. 1.000 R²) mean 117.2 ms (116.6 ms .. 117.9 ms) std dev 920.3 μs (550.5 μs .. 1.360 ms) variance introduced by outliers: 11% (moderately inflated) benchmarking parallel/few time 10.04 ms (9.968 ms .. 10.14 ms) 0.999 R² (0.999 R² .. 1.000 R²) mean 9.970 ms (9.891 ms .. 10.03 ms) std dev 172.9 μs (114.5 μs .. 282.9 μs) benchmarking parallel/many time 45.32 ms (43.55 ms .. 47.17 ms) 0.996 R² (0.993 R² .. 0.999 R²) mean 45.93 ms (44.71 ms .. 48.10 ms) std dev 3.041 ms (1.611 ms .. 4.654 ms) variance introduced by outliers: 20% (moderately inflated) }}} Interestingly, in the benchmark with the smaller 10,000,000 element vector, we see almost no performance improvement from the sparks. But, in the one with the larger 100,000,000 element vector, we see a considerable speedup. It runs 2.5-3.0x faster. The reason for this is that sparks are not started between scheduling intervals. By default, this happens every 20ms. We can see the fizzling like this: {{{ > ./parallel_compute 'parallel/few' +RTS -N6 -s benchmarking parallel/few ... SPARKS: 1536 (613 converted, 0 overflowed, 0 dud, 42 GC'd, 881 fizzled) ... > ./parallel_compute 'parallel/many' +RTS -N6 -s benchmarking parallel/many ... SPARKS: 411 (411 converted, 0 overflowed, 0 dud, 0 GC'd, 0 fizzled) ... }}} For application developers, it's possible to work around this by tweaking the scheduling interval: {{{ > ghc -threaded -rtsopts parallel_compute.hs > ./parallel_compute 'parallel/few' +RTS -N6 -s -C0.001 benchmarking parallel/few time 4.158 ms (4.013 ms .. 4.302 ms) 0.993 R² (0.987 R² .. 0.998 R²) mean 4.094 ms (4.054 ms .. 4.164 ms) std dev 178.5 μs (131.5 μs .. 243.7 μs) variance introduced by outliers: 24% (moderately inflated) ... SPARKS: 3687 (3687 converted, 0 overflowed, 0 dud, 0 GC'd, 0 fizzled) }}} Much better. But, there are two problems with this: 1. This may negatively impact the overall performance of an application. 2. It doesn't work at all for library developers. It isn't practical to tell end users of your to use certain runtime flags. I don't know enough about the RTS to suggest a way to improve this. However, intuitively, I would expect that if I spark something and there's an idle capability, the idle capability could immediately be given the spark instead of having it placed in the local queue. This may not be possible or may not be compatible with the minimal use of locks in the implementation of sparks though. Here is a comment I made in the StackOverflow thread: > I suppose that in the normal case, if you're going to be sparking things, you should ensure that the work done by all the sparks plus the main thread takes well over 20ms. Otherwise, nearly everything will fizzle unless scheduling happens to be coming soon. I've always wondered about the threshold for how fine-grained sparks should be, and my understanding is now that this is roughly it. In short, I'd like for it to be possible to realize some of the benefits of parallelism for computations that take under 20ms without resorting to `forkIO` and `MVar`. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 6 14:11:17 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 06 Oct 2017 14:11:17 -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.b74a5ae82758b7e63f41cc5fd8393a62@haskell.org> #14329: GHC 8.2.1 segfaults while bootstrapping master -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: patch 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: new => patch * differential: => Phab:D4075 Comment: I wonder if we are running out of memory; The builder has only 4GB of RAM and four vCPUs. I have seen GHC segfault due to OOM conditions in the past. I took a look at the allocator and noticed that we never actually check whether commit was successful. I've fixed this in Phab:D4075. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 6 14:46:18 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 06 Oct 2017 14:46:18 -0000 Subject: [GHC] #14135: PatternSynonyms regression in GHC HEAD (expectJust mkOneConFull) In-Reply-To: <050.a39b92c3108f361708a6e28740f79fdc@haskell.org> References: <050.a39b92c3108f361708a6e28740f79fdc@haskell.org> Message-ID: <065.650d9e8e5b0af682364fff5a4b55b11e@haskell.org> #14135: PatternSynonyms regression in GHC HEAD (expectJust mkOneConFull) -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: carlostome Type: bug | Status: new Priority: highest | Milestone: 8.4.1 Component: Compiler | Version: 8.3 Resolution: | Keywords: | PatternSynonyms 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): Phab:D3981 Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Anyone want to try doing this? Currently we just crash which is bad. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 6 16:43:44 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 06 Oct 2017 16:43:44 -0000 Subject: [GHC] #12999: Investigate use of floating-point arithmetic in I/O Event-handler In-Reply-To: <042.d9e72583afa2ded1431f4a089ec3a9ba@haskell.org> References: <042.d9e72583afa2ded1431f4a089ec3a9ba@haskell.org> Message-ID: <057.dc65fca3c04dccac0f11972e6334fcb3@haskell.org> #12999: Investigate use of floating-point arithmetic in I/O Event-handler -------------------------------------+------------------------------------- Reporter: hvr | Owner: (none) Type: task | Status: new Priority: normal | Milestone: 8.4.1 Component: libraries/base | 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 nh2): Commit http://github.com/ghc/ghc/commit/ab2dcb1c474d918efdc875f3cca7ef5b6ebdce1a exports `getMonotonicTimeNSec :: IO Word64` so it can be used directly without conversion, and uses it to fix some PSQ timeout code. It updated the code mentioned in the issue description. Please take another look if this bug is fixed now. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Oct 7 00:49:33 2017 From: ghc-devs at haskell.org (GHC) Date: Sat, 07 Oct 2017 00:49:33 -0000 Subject: [GHC] #13795: :kind! is not expanding type synonyms anymore In-Reply-To: <045.9bd0a404a46fb5b0930c49818b8cb45d@haskell.org> References: <045.9bd0a404a46fb5b0930c49818b8cb45d@haskell.org> Message-ID: <060.18530e6b93e844d6ddc657e765db0009@haskell.org> #13795: :kind! is not expanding type synonyms anymore -------------------------------------+------------------------------------- Reporter: Hjulle | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: GHCi | Version: 8.0.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: | -------------------------------------+------------------------------------- Comment (by alpmestan): I went ahead and implemented Simon's first suggestion (quick and dirty way), as this is what I would personally want to have, I think. The patch is indeed very, very small: https://gist.github.com/alpmestan/50a0a00ebf4208c8ae898f84d6b41e07 Would people be happy with this patch (modulo nicer formatting and possible review feedback)? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Oct 7 00:52:21 2017 From: ghc-devs at haskell.org (GHC) Date: Sat, 07 Oct 2017 00:52:21 -0000 Subject: [GHC] #13795: :kind! is not expanding type synonyms anymore In-Reply-To: <045.9bd0a404a46fb5b0930c49818b8cb45d@haskell.org> References: <045.9bd0a404a46fb5b0930c49818b8cb45d@haskell.org> Message-ID: <060.cbbaa81026f63e71c1de8d989d0db058@haskell.org> #13795: :kind! is not expanding type synonyms anymore -------------------------------------+------------------------------------- Reporter: Hjulle | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: GHCi | Version: 8.0.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 alpmestan): * cc: alpmestan (added) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Oct 7 01:35:24 2017 From: ghc-devs at haskell.org (GHC) Date: Sat, 07 Oct 2017 01:35:24 -0000 Subject: [GHC] #10074: Implement the 'Improved LLVM Backend' proposal In-Reply-To: <052.e0bd123a5931fad09824fa5aaa592583@haskell.org> References: <052.e0bd123a5931fad09824fa5aaa592583@haskell.org> Message-ID: <067.41e5619a1321b41094bbe0ad4ee23420@haskell.org> #10074: Implement the 'Improved LLVM Backend' proposal -------------------------------------+------------------------------------- Reporter: thoughtpolice | Owner: angerman Type: task | Status: new Priority: high | Milestone: 8.4.1 Component: Compiler (LLVM) | Version: Resolution: | Keywords: llvm, codegen Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #11295, #12470 | Differential Rev(s): Phab:D530 Wiki Page: | wiki:ImprovedLLVMBackend | -------------------------------------+------------------------------------- Changes (by alpmestan): * cc: alpmestan (added) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Oct 7 02:30:08 2017 From: ghc-devs at haskell.org (GHC) Date: Sat, 07 Oct 2017 02:30:08 -0000 Subject: [GHC] #14331: Overzealous free-floating kind check causes deriving clause to be rejected Message-ID: <050.cb87f2a10e38fd0ac57d92b074ac5d5b@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: Component: Compiler | Version: 8.2.1 (Type checker) | 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: -------------------------------------+------------------------------------- GHC rejects this program: {{{#!hs {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE PolyKinds #-} module Bug where class C a b data D = D deriving (C (a :: k)) }}} {{{ GHCi, version 8.2.1: 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:1: error: Kind variable ‘k’ is implicitly bound in datatype ‘D’, but does not appear as the kind of any of its type variables. Perhaps you meant to bind it (with TypeInType) explicitly somewhere? | 8 | data D = D deriving (C (a :: k)) | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ }}} But it really shouldn't, since it's quite possible to write the code that is should generate: {{{#!hs instance C (a :: k) D }}} Curiously, this does not appear to happen for data family instances, as this typechecks: {{{#!hs {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE TypeFamilies #-} module Bug where class C a b data family D1 data instance D1 = D1 deriving (C (a :: k)) class E where data D2 instance E where data D2 = D2 deriving (C (a :: k)) }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Oct 7 02:45:11 2017 From: ghc-devs at haskell.org (GHC) Date: Sat, 07 Oct 2017 02:45:11 -0000 Subject: [GHC] #14332: Deriving clauses can have forall types Message-ID: <050.6c2c9b47d51bbd6274ba7997829a8360@haskell.org> #14332: Deriving clauses can have forall types -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 (Type checker) | Keywords: deriving | 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: -------------------------------------+------------------------------------- I made a horrifying discovery today: GHC accepts this code! {{{#!hs {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RankNTypes #-} {-# OPTIONS_GHC -ddump-deriv #-} module Bug1 where class C a b data D a = D deriving ((forall a. C a)) }}} {{{ GHCi, version 8.2.1: http://www.haskell.org/ghc/ :? for help Loaded GHCi configuration from /home/rgscott/.ghci [1 of 1] Compiling Bug1 ( Bug.hs, interpreted ) ==================== Derived instances ==================== Derived class instances: instance Bug1.C a1 (Bug1.D a2) where Derived type family instances: Ok, 1 module loaded. }}} It gets even worse with this example: {{{#!hs {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeInType #-} {-# OPTIONS_GHC -ddump-deriv -fprint-explicit-kinds #-} module Bug1 where import Data.Kind import GHC.Generics data Proxy (a :: k) = Proxy deriving ((forall k. (Generic1 :: (k -> Type) -> Constraint))) }}} {{{ GHCi, version 8.2.1: http://www.haskell.org/ghc/ :? for help Loaded GHCi configuration from /home/rgscott/.ghci [1 of 1] Compiling Bug1 ( Bug.hs, interpreted ) ==================== Derived instances ==================== Derived class instances: instance GHC.Generics.Generic1 k (Bug1.Proxy k) where GHC.Generics.from1 x_a3ip = GHC.Generics.M1 (case x_a3ip of { Bug1.Proxy -> GHC.Generics.M1 GHC.Generics.U1 }) GHC.Generics.to1 (GHC.Generics.M1 x_a3iq) = case x_a3iq of { (GHC.Generics.M1 GHC.Generics.U1) -> Bug1.Proxy } Derived type family instances: type GHC.Generics.Rep1 k_a2mY (Bug1.Proxy k_a2mY) = GHC.Generics.D1 k_a2mY ('GHC.Generics.MetaData "Proxy" "Bug1" "main" 'GHC.Types.False) (GHC.Generics.C1 k_a2mY ('GHC.Generics.MetaCons "Proxy" 'GHC.Generics.PrefixI 'GHC.Types.False) (GHC.Generics.U1 k_a2mY)) Ok, 1 module loaded. }}} In this example, the `forall`'d `k` from the `deriving` clause is discarded and then unified with the `k` from `data Proxy (a :: k)`. All of this is incredibly unsettling. We really shouldn't be allowing `forall` types in `deriving` clauses in the first place. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Oct 7 02:47:36 2017 From: ghc-devs at haskell.org (GHC) Date: Sat, 07 Oct 2017 02:47:36 -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.05858eff744530a6e0344eca4419b101@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: Component: Compiler (Type | Version: 8.2.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: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): I spoke too soon about that second program (with data families) working. It turns out that it's rejected on GHC HEAD: {{{ GHCi, version 8.3.20171004: http://www.haskell.org/ghc/ :? for help Loaded GHCi configuration from /home/rgscott/.ghci [1 of 1] Compiling Bug ( Bug.hs, interpreted ) Bug.hs:10:1: error: • Kind variable ‘k’ is implicitly bound in data family ‘D1’, but does not appear as the kind of any of its type variables. Perhaps you meant to bind it (with TypeInType) explicitly somewhere? • In the data instance declaration for ‘D1’ | 10 | data instance D1 = D1 deriving (C (a :: k)) | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ Bug.hs:16:3: error: • Kind variable ‘k’ is implicitly bound in data family ‘D2’, but does not appear as the kind of any of its type variables. Perhaps you meant to bind it (with TypeInType) explicitly somewhere? • In the data instance declaration for ‘D2’ In the instance declaration for ‘E’ | 16 | data D2 = D2 deriving (C (a :: k)) | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Oct 7 12:51:09 2017 From: ghc-devs at haskell.org (GHC) Date: Sat, 07 Oct 2017 12:51:09 -0000 Subject: [GHC] #14312: Head does not build on Windows with the default make config. In-Reply-To: <047.086b87bb9b3dcf2f7a921149fa31eda2@haskell.org> References: <047.086b87bb9b3dcf2f7a921149fa31eda2@haskell.org> Message-ID: <062.4068f7dbc14195c51f32acde848dbf3a@haskell.org> #14312: Head does not build on Windows with the default make config. -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: (none) Type: bug | Status: upstream Priority: normal | Milestone: Component: Build System | Version: 8.2.1 Resolution: | Keywords: Operating System: Windows | Architecture: Type of failure: Building GHC | Unknown/Multiple failed | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Phyx-): @Rufflewind Yes I was going to give `-iquote` a try, but have to first confirm why we do this. This won't fix GHCs that have already been released though of course. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Oct 7 17:26:14 2017 From: ghc-devs at haskell.org (GHC) Date: Sat, 07 Oct 2017 17:26:14 -0000 Subject: [GHC] #13203: Implement Bits Natural clearBit In-Reply-To: <044.036af31a947c4008bf1dfa61730885bd@haskell.org> References: <044.036af31a947c4008bf1dfa61730885bd@haskell.org> Message-ID: <059.ed8a06a133ab68ef6292e1644e8891e3@haskell.org> #13203: Implement Bits Natural clearBit -------------------------------------+------------------------------------- Reporter: dylex | Owner: supersven Type: bug | Status: new Priority: lowest | Milestone: Component: libraries/base | Version: 8.0.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): *cough* D3415 *cough* -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Oct 7 18:39:36 2017 From: ghc-devs at haskell.org (GHC) Date: Sat, 07 Oct 2017 18:39:36 -0000 Subject: [GHC] #13203: Implement Bits Natural clearBit In-Reply-To: <044.036af31a947c4008bf1dfa61730885bd@haskell.org> References: <044.036af31a947c4008bf1dfa61730885bd@haskell.org> Message-ID: <059.fae41808e48d5b75b0d14a85d5eaf681@haskell.org> #13203: Implement Bits Natural clearBit -------------------------------------+------------------------------------- Reporter: dylex | Owner: supersven Type: bug | Status: new Priority: lowest | Milestone: Component: libraries/base | Version: 8.0.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 supersven): Just a few details if someone else reads this ticket: ​phab:D3415 would supersede this ticket as it implements `clearBit` in a more sophisticated way. I think under these circumstances it wouldn't make much sense to finish this ticket. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Oct 7 21:07:30 2017 From: ghc-devs at haskell.org (GHC) Date: Sat, 07 Oct 2017 21:07:30 -0000 Subject: [GHC] #14320: Brackets change meaning of value-constructor type In-Reply-To: <041.3c8f20a47f3244d2b4af7e2826cc272d@haskell.org> References: <041.3c8f20a47f3244d2b4af7e2826cc272d@haskell.org> Message-ID: <056.b047362e0781054c667171fa74a969ce@haskell.org> #14320: Brackets change meaning of value-constructor type -------------------------------------+------------------------------------- Reporter: nr | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: Component: Compiler (Type | Version: 8.2.1 checker) | Keywords: GADT, Resolution: | existential type 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:D4072 Wiki Page: | -------------------------------------+------------------------------------- Comment (by Ryan Scott ): In [changeset:"f1d2db68d87f2c47a8dd4d86910e415599777f9f/ghc" f1d2db6/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="f1d2db68d87f2c47a8dd4d86910e415599777f9f" Fix #14320 by looking through HsParTy in more places Summary: GHC was needlessly rejecting GADT constructors' type signatures that were surrounded in parentheses due to the fact that `splitLHsForAllTy` and `splitLHsQualTy` (which are used to check as part of checking if GADT constructor return types are correct) weren't looking through parentheses (i.e., `HsParTy`). This is easily fixed, though. Test Plan: make test TEST=T14320 Reviewers: austin, bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie GHC Trac Issues: #14320 Differential Revision: https://phabricator.haskell.org/D4072 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Oct 7 21:07:30 2017 From: ghc-devs at haskell.org (GHC) Date: Sat, 07 Oct 2017 21:07:30 -0000 Subject: [GHC] #11721: GADT-syntax data constructors don't work well with TypeApplications In-Reply-To: <047.d3cda57aa918919c3cdf02eb21c0a581@haskell.org> References: <047.d3cda57aa918919c3cdf02eb21c0a581@haskell.org> Message-ID: <062.48ecca87f61006dc31d03ef577ec5a10@haskell.org> #11721: GADT-syntax data constructors don't work well with TypeApplications -------------------------------------+------------------------------------- Reporter: goldfire | Owner: RyanGlScott Type: bug | Status: closed Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.1 Resolution: fixed | Keywords: | TypeApplications Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #13848, #12025 | Differential Rev(s): Phab:D3687, Wiki Page: | Phab:D4070 -------------------------------------+------------------------------------- Comment (by Ryan Scott ): In [changeset:"341d3a7896385f14580d048ea7681232e5b242ce/ghc" 341d3a78/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="341d3a7896385f14580d048ea7681232e5b242ce" Incorporate changes from #11721 into Template Haskell Summary: #11721 changed the order of type variables in GADT constructor type signatures, but these changes weren't reflected in Template Haskell reification of GADTs. Let's do that. Along the way, I: * noticed that the `T13885` test was claiming to test TH reification of GADTs, but the reified data type wasn't actually a GADT! Since this patch touches that part of the codebase, I decided to fix this. * incorporated some feedback from @simonpj in https://phabricator.haskell.org/D3687#113566. (These changes alone don't account for any different in behavior.) Test Plan: make test TEST=T11721_TH Reviewers: goldfire, austin, bgamari, simonpj Reviewed By: goldfire, bgamari, simonpj Subscribers: rwbarton, thomie, simonpj GHC Trac Issues: #11721 Differential Revision: https://phabricator.haskell.org/D4070 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Oct 7 21:09:28 2017 From: ghc-devs at haskell.org (GHC) Date: Sat, 07 Oct 2017 21:09:28 -0000 Subject: [GHC] #11721: GADT-syntax data constructors don't work well with TypeApplications In-Reply-To: <047.d3cda57aa918919c3cdf02eb21c0a581@haskell.org> References: <047.d3cda57aa918919c3cdf02eb21c0a581@haskell.org> Message-ID: <062.b133b6c8c846f8cc97d88719c48435d3@haskell.org> #11721: GADT-syntax data constructors don't work well with TypeApplications -------------------------------------+------------------------------------- Reporter: goldfire | Owner: RyanGlScott Type: bug | Status: closed Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.1 Resolution: fixed | Keywords: | TypeApplications Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: | ghci/scripts/T11721, th/T11721_TH, | typecheck/should_compile/T13848 Blocked By: | Blocking: Related Tickets: #13848, #12025 | Differential Rev(s): Phab:D3687, Wiki Page: | Phab:D4070 -------------------------------------+------------------------------------- Changes (by RyanGlScott): * testcase: => ghci/scripts/T11721, th/T11721_TH, typecheck/should_compile/T13848 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Oct 7 21:10:30 2017 From: ghc-devs at haskell.org (GHC) Date: Sat, 07 Oct 2017 21:10:30 -0000 Subject: [GHC] #14320: Brackets change meaning of value-constructor type In-Reply-To: <041.3c8f20a47f3244d2b4af7e2826cc272d@haskell.org> References: <041.3c8f20a47f3244d2b4af7e2826cc272d@haskell.org> Message-ID: <056.509790f59a2fb11aff3ffeb82906e31d@haskell.org> #14320: Brackets change meaning of value-constructor type -------------------------------------+------------------------------------- Reporter: nr | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: 8.4.1 Component: Compiler (Type | Version: 8.2.1 checker) | Keywords: GADT, Resolution: fixed | existential type Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: GHC rejects | Test Case: valid program | tests/gadt/T14320 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4072 Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * status: patch => closed * testcase: => tests/gadt/T14320 * resolution: => fixed * milestone: => 8.4.1 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Oct 8 02:01:31 2017 From: ghc-devs at haskell.org (GHC) Date: Sun, 08 Oct 2017 02:01:31 -0000 Subject: [GHC] #10816: Fixity declaration for associated type rejected In-Reply-To: <047.cd9a1f02ca3266d044f12741b664719c@haskell.org> References: <047.cd9a1f02ca3266d044f12741b664719c@haskell.org> Message-ID: <062.48c02210034628a3f2b89d68e1e32851@haskell.org> #10816: Fixity declaration for associated type rejected -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: 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: | Differential Rev(s): Phab:D4077 Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * status: new => patch * differential: => Phab:D4077 Comment: I ended up stumbling upon this while looking at implementing [https://github.com/ghc-proposals/ghc-proposals/pull/65 this proposal], as the symptom of this ticket (having too many code paths for renaming fixity declarations) also made it annoying to implement the proposal. While Phab:D4077 doesn't implement the proposal in full, it will make it easier to do so later. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Oct 8 09:27:37 2017 From: ghc-devs at haskell.org (GHC) Date: Sun, 08 Oct 2017 09:27:37 -0000 Subject: [GHC] #13652: Add integer division to GHC.TypeLits In-Reply-To: <048.b9612e3f8a829526a91743f198cf1ed8@haskell.org> References: <048.b9612e3f8a829526a91743f198cf1ed8@haskell.org> Message-ID: <063.3cdce1fb81e3f62e3a3b0e5189613188@haskell.org> #13652: Add integer division to GHC.TypeLits -------------------------------------+------------------------------------- Reporter: vagarenko | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Core Libraries | 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): Phab:D4002 Wiki Page: | -------------------------------------+------------------------------------- Comment (by vagarenko): Okay, since we don't have `Fst` and `Snd` families in `base` anyway let's skip `DivMod`. Thanks for implementing this! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Oct 8 09:32:07 2017 From: ghc-devs at haskell.org (GHC) Date: Sun, 08 Oct 2017 09:32:07 -0000 Subject: [GHC] #13652: Add integer division to GHC.TypeLits In-Reply-To: <048.b9612e3f8a829526a91743f198cf1ed8@haskell.org> References: <048.b9612e3f8a829526a91743f198cf1ed8@haskell.org> Message-ID: <063.875d929ccd440ba271ddf0a27c960114@haskell.org> #13652: Add integer division to GHC.TypeLits -------------------------------------+------------------------------------- Reporter: vagarenko | Owner: (none) Type: feature request | Status: closed Priority: normal | Milestone: Component: Core Libraries | 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): Phab:D4002 Wiki Page: | -------------------------------------+------------------------------------- Changes (by vagarenko): * status: new => closed * resolution: => fixed -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Oct 8 10:09:28 2017 From: ghc-devs at haskell.org (GHC) Date: Sun, 08 Oct 2017 10:09:28 -0000 Subject: [GHC] #4017: Unhelpful error message in GHCi In-Reply-To: <046.b126e34ebdc516a2392e1a0dd50d1e4f@haskell.org> References: <046.b126e34ebdc516a2392e1a0dd50d1e4f@haskell.org> Message-ID: <061.350ba7414c616644c1e2c34ad07f4ca5@haskell.org> #4017: Unhelpful error message in GHCi -------------------------------------+------------------------------------- Reporter: simonpj | Owner: supersven Type: bug | Status: new Priority: lowest | Milestone: Component: Compiler | Version: 6.12.2 Resolution: | 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 supersven): * owner: (none) => supersven -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Oct 8 13:29:41 2017 From: ghc-devs at haskell.org (GHC) Date: Sun, 08 Oct 2017 13:29:41 -0000 Subject: [GHC] #4017: Unhelpful error message in GHCi In-Reply-To: <046.b126e34ebdc516a2392e1a0dd50d1e4f@haskell.org> References: <046.b126e34ebdc516a2392e1a0dd50d1e4f@haskell.org> Message-ID: <061.ce8c1a26e1b2a96449ee8cb9870e2278@haskell.org> #4017: Unhelpful error message in GHCi -------------------------------------+------------------------------------- Reporter: simonpj | Owner: supersven Type: bug | Status: new Priority: lowest | Milestone: Component: Compiler | Version: 6.12.2 Resolution: | 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: | -------------------------------------+------------------------------------- Comment (by supersven): Looks like things (or symptoms) changed a bit over time - The problem seems to be the same. Starting a current version of GHC in interactive mode: {{{ [nix-shell:~/src/ghc]$ inplace/bin/ghc-stage2 --interactive GHCi, version 8.3.20170930: http://www.haskell.org/ghc/ :? for help }}} `:i GHC.Integer.Type.Integer` now responds with a "Not in scope" error. `:i Integer` still shows that `GHC.Integer.Type.Integer` is reachable: {{{ Prelude> :i GHC.Integer.Type.Integer :1:1: error: Not in scope: ‘GHC.Integer.Type.Integer’ Prelude> :i Integer data Integer = integer-gmp-1.0.1.0:GHC.Integer.Type.S# GHC.Prim.Int# | integer-gmp-1.0.1.0:GHC.Integer.Type.Jp# {-# UNPACK #-}integer- gmp-1.0.1.0:GHC.Integer.Type.BigNat | integer-gmp-1.0.1.0:GHC.Integer.Type.Jn# {-# UNPACK #-}integer- gmp-1.0.1.0:GHC.Integer.Type.BigNat -- Defined in ‘integer-gmp-1.0.1.0:GHC.Integer.Type’ instance Eq Integer -- Defined in ‘integer-gmp-1.0.1.0:GHC.Integer.Type’ instance Ord Integer -- Defined in ‘integer-gmp-1.0.1.0:GHC.Integer.Type’ instance Show Integer -- Defined in ‘GHC.Show’ instance Read Integer -- Defined in ‘GHC.Read’ instance Enum Integer -- Defined in ‘GHC.Enum’ instance Num Integer -- Defined in ‘GHC.Num’ instance Real Integer -- Defined in ‘GHC.Real’ instance Integral Integer -- Defined in ‘GHC.Real’ }}} Setting the "integer-gmp" package doesn't change the situation: {{{ Prelude> :set -package integer-gmp package flags have changed, resetting and loading new packages... Prelude> :i Integer data Integer = integer-gmp-1.0.1.0:GHC.Integer.Type.S# GHC.Prim.Int# | integer-gmp-1.0.1.0:GHC.Integer.Type.Jp# {-# UNPACK #-}integer- gmp-1.0.1.0:GHC.Integer.Type.BigNat | integer-gmp-1.0.1.0:GHC.Integer.Type.Jn# {-# UNPACK #-}integer- gmp-1.0.1.0:GHC.Integer.Type.BigNat -- Defined in ‘integer-gmp-1.0.1.0:GHC.Integer.Type’ instance Eq Integer -- Defined in ‘integer-gmp-1.0.1.0:GHC.Integer.Type’ instance Ord Integer -- Defined in ‘integer-gmp-1.0.1.0:GHC.Integer.Type’ instance Show Integer -- Defined in ‘GHC.Show’ instance Read Integer -- Defined in ‘GHC.Read’ instance Enum Integer -- Defined in ‘GHC.Enum’ instance Num Integer -- Defined in ‘GHC.Num’ instance Real Integer -- Defined in ‘GHC.Real’ instance Integral Integer -- Defined in ‘GHC.Real’ Prelude> :i GHC.Integer.Type.Integer :1:1: error: Not in scope: ‘GHC.Integer.Type.Integer’ }}} `GHC.Integer.Type` is still a hidden module: {{{ Prelude> import GHC.Integer.Type : error: Could not find module ‘GHC.Integer.Type’ it is a hidden module in the package ‘integer-gmp-1.0.1.0’ }}} === Summary === The error message of `:i GHC.Integer.Type.Integer` changed to "Not in scope". But `:i Integer` still shows that the requested information would be available. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Oct 8 13:30:20 2017 From: ghc-devs at haskell.org (GHC) Date: Sun, 08 Oct 2017 13:30:20 -0000 Subject: [GHC] #14312: Head does not build on Windows with the default make config. In-Reply-To: <047.086b87bb9b3dcf2f7a921149fa31eda2@haskell.org> References: <047.086b87bb9b3dcf2f7a921149fa31eda2@haskell.org> Message-ID: <062.8fddf6776d0761c5e0193e8e3710b7c1@haskell.org> #14312: Head does not build on Windows with the default make config. -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: Component: Build System | Version: 8.2.1 Resolution: | Keywords: Operating System: Windows | Architecture: Type of failure: Building GHC | Unknown/Multiple failed | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4080 Wiki Page: | -------------------------------------+------------------------------------- Changes (by Phyx-): * status: upstream => patch * differential: => Phab:D4080 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Oct 8 13:58:30 2017 From: ghc-devs at haskell.org (GHC) Date: Sun, 08 Oct 2017 13:58:30 -0000 Subject: [GHC] #14333: GHC doesn't use the fact that Coercible is symmetric Message-ID: <051.317ebc999077ee18339a9e5fa0ad5d1c@haskell.org> #14333: GHC doesn't use the fact that Coercible is symmetric -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- {{{#!hs {-# Language ScopedTypeVariables, GADTs, DeriveGeneric #-} import GHC.Generics import Data.Type.Coercion data AB = A | B deriving (Generic) data XY = X | Y deriving (Generic) data This ab xy where At :: This AB XY foo :: This ab xy -> Coercion (Rep ab a) (Rep xy a) foo At = Coercion bar :: forall ab xy a. This ab xy -> Coercion (Rep ab a) (Rep xy a) bar at | Coercion <- foo at :: Coercion (Rep ab a) (Rep xy a) = Coercion }}} This compiles on 8.2.1 and 8.3.20170920 but flipping the arguments to `Coercion` fails {{{#!hs -- ... -- • Could not deduce: Coercible (Rep xy a) (Rep ab a) -- arising from a use of ‘Coercion’ -- from the context: Coercible (Rep ab a) (Rep xy a) -- bound by a pattern with constructor: bar :: forall ab xy a. This ab xy -> Coercion (Rep xy a) (Rep ab a) bar at | Coercion <- foo at :: Coercion (Rep ab a) (Rep xy a) = Coercion }}} Conceptually there should be an (`Undecidable`) superclass constraint for `Coercible` {{{#!hs class Coercible b a => Coercible a b }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Oct 8 14:17:15 2017 From: ghc-devs at haskell.org (GHC) Date: Sun, 08 Oct 2017 14:17:15 -0000 Subject: [GHC] #14334: Large static object : getLabelBc: Ran out of labels Message-ID: <049.315b3535fb3bb7f5242722a4542261ed@haskell.org> #14334: Large static object : getLabelBc: Ran out of labels -------------------------------------+------------------------------------- Reporter: h4ck3rm1k3 | Owner: (none) Type: bug | Status: new Priority: lowest | Milestone: Component: GHCi | Version: 8.0.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: -------------------------------------+------------------------------------- stack ghci The following GHC options are incompatible with GHCi and have not been passed to it: -threaded Configuring GHCi with the following packages: gcc-haskell Using main module: 1. Package `gcc-haskell' component exe:gcc-haskell-exe with main-is file: /home/mdupont/experiments/g\ cc-haskell/gcc-haskell/app/Main.hs GHCi, version 8.0.2: http://www.haskell.org/ghc/ :? for help [1 of 3] Compiling LibData ( LibData.hs, interpreted ) ghc: panic! (the 'impossible' happened) (GHC version 8.0.2 for x86_64-unknown-linux): getLabelBc: Ran out of labels Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug Compiling this project file here that is basically a large data object emitted from the rdf4h lib. I wanted to put the data into static space to improve load times and remove IO. https://github.com/h4ck3rm1k3/gcc-haskell/blob/master/src/LibData.hs -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Oct 8 14:29:17 2017 From: ghc-devs at haskell.org (GHC) Date: Sun, 08 Oct 2017 14:29:17 -0000 Subject: [GHC] #14334: Large static object : getLabelBc: Ran out of labels In-Reply-To: <049.315b3535fb3bb7f5242722a4542261ed@haskell.org> References: <049.315b3535fb3bb7f5242722a4542261ed@haskell.org> Message-ID: <064.0e212341a4d99f63d4e7c35153b5f549@haskell.org> #14334: Large static object : getLabelBc: Ran out of labels -------------------------------------+------------------------------------- Reporter: h4ck3rm1k3 | Owner: (none) Type: bug | Status: new Priority: lowest | Milestone: Component: GHCi | Version: 8.0.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: | -------------------------------------+------------------------------------- Description changed by dfeuer: Old description: > stack ghci > The following GHC options are incompatible with GHCi and have not been > passed to it: -threaded > Configuring GHCi with the following packages: gcc-haskell > Using main module: 1. Package `gcc-haskell' component exe:gcc-haskell-exe > with main-is file: /home/mdupont/experiments/g\ > cc-haskell/gcc-haskell/app/Main.hs > GHCi, version 8.0.2: http://www.haskell.org/ghc/ :? for help > [1 of 3] Compiling LibData ( LibData.hs, interpreted ) > ghc: panic! (the 'impossible' happened) > (GHC version 8.0.2 for x86_64-unknown-linux): > getLabelBc: Ran out of labels > > Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug > > > Compiling this project file here that is basically a large data object > emitted from the rdf4h lib. I wanted to put the data into static space to > improve load times and remove IO. > > https://github.com/h4ck3rm1k3/gcc-haskell/blob/master/src/LibData.hs New description: {{{ stack ghci The following GHC options are incompatible with GHCi and have not been passed to it: -threaded Configuring GHCi with the following packages: gcc-haskell Using main module: 1. Package `gcc-haskell' component exe:gcc-haskell-exe with main-is file: /home/mdupont/experiments/g\ cc-haskell/gcc-haskell/app/Main.hs GHCi, version 8.0.2: http://www.haskell.org/ghc/ :? for help [1 of 3] Compiling LibData ( LibData.hs, interpreted ) ghc: panic! (the 'impossible' happened) (GHC version 8.0.2 for x86_64-unknown-linux): getLabelBc: Ran out of labels Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug }}} Compiling this project file here that is basically a large data object emitted from the rdf4h lib. I wanted to put the data into static space to improve load times and remove IO. https://github.com/h4ck3rm1k3/gcc-haskell/blob/master/src/LibData.hs -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Oct 8 14:30:08 2017 From: ghc-devs at haskell.org (GHC) Date: Sun, 08 Oct 2017 14:30:08 -0000 Subject: [GHC] #14334: Large static object : getLabelBc: Ran out of labels In-Reply-To: <049.315b3535fb3bb7f5242722a4542261ed@haskell.org> References: <049.315b3535fb3bb7f5242722a4542261ed@haskell.org> Message-ID: <064.202e1d231de167155fd9b36b9f5e1525@haskell.org> #14334: Large static object : getLabelBc: Ran out of labels -------------------------------+-------------------------------------- Reporter: h4ck3rm1k3 | Owner: (none) Type: bug | Status: new Priority: lowest | Milestone: Component: GHCi | Version: 8.0.2 Resolution: | Keywords: 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 h4ck3rm1k3): * os: Unknown/Multiple => Linux -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Oct 8 14:30:42 2017 From: ghc-devs at haskell.org (GHC) Date: Sun, 08 Oct 2017 14:30:42 -0000 Subject: [GHC] #14334: Large static object : getLabelBc: Ran out of labels In-Reply-To: <049.315b3535fb3bb7f5242722a4542261ed@haskell.org> References: <049.315b3535fb3bb7f5242722a4542261ed@haskell.org> Message-ID: <064.5d038f028f15f5c0c7013a5535a35636@haskell.org> #14334: Large static object : getLabelBc: Ran out of labels -------------------------------+-------------------------------------- Reporter: h4ck3rm1k3 | Owner: (none) Type: bug | Status: new Priority: lowest | Milestone: Component: GHCi | Version: 8.0.2 Resolution: | Keywords: Operating System: Linux | Architecture: x86_64 (amd64) Type of failure: GHCi crash | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------+-------------------------------------- Comment (by h4ck3rm1k3): Reducing the size of the static data of course solves this problem. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Oct 8 14:55:03 2017 From: ghc-devs at haskell.org (GHC) Date: Sun, 08 Oct 2017 14:55:03 -0000 Subject: [GHC] #14135: PatternSynonyms regression in GHC HEAD (expectJust mkOneConFull) In-Reply-To: <050.a39b92c3108f361708a6e28740f79fdc@haskell.org> References: <050.a39b92c3108f361708a6e28740f79fdc@haskell.org> Message-ID: <065.23f307da299b47f21c643b2d80775cb1@haskell.org> #14135: PatternSynonyms regression in GHC HEAD (expectJust mkOneConFull) -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: carlostome Type: bug | Status: patch Priority: highest | Milestone: 8.4.1 Component: Compiler | Version: 8.3 Resolution: | Keywords: | PatternSynonyms 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): Phab:D3981 Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * status: new => patch Comment: carlostome appears to be working on this in Phab:D3981. However, he appears to be stuck, so any advice would be appreciated over at Phab:D3981. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Oct 8 15:12:26 2017 From: ghc-devs at haskell.org (GHC) Date: Sun, 08 Oct 2017 15:12:26 -0000 Subject: [GHC] #14333: GHC doesn't use the fact that Coercible is symmetric In-Reply-To: <051.317ebc999077ee18339a9e5fa0ad5d1c@haskell.org> References: <051.317ebc999077ee18339a9e5fa0ad5d1c@haskell.org> Message-ID: <066.ea8e4e0fc2a9b1106ee6de38f4f05467@haskell.org> #14333: GHC doesn't use the fact that Coercible is symmetric -------------------------------------+------------------------------------- Reporter: Iceland_jack | 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: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * cc: RyanGlScott (added) * keywords: => TypeFamilies Comment: Indeed, something funny is going on here. Here's a simplified version of this program. Notice that this typechecks: {{{#!hs {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE TypeFamilies #-} import Data.Type.Coercion type family F a b :: * f :: Coercion (F a b) (F c d) -> Coercion (F c d) (F a b) f Coercion = Coercion }}} However, if you change the kind of `F`: {{{#!hs {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE TypeFamilies #-} import Data.Type.Coercion type family F a :: * -> * f :: Coercion (F a b) (F c d) -> Coercion (F c d) (F a b) f Coercion = Coercion }}} Then it no longer typechecks: {{{ GHCi, version 8.2.1: http://www.haskell.org/ghc/ :? for help Loaded GHCi configuration from /home/ryanglscott/.ghci [1 of 1] Compiling Main ( Bug.hs, interpreted ) Bug.hs:10:14: error: • Could not deduce: Coercible (F c d) (F a b) arising from a use of ‘Coercion’ from the context: Coercible (F a b) (F c d) bound by a pattern with constructor: Coercion :: forall k (a :: k) (b :: k). Coercible a b => Coercion a b, in an equation for ‘f’ at Bug.hs:10:3-10 NB: ‘F’ is a type function, and may not be injective • In the expression: Coercion In an equation for ‘f’: f Coercion = Coercion • Relevant bindings include f :: Coercion (F a b) (F c d) -> Coercion (F c d) (F a b) (bound at Bug.hs:10:1) | 10 | f Coercion = Coercion | ^^^^^^^^ }}} Of course, it's quite easy to actually construct an implementation of `f` which does typecheck: {{{#!hs {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE TypeFamilies #-} import Data.Type.Coercion type family F a :: * -> * f :: Coercion (F a b) (F c d) -> Coercion (F c d) (F a b) f = sym }}} So the mystery is why GHC gets tripped up on this particular incarnation of `F`. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Oct 8 15:20:36 2017 From: ghc-devs at haskell.org (GHC) Date: Sun, 08 Oct 2017 15:20:36 -0000 Subject: [GHC] #14334: Large static object : getLabelBc: Ran out of labels In-Reply-To: <049.315b3535fb3bb7f5242722a4542261ed@haskell.org> References: <049.315b3535fb3bb7f5242722a4542261ed@haskell.org> Message-ID: <064.129b499413a5e463af0fedc5531a1096@haskell.org> #14334: Large static object : getLabelBc: Ran out of labels -------------------------------+-------------------------------------- Reporter: h4ck3rm1k3 | Owner: (none) Type: bug | Status: infoneeded Priority: lowest | Milestone: Component: GHCi | Version: 8.0.2 Resolution: | Keywords: 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): * status: new => infoneeded Comment: It's impossible for me to reproduce this at the moment, since this project relies on code that's [https://github.com/h4ck3rm1k3/gcc- haskell/blob/c4dcf67c73a974715d6368e234506e4df2ce749f/stack.yaml#L40 only available on your machine]. Posting a version of this code (preferably with no external dependencies) would go a long way in helping us diagnose the issue. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Oct 8 15:36:44 2017 From: ghc-devs at haskell.org (GHC) Date: Sun, 08 Oct 2017 15:36:44 -0000 Subject: [GHC] #14334: Large static object : getLabelBc: Ran out of labels In-Reply-To: <049.315b3535fb3bb7f5242722a4542261ed@haskell.org> References: <049.315b3535fb3bb7f5242722a4542261ed@haskell.org> Message-ID: <064.9e333f0730ae00a120288f8cca24e21f@haskell.org> #14334: Large static object : getLabelBc: Ran out of labels -------------------------------+-------------------------------------- Reporter: h4ck3rm1k3 | Owner: (none) Type: bug | Status: infoneeded Priority: lowest | Milestone: Component: GHCi | Version: 8.0.2 Resolution: | Keywords: Operating System: Linux | Architecture: x86_64 (amd64) Type of failure: GHCi crash | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------+-------------------------------------- Comment (by h4ck3rm1k3): Sorry about that, I removed all local deps and cleaned up the code so that it compiles ok. Please check again. Sorry to waste your time. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Oct 8 15:57:19 2017 From: ghc-devs at haskell.org (GHC) Date: Sun, 08 Oct 2017 15:57:19 -0000 Subject: [GHC] #14334: Large static object : getLabelBc: Ran out of labels In-Reply-To: <049.315b3535fb3bb7f5242722a4542261ed@haskell.org> References: <049.315b3535fb3bb7f5242722a4542261ed@haskell.org> Message-ID: <064.ab10a05d21292d0bbaed6421b96e02bc@haskell.org> #14334: Large static object : getLabelBc: Ran out of labels -------------------------------+-------------------------------------- Reporter: h4ck3rm1k3 | Owner: (none) Type: bug | Status: new Priority: lowest | Milestone: Component: GHCi | Version: 8.0.2 Resolution: | Keywords: 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): * status: infoneeded => new Comment: Thanks, that was helpful. I'm now able to reduce this to a single (very large) file with only a `text` dependency (which is bundled with GHC HEAD nowadays), which can be found [https://gist.githubusercontent.com/RyanGlScott/75e8b0ad7a3995f6877e3e8e2f9a752f/raw/688ac3e87c25669f5acdf80f8351a420ee22c82e/LibData.hs here] (since it exceeds Trac's file upload limit). Running `ghci` on this file is enough to make it panic: {{{ $ ~/Software/ghc2/inplace/bin/ghc-stage2 --interactive LibData.hs GHCi, version 8.3.20171004: http://www.haskell.org/ghc/ :? for help Loaded GHCi configuration from /home/rgscott/.ghci [1 of 1] Compiling LibData ( LibData.hs, interpreted ) ghc-stage2: panic! (the 'impossible' happened) (GHC version 8.3.20171004 for x86_64-unknown-linux): getLabelBc: Ran out of labels }}} I've reproduced this with GHC 8.0.2, 8.2.1, and HEAD. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Oct 8 17:12:22 2017 From: ghc-devs at haskell.org (GHC) Date: Sun, 08 Oct 2017 17:12:22 -0000 Subject: [GHC] #14335: Annotations aren't supported with -fexternal-interpreter Message-ID: <046.25c38c823cb7fca986641ffde5e3cbd0@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 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 seems that using `{-# ANN #-}` pragmas from a plugin cause GHC to crash when run with `-fexternal-interpreter` with {{{ ghc: this operation requires -fno-external-interpreter }}} It seems that the culprit is likely the use of `wormhole` in `convertAnnotationWrapper`. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Oct 8 17:23:28 2017 From: ghc-devs at haskell.org (GHC) Date: Sun, 08 Oct 2017 17:23:28 -0000 Subject: [GHC] #14064: Compiling problem on FreeBSD 11 ("failed in phase") In-Reply-To: <043.996442976c5d50d07afa88e2354bce42@haskell.org> References: <043.996442976c5d50d07afa88e2354bce42@haskell.org> Message-ID: <058.291047474c8a1999865bde9ea3d5fb05@haskell.org> #14064: Compiling problem on FreeBSD 11 ("failed in phase") -------------------------------------+------------------------------------- Reporter: ohho | Owner: (none) Type: bug | Status: infoneeded Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: | Keywords: Operating System: FreeBSD | Architecture: x86_64 Type of failure: GHC doesn't work | (amd64) at all | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by mboes): On FreeBSD 10.1-RELEASE-p1, I get a bunch of e.g. {{{ ... ld.lld: error: Section has flags incompatible with others with the same name libraries/ghc-prim/dist-install/build/GHC/CString.o:(.text.sFl_info) ... }}} errors and the build fails. Passing `--disable-ld-override` fixes this. It should probably be added automatically on this platform through auto configuration (hard for users to guess upfront what combination of `./configure` flags will make the build succeed). -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Oct 8 20:45:17 2017 From: ghc-devs at haskell.org (GHC) Date: Sun, 08 Oct 2017 20:45:17 -0000 Subject: [GHC] #14336: ghci leaks memory Message-ID: <051.dbf33557716163bb981beab6790198d1@haskell.org> #14336: ghci leaks memory -------------------------------------+------------------------------------- Reporter: NeilMitchell | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: GHCi | Version: 8.2.1 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: -------------------------------------+------------------------------------- The following script spawns ghci, and that spawned ghci then goes on to leak memory: {{{#!hs import Control.Concurrent import Control.Monad import System.IO import System.Process main = do (Just hin, Nothing, Nothing, pid) <- createProcess (proc "ghci" ["+RTS","-S"]){std_in=CreatePipe} forever $ do threadDelay 100000 -- 0.1s hPutStrLn hin "\"this is a test of outputting stuff\"" hFlush hin }}} This script just writes a string to GHCi, which then echos it back. The {{{+RTS -S}}} is useful to watch the live memory tick up in realtime, but it leaks without it, and the leak can be seen in process explorer (87Mb to 700Mb over about 30 minutes). While repeatedly writing commands may not be a standard usage of ghci, it is when driven by tools such as ghcid (https://hackage.haskell.org/package/ghcid) and other IDE-like uses. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Oct 8 20:45:32 2017 From: ghc-devs at haskell.org (GHC) Date: Sun, 08 Oct 2017 20:45:32 -0000 Subject: [GHC] #14336: ghci leaks memory In-Reply-To: <051.dbf33557716163bb981beab6790198d1@haskell.org> References: <051.dbf33557716163bb981beab6790198d1@haskell.org> Message-ID: <066.c971907783a419f7acc52ce59c786677@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 NeilMitchell): * cc: ndmitchell@… (added) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 9 01:42:35 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 09 Oct 2017 01:42:35 -0000 Subject: [GHC] #14333: GHC doesn't use the fact that Coercible is symmetric In-Reply-To: <051.317ebc999077ee18339a9e5fa0ad5d1c@haskell.org> References: <051.317ebc999077ee18339a9e5fa0ad5d1c@haskell.org> Message-ID: <066.40e78cebb6cc00bdd6d4ae194454e1e9@haskell.org> #14333: GHC doesn't use the fact that Coercible is symmetric -------------------------------------+------------------------------------- Reporter: Iceland_jack | 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: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by goldfire): This is a good point. The problem is that `(a b) ~R# (c d)` tells you nothing at all about the relationship between any of the variables `a`, `b`, `c`, and `d`. This isn't a restriction in the solver, but simply a truism of representational equality. So when GHC knows `(a b) ~R# (c d)`, it is too stupid to figure out `(c d) ~R# (a b)`. I can thus boil down the problem even further: {{{#!hs bad :: Coercible (a b) (c d) => c d -> a b bad = coerce }}} will fail to type-check. (The version with argument & result swapped works fine.) Could the solver work around this? Maybe, with sufficient cleverness. (Unlike my concerns around recursive newtypes, I think this may be an engineering issue, not undecidability.) I don't think it would be easy though, requiring some kind of flattening logic akin to what GHC does for type families. Do you have a concrete use case? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 9 02:07:49 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 09 Oct 2017 02:07:49 -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.48166cbc884a0eeefee401785724ca57@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: Component: Compiler (Type | Version: 8.2.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: | -------------------------------------+------------------------------------- Comment (by goldfire): I assume you really meant {{{#!hs data D = D deriving (forall k a. C (a :: k)) }}} but that GHC doesn't quantify `k` the right way. So it's a bug in kind quantification, not the free-floating kind variable check. (Sidenote: that `forall` isn't allowed there. But perhaps it should be incorporated into [https://github.com/ghc-proposals/ghc- proposals/blob/master/proposals/0007-instance-foralls.rst the recent proposal expanding where `forall` can be used.) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 9 02:10:54 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 09 Oct 2017 02:10:54 -0000 Subject: [GHC] #14332: Deriving clauses can have forall types In-Reply-To: <050.6c2c9b47d51bbd6274ba7997829a8360@haskell.org> References: <050.6c2c9b47d51bbd6274ba7997829a8360@haskell.org> Message-ID: <065.105db8239fd3999cfdf8f77c84e9c506@haskell.org> #14332: Deriving clauses can have forall types -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.2.1 checker) | Resolution: | Keywords: deriving 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): Why shouldn't we allow `forall` in deriving clauses? I agree that the current implementation is buggy (for example, that you need two sets of parens!), but I think `forall`s there are just peachy. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 9 02:15:32 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 09 Oct 2017 02:15:32 -0000 Subject: [GHC] #13795: :kind! is not expanding type synonyms anymore In-Reply-To: <045.9bd0a404a46fb5b0930c49818b8cb45d@haskell.org> References: <045.9bd0a404a46fb5b0930c49818b8cb45d@haskell.org> Message-ID: <060.6eeb03d99317c654f14874482718cf79@haskell.org> #13795: :kind! is not expanding type synonyms anymore -------------------------------------+------------------------------------- Reporter: Hjulle | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: GHCi | Version: 8.0.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: | -------------------------------------+------------------------------------- Comment (by goldfire): The patch looks reasonable to me. But I do think this should go via the normal [https://github.com/ghc-proposals/ghc-proposals ghc-proposals] process, as it's a user-facing feature. I know this is small, but I've found that process to be a great way to refine a feature to a beautiful final form. No doubt several "small" features I've added (e.g., the `:type +d` syntax) would have benefited from such a process. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 9 02:22:22 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 09 Oct 2017 02:22:22 -0000 Subject: [GHC] #14332: Deriving clauses can have forall types In-Reply-To: <050.6c2c9b47d51bbd6274ba7997829a8360@haskell.org> References: <050.6c2c9b47d51bbd6274ba7997829a8360@haskell.org> Message-ID: <065.24eae348e8675e73a763c67d7cd5aced@haskell.org> #14332: Deriving clauses can have forall types -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.2.1 checker) | Resolution: | Keywords: deriving 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): To my knowledge, there's no formalism that states what the static semantics of `deriving` clauses are, so saying what should or shouldn't be allowed leaves a lot up to personal interpretation. But I can at least give my interpretation: whenever something of the form: {{{#!hs data D d1 ... dn = ... deriving (C c1 ... cm) }}} is encountered, then an instance of the form: {{{#!hs instance ... => C c1 ... cm (D d1 ... dn) }}} is emitted. To put it less formally, one takes the derived type and plops the datatype to the right of it, forming the instance. Having established this, let me turn the tables on you and ask: what do //you// think should happen if something of this form is encountered? {{{#!hs data D d1 ... dn = ... deriving (forall <...>. C c1 ... cm) }}} I for one can't come up with a consistent semantics for this. Do you emit this? {{{#!hs instance ... => (forall <...>. C c1 ... cm) (D d1 ... dn) }}} Clearly not, since instances have to be headed by an actual type class constructor. So do you attempt to beta-reduce the `forall`'d type? What happens if there is more than one `forall`'d type variable? In my view, trying to make sense of this is opening up a giant can of worms. I'm open to being proved wrong though—is there an interpretation of this which makes sense, and has a consistent semantics? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 9 02:23:58 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 09 Oct 2017 02:23:58 -0000 Subject: [GHC] #14332: Deriving clauses can have forall types In-Reply-To: <050.6c2c9b47d51bbd6274ba7997829a8360@haskell.org> References: <050.6c2c9b47d51bbd6274ba7997829a8360@haskell.org> Message-ID: <065.5d9f53bd2c2676c030e8cac358c9e328@haskell.org> #14332: Deriving clauses can have forall types -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.2.1 checker) | Resolution: | Keywords: deriving 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): I intended to move the `forall` to the left of the context. So `deriving (forall <...>. C tys)` is like `instance forall <...>. ... => C tys`. That's nice and simple, I think. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 9 02:38:44 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 09 Oct 2017 02:38:44 -0000 Subject: [GHC] #14332: Deriving clauses can have forall types In-Reply-To: <050.6c2c9b47d51bbd6274ba7997829a8360@haskell.org> References: <050.6c2c9b47d51bbd6274ba7997829a8360@haskell.org> Message-ID: <065.345a879ec4bfee1e400b16a656a748a3@haskell.org> #14332: Deriving clauses can have forall types -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.2.1 checker) | Resolution: | Keywords: deriving 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): OK, that's a start. But I have more questions: * Are the `forall`'d type variables in a `deriving` clause's type assumed to be distinct from the type variables bound by a data type itself? If so, how should GHC treat derived instances that would only work if kind unification were to occur? For instance, `data Proxy (a :: k) = Proxy deriving (Generic1 :: (k -> Type) -> Constraint)` is clearly OK, but `data Proxy (a :: k) = Proxy deriving (forall k. Generic1 :: (k -> Type) -> Constraint)` isn't, since it can't unify the `k` from the derived type and the `k` from the datatype. What should GHC do here? * What happens if one of the variables isn't quantified over (e.g., `data D = D deriving (forall a. C a b)`)? Is this an error? Many I'd be convinced if I did see a full write-up of this in a proposal. But as it stands, I'm quite unconvinced that this would work out if you actually sat down and attempted to implement this. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 9 02:40:33 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 09 Oct 2017 02:40: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.5f279a97b8cfbeaf332b9cae704ed849@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: Component: Compiler (Type | Version: 8.2.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: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): Replying to [comment:2 goldfire]: > I assume you really meant > > {{{#!hs > data D = D deriving (forall k a. C (a :: k)) > }}} > > but that GHC doesn't quantify `k` the right way. I most certainly didn't. (In fact, I've opened a [https://ghc.haskell.org/trac/ghc/ticket/14332 separate bug] about the fact that you //can// put `forall`s in `deriving` clauses, which horrifies me.) It's somewhat surprising, but `deriving` clauses can bind type variables themselves. Note that this is currently accepted: {{{#!hs data D = D deriving (C a) }}} Here, `a` isn't bound by the data type `D`, so it is in fact bound in the `deriving` clause. By the same principle, `deriving (C (a :: k))` should be allowed, and the free-floating kind check is mistaken to reject it. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 9 04:09:36 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 09 Oct 2017 04:09:36 -0000 Subject: [GHC] #14254: The Binary instance for TypeRep smells a bit expensive In-Reply-To: <045.b0b485439de28cadfa61420f4ccc13a7@haskell.org> References: <045.b0b485439de28cadfa61420f4ccc13a7@haskell.org> Message-ID: <060.d746017db10ca986300b9340a97d5fb2@haskell.org> #14254: The Binary instance for TypeRep smells a bit expensive -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.2.1 Resolution: | Keywords: Typeable 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:D3998, Wiki Page: | Phab:D4078, Phab:D4082 -------------------------------------+------------------------------------- Changes (by dfeuer): * differential: Phab:D3998 => Phab:D3998, Phab:D4078, Phab:D4082 Comment: I believe the simplest thing right now that will actually make deserialization linear is Phab:D4082. If at some point GHC allows unlifted types in kinds (which Richard thinks is probably not hard), then it will get even simpler and even cheaper. Phab:D4078 implements Richard's idea of starting off by digging down to the constructor, and as a side effect reduces the number of tags needed to express deeply nested applications. But I very much doubt the complexity/benefit ratio supports that approach, unless we change the structure of `TypeRep` to match. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 9 08:23:05 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 09 Oct 2017 08:23:05 -0000 Subject: [GHC] #13795: :kind! is not expanding type synonyms anymore In-Reply-To: <045.9bd0a404a46fb5b0930c49818b8cb45d@haskell.org> References: <045.9bd0a404a46fb5b0930c49818b8cb45d@haskell.org> Message-ID: <060.5f997fa91754a62e05d6b1cbbad614ec@haskell.org> #13795: :kind! is not expanding type synonyms anymore -------------------------------------+------------------------------------- Reporter: Hjulle | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: GHCi | Version: 8.0.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: | -------------------------------------+------------------------------------- Comment (by alpmestan): No problem, I'll go through that process then, thanks! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 9 08:33:49 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 09 Oct 2017 08:33:49 -0000 Subject: [GHC] #14332: Deriving clauses can have forall types In-Reply-To: <050.6c2c9b47d51bbd6274ba7997829a8360@haskell.org> References: <050.6c2c9b47d51bbd6274ba7997829a8360@haskell.org> Message-ID: <065.beada52e328c29de0d70e75aaf78b746@haskell.org> #14332: Deriving clauses can have forall types -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.2.1 checker) | Resolution: | Keywords: deriving 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): > I intended to move the forall to the left of the context. Aha, that makes a huge difference. I thought you were advocating generating a derived instance like {{{ instance ... => C (forall k. T k a) where ... }}} which would be bad. (We don't allow that in source code, so we shouldn't in deriving-generated code.) But if you mean just moving the foralls to the left, then we've supported that for ages in the abstract syntax {{{ data HsDerivingClause pass -- See Note [Deriving strategies] in TcDeriv = HsDerivingClause { deriv_clause_strategy :: Maybe (Located DerivStrategy) -- ^ The user-specified strategy (if any) to use when deriving -- 'deriv_clause_tys'. , deriv_clause_tys :: Located [LHsSigType pass] -- ^ The types to derive. -- -- It uses 'LHsSigType's because, with @-XGeneralizedNewtypeDeriving@, -- we can mention type variables that aren't bound by the datatype, e.g. -- -- > data T b = ... deriving (C [a]) -- -- should produce a derived instance for @C [a] (T b)@. } }}} Note the `LHsSigType` and comment. I'm not saying it's implemented right, and it appears to be undocumented in the user manual, but it's there by design. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 9 08:57:36 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 09 Oct 2017 08:57:36 -0000 Subject: [GHC] #14333: GHC doesn't use the fact that Coercible is symmetric In-Reply-To: <051.317ebc999077ee18339a9e5fa0ad5d1c@haskell.org> References: <051.317ebc999077ee18339a9e5fa0ad5d1c@haskell.org> Message-ID: <066.c79c6be1faf208e7d73cc4ddbe1b4d22@haskell.org> #14333: GHC doesn't use the fact that Coercible is symmetric -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: | Keywords: TypeFamilies, | 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 simonpj): * keywords: TypeFamilies => TypeFamilies, Roles -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 9 10:02:08 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 09 Oct 2017 10:02:08 -0000 Subject: [GHC] #14333: GHC doesn't use the fact that Coercible is symmetric In-Reply-To: <051.317ebc999077ee18339a9e5fa0ad5d1c@haskell.org> References: <051.317ebc999077ee18339a9e5fa0ad5d1c@haskell.org> Message-ID: <066.3aacd52c567420c9ed58edd57a23325e@haskell.org> #14333: GHC doesn't use the fact that Coercible is symmetric -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: | Keywords: TypeFamilies, | 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): Replying to [comment:2 goldfire]: > Do you have a concrete use case? My use case is [https://github.com/Icelandjack/deriving- via/blob/master/examples/Generics.hs this] where `swap` is required to express symmetry. I use this to witness a coercion between `Rep a x` and `Rep b x` {{{#!hs sameRep :: SameRep a b :- (Rep a x `Coercible` Rep b x) }}} but I also need {{{#!hs SameRep a b :- (Rep b x `Coercible` Rep a x) }}} for which I use `swap` -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 9 10:49:25 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 09 Oct 2017 10:49:25 -0000 Subject: [GHC] #14332: Deriving clauses can have forall types In-Reply-To: <050.6c2c9b47d51bbd6274ba7997829a8360@haskell.org> References: <050.6c2c9b47d51bbd6274ba7997829a8360@haskell.org> Message-ID: <065.28fa463dbe118cb77cdb24cd6438225a@haskell.org> #14332: Deriving clauses can have forall types -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.2.1 checker) | Resolution: | Keywords: deriving 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): I'm well aware of the fact that `deriv_clause_tys` uses `LHsSigType`. That is indeed there for a good reason—`deriving` clauses need to support implicit quantification. But just because `LHsSigType` supports explicit quantification via `forall`s doesn't mean it's a good idea to actually allow them in `deriving` clauses. After all, the fact that we use `LHsSigType` in class instances means that it's possible to write instances with nested `forall`s, like this: {{{#!hs instance forall a. forall b. (Show a, Show b) => Show (Either a b) }}} But despite this, GHC will reject this will `Malformed instance: forall a. forall b. Show (Either a b)`. Similarly, we should think carefully about whether `deriving (forall <<>>. C c1 ... cn)` well formed or not. I thought about this some more last night, and another reason why `deriving (forall <<>>. C c1 ... cn)` bothers me is because unlike the `forall` in a class instance, this proposed `forall` in a `deriving` clause doesn't scope over a "real" type in some ways. That is to say, the `C c1 ... cn` in `deriving C c1 ... cn` isn't so much of a type as a "type former". There is a rather involved process in taking `C c1 ... cn`, applying it to the datatype (possibly after eta reducing some of its type variables), and unifying their kinds. In fact, after this kind unification, it's possible that some of these type variables will vanish completely! Take this example, for instance: {{{#!hs {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeInType #-} {-# OPTIONS_GHC -ddump-deriv #-} class C k (a :: k) data D = D deriving (C k) }}} Here, the actual instance that gets emitted (as shown by `-ddump-deriv`) is: {{{ GHCi, version 8.2.1: http://www.haskell.org/ghc/ :? for help Loaded GHCi configuration from /home/ryanglscott/.ghci [1 of 1] Compiling Main ( Bug.hs, interpreted ) ==================== Derived instances ==================== Derived class instances: instance Main.C * Main.D where }}} Notice how the `k` has become `*` due to kind unification! But according to this proposal, you could have alternatively written this as: {{{#!hs data D = D deriving (forall k. C k) }}} And according to the specification given in comment:3, this should emit an instance of the form `forall k. ... => C k D`. But that's clearly not true when you inspect `-ddump-deriv`! So this `forall` here is an utter lie. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 9 12:26:45 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 09 Oct 2017 12:26:45 -0000 Subject: [GHC] #14332: Deriving clauses can have forall types In-Reply-To: <050.6c2c9b47d51bbd6274ba7997829a8360@haskell.org> References: <050.6c2c9b47d51bbd6274ba7997829a8360@haskell.org> Message-ID: <065.288b966ce81a7a310b4432072215ac44@haskell.org> #14332: Deriving clauses can have forall types -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.2.1 checker) | Resolution: | Keywords: deriving 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): > Notice how the k has become * due to kind unification! I'd say this is an outright bug. You should say {{{ data D = D deriving (C Type) }}} Would you like to open a ticket? I grant that it's odd to quantify over a type former. But it's odd not to have ANY way to explicitly quantify. (Well, I suppose you could use standalone deriving.) I'm not pressing hard for an explicit forall. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 9 12:42:31 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 09 Oct 2017 12:42:31 -0000 Subject: [GHC] #14332: Deriving clauses can have forall types In-Reply-To: <050.6c2c9b47d51bbd6274ba7997829a8360@haskell.org> References: <050.6c2c9b47d51bbd6274ba7997829a8360@haskell.org> Message-ID: <065.393be168fb75827e14c3056162e6b958@haskell.org> #14332: Deriving clauses can have forall types -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.2.1 checker) | Resolution: | Keywords: deriving 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): Replying to [comment:7 simonpj]: > I'd say this is an outright bug. You should say > {{{ > data D = D deriving (C Type) > }}} > Would you like to open a ticket? No, because this is behaving as I would expect it to! Kind unification is fundamental to the way `deriving` works, and I'm leery of any design which doesn't incorporate it as a guiding principle. Here is another example where `deriving` //must// unify kinds: {{{#!hs {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeInType #-} {-# OPTIONS_GHC -ddump-deriv #-} data Proxy k (a :: k) = Proxy deriving Functor }}} {{{ GHCi, version 8.2.1: http://www.haskell.org/ghc/ :? for help Loaded GHCi configuration from /home/ryanglscott/.ghci [1 of 1] Compiling Main ( Bug.hs, interpreted ) ==================== Derived instances ==================== Derived class instances: instance GHC.Base.Functor (Main.Proxy *) where }}} Here, if `k` weren't unified with `*`, then the instance simply wouldn't be well kinded. How about another example? {{{#!hs {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeInType #-} {-# OPTIONS_GHC -ddump-deriv #-} import Data.Kind class C k (f :: k -> *) data T j (a :: j) deriving (C k) }}} {{{ GHCi, version 8.2.1: http://www.haskell.org/ghc/ :? for help Loaded GHCi configuration from /home/ryanglscott/.ghci [1 of 1] Compiling Main ( Bug.hs, interpreted ) ==================== Derived instances ==================== Derived class instances: instance Main.C k (Main.T k) where }}} Notice that GHC didn't attempt to emit an instance of the form `forall k j. C k (T j)`—instead, it deliberately unified `k` and `j`! This is a good thing, because otherwise GHC would spit out utter nonsense that wouldn't pass muster. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 9 13:11:26 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 09 Oct 2017 13:11:26 -0000 Subject: [GHC] #14291: Tests tend to fail in the ext-interp way when split sections is enabled In-Reply-To: <046.50939ac6d09fd8ac7c487275ec7ee681@haskell.org> References: <046.50939ac6d09fd8ac7c487275ec7ee681@haskell.org> Message-ID: <061.7d3e68e9b99e467a6f5570adf5024663@haskell.org> #14291: Tests tend to fail in the ext-interp way when split sections is enabled -------------------------------------+------------------------------------- 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: 14328 | Blocking: 13716 Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Of the linkers * `ld.gold` has this bug; produces valid-looking object code that simply doesn't work. Ben has filed [https://sourceware.org/bugzilla/show_bug.cgi?id=22266 this bug report]. * `ld.lld` crashes on the same repro case. And `gcc` doesn't support `lld`. * `ld.bfd` is OK on this, but it is slow see #13739. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 9 13:20:26 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 09 Oct 2017 13:20:26 -0000 Subject: [GHC] #14115: GHC segfaults trying to use TH code when ghc is compiled as DYNAMIC_GHC_PROGRAMS=NO In-Reply-To: <044.b3cd3c1bf232141df45df0c09168c130@haskell.org> References: <044.b3cd3c1bf232141df45df0c09168c130@haskell.org> Message-ID: <059.7715c12ea95b0d0ab18f984b78d4d706@haskell.org> #14115: GHC segfaults trying to use TH code when ghc is compiled as DYNAMIC_GHC_PROGRAMS=NO -------------------------------------+------------------------------------- Reporter: pacak | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: Component: Runtime System | Version: 8.2.1 (Linker) | Resolution: duplicate | Keywords: Operating System: Linux | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: #14328 | Differential Rev(s): Phab:D3983 Wiki Page: | -------------------------------------+------------------------------------- Changes (by dfeuer): * status: patch => closed * resolution: => duplicate * related: => #14328 Comment: Closing as a duplicate. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 9 15:01:28 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 09 Oct 2017 15:01:28 -0000 Subject: [GHC] #14064: Compiling problem on FreeBSD 11 ("failed in phase") In-Reply-To: <043.996442976c5d50d07afa88e2354bce42@haskell.org> References: <043.996442976c5d50d07afa88e2354bce42@haskell.org> Message-ID: <058.ae9909e98435e2893bcd68f3ad222a6a@haskell.org> #14064: Compiling problem on FreeBSD 11 ("failed in phase") -------------------------------------+------------------------------------- Reporter: ohho | Owner: (none) Type: bug | Status: infoneeded Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: | Keywords: Operating System: FreeBSD | Architecture: x86_64 Type of failure: GHC doesn't work | (amd64) at all | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): Note that this issue is addressed in #14300; the rationale for this issue is also discussed in ticket:14300#comment:5. In short, the issue is that the platform toolchain is buggy due to tiresome licensing issue. Note that GHC builds without any trouble on FreeBSD 11. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 9 15:44:42 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 09 Oct 2017 15:44:42 -0000 Subject: [GHC] #14334: Large static object : getLabelBc: Ran out of labels In-Reply-To: <049.315b3535fb3bb7f5242722a4542261ed@haskell.org> References: <049.315b3535fb3bb7f5242722a4542261ed@haskell.org> Message-ID: <064.0111c15af5084e8c777ff088fc3254d2@haskell.org> #14334: Large static object : getLabelBc: Ran out of labels -------------------------------+-------------------------------------- Reporter: h4ck3rm1k3 | Owner: (none) Type: bug | Status: new Priority: lowest | Milestone: Component: GHCi | Version: 8.0.2 Resolution: | Keywords: 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 bgamari): * cc: Jaffacake (added) Comment: Hmm, this is a bit tricky; the trouble is the GHCi bytecode only has room for 16-bit labels. I suspect the most sensible option would be to break up large BCO objects during ByteCodeGen, but this sounds slightly non- trivial. Simon, any thoughts? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 9 15:53:59 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 09 Oct 2017 15:53:59 -0000 Subject: [GHC] #14330: Sparks are not started promptly In-Reply-To: <049.15689449c051500fed95f985fcea2e55@haskell.org> References: <049.15689449c051500fed95f985fcea2e55@haskell.org> Message-ID: <064.fd89b4d2005efa0e8a7920b5ac0b7a34@haskell.org> #14330: Sparks are not started promptly -------------------------------------+------------------------------------- Reporter: andrewthad | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: | Keywords: sparks 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 jberryman): * type: feature request => bug Comment: I hope it's all right that I've modified this from "feature request" to "bug". This seems like not particularly well-understood or documented behavior. At least this user (me) still doesn't really understand the implications. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 9 16:29:33 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 09 Oct 2017 16:29:33 -0000 Subject: [GHC] #13945: 'ghc-pkg update' fails due to bad file descriptor error In-Reply-To: <049.b152863155a8f5ca5d2c78f97fc10495@haskell.org> References: <049.b152863155a8f5ca5d2c78f97fc10495@haskell.org> Message-ID: <064.d1ba86a1bfd5a8314321605b41ec56c1@haskell.org> #13945: 'ghc-pkg update' fails due to bad file descriptor error ---------------------------------+---------------------------------------- Reporter: mpickering | Owner: bgamari Type: bug | Status: new Priority: high | Milestone: 8.2.2 Component: Compiler | Version: 8.2.1-rc3 Resolution: | Keywords: Operating System: Linux | Architecture: Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D3897 Wiki Page: | ---------------------------------+---------------------------------------- Changes (by bgamari): * owner: (none) => bgamari -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 9 16:32:44 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 09 Oct 2017 16:32:44 -0000 Subject: [GHC] #14332: Deriving clauses can have forall types In-Reply-To: <050.6c2c9b47d51bbd6274ba7997829a8360@haskell.org> References: <050.6c2c9b47d51bbd6274ba7997829a8360@haskell.org> Message-ID: <065.ec6dd9f8d2fdeaf044850cff47008e7a@haskell.org> #14332: Deriving clauses can have forall types -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.2.1 checker) | Resolution: | Keywords: deriving 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): In both of your examples, IIUC, the unification happens to the datatype variables, not the newly-quantified variables in the `deriving` clause. I agree that this kind unification is good. I further agree that any unwritten kinds in a `deriving` clause should be unified. But I think any explicitly written kinds are skolems, and that this doesn't cause problems. The example toward the end of comment:8 should be rejected; the user should have to write `Type`, not `k`. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 9 16:43:00 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 09 Oct 2017 16:43:00 -0000 Subject: [GHC] #14330: Sparks are not started promptly In-Reply-To: <049.15689449c051500fed95f985fcea2e55@haskell.org> References: <049.15689449c051500fed95f985fcea2e55@haskell.org> Message-ID: <064.5e743040e369203503bf01063ca69408@haskell.org> #14330: Sparks are not started promptly -------------------------------------+------------------------------------- Reporter: andrewthad | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: | Keywords: sparks 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: Jaffacake (added) Comment: Considering this to be a bug is perhaps reasonable, although perhaps only a documentation bug. I agree that the current behavior is a bit surprising. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 9 16:43:50 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 09 Oct 2017 16:43:50 -0000 Subject: [GHC] #14332: Deriving clauses can have forall types In-Reply-To: <050.6c2c9b47d51bbd6274ba7997829a8360@haskell.org> References: <050.6c2c9b47d51bbd6274ba7997829a8360@haskell.org> Message-ID: <065.096bfa3ed809341b7ea26459e2307137@haskell.org> #14332: Deriving clauses can have forall types -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.2.1 checker) | Resolution: | Keywords: deriving 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): > But I think any explicitly written kinds are skolems, and that this doesn't cause problems. Right! > The example toward the end of comment:8 should be rejected Which example, precisely? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 9 16:59:29 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 09 Oct 2017 16:59:29 -0000 Subject: [GHC] #14332: Deriving clauses can have forall types In-Reply-To: <050.6c2c9b47d51bbd6274ba7997829a8360@haskell.org> References: <050.6c2c9b47d51bbd6274ba7997829a8360@haskell.org> Message-ID: <065.fc2684299febe089e2a04d1597072a23@haskell.org> #14332: Deriving clauses can have forall types -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.2.1 checker) | Resolution: | Keywords: deriving 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): Replying to [comment:9 goldfire]: > In both of your examples, IIUC, the unification happens to the datatype variables, not the newly-quantified variables in the `deriving` clause. I agree that this kind unification is good. I further agree that any unwritten kinds in a `deriving` clause should be unified. I am baffled as to why we are drawing these arbitrary distinctions among slightly different positionings of kind variables in a data declaration. I want to believe that there is some overarching principle behind these viewpoints, but it's either not spelled out anywhere, or I'm too dense to discern it from the subtext (or both). > But I think any explicitly written kinds are skolems, and that this doesn't cause problems. OK. But in `data Proxy (a :: k) = Proxy deriving Functor`, `k` is //also// a user-written kind! Why should this not be considered rigid, but the `k` in `data D = D deriving (C k)` should be considered rigid? I swear I'm not trying to be contrarian here simply to be stubborn. But from my viewpoint, all of these proposed changes are adding a ton of complexity, and moreover, they are ruling out classes of programs that currently typecheck. I don't think it's healthy to view the `C c1 ... cn` in `deriving (C1 ... cn)` like the types in other class instance heads, because `C c1 ... cn` isn't like other types—it's a macro, not a standalone thing. We shouldn't foist our biases of other types onto this construct, which is quite different from anything else in Haskell. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 9 17:01:23 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 09 Oct 2017 17:01:23 -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.fcb2b7041ca63f776138b3e787c1fb02@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: Component: Compiler (Type | Version: 8.2.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: | -------------------------------------+------------------------------------- Comment (by goldfire): So, if `deriving (C (a :: k))` doesn't mean to quantify, what do you expect it to mean? I agree that the current error is wrong, but I'm not sure what behavior you want GHC to take here. If you want GHC to accept your original declaration, creating `instance forall k (a :: k). C a D`, then we're basically in agreement. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 9 17:03:36 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 09 Oct 2017 17:03:36 -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.bdf2143e05fb1e5b57c32b4c0fa9b2bd@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: Component: Compiler (Type | Version: 8.2.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: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): I meant exactly what I wrote in the original description: it should emit: {{{#!hs instance C (a :: k) D }}} After all, the user wrote `deriving (C (a :: k))`, and the data type is `D`. What you get after doing the whole `deriving` macro-application-eta- reduction-kind-unification shebang is `C (a :: k) D`. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 9 18:58:02 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 09 Oct 2017 18:58:02 -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.ce08854a4f530cc8c6e08774de19afb5@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: Component: Compiler (Type | Version: 8.2.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: | -------------------------------------+------------------------------------- Comment (by goldfire): But I see `instance C (a :: k) D` as fully equivalent to `instance forall k (a :: k). C a D`. They just make different things explicit, but both declarations have the same static and dynamic semantics. And, I don't quite agree that clauses in a `deriving` are macro-like. They are types of kind `... -> Type -> Constraint`, where the `...` may be empty. My desire to put `forall` in there is more macro-like, I admit... but no more so than the syntax for pattern synonym types or even GADT constructor types. I believe that you are genuinely confused here. But I'm afraid I'm equally confused as to why you're confused. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 9 18:58:52 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 09 Oct 2017 18:58:52 -0000 Subject: [GHC] #14332: Deriving clauses can have forall types In-Reply-To: <050.6c2c9b47d51bbd6274ba7997829a8360@haskell.org> References: <050.6c2c9b47d51bbd6274ba7997829a8360@haskell.org> Message-ID: <065.20724c30f750a216aa115f254fe08bde@haskell.org> #14332: Deriving clauses can have forall types -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.2.1 checker) | Resolution: | Keywords: deriving 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): Replying to [comment:10 simonpj]: > > But I think any explicitly written kinds are skolems, and that this doesn't cause problems. > > Right! > > > The example toward the end of comment:8 should be rejected > > Which example, precisely? Oops. I meant comment:6. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 9 19:06:41 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 09 Oct 2017 19:06:41 -0000 Subject: [GHC] #14333: GHC doesn't use the fact that Coercible is symmetric In-Reply-To: <051.317ebc999077ee18339a9e5fa0ad5d1c@haskell.org> References: <051.317ebc999077ee18339a9e5fa0ad5d1c@haskell.org> Message-ID: <066.aee63fe99f7e1cce1f590147a204047f@haskell.org> #14333: GHC doesn't use the fact that Coercible is symmetric -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: | Keywords: TypeFamilies, | 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): Could you include the full code of the concrete use case? I followed the link, but that's a non-trivial and not-self-contained file. GHC accepts {{{#!hs f :: Coercible b a => a x -> b x f = coerce }}} So, if `SameRep a b` implies `Coercible (Rep a) (Rep b)`, then the final implication above should hold. If, on the other hand, `SameRep a b` implies `forall x. Coercible (Rep a x) (Rep b x)`, then you're in trouble (at least with the current implementation). It occurs to me that you do not necessarily need to do anything clever with `a b ~R# c d`, but instead `F a b ~R# F c d`, where `F` has an arity of 1. Tackling the special case where we have a type function at the head, instead of any variable, might be easier than the general case. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 9 19:21:51 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 09 Oct 2017 19:21:51 -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.9619183b009b21e3e2e8e6c3e9752cf8@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: Component: Compiler (Type | Version: 8.2.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: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): Replying to [comment:6 goldfire]: > But I see `instance C (a :: k) D` as fully equivalent to `instance forall k (a :: k). C a D`. They just make different things explicit, but both declarations have the same static and dynamic semantics. Yes, agreed. > And, I don't quite agree that clauses in a `deriving` are macro-like. They are types of kind `... -> Type -> Constraint`, where the `...` may be empty. Surely you mean kind `k -> Constraint`? You certainly can't say `deriving Z`, where `class Z a b`, for instance. To elaborate what I mean by "macro" here: yes, the `C c1 ... cn` in `deriving (C c1 ... cn)` is a type, and one that is thrust into the typechecker at one point as a sanity-check to make sure you aren't writing utter garbage. But it's not like other types in that `C c1 ... cn` doesn't appear on its own in the emitted code—it only makes sense to talk about `C c1 ... cn` in the final program //after it has been combined// with its corresponding data type. Trying to stick `forall`s on just `C c1 ... cn` feels nonsensical, because the scoping needs to happen for the whole derived instance, not just `C c1 ... cn`, which happens to be one part of the recipe. > I believe that you are genuinely confused here. But I'm afraid I'm equally confused as to why you're confused. The thing that I am confused on above all else is this business on skolems you mention in https://ghc.haskell.org/trac/ghc/ticket/14332#comment:9, and why the user-written kinds of a data type's type variables don't fall under the same scrutiny. I can't even begin to understand how this would work without an explanation of what is motivating this design choice. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 9 22:11:58 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 09 Oct 2017 22:11:58 -0000 Subject: [GHC] #4012: Compilation results are not deterministic In-Reply-To: <043.9c3dc141e8901acb12e4d7c1e6038096@haskell.org> References: <043.9c3dc141e8901acb12e4d7c1e6038096@haskell.org> Message-ID: <058.a4bbab2db1a50b3c37c504a71b1634be@haskell.org> #4012: Compilation results are not deterministic -------------------------------------+------------------------------------- Reporter: kili | Owner: niteria Type: bug | Status: new Priority: high | Milestone: 8.4.1 Component: Compiler | Version: 6.12.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Other | Test Case: Blocked By: 11362 | Blocking: 12262 Related Tickets: #10424 | Differential Rev(s): Phab:D910, | Phab:D1073, Phab:D1133, Phab:D1192, | Phab:D1268, Phab:D1360, Phab:D1373, Wiki Page: | Phab:D1396, Phab:D1457, Phab:D1468, DeterministicBuilds | Phab:D1487, Phab:D1504, Phab:D1508 -------------------------------------+------------------------------------- Comment (by duog): It looks like trac:14092 could lead to nondeterministic interface files when using parallel --make. Single threaded --make does not seem to be nondetermistic, though I believe it is uncomfortably sensitve to the order in which modules are compiled, which can be determined by the order they are imported or passed to ghc. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 9 22:26:24 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 09 Oct 2017 22:26:24 -0000 Subject: [GHC] #14334: Large static object : getLabelBc: Ran out of labels In-Reply-To: <049.315b3535fb3bb7f5242722a4542261ed@haskell.org> References: <049.315b3535fb3bb7f5242722a4542261ed@haskell.org> Message-ID: <064.a2aae1af5bf47ce64503aa94155a768d@haskell.org> #14334: Large static object : getLabelBc: Ran out of labels -------------------------------+-------------------------------------- Reporter: h4ck3rm1k3 | Owner: (none) Type: bug | Status: new Priority: lowest | Milestone: Component: GHCi | Version: 8.0.2 Resolution: | Keywords: Operating System: Linux | Architecture: x86_64 (amd64) Type of failure: GHCi crash | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------+-------------------------------------- Comment (by h4ck3rm1k3): Is there any workarounds ? Is this 16 bit per module or globally? How do you deal with large programs? Can i transform the data which is code into some other form to use less labels? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 9 23:23:34 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 09 Oct 2017 23:23:34 -0000 Subject: [GHC] #14337: typeRepKind can perform substantial amounts of allocation Message-ID: <045.992f3f60f638e8ee69252627da02cfdc@haskell.org> #14337: typeRepKind can perform substantial amounts of allocation -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.4.1 Component: Core | Version: 8.2.1 Libraries | Keywords: Typeable | 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 came up with a (rather contrived) test case to demonstrate that Phab:D4082 reduced big-O time complexity in pathological cases. But I expected it to increase space usage by a constant factor. What I found was very much the opposite: it dramatically reduced allocation. The reason for this is obvious in hindsight. Every time we call `typeRepKind`, we recalculate the kind entirely from scratch. That recalculation is only a potential ''time'' problem for `TrApp`, because we only need to walk down links, but it's also a ''space'' problem for `TrTyCon`, because we're building up a `TypeRep` from a `KindRep`. The solution, assuming we choose to keep `typeRepKind`, seems fairly clear: whether or not we choose to cache the kind in `TrApp`, we should almost certainly do so in `TrTyCon`. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 9 23:31:10 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 09 Oct 2017 23:31:10 -0000 Subject: [GHC] #14334: Large static object : getLabelBc: Ran out of labels In-Reply-To: <049.315b3535fb3bb7f5242722a4542261ed@haskell.org> References: <049.315b3535fb3bb7f5242722a4542261ed@haskell.org> Message-ID: <064.a0f25f9816eb49ef22fec7a209877d1f@haskell.org> #14334: Large static object : getLabelBc: Ran out of labels -------------------------------+-------------------------------------- Reporter: h4ck3rm1k3 | Owner: (none) Type: bug | Status: new Priority: lowest | Milestone: Component: GHCi | Version: 8.0.2 Resolution: | Keywords: Operating System: Linux | Architecture: x86_64 (amd64) Type of failure: GHCi crash | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------+-------------------------------------- Comment (by bgamari): I believe we pass Core to the byte-code generator as a whole module. I suspect breaking your list into multiple, moderately-sized modules would be one potential workaround. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 10 02:29:03 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 10 Oct 2017 02:29:03 -0000 Subject: [GHC] #7169: Warning for incomplete record field label used as function In-Reply-To: <047.31629c8fe32b813e38c132e8d4305995@haskell.org> References: <047.31629c8fe32b813e38c132e8d4305995@haskell.org> Message-ID: <062.e6c1fb86a773f5f7a8ea0a503022263b@haskell.org> #7169: Warning for incomplete record field label used as function -------------------------------------+------------------------------------- Reporter: goldfire | Owner: nakaji_dayo Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.7 Resolution: | Keywords: Warnings, | newcomer 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): D4083 Wiki Page: | -------------------------------------+------------------------------------- Changes (by nakaji_dayo): * differential: => D4083 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 10 02:30:49 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 10 Oct 2017 02:30:49 -0000 Subject: [GHC] #7169: Warning for incomplete record field label used as function In-Reply-To: <047.31629c8fe32b813e38c132e8d4305995@haskell.org> References: <047.31629c8fe32b813e38c132e8d4305995@haskell.org> Message-ID: <062.f66866728899b162744bb1cc3c095e25@haskell.org> #7169: Warning for incomplete record field label used as function -------------------------------------+------------------------------------- Reporter: goldfire | Owner: nakaji_dayo Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.7 Resolution: | Keywords: Warnings, | newcomer 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): Phab:D4083 Wiki Page: | -------------------------------------+------------------------------------- Changes (by nakaji_dayo): * differential: D4083 => Phab:D4083 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 10 08:41:24 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 10 Oct 2017 08:41:24 -0000 Subject: [GHC] #14334: Large static object : getLabelBc: Ran out of labels In-Reply-To: <049.315b3535fb3bb7f5242722a4542261ed@haskell.org> References: <049.315b3535fb3bb7f5242722a4542261ed@haskell.org> Message-ID: <064.4812f4666638aeea399a561823b9add1@haskell.org> #14334: Large static object : getLabelBc: Ran out of labels -------------------------------+-------------------------------------- Reporter: h4ck3rm1k3 | Owner: (none) Type: bug | Status: new Priority: lowest | Milestone: Component: GHCi | Version: 8.0.2 Resolution: | Keywords: Operating System: Linux | Architecture: x86_64 (amd64) Type of failure: GHCi crash | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------+-------------------------------------- Comment (by h4ck3rm1k3): Splitting this into two modules gave me a workaround for this issue. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 10 14:05:23 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 10 Oct 2017 14:05:23 -0000 Subject: [GHC] #14338: Simplifier fails with "Simplifier ticks exhausted" Message-ID: <049.819ef8e60a65cb9f3e29afb8f69166a7@haskell.org> #14338: Simplifier fails with "Simplifier ticks exhausted" -------------------------------------+------------------------------------- Reporter: dredozubov | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 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: -------------------------------------+------------------------------------- While upgrading a codebase to GHC 8.2.1(it compiles reliably with 7.10.3) we encountered an issue with core simplifier(and rewrite rules if I correctly understood the meaning of RuleFired): {{{ ghc: panic! (the 'impossible' happened) (GHC version 8.2.1 for x86_64-apple-darwin): Simplifier ticks exhausted When trying RuleFired Class op $p2HModify To increase the limit, use -fsimpl-tick-factor=N (default 100) If you need to do this, let GHC HQ know, and what factor you needed Total ticks: 10450410 1494659 PreInlineUnconditionally 149100 w_ipsJ 149095 w_ipps 149084 w_iplQ 149084 w1_iplR 149084 w2_iplS 149084 w3_iplT 149078 w_ipm7 149078 w1_ipm8 149078 w2_ipm9 149078 w3_ipma 120 $d~_iplr 120 $d~1_ipls 120 irred_iplu 120 eta_iplv 39 v_spsR 38 v_sp9c 38 v1_sp9d 38 v_spii 38 v1_spij 38 v2_spik 38 v3_spil 37 v_sp99 37 v1_sp9a 37 v_spin 37 v1_spio 37 v2_spip 37 v3_spiq 36 v_sp9f 36 v1_sp9g 36 v_spis ...skipping... 1 cobox1_apuk 1 cobox_apuq 1 cobox1_apur 1 cobox_apux 1 cobox1_apuy 2 CaseIdentity 2 ds1_iqAB 4 FillInCaseDefault 1 nt_sqyY 1 nt_sqz9 1 nt_sqze 1 nt_sqzj 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/simplCore/SimplMonad.hs:199:31 in ghc:SimplMonad Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug }}} We tried to shrink reproducible example to something reasonable and this is what we got: https://github.com/4e6/webapp-template-hs/tree/simpl-tick- factor Compiling it with stack build --ghc-options='-fsimpl-tick-factor=1000'(ten times the default) will demonstrate the issue. It fails reliably with a combination of servant and hset libraries. Removing one route from a servant API or moving the PayloadX to the head of type-level list makes it compilable again. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 10 14:08:44 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 10 Oct 2017 14:08:44 -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.bccea5dc574d3c94081ce69effee99ef@haskell.org> #14338: Simplifier fails with "Simplifier ticks exhausted" -------------------------------------+------------------------------------- Reporter: dredozubov | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 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): Can you paste the full `-ddump-simpl-stats` output? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 10 14:12:32 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 10 Oct 2017 14:12:32 -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.2d357375ac3fd7046eb54aa525fe0c38@haskell.org> #14338: Simplifier fails with "Simplifier ticks exhausted" -------------------------------------+------------------------------------- Reporter: dredozubov | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 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: | -------------------------------------+------------------------------------- Changes (by dredozubov): * Attachment "Runner.dump-simpl-stats" added. simpl-stats -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 10 14:15:43 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 10 Oct 2017 14:15:43 -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.8f0221c909177c979376d4cc2c1a9ac1@haskell.org> #14338: Simplifier fails with "Simplifier ticks exhausted" -------------------------------------+------------------------------------- Reporter: dredozubov | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 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): That file seems to be truncated to 6 lines? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 10 14:18:22 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 10 Oct 2017 14:18:22 -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.b67188183d483f4e392d65dc6f1026fc@haskell.org> #14338: Simplifier fails with "Simplifier ticks exhausted" -------------------------------------+------------------------------------- Reporter: dredozubov | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 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: | -------------------------------------+------------------------------------- Changes (by dredozubov): * Attachment "Runner.2.dump-simpl-stats" added. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 10 14:23:44 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 10 Oct 2017 14:23:44 -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.d3afa66193b368147092413d7ad2eb33@haskell.org> #14338: Simplifier fails with "Simplifier ticks exhausted" -------------------------------------+------------------------------------- Reporter: dredozubov | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 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): Still truncated?, perhaps it is too big for trac to deal with? Can you upload it elsewhere? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 10 14:24:43 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 10 Oct 2017 14:24:43 -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.098ee928ca5b721fdf8538d67892ca54@haskell.org> #14338: Simplifier fails with "Simplifier ticks exhausted" -------------------------------------+------------------------------------- Reporter: dredozubov | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 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 dredozubov): Just uploaded it as github gist: https://gist.github.com/dredozubov/e6696780405eba1615cd15a6e657892b -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 10 15:06:23 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 10 Oct 2017 15:06:23 -0000 Subject: [GHC] #7169: Warning for incomplete record field label used as function In-Reply-To: <047.31629c8fe32b813e38c132e8d4305995@haskell.org> References: <047.31629c8fe32b813e38c132e8d4305995@haskell.org> Message-ID: <062.0a9654f793d41f70a59179d9886390ed@haskell.org> #7169: Warning for incomplete record field label used as function -------------------------------------+------------------------------------- Reporter: goldfire | Owner: nakaji_dayo Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.7 Resolution: | Keywords: Warnings, | newcomer 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): Phab:D4083 Wiki Page: | -------------------------------------+------------------------------------- Comment (by nakaji_dayo): Replying to [comment:22 mgsloan]: I agree. I think "-Wpartial-fields" is good name. I have submitted code review about `-Wpartial-fields`.\\ On the other hand, I don't have any commit about `-Wpartial-field-usages`. > I think it also makes sense to have an option to emit warnings for partial record fields. Perhaps call it -Wpartial-field-usages? The reason this is helpful is that some libraries may export partial fields. It's still helpful as a sanity check for users of a library to have this as an optional warning. I think that this is helpful in this case too. But as far as I know, GHC doesn't have warnings for usage of partial function.\\ In case of implement this, it seems that design considering the whole is necessary.\\ Is my understanding correct? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 10 15:41:24 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 10 Oct 2017 15:41:24 -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.3113dcb0ac41ec0ac7ac5c6a1d022fad@haskell.org> #14338: Simplifier fails with "Simplifier ticks exhausted" -------------------------------------+------------------------------------- Reporter: dredozubov | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 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): It seems that the problems are because we are doing lots (and lots (and lots)) of inlining of functions which produce and handle coercions. Here is the iface file which contains the functions which appear many times in the ddump-simpl-stats log. https://gist.github.com/mpickering/30adf1e6c61bcfa1462031f947079c10 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 10 17:29:01 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 10 Oct 2017 17:29:01 -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.955e2ec7f3567bc7ac436f44b351bdb7@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: 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: | -------------------------------------+------------------------------------- Comment (by bgamari): For the record, I tried adding an assertion for the coercion variable matching invariant in Phab:D4035 but it doesn't appear to be an invariant that we respect. Perhaps we should tighten this up a bit. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 10 22:32:19 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 10 Oct 2017 22:32:19 -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.6bea4253d5057cda5b9ceebd3c32429c@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: 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: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): I attempted to create a minimal example of this bug. This is as small as I was able to make it (~110 lines): {{{#!hs {-# LANGUAGE TypeInType #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE TypeApplications #-} module DataTypeableInternal (pattern App) where import Data.Kind (Type) import GHC.Fingerprint (Fingerprint, fingerprintFingerprints) import GHC.Types (RuntimeRep, TYPE, TyCon) data (a :: k1) :~~: (b :: k2) where HRefl :: a :~~: a data TypeRep (a :: k) where TrTyCon :: {-# UNPACK #-} !Fingerprint -> !TyCon -> [SomeTypeRep] -> TypeRep (a :: k) TrApp :: forall k1 k2 (a :: k1 -> k2) (b :: k1). {-# UNPACK #-} !Fingerprint -> TypeRep (a :: k1 -> k2) -> TypeRep (b :: k1) -> TypeRep (a b) TrFun :: forall (r1 :: RuntimeRep) (r2 :: RuntimeRep) (a :: TYPE r1) (b :: TYPE r2). {-# UNPACK #-} !Fingerprint -> TypeRep a -> TypeRep b -> TypeRep (a -> b) data SomeTypeRep where SomeTypeRep :: forall k (a :: k). !(TypeRep a) -> SomeTypeRep typeRepFingerprint :: TypeRep a -> Fingerprint typeRepFingerprint = undefined mkTrApp :: forall k1 k2 (a :: k1 -> k2) (b :: k1). TypeRep (a :: k1 -> k2) -> TypeRep (b :: k1) -> TypeRep (a b) mkTrApp rep@(TrApp _ (TrTyCon _ con _) (x :: TypeRep x)) (y :: TypeRep y) | con == funTyCon -- cheap check first , Just (IsTYPE (rx :: TypeRep rx)) <- isTYPE (typeRepKind x) , Just (IsTYPE (ry :: TypeRep ry)) <- isTYPE (typeRepKind y) , Just HRefl <- withTypeable x $ withTypeable rx $ withTypeable ry $ typeRep @((->) x :: TYPE ry -> Type) `eqTypeRep` rep = undefined mkTrApp a b = TrApp fpr a b where fpr_a = typeRepFingerprint a fpr_b = typeRepFingerprint b fpr = fingerprintFingerprints [fpr_a, fpr_b] pattern App :: forall k2 (t :: k2). () => forall k1 (a :: k1 -> k2) (b :: k1). (t ~ a b) => TypeRep a -> TypeRep b -> TypeRep t pattern App f x <- (splitApp -> Just (IsApp f x)) where App f x = mkTrApp f x data IsApp (a :: k) where IsApp :: forall k k' (f :: k' -> k) (x :: k'). () => TypeRep f -> TypeRep x -> IsApp (f x) splitApp :: forall k (a :: k). () => TypeRep a -> Maybe (IsApp a) splitApp (TrApp _ f x) = Just (IsApp f x) splitApp rep@(TrFun _ a b) = Just (IsApp (mkTrApp arr a) b) where arr = bareArrow rep splitApp (TrTyCon{}) = Nothing withTypeable :: forall a r. TypeRep a -> (Typeable a => r) -> r withTypeable = undefined eqTypeRep :: forall k1 k2 (a :: k1) (b :: k2). TypeRep a -> TypeRep b -> Maybe (a :~~: b) eqTypeRep = undefined typeRepKind :: TypeRep (a :: k) -> TypeRep k typeRepKind = undefined bareArrow :: forall (r1 :: RuntimeRep) (r2 :: RuntimeRep) (a :: TYPE r1) (b :: TYPE r2). () => TypeRep (a -> b) -> TypeRep ((->) :: TYPE r1 -> TYPE r2 -> Type) bareArrow = undefined data IsTYPE (a :: Type) where IsTYPE :: forall (r :: RuntimeRep). TypeRep r -> IsTYPE (TYPE r) isTYPE :: TypeRep (a :: Type) -> Maybe (IsTYPE a) isTYPE = undefined class Typeable (a :: k) where typeRep :: Typeable a => TypeRep a typeRep = undefined funTyCon :: TyCon funTyCon = undefined instance (Typeable f, Typeable a) => Typeable (f a) instance Typeable ((->) :: TYPE r -> TYPE s -> Type) instance Typeable TYPE }}} I wasn't able to reproduce the exact panic in this ticket, but if you compile with `-O1` and `-dcore-lint`, then you do experience a Core Lint that is very reminiscent of the panic: {{{ $ /opt/ghc/8.2.1/bin/ghc -O1 -fforce-recomp Bug.hs -dcore-lint [1 of 1] Compiling DataTypeableInternal ( Bug.hs, Bug.o ) *** Core Lint errors : in result of Float out(FOS {Lam = Just 0, Consts = True, OverSatApps = True}) *** : warning: In the type ‘forall (a :: TYPE r1) k1. (k1 :: *) ~# (* :: *) => TypeRep ((->) a |> _N ->_N Sym cobox)’ cobox_a2ym :: (k2_aVY :: *) ~# (* :: *) [LclId[CoVarId]] is out of scope *** Offending Program *** *** End of Offense *** : error: Compilation had errors }}} `cobox_a2ym` appears in `$mApp` (the matcher for the `App` pattern synonym). I've reproduced this with GHC 8.0.2 and HEAD. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 10 22:41:16 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 10 Oct 2017 22:41:16 -0000 Subject: [GHC] #14339: GHC 8.2.1 regression when combining GND with TypeError (solveDerivEqns: probable loop) Message-ID: <050.71c0075dc8f8df8e6578520d1b23a3ca@haskell.org> #14339: GHC 8.2.1 regression when combining GND with TypeError (solveDerivEqns: probable loop) -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: high | Milestone: 8.4.1 Component: Compiler | Version: 8.2.1 (Type checker) | Keywords: deriving, | Operating System: Unknown/Multiple CustomTypeErrors | Architecture: | Type of failure: Compile-time Unknown/Multiple | crash or panic Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- This code panics on GHC 8.2.1 and later: {{{#!hs {-# LANGUAGE DataKinds #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE UndecidableInstances #-} module Bug where import GHC.TypeLits newtype Baz = Baz Foo deriving Bar newtype Foo = Foo Int class Bar a where bar :: a instance (TypeError (Text "Boo")) => Bar Foo where bar = undefined }}} {{{ $ /opt/ghc/8.2.1/bin/ghci Bug.hs GHCi, version 8.2.1: http://www.haskell.org/ghc/ :? for help Loaded GHCi configuration from /home/rgscott/.ghci [1 of 1] Compiling Bug ( Bug.hs, interpreted ) ghc: panic! (the 'impossible' happened) (GHC version 8.2.1 for x86_64-unknown-linux): solveDerivEqns: probable loop DerivSpec ds_loc = Bug.hs:9:12-14 ds_name = $fBarBaz ds_tvs = [] ds_cls = Bar ds_tys = [Baz] ds_theta = [ThetaOrigin to_tvs = [] to_givens = [] to_wanted_origins = [Bar Foo, (Foo :: *) ~R# (Baz :: *)]] ds_mechanism = newtype [[s0_a1D7[fuv:0]]] 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/TcDerivInfer.hs:515:9 in ghc:TcDerivInfer }}} This is a regression since GHC 8.0.2, in which it does compile successfully. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 10 23:12:31 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 10 Oct 2017 23:12:31 -0000 Subject: [GHC] #14339: GHC 8.2.1 regression when combining GND with TypeError (solveDerivEqns: probable loop) In-Reply-To: <050.71c0075dc8f8df8e6578520d1b23a3ca@haskell.org> References: <050.71c0075dc8f8df8e6578520d1b23a3ca@haskell.org> Message-ID: <065.a73c2d18b21959c47783620057b2bc63@haskell.org> #14339: GHC 8.2.1 regression when combining GND with TypeError (solveDerivEqns: probable loop) -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: high | Milestone: 8.4.1 Component: Compiler (Type | Version: 8.2.1 checker) | Keywords: deriving, Resolution: | CustomTypeErrors 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): This is technically my fault, since this regression first started happening in 639e702b6129f501c539b158b982ed8489e3d09c (`Refactor DeriveAnyClass's instance context inference`). That being said, I don't have any inclination as to what part of that patch tickles this panic. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 11 03:23:22 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 11 Oct 2017 03:23:22 -0000 Subject: [GHC] #14263: typeKind is quadratic In-Reply-To: <047.347eff46dcda74aa975a5781e6cb08f5@haskell.org> References: <047.347eff46dcda74aa975a5781e6cb08f5@haskell.org> Message-ID: <062.b6689ac8e698d0b7ec3a41a65d2ce9bc@haskell.org> #14263: typeKind is quadratic -------------------------------------+------------------------------------- Reporter: goldfire | Owner: dfeuer Type: task | 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 dfeuer): * owner: (none) => dfeuer -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 11 06:28:38 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 11 Oct 2017 06:28:38 -0000 Subject: [GHC] #14339: GHC 8.2.1 regression when combining GND with TypeError (solveDerivEqns: probable loop) In-Reply-To: <050.71c0075dc8f8df8e6578520d1b23a3ca@haskell.org> References: <050.71c0075dc8f8df8e6578520d1b23a3ca@haskell.org> Message-ID: <065.902896accd310885cb3541cf80d969bc@haskell.org> #14339: GHC 8.2.1 regression when combining GND with TypeError (solveDerivEqns: probable loop) -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: high | Milestone: 8.4.1 Component: Compiler (Type | Version: 8.2.1 checker) | Keywords: deriving, Resolution: | CustomTypeErrors 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 kosmikus): * cc: kosmikus (added) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 11 07:41:55 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 11 Oct 2017 07:41:55 -0000 Subject: [GHC] #12537: Parallel cabal builds Segmentation Fault on PowerPC 64-bit In-Reply-To: <048.e821713d1c06a4d751fa396103744323@haskell.org> References: <048.e821713d1c06a4d751fa396103744323@haskell.org> Message-ID: <063.959303316a78a3a47fb3a94e92cba221@haskell.org> #12537: Parallel cabal builds Segmentation Fault on PowerPC 64-bit -------------------------------------+------------------------------------- Reporter: michelmno | Owner: trommler Type: bug | Status: patch Priority: normal | Milestone: Component: Compiler | Version: 8.0.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: powerpc64 Type of failure: Incorrect result | Test Case: at runtime | Blocked By: 12469 | Blocking: Related Tickets: | Differential Rev(s): Phab:D3984 Wiki Page: | -------------------------------------+------------------------------------- Comment (by michelmno): Replying to [comment:12 trommler]: > Replying to [comment:11 trommler]: > > I found an issue in the implementation of atomic read and atomic write operations in ghc-prim. I am working on a fix for powerpc64 and powerpc64le. > Phab:3984 improves the situation a lot on an old PowerMac. The segfault occurs only on every other run where before this patch I would see a segfault on almost all build attempts. > > The correctness issue I found in `libraries/ghc-prim/cbits/atomic.c` affects all platforms that are using the fallback functions `hs_atomicread*` and `hs_atomicwrite*`. I will create a separate ticket for that. What is the referenced Phab:3934 ? it is pointing to https://phabricator.haskell.org/3984 that is a "404 not found" page What is the reference to the separate ticket supposed to be created ? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 11 08:29:10 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 11 Oct 2017 08:29:10 -0000 Subject: [GHC] #14254: The Binary instance for TypeRep smells a bit expensive In-Reply-To: <045.b0b485439de28cadfa61420f4ccc13a7@haskell.org> References: <045.b0b485439de28cadfa61420f4ccc13a7@haskell.org> Message-ID: <060.c83da1983edbf944092d15ea25650f71@haskell.org> #14254: The Binary instance for TypeRep smells a bit expensive -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.2.1 Resolution: | Keywords: Typeable 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:D3998, Wiki Page: | Phab:D4078, Phab:D4082 -------------------------------------+------------------------------------- Comment (by simonpj): > to avoid these performance problems I would love to know what "these performance problems" actually are. The ticket description is opaque to me. Can someone offer a program that behaves badly, and an explanation of what is bad? It's hard for me to review a patch without knowing the problem that it seeks to solve. comment:9 offers two patches. Are they alternatives? Or do we need them both? Do they solve two different problems? What are those two problems. Finally, does this all have something to do with #14337? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 11 08:29:45 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 11 Oct 2017 08:29:45 -0000 Subject: [GHC] #14337: typeRepKind can perform substantial amounts of allocation In-Reply-To: <045.992f3f60f638e8ee69252627da02cfdc@haskell.org> References: <045.992f3f60f638e8ee69252627da02cfdc@haskell.org> Message-ID: <060.044df529a4377c71b6f8e29d61e28075@haskell.org> #14337: typeRepKind can perform substantial amounts of allocation -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.4.1 Component: Core Libraries | Version: 8.2.1 Resolution: | Keywords: Typeable 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): Is this something to do with #14254, perhaps? > I came up with a (rather contrived) test case Did you perhaps fail to attach it? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 11 08:39:11 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 11 Oct 2017 08:39:11 -0000 Subject: [GHC] #14254: The Binary instance for TypeRep smells a bit expensive In-Reply-To: <045.b0b485439de28cadfa61420f4ccc13a7@haskell.org> References: <045.b0b485439de28cadfa61420f4ccc13a7@haskell.org> Message-ID: <060.5b8e4f44d4ca9adbc1638ad38ce8d209@haskell.org> #14254: The Binary instance for TypeRep smells a bit expensive -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.2.1 Resolution: | Keywords: Typeable 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:D3998, Wiki Page: | Phab:D4078, Phab:D4082 -------------------------------------+------------------------------------- Changes (by dfeuer): * Attachment "Big.hs" added. Test case -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 11 09:06:30 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 11 Oct 2017 09:06:30 -0000 Subject: [GHC] #14254: The Binary instance for TypeRep smells a bit expensive In-Reply-To: <045.b0b485439de28cadfa61420f4ccc13a7@haskell.org> References: <045.b0b485439de28cadfa61420f4ccc13a7@haskell.org> Message-ID: <060.239b12221c715c9d1f09b3918f310ea7@haskell.org> #14254: The Binary instance for TypeRep smells a bit expensive -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.2.1 Resolution: | Keywords: Typeable 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:D3998, Wiki Page: | Phab:D4078, Phab:D4082 -------------------------------------+------------------------------------- Comment (by dfeuer): The attached test case (`Big.hs`) takes a third of a second to run and allocates half a gigabyte of memory. I went through several iterations of solutions, yes. The three that strike me as significant contenders at the moment are: 1. Phab:D4082, which is a pretty simple way to make sure deserialization is never too bad. This cuts total time to 0.029s and allocation to 17.7MB. 2. Phab:D4085, which caches `TypeRep`s of kinds in each `TrTyCon` and `TrApp` constructor. This fixes the deserialization problem and also ensures that `Data.Dynamic.dynApply` is cheap. This has really been my preferred approach all along. There is some extra laziness I'd like to get rid of that is not entirely trivial to eliminate; bgamari may well know how to do so. This cuts total time to 0.023s and allocation to 15MB. 3. Get rid of `typeRepKind`. This is definitely the most intrusive option, and I don't have a terribly clear sense of the consequences as yet, but I'm not sure we should dismiss it out of hand. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 11 09:12:19 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 11 Oct 2017 09:12:19 -0000 Subject: [GHC] #14254: The Binary instance for TypeRep smells a bit expensive In-Reply-To: <045.b0b485439de28cadfa61420f4ccc13a7@haskell.org> References: <045.b0b485439de28cadfa61420f4ccc13a7@haskell.org> Message-ID: <060.0fbcacacf98aa3323080f8e5709fc7f6@haskell.org> #14254: The Binary instance for TypeRep smells a bit expensive -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.2.1 Resolution: | Keywords: Typeable 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:D3998, Wiki Page: | Phab:D4078, Phab:D4082 -------------------------------------+------------------------------------- Comment (by dfeuer): One more thing: while I don't think it's a good idea, we ''could'' go with a version of Phab:D4085 that only caches kind typereps in `TrTyCon` constructors. That would eliminate the allocation problem and alleviate but not eliminate the time problem. The reason I favor the fully cached version is that it doesn't strike me as really that expensive to add one more pointer to a constructor that already has four words of payload (two for the `Fingerprint`, one for the function, and one for the argument). However, that's somewhat conditional on being able to eliminate the extra laziness. It seems there's a knot that needs tying for `Type :: Type`, which makes things a tad fussy. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 11 09:14:03 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 11 Oct 2017 09:14:03 -0000 Subject: [GHC] #14254: The Binary instance for TypeRep smells a bit expensive In-Reply-To: <045.b0b485439de28cadfa61420f4ccc13a7@haskell.org> References: <045.b0b485439de28cadfa61420f4ccc13a7@haskell.org> Message-ID: <060.16af93881f00bb3be67f5ffea5ac2e5d@haskell.org> #14254: The Binary instance for TypeRep smells a bit expensive -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.2.1 Resolution: | Keywords: Typeable Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: #14337 | Differential Rev(s): Phab:D3998, Wiki Page: | Phab:D4082, Phab:D4085 -------------------------------------+------------------------------------- Changes (by dfeuer): * differential: Phab:D3998, Phab:D4078, Phab:D4082 => Phab:D3998, Phab:D4082, Phab:D4085 * related: => #14337 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 11 09:14:58 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 11 Oct 2017 09:14:58 -0000 Subject: [GHC] #14337: typeRepKind can perform substantial amounts of allocation In-Reply-To: <045.992f3f60f638e8ee69252627da02cfdc@haskell.org> References: <045.992f3f60f638e8ee69252627da02cfdc@haskell.org> Message-ID: <060.9aaaad915a088aac1adebb3f54cd5cb5@haskell.org> #14337: typeRepKind can perform substantial amounts of allocation -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.4.1 Component: Core Libraries | Version: 8.2.1 Resolution: | Keywords: Typeable Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: #14254 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by dfeuer): * related: => #14254 Comment: I've attached it now, to #14254. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 11 10:23:20 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 11 Oct 2017 10:23:20 -0000 Subject: [GHC] #13945: 'ghc-pkg update' fails due to bad file descriptor error In-Reply-To: <049.b152863155a8f5ca5d2c78f97fc10495@haskell.org> References: <049.b152863155a8f5ca5d2c78f97fc10495@haskell.org> Message-ID: <064.f2dcf099fe870862baf6f8a9ee48fb0b@haskell.org> #13945: 'ghc-pkg update' fails due to bad file descriptor error ---------------------------------+---------------------------------------- Reporter: mpickering | Owner: bgamari Type: bug | Status: new Priority: high | Milestone: 8.2.2 Component: Compiler | Version: 8.2.1-rc3 Resolution: | Keywords: Operating System: Linux | Architecture: Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D3897 Wiki Page: | ---------------------------------+---------------------------------------- Comment (by j.waldmann): I built from ghc-8.2.2-rc1 source and "make install" fails as before - unsurprisingly, since the above patch is not in there. Should it be? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 11 10:33:26 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 11 Oct 2017 10:33:26 -0000 Subject: [GHC] #14254: The Binary instance for TypeRep smells a bit expensive In-Reply-To: <045.b0b485439de28cadfa61420f4ccc13a7@haskell.org> References: <045.b0b485439de28cadfa61420f4ccc13a7@haskell.org> Message-ID: <060.97adb707404bb9312de7147b4ca331c9@haskell.org> #14254: The Binary instance for TypeRep smells a bit expensive -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.2.1 Resolution: | Keywords: Typeable Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: #14337 | Differential Rev(s): Phab:D3998, Wiki Page: | Phab:D4082, Phab:D4085 -------------------------------------+------------------------------------- Comment (by simonpj): Re the loop, `Type` = `TYPE Lifted`. So the `TypeRep` for `Type` is a `TrApp`, with a cached kind. So {{{ TYPE Lifted :: TYPE Lifted }}} But that kind has a cached kind: {{{ TYPE Lifted :: TYPE Lifted :: TYPE Lifted }}} and if the cache field is strict you build an infinite data structure. The only way out of this I can see is to * define a top level definition the `TypeRep` for `TYPE Lifted` * in that definition, do not use `mkTrApp`; instead build an explicit loop {{{ trTYPELifted = TrApp fpr trTYPE trLifted trTYPELifted }}} note that `trTYPELifted mentions itself directly. * In `mkTrApp` spot that case, and return `trTYPELifted`. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 11 11:51:21 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 11 Oct 2017 11:51:21 -0000 Subject: [GHC] #12537: Parallel cabal builds Segmentation Fault on PowerPC 64-bit In-Reply-To: <048.e821713d1c06a4d751fa396103744323@haskell.org> References: <048.e821713d1c06a4d751fa396103744323@haskell.org> Message-ID: <063.5b8331f32175cf574feb51ae39261c99@haskell.org> #12537: Parallel cabal builds Segmentation Fault on PowerPC 64-bit -------------------------------------+------------------------------------- Reporter: michelmno | Owner: trommler Type: bug | Status: patch Priority: normal | Milestone: Component: Compiler | Version: 8.0.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: powerpc64 Type of failure: Incorrect result | Test Case: at runtime | Blocked By: 12469 | Blocking: Related Tickets: #14244 | Differential Rev(s): Phab:D3984 Wiki Page: | -------------------------------------+------------------------------------- Changes (by trommler): * related: => #14244 Comment: Replying to [comment:13 michelmno]: > > ref Phab:3934 is invalid it is probably Phab:D3934 I assume I fixed the link, sorry. > > What is the reference to the separate ticket supposed to be created ? That is #14244. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 11 12:30:00 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 11 Oct 2017 12:30:00 -0000 Subject: [GHC] #14325: Erroneous program emits no errors In-Reply-To: <046.40df183102ba61ea001c050698aa9aba@haskell.org> References: <046.40df183102ba61ea001c050698aa9aba@haskell.org> Message-ID: <061.9443b6011a2f271c0c5edd9142fb19ad@haskell.org> #14325: Erroneous program emits no errors -------------------------------------+------------------------------------- Reporter: simonpj | 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): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Simon Peyton Jones ): In [changeset:"c81f66ccafdb4c6c7a09cfaf6819c8797c518491/ghc" c81f66cc/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="c81f66ccafdb4c6c7a09cfaf6819c8797c518491" Fix over-eager error suppression in TcErrors See Note [Given insolubles] in TcRnTypes Fixes Trac #14325. }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 11 12:30:00 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 11 Oct 2017 12:30:00 -0000 Subject: [GHC] #14307: NamedFieldPuns should allow "ambiguous" field names In-Reply-To: <046.4bb60103aff0450ac9d1c7696050c9a0@haskell.org> References: <046.4bb60103aff0450ac9d1c7696050c9a0@haskell.org> Message-ID: <061.5a6b0a33b4183702458426b9c6def844@haskell.org> #14307: NamedFieldPuns should allow "ambiguous" field names -------------------------------------+------------------------------------- Reporter: mgsloan | Owner: (none) Type: feature request | Status: new Priority: low | Milestone: Component: Compiler | Version: 8.2.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: | rename/should_fail/T14307 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Simon Peyton Jones ): In [changeset:"7720c293e7f5ca5089e3d154aad99e8060d6ac63/ghc" 7720c293/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="7720c293e7f5ca5089e3d154aad99e8060d6ac63" Tidy up some convoluted "child/parent" code In investigating something else (Trac #14307) I encountered the wonders of TcRnExports.lookupChildrenExport, and the data type ChildLookupResult. I managed to remove the NameErr constructor from ChildLookupResult, and simplify the code significantly at the same time. This is just refactoring; no change in behaviour. }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 11 12:57:55 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 11 Oct 2017 12:57:55 -0000 Subject: [GHC] #10816: Fixity declaration for associated type rejected In-Reply-To: <047.cd9a1f02ca3266d044f12741b664719c@haskell.org> References: <047.cd9a1f02ca3266d044f12741b664719c@haskell.org> Message-ID: <062.10d91f55bab6eeaf50582d532f824c6f@haskell.org> #10816: Fixity declaration for associated type rejected -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: 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: | Differential Rev(s): Phab:D4077 Wiki Page: | -------------------------------------+------------------------------------- Comment (by Ryan Scott ): In [changeset:"9c3f73168a6f7f6632b6a3ffd2cfcd774976a7f1/ghc" 9c3f731/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="9c3f73168a6f7f6632b6a3ffd2cfcd774976a7f1" Fix #10816 by renaming FixitySigs more consistently Summary: #10816 surfaced because we were renaming top-level fixity declarations with a different code path (`rnSrcFixityDecl`) than the code path for fixity declarations inside of type classes, which is not privy to names that exist in the type namespace. Luckily, the fix is simple: use `rnSrcFixityDecl` in both places. Test Plan: make test TEST=T10816 Reviewers: austin, bgamari, simonpj Reviewed By: simonpj Subscribers: simonpj, rwbarton, thomie GHC Trac Issues: #10816 Differential Revision: https://phabricator.haskell.org/D4077 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 11 12:58:54 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 11 Oct 2017 12:58:54 -0000 Subject: [GHC] #10816: Fixity declaration for associated type rejected In-Reply-To: <047.cd9a1f02ca3266d044f12741b664719c@haskell.org> References: <047.cd9a1f02ca3266d044f12741b664719c@haskell.org> Message-ID: <062.c645470909cec5a35b35817ce465a31d@haskell.org> #10816: Fixity declaration for associated type rejected -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 7.10.2 Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: | testsuite/rename/should_compile/T10816 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4077 Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * testcase: => testsuite/rename/should_compile/T10816 * status: patch => closed * resolution: => fixed * milestone: => 8.4.1 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 11 13:09:31 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 11 Oct 2017 13:09:31 -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.088123278bb2b30f2112ffb11fd5f82e@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: 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: | -------------------------------------+------------------------------------- Comment (by simonpj): Crumbs. comment:15 exposes a completely new bug in float-out. I have a fix validating. The relevant Note is {{{ {- Note [Floating and kind casts] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider this case x of K (co :: * ~# k) -> let v :: Int |> co v = e in blah Then, even if we are abstracting over Ids, or if e is bottom, we can't float v outside the 'co' binding. Reason: if we did we'd get v' :: forall k. (Int ~# Age) => Int |> co and now 'co' isn't in scope in that type. The underlying reason is that 'co' is a value-level thing and we can't abstract over that in a type. So if v's /type/ mentions 'co' we can't float it out beyond the binding site of 'co'. That's why we have this as_far_as_poss stuff. Usually as_far_as_poss is just tOP_LEVEL; but occasionally a coercion variable (which is an Id) mentioned in type prevents this. Example Trac #14270 comment:15. }}} However this is ''not'' the original bug for this ticket. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 11 13:27:55 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 11 Oct 2017 13:27:55 -0000 Subject: [GHC] #13531: GHC fails with "Dynamic linker not initialised" when -j is on and trying to load nonexistent .so file In-Reply-To: <042.f97bf302ed95b0f9a174910a7d6a0986@haskell.org> References: <042.f97bf302ed95b0f9a174910a7d6a0986@haskell.org> Message-ID: <057.583991df0df6d57fd41b639a7a7b150d@haskell.org> #13531: GHC fails with "Dynamic linker not initialised" when -j is on and trying to load nonexistent .so file -------------------------------------+------------------------------------- Reporter: nh2 | Owner: (none) 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 crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: #13137, #9868, | Differential Rev(s): #10355, #13607 | Wiki Page: | -------------------------------------+------------------------------------- Comment (by nh2): For people who google with quotes and don't use British English: dynamic linker not initialized -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 11 14:00:32 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 11 Oct 2017 14:00:32 -0000 Subject: [GHC] #14289: Pretty-printing of derived multi-parameter classes omits necessary parentheses In-Reply-To: <050.12237887bf2722a5c0ca5d51c4478a96@haskell.org> References: <050.12237887bf2722a5c0ca5d51c4478a96@haskell.org> Message-ID: <065.ffd0ced637c3a11aba57031a7b6b3ffe@haskell.org> #14289: Pretty-printing of derived multi-parameter classes omits necessary parentheses -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: alanz Type: bug | Status: patch Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 (Parser) | 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:D4056 Wiki Page: | -------------------------------------+------------------------------------- Comment (by Alan Zimmerman ): In [changeset:"6869864eac211885edcd4b14425fd368069e4aba/ghc" 6869864e/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="6869864eac211885edcd4b14425fd368069e4aba" Pretty-printing of derived multi-parameter classes omits parentheses Summary: Pretty printing a splice with an HsAppType in the deriving clause, such as $([d| data Foo a = Foo a deriving (C a) |]) would omit the parens. Test Plan: ./validate Reviewers: RyanGlScott, austin, bgamari Subscribers: rwbarton, thomie GHC Trac Issues: #14289 Differential Revision: https://phabricator.haskell.org/D4056 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 11 14:00:59 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 11 Oct 2017 14:00:59 -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.eab419def0245acc313bdf5570dda515@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: 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: | -------------------------------------+------------------------------------- Comment (by Simon Peyton Jones ): In [changeset:"4bb54a4522d44a81b2c47233f48252bd73c38279/ghc" 4bb54a45/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="4bb54a4522d44a81b2c47233f48252bd73c38279" Avoid creating dependent types in FloatOut This bug was exposed by Trac #14270. The problem and its cure is described in SetLevels, Note [Floating and kind casts]. It's simple and will affect very few programs. But the very fact that it was so unexpected is discomforting. }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 11 14:04:40 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 11 Oct 2017 14:04:40 -0000 Subject: [GHC] #14325: Erroneous program emits no errors In-Reply-To: <046.40df183102ba61ea001c050698aa9aba@haskell.org> References: <046.40df183102ba61ea001c050698aa9aba@haskell.org> Message-ID: <061.4a331b4a9fd954157c6567e8f5e88ebc@haskell.org> #14325: Erroneous program emits no errors -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: merge 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: | typecheck/should_fail/T14325 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * testcase: => typecheck/should_fail/T14325 * status: new => merge Comment: Merge if convenient. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 11 14:08:05 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 11 Oct 2017 14:08:05 -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.e7f71af271538055f8595dce96fc7f96@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: 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: | -------------------------------------+------------------------------------- Comment (by simonpj): OK I have fixed commment:15 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 11 14:14:38 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 11 Oct 2017 14:14:38 -0000 Subject: [GHC] #14323: Occurs check regressions in GHC 8.2.1 (and HEAD) In-Reply-To: <050.dbbfdd1cdcddb65fbaceda43a16d7074@haskell.org> References: <050.dbbfdd1cdcddb65fbaceda43a16d7074@haskell.org> Message-ID: <065.7df92eaa2d11713fe2b130ceee8544ec@haskell.org> #14323: Occurs check regressions in GHC 8.2.1 (and HEAD) -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.2.1 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): comment:8 done in {{{ commit f20cf982f126aea968ed6a482551550ffb6650cf Author: Simon Peyton Jones Date: Mon Oct 9 13:16:59 2017 +0100 Remove wc_insol from WantedConstraints This patch is a pure refactoring, which I've wanted to do for some time. The main payload is * Remove the wc_insol field from WantedConstraints; instead put all the insolubles in wc_simple * Remove inert_insols from InertCans Instead put all the insolubles in inert_irreds * Add a cc_insol flag to CIrredCan, to record that the constraint is definitely insoluble Reasons * Quite a bit of code gets slightly simpler * Fewer concepts to keep separate * Insolubles don't happen at all in production code that is just being recompiled, so previously there was a lot of moving-about of empty sets A couple of error messages acutally improved. }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 11 14:27:50 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 11 Oct 2017 14:27:50 -0000 Subject: [GHC] #14340: Rename AND typecheck types before values Message-ID: <045.d421452b2eb2470280894bf76a284114@haskell.org> #14340: Rename AND typecheck types before values -------------------------------------+------------------------------------- Reporter: ezyang | Owner: (none) Type: task | 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: -------------------------------------+------------------------------------- In a few cases, we get in trouble during renaming of values because we don't have access to information that would be computed during typechecking. Two examples of this: * https://ghc.haskell.org/trac/ghc/ticket/13905 - Here, we need to determine if a Name is a newtype constructor or data type constructor during renaming (desugaring of applicative do), which is not known until after typechecking * https://ghc.haskell.org/trac/ghc/ticket/12088 - Perhaps? We want to rename and typecheck instance declarations at the same time, since they can occur between the type declarations. One nit: you can't compute SCCs until you rename. But if you just rename ALL of the types at once, then SCC them, that should be fine. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 11 14:49:30 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 11 Oct 2017 14:49:30 -0000 Subject: [GHC] #14289: Pretty-printing of derived multi-parameter classes omits necessary parentheses In-Reply-To: <050.12237887bf2722a5c0ca5d51c4478a96@haskell.org> References: <050.12237887bf2722a5c0ca5d51c4478a96@haskell.org> Message-ID: <065.bca9b6705fca0a3b712523caf48b5896@haskell.org> #14289: Pretty-printing of derived multi-parameter classes omits necessary parentheses -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: alanz Type: bug | Status: closed Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 (Parser) | 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:D4056 Wiki Page: | -------------------------------------+------------------------------------- Changes (by alanz): * status: patch => closed * resolution: => fixed -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 11 15:20:06 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 11 Oct 2017 15:20:06 -0000 Subject: [GHC] #13945: 'ghc-pkg update' fails due to bad file descriptor error In-Reply-To: <049.b152863155a8f5ca5d2c78f97fc10495@haskell.org> References: <049.b152863155a8f5ca5d2c78f97fc10495@haskell.org> Message-ID: <064.c0bf3cc999d53294ff8529734ac77b14@haskell.org> #13945: 'ghc-pkg update' fails due to bad file descriptor error ---------------------------------+---------------------------------------- Reporter: mpickering | Owner: bgamari Type: bug | Status: new Priority: high | Milestone: 8.2.2 Component: Compiler | Version: 8.2.1-rc3 Resolution: | Keywords: Operating System: Linux | Architecture: Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D3897 Wiki Page: | ---------------------------------+---------------------------------------- Comment (by bgamari): In this case the ticket hasn't yet been closed, which is when I typically backport patches. That being said, I suppose comment:14 and comment:15 are almost certainly going to be part of the final solution so I'll go ahead and merge them. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 11 15:28:44 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 11 Oct 2017 15:28:44 -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.76d55af81b857390a97fceb4f5fc65df@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: Component: Compiler (Type | Version: 8.2.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: | -------------------------------------+------------------------------------- Comment (by simonpj): > Trying to stick foralls on just C c1 ... cn feels nonsensical, You could try not thinking of them as foralls. Say {{{ data D = D deriving ({k a}. C (a :: k)) }}} where I'm using `{k a}` to bring `k` and `a` into scope. But they ARE skolems. I'm sure you wouldn't be happy with {{{ data D = D deriving( {a}. C a } }}} it the derived instance declaration ended up being {{{ instance C Int D }}} where the `a` gets unified with `Int` somehow. (Fundeps or something.) This quantification is ''per-deriving-clause''. If you say `a` you mean `a` and not `Int`! > why the user-written kinds of a data type's type variables don't fall under the same scrutiny Because they are shared across the data type decl itself, ''and'' all the deriving clauses. So in {{{ data Proxy k (a :: k) = Proxy deriving( Functor, ...others... ) }}} the `Functor` instance only makes sense when `k=*`, so we specialise it to that {{{ instance GHC.Base.Functor (Main.Proxy *) where }}} We ''can't'' turn that `k` into `*` in the decl without crippling `Proxy`. To put it another way: * The kind binders in the data decl belong to the data decl * The freshly bound variables in the deriving clause belong to the instance decl * Naturally, the quantified variables of the data decl may be instantiated in the instance decl. Does that help? Is this essentially the same ticket as #14332? Can we combine? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 11 15:38:16 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 11 Oct 2017 15:38:16 -0000 Subject: [GHC] #14003: Allow more worker arguments in SpecConstr In-Reply-To: <048.309346fc5a64debb96097824f9daa7e2@haskell.org> References: <048.309346fc5a64debb96097824f9daa7e2@haskell.org> Message-ID: <063.891616829ecbde190c619a147f1fb3b6@haskell.org> #14003: Allow more worker arguments in SpecConstr -------------------------------------+------------------------------------- Reporter: choenerzs | Owner: choenerzs Type: feature request | Status: new Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.2.1-rc3 Resolution: | Keywords: JoinPoints, | Fusion Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: #11565 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by choenerzs): Hi Ben, sorry for the delay. Work caught up with me. I think, this month should work out. Best, Christian -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 11 15:41:18 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 11 Oct 2017 15:41:18 -0000 Subject: [GHC] #14339: GHC 8.2.1 regression when combining GND with TypeError (solveDerivEqns: probable loop) In-Reply-To: <050.71c0075dc8f8df8e6578520d1b23a3ca@haskell.org> References: <050.71c0075dc8f8df8e6578520d1b23a3ca@haskell.org> Message-ID: <065.82b21f74566be293420fa57dd4cc3791@haskell.org> #14339: GHC 8.2.1 regression when combining GND with TypeError (solveDerivEqns: probable loop) -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: high | Milestone: 8.4.1 Component: Compiler (Type | Version: 8.2.1 checker) | Keywords: deriving, Resolution: | CustomTypeErrors 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 Simon Peyton Jones ): In [changeset:"13fdca3d174ff15ac347c5db78370f457a3013ee/ghc" 13fdca3d/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="13fdca3d174ff15ac347c5db78370f457a3013ee" Add a missing zonk in TcDerivInfer.simplifyDeriv I'm astonished that anything worked without this! Fixes Trac #14339 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 11 15:57:22 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 11 Oct 2017 15:57:22 -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.e73f8ba1a3c2d069edc8c668a8f54761@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: 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: | -------------------------------------+------------------------------------- Comment (by simonpj): Here is what is happening. The bug happens in `SpecConstr` when compiling `libraries/base/./Data/Typeable/Internal.hs` with `-O2`. When I re-apply the patch "Typeable: Allow App to match arrow types" I get a Lint error as before. Here's why: We have {{{ mkTrApp_Xjt [Occ=LoopBreaker] :: forall k1 k2 (a :: k1 -> k2) (b :: k1). TypeRep a -> TypeRep b -> TypeRep (a b) }}} and an application thereof looking like {{{ mkTrApp_Xjt @ (TYPE (b_a3TI |> Nth:2 (Sym cobox_a3TS))) @ (TYPE (b_X444 |> Nth:2 (Sym cobox_X44r)) -> *) @ (->) @ (b_X4hY |> Sym (cobox_a3TT (Coh (Sym (Coh _N (Nth:2 (Sym cobox_a3TS)))) (Nth:2 (Sym cobox_a3TS)) ; Coh _N (Nth:2 (Sym cobox_a3TS))) ; Sym cobox_a3TJ)) (Data.Typeable.Internal.TrTyCon @ (TYPE (b_a3TI |> Nth:2 (Sym cobox_a3TS)) -> TYPE (b_X444 |> Nth:2 (Sym cobox_X44r)) -> *) @ (->) dt_a2Xi dt_a2Xj GHC.Types.$tc(->) kind_vars_X3a2) (ds_X4ZX `cast` ( :: (TypeRep b_X4hY :: *) ~R# (TypeRep (b_X4hY |> cobox_a3TJ ; Sym cobox_a3TT (Sym (Coh _N (Nth:2 (Sym cobox_a3TS))) ; Sym (Coh (Sym (Coh _N (Nth:2 (Sym cobox_a3TS)))) (Nth:2 (Sym cobox_a3TS))))) :: *))) }}} So `SpecConstr` tries to specialise `mkTrApp_Xjt` for this call; in particular the `TrTyCon` argument. Very good. But the rule we get is this {{{ RULES: "SC:mkTrApp0" forall (@ k1_X4hU) (@ (b_X4hY :: k1_X4hU)) (@ k1_X440) (@ (b_X444 :: k1_X440)) (@ k1_a3TG) (@ (b_a3TI :: k1_a3TG)) (sc_s7Yv :: TypeRep (b_X4hY |> cobox_a3TJ ; Sym cobox_a3TT (Sym (Coh _N (Nth:2 (Sym cobox_a3TS))) ; Sym (Coh (Sym (Coh _N (Nth:2 (Sym cobox_a3TS)))) (Nth:2 (Sym cobox_a3TS)))))) (cobox_X44r :: (RuntimeRep -> * :: *) ~# (k1_X440 -> * :: *)) (sc_s7Yr :: Word#) (sc_s7Ys :: Word#) (sc_s7Yt :: [SomeTypeRep]) (cobox_a3TS :: (RuntimeRep -> * :: *) ~# (k1_a3TG -> * :: *)). mkTrApp_Xjt @ (TYPE (b_a3TI |> <(type pat) k1_a3TG, RuntimeRep>)) @ (TYPE (b_X444 |> <(type pat) k1_X440, RuntimeRep>) -> *) @ (->) @ (b_X4hY |> <(type pat) k1_X4hU, TYPE (b_a3TI |> Nth:2 (Sym cobox_a3TS))>) (Data.Typeable.Internal.TrTyCon @ (TYPE (b_a3TI |> Nth:2 (Sym cobox_a3TS)) -> TYPE (b_X444 |> Nth:2 (Sym cobox_X44r)) -> *) @ (->) sc_s7Yr sc_s7Ys GHC.Types.$tc(->) sc_s7Yt) sc_s7Yv = $smkTrApp_s7Ze @ k1_X4hU @ b_X4hY @ k1_X440 @ b_X444 @ k1_a3TG @ b_a3TI sc_s7Yv @~ (cobox_X44r :: (RuntimeRep -> * :: *) ~# (k1_X440 -> * :: *)) sc_s7Yr sc_s7Ys sc_s7Yt @~ (cobox_a3TS :: (RuntimeRep -> * :: *) ~# (k1_a3TG -> * :: *))] }}} This is no good in at least two ways * We mention `cobox_a3TS` in the kind of `sc_s7Yv`, but don't bind it until later in the telescope. * Matching against the LHS will not bind those `cobox` variables, because the type matcher discards casts (and rightly so). So that's the problem. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 11 16:06:02 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 11 Oct 2017 16:06:02 -0000 Subject: [GHC] #14339: GHC 8.2.1 regression when combining GND with TypeError (solveDerivEqns: probable loop) In-Reply-To: <050.71c0075dc8f8df8e6578520d1b23a3ca@haskell.org> References: <050.71c0075dc8f8df8e6578520d1b23a3ca@haskell.org> Message-ID: <065.d36cc5ee9f5a127deccbfa5b48cb7737@haskell.org> #14339: GHC 8.2.1 regression when combining GND with TypeError (solveDerivEqns: probable loop) -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: merge Priority: high | Milestone: 8.4.1 Component: Compiler (Type | Version: 8.2.1 checker) | Keywords: deriving, Resolution: | CustomTypeErrors Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Compile-time | Test Case: crash or panic | testsuite/tests/deriving/should_compile/T14339 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * status: new => merge * testcase: => testsuite/tests/deriving/should_compile/T14339 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 11 16:24:06 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 11 Oct 2017 16:24:06 -0000 Subject: [GHC] #14214: Users guide lies about default optimization level In-Reply-To: <046.736805dbdfc6944b76008d4f99ba283f@haskell.org> References: <046.736805dbdfc6944b76008d4f99ba283f@haskell.org> Message-ID: <061.62dd449cc80001cd5be9bd779cfa020f@haskell.org> #14214: Users guide lies about default optimization level -------------------------------------+------------------------------------- Reporter: bgamari | Owner: bgamari Type: bug | Status: new Priority: high | Milestone: 8.4.1 Component: Compiler | Version: 8.2.1 Resolution: | Keywords: 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 bgamari): * cc: patrickdoc (added) Comment: CCing patrickdoc, who has some great work on improving documentation in the past. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 11 16:24:37 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 11 Oct 2017 16:24:37 -0000 Subject: [GHC] #11654: User Guide: Generate command line options table from ghc-flags directives In-Reply-To: <046.ddd00ea2d6129f4c2ecb14404cf0a699@haskell.org> References: <046.ddd00ea2d6129f4c2ecb14404cf0a699@haskell.org> Message-ID: <061.efe84c5360dbec58354302a6e64678c3@haskell.org> #11654: User Guide: Generate command line options table from ghc-flags directives -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: task | Status: closed Priority: normal | Milestone: 8.4.1 Component: Documentation | Version: 7.10.3 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:D3839, Wiki Page: | Phab:D3886 -------------------------------------+------------------------------------- Changes (by bgamari): * status: patch => closed * resolution: => fixed Comment: Phab:D3886 has been merged. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 11 16:25:49 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 11 Oct 2017 16:25:49 -0000 Subject: [GHC] #13678: Overhaul the linker In-Reply-To: <047.e127759c3a4017d82c97188d47fb36ec@haskell.org> References: <047.e127759c3a4017d82c97188d47fb36ec@haskell.org> Message-ID: <062.a4695356b67966ab0961c205ec17e3d9@haskell.org> #13678: Overhaul the linker -------------------------------------+------------------------------------- Reporter: angerman | Owner: (none) Type: bug | Status: new Priority: lowest | Milestone: ⊥ Component: Compiler | Version: 8.3 (Linking) | Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #14069 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * related: => #14069 Comment: For the record, the matter of W^X protection is being tracked by #14069. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 11 16:34:42 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 11 Oct 2017 16:34:42 -0000 Subject: [GHC] #14214: Users guide lies about default optimization level In-Reply-To: <046.736805dbdfc6944b76008d4f99ba283f@haskell.org> References: <046.736805dbdfc6944b76008d4f99ba283f@haskell.org> Message-ID: <061.b154ac646f23bb8a331d9cd75ded7460@haskell.org> #14214: Users guide lies about default optimization level -------------------------------------+------------------------------------- Reporter: bgamari | Owner: bgamari Type: bug | Status: new Priority: high | Milestone: 8.4.1 Component: Compiler | Version: 8.2.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Documentation | Unknown/Multiple bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): In response to comment:2: Regarding (2): It would be great to have the documentation specify precisely which flags each of the optimisation levels implies. However, I think we would ideally like to have these lists generated from the implementation; otherwise it's only a matter of time until they fall out- of-date. Regarding (3): I believe that as of b2b416014e4276ebb660d85c3a612f7ca45ade78 there is now such a mention. Regarding (4): Indeed, it looks like this has been out-of-date for quite a long time; I don't remember a time when `-v` told you anything about which optimisation flags were used. Regarding (5): I absolutely agree. The documentation for some of these flags is incredibly confusing. What makes things complicated is that `-fopt-coercion` doesn't currently exist. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 11 16:38:24 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 11 Oct 2017 16:38:24 -0000 Subject: [GHC] #14043: GHC.Stack.callStack throws exception In-Reply-To: <046.04c19b3f92ab14302022d82213714264@haskell.org> References: <046.04c19b3f92ab14302022d82213714264@haskell.org> Message-ID: <061.4b7372d81585499330bde0919d8ef6e5@haskell.org> #14043: GHC.Stack.callStack throws exception -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: closed Priority: high | 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): Phab:D3795 Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: patch => closed * resolution: => fixed Comment: This was merged. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 11 16:40:16 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 11 Oct 2017 16:40:16 -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.fa604c73b1c6d38fdc7642c522fd6e9d@haskell.org> #14338: Simplifier fails with "Simplifier ticks exhausted" -------------------------------------+------------------------------------- Reporter: dredozubov | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 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): I can't even get to base-camp (with HEAD). cabal install (with `--allow- newer` else nothing at all works) says {{{ ....lots of stuff... Preprocessing library unordered-containers-0.2.8.0... [1 of 8] Compiling Data.HashMap.PopCount ( Data/HashMap/PopCount.hs, dist/build/Data/HashMap/PopCount.o ) [2 of 8] Compiling Data.HashMap.Unsafe ( Data/HashMap/Unsafe.hs, dist/build/Data/HashMap/Unsafe.o ) [3 of 8] Compiling Data.HashMap.Array ( Data/HashMap/Array.hs, dist/build/Data/HashMap/Array.o ) [4 of 8] Compiling Data.HashMap.UnsafeShift ( Data/HashMap/UnsafeShift.hs, dist/build/Data/HashMap/UnsafeShift.o ) [5 of 8] Compiling Data.HashMap.Base ( Data/HashMap/Base.hs, dist/build/Data/HashMap/Base.o ) [6 of 8] Compiling Data.HashMap.Strict ( Data/HashMap/Strict.hs, dist/build/Data/HashMap/Strict.o ) [7 of 8] Compiling Data.HashMap.Lazy ( Data/HashMap/Lazy.hs, dist/build/Data/HashMap/Lazy.o ) [8 of 8] Compiling Data.HashSet ( Data/HashSet.hs, dist/build/Data/HashSet.o ) Data/HashSet.hs:80:39: error: Module ‘Data.Semigroup’ does not export ‘Monoid(..)’ | 80 | import Data.Semigroup (Semigroup(..), Monoid(..)) | ^^^^^^^^^^ cabal: Leaving directory '/tmp/cabal-tmp-22962/unordered- containers-0.2.8.0' Installed iproute-1.7.1 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 11 17:09:45 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 11 Oct 2017 17:09:45 -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.ed5ae928f4f7c95236e418436c61b0c4@haskell.org> #14338: Simplifier fails with "Simplifier ticks exhausted" -------------------------------------+------------------------------------- Reporter: dredozubov | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 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 bgamari): simonpj, perhaps try running {{{ git clone git://github.com/RyanGlScott/unordered-containers cabal install --allow-newer unordered-containers/ }}} and then try again. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 11 17:10:02 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 11 Oct 2017 17:10:02 -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.feae4903721c6b0ed9fe38a1ef026442@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: 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: patch => closed * resolution: => fixed Comment: This should now be resolved. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 11 17:22:42 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 11 Oct 2017 17:22:42 -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.69832e066ce7606545c8990085e1cee0@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 -------------------------------------+------------------------------------- Changes (by bgamari): * keywords: => newcomer -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 11 17:37:20 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 11 Oct 2017 17:37:20 -0000 Subject: [GHC] #12970: Add default implementation for Bits.bitSize In-Reply-To: <045.18bc248265b05555e123c1ad78e88bb9@haskell.org> References: <045.18bc248265b05555e123c1ad78e88bb9@haskell.org> Message-ID: <060.1907ea613fb6c0b777f784c72d8bde11@haskell.org> #12970: Add default implementation for Bits.bitSize -------------------------------------+------------------------------------- Reporter: txnull | Owner: dfeuer Type: feature request | Status: patch Priority: high | Milestone: 8.4.1 Component: libraries/base | 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:D3723 Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): Are we going to do this? If so I wonder whether we should push it to 8.6 to avoid breaking libraries again prior to 8.4. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 11 17:55:07 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 11 Oct 2017 17:55:07 -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.8daa18c4918b07b19d77cbd289ff4ff4@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: Component: Compiler (Type | Version: 8.2.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: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): Replying to [comment:8 simonpj]: > Does that help? Thank you Simon, that was the careful explanation I was searching for. I think I'm sold on this idea now. > Is this essentially the same ticket as #14332? Can we combine? I'm not sure. Do we know for sure that the bug described in this ticket is caused by a deficient treatment of quantification in `deriving` clauses? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 11 17:56:04 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 11 Oct 2017 17:56:04 -0000 Subject: [GHC] #14332: Deriving clauses can have forall types In-Reply-To: <050.6c2c9b47d51bbd6274ba7997829a8360@haskell.org> References: <050.6c2c9b47d51bbd6274ba7997829a8360@haskell.org> Message-ID: <065.14c4ea05381d9a9f37fbd2bac5f6ad9c@haskell.org> #14332: Deriving clauses can have forall types -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.2.1 checker) | Resolution: | Keywords: deriving 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): I think I'm sold on this idea now, after hearing Simon's rationalization of it in https://ghc.haskell.org/trac/ghc/ticket/14331#comment:8. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 11 18:50:48 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 11 Oct 2017 18:50:48 -0000 Subject: [GHC] #14341: Show instance for TypeReps is a bit broken Message-ID: <045.cd028c896befff283e5e70cbc43095b2@haskell.org> #14341: Show instance for TypeReps is a bit broken -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Core | Version: 8.2.1 Libraries | Keywords: Typeable | Operating System: Unknown/Multiple Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): Phab:D4084 | Wiki Page: -------------------------------------+------------------------------------- There are two problems. 1. Showing typereps of tuples can produce unnecessary parentheses: {{{ Prelude K T> typeRep @(Int, Maybe Bool) (Int,(Maybe Bool)) }}} The fix is trivial. 2. Showing typereps of ticked (i.e., lifted) tuples and lists gives hard- to-read results, because it does not use the usual special syntax: {{{ Prelude K T> typeRep @'(Int, Maybe Bool) '(,) * * Int (Maybe Bool) Prelude K T> typeRep @'[1,2,3] ': Nat 1 (': Nat 2 (': Nat 3 ('[] Nat))) }}} Fixing the lifted tuple case is trivial. Fixing the lifted list case is slightly less trivial, but not hard. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 11 19:15:49 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 11 Oct 2017 19:15:49 -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.ebfbc3e1a0c9826fe09c7747632edd55@haskell.org> #14338: Simplifier fails with "Simplifier ticks exhausted" -------------------------------------+------------------------------------- Reporter: dredozubov | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 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 4e6): I've updated [https://github.com/4e6/webapp-template-hs/tree/simpl-tick- factor webapp-template-hs] example (branch ''simpl-tick-factor'') to be compatible with GHC 7 and 8. With ghc-7.10.3 it compiles with 2534 simplifier ticks, and with ghc-8.2.1 it panics with 'Simplifier ticks exhausted' on 256649 ticks. See readme for details. Here is the full `-ddump-simpl-stats` output for both cases: https://gist.github.com/4e6/5ef65efdb309daa373a928ec36404fd7 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 11 19:42:55 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 11 Oct 2017 19:42:55 -0000 Subject: [GHC] #14341: Show instance for TypeReps is a bit broken In-Reply-To: <045.cd028c896befff283e5e70cbc43095b2@haskell.org> References: <045.cd028c896befff283e5e70cbc43095b2@haskell.org> Message-ID: <060.a8953f2a90aa1da8dbb61e19996583bd@haskell.org> #14341: Show instance for TypeReps is a bit broken -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Core Libraries | Version: 8.2.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): Phab:D4084 Wiki Page: | -------------------------------------+------------------------------------- Comment (by dfeuer): Actually, there's a third problem as well: type operators are not shown infix! The solution, I believe, is to add operator precedence to `TyCon`, and then to use something akin to `Show` derivation machinery in `showTypeRep`. I imagine we don't need to worry too much about showing these things ''efficiently'', at least for the foreseeable future. `SomeTypeRep` has no `Read` instance, so there's no substantial risk of anyone trying to use its `Show` instance for anything other than error messages and interactive exploration. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 11 19:46:00 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 11 Oct 2017 19:46:00 -0000 Subject: [GHC] #14341: Show instance for TypeReps is a bit broken In-Reply-To: <045.cd028c896befff283e5e70cbc43095b2@haskell.org> References: <045.cd028c896befff283e5e70cbc43095b2@haskell.org> Message-ID: <060.8805f6c0356ac7b0600652d8c0a89328@haskell.org> #14341: Show instance for TypeReps is a bit broken -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Core Libraries | Version: 8.2.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): Phab:D4084 Wiki Page: | -------------------------------------+------------------------------------- Description changed by dfeuer: Old description: > There are two problems. > > 1. Showing typereps of tuples can produce unnecessary parentheses: > > {{{ > Prelude K T> typeRep @(Int, Maybe Bool) > (Int,(Maybe Bool)) > }}} > > The fix is trivial. > > 2. Showing typereps of ticked (i.e., lifted) tuples and lists gives hard- > to-read results, because it does not use the usual special syntax: > > {{{ > Prelude K T> typeRep @'(Int, Maybe Bool) > '(,) * * Int (Maybe Bool) > > Prelude K T> typeRep @'[1,2,3] > ': Nat 1 (': Nat 2 (': Nat 3 ('[] Nat))) > }}} > > Fixing the lifted tuple case is trivial. Fixing the lifted list case > is slightly less trivial, but not hard. New description: There are three problems. 1. Showing typereps of tuples can produce unnecessary parentheses: {{{ Prelude K T> typeRep @(Int, Maybe Bool) (Int,(Maybe Bool)) }}} The fix is trivial. 2. Showing typereps of ticked (i.e., lifted) tuples and lists gives hard- to-read results, because it does not use the usual special syntax: {{{ Prelude K T> typeRep @'(Int, Maybe Bool) '(,) * * Int (Maybe Bool) Prelude K T> typeRep @'[1,2,3] ': Nat 1 (': Nat 2 (': Nat 3 ('[] Nat))) }}} Fixing the lifted tuple case is trivial. Fixing the lifted list case is slightly less trivial, but not hard. 3. Type operator applications are not shown infix. {{{ Prelude K T> typeRep @(Maybe :*: Either Int) :*: * Maybe (Either Int) }}} This is the hardest problem to fix, although it's probably not too terribly hard. See comment:1 for thoughts. -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 11 20:00:18 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 11 Oct 2017 20:00:18 -0000 Subject: [GHC] #9832: Get rid of PERL dependency of `ghc-split` In-Reply-To: <042.a80d180822707ef08b1350d4a542cee3@haskell.org> References: <042.a80d180822707ef08b1350d4a542cee3@haskell.org> Message-ID: <057.be41b307bf730394d722bfa30ca931b9@haskell.org> #9832: Get rid of PERL dependency of `ghc-split` ---------------------------------+---------------------------------------- Reporter: hvr | Owner: dobenour Type: task | Status: patch Priority: normal | Milestone: 8.6.1 Component: Driver | Version: Resolution: | Keywords: perl Operating System: Windows | Architecture: Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #8405 | Differential Rev(s): Phab:D2768 Wiki Page: | ---------------------------------+---------------------------------------- Changes (by bgamari): * milestone: 8.4.1 => 8.6.1 Comment: As mentioned by Tamar in Phab:D2768, this won't happen for 8.4. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 11 20:19:18 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 11 Oct 2017 20:19:18 -0000 Subject: [GHC] #14342: ghci fails to start with RebindableSyntax and OverloadedStrings Message-ID: <051.d10c8c6e8127d1aec95b8f77a4602f20@haskell.org> #14342: ghci fails to start with RebindableSyntax and OverloadedStrings ----------------------------------------+------------------------------- Reporter: NeilMitchell | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: GHCi | Version: 8.2.1 Keywords: | Operating System: Windows Architecture: Unknown/Multiple | Type of failure: GHCi crash Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: ----------------------------------------+------------------------------- {{{ C:\Neil>ghci -XRebindableSyntax -XOverloadedStrings GHCi, version 8.2.1: http://www.haskell.org/ghc/ :? for help :1:39: error: Not in scope: `fromString' }}} GHCi exits immediately with the above error if using both rebindable syntax and overloaded strings. This behaviour prevents starting projects which use both extensions. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 11 20:19:32 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 11 Oct 2017 20:19:32 -0000 Subject: [GHC] #14342: ghci fails to start with RebindableSyntax and OverloadedStrings In-Reply-To: <051.d10c8c6e8127d1aec95b8f77a4602f20@haskell.org> References: <051.d10c8c6e8127d1aec95b8f77a4602f20@haskell.org> Message-ID: <066.6d9ddbacf2d8622ee4f0d659a85c50fb@haskell.org> #14342: ghci fails to start with RebindableSyntax and OverloadedStrings ---------------------------------+---------------------------------------- Reporter: NeilMitchell | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: GHCi | Version: 8.2.1 Resolution: | Keywords: Operating System: Windows | Architecture: Unknown/Multiple Type of failure: GHCi crash | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | ---------------------------------+---------------------------------------- Changes (by NeilMitchell): * cc: ndmitchell@… (added) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 11 20:26:15 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 11 Oct 2017 20:26:15 -0000 Subject: [GHC] #14343: bad pretty-printing of types with promoted data types Message-ID: <048.9dafa4d8103f25346932aca07d111b88@haskell.org> #14343: bad pretty-printing of types with promoted data types -------------------------------------+------------------------------------- Reporter: lspitzner | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- {{{ > :set -XDataKinds > :set -XPolyKinds > data Proxy k = Proxy > _ :: Proxy '[ 'True ] error: Found hole: _ :: Proxy '['True] > _ :: Proxy '['True] error: Invalid type signature: _ :: ... Should be of form :: }}} Alternatively, this could be attributed to the parser/lexer doing an insufficient job there. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 11 22:07:58 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 11 Oct 2017 22:07:58 -0000 Subject: [GHC] #14344: `ghc: panic!` when loading module Message-ID: <043.04f06ebd98c20754305ad1323f8e7ae3@haskell.org> #14344: `ghc: panic!` when loading module -------------------------------------+------------------------------------- Reporter: javi | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Keywords: | Operating System: MacOS X Architecture: | Type of failure: Compile-time Unknown/Multiple | crash or panic Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- I'm learning Haskell from an online book (haskellbook.com) and when I loaded an answers module, this happened: {{{#!hs Prelude> :l ex.hs [1 of 1] Compiling Ex ( ex.hs, interpreted ) ghc: panic! (the 'impossible' happened) (GHC version 8.2.1 for x86_64-apple-darwin): repSplitAppTys a_a1qJ[sk:1] Bool [] 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/types/Type.hs:808:9 in ghc:Type Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug > }}} notice that the Prelude module got unloaded. The source code for my `ex.hs` module: {{{#!hs module Ex where import Data.Char myAny :: (a -> Bool) [a] -> Bool myAny pred [] = False myAny pred (x:xs) = pred x || myAny pred xs }}} You'll notice that I missed a `->` in `myAny`'s type signature. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 11 23:20:16 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 11 Oct 2017 23:20:16 -0000 Subject: [GHC] #14344: `ghc: panic!` when loading module In-Reply-To: <043.04f06ebd98c20754305ad1323f8e7ae3@haskell.org> References: <043.04f06ebd98c20754305ad1323f8e7ae3@haskell.org> Message-ID: <058.942da22cee3000b5282e19fa8aa5a901@haskell.org> #14344: `ghc: panic!` when loading module -------------------------------------+------------------------------------- Reporter: javi | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: duplicate | Keywords: Operating System: MacOS X | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: #13819 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * status: new => closed * resolution: => duplicate * related: => #13819 Comment: Thanks for the bug report. This is a duplicate of #13819, and has been fixed in the upcoming GHC 8.2.2 release: {{{ $ /opt/ghc/8.2.2/bin/ghci Bug.hs GHCi, version 8.2.1.20170928: http://www.haskell.org/ghc/ :? for help Loaded GHCi configuration from /home/rgscott/.ghci [1 of 1] Compiling Ex ( Bug.hs, interpreted ) Bug.hs:5:10: error: • Expecting one fewer arguments to ‘a -> Bool’ Expected kind ‘* -> *’, but ‘a -> Bool’ has kind ‘*’ • In the type signature: myAny :: (a -> Bool) [a] -> Bool | 5 | myAny :: (a -> Bool) [a] -> Bool | ^^^^^^^^^^^^^^^ }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 12 00:28:51 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 12 Oct 2017 00:28:51 -0000 Subject: [GHC] #14342: ghci fails to start with RebindableSyntax and OverloadedStrings In-Reply-To: <051.d10c8c6e8127d1aec95b8f77a4602f20@haskell.org> References: <051.d10c8c6e8127d1aec95b8f77a4602f20@haskell.org> Message-ID: <066.ae1fad543253ee07d22f0681cadc6018@haskell.org> #14342: ghci fails to start with RebindableSyntax and OverloadedStrings ---------------------------------+---------------------------------------- Reporter: NeilMitchell | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: Component: GHCi | Version: 8.2.1 Resolution: | Keywords: RebindableSyntax Operating System: Windows | Architecture: Unknown/Multiple Type of failure: GHCi crash | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4086 Wiki Page: | ---------------------------------+---------------------------------------- Changes (by RyanGlScott): * status: new => patch * keywords: => RebindableSyntax * differential: => Phab:D4086 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 12 04:35:35 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 12 Oct 2017 04:35:35 -0000 Subject: [GHC] #12152: panic: Loading temp shared object failed In-Reply-To: <047.fffa3b3df32ae27b408efe8d3e6f6a61@haskell.org> References: <047.fffa3b3df32ae27b408efe8d3e6f6a61@haskell.org> Message-ID: <062.a9ff100eb4c7f5177f53bd8d4f9e2793@haskell.org> #12152: panic: Loading temp shared object failed -------------------------------------+------------------------------------- Reporter: crockeea | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.8.1 (Linking) | Resolution: | Keywords: Operating System: Linux | Architecture: | Unknown/Multiple Type of failure: GHCi crash | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by crockeea): This appears to be fixed in 8.2. @basvandijk, can you confirm for your case? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 12 05:39:18 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 12 Oct 2017 05:39:18 -0000 Subject: [GHC] #14345: Warning when linking with C++ code Message-ID: <047.f1b4db3acbc221c558e5c522a0ac645a@haskell.org> #14345: Warning when linking with C++ code -------------------------------------+------------------------------------- Reporter: crockeea | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 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: -------------------------------------+------------------------------------- When linking with a C++ file, GHC 8.2.1.20170928 produces a warning because it runs gcc with 'std=gnu99', even when I pass 'std=c++11' to cc- options (when using stack, I see that the command is something like 'gcc std=gnu99 ... std=c++11', so it isn't *ignoring* my input, just appending it.) I believe this warning is new as of 8.2. The attached example demonstrates the problem: {{{ > cabal configure > cabal build cc1plus: warning: command line option ‘-std=gnu99’ is valid for C/ObjC but not for C++ cc1plus: warning: command line option ‘-std=gnu99’ is valid for C/ObjC but not for C++ }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 12 05:39:57 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 12 Oct 2017 05:39:57 -0000 Subject: [GHC] #14345: Warning when linking with C++ code In-Reply-To: <047.f1b4db3acbc221c558e5c522a0ac645a@haskell.org> References: <047.f1b4db3acbc221c558e5c522a0ac645a@haskell.org> Message-ID: <062.811cf875e7f3f4c6f2947f67d310ea93@haskell.org> #14345: Warning when linking with C++ code -------------------------------------+------------------------------------- Reporter: crockeea | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 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: | -------------------------------------+------------------------------------- Changes (by crockeea): * Attachment "bug.tar.gz" added. Minimal example -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 12 05:40:54 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 12 Oct 2017 05:40:54 -0000 Subject: [GHC] #14345: Warning when linking with C++ code In-Reply-To: <047.f1b4db3acbc221c558e5c522a0ac645a@haskell.org> References: <047.f1b4db3acbc221c558e5c522a0ac645a@haskell.org> Message-ID: <062.212a940d493968abf02131812df05014@haskell.org> #14345: Warning when linking with C++ code -------------------------------------+------------------------------------- Reporter: crockeea | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 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: | -------------------------------------+------------------------------------- Description changed by crockeea: Old description: > When linking with a C++ file, GHC 8.2.1.20170928 produces a warning > because it runs gcc with 'std=gnu99', even when I pass 'std=c++11' to cc- > options (when using stack, I see that the command is something like 'gcc > std=gnu99 ... std=c++11', so it isn't *ignoring* my input, just appending > it.) I believe this warning is new as of 8.2. > > The attached example demonstrates the problem: > > {{{ > > cabal configure > > cabal build > cc1plus: warning: command line option ‘-std=gnu99’ is valid for C/ObjC > but not for C++ > cc1plus: warning: command line option ‘-std=gnu99’ is valid for C/ObjC > but not for C++ > }}} New description: When linking with a C++ file, GHC 8.2.1.20170928 produces a warning because it runs gcc with 'std=gnu99', even when I pass 'std=c++11' to cc- options (when using stack with `-v3`, I see that the command is something like `gcc std=gnu99 ... std=c++11`, so it isn't *ignoring* my input, just appending it.) I believe this warning is new as of 8.2. The attached example demonstrates the problem: {{{ > cabal configure > cabal build cc1plus: warning: command line option ‘-std=gnu99’ is valid for C/ObjC but not for C++ cc1plus: warning: command line option ‘-std=gnu99’ is valid for C/ObjC but not for C++ }}} -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 12 07:38:52 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 12 Oct 2017 07:38:52 -0000 Subject: [GHC] #14343: bad pretty-printing of types with promoted data types In-Reply-To: <048.9dafa4d8103f25346932aca07d111b88@haskell.org> References: <048.9dafa4d8103f25346932aca07d111b88@haskell.org> Message-ID: <063.076f8e27b0759fb37e731562af9fd876@haskell.org> #14343: bad pretty-printing of types with promoted data types -------------------------------------+------------------------------------- Reporter: lspitzner | 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): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Are you sure you put that in right? With GHC 8.2.1 I get {{{ Prelude> _ :: Proxy '[ 'True ] :3:1: error: • Found hole: _ :: Proxy '['True] • In the expression: _ :: Proxy '[ 'True] In an equation for ‘it’: it = _ :: Proxy '[ 'True] • Relevant bindings include it :: Proxy '['True] (bound at :3:1) }}} But if I miss out the space it parses `'['` as a character literal. {{{ Prelude> _ :: Proxy '['True ] :4:1: error: Invalid type signature: _ :: ... Should be of form :: }}} Hard to avoid that. Make sense? I'm inclined to say 'wont-fix'. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 12 07:41:41 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 12 Oct 2017 07:41:41 -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.de03bd8ed502afaf9a89f9feff1e17ae@haskell.org> #14338: Simplifier fails with "Simplifier ticks exhausted" -------------------------------------+------------------------------------- Reporter: dredozubov | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 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): Thanks. I now get this {{{ simonpj at cam-05-unx:~/tmp/webapp-template-hs$ cabal install --allow-newer --with-ghc=/home/simonpj/5builds/HEAD/inplace/bin/ghc-stage2 Resolving dependencies... Configuring basement-0.0.2... Configuring colour-2.3.3... Configuring blaze-builder-0.4.0.2... Configuring primitive-0.6.2.0... Configuring psqueues-0.2.4.0... Configuring system-filepath-0.4.13.4... Configuring unordered-containers-0.2.8.0... Building basement-0.0.2... Building colour-2.3.3... Building blaze-builder-0.4.0.2... Building psqueues-0.2.4.0... Building primitive-0.6.2.0... Building unordered-containers-0.2.8.0... Failed to install blaze-builder-0.4.0.2 Build log ( /home/simonpj/.cabal/logs/blaze-builder-0.4.0.2.log ): cabal: Entering directory '/tmp/cabal-tmp-35090/blaze-builder-0.4.0.2' Configuring blaze-builder-0.4.0.2... Building blaze-builder-0.4.0.2... Preprocessing library blaze-builder-0.4.0.2... [ 1 of 10] Compiling Blaze.ByteString.Builder.Internal.Write ( Blaze/ByteString/Builder/Internal/Write.hs, dist/build/Blaze/ByteString/Builder/Internal/Write.o ) Blaze/ByteString/Builder/Internal/Write.hs:122:10: error: • No instance for (Semigroup Poke) arising from the superclasses of an instance declaration • In the instance declaration for ‘Monoid Poke’ | 122 | instance Monoid Poke where | ^^^^^^^^^^^ Blaze/ByteString/Builder/Internal/Write.hs:132:10: error: • No instance for (Semigroup Write) arising from the superclasses of an instance declaration • In the instance declaration for ‘Monoid Write’ | 132 | instance Monoid Write where | ^^^^^^^^^^^^ ... and lots more like that... }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 12 07:53:30 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 12 Oct 2017 07:53:30 -0000 Subject: [GHC] #14332: Deriving clauses can have forall types In-Reply-To: <050.6c2c9b47d51bbd6274ba7997829a8360@haskell.org> References: <050.6c2c9b47d51bbd6274ba7997829a8360@haskell.org> Message-ID: <065.7f1ad90520789887c20f7a1d7059ea0c@haskell.org> #14332: Deriving clauses can have forall types -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.2.1 checker) | Resolution: | Keywords: deriving 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): OK, so to review: * We need to write up [https://ghc.haskell.org/trac/ghc/ticket/14331#comment:8 the rationalisation] in the user manual. * If we are going to make it a proper feature (which it already is), we should not require silly parens. E.g. this example from the Description {{{ data D a = D deriving ((forall a. C a)) }}} works just as we intend, but should not require the second pair of parens -- a parser bug. * The second example from the Description is also OK {{{ data Proxy (a :: k) = Proxy deriving ((forall k2. (Generic1 :: (k2 -> Type) -> Constraint))) }}} As I put it in the rationalisation, `k` comes from the data type decl, and `k2` from the instance; but it's fine to instantiate `k` to `k2` in that instance decl. And that is just what happens. Worth an example in the user manual perhaps, after the one about `Functor Proxy`. Ryan, might you be able to do this? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 12 08:27:46 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 12 Oct 2017 08:27:46 -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.054cf469e1cd314923be8045b94e973d@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: Component: Compiler (Type | Version: 8.2.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: | -------------------------------------+------------------------------------- Comment (by Simon Peyton Jones ): In [changeset:"82b77ec375ab74678ac2afecf55dc574fa24490f/ghc" 82b77ec/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="82b77ec375ab74678ac2afecf55dc574fa24490f" Do not quantify over deriving clauses Trac #14331 showed that in a data type decl like data D = D deriving (C (a :: k)) we were quantifying D over the 'k' in the deriving clause. Yikes. Easily fixed, by deleting code in RnTypes.extractDataDefnKindVars See the discussion on the ticket, esp comment:8. }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 12 08:43:17 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 12 Oct 2017 08:43: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.f88519a30365bd33feb1c7b6aa7849ab@haskell.org> #14331: Overzealous free-floating kind check causes deriving clause to be rejected -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: merge Priority: normal | Milestone: 8.2.2 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: | -------------------------------------+------------------------------------- Changes (by simonpj): * status: new => merge * testcase: => deriving/should_compile/T14331 * milestone: => 8.2.2 Comment: OK I fixed the bug for this ticket. Remaining work is on #14332. Merge if/when convenient. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 12 08:54:51 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 12 Oct 2017 08:54:51 -0000 Subject: [GHC] #14344: `ghc: panic!` when loading module In-Reply-To: <043.04f06ebd98c20754305ad1323f8e7ae3@haskell.org> References: <043.04f06ebd98c20754305ad1323f8e7ae3@haskell.org> Message-ID: <058.5cc0571894cc61f4ee333dba0d9930d1@haskell.org> #14344: `ghc: panic!` when loading module -------------------------------------+------------------------------------- Reporter: javi | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: duplicate | Keywords: Operating System: MacOS X | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: #13819 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by javi): Cool, thanks! sorry for the dup... -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 12 09:26:57 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 12 Oct 2017 09:26:57 -0000 Subject: [GHC] #14346: 8.2.1 regression: heap corruption after safe foreign calls Message-ID: <049.7a4af7d8399ac93444ea4b9211bf91ff@haskell.org> #14346: 8.2.1 regression: heap corruption after safe foreign calls -------------------------------------+------------------------------------- Reporter: andrewchen | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: Component: Runtime | Version: 8.2.1 System | 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: -------------------------------------+------------------------------------- Test case: (compile with ghc 8.2.1 and -threaded option) {{{#!haskell module Main where import Control.Concurrent import Control.Monad import Data.Word import Foreign.Marshal.Alloc import Foreign.Ptr import Foreign.Storable foreign import ccall safe "test" c_test :: Ptr Word32 -> IO () main :: IO () main = do replicateM_ 1000 $ threadDelay 1000 _ <- forkIO $ forever $ threadDelay 100 allocaBytes 4 $ \p -> forever $ do c_test p x <- peek p unless (x == 0xDEADBEEF) $ putStrLn "value mismatch" }}} {{{#!c void test(unsigned int *buf) { *buf = 0xDEADBEEF; } }}} On my machine, it detects a few value mismatches before crashing with sigsegv. {{{ $ time ./.stack-work/install/x86_64-linux- nopie/nightly-2017-10-10/8.2.1/bin/bug value mismatch value mismatch value mismatch value mismatch zsh: segmentation fault (core dumped) ./.stack-work/install/x86_64-linux- nopie/nightly-2017-10-10/8.2.1/bin/bug ./.stack-work/install/x86_64-linux-nopie/nightly-2017-10-10/8.2.1/bin/bug 2.11s user 0.25s system 66% cpu 3.543 total }}} I believe this is what is causing crashes in xmobar. See discussion: https://github.com/jaor/xmobar/issues/310. Note that the crash in xmobar still happens without -threaded option, while this example only breaks when compiled with -threaded. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 12 09:29:32 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 12 Oct 2017 09:29:32 -0000 Subject: [GHC] #14346: 8.2.1 regression: heap corruption after safe foreign calls In-Reply-To: <049.7a4af7d8399ac93444ea4b9211bf91ff@haskell.org> References: <049.7a4af7d8399ac93444ea4b9211bf91ff@haskell.org> Message-ID: <064.3f053acb2a68e3bbb1ac58a0c3300a47@haskell.org> #14346: 8.2.1 regression: heap corruption after safe foreign calls -------------------------------------+------------------------------------- Reporter: andrewchen | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: Component: Runtime System | Version: 8.2.1 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 andrewchen): * Attachment "ghc_output" added. compiler output with -v -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 12 10:16:45 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 12 Oct 2017 10:16:45 -0000 Subject: [GHC] #14119: Refactor type patterns In-Reply-To: <047.bf8d1a6935e161be73f38f5b1322f10b@haskell.org> References: <047.bf8d1a6935e161be73f38f5b1322f10b@haskell.org> Message-ID: <062.c42f09e8995ea641629649bfd5bdc3dc@haskell.org> #14119: Refactor type patterns -------------------------------------+------------------------------------- Reporter: goldfire | Owner: goldfire Type: task | Status: new Priority: normal | Milestone: 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: 12564, 13910, | 13938, 14038 Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): While investigating #14270 I found that `SpecConstr` was generating rules with massive coercions, like {{{ RULE "SC:foo" f @(a |> ) arg1 arg2 = ... }}} Then I mis-read `Note [Matching in the presence of casts]` in `Unify`, and thought that we simply discarded casts. So I had a go at replacing casts in type patterns with a kind of placeholder `UnivCo`. I now think this is probably all wrong, because I still don't understanding of type patterns involving kind casts. But rather than delete my changes entirely I'll attach them here for future reference. The starting point was a new form of `UnivCoProvenance` to use in type patterns; and a `TypePat` type in `Unify. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 12 10:17:22 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 12 Oct 2017 10:17:22 -0000 Subject: [GHC] #14119: Refactor type patterns In-Reply-To: <047.bf8d1a6935e161be73f38f5b1322f10b@haskell.org> References: <047.bf8d1a6935e161be73f38f5b1322f10b@haskell.org> Message-ID: <062.b3df37283c803d1897b959f9dfa4a0ab@haskell.org> #14119: Refactor type patterns -------------------------------------+------------------------------------- Reporter: goldfire | Owner: goldfire Type: task | Status: new Priority: normal | Milestone: 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: 12564, 13910, | 13938, 14038 Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * Attachment "type-pats" added. Half-baked patch for type patterns -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 12 11:53:45 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 12 Oct 2017 11:53:45 -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.13f95738a5d1e0a781628e32e6ff001d@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: 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: | -------------------------------------+------------------------------------- Comment (by Simon Peyton Jones ): In [changeset:"3de788c4eaa0592165bf1fb9e9a6d5b8e2c27554/ghc" 3de788c/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="3de788c4eaa0592165bf1fb9e9a6d5b8e2c27554" Re-apply "Typeable: Allow App to match arrow types" This re-applies commit cc6be3a2f23c9b2e04f9f491099149e1e1d4d20b Author: Ben Gamari Date: Tue Sep 19 18:57:38 2017 -0400 Typeable: Allow App to match arrow types which was reverted because of Trac #14270. Now the latter is fixed we can re-apply it. The original ticket was Trac #14236 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 12 11:53:45 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 12 Oct 2017 11:53:45 -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.5fdd26346633614729465772470a1ebf@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: 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: | -------------------------------------+------------------------------------- Comment (by Simon Peyton Jones ): In [changeset:"fb050a330ad202c1eb43038dc18cca2a5be26f4a/ghc" fb050a3/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="fb050a330ad202c1eb43038dc18cca2a5be26f4a" Do not bind coercion variables in SpecConstr rules Trac #14270 showed that SpecConstr could cause nasty Lint failures if it generates a RULE that binds coercion varables. See * Note [SpecConstr and casts], and * the test simplCore/should_compile/T14270. This doesn't feel like the final word to me, because somehow the specialisation "ought" to work. So I left in a debug WARN to yell if the new check acutally fires. Meanwhile, it stops the erroneous specialisation. binding coercion }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 12 11:53:45 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 12 Oct 2017 11:53:45 -0000 Subject: [GHC] #14236: Typeable App pattern doesn't match function types In-Reply-To: <046.ae944f6e95c597c7005a5662aad01714@haskell.org> References: <046.ae944f6e95c597c7005a5662aad01714@haskell.org> Message-ID: <061.9b68723fe99f7bc0d9df8a7ba8220735@haskell.org> #14236: Typeable App pattern doesn't match function types -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: new Priority: low | 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: #14270 | Differential Rev(s): Phab:D3969 Wiki Page: | -------------------------------------+------------------------------------- Comment (by Simon Peyton Jones ): In [changeset:"3de788c4eaa0592165bf1fb9e9a6d5b8e2c27554/ghc" 3de788c/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="3de788c4eaa0592165bf1fb9e9a6d5b8e2c27554" Re-apply "Typeable: Allow App to match arrow types" This re-applies commit cc6be3a2f23c9b2e04f9f491099149e1e1d4d20b Author: Ben Gamari Date: Tue Sep 19 18:57:38 2017 -0400 Typeable: Allow App to match arrow types which was reverted because of Trac #14270. Now the latter is fixed we can re-apply it. The original ticket was Trac #14236 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 12 11:55:54 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 12 Oct 2017 11:55:54 -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.5ab4fd495d611c6c11420f14a968f91e@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: 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: | -------------------------------------+------------------------------------- Comment (by simonpj): OK so we are good on this, apart from the "doesn't feel like the final word to me" part of the patch in comment:20. I'd like Richard's thoughts. I don't know if it's worth merging to 8.2. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 12 11:56:17 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 12 Oct 2017 11:56:17 -0000 Subject: [GHC] #14236: Typeable App pattern doesn't match function types In-Reply-To: <046.ae944f6e95c597c7005a5662aad01714@haskell.org> References: <046.ae944f6e95c597c7005a5662aad01714@haskell.org> Message-ID: <061.6e9b8b8524092aa9ab21ccf10d6275ad@haskell.org> #14236: Typeable App pattern doesn't match function types -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: closed Priority: low | 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: #14270 | Differential Rev(s): Phab:D3969 Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * status: new => closed * resolution: => fixed -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 12 12:22:21 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 12 Oct 2017 12:22:21 -0000 Subject: [GHC] #14346: 8.2.1 regression: heap corruption after safe foreign calls In-Reply-To: <049.7a4af7d8399ac93444ea4b9211bf91ff@haskell.org> References: <049.7a4af7d8399ac93444ea4b9211bf91ff@haskell.org> Message-ID: <064.a9b3b7d30cf4ae7b553ef03c5970c9b2@haskell.org> #14346: 8.2.1 regression: heap corruption after safe foreign calls -------------------------------------+------------------------------------- Reporter: andrewchen | Owner: (none) Type: bug | Status: infoneeded Priority: highest | Milestone: Component: Runtime System | Version: 8.2.1 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): * status: new => infoneeded Comment: For whatever reason, I'm not able to reproduce this on either my Ubuntu 14.04 or 17.04 machines with GHC 8.2.1. I'm doing this: {{{ $ ghc -fforce-recomp -threaded bug.c Bug.hs [1 of 1] Compiling Main ( Bug.hs, Bug.o ) Linking Bug ... $ ./Bug }}} It then proceeds to run forever (AFAICT) without hitting any `value mistmatch`es or segfaults. Some questions: 1. What operating system are you using? 2. How can I reproduce this issue //with just GHC//? Please, no instructions involving fancy build tools like `stack`, since if this really is a GHC bug, one should be able to trigger the issue with just GHC. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 12 12:30:54 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 12 Oct 2017 12:30:54 -0000 Subject: [GHC] #14236: Typeable App pattern doesn't match function types In-Reply-To: <046.ae944f6e95c597c7005a5662aad01714@haskell.org> References: <046.ae944f6e95c597c7005a5662aad01714@haskell.org> Message-ID: <061.de89a4589a518987c9f1a0178f15c7b0@haskell.org> #14236: Typeable App pattern doesn't match function types -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: closed Priority: low | 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: #14270 | Differential Rev(s): Phab:D3969 Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): Thanks for re-applying, Simon! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 12 12:34:11 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 12 Oct 2017 12:34:11 -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.bb3a3898ecc08412a414bf7ce02ef831@haskell.org> #14331: Overzealous free-floating kind check causes deriving clause to be rejected -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: merge Priority: normal | Milestone: 8.2.2 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 still don't think this is quite right. Look at what happens now when you try to compile this variation of the original program: {{{#!hs {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE PolyKinds #-} module Bug where class C a b data D a = D deriving (C (a :: k)) }}} {{{ GHCi, version 8.3.20171011: 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:27: error: • Expected kind ‘k1’, but ‘a’ has kind ‘k’ • In the first argument of ‘C’, namely ‘(a :: k)’ In the data declaration for ‘D’ | 8 | data D a = D deriving (C (a :: k)) | ^ }}} This is wrong—the `a` in `D a` and `C a` should have the same kind, since they're the same `a`. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 12 12:37:34 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 12 Oct 2017 12:37:34 -0000 Subject: [GHC] #14346: 8.2.1 regression: heap corruption after safe foreign calls In-Reply-To: <049.7a4af7d8399ac93444ea4b9211bf91ff@haskell.org> References: <049.7a4af7d8399ac93444ea4b9211bf91ff@haskell.org> Message-ID: <064.b0e898c61dc376758cfefee7534856a7@haskell.org> #14346: 8.2.1 regression: heap corruption after safe foreign calls -------------------------------------+------------------------------------- Reporter: andrewchen | Owner: (none) Type: bug | Status: infoneeded Priority: highest | Milestone: Component: Runtime System | Version: 8.2.1 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 for your report andrewchan; Unfortunately, as with RyanGlScott, I am unable to reproduce this with `+RTS -N4`, `+RTS -N1`, or under any of GHC's optimization levels on Debian 9 running on amd64. Having a standalone testcase, free of build tools, would be quite helpful. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 12 12:44:41 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 12 Oct 2017 12:44:41 -0000 Subject: [GHC] #14343: bad pretty-printing of types with promoted data types In-Reply-To: <048.9dafa4d8103f25346932aca07d111b88@haskell.org> References: <048.9dafa4d8103f25346932aca07d111b88@haskell.org> Message-ID: <063.ac1126d370b5c8dfa0ac25885f6f9516@haskell.org> #14343: bad pretty-printing of types with promoted data types -------------------------------------+------------------------------------- Reporter: lspitzner | 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): Wiki Page: | -------------------------------------+------------------------------------- Comment (by lspitzner): I am fine with '[' being lexed as it is, so i don't mind a wont-fix for that aspect. But why does the error message for syntactically valid input contain source fragments that are not syntactically valid? Just as a test for how input is transformed (on 8.2.1 as well): {{{ Prelude> _ :: Proxy '[ 'True ] -- 2 spaces in input :8:1: error: • Found hole: _ :: Proxy '['True] -- 0 spaces • In the expression: _ :: Proxy '[ 'True] -- 1 spaces In an equation for ‘it’: it = _ :: Proxy '[ 'True] -- 1 spaces • Relevant bindings include it :: Proxy '['True] (bound at :8:1) -- 0 spaces }}} The zeros are problematic, and i think the ones only avoid the problem because they don't really re-layout, they just merge whitespace (at least that's what i suspect; haven't looked at the source). -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 12 12:48:49 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 12 Oct 2017 12:48:49 -0000 Subject: [GHC] #14332: Deriving clauses can have forall types In-Reply-To: <050.6c2c9b47d51bbd6274ba7997829a8360@haskell.org> References: <050.6c2c9b47d51bbd6274ba7997829a8360@haskell.org> Message-ID: <065.fa3a4f8dd888e442778c2a97e6399605@haskell.org> #14332: Deriving clauses can have forall types -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.2.1 checker) | Resolution: | Keywords: deriving 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): Replying to [comment:14 simonpj]: > Ryan, might you be able to do this? Er, I doubt it. This sounds like it goes well beyond my abilities as a GHC hacker, since it requires intricate knowledge of: * Somehow informing GHC of which type variables are "OK to unify" for instance, the `k` in `data Proxy (a :: k)` is OK to unify, but the `k` in `deriving (C (a :: k))` is not—what is the secret sauce in GHC to specify this? I have no idea. Actually, it's even more subtle than that. There are scenarios when you'd want to unify kind variables in `deriving` types: when they're //invisible//. For instance: {{{#!hs newtype Identity a = Identity a deriving Generic1 }}} Here, `Generic1 :: (k -> *) -> Constraint`. But note that we never write `k` explicitly, so it's more like `deriving (Generic1 {k})`. However, we ultimately unify `k` with `*` in the end, giving us `deriving (Generic1 {*})`. Somehow, we //also// have to inform GHC that this is OK. Urp... * WTF this "skolem" business from comment:9 is about. (I don't know if I could even give a proper definition of this word, let alone profitably implement it.) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 12 13:14:52 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 12 Oct 2017 13:14:52 -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.19ba1ffe644f30fd6d5d0f32735f51b3@haskell.org> #14338: Simplifier fails with "Simplifier ticks exhausted" -------------------------------------+------------------------------------- Reporter: dredozubov | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 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 4e6): Ok, I [https://github.com/4e6/webapp-template-hs/tree/simpl-tick-factor pushed] the update that removes almost all external dependencies. With this update, I was able to build the project with latest ghc-8.3-start-1211-g82b77ec375 (version by git-describe) Interestingly enough, ghc-8.3 doesn't show the presence of the bug. It means that the regression was fixed after the ghc-8.2.1 release. I also updated the [https://gist.github.com/4e6/5ef65efdb309daa373a928ec36404fd7 gist] with ''-ddump-simpl-stats'' output for all three ghc versions. Total ticks number for ghc-8.3 is similar to ghc-7.10.3 value. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 12 14:02:31 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 12 Oct 2017 14:02:31 -0000 Subject: [GHC] #13564: Why does memory usage increase so much during CoreTidy? In-Reply-To: <047.e92939a4cd1c030b3af9ef0cac10654f@haskell.org> References: <047.e92939a4cd1c030b3af9ef0cac10654f@haskell.org> Message-ID: <062.e80bd243f5ee1a5de8902591ee4a59e5@haskell.org> #13564: Why does memory usage increase so much during CoreTidy? -------------------------------------+------------------------------------- Reporter: rwbarton | Owner: (none) Type: task | Status: new Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.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): Phab:D3516, Wiki Page: | Phab:D3524 -------------------------------------+------------------------------------- Changes (by bgamari): * milestone: 8.2.2 => 8.4.1 Comment: Bumping this off to 8.4.1. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 12 14:03:45 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 12 Oct 2017 14:03:45 -0000 Subject: [GHC] #14078: -ddump-json doesn't work well with GHCi In-Reply-To: <050.a3c1661fff8336ca3c521994e1a88d18@haskell.org> References: <050.a3c1661fff8336ca3c521994e1a88d18@haskell.org> Message-ID: <065.602956272af82d2a46f9248384920358@haskell.org> #14078: -ddump-json doesn't work well with GHCi -------------------------------------+------------------------------------- Reporter: dramforever | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.4.1 Component: GHCi | Version: 8.2.1 Resolution: | Keywords: JSON 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.2.2 => 8.4.1 Comment: It seems there is some design work still needed here. Perhaps `-ddump- json` shouldn't be in the `-d` category if it behaves so differently from other dump flags? Bumping to 8.4. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 12 14:07:10 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 12 Oct 2017 14:07:10 -0000 Subject: [GHC] #14078: -ddump-json doesn't work well with GHCi In-Reply-To: <050.a3c1661fff8336ca3c521994e1a88d18@haskell.org> References: <050.a3c1661fff8336ca3c521994e1a88d18@haskell.org> Message-ID: <065.903b53d150c622b4932fb38e634811e0@haskell.org> #14078: -ddump-json doesn't work well with GHCi -------------------------------------+------------------------------------- Reporter: dramforever | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.4.1 Component: GHCi | Version: 8.2.1 Resolution: | Keywords: JSON 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 definitely want to fix this before 8.4. I think that make it work on a per module basis is the way to go. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 12 15:37:43 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 12 Oct 2017 15:37:43 -0000 Subject: [GHC] #14078: -ddump-json doesn't work well with GHCi In-Reply-To: <050.a3c1661fff8336ca3c521994e1a88d18@haskell.org> References: <050.a3c1661fff8336ca3c521994e1a88d18@haskell.org> Message-ID: <065.4a3d93a37a8aab8e8f25d371a27dcdcf@haskell.org> #14078: -ddump-json doesn't work well with GHCi -------------------------------------+------------------------------------- Reporter: dramforever | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.4.1 Component: GHCi | Version: 8.2.1 Resolution: | Keywords: JSON 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): Okay, but be aware that 8.2.2 is quickly approaching and it's unclear whether we will have an 8.2.3. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 12 16:43:08 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 12 Oct 2017 16:43:08 -0000 Subject: [GHC] #14347: Top-level RecordWildCards no longer working. Message-ID: <047.9d7d4bc51f0d30fd962b21bdfacfc205@haskell.org> #14347: Top-level RecordWildCards no longer working. -------------------------------------+------------------------------------- Reporter: Fuuzetsu | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- {{{#!hs $ ghc -fforce-recomp /tmp/Damn.hs /tmp/T.hs [1 of 2] Compiling Damn ( /tmp/Damn.hs, /tmp/Damn.o ) [2 of 2] Compiling T ( /tmp/T.hs, /tmp/T.o ) /tmp/T.hs:7:5: warning: [-Wmissing-fields] • Fields of ‘D.D’ not initialised: x, y • In the expression: D.D {..} In an equation for ‘d’: d = D.D {..} | 7 | d = D.D {..} | ^^^^^^^^ $ cat /tmp/Damn.hs /tmp/T.hs module Damn (D(..)) where data D = D { x :: Int, y :: () } {-# LANGUAGE RecordWildCards #-} module T where import qualified Damn as D d :: D.D d = D.D {..} x :: Int x = 7 y :: () y = () $ ghc --version The Glorious Glasgow Haskell Compilation System, version 8.2.1 }}} Meanwhile on 8.0 {{{#!hs $ ghc -Wall -fforce-recomp /tmp/Damn.hs /tmp/T.hs [1 of 2] Compiling Damn ( /tmp/Damn.hs, /tmp/Damn.o ) [2 of 2] Compiling T ( /tmp/T.hs, /tmp/T.o ) $ ghc --version The Glorious Glasgow Haskell Compilation System, version 8.0.2 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 12 16:43:28 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 12 Oct 2017 16:43:28 -0000 Subject: [GHC] #14347: Top-level RecordWildCards no longer working. In-Reply-To: <047.9d7d4bc51f0d30fd962b21bdfacfc205@haskell.org> References: <047.9d7d4bc51f0d30fd962b21bdfacfc205@haskell.org> Message-ID: <062.a1cf9abb2ecc951465565c4e2416542a@haskell.org> #14347: Top-level RecordWildCards no longer working. -------------------------------------+------------------------------------- Reporter: Fuuzetsu | 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): Wiki Page: | -------------------------------------+------------------------------------- Changes (by Fuuzetsu): * Attachment "T.hs" added. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 12 16:43:40 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 12 Oct 2017 16:43:40 -0000 Subject: [GHC] #14347: Top-level RecordWildCards no longer working. In-Reply-To: <047.9d7d4bc51f0d30fd962b21bdfacfc205@haskell.org> References: <047.9d7d4bc51f0d30fd962b21bdfacfc205@haskell.org> Message-ID: <062.558824a7786a573fa7e7f3c8eb55deac@haskell.org> #14347: Top-level RecordWildCards no longer working. -------------------------------------+------------------------------------- Reporter: Fuuzetsu | 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): Wiki Page: | -------------------------------------+------------------------------------- Changes (by Fuuzetsu): * Attachment "Damn.hs" added. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 12 16:53:35 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 12 Oct 2017 16:53:35 -0000 Subject: [GHC] #14347: Top-level RecordWildCards no longer working. In-Reply-To: <047.9d7d4bc51f0d30fd962b21bdfacfc205@haskell.org> References: <047.9d7d4bc51f0d30fd962b21bdfacfc205@haskell.org> Message-ID: <062.db691b8749d7aa658828eddbc07e9bbf@haskell.org> #14347: Top-level RecordWildCards no longer working. -------------------------------------+------------------------------------- Reporter: Fuuzetsu | 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): Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * cc: adamgundry (added) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 12 21:03:16 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 12 Oct 2017 21:03:16 -0000 Subject: [GHC] #14271: ghci hangs with -fexternal-interpreter -prof In-Reply-To: <047.35b6ee83038ae67884e53737c2b92695@haskell.org> References: <047.35b6ee83038ae67884e53737c2b92695@haskell.org> Message-ID: <062.d1b9669ad55fcd37f6ccaf734b2eb093@haskell.org> #14271: ghci hangs with -fexternal-interpreter -prof -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: GHCi | Version: 8.2.1 Resolution: | Keywords: Operating System: Windows | Architecture: | Unknown/Multiple Type of failure: GHCi crash | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * cc: Jaffacake (added) Comment: Is this true? We should probably throw a proper error if this is the case. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 12 21:08:40 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 12 Oct 2017 21:08:40 -0000 Subject: [GHC] #14346: 8.2.1 regression: heap corruption after safe foreign calls In-Reply-To: <049.7a4af7d8399ac93444ea4b9211bf91ff@haskell.org> References: <049.7a4af7d8399ac93444ea4b9211bf91ff@haskell.org> Message-ID: <064.c6f80c1498b78c73af05f6aa3fefe38d@haskell.org> #14346: 8.2.1 regression: heap corruption after safe foreign calls -------------------------------------+------------------------------------- Reporter: andrewchen | Owner: (none) Type: bug | Status: infoneeded Priority: highest | Milestone: Component: Runtime System | Version: 8.2.1 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 andrewchen): I am running arch linux x64 on a i5-4200U laptop. I'm able to reproduce with just the system ghc: {{{ ghc Main.hs test.c -threaded -O1 -fforce-recomp [1 of 1] Compiling Main ( Main.hs, Main.o ) Linking Main ... }}} For me the program fails within seconds: {{{ $ time ./Main value mismatch value mismatch value mismatch value mismatch zsh: segmentation fault (core dumped) ./Main ./Main 2.19s user 0.20s system 67% cpu 3.553 total }}} I'm also able to reproduce the issue in a fedora virtual machine on the same physical machine using ghc 8.2.1 binaries downloaded from haskell.org. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 12 21:14:36 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 12 Oct 2017 21:14:36 -0000 Subject: [GHC] #7169: Warning for incomplete record field label used as function In-Reply-To: <047.31629c8fe32b813e38c132e8d4305995@haskell.org> References: <047.31629c8fe32b813e38c132e8d4305995@haskell.org> Message-ID: <062.1e422ae137fd76cbfd1cf194424eb9c0@haskell.org> #7169: Warning for incomplete record field label used as function -------------------------------------+------------------------------------- Reporter: goldfire | Owner: nakaji_dayo Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.7 Resolution: | Keywords: Warnings, | newcomer 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): Phab:D4083 Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): > In case of implement this, it seems that design considering the whole is necessary. It's not clear; determining partiality is in general quite tricky whereas partial selectors is a class of partiality that we can easily identify. Consequently it may make sense to handle it separately. I also don't have a strong opinion on this, however. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 12 21:15:38 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 12 Oct 2017 21:15:38 -0000 Subject: [GHC] #14346: 8.2.1 regression: heap corruption after safe foreign calls In-Reply-To: <049.7a4af7d8399ac93444ea4b9211bf91ff@haskell.org> References: <049.7a4af7d8399ac93444ea4b9211bf91ff@haskell.org> Message-ID: <064.27908b55dcdab0a5b85f5b123f7651fa@haskell.org> #14346: 8.2.1 regression: heap corruption after safe foreign calls -------------------------------------+------------------------------------- Reporter: andrewchen | Owner: (none) Type: bug | Status: infoneeded Priority: highest | Milestone: Component: Runtime System | Version: 8.2.1 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 rezb1t): I can reproduce this same issue on my machine, I am using: NixOS x86_64 Unstable Branch (as of 10-12) GHC 8.2.1 Binutils 2.28.1 GCC 6.4.0 I noticed the bug does not occur and the program runs infinitely if I simply compile with 'ghc Main.hs test.c -threaded -o Bug', however, if Optimization level 1 or 2 are enabled, the bug happens very quickly after running the binary. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 12 21:30:17 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 12 Oct 2017 21:30:17 -0000 Subject: [GHC] #14346: 8.2.1 regression: heap corruption after safe foreign calls In-Reply-To: <049.7a4af7d8399ac93444ea4b9211bf91ff@haskell.org> References: <049.7a4af7d8399ac93444ea4b9211bf91ff@haskell.org> Message-ID: <064.f06f1f0aee27bb3eecf4fa72b6be13d9@haskell.org> #14346: 8.2.1 regression: heap corruption after safe foreign calls -------------------------------------+------------------------------------- Reporter: andrewchen | Owner: (none) Type: bug | Status: infoneeded Priority: highest | Milestone: Component: Runtime System | Version: 8.2.1 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 andrewchen): Also, I forgot to add, the bug does not occur when compiled with debug symbols (-g). -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 12 21:32:27 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 12 Oct 2017 21:32:27 -0000 Subject: [GHC] #14346: 8.2.1 regression: heap corruption after safe foreign calls In-Reply-To: <049.7a4af7d8399ac93444ea4b9211bf91ff@haskell.org> References: <049.7a4af7d8399ac93444ea4b9211bf91ff@haskell.org> Message-ID: <064.762fc836467c6df36096e1bc735187ba@haskell.org> #14346: 8.2.1 regression: heap corruption after safe foreign calls -------------------------------------+------------------------------------- Reporter: andrewchen | Owner: (none) Type: bug | Status: infoneeded Priority: highest | Milestone: Component: Runtime System | Version: 8.2.1 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): Interesting; I can also reproduce this in my Nix unstable VM. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 12 22:15:51 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 12 Oct 2017 22:15:51 -0000 Subject: [GHC] #13707: xmobar crashes with segmentation faults? In-Reply-To: <046.fbf7af7bdea4e00dc6b71cd4d89ec01e@haskell.org> References: <046.fbf7af7bdea4e00dc6b71cd4d89ec01e@haskell.org> Message-ID: <061.6fd97f469a288c4b5f076a8f5b3216d2@haskell.org> #13707: xmobar crashes with segmentation faults? -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.2.1 Component: Compiler | Version: 8.2.1-rc2 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 andrewchen): You can reliably reproduce the crash by sending the xmobar window a lot of events, e.g. using xdotool to send a lot of mouse button presses, or as some members on github has pointed out, dragging other windows over the xmobar window, thus sending Expose events. You also need to have at least 1 monitor in your xmobarrc (e.g. have `Run Swap [] 10` in commands). The stack traces I got weren't very helpful, but most of them segfaulted on values read from the memory area used for return data from XNextEvent. Also see discussion here: https://ghc.haskell.org/trac/ghc/ticket/14346 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 13 02:14:00 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 13 Oct 2017 02:14:00 -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.695efac75b3cb548b5b5a0d782eec439@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: 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: | -------------------------------------+------------------------------------- Comment (by goldfire): I think comment:9:ticket:14119 is the answer to this problem. Let's structurally remove the possibility of matching on types with structured coercions, and then this just won't be possible. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 13 02:46:53 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 13 Oct 2017 02:46:53 -0000 Subject: [GHC] #14346: 8.2.1 regression: heap corruption after safe foreign calls In-Reply-To: <049.7a4af7d8399ac93444ea4b9211bf91ff@haskell.org> References: <049.7a4af7d8399ac93444ea4b9211bf91ff@haskell.org> Message-ID: <064.119dac9626c1424a37660a51236d2196@haskell.org> #14346: 8.2.1 regression: heap corruption after safe foreign calls -------------------------------------+------------------------------------- Reporter: andrewchen | Owner: (none) Type: bug | Status: infoneeded Priority: highest | Milestone: Component: Runtime System | Version: 8.2.1 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 RyanGlScott): Somewhat to my surprise, this regression was introduced in 8d5cf8bf584fd4849917c29d82dcf46ee75dd035 (`Join points`). -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 13 03:55:34 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 13 Oct 2017 03:55:34 -0000 Subject: [GHC] #14347: Top-level RecordWildCards no longer working. In-Reply-To: <047.9d7d4bc51f0d30fd962b21bdfacfc205@haskell.org> References: <047.9d7d4bc51f0d30fd962b21bdfacfc205@haskell.org> Message-ID: <062.edd7edd6d202b90c9a60e6d2dd83937c@haskell.org> #14347: Top-level RecordWildCards no longer working. -------------------------------------+------------------------------------- Reporter: Fuuzetsu | 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): Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * cc: adamgundry (removed) * cc: simonpj (added) Comment: Oh, it turns out this breakage was intentional! It was caused by commit 2f8cd14fe909a377b3e084a4f2ded83a0e6d44dd: {{{ From 2f8cd14fe909a377b3e084a4f2ded83a0e6d44dd Mon Sep 17 00:00:00 2001 From: Simon Peyton Jones Date: Thu, 23 Jun 2016 09:02:00 +0100 Subject: [PATCH] Narrow the use of record wildcards slightly In reviewing the fix to Trac #12130 I found the wild-card fill-in code for ".." notation in record constructions hard to understand. It went to great contortions (including the find_tycon code) to allow data T = C { x, y :: Int } f x = C { .. } to expand to f x = C { x = x, y = y } where 'y' is an /imported function/! That seems way over the top for what record wildcards are supposed to do. So I have narrowed the record-wildcard expansion to include only /locally-bound/ variables; i.e. not top level, and certainly not imported. I don't think anyone is using record wildcards in this bizarre way, so I don't expect any fallout. Even if there is, you can easily initialise fields with eponymous but imported values by hand. An intermediate position would be to allow /local/ top-level definitions. But I doubt anyone is doing that either. Let's see if there's any fallout. It's a local change, easy to revert, so I've just gone ahead to save everyone's time. }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 13 07:39:27 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 13 Oct 2017 07:39:27 -0000 Subject: [GHC] #13112: Windows 64-bit GHC HEAD segfaults on the code with a lot of TH stuff. In-Reply-To: <044.8846313dfa837f257582237983583132@haskell.org> References: <044.8846313dfa837f257582237983583132@haskell.org> Message-ID: <059.44e83d47ae9252a00ab557cc18da7e6e@haskell.org> #13112: Windows 64-bit GHC HEAD segfaults on the code with a lot of TH stuff. ---------------------------------+-------------------------------------- Reporter: awson | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.1 Resolution: | Keywords: Operating System: Windows | Architecture: x86_64 (amd64) Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | ---------------------------------+-------------------------------------- Comment (by jbetz): I can reproduce it on 64-bit Windows, with or without TH. The bindings to PostreSQL are completely broken because of it, presumably do to C code generated in postgresql-libpq. It's been identified in multiple database projects: * https://github.com/yesodweb/persistent/issues/697 * https://github.com/tomjaguarpaw/haskell-opaleye/issues/338 Probably not much help in narrowing it down, but this really needs to be looked into. Especially since WSL still isn't a viable alternative at this point. It's unbearably slow. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 13 10:30:36 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 13 Oct 2017 10:30:36 -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.59da8bb4b48da679de4d375d7916cf02@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: 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: | -------------------------------------+------------------------------------- Comment (by simonpj): > I think comment:9:ticket:14119 is the answer to this problem. Maybe so... but the specifics still elude me. It'd be good to actually do it! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 13 11:31:46 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 13 Oct 2017 11:31:46 -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.484be4af59947952aba31f6a6ea64270@haskell.org> #14331: Overzealous free-floating kind check causes deriving clause to be rejected -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: merge Priority: normal | Milestone: 8.2.2 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): I agree. After elaboration we expect {{{ class C {k1 k2} (p::k1) (q::k2) data D {k3} (r::k3) = D instance forall {k2} k (a:k) (b:k2). C a (D {k2} b) where ... }}} So we instantiate the `k3` belonging to the data declaration to `k2` belonging to the instance. The `forall k` in the `deriving` clause is just the kind on `a`, the first parameter for `C`. Right? Why this doesn't work I don't know. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 13 11:43:46 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 13 Oct 2017 11:43:46 -0000 Subject: [GHC] #14348: Poly-kinded definitions silently introduce extra type arguments captured by TypeApplications Message-ID: <046.2db678b92d7b4654f98b7730ca2d846c@haskell.org> #14348: Poly-kinded definitions silently introduce extra type arguments captured by TypeApplications -------------------------------------+------------------------------------- Reporter: gallais | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.0.1 (Type checker) | 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: -------------------------------------+------------------------------------- The first type argument of a poly-kinded definition is not the one explicitly quantified over in the definition but rather the implicitly inserted kind. This leads to the puzzling error message "Expected a type, but ‘a’ has kind ‘k’" when ghc actually expected a kind. {{{#!haskell {-# LANGUAGE GADTs, PolyKinds, ScopedTypeVariables, TypeApplications #-} data EQ :: k -> k -> * where Refl :: EQ a a data Wrap (a :: k) = Wrap (EQ a a) wrap :: forall (a :: k). Wrap a wrap = Wrap @a Refl -- fails -- wrap = Wrap @k @a Refl -- works }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 13 12:42:18 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 13 Oct 2017 12:42:18 -0000 Subject: [GHC] #13112: Windows 64-bit GHC HEAD segfaults on the code with a lot of TH stuff. In-Reply-To: <044.8846313dfa837f257582237983583132@haskell.org> References: <044.8846313dfa837f257582237983583132@haskell.org> Message-ID: <059.583d917cadc5eea2c41ae793b20f8e85@haskell.org> #13112: Windows 64-bit GHC HEAD segfaults on the code with a lot of TH stuff. ---------------------------------+-------------------------------------- Reporter: awson | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.1 Resolution: | Keywords: Operating System: Windows | Architecture: x86_64 (amd64) Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | ---------------------------------+-------------------------------------- Comment (by awson): Replying to [comment:14 jbetz]: > * https://github.com/tomjaguarpaw/haskell-opaleye/issues/338 Is it possible to make [https://github.com/tomjaguarpaw/haskell- opaleye/issues/338#issuecomment-335511777 your example] slightly more self-contained? Particularly I don't want to deal with postgresql-related packages. I have a lot of packages installed in my main package database, and I've even added `product-profunctors` package to it, but still get several {{{Not in scope: type constructor or class `CellRecord'}}} errors. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 13 12:42:56 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 13 Oct 2017 12:42:56 -0000 Subject: [GHC] #13112: Windows 64-bit GHC HEAD segfaults on the code with a lot of TH stuff. In-Reply-To: <044.8846313dfa837f257582237983583132@haskell.org> References: <044.8846313dfa837f257582237983583132@haskell.org> Message-ID: <059.63f71a716c16fe871e7060cf95fa1e09@haskell.org> #13112: Windows 64-bit GHC HEAD segfaults on the code with a lot of TH stuff. ---------------------------------+-------------------------------------- Reporter: awson | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.1 Resolution: | Keywords: Operating System: Windows | Architecture: x86_64 (amd64) Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | ---------------------------------+-------------------------------------- Comment (by RyanGlScott): I'm aware of the `persistent` issue, see https://ghc.haskell.org/trac/ghc/ticket/14089#comment:8. But alas, as I've documented at that link, I can no longer reliably reproduce the segfault on GHC 8.2.1! Coming up with a minimal example (with preferably no external dependencies) would go a long way in diagnosing this issue. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 13 13:05:49 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 13 Oct 2017 13:05:49 -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.5df41d2181e53d150048653f718be8d5@haskell.org> #14331: Overzealous free-floating kind check causes deriving clause to be rejected -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: merge Priority: normal | Milestone: 8.2.2 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): Huh? That is not what I would have expected at all. I would have expected: {{{#!hs class C {k1 k2} (a :: k1) (b :: k2) data D {k3} (r :: k3) = D instance forall k1 (a :: k1). C a (D a) where ... }}} In other words, you should unify `r` with `a`. After all, the `a` in `data D a = D deriving (C (a :: k))` scopes over the data type, not the `deriving` clause! Now if you had chosen to use a different scoping with `data D a = D deriving (forall (a :: k). C a)`, //then// I could see the instance being derived that you suggested. But I don't think users would expect that behavior to be the default (that is, in lieu of explicit `forall`s on a `deriving` clause, one should assume that the user-written type variables are bound by the data type if they appear in the `` in `data D `). -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 13 13:21:02 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 13 Oct 2017 13:21:02 -0000 Subject: [GHC] #14348: Poly-kinded definitions silently introduce extra type arguments captured by TypeApplications In-Reply-To: <046.2db678b92d7b4654f98b7730ca2d846c@haskell.org> References: <046.2db678b92d7b4654f98b7730ca2d846c@haskell.org> Message-ID: <061.51b91d8b76d0be425dec9c433142a910@haskell.org> #14348: Poly-kinded definitions silently introduce extra type arguments captured by TypeApplications -------------------------------------+------------------------------------- Reporter: gallais | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: Component: Compiler (Type | Version: 8.0.1 checker) | Keywords: Resolution: invalid | TypeApplications 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: new => closed * keywords: => TypeApplications * resolution: => invalid Comment: This is expected behavior. As noted in the [https://downloads.haskell.org/~ghc/8.2.1/docs/html/users_guide/glasgow_exts.html?highlight =#ghc-flag--XTypeApplications users' guide], GHC determines the order of arguments for type applications by doing a stable topological sort on the user-written type variables, keeping kind variables before type variables. Since `k` is user-written, this means it's available for type application, and since it's the kind of `a`, `k` comes before `a`. If you don't want `k` to be available for type application, then you can do so by not writing it explicitly: {{{#!hs {-# LANGUAGE GADTs, PolyKinds, ScopedTypeVariables, TypeApplications #-} data EQ :: k -> k -> * where Refl :: EQ a a data Wrap a = Wrap (EQ a a) wrap :: forall a. Wrap a wrap = Wrap @a Refl }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 13 13:49:37 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 13 Oct 2017 13:49:37 -0000 Subject: [GHC] #14348: Poly-kinded definitions silently introduce extra type arguments captured by TypeApplications In-Reply-To: <046.2db678b92d7b4654f98b7730ca2d846c@haskell.org> References: <046.2db678b92d7b4654f98b7730ca2d846c@haskell.org> Message-ID: <061.742f0e0ea9703817e228256e643089a7@haskell.org> #14348: Poly-kinded definitions silently introduce extra type arguments captured by TypeApplications -------------------------------------+------------------------------------- Reporter: gallais | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: Component: Compiler (Type | Version: 8.0.1 checker) | Keywords: Resolution: invalid | TypeApplications 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 gallais): If it's expected behaviour then I suppose what I'd really like is a distinction between "user-written" and "user-introduced". So that I may keep the kind annotations (which are helpful documentation when the kinds are complicated) whilst not having these extra arguments. E.g. {{{#!haskell data Wrap (k :: Kind) (a :: k) -- user introduced: can be explicitly set via @ data Wrap (a :: k) -- user written: cannot be explicitly set via @ wrap :: forall k (a :: k). Wrap a -- user introduced wrap :: forall (a :: k). Wrap a -- user written }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 13 13:51:09 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 13 Oct 2017 13:51:09 -0000 Subject: [GHC] #14349: Semigroup/Monoid instances for System.Exit.ExitCode Message-ID: <050.38ed5b1d7f57b93168c3a6f1a83443f4@haskell.org> #14349: Semigroup/Monoid instances for System.Exit.ExitCode -------------------------------------+------------------------------------- Reporter: neil.mayhew | Owner: (none) Type: feature | Status: new request | Priority: low | Milestone: Component: | Version: 8.2.1 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: -------------------------------------+------------------------------------- Please add instances for ExitCode along the following lines: {{{#!hs instance Monoid ExitCode where mempty = ExitSuccess mappend ExitSuccess b = b mappend a _ = a }}} This allows the summary result of multiple child processes to be computed naturally. For example: {{{#!hs mconcat <$> mapM system commands }}} The result is `ExitSuccess` if they all succeeded, and the leftmost failure otherwise -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 13 13:53:55 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 13 Oct 2017 13:53:55 -0000 Subject: [GHC] #14348: Poly-kinded definitions silently introduce extra type arguments captured by TypeApplications In-Reply-To: <046.2db678b92d7b4654f98b7730ca2d846c@haskell.org> References: <046.2db678b92d7b4654f98b7730ca2d846c@haskell.org> Message-ID: <061.004b96cfe5c5f8fc11f050a0178d266c@haskell.org> #14348: Poly-kinded definitions silently introduce extra type arguments captured by TypeApplications -------------------------------------+------------------------------------- Reporter: gallais | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: Component: Compiler (Type | Version: 8.0.1 checker) | Keywords: Resolution: invalid | TypeApplications 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 RyanGlScott): I believe what you are looking for is [https://github.com/goldfirere/ghc/pull/74 explicit specificity]. This is a GHC "proposal" that isn't fully baked yet, or even been formally proposed yet—I'm only showing this to you since you asked nicely ;) This would allow you to write: {{{#!hs data Wrap {k} (a :: k) }}} To tell GHC to treat `k` as though it were inferred (even though it's technically written in the source) and thus not available for visible type application. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 13 13:58:24 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 13 Oct 2017 13:58:24 -0000 Subject: [GHC] #14348: Poly-kinded definitions silently introduce extra type arguments captured by TypeApplications In-Reply-To: <046.2db678b92d7b4654f98b7730ca2d846c@haskell.org> References: <046.2db678b92d7b4654f98b7730ca2d846c@haskell.org> Message-ID: <061.d110d57fda03150d3cafa14c0f6b6957@haskell.org> #14348: Poly-kinded definitions silently introduce extra type arguments captured by TypeApplications -------------------------------------+------------------------------------- Reporter: gallais | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: Component: Compiler (Type | Version: 8.0.1 checker) | Keywords: Resolution: invalid | TypeApplications 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 gallais): This looks great! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 13 13:59:21 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 13 Oct 2017 13:59:21 -0000 Subject: [GHC] #14349: Semigroup/Monoid instances for System.Exit.ExitCode In-Reply-To: <050.38ed5b1d7f57b93168c3a6f1a83443f4@haskell.org> References: <050.38ed5b1d7f57b93168c3a6f1a83443f4@haskell.org> Message-ID: <065.cdefc278d05acbceb93628c25437c11a@haskell.org> #14349: Semigroup/Monoid instances for System.Exit.ExitCode -------------------------------------+------------------------------------- Reporter: neil.mayhew | Owner: (none) Type: feature request | Status: upstream Priority: low | Milestone: Component: libraries/base | 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): * cc: hvr, ekmett, core-libraries-committee@… (added) * status: new => upstream Comment: I think I would like to defer to the Core Libraries Committee on this. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 13 14:01:03 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 13 Oct 2017 14:01:03 -0000 Subject: [GHC] #14346: 8.2.1 regression: heap corruption after safe foreign calls In-Reply-To: <049.7a4af7d8399ac93444ea4b9211bf91ff@haskell.org> References: <049.7a4af7d8399ac93444ea4b9211bf91ff@haskell.org> Message-ID: <064.3048788458bb6d2439823ef39e21e1d2@haskell.org> #14346: 8.2.1 regression: heap corruption after safe foreign calls -------------------------------------+------------------------------------- Reporter: andrewchen | Owner: (none) Type: bug | Status: infoneeded Priority: highest | Milestone: Component: Runtime System | Version: 8.2.1 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): Well, comment:7 certainly explains why `-g` avoids the crash: in 8.2 source note ticks essentially prevented GHC from marking anything as a join point. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 13 14:02:38 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 13 Oct 2017 14:02:38 -0000 Subject: [GHC] #14349: Semigroup/Monoid instances for System.Exit.ExitCode In-Reply-To: <050.38ed5b1d7f57b93168c3a6f1a83443f4@haskell.org> References: <050.38ed5b1d7f57b93168c3a6f1a83443f4@haskell.org> Message-ID: <065.6999aae90d6d1bfc199ace69ac90d6a0@haskell.org> #14349: Semigroup/Monoid instances for System.Exit.ExitCode -------------------------------------+------------------------------------- Reporter: neil.mayhew | Owner: (none) Type: feature request | Status: upstream Priority: low | Milestone: Component: libraries/base | 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 neil.mayhew): * cc: hvr, ekmett, core-libraries-committee@… (removed) Old description: > Please add instances for ExitCode along the following lines: > > {{{#!hs > instance Monoid ExitCode where > mempty = ExitSuccess > mappend ExitSuccess b = b > mappend a _ = a > }}} > > This allows the summary result of multiple child processes to be computed > naturally. For example: > > {{{#!hs > mconcat <$> mapM system commands > }}} > > The result is `ExitSuccess` if they all succeeded, and the leftmost > failure otherwise New description: Please add instances for ExitCode along the following lines: {{{#!hs instance Monoid ExitCode where mempty = ExitSuccess mappend ExitSuccess b = b mappend a _ = a }}} This allows the summary result of multiple child processes to be computed naturally. For example: {{{#!hs mconcat <$> mapM system commands }}} The result is `ExitSuccess` if they all succeeded, and the leftmost failure otherwise. This is similar to the behaviour of `set -e` in `bash`. -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 13 14:10:14 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 13 Oct 2017 14:10:14 -0000 Subject: [GHC] #14349: Semigroup/Monoid instances for System.Exit.ExitCode In-Reply-To: <050.38ed5b1d7f57b93168c3a6f1a83443f4@haskell.org> References: <050.38ed5b1d7f57b93168c3a6f1a83443f4@haskell.org> Message-ID: <065.9e5199c557e1463bca4e6d50d219ccd6@haskell.org> #14349: Semigroup/Monoid instances for System.Exit.ExitCode -------------------------------------+------------------------------------- Reporter: neil.mayhew | Owner: (none) Type: feature request | Status: upstream Priority: low | Milestone: Component: libraries/base | 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 nomeata): I am not yet convinced. Is this the only sensible `Monoid` instance? Do we want to see code that says `returnWith mempty`? Why is leftmost the right thing? Note that it is verymuch noch like `set -e` because `set -e` *stops* after the first error. Maybe a named function `anySuccess :: [ExitCode] -> ExitCode` would be a better design. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 13 14:18:45 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 13 Oct 2017 14:18:45 -0000 Subject: [GHC] #14346: 8.2.1 regression: heap corruption after safe foreign calls In-Reply-To: <049.7a4af7d8399ac93444ea4b9211bf91ff@haskell.org> References: <049.7a4af7d8399ac93444ea4b9211bf91ff@haskell.org> Message-ID: <064.9b3119daf83672d402fb609ad2f4d350@haskell.org> #14346: 8.2.1 regression: heap corruption after safe foreign calls -------------------------------------+------------------------------------- Reporter: andrewchen | Owner: (none) Type: bug | Status: infoneeded Priority: highest | Milestone: Component: Runtime System | Version: 8.2.1 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): I could have sworn I left a comment last night but it seems I am mistaken. Here is what I discovered while looking into this so far: The test is indeed rather environment sensitive. Moreover, as it doesn't occur under `rr` I strongly suspect it's a race of some sort. When compiled with `-debug` the eventual segmentation fault always seems to occur in `stg_putMVarzh`. Specifically here, {{{ Dump of assembler code for function stg_putMVarzh: 0x00000000004ab1b0 <+0>: cmpl $0x1,0x4f4800 0x00000000004ab1b8 <+8>: je 0x4ab35e 0x00000000004ab1be <+14>: mov $0x479e18,%eax 0x00000000004ab1c3 <+19>: mov %rbx,%rcx 0x00000000004ab1c6 <+22>: sub $0x8,%rsp 0x00000000004ab1ca <+26>: mov %rcx,%rdi 0x00000000004ab1cd <+29>: mov %rax,%rcx 0x00000000004ab1d0 <+32>: xor %eax,%eax 0x00000000004ab1d2 <+34>: callq *%rcx 0x00000000004ab1d4 <+36>: add $0x8,%rsp 0x00000000004ab1d8 <+40>: cmpq $0x4f2c30,0x18(%rbx) 0x00000000004ab1e0 <+48>: jne 0x4ab366 0x00000000004ab1e6 <+54>: mov 0x8(%rbx),%rcx 0x00000000004ab1ea <+58>: cmp $0x4f2c30,%rcx 0x00000000004ab1f1 <+65>: je 0x4ab466 0x00000000004ab1f7 <+71>: cmpq $0x4ac2f0,(%rcx) 0x00000000004ab1fe <+78>: je 0x4ab45d 0x00000000004ab204 <+84>: cmpq $0x4aca20,(%rcx) 0x00000000004ab20b <+91>: je 0x4ab45d 0x00000000004ab211 <+97>: mov 0x10(%rcx),%rdx 0x00000000004ab215 <+101>: mov 0x8(%rcx),%rsi 0x00000000004ab219 <+105>: mov %rsi,0x8(%rbx) 0x00000000004ab21d <+109>: cmpq $0x4f2c30,0x8(%rbx) 0x00000000004ab225 <+117>: jne 0x4ab22f 0x00000000004ab227 <+119>: movq $0x4f2c30,0x10(%rbx) => 0x00000000004ab22f <+127>: cmp 0x28(%rdx),%rbx 0x00000000004ab233 <+131>: je 0x4ab276 ... }}} I believe this corresponds to this bit of C--, {{{#!c ... tso = StgMVarTSOQueue_tso(q); StgMVar_head(mvar) = StgMVarTSOQueue_link(q); if (StgMVar_head(mvar) == stg_END_TSO_QUEUE_closure) { // cmpq $0x4f2c30,0x8(%rbx) StgMVar_tail(mvar) = stg_END_TSO_QUEUE_closure; // movq $0x4f2c30,0x10(%rbx) } ASSERT(StgTSO_block_info(tso) == mvar); // cmp 0x28(%rdx),%rbx ... }}} Indeed we find that, {{{ >>> print/a $rbx $1 = 0x42000b8400 >>> print/a $rdx $2 = 0x42deadbeef }}} Yikes! This sounds to me like we reentered STG while forgetting to do some bit of cleanup from the foreign call. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 13 14:30:10 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 13 Oct 2017 14:30:10 -0000 Subject: [GHC] #14349: Semigroup/Monoid instances for System.Exit.ExitCode In-Reply-To: <050.38ed5b1d7f57b93168c3a6f1a83443f4@haskell.org> References: <050.38ed5b1d7f57b93168c3a6f1a83443f4@haskell.org> Message-ID: <065.65c70515667eb6f082d6408639af619c@haskell.org> #14349: Semigroup/Monoid instances for System.Exit.ExitCode -------------------------------------+------------------------------------- Reporter: neil.mayhew | Owner: (none) Type: feature request | Status: upstream Priority: low | Milestone: Component: libraries/base | 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 neil.mayhew): * cc: hvr, ekmett, core-libraries-committee (added) Comment: As far as I can see, the only other reasonable `Monoid` instance would be to have success if any succeeded, but this is almost never what you want. It would be possible to use a similar approach to the `Any`/`All` newtypes for `Bool`, but this seems like overthinking it. It would be possible to favour the rightmost failure, but I don't see much point in this. That's why I mentioned `set -e`, which returns the exit code of the first, ie leftmost, failure. The fact that bash short-circuits the rest of the evaluation is mostly an issue of lazy evaluation. The semantics of the summary exit code are the same, although of course the side effects are different. Adding a named function would be a valid approach, but it's a pity to add a single-use function when we already have a nice general way to view the problem with `Monoid`. If `mempty` is an issue then it could be a `Semigroup` instance. However, it seems natural to me that running no child processes is considered successful. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 13 15:19:20 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 13 Oct 2017 15:19:20 -0000 Subject: [GHC] #14349: Semigroup/Monoid instances for System.Exit.ExitCode In-Reply-To: <050.38ed5b1d7f57b93168c3a6f1a83443f4@haskell.org> References: <050.38ed5b1d7f57b93168c3a6f1a83443f4@haskell.org> Message-ID: <065.fce23cfe410e9ee365c8cbc9a76d5061@haskell.org> #14349: Semigroup/Monoid instances for System.Exit.ExitCode -------------------------------------+------------------------------------- Reporter: neil.mayhew | Owner: (none) Type: feature request | Status: upstream Priority: low | Milestone: Component: libraries/base | 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 glguy): Having a Monoid instance doesn't seem like a good idea to me. The code above could be written more clearly using an explicitly named, locally defined operation: `combineExitCodes <$> mapM system commands`. Reusing `mconcat` isn't a win here. Having such a forced Monoid instance simply means that users will have to consult the documentation to find the instance declaration to determine what behavior it has. There isn't a natural meaning for `instance Monoid ExitCode` -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 13 15:28:42 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 13 Oct 2017 15:28: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.7c13189a0e676dd2f5a10af15feb5b91@haskell.org> #14331: Overzealous free-floating kind check causes deriving clause to be rejected -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: merge Priority: normal | Milestone: 8.2.2 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): For what it's worth, I agree with Ryan in what GHC should do here. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 13 16:07:11 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 13 Oct 2017 16:07:11 -0000 Subject: [GHC] #14350: Infinite loop when typechecking incorrect implementation (GHC HEAD only) Message-ID: <050.13c8453cb18174ae45ace93d1d6319c0@haskell.org> #14350: Infinite loop when typechecking incorrect implementation (GHC HEAD only) -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: high | Milestone: 8.4.1 Component: Compiler | Version: 8.3 (Type checker) | Keywords: TypeInType | Operating System: Unknown/Multiple Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- On GHC HEAD, typechecking this program loops infinitely: {{{#!hs {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeInType #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} module Bug where import Data.Kind data Proxy a = Proxy data family Sing (a :: k) data SomeSing k where SomeSing :: Sing (a :: k) -> SomeSing k class SingKind k where type Demote k :: Type fromSing :: Sing (a :: k) -> Demote k toSing :: Demote k -> SomeSing k data instance Sing (x :: Proxy k) where SProxy :: Sing 'Proxy instance SingKind (Proxy k) where type Demote (Proxy k) = Proxy k fromSing SProxy = Proxy toSing Proxy = SomeSing SProxy data TyFun :: Type -> Type -> Type type a ~> b = TyFun a b -> Type infixr 0 ~> type family Apply (f :: k1 ~> k2) (x :: k1) :: k2 type a @@ b = Apply a b infixl 9 @@ newtype instance Sing (f :: k1 ~> k2) = SLambda { applySing :: forall t. Sing t -> Sing (f @@ t) } instance (SingKind k1, SingKind k2) => SingKind (k1 ~> k2) where type Demote (k1 ~> k2) = Demote k1 -> Demote k2 fromSing sFun x = case toSing x of SomeSing y -> fromSing (applySing sFun y) toSing = undefined dcomp :: forall (a :: Type) (b :: a ~> Type) (c :: forall (x :: a). Proxy x ~> b @@ x ~> Type) (f :: forall (x :: a) (y :: b @@ x). Proxy x ~> Proxy y ~> c @@ ('Proxy :: Proxy x) @@ y) (g :: forall (x :: a). Proxy x ~> b @@ x) (x :: a). Sing f -> Sing g -> Sing x -> c @@ ('Proxy :: Proxy x) @@ (g @@ ('Proxy :: Proxy x)) dcomp f g x = applySing f Proxy Proxy }}} This is a regression from GHC 8.2.1/8.2.2, where it gives a proper error message: {{{ $ /opt/ghc/8.2.1/bin/ghci Bug.hs GHCi, version 8.2.1: http://www.haskell.org/ghc/ :? for help Loaded GHCi configuration from /home/rgscott/.ghci [1 of 1] Compiling Bug ( Bug.hs, interpreted ) Bug.hs:60:15: error: • Couldn't match expected type ‘Proxy a2 -> Apply (Apply (c x4) 'Proxy) (Apply (g x4) 'Proxy)’ with actual type ‘Sing (f x y @@ t0)’ • The function ‘applySing’ is applied to three arguments, but its type ‘Sing (f x y) -> Sing t0 -> Sing (f x y @@ t0)’ has only two In the expression: applySing f Proxy Proxy In an equation for ‘dcomp’: dcomp f g x = applySing f Proxy Proxy • Relevant bindings include x :: Sing x4 (bound at Bug.hs:60:11) g :: Sing (g x3) (bound at Bug.hs:60:9) f :: Sing (f x2 y) (bound at Bug.hs:60:7) dcomp :: Sing (f x2 y) -> Sing (g x3) -> Sing x4 -> (c x4 @@ 'Proxy) @@ (g x4 @@ 'Proxy) (bound at Bug.hs:60:1) | 60 | dcomp f g x = applySing f Proxy Proxy | ^^^^^^^^^^^^^^^^^^^^^^^ Bug.hs:60:27: error: • Couldn't match expected type ‘Sing t0’ with actual type ‘Proxy a0’ • In the second argument of ‘applySing’, namely ‘Proxy’ In the expression: applySing f Proxy Proxy In an equation for ‘dcomp’: dcomp f g x = applySing f Proxy Proxy • Relevant bindings include x :: Sing x4 (bound at Bug.hs:60:11) g :: Sing (g x3) (bound at Bug.hs:60:9) f :: Sing (f x2 y) (bound at Bug.hs:60:7) dcomp :: Sing (f x2 y) -> Sing (g x3) -> Sing x4 -> (c x4 @@ 'Proxy) @@ (g x4 @@ 'Proxy) (bound at Bug.hs:60:1) | 60 | dcomp f g x = applySing f Proxy Proxy | ^^^^^ }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 13 16:18:20 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 13 Oct 2017 16:18:20 -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.05a4a795bc25f39038fc15895f97c3ac@haskell.org> #14331: Overzealous free-floating kind check causes deriving clause to be rejected -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: merge Priority: normal | Milestone: 8.2.2 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): Ah yes, you're right. I was focusing on the `k`, but there's the `a` as well. But then I'd say that the error message is dead right. Let's put the implicit binders in: {{{ data D {k1} (a::k1) = D deriving (forall k. C (a :: k)) }}} Look at that! `a` has kind `k1`; but in the `deriving` clause we claim that the occurrence of `a` ahs type `k`. Boom. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 13 16:27:12 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 13 Oct 2017 16:27:12 -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.2fe10e1971b9b89c9d5d9a5c012c67f6@haskell.org> #14331: Overzealous free-floating kind check causes deriving clause to be rejected -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: merge Priority: normal | Milestone: 8.2.2 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 don't understand your reasoning in comment:16. After all, we don't reject this: {{{#!hs {-# LANGUAGE TypeInType #-} import Data.Proxy data Foo a = Foo (Proxy (a :: k)) }}} After all, `k` is implicitly bound by the datatype `D`, so everything works out. The same situation applies in: {{{#!hs data D a = D deriving (C (a :: k)) }}} Once again, `k` is implicitly bound by `D`, so `k` and the kind of `a` are one and the same. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 13 16:32:01 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 13 Oct 2017 16:32:01 -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.2e6ba32715a26fd4509b9772e276b4ad@haskell.org> #14331: Overzealous free-floating kind check causes deriving clause to be rejected -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: merge Priority: normal | Milestone: 8.2.2 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'm not convinced by comment:17, as I consider `deriving` clauses to be more separate from the definition. My reasoning is that we do unification for deriving. Thus, the kind `k2` of `a` will be unified with the newly- quantified kind `k`, leading to an accepted definition. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 13 16:32:24 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 13 Oct 2017 16:32:24 -0000 Subject: [GHC] #14349: Semigroup/Monoid instances for System.Exit.ExitCode In-Reply-To: <050.38ed5b1d7f57b93168c3a6f1a83443f4@haskell.org> References: <050.38ed5b1d7f57b93168c3a6f1a83443f4@haskell.org> Message-ID: <065.a7b3d49dd420f6d23c03f844b940b78f@haskell.org> #14349: Semigroup/Monoid instances for System.Exit.ExitCode -------------------------------------+------------------------------------- Reporter: neil.mayhew | Owner: (none) Type: feature request | Status: upstream Priority: low | Milestone: Component: libraries/base | 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 neil.mayhew): I don't see this as 'forced'. The meaning I'm suggesting is the conventional interpretation of OS exit statuses, ie a set of processes is considered failed if any one of them fails. The only reason to look up the documentation would be if someone needs to know how the `Int` in `ExitFailure Int` is produced, and typically people don't care about the value, just success or failure. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 13 16:51:52 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 13 Oct 2017 16:51:52 -0000 Subject: [GHC] #14349: Semigroup/Monoid instances for System.Exit.ExitCode In-Reply-To: <050.38ed5b1d7f57b93168c3a6f1a83443f4@haskell.org> References: <050.38ed5b1d7f57b93168c3a6f1a83443f4@haskell.org> Message-ID: <065.c88a6a56a44148b68de2e1bcd8e76a60@haskell.org> #14349: Semigroup/Monoid instances for System.Exit.ExitCode -------------------------------------+------------------------------------- Reporter: neil.mayhew | Owner: (none) Type: feature request | Status: upstream Priority: low | Milestone: Component: libraries/base | 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 neil.mayhew): Maybe it would help to mention my use case, which is running a set of regression tests implemented as shell commands. (They pipe the output of an executable into a `diff` against the expected output. The exit status of the shell command is that of the `diff`.) The program that runs the regression tests is then used as a Cabal test suite (of type `exitcode- stdio`). (A simplified version of) the code looks like this: {{{#!hs {-# OPTIONS_GHC -fno-warn-orphans #-} import Data.Monoid (Monoid(..)) import System.Process (system) import System.Exit (ExitCode(..), exitWith) instance Monoid ExitCode where mempty = ExitSuccess mappend ExitSuccess b = b mappend a _ = a data MyTest = MyTest String tests :: [MyTest] tests = map MyTest [ "echo Test1" , "echo Test2" , "exit 3" , "echo Test4" , "exit 5" ] main :: IO () main = mapM runTest tests >>= exitWith . mconcat runTest :: MyTest -> IO ExitCode runTest (MyTest cmd) = system cmd }}} To avoid the `Monoid` instance I could have the `runTest` function return a `Bool` instead, and use `and` to collect all the statuses: {{{#!hs main :: IO () main = mapM runTest tests >>= bool exitFailure exitSuccess . and runTest :: MyTest -> IO Bool runTest (MyTest cmd) = (==ExitSuccess) <$> system cmd }}} However, the `Monoid` approach is more elegant because it avoids the repeated and redundant use of machinery from `System.Exit`. In both cases, the exit code of the test suite is `3`. It also happens that the `diff` output appears in the output of the test suite, and all the tests are run, rather than stopping at the first failure. So the output of the simplified test suite above is: {{{ Test1 Test2 Test4 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 13 16:56:09 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 13 Oct 2017 16:56:09 -0000 Subject: [GHC] #14349: Semigroup/Monoid instances for System.Exit.ExitCode In-Reply-To: <050.38ed5b1d7f57b93168c3a6f1a83443f4@haskell.org> References: <050.38ed5b1d7f57b93168c3a6f1a83443f4@haskell.org> Message-ID: <065.974732471538606e1d477575b0dd1805@haskell.org> #14349: Semigroup/Monoid instances for System.Exit.ExitCode -------------------------------------+------------------------------------- Reporter: neil.mayhew | Owner: (none) Type: feature request | Status: upstream Priority: low | Milestone: Component: libraries/base | 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 neil.mayhew): Actually, in the second version, the exit code is `1`. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 13 17:07:27 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 13 Oct 2017 17:07:27 -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.a4819fd76bf1e7a2359467fdffbca034@haskell.org> #14331: Overzealous free-floating kind check causes deriving clause to be rejected -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: merge Priority: normal | Milestone: 8.2.2 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): It will lead to an accepting definition, yes, but I don't think it's the definition you'd want (or at least, it seems to differ from the proposal I put forth in comment:14). If I understand your argument correctly, you want all type variables in a `deriving` clause's type to be scoped differently from the data type, and expect unification to save you in the end? That is, this: {{{#!hs data D a = D deriving (C (a :: k)) }}} Would be treated like this? {{{#!hs data D {k1} (a1 :: k1) = D deriving (forall {j} k (a :: k). C @k @j a) }}} If so, we have a problem—the //only// kinds we'd unify are the `j` in `C a :: j -> Constraint` and `Type` (the kind of `D a`), so the instance we'd get in the end is: {{{#!hs instance forall {k1} k {a1 :: k1} (a :: k). C @k @Type a (D @k1 a1) where ... }}} Which is not what I'd expect, since `a` and `a1` are distinct. The only way to ensure that they're the same is to interpret the scope like this: {{{#!hs data D {k} (a :: k) = D deriving (forall {j}. C @k @j a) }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 13 18:26:02 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 13 Oct 2017 18:26:02 -0000 Subject: [GHC] #11295: Figure out what LLVM passes are fruitful In-Reply-To: <046.97e900ad29a1522a4b7374676cc6de7a@haskell.org> References: <046.97e900ad29a1522a4b7374676cc6de7a@haskell.org> Message-ID: <061.5c2eee69da550bb6f1214e853bf953b2@haskell.org> #11295: Figure out what LLVM passes are fruitful -------------------------------------+------------------------------------- Reporter: bgamari | Owner: kavon Type: task | Status: new Priority: normal | Milestone: Component: Compiler (LLVM) | 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 kavon): * owner: (none) => kavon Comment: I'll try to get a conservative tuning into 8.4.1 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 13 18:50:06 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 13 Oct 2017 18:50:06 -0000 Subject: [GHC] #13112: Windows 64-bit GHC HEAD segfaults on the code with a lot of TH stuff. In-Reply-To: <044.8846313dfa837f257582237983583132@haskell.org> References: <044.8846313dfa837f257582237983583132@haskell.org> Message-ID: <059.869829c5791383137ce681a792c7ee83@haskell.org> #13112: Windows 64-bit GHC HEAD segfaults on the code with a lot of TH stuff. ---------------------------------+-------------------------------------- Reporter: awson | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.1 Resolution: | Keywords: Operating System: Windows | Architecture: x86_64 (amd64) Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | ---------------------------------+-------------------------------------- Comment (by jbetz): Replying to [comment:15 awson]: > Is it possible to make [https://github.com/tomjaguarpaw/haskell- opaleye/issues/338#issuecomment-335511777 your example] slightly more self-contained? I've updated the original issue to remove some dependencies, and I'll try to get it all into one Main module this weekend. If that doesn't help, I guess we'll have to dig deeper into the postgres libraries. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 13 21:13:04 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 13 Oct 2017 21:13:04 -0000 Subject: [GHC] #11295: Figure out what LLVM passes are fruitful In-Reply-To: <046.97e900ad29a1522a4b7374676cc6de7a@haskell.org> References: <046.97e900ad29a1522a4b7374676cc6de7a@haskell.org> Message-ID: <061.61ca70aaa8f8171b96c5e79a0b73e250@haskell.org> #11295: Figure out what LLVM passes are fruitful -------------------------------------+------------------------------------- Reporter: bgamari | Owner: kavon Type: task | Status: new Priority: normal | Milestone: Component: Compiler (LLVM) | 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 kavon): Actually I'm now using OpenTune, repo with the bootstrap code forthcoming. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 13 21:15:50 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 13 Oct 2017 21:15:50 -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.222119be824b7949b88aa714deeb4bbf@haskell.org> #14331: Overzealous free-floating kind check causes deriving clause to be rejected -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: merge Priority: normal | Milestone: 8.2.2 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 think you don't understand correctly. (Perhaps because I've communicated poorly.) The user writes {{{#!hs class C a b data D c = D deriving (C (c :: k)) }}} There is implicit lexical quantification in the `deriving` clause. ("Lexical" because it's all just based on reading the code -- no type- checking yet!) So, these declarations are understood to mean {{{#!hs class C a b data D c = D deriving (forall k. C (c :: k)) }}} We don't have to write `forall` for the class or data declarations, because the type variables there are understood to mean quantification. Note that I'm ''not'' quantifying over `c` in the `deriving` clause, because it's already in scope. The initial declarations are processed without regard to the `deriving` clause, producing {{{#!hs class C {k1} {k2} (a :: k1) (b :: k2) data D {k3} (c :: k3) = D }}} Now, we type-check {{{#!hs instance forall {c k}. C (c :: k) (D c) }}} where the `C (c :: k)` is taken from the `deriving` clause, and the quantified variables are not yet ordered. After type-checking, we get {{{#!hs instance forall (k :: Type) (c :: k). C {k} {Type} c (D {k} c) }}} as desired. Note that the use of `c` in the `deriving` clause did not lead to unification. Instead, the fact that we know more about its kind does. However, in writing this up, I discovered a new problem. When I write {{{#!hs class C2 a data D b = D deriving C2 }}} do I mean {{{#!hs instance C2 {k -> Type} D }}} or {{{#!hs instance C2 {Type} (D b) }}} ? Both are well-kinded and sensible. Right now, we always choose the latter, but I'm not sure why. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 13 22:47:31 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 13 Oct 2017 22:47:31 -0000 Subject: [GHC] #14351: reverse-errors doesn't affect instance errors Message-ID: <042.a1183b3f8b4f24e7561cc5b1a47d29f9@haskell.org> #14351: reverse-errors doesn't affect instance errors -------------------------------------+------------------------------------- Reporter: br1 | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- In the following sample code, the errors are in the same order with and without -freverse-errors: {{{ data Foo = Foo data Bar = Bar instance Show (Foo Int) instance Read (Bar Int) }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 13 23:41:44 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 13 Oct 2017 23:41:44 -0000 Subject: [GHC] #14350: Infinite loop when typechecking incorrect implementation (GHC HEAD only) In-Reply-To: <050.13c8453cb18174ae45ace93d1d6319c0@haskell.org> References: <050.13c8453cb18174ae45ace93d1d6319c0@haskell.org> Message-ID: <065.a2cb9d7ba225c6ec37560028b7d6498e@haskell.org> #14350: Infinite loop when typechecking incorrect implementation (GHC HEAD only) -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: high | Milestone: 8.4.1 Component: Compiler (Type | Version: 8.3 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: | -------------------------------------+------------------------------------- Description changed by RyanGlScott: Old description: > On GHC HEAD, typechecking this program loops infinitely: > > {{{#!hs > {-# LANGUAGE AllowAmbiguousTypes #-} > {-# LANGUAGE FlexibleInstances #-} > {-# LANGUAGE GADTs #-} > {-# LANGUAGE RankNTypes #-} > {-# LANGUAGE ScopedTypeVariables #-} > {-# LANGUAGE TypeApplications #-} > {-# LANGUAGE TypeFamilies #-} > {-# LANGUAGE TypeInType #-} > {-# LANGUAGE TypeOperators #-} > {-# LANGUAGE UndecidableInstances #-} > module Bug where > > import Data.Kind > > data Proxy a = Proxy > data family Sing (a :: k) > > data SomeSing k where > SomeSing :: Sing (a :: k) -> SomeSing k > > class SingKind k where > type Demote k :: Type > fromSing :: Sing (a :: k) -> Demote k > toSing :: Demote k -> SomeSing k > > data instance Sing (x :: Proxy k) where > SProxy :: Sing 'Proxy > > instance SingKind (Proxy k) where > type Demote (Proxy k) = Proxy k > fromSing SProxy = Proxy > toSing Proxy = SomeSing SProxy > > data TyFun :: Type -> Type -> Type > type a ~> b = TyFun a b -> Type > infixr 0 ~> > > type family Apply (f :: k1 ~> k2) (x :: k1) :: k2 > type a @@ b = Apply a b > infixl 9 @@ > > newtype instance Sing (f :: k1 ~> k2) = > SLambda { applySing :: forall t. Sing t -> Sing (f @@ t) } > > instance (SingKind k1, SingKind k2) => SingKind (k1 ~> k2) where > type Demote (k1 ~> k2) = Demote k1 -> Demote k2 > fromSing sFun x = case toSing x of SomeSing y -> fromSing (applySing > sFun y) > toSing = undefined > > dcomp :: forall (a :: Type) > (b :: a ~> Type) > (c :: forall (x :: a). Proxy x ~> b @@ x ~> Type) > (f :: forall (x :: a) (y :: b @@ x). Proxy x ~> Proxy y > ~> c @@ ('Proxy :: Proxy x) @@ y) > (g :: forall (x :: a). Proxy x ~> b @@ x) > (x :: a). > Sing f > -> Sing g > -> Sing x > -> c @@ ('Proxy :: Proxy x) @@ (g @@ ('Proxy :: Proxy x)) > dcomp f g x = applySing f Proxy Proxy > }}} > > This is a regression from GHC 8.2.1/8.2.2, where it gives a proper error > message: > > {{{ > $ /opt/ghc/8.2.1/bin/ghci Bug.hs > GHCi, version 8.2.1: http://www.haskell.org/ghc/ :? for help > Loaded GHCi configuration from /home/rgscott/.ghci > [1 of 1] Compiling Bug ( Bug.hs, interpreted ) > > Bug.hs:60:15: error: > • Couldn't match expected type ‘Proxy a2 > -> Apply (Apply (c x4) 'Proxy) (Apply > (g x4) 'Proxy)’ > with actual type ‘Sing (f x y @@ t0)’ > • The function ‘applySing’ is applied to three arguments, > but its type ‘Sing (f x y) -> Sing t0 -> Sing (f x y @@ t0)’ > has only two > In the expression: applySing f Proxy Proxy > In an equation for ‘dcomp’: dcomp f g x = applySing f Proxy Proxy > • Relevant bindings include > x :: Sing x4 (bound at Bug.hs:60:11) > g :: Sing (g x3) (bound at Bug.hs:60:9) > f :: Sing (f x2 y) (bound at Bug.hs:60:7) > dcomp :: Sing (f x2 y) > -> Sing (g x3) -> Sing x4 -> (c x4 @@ 'Proxy) @@ (g x4 > @@ 'Proxy) > (bound at Bug.hs:60:1) > | > 60 | dcomp f g x = applySing f Proxy Proxy > | ^^^^^^^^^^^^^^^^^^^^^^^ > > Bug.hs:60:27: error: > • Couldn't match expected type ‘Sing t0’ > with actual type ‘Proxy a0’ > • In the second argument of ‘applySing’, namely ‘Proxy’ > In the expression: applySing f Proxy Proxy > In an equation for ‘dcomp’: dcomp f g x = applySing f Proxy Proxy > • Relevant bindings include > x :: Sing x4 (bound at Bug.hs:60:11) > g :: Sing (g x3) (bound at Bug.hs:60:9) > f :: Sing (f x2 y) (bound at Bug.hs:60:7) > dcomp :: Sing (f x2 y) > -> Sing (g x3) -> Sing x4 -> (c x4 @@ 'Proxy) @@ (g x4 > @@ 'Proxy) > (bound at Bug.hs:60:1) > | > 60 | dcomp f g x = applySing f Proxy Proxy > | ^^^^^ > }}} New description: On GHC HEAD, typechecking this program loops infinitely: {{{#!hs {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeInType #-} {-# LANGUAGE TypeOperators #-} module Bug where import Data.Kind data Proxy a = Proxy data family Sing (a :: k) data SomeSing k where SomeSing :: Sing (a :: k) -> SomeSing k class SingKind k where type Demote k :: Type fromSing :: Sing (a :: k) -> Demote k toSing :: Demote k -> SomeSing k data instance Sing (x :: Proxy k) where SProxy :: Sing 'Proxy instance SingKind (Proxy k) where type Demote (Proxy k) = Proxy k fromSing SProxy = Proxy toSing Proxy = SomeSing SProxy data TyFun :: Type -> Type -> Type type a ~> b = TyFun a b -> Type infixr 0 ~> type family Apply (f :: k1 ~> k2) (x :: k1) :: k2 type a @@ b = Apply a b infixl 9 @@ newtype instance Sing (f :: k1 ~> k2) = SLambda { applySing :: forall t. Sing t -> Sing (f @@ t) } instance (SingKind k1, SingKind k2) => SingKind (k1 ~> k2) where type Demote (k1 ~> k2) = Demote k1 -> Demote k2 fromSing sFun x = case toSing x of SomeSing y -> fromSing (applySing sFun y) toSing = undefined dcomp :: forall (a :: Type) (b :: a ~> Type) (c :: forall (x :: a). Proxy x ~> b @@ x ~> Type) (f :: forall (x :: a) (y :: b @@ x). Proxy x ~> Proxy y ~> c @@ ('Proxy :: Proxy x) @@ y) (g :: forall (x :: a). Proxy x ~> b @@ x) (x :: a). Sing f -> Sing g -> Sing x -> c @@ ('Proxy :: Proxy x) @@ (g @@ ('Proxy :: Proxy x)) dcomp f g x = applySing f Proxy Proxy }}} This is a regression from GHC 8.2.1/8.2.2, where it gives a proper error message: {{{ $ /opt/ghc/8.2.1/bin/ghci Bug.hs GHCi, version 8.2.1: http://www.haskell.org/ghc/ :? for help Loaded GHCi configuration from /home/rgscott/.ghci [1 of 1] Compiling Bug ( Bug.hs, interpreted ) Bug.hs:59:15: error: • Couldn't match expected type ‘Proxy a2 -> Apply (Apply (c x4) 'Proxy) (Apply (g x4) 'Proxy)’ with actual type ‘Sing (f x y @@ t0)’ • The function ‘applySing’ is applied to three arguments, but its type ‘Sing (f x y) -> Sing t0 -> Sing (f x y @@ t0)’ has only two In the expression: applySing f Proxy Proxy In an equation for ‘dcomp’: dcomp f g x = applySing f Proxy Proxy • Relevant bindings include x :: Sing x4 (bound at Bug.hs:59:11) g :: Sing (g x3) (bound at Bug.hs:59:9) f :: Sing (f x2 y) (bound at Bug.hs:59:7) dcomp :: Sing (f x2 y) -> Sing (g x3) -> Sing x4 -> (c x4 @@ 'Proxy) @@ (g x4 @@ 'Proxy) (bound at Bug.hs:59:1) | 59 | dcomp f g x = applySing f Proxy Proxy | ^^^^^^^^^^^^^^^^^^^^^^^ Bug.hs:59:27: error: • Couldn't match expected type ‘Sing t0’ with actual type ‘Proxy a0’ • In the second argument of ‘applySing’, namely ‘Proxy’ In the expression: applySing f Proxy Proxy In an equation for ‘dcomp’: dcomp f g x = applySing f Proxy Proxy • Relevant bindings include x :: Sing x4 (bound at Bug.hs:59:11) g :: Sing (g x3) (bound at Bug.hs:59:9) f :: Sing (f x2 y) (bound at Bug.hs:59:7) dcomp :: Sing (f x2 y) -> Sing (g x3) -> Sing x4 -> (c x4 @@ 'Proxy) @@ (g x4 @@ 'Proxy) (bound at Bug.hs:59:1) | 59 | dcomp f g x = applySing f Proxy Proxy | ^^^^^ }}} -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Oct 14 00:08:16 2017 From: ghc-devs at haskell.org (GHC) Date: Sat, 14 Oct 2017 00:08: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.ba171dc059fb6628614da67f3926999b@haskell.org> #14331: Overzealous free-floating kind check causes deriving clause to be rejected -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: merge Priority: normal | Milestone: 8.2.2 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): You're right, that should work out in the end. Thank you for the patient explanation, and sorry for being slow on the uptake. Replying to [comment:20 goldfire]: > However, in writing this up, I discovered a new problem. When I write > > {{{#!hs > class C2 a > data D b = D deriving C2 > }}} > > do I mean > > {{{#!hs > instance C2 {k -> Type} D > }}} > > or > > {{{#!hs > instance C2 {Type} (D b) > }}} > > ? Both are well-kinded and sensible. Right now, we always choose the latter, but I'm not sure why. The usual convention for figuring out how many type variables to eta reduce from the datatype is to simply count the number of argument types in the kind `k` in `deriving (Cls c1 ... cn :: k -> Constraint)`. In this example, the kind is just a plain kind variable, which we count as having zero arguments. Thus, we don't eta reduce any type variables, resulting in the latter instance. This convention doesn't bother me that much, since if the user wanted to derive `instance C2 D`, they could just as well write `data D a = D deriving (C2 :: (k -> Type) -> Constraint)`. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Oct 14 00:15:34 2017 From: ghc-devs at haskell.org (GHC) Date: Sat, 14 Oct 2017 00:15:34 -0000 Subject: [GHC] #14040: Typed holes regression in GHC 8.0.2: No skolem info: z_a1sY[sk:2] In-Reply-To: <050.973ad933fee1878607a6ab042ec05467@haskell.org> References: <050.973ad933fee1878607a6ab042ec05467@haskell.org> Message-ID: <065.fc6ae2cd68bacd231a1e46c2318e1634@haskell.org> #14040: Typed holes regression in GHC 8.0.2: No skolem info: z_a1sY[sk:2] -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.0.2 checker) | Keywords: TypeInType, Resolution: | TypeFamilies, PartialTypeSignatures Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: #13877 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): Another program with a similar structure and error message: {{{#!hs {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeInType #-} {-# LANGUAGE TypeOperators #-} module Bug where import Data.Kind data Proxy a = Proxy data family Sing (a :: k) data SomeSing k where SomeSing :: Sing (a :: k) -> SomeSing k class SingKind k where type Demote k :: Type fromSing :: Sing (a :: k) -> Demote k toSing :: Demote k -> SomeSing k data instance Sing (x :: Proxy k) where SProxy :: forall (a :: k). Sing ('Proxy :: Proxy a) instance SingKind (Proxy k) where type Demote (Proxy k) = Proxy k fromSing SProxy = Proxy toSing Proxy = SomeSing SProxy data TyFun :: Type -> Type -> Type type a ~> b = TyFun a b -> Type infixr 0 ~> type family Apply (f :: k1 ~> k2) (x :: k1) :: k2 type a @@ b = Apply a b infixl 9 @@ newtype instance Sing (f :: k1 ~> k2) = SLambda { applySing :: forall t. Sing t -> Sing (f @@ t) } instance (SingKind k1, SingKind k2) => SingKind (k1 ~> k2) where type Demote (k1 ~> k2) = Demote k1 -> Demote k2 fromSing sFun x = case toSing x of SomeSing y -> fromSing (applySing sFun y) toSing = undefined dapp :: forall (a :: Type) (f :: forall (x :: a). Proxy x ~> Type) (x :: a). Sing f -> Sing x -> f @@ ('Proxy :: Proxy x) dapp f x = case f of SLambda (sF :: _) -> undefined }}} This time, all GHCs from 8.0.1 on give a similar panic: {{{ $ /opt/ghc/8.2.1/bin/ghci Bug.hs GHCi, version 8.2.1: http://www.haskell.org/ghc/ :? for help Loaded GHCi configuration from /home/rgscott/.ghci [1 of 1] Compiling Bug ( Bug.hs, interpreted ) Bug.hs:56:28: error: • Found type wildcard ‘_’ standing for ‘Singghc: panic! (the 'impossible' happened) (GHC version 8.2.1 for x86_64-unknown-linux): No skolem info: a1_a1tE[sk:1] 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 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Oct 14 00:50:59 2017 From: ghc-devs at haskell.org (GHC) Date: Sat, 14 Oct 2017 00:50:59 -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.601fb1ba3a8325590fe0da9d85c58b8e@haskell.org> #14331: Overzealous free-floating kind check causes deriving clause to be rejected -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: merge Priority: normal | Milestone: 8.2.2 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): You're right that the user could specify this, but I see the original `deriving` as ambiguous -- only we don't report it as so. Worth fixing? I'm not sure. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Oct 14 01:43:46 2017 From: ghc-devs at haskell.org (GHC) Date: Sat, 14 Oct 2017 01:43:46 -0000 Subject: [GHC] #14352: Higher-rank kind ascription oddities Message-ID: <050.9b0e539199d41c76dc35ba34a4af3778@haskell.org> #14352: Higher-rank kind ascription oddities -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 (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 accepts these two definitions: {{{#!hs {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeInType #-} module Bug where import Data.Proxy f :: forall (x :: forall a. a -> Int). Proxy x f = Proxy g :: forall (x :: forall a. a -> Int). Proxy (x :: forall b. b -> Int) g = Proxy }}} However, it does not accept this one, which (AFAICT) should be equivalent to the two above: {{{#!hs h :: forall x. Proxy (x :: forall b. b -> Int) h = Proxy }}} {{{ GHCi, version 8.2.1: http://www.haskell.org/ghc/ :? for help Loaded GHCi configuration from /home/rgscott/.ghci [1 of 1] Compiling Bug ( Bug.hs, interpreted ) Bug.hs:13:23: error: • Expected kind ‘forall b. b -> Int’, but ‘x’ has kind ‘k0’ • In the first argument of ‘Proxy’, namely ‘(x :: forall b. b -> Int)’ In the type signature: h :: forall x. Proxy (x :: forall b. b -> Int) | 13 | h :: forall x. Proxy (x :: forall b. b -> Int) | ^ }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Oct 14 01:57:02 2017 From: ghc-devs at haskell.org (GHC) Date: Sat, 14 Oct 2017 01:57:02 -0000 Subject: [GHC] #14352: Higher-rank kind ascription oddities In-Reply-To: <050.9b0e539199d41c76dc35ba34a4af3778@haskell.org> References: <050.9b0e539199d41c76dc35ba34a4af3778@haskell.org> Message-ID: <065.5b9fb51c2c9e8f5903d027f4321a9d14@haskell.org> #14352: Higher-rank kind ascription oddities -------------------------------------+------------------------------------- Reporter: RyanGlScott | 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: Type of failure: GHC rejects | Unknown/Multiple valid program | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by goldfire): Looks good to me. It all comes down to this rule: GHC never infers a higher-rank kind. In your rejected example, you're asking GHC to infer a higher-rank kind for `x`. Now, you might say "but I'm telling you what the kind is!". The problem is that you haven't quite. You've said that `x` can be used at the type `forall b. b -> Int`, but its actual kind might be more general. On the other hand, when you give a kind at a binding site, that kind is authoritative -- no inference necessary. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Oct 14 02:01:36 2017 From: ghc-devs at haskell.org (GHC) Date: Sat, 14 Oct 2017 02:01:36 -0000 Subject: [GHC] #14352: Higher-rank kind ascription oddities In-Reply-To: <050.9b0e539199d41c76dc35ba34a4af3778@haskell.org> References: <050.9b0e539199d41c76dc35ba34a4af3778@haskell.org> Message-ID: <065.2cb91f3a55d7592c958f3257464ff82a@haskell.org> #14352: Higher-rank kind ascription oddities -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: Component: Compiler (Type | Version: 8.2.1 checker) | Resolution: invalid | 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): * status: new => closed * resolution: => invalid Comment: I stand corrected. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Oct 14 03:02:47 2017 From: ghc-devs at haskell.org (GHC) Date: Sat, 14 Oct 2017 03:02:47 -0000 Subject: [GHC] #14346: 8.2.1 regression: heap corruption after safe foreign calls In-Reply-To: <049.7a4af7d8399ac93444ea4b9211bf91ff@haskell.org> References: <049.7a4af7d8399ac93444ea4b9211bf91ff@haskell.org> Message-ID: <064.c6a0c99cd565e7d0122abf0ac25bfb67@haskell.org> #14346: 8.2.1 regression: heap corruption after safe foreign calls -------------------------------------+------------------------------------- Reporter: andrewchen | Owner: (none) Type: bug | Status: infoneeded Priority: highest | Milestone: Component: Runtime System | Version: 8.2.1 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 andrewchen): I managed to do a `rr` capture with `--chaos` mode. Here's the part in main where it does the comparison: {{{ 0x404581 mov ecx,DWORD PTR [rax] 0x404583 cmp rcx,rbx // compares value with 0xDEADBEEF 0x404586 jne 0x40443c // goes to print "value mismatch" }}} {{{ (rr) p/x $rcx $22 = 0x1 (rr) p/x $rbx $23 = 0xdeadbeef (rr) p/x $rax $24 = 0x42000b7540 }}} Putting a watch point on the the memory address and reverse continuing leads to this: {{{ Old value = 1 New value = -559038737 0x0000000000470b42 in base_GHCziEventziPoll_new5_info () => 0x0000000000470b42 : 49 89 04 24 mov QWORD PTR [r12],rax }}} {{{ (rr) p/x $r12 $27 = 0x42000b7540 }}} Not sure what's going on there, but I hope this is of some help. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Oct 14 10:34:53 2017 From: ghc-devs at haskell.org (GHC) Date: Sat, 14 Oct 2017 10:34:53 -0000 Subject: [GHC] #12822: Cleanup GHC verbosity flags In-Reply-To: <045.4d9fca09f9ab247dee7b220b1a06e9a9@haskell.org> References: <045.4d9fca09f9ab247dee7b220b1a06e9a9@haskell.org> Message-ID: <060.5c4686e8db3332a213369afbbc71661f@haskell.org> #12822: Cleanup GHC verbosity flags -------------------------------------+------------------------------------- Reporter: hsyl20 | Owner: (none) Type: task | Status: new Priority: low | Milestone: Component: Compiler | Version: 8.0.1 Resolution: | Keywords: | newcomer,flags 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 captaintrunky): * Attachment "fix12822.patch" added. First implementation of unified verbosity flags. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Oct 14 10:35:17 2017 From: ghc-devs at haskell.org (GHC) Date: Sat, 14 Oct 2017 10:35:17 -0000 Subject: [GHC] #12822: Cleanup GHC verbosity flags In-Reply-To: <045.4d9fca09f9ab247dee7b220b1a06e9a9@haskell.org> References: <045.4d9fca09f9ab247dee7b220b1a06e9a9@haskell.org> Message-ID: <060.3026165b2fce6a96f97b591bbe84bcde@haskell.org> #12822: Cleanup GHC verbosity flags -------------------------------------+------------------------------------- Reporter: hsyl20 | Owner: (none) Type: task | Status: new Priority: low | Milestone: Component: Compiler | Version: 8.0.1 Resolution: | Keywords: | newcomer,flags Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Other | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by captaintrunky): I've done some preliminary fixes for this task in DynFlags. Is that the right approach? Next step is to refactor some uses of 'verbosity' in some files mentioned above. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Oct 14 11:01:30 2017 From: ghc-devs at haskell.org (GHC) Date: Sat, 14 Oct 2017 11:01:30 -0000 Subject: [GHC] #14353: PowerPC: HEAD validate fails due to warnings in libffi Message-ID: <047.961ea899fd8ff2b7dcf4d0bb882f6d5d@haskell.org> #14353: PowerPC: HEAD validate fails due to warnings in libffi --------------------------------+---------------------------------------- Reporter: trommler | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.3 Keywords: | Operating System: Unknown/Multiple Architecture: powerpc | Type of failure: Building GHC failed Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: --------------------------------+---------------------------------------- Validate produces the following error message: {{{ In file included from rts/dist/build/ffi.h:58:0: error: 0, from rts/Adjustor.c:46: rts/dist/build/ffitarget.h:157:7: error: error: "FFI_TYPE_LAST" is not defined [-Werror=undef] #if !(FFI_TYPE_LAST == FFI_PPC_TYPE_LAST \ }}} and a few more like this. Perhaps, we could turn off the warning for files that include `ffi.h` on PowerPC. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Oct 14 11:23:01 2017 From: ghc-devs at haskell.org (GHC) Date: Sat, 14 Oct 2017 11:23:01 -0000 Subject: [GHC] #12822: Cleanup GHC verbosity flags In-Reply-To: <045.4d9fca09f9ab247dee7b220b1a06e9a9@haskell.org> References: <045.4d9fca09f9ab247dee7b220b1a06e9a9@haskell.org> Message-ID: <060.b2b0aafc41fe744ad270dc889b7a3a3e@haskell.org> #12822: Cleanup GHC verbosity flags -------------------------------------+------------------------------------- Reporter: hsyl20 | Owner: (none) Type: task | Status: new Priority: low | Milestone: Component: Compiler | Version: 8.0.1 Resolution: | Keywords: | newcomer,flags 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 captaintrunky): * cc: captaintrunky (added) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Oct 14 12:16:08 2017 From: ghc-devs at haskell.org (GHC) Date: Sat, 14 Oct 2017 12:16:08 -0000 Subject: [GHC] #11350: Allow visible type application in patterns In-Reply-To: <051.b16517d65bfaaca2db1f23781a666611@haskell.org> References: <051.b16517d65bfaaca2db1f23781a666611@haskell.org> Message-ID: <066.9b198b80dcd75978b2d8f863ee3641b9@haskell.org> #11350: Allow visible type application in patterns -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.1 Resolution: | Keywords: | TypeApplications PatternSynonyms Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #11385, #13159, | Differential Rev(s): #13158 | Wiki Page: | -------------------------------------+------------------------------------- Changes (by vagarenko): * cc: vagarenko (added) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Oct 14 14:06:18 2017 From: ghc-devs at haskell.org (GHC) Date: Sat, 14 Oct 2017 14:06:18 -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.37a34209fba41f9a74cbcac9d14abaa1@haskell.org> #14338: Simplifier fails with "Simplifier ticks exhausted" -------------------------------------+------------------------------------- Reporter: dredozubov | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 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 4e6): I ran git bisect between {{{ghc-8.2.1-release}}} and {{{master}}}, and the first commit that doesn't have the issue is [https://git.haskell.org/ghc.git/commitdiff/33452dfc6cf891b59d63fa9fe138b18cbce4df81 33452dfc6c Refactor the Mighty Simplifier]. Is there a chance to include these changes into the upcoming {{{ghc-8.2.2}}} release? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Oct 14 20:36:07 2017 From: ghc-devs at haskell.org (GHC) Date: Sat, 14 Oct 2017 20:36:07 -0000 Subject: [GHC] #13851: Change in specialisation(?) behaviour since 8.0.2 causes 6x slowdown In-Reply-To: <049.12eb233680e8d62e08f397274c91a741@haskell.org> References: <049.12eb233680e8d62e08f397274c91a741@haskell.org> Message-ID: <064.fca862c1c60ddaa315dd308edb72ce40@haskell.org> #13851: Change in specialisation(?) behaviour since 8.0.2 causes 6x slowdown -------------------------------------+------------------------------------- Reporter: mpickering | Owner: (none) Type: bug | Status: new Priority: high | Milestone: 8.4.1 Component: Compiler | Version: 8.2.1-rc2 Resolution: | Keywords: inlining 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 MikolajKonarski): * cc: MikolajKonarski (added) * keywords: => inlining -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Oct 14 21:33:48 2017 From: ghc-devs at haskell.org (GHC) Date: Sat, 14 Oct 2017 21:33:48 -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.2b9e5b9faa8b649e494d3238a0f0ae3a@haskell.org> #14331: Overzealous free-floating kind check causes deriving clause to be rejected -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: merge Priority: normal | Milestone: 8.2.2 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): Re comment:17, consider {{{ data Foo a = Foo (Proxy (a :: k)) data D a = D deriving (C (a :: k)) }}} You suggest that these are similar, but they aren't. After renaming we have {{{ data Foo {k} a = Foo (Proxy (a :: k)) data D a = D deriving (forall {k}. C (a :: k)) }}} Notice the different scoping of the two `k`'s. So the two really aren't the same at all. We ''could'' have specified different quantifaction semantics for `Foo` thus {{{ data Foo a = Foo (forall {k}. Proxy (a :: k)) }}} But we didn't, and for good reasons. Likewise the tighter scoping in the deriving clause has a good justification. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Oct 14 22:47:04 2017 From: ghc-devs at haskell.org (GHC) Date: Sat, 14 Oct 2017 22:47:04 -0000 Subject: [GHC] #9274: GHC panic with UnliftedFFITypes+CApiFFI In-Reply-To: <042.a93530e65a57f7e254d144435628d197@haskell.org> References: <042.a93530e65a57f7e254d144435628d197@haskell.org> Message-ID: <057.02707dbf4c6b5cf6480979b7f3a4cb7a@haskell.org> #9274: GHC panic with UnliftedFFITypes+CApiFFI -------------------------------------+------------------------------------- Reporter: hvr | Owner: igloo Type: bug | Status: patch Priority: normal | Milestone: Component: Compiler | Version: 7.6.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): phab:D4092 Wiki Page: | -------------------------------------+------------------------------------- Changes (by hvr): * status: new => patch * differential: => phab:D4092 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Oct 14 23:53:26 2017 From: ghc-devs at haskell.org (GHC) Date: Sat, 14 Oct 2017 23:53:26 -0000 Subject: [GHC] #12970: Add default implementation for Bits.bitSize In-Reply-To: <045.18bc248265b05555e123c1ad78e88bb9@haskell.org> References: <045.18bc248265b05555e123c1ad78e88bb9@haskell.org> Message-ID: <060.665c4d34cbf1f145c71750ce1bd49173@haskell.org> #12970: Add default implementation for Bits.bitSize -------------------------------------+------------------------------------- Reporter: txnull | Owner: dfeuer Type: feature request | Status: patch Priority: high | Milestone: 8.4.1 Component: libraries/base | 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:D3723 Wiki Page: | -------------------------------------+------------------------------------- Comment (by hvr): Replying to [comment:11 bgamari]: > Are we going to do this? If so I wonder whether we should push it to 8.6 to avoid breaking libraries again prior to 8.4. By that argument we'd never remove anything, as the same situation would just re-present itself during GHC 8.5; if maintainers have been ignoring the warnings introduced in GHC 7.8, they'll likely ignore them forever... life's too short... ;-) In comment:4 Ed wrote: > We deprecated `bitSize` back in 7.8. Removing it outright in 8.4 seems to be a reasonably measured move and would preempt the need for this default. I'm rather inclined to say we should just finish removing it. So that's the part I believe everyone agrees. And one year later, David submitted a patch (see comment:7) to finally finish this. However, David also brought up a suggestion of doing something that wasn't originally considered/planned: adding a top-level `bitSize` binding in place of the removed `bitSize` method. It isn't clear whether this is something everyone agrees to want to do (David writes in phab:D3723: ''"@ekmett seems to oppose stealing the name."''). What I'd suggest at this point while we're still ahead of the GHC 8.4 freeze: Do the removal now, don't add anything new in its place. Once GHC HEAD snapshots appear with this change, we'll see quickly how bad the fallout is. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Oct 15 07:50:52 2017 From: ghc-devs at haskell.org (GHC) Date: Sun, 15 Oct 2017 07:50:52 -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.f8bc18d96c10cdfb1b939d99b47bea1c@haskell.org> #14338: Simplifier fails with "Simplifier ticks exhausted" -------------------------------------+------------------------------------- Reporter: dredozubov | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 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 4e6): Ugh, that's not all. I tried to build our (big) project with [https://git.haskell.org/ghc.git/commitdiff/33452dfc6cf891b59d63fa9fe138b18cbce4df81 33452dfc6c Refactor the Mighty Simplifier] GHC revision and it was still failing. So, I returned to the test example and was able to trigger the issue on GHC {{{master}}} branch by [https://github.com/4e6/webapp- template-hs/commit/d15ef703a61fd98202e475bff60609d0dd072f50 implementing some methods] and slightly increasing reader size. **Summary** [https://github.com/4e6/webapp-template-hs/tree/simpl-tick-factor webapp- template-hs] branch ''simpl-tick-factor''\\ Builds with {{{ghc-7.10.3}}}\\ Fails with {{{ghc-8.2.1}}} and {{{master}}} branch\\ [https://gist.github.com/4e6/5ef65efdb309daa373a928ec36404fd7 gist] with updated ''-ddump-simpl-stats'' output -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Oct 15 09:51:04 2017 From: ghc-devs at haskell.org (GHC) Date: Sun, 15 Oct 2017 09:51:04 -0000 Subject: [GHC] #13875: ApplicativeDo desugaring is lazier than standard desugaring In-Reply-To: <045.2eda858359df0999208d04da5f95a1da@haskell.org> References: <045.2eda858359df0999208d04da5f95a1da@haskell.org> Message-ID: <060.23e3c1157f89fd629ab7c1b2e8f0a9a4@haskell.org> #13875: ApplicativeDo desugaring is lazier than standard desugaring -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: simonmar Type: bug | Status: closed Priority: high | Milestone: 8.2.1 Component: Compiler | Version: 8.3 Resolution: fixed | Keywords: ApplicativeDo Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Other | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D3681 Wiki Page: | -------------------------------------+------------------------------------- Comment (by Simon Marlow ): In [changeset:"4a677f76155f94086dd645a41a889d362da04e77/ghc" 4a677f76/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="4a677f76155f94086dd645a41a889d362da04e77" Remove section about ApplicativeDo & existentials (#13875) Summary: This section is irrelevant now that strict pattern matches don't get the ApplicativeDo treatment. Test Plan: ``` make html FAST=YES ``` Reviewers: bgamari, austin, erikd Subscribers: rwbarton, thomie GHC Trac Issues: #13875 Differential Revision: https://phabricator.haskell.org/D4087 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Oct 15 10:35:09 2017 From: ghc-devs at haskell.org (GHC) Date: Sun, 15 Oct 2017 10:35:09 -0000 Subject: [GHC] #7258: Compiling DynFlags is jolly slow In-Reply-To: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> References: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> Message-ID: <061.53de2bd89464b20e6ce43a095aca7d95@haskell.org> #7258: Compiling DynFlags is jolly slow -------------------------------------+------------------------------------- Reporter: simonpj | Owner: simonpj Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.6.1 Resolution: | Keywords: deriving-perf 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 trommler): * cc: trommler (added) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Oct 15 11:48:17 2017 From: ghc-devs at haskell.org (GHC) Date: Sun, 15 Oct 2017 11:48:17 -0000 Subject: [GHC] #9274: GHC panic with UnliftedFFITypes+CApiFFI In-Reply-To: <042.a93530e65a57f7e254d144435628d197@haskell.org> References: <042.a93530e65a57f7e254d144435628d197@haskell.org> Message-ID: <057.086701673fde9334e3c027ac4bb7316f@haskell.org> #9274: GHC panic with UnliftedFFITypes+CApiFFI -------------------------------------+------------------------------------- Reporter: hvr | Owner: igloo Type: bug | Status: patch Priority: high | Milestone: 8.2.2 Component: Compiler | Version: 7.6.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): phab:D4092 Wiki Page: | -------------------------------------+------------------------------------- Changes (by hvr): * priority: normal => high * milestone: => 8.2.2 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Oct 15 16:52:04 2017 From: ghc-devs at haskell.org (GHC) Date: Sun, 15 Oct 2017 16:52:04 -0000 Subject: [GHC] #14350: Infinite loop when typechecking incorrect implementation (GHC HEAD only) In-Reply-To: <050.13c8453cb18174ae45ace93d1d6319c0@haskell.org> References: <050.13c8453cb18174ae45ace93d1d6319c0@haskell.org> Message-ID: <065.bb39096349e1eb0c9beba4ef0d26c83e@haskell.org> #14350: Infinite loop when typechecking incorrect implementation (GHC HEAD only) -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: high | Milestone: 8.4.1 Component: Compiler (Type | Version: 8.3 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 RyanGlScott): * cc: simonpj (added) Comment: Commit f20cf982f126aea968ed6a482551550ffb6650cf (`Remove wc_insol from WantedConstraints`) introduced this regression. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Oct 15 21:12:25 2017 From: ghc-devs at haskell.org (GHC) Date: Sun, 15 Oct 2017 21:12:25 -0000 Subject: [GHC] #11295: Figure out what LLVM passes are fruitful In-Reply-To: <046.97e900ad29a1522a4b7374676cc6de7a@haskell.org> References: <046.97e900ad29a1522a4b7374676cc6de7a@haskell.org> Message-ID: <061.e1854b9821485909c6ad7fed188b0ad5@haskell.org> #11295: Figure out what LLVM passes are fruitful -------------------------------------+------------------------------------- Reporter: bgamari | Owner: kavon Type: task | Status: new Priority: normal | Milestone: Component: Compiler (LLVM) | 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 kavon): FYI the repo with progress on this front is here: https://github.com/kavon/autotune A good pass sequence that is not overfit to a specific program is more likely to be ready for 8.6.x -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Oct 15 21:50:07 2017 From: ghc-devs at haskell.org (GHC) Date: Sun, 15 Oct 2017 21:50:07 -0000 Subject: [GHC] #4020: Please consider adding support for local type synonyms In-Reply-To: <041.4d1fc687182926effba30be48457cbb9@haskell.org> References: <041.4d1fc687182926effba30be48457cbb9@haskell.org> Message-ID: <056.581743d381aaec74d62ddf1f30da01b9@haskell.org> #4020: Please consider adding support for local type synonyms -------------------------------------+------------------------------------- Reporter: nr | Owner: (none) Type: feature request | Status: new Priority: low | Milestone: Component: Compiler (Type | Version: 6.12.2 checker) | Resolution: | Keywords: type synonym 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 mentheta): * cc: mentheta (added) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Oct 15 23:24:22 2017 From: ghc-devs at haskell.org (GHC) Date: Sun, 15 Oct 2017 23:24:22 -0000 Subject: [GHC] #14354: Unexpected type inference behavior with -XTypeApplications Message-ID: <042.63a78faec0e747b523d11c4c0ef5172e@haskell.org> #14354: Unexpected type inference behavior with -XTypeApplications -------------------------------------+------------------------------------- Reporter: mbw | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 (Type checker) | Keywords: | Operating System: POSIX Architecture: x86_64 | Type of failure: None/Unknown (amd64) | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- In the following snippet, type inference of the let bound identity function after applying a type unexpectedly fails: {{{#!hs GHCi, version 8.2.1: http://www.haskell.org/ghc/ :? for help [...] *Main> :set -XTypeApplications *Main> :t id @Int id @Int :: Int -> Int *Main> let the = id *Main> :t the @Int :1:1: error: • Cannot apply expression of type ‘a0 -> a0’ to a visible type argument ‘Int’ • In the expression: the @Int *Main> :t _ @Int }}} Note that it works with `id`, but not with `the`. I would expect to be able to write something like `the @Double 42`, for instance. For completeness' sake and since I don't know if it is related or relevant, with GHC 8.0.2, a panic is easily triggered: {{{#!hs Prelude> :set -XTypeApplications Prelude> :t _ @Int ghc: panic! (the 'impossible' happened) (GHC version 8.0.2 for x86_64-unknown-linux): initTc: unsolved constraints WC {wc_insol = [W] __a15d :: t_a15c[tau:3] (CHoleCan: _)} Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug }}} This however does not happen with GHC 8.2.1. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 16 00:24:35 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 16 Oct 2017 00:24:35 -0000 Subject: [GHC] #8822: Allow -- ^ Haddock syntax on record constructors In-Reply-To: <047.9e31292a58062fe675a519afe89cb025@haskell.org> References: <047.9e31292a58062fe675a519afe89cb025@haskell.org> Message-ID: <062.233dd490e6bfd086a1af0e61217acf9e@haskell.org> #8822: Allow -- ^ Haddock syntax on record constructors -------------------------------------+------------------------------------- Reporter: Fuuzetsu | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.9 (Parser) | Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #9770, #12050 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by harpocrates): I have a patch that implements both the initial idea and the the suggestion in comment:4. I'll link to it shortly. The only unpleasantness here is that we probably want to maintain backwards compatibility. For that, I decided to lift doc comments on the last field of the constructor to the constructor, provided there are no other doc comments either on the constructor or any of the other fields. This ensures that existing docs will all still parse the same way. {{{ data Foo = Bar Int String -- ^ doc on `Bar` constructor | Baz -- ^ doc on the `Baz` constructor Int -- ^ doc on the `Int` field of `Baz` String -- ^ doc on the `String` field of `Baz` | Int :+ String -- ^ doc on the `:+` constructor | Int -- ^ doc on the `Int` field of the `:*` constructor :* -- ^ doc on the `:*` constructor String -- ^ doc on the `String` field of the `:*` constructor | Boo { x :: () } -- ^ doc on the `Boo` record constructor | Boa -- ^ doc on the `Boa` record constructor { y :: () } }}} The patch also adds support for doc comments on GADT constructor arguments. {{{ data Foo where Foo :: Int -- ^ `Int` field of `Foo` -> String -- ^ `String` field of `Foo` -> Foo }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 16 00:36:50 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 16 Oct 2017 00:36:50 -0000 Subject: [GHC] #14354: Unexpected type inference behavior with -XTypeApplications In-Reply-To: <042.63a78faec0e747b523d11c4c0ef5172e@haskell.org> References: <042.63a78faec0e747b523d11c4c0ef5172e@haskell.org> Message-ID: <057.85f7d0c32217e7cf5ea0176ad4886579@haskell.org> #14354: Unexpected type inference behavior with -XTypeApplications -------------------------------------+------------------------------------- Reporter: mbw | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.2.1 checker) | Resolution: | Keywords: Operating System: POSIX | Architecture: x86_64 | (amd64) Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by goldfire): This is expected behavior. The [https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/glasgow_exts.html #visible-type-application relevant section] of the GHC manual includes this sentence: > If the function is an identifier (the common case), its type is considered known only when the identifier has been given a type signature. If the identifier does not have a type signature, visible type application cannot be used. I know this behavior can be unintuitive, but it seems that it's the best we can do. If you want to know more about ''why'' this is the case, you will find the answers in [https://repository.brynmawr.edu/cgi/viewcontent.cgi?article=1001&context=compsci_pubs the original paper]. The panic you report is due to an unrelated, fixed bug. If you're satisfied with this answer, please close the ticket. Thanks for reporting! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 16 01:17:35 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 16 Oct 2017 01:17:35 -0000 Subject: [GHC] #14354: Unexpected type inference behavior with -XTypeApplications In-Reply-To: <042.63a78faec0e747b523d11c4c0ef5172e@haskell.org> References: <042.63a78faec0e747b523d11c4c0ef5172e@haskell.org> Message-ID: <057.6245ec8b3e84f0d5f9d5becda91000de@haskell.org> #14354: Unexpected type inference behavior with -XTypeApplications -------------------------------------+------------------------------------- Reporter: mbw | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: Component: Compiler (Type | Version: 8.2.1 checker) | Resolution: invalid | Keywords: Operating System: POSIX | Architecture: x86_64 | (amd64) Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by mbw): * status: new => closed * resolution: => invalid -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 16 02:53:12 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 16 Oct 2017 02:53:12 -0000 Subject: [GHC] #8822: Allow -- ^ Haddock syntax on record constructors In-Reply-To: <047.9e31292a58062fe675a519afe89cb025@haskell.org> References: <047.9e31292a58062fe675a519afe89cb025@haskell.org> Message-ID: <062.fd259914e3420ff997f9bf3e4fdc6aa6@haskell.org> #8822: Allow -- ^ Haddock syntax on record constructors -------------------------------------+------------------------------------- Reporter: Fuuzetsu | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.9 (Parser) | Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #9770, #12050 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by harpocrates): Here is the patch I mentioned in comment:5. https://phabricator.haskell.org/D4094 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 16 07:33:10 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 16 Oct 2017 07:33:10 -0000 Subject: [GHC] #14066: Skolem escape at the kind level In-Reply-To: <046.e2349c640a192dfbbdb6f96b014bd586@haskell.org> References: <046.e2349c640a192dfbbdb6f96b014bd586@haskell.org> Message-ID: <061.03a237693812b84e8f15886390eceaab@haskell.org> #14066: Skolem escape at the kind level -------------------------------------+------------------------------------- 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: #13364, #14040 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * related: => #13364, #14040 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 16 08:24:50 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 16 Oct 2017 08:24:50 -0000 Subject: [GHC] #14347: Top-level RecordWildCards no longer working. In-Reply-To: <047.9d7d4bc51f0d30fd962b21bdfacfc205@haskell.org> References: <047.9d7d4bc51f0d30fd962b21bdfacfc205@haskell.org> Message-ID: <062.4c16585b6aec982ec71cc273141d3480@haskell.org> #14347: Top-level RecordWildCards no longer working. -------------------------------------+------------------------------------- Reporter: Fuuzetsu | 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): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): OK so it looks as if I made this change just before the GHC proposals process kicked off. If you think it's desirable for record wildcards to fill-in with top- level, or even imported, bindings, I suggest you write a short proposal to advocate for it. That way we'll get some debate. However, the absence of documentation of this property is bad. I'll add a paragraph about that anyway; we can always modify it if the GHC proposals process agrees a change. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 16 08:36:12 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 16 Oct 2017 08:36:12 -0000 Subject: [GHC] #14355: Improvement of lazy evaluation Message-ID: <044.85418c0252a45f1b2545c62f3e2e73d8@haskell.org> #14355: Improvement of lazy evaluation -------------------------------------+------------------------------------- Reporter: vanto | Owner: (none) Type: feature | Status: new request | Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- Hello, consider the following example:\\ {{{ Prelude> let d = (\x y -> (+)) Prelude> :t d d :: Num a => p1 -> p2 -> a -> a -> a }}} and calculating these expressions:\\ example 1:\\ {{{ Prelude> d (/) ({-# LANGUAGE TypeNTypes #-}) 1 6 Prelude> d ((\x y -> 1/0)2 3) (\x y -> 1/0) 6 3 Prelude> d 1 2 3 4 Prelude> d 'e' 'r' 5 6 Prelude> d [1] [5] 1 1 Prelude> d (1/0) (1/0) 1 0 Prelude> d (1 `div` 0) 5 3 2 Prelude> d (0/0) (0/0) 1 0 Prelude> d undefined undefined 1 0 Prelude> d True False 1 2 Prelude> d otherwise otherwise 4 3 Prelude> d maybe maybe 8 9 Prelude> d Nothing Nothing 0 7 Prelude> d EQ EQ 4 5 Prelude> d (+) (+) 0 9 Prelude> d error error 1 2 Prelude> d interact interact 1 3 Prelude> d min max 6 4 Prelude> d (:) (:) 7 3 Prelude> d foldl foldr 1 7 }}} and this:\\ example 2:\\ {{{ Prelude> d _ _ 1 2 Prelude> d a z 3 5 Prelude> d (\x -> (*/*)) (\x -> (*/*)) 2 7 Prelude> d (otherwise/otherwise) 2 6 4 }}} and this:\\ example 3: {{{ Prelude> d (/) ({-# #-}) 1 6 }}} Are the results correct? Yes. Is this consistent with common sense? No. Here again, it does not make sense. No comment, I hope this is clear to everyone.\\ Example 2 should provide a result as an example 1. it makes sense.\\ See example 3. A result with warning. you understand? Those who do not understand can close the ticket. Others can re-open the ticket, think better and improve. Do not waste your time answering me that you do not agree. This is only another idea to improve lazy evaluation. Of course, I will not make a proposal. Thank you. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 16 09:46:48 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 16 Oct 2017 09:46:48 -0000 Subject: [GHC] #4020: Please consider adding support for local type synonyms In-Reply-To: <041.4d1fc687182926effba30be48457cbb9@haskell.org> References: <041.4d1fc687182926effba30be48457cbb9@haskell.org> Message-ID: <056.bf9de16d72d4455aa95bbe3654088c61@haskell.org> #4020: Please consider adding support for local type synonyms -------------------------------------+------------------------------------- Reporter: nr | Owner: (none) Type: feature request | Status: new Priority: low | Milestone: Component: Compiler (Type | Version: 6.12.2 checker) | Resolution: | Keywords: type synonym 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 Mon Oct 16 11:03:48 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 16 Oct 2017 11:03:48 -0000 Subject: [GHC] #14356: "Main: thread blocked indefinitely in an MVar operation" in fixIO Message-ID: <046.213052b44c9d3401325e49943e41332d@haskell.org> #14356: "Main: thread blocked indefinitely in an MVar operation" in fixIO -------------------------------------+------------------------------------- Reporter: nickkuk | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Runtime | Version: 8.2.1 System | 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: -------------------------------------+------------------------------------- I'm not sure whether such behavior is expected, but this program {{{ import System.IO main = fixIO (\x -> return 1) >>= print }}} prints "1"; and this {{{ import System.IO main = fixIO (\(x, _) -> return (1, print x)) >>= print . fst }}} prints "Main: thread blocked indefinitely in an MVar operation". Second program arises from something like {{{ {-# LANUGAGE RecursiveDo #-} main = mdo ... x <- return 1 let f = do ... print x ... ... return f }}} It is not necessary to call f somewhere in mdo to get "Main: thread blocked indefinitely in an MVar operation". -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 16 14:38:53 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 16 Oct 2017 14:38:53 -0000 Subject: [GHC] #13604: ghci no longer loads dynamic .o files by default if they were built with -O In-Reply-To: <045.626a6b40d9101c93e2935653ef7e4668@haskell.org> References: <045.626a6b40d9101c93e2935653ef7e4668@haskell.org> Message-ID: <060.a64470e97dfdff5b9b5e7c211e858b2a@haskell.org> #13604: ghci no longer loads dynamic .o files by default if they were built with -O -------------------------------------+------------------------------------- Reporter: George | Owner: dfeuer Type: bug | Status: new Priority: high | Milestone: 8.2.2 Component: Compiler | Version: 8.2.1-rc1 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): Phab:D3514 Wiki Page: | -------------------------------------+------------------------------------- Comment (by dfeuer): What we really want, I think, is for users to be able to specify (globally, and perhaps also for individual loaded files) whether they want extra-aggressive recompilation avoidance. That would include optimization level and HPC (is that covered under the `prof` bit?), and perhaps other profiling options. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 16 14:42:30 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 16 Oct 2017 14:42:30 -0000 Subject: [GHC] #14346: 8.2.1 regression: heap corruption after safe foreign calls In-Reply-To: <049.7a4af7d8399ac93444ea4b9211bf91ff@haskell.org> References: <049.7a4af7d8399ac93444ea4b9211bf91ff@haskell.org> Message-ID: <064.cb602c3c6f872844dfb5329893dd898b@haskell.org> #14346: 8.2.1 regression: heap corruption after safe foreign calls -------------------------------------+------------------------------------- Reporter: andrewchen | Owner: (none) Type: bug | Status: infoneeded Priority: highest | Milestone: Component: Runtime System | Version: 8.2.1 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): Indeed the `--chaos` tip is quite helpful. Thanks! So it appears that the crazy TSO is loaded in `stg_putMVar#` on line 1737: {{{#!c ... // There are readMVar/takeMVar(s) waiting: wake up the first one tso = StgMVarTSOQueue_tso(q); // <--- here StgMVar_head(mvar) = StgMVarTSOQueue_link(q); if (StgMVar_head(mvar) == stg_END_TSO_QUEUE_closure) { StgMVar_tail(mvar) = stg_END_TSO_QUEUE_closure; } ... }}} Here `q` is `0x42000b7530` which is a fairly reasonable-looking `MVAR_TSO_QUEUE`, except with a completely wild `tso` field, {{{ 0x42000b7530: 0x4acd28 0x4f2c30 0x42000b7540: 0x42deadbeef 0x433508 }}} Indeed the last guy to write to `StgMVarTSOQueue_tso(q)` is the FFI target, `test`, {{{ Dump of assembler code for function test: => 0x00000000004044f0 <+0>: movl $0xdeadbeef,(%rdi) 0x00000000004044f6 <+6>: retq }}} where `%rdi == 0x00000042000b7540`. Let's look at the calling sequence produced by GHC, {{{#!asm _c4Rp: movq $block_c4Ru_info,-8(%rbp) # I64[Sp - 8] = c4Ru; movq %rax,(%rbp) # I64[Sp] = _s4Ok::I64; addq $-8,%rbp # Sp = Sp - 8; movq 872(%r13),%rbx # _u4RJ::P64 = CurrentTSO; movq 24(%rbx),%rcx # I64[I64[_u4RJ::P64 + 24] + 16] = Sp; movq %rbp,16(%rcx) movq 888(%r13),%rcx # _u4RK::I64 = CurrentNursery; leaq 8(%r12),%rdx # P64[_u4RK::I64 + 8] = Hp + 8; # I64[_u4RJ::P64 + 104] = I64[_u4RJ::P64 + 104] # - ((Hp + 8) - I64[_u4RK::I64]); movq %rdx,8(%rcx) leaq 8(%r12),%rdx subq (%rcx),%rdx movq 104(%rbx),%rcx subq %rdx,%rcx movq %rcx,104(%rbx) # (_u4RH::I64) = call "ccall" arg hints: [PtrHint,] result hints: [PtrHint] suspendThread(BaseReg, 0); subq $8,%rsp # native-call stack adjustment movq %r13,%rdi # setup argument 1 (BaseReg) xorl %esi,%esi # setup argument 2 (0) movq %rax,%rbx # Save $rax in callee-saved register xorl %eax,%eax # ??? call suspendThread addq $8,%rsp # undo stack adjustment subq $8,%rsp # redo stack adjustment; silly GHC movq %rbx,%rdi # ??? <---- This is where the bad argument comes from movq %rax,%rbx # Ahhh, I think I see xorl %eax,%eax call test # Native call addq $8,%rsp # undo stack adjustment subq $8,%rsp # you are such a joker, GHC movq %rbx,%rdi xorl %eax,%eax call resumeThread ... }}} It looks to me like what happens here is that we spill `$rax` (which contains a pointer to the current `MVar` closure) to `$rbx` twice, losing knowledge of the first spill. Consequently we end up passing the `MVar` as the argument to `test`. Hilarity ensues. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 16 14:46:15 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 16 Oct 2017 14:46:15 -0000 Subject: [GHC] #13604: ghci no longer loads dynamic .o files by default if they were built with -O In-Reply-To: <045.626a6b40d9101c93e2935653ef7e4668@haskell.org> References: <045.626a6b40d9101c93e2935653ef7e4668@haskell.org> Message-ID: <060.11e389f7f12890815b85e938374428c5@haskell.org> #13604: ghci no longer loads dynamic .o files by default if they were built with -O -------------------------------------+------------------------------------- Reporter: George | Owner: dfeuer Type: bug | Status: new Priority: high | Milestone: 8.2.2 Component: Compiler | Version: 8.2.1-rc1 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): Phab:D3514 Wiki Page: | -------------------------------------+------------------------------------- Comment (by dfeuer): I guess this probably means teasing apart fingerprints that are currently merged, recording these options separately. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 16 15:02:09 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 16 Oct 2017 15:02:09 -0000 Subject: [GHC] #14355: Improvement of lazy evaluation In-Reply-To: <044.85418c0252a45f1b2545c62f3e2e73d8@haskell.org> References: <044.85418c0252a45f1b2545c62f3e2e73d8@haskell.org> Message-ID: <059.2e815b804fa57f2da70deb4893d78b76@haskell.org> #14355: Improvement of lazy evaluation -------------------------------------+------------------------------------- Reporter: vanto | Owner: (none) Type: feature request | Status: closed Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 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 nomeata): * status: new => closed * resolution: => invalid Comment: > Those who do not understand can close the ticket. Will do. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 16 15:21:16 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 16 Oct 2017 15:21:16 -0000 Subject: [GHC] #14271: ghci hangs with -fexternal-interpreter -prof In-Reply-To: <047.35b6ee83038ae67884e53737c2b92695@haskell.org> References: <047.35b6ee83038ae67884e53737c2b92695@haskell.org> Message-ID: <062.e35b9004d559f6dfd6f0479a5568d8d2@haskell.org> #14271: ghci hangs with -fexternal-interpreter -prof -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: GHCi | Version: 8.2.1 Resolution: | Keywords: Operating System: Windows | Architecture: | Unknown/Multiple Type of failure: GHCi crash | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * cc: Phyx- (added) Comment: Tamar, do you know what is going on here? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 16 15:27:31 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 16 Oct 2017 15:27:31 -0000 Subject: [GHC] #7258: Compiling DynFlags is jolly slow In-Reply-To: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> References: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> Message-ID: <061.40ea597438f3d4a98657739723964ca4@haskell.org> #7258: Compiling DynFlags is jolly slow -------------------------------------+------------------------------------- Reporter: simonpj | Owner: simonpj Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.6.1 Resolution: | Keywords: deriving-perf 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): Tobaias found that the bottlenecks on W2 were * Pretty-printing of assembly code * Register allocation He has some improvements in progress. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 16 15:29:22 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 16 Oct 2017 15:29:22 -0000 Subject: [GHC] #7258: Compiling DynFlags is jolly slow In-Reply-To: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> References: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> Message-ID: <061.2c8d7ad03bdc7910d7745b6ad07baa7e@haskell.org> #7258: Compiling DynFlags is jolly slow -------------------------------------+------------------------------------- Reporter: simonpj | Owner: simonpj Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.6.1 Resolution: | Keywords: deriving-perf Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: #13426 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by dfeuer): * related: => #13426 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 16 15:29:50 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 16 Oct 2017 15:29:50 -0000 Subject: [GHC] #13426: compile-time memory-usage regression for DynFlags between GHC 8.0 and GHC 8.2 In-Reply-To: <042.588059ee1290b666bd7f0947c071e1ff@haskell.org> References: <042.588059ee1290b666bd7f0947c071e1ff@haskell.org> Message-ID: <057.03af6f3c921e7f3605c2b27d57c65ee0@haskell.org> #13426: compile-time memory-usage regression for DynFlags between GHC 8.0 and GHC 8.2 -------------------------------------+------------------------------------- Reporter: hvr | Owner: dfeuer Type: bug | Status: new Priority: high | Milestone: 8.4.1 Component: Compiler | Version: 8.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: #7258 | Differential Rev(s): Phab:D3399, Wiki Page: | Phab:D3400, Phab:D3421 -------------------------------------+------------------------------------- Changes (by dfeuer): * related: => #7258 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 16 15:33:21 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 16 Oct 2017 15:33:21 -0000 Subject: [GHC] #7258: Compiling DynFlags is jolly slow In-Reply-To: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> References: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> Message-ID: <061.56fc3f1eb8ef2c8385bc9a2b698dba1b@haskell.org> #7258: Compiling DynFlags is jolly slow -------------------------------------+------------------------------------- Reporter: simonpj | Owner: simonpj Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.6.1 Resolution: | Keywords: deriving-perf 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): * related: #13426 => Comment: Apparently [https://github.com/jwaldmann/pretty-test this] is a example of non-linearity in the pretty printer library. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 16 15:55:49 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 16 Oct 2017 15:55:49 -0000 Subject: [GHC] #13604: ghci no longer loads dynamic .o files by default if they were built with -O In-Reply-To: <045.626a6b40d9101c93e2935653ef7e4668@haskell.org> References: <045.626a6b40d9101c93e2935653ef7e4668@haskell.org> Message-ID: <060.a4c23976393b0e3429dee85152b04d51@haskell.org> #13604: ghci no longer loads dynamic .o files by default if they were built with -O -------------------------------------+------------------------------------- Reporter: George | Owner: dfeuer Type: bug | Status: new Priority: highest | Milestone: 8.2.2 Component: Compiler | Version: 8.2.1-rc1 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): Phab:D3514 Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * priority: high => highest -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 16 16:01:07 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 16 Oct 2017 16:01:07 -0000 Subject: [GHC] #14215: Coordinate re Cabal-2.0.0.3 or Cabal-2.0.1 release In-Reply-To: <042.f2da5496c03c753cd8a87d1fc1022cfc@haskell.org> References: <042.f2da5496c03c753cd8a87d1fc1022cfc@haskell.org> Message-ID: <057.9c001cbdc7e413a8fc32792ccd6574c5@haskell.org> #14215: Coordinate re Cabal-2.0.0.3 or Cabal-2.0.1 release -------------------------------------+------------------------------------- Reporter: hvr | Owner: (none) Type: task | Status: new Priority: high | Milestone: 8.2.2 Component: libraries | Version: 8.2.1 (other) | 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: It turns out that there is still a blocker in [[https://github.com/haskell/cabal/issues/4808|#4808]]. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 16 16:01:43 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 16 Oct 2017 16:01:43 -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.69ac6d5d132b4b9074feb2c098686fdf@haskell.org> #14335: Annotations aren't supported with -fexternal-interpreter -------------------------------------+------------------------------------- Reporter: bgamari | Owner: bgamari 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: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * owner: (none) => bgamari Comment: Looking at the implementation more carefully it actually looks like this should work. I'll investigate. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 16 16:21:32 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 16 Oct 2017 16:21:32 -0000 Subject: [GHC] #11295: Figure out what LLVM passes are fruitful In-Reply-To: <046.97e900ad29a1522a4b7374676cc6de7a@haskell.org> References: <046.97e900ad29a1522a4b7374676cc6de7a@haskell.org> Message-ID: <061.0a6285ac16e9f43a2ebbf5e631ed1206@haskell.org> #11295: Figure out what LLVM passes are fruitful -------------------------------------+------------------------------------- Reporter: bgamari | Owner: kavon Type: task | Status: new Priority: normal | Milestone: Component: Compiler (LLVM) | 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 bgamari): Yay! Thanks kavon. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 16 16:38:24 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 16 Oct 2017 16:38:24 -0000 Subject: [GHC] #14357: Document deriving strategies fully Message-ID: <046.91687c1a92b17e8af88be3338e9d0f5b@haskell.org> #14357: Document deriving strategies fully -------------------------------------+------------------------------------- Reporter: nomeata | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Documentation | 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: -------------------------------------+------------------------------------- The users’ guide currently sais in the section on `DerivingStrategies`: > If an explicit deriving strategy is not given, GHC has an algorithm for determining how it will actually derive an instance. For brevity, the algorithm is omitted here. You can read the full algorithm at Wiki page. I think this is doing our users a disservice: They want to rely on the guide to have authorative, concise and clear information. The wiki page contains too much stuff that is confusing for users (Alternative syntax, rationales etc.) (Also, the link in the manual is wrong). Ryan, do you agree and are you available to put the relevant bits into the manual? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 16 16:49:01 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 16 Oct 2017 16:49:01 -0000 Subject: [GHC] #14357: Document deriving strategies fully In-Reply-To: <046.91687c1a92b17e8af88be3338e9d0f5b@haskell.org> References: <046.91687c1a92b17e8af88be3338e9d0f5b@haskell.org> Message-ID: <061.92cbcdc4fa3b2d081c71dc82952a94be@haskell.org> #14357: Document deriving strategies fully -------------------------------------+------------------------------------- Reporter: nomeata | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Documentation | 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 RyanGlScott): I agree that the "wiki page contains too much stuff that is confusing for users", which is precisely why I didn't inline the gory details into the users' guide in the first place, and left a link for adventurous readers. But I consider the algorithm for choosing when GHC will default to a particular strategy to be an especially gory giblet. (If you don't believe me, try to condense the information [https://ghc.haskell.org/trac/ghc/wiki/Commentary/Compiler/DerivingStrategies#Thederivingstrategyresolutionalgorithm here] into something short and snappy!) So I don't know what you're expecting the users' guide to say in this regard. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 16 17:03:54 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 16 Oct 2017 17:03:54 -0000 Subject: [GHC] #9274: GHC panic with UnliftedFFITypes+CApiFFI In-Reply-To: <042.a93530e65a57f7e254d144435628d197@haskell.org> References: <042.a93530e65a57f7e254d144435628d197@haskell.org> Message-ID: <057.0dd1fe13b3e36f354b35794813f9f0a6@haskell.org> #9274: GHC panic with UnliftedFFITypes+CApiFFI -------------------------------------+------------------------------------- Reporter: hvr | Owner: igloo Type: bug | Status: patch Priority: high | Milestone: 8.2.2 Component: Compiler | Version: 7.6.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): phab:D4092 Wiki Page: | -------------------------------------+------------------------------------- Comment (by Herbert Valerio Riedel ): In [changeset:"add85cc2a3ec0bda810dca2a35264308ffaab069/ghc" add85cc2/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="add85cc2a3ec0bda810dca2a35264308ffaab069" Fix panic for `ByteArray#` arguments in CApiFFI foreign imports Declarations such as foreign import capi unsafe "string.h strlen" c_strlen_capi :: ByteArray# -> IO CSize foreign import capi unsafe "string.h memset" c_memset_capi :: MutableByteArray# s -> CInt -> CSize -> IO () would cause GHC to panic because the CApiFFI c-wrapper generator didn't know what C type to use for `(Mutable)ByteArray#` types (unlike the `ccall` codepath). This addresses #9274 Reviewed By: bgamari Differential Revision: https://phabricator.haskell.org/D4092 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 16 18:31:22 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 16 Oct 2017 18:31:22 -0000 Subject: [GHC] #7258: Compiling DynFlags is jolly slow In-Reply-To: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> References: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> Message-ID: <061.49e5488e02bc67a9ceeeab9e399fbb9d@haskell.org> #7258: Compiling DynFlags is jolly slow -------------------------------------+------------------------------------- Reporter: simonpj | Owner: simonpj Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.6.1 Resolution: | Keywords: deriving-perf 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 heisenbug): * cc: heisenbug (added) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 16 18:53:54 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 16 Oct 2017 18:53:54 -0000 Subject: [GHC] #14214: Users guide lies about default optimization level In-Reply-To: <046.736805dbdfc6944b76008d4f99ba283f@haskell.org> References: <046.736805dbdfc6944b76008d4f99ba283f@haskell.org> Message-ID: <061.5a31a0acdaf35123293259fcbd947591@haskell.org> #14214: Users guide lies about default optimization level -------------------------------------+------------------------------------- Reporter: bgamari | Owner: bgamari Type: bug | Status: new Priority: high | Milestone: 8.4.1 Component: Compiler | Version: 8.2.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Documentation | Unknown/Multiple bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4098 Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * differential: => Phab:D4098 Comment: See Phab:D4098 for a first cut. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 16 19:16:36 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 16 Oct 2017 19:16:36 -0000 Subject: [GHC] #14357: Document deriving strategies fully In-Reply-To: <046.91687c1a92b17e8af88be3338e9d0f5b@haskell.org> References: <046.91687c1a92b17e8af88be3338e9d0f5b@haskell.org> Message-ID: <061.ea8c7486621be342cb46c4f0e26676e8@haskell.org> #14357: Document deriving strategies fully -------------------------------------+------------------------------------- Reporter: nomeata | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Documentation | 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 nomeata): Sure, good documentation is tricky :-) I would have found the enumeration at the beginning of the wiki section already quite useful. Also note that this describes what happens without `DerivingStrategies`. So maybe it should not be documented under this language extension… Bits of the information that is missing here are scattered throughout the documentation, e.g. https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/glasgow_exts.html #precise-gnd-specification states: > Lastly, all of this applies only for classes other than Read, Show, Typeable, and Data, for which the stock derivation applies (section 4.3.3. of the Haskell Report). So maybe there should be a general section that describes GHC’s approach to deriving more general, and gives an overview that spans the various pragmas. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 16 19:26:37 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 16 Oct 2017 19:26:37 -0000 Subject: [GHC] #14357: Document deriving strategies fully In-Reply-To: <046.91687c1a92b17e8af88be3338e9d0f5b@haskell.org> References: <046.91687c1a92b17e8af88be3338e9d0f5b@haskell.org> Message-ID: <061.d425a9e289d02041326313d6fae3e69c@haskell.org> #14357: Document deriving strategies fully -------------------------------------+------------------------------------- Reporter: nomeata | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Documentation | Version: 8.2.1 Resolution: | Keywords: 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 RyanGlScott): * keywords: => deriving Comment: OK. What you are describing sounds a lot like #13175, yes? We already have quite an extensive overview of all the various `Deriving` pragmas (see https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/glasgow_exts.html #deriving-instances-of-extra-classes-data-etc). All that's missing is a blurb that mentions the other stock derivable classes (and of course, a link to deriving strategies section that explains what "stock" means). -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 16 19:35:00 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 16 Oct 2017 19:35:00 -0000 Subject: [GHC] #14357: Document deriving strategies fully In-Reply-To: <046.91687c1a92b17e8af88be3338e9d0f5b@haskell.org> References: <046.91687c1a92b17e8af88be3338e9d0f5b@haskell.org> Message-ID: <061.585a88f0067030c32b49e4c7a6e1e3a3@haskell.org> #14357: Document deriving strategies fully -------------------------------------+------------------------------------- Reporter: nomeata | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Documentation | Version: 8.2.1 Resolution: | Keywords: 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: | -------------------------------------+------------------------------------- Comment (by nomeata): Yes, maybe that’d be sufficient. I think I’d also like to know which stock instances are derived as such for newtypes, and which are derived by using the newtype strategy, but I guess that information can also be found (“C is not Read, Show, Typeable, or Data. These classes should not “look through” the type or its constructor. You can still derive these classes for a newtype, but it happens in the usual way, not via this new mechanism.”). So maybe, all the information is already present in the manual, in which case the reference to the wiki can be removed? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 16 19:37:11 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 16 Oct 2017 19:37:11 -0000 Subject: [GHC] #14357: Document deriving strategies fully In-Reply-To: <046.91687c1a92b17e8af88be3338e9d0f5b@haskell.org> References: <046.91687c1a92b17e8af88be3338e9d0f5b@haskell.org> Message-ID: <061.79f24b83928f684650d44a6a91ddd291@haskell.org> #14357: Document deriving strategies fully -------------------------------------+------------------------------------- Reporter: nomeata | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Documentation | Version: 8.2.1 Resolution: | Keywords: 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: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): Replying to [comment:4 nomeata]: > So maybe, all the information is already present in the manual, in which case the reference to the wiki can be removed? Sounds good to me. Do you want to take a crack at implementing this? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 16 19:50:46 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 16 Oct 2017 19:50:46 -0000 Subject: [GHC] #14357: Document deriving strategies fully In-Reply-To: <046.91687c1a92b17e8af88be3338e9d0f5b@haskell.org> References: <046.91687c1a92b17e8af88be3338e9d0f5b@haskell.org> Message-ID: <061.7c0417b64464c2b8726da7b08e220ae0@haskell.org> #14357: Document deriving strategies fully -------------------------------------+------------------------------------- Reporter: nomeata | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Documentation | Version: 8.2.1 Resolution: | Keywords: 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: | -------------------------------------+------------------------------------- Comment (by nomeata): Not necessarily :-) (at least not right now). I will, however, not blame anyone else for not doing this right now either. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 16 20:19:33 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 16 Oct 2017 20:19:33 -0000 Subject: [GHC] #13203: Implement Bits Natural clearBit In-Reply-To: <044.036af31a947c4008bf1dfa61730885bd@haskell.org> References: <044.036af31a947c4008bf1dfa61730885bd@haskell.org> Message-ID: <059.22c06a8f9e9c819fd66bc19955d5e363@haskell.org> #13203: Implement Bits Natural clearBit -------------------------------------+------------------------------------- Reporter: dylex | Owner: supersven Type: bug | Status: new Priority: lowest | Milestone: Component: libraries/base | Version: 8.0.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 Herbert Valerio Riedel ): In [changeset:"5984a698fc2974b719365a9647a7cae1bed51eec/ghc" 5984a698/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="5984a698fc2974b719365a9647a7cae1bed51eec" Override default `clearBit` method impl for `Natural` The default implementation of `clearBit` is in terms of `complement`. However, `complement` is not well-defined for `Natural` and this consequently renders the default implementation of `clearBit` dysfunctional. This implements `clearBit` in terms of `testBit` and `setBit` which are both well-defined for `Natural`s. This addresses #13203 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 16 20:26:23 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 16 Oct 2017 20:26:23 -0000 Subject: [GHC] #13203: Implement Bits Natural clearBit In-Reply-To: <044.036af31a947c4008bf1dfa61730885bd@haskell.org> References: <044.036af31a947c4008bf1dfa61730885bd@haskell.org> Message-ID: <059.a0ceaaa5f4ee09b8bb921e26b0eb4f52@haskell.org> #13203: Implement Bits Natural clearBit -------------------------------------+------------------------------------- Reporter: dylex | Owner: supersven Type: bug | Status: new Priority: lowest | Milestone: Component: libraries/base | Version: 8.0.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 Herbert Valerio Riedel ): In [changeset:"843772b86b62df686a9e57648fa9d3ed06b13973/ghc" 843772b8/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="843772b86b62df686a9e57648fa9d3ed06b13973" Enable testing 'Natural' type in TEST=arith011 This now passes thanks to 5984a698fc2974b719365a9647a7cae1bed51eec (re #13203) }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 16 20:31:47 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 16 Oct 2017 20:31:47 -0000 Subject: [GHC] #7860: Add more bit fiddling functions to 'integer-gmp' In-Reply-To: <046.cf50459cade182946253e5602ab21f1f@haskell.org> References: <046.cf50459cade182946253e5602ab21f1f@haskell.org> Message-ID: <061.5fbf564d3064cd636317d6510f3d57c0@haskell.org> #7860: Add more bit fiddling functions to 'integer-gmp' -------------------------------------+------------------------------------- Reporter: lebedev | Owner: hvr Type: feature request | Status: new Priority: normal | Milestone: 8.4.1 Component: Core Libraries | Version: 7.6.3 Resolution: | Keywords: integer-gmp Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #3489, #9835 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Herbert Valerio Riedel ): In [changeset:"6cc232ae925bc6fc88229d96589a851068a9cace/ghc" 6cc232ae/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="6cc232ae925bc6fc88229d96589a851068a9cace" Implement {set,clear,complement}BitBigNat primitives This implements the missing `{set,clear,complement}BitBigNat` primitives and hooks them up to `Natural`'s `Bits` instance. This doesn't yet benefit `Integer`, as we still need "negative" `BigNat` variants of those primitives. Addresses #7860 (partly) Reviewed By: bgamari Differential Revision: https://phabricator.haskell.org/D3415 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 16 20:38:07 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 16 Oct 2017 20:38:07 -0000 Subject: [GHC] #13203: Implement Bits Natural clearBit In-Reply-To: <044.036af31a947c4008bf1dfa61730885bd@haskell.org> References: <044.036af31a947c4008bf1dfa61730885bd@haskell.org> Message-ID: <059.9ff29806889c8a3a73f669b20a020513@haskell.org> #13203: Implement Bits Natural clearBit -------------------------------------+------------------------------------- Reporter: dylex | Owner: supersven Type: bug | Status: merge Priority: high | Milestone: 8.2.2 Component: libraries/base | Version: 7.10.1 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 hvr): * status: new => merge * failure: None/Unknown => Incorrect result at runtime * priority: lowest => high * version: 8.0.2 => 7.10.1 * milestone: => 8.2.2 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 16 20:40:35 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 16 Oct 2017 20:40:35 -0000 Subject: [GHC] #9274: GHC panic with UnliftedFFITypes+CApiFFI In-Reply-To: <042.a93530e65a57f7e254d144435628d197@haskell.org> References: <042.a93530e65a57f7e254d144435628d197@haskell.org> Message-ID: <057.5e1405bab84691ef02f25c74ff66d0da@haskell.org> #9274: GHC panic with UnliftedFFITypes+CApiFFI -------------------------------------+------------------------------------- Reporter: hvr | Owner: igloo Type: bug | Status: merge Priority: high | Milestone: 8.2.2 Component: Compiler | Version: 7.6.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): phab:D4092 Wiki Page: | -------------------------------------+------------------------------------- Changes (by hvr): * status: patch => merge -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 16 20:43:07 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 16 Oct 2017 20:43:07 -0000 Subject: [GHC] #14271: ghci hangs with -fexternal-interpreter -prof In-Reply-To: <047.35b6ee83038ae67884e53737c2b92695@haskell.org> References: <047.35b6ee83038ae67884e53737c2b92695@haskell.org> Message-ID: <062.29b0b629d79043b28efa72167e1c42a7@haskell.org> #14271: ghci hangs with -fexternal-interpreter -prof -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: GHCi | Version: 8.2.1 Resolution: | Keywords: Operating System: Windows | Architecture: | Unknown/Multiple Type of failure: GHCi crash | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Phyx-): @bgamari, no, I've never used `fexternal-interpreter` aside from the initial implementation stuff for Windows. I'm having trouble with building a profiled debug build so I'll have to sort that out first before I can debug this. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 16 20:47:22 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 16 Oct 2017 20:47:22 -0000 Subject: [GHC] #14336: ghci leaks memory In-Reply-To: <051.dbf33557716163bb981beab6790198d1@haskell.org> References: <051.dbf33557716163bb981beab6790198d1@haskell.org> Message-ID: <066.51f9605c47dc265272fb94795c855404@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 Phyx-): Hmm I believe this is not Windows specific, peaking into the heap it seems to be all `PAPs` and `closures` so I believe it's a generic GHCi bug, where a reference is being held to the previous repl results and so preventing GC. I'll find some time to take a look at it, thanks for the report! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 16 20:58:14 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 16 Oct 2017 20:58:14 -0000 Subject: [GHC] #13945: 'ghc-pkg update' fails due to bad file descriptor error In-Reply-To: <049.b152863155a8f5ca5d2c78f97fc10495@haskell.org> References: <049.b152863155a8f5ca5d2c78f97fc10495@haskell.org> Message-ID: <064.33a121ca9341e8689e7691b6bf601f76@haskell.org> #13945: 'ghc-pkg update' fails due to bad file descriptor error ---------------------------------+---------------------------------------- Reporter: mpickering | Owner: bgamari Type: bug | Status: new Priority: high | Milestone: 8.2.2 Component: Compiler | Version: 8.2.1-rc3 Resolution: | Keywords: Operating System: Linux | Architecture: Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D3897 Wiki Page: | ---------------------------------+---------------------------------------- Comment (by bgamari): comment:14 and comment:15 merged to `ghc-8.2` in 92014a72f12786d8f9c3d9b82a295621ca4b3fff and f093d7ea26323f026d95338162913c33525b32fe. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 16 20:58:42 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 16 Oct 2017 20:58:42 -0000 Subject: [GHC] #14285: Entered absent arg - triggered by INLINEABLE, regression from 8.0.2 In-Reply-To: <049.09fbd6d1ad4f0a97bcd76579dd68ae8a@haskell.org> References: <049.09fbd6d1ad4f0a97bcd76579dd68ae8a@haskell.org> Message-ID: <064.9e0b1cda141be506b61902c32e874efa@haskell.org> #14285: Entered absent arg - triggered by INLINEABLE, regression from 8.0.2 -------------------------------------+------------------------------------- Reporter: j.waldmann | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: 8.2.2 Component: Compiler | Version: 8.2.1 Resolution: fixed | Keywords: Operating System: Linux | Architecture: x86_64 | (amd64) Type of failure: None/Unknown | Test Case: | stranal/should_run/T14285 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: merge => closed * resolution: => fixed Comment: Merged to `ghc-8.2` in 35f85046d7f639b8aa741069f19add754b546fdc. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 16 21:14:29 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 16 Oct 2017 21:14:29 -0000 Subject: [GHC] #13861: Take more advantage of STG representation invariance (follows up #9291) In-Reply-To: <048.651e325a747e822318af666cede88e81@haskell.org> References: <048.651e325a747e822318af666cede88e81@haskell.org> Message-ID: <063.b99072febb7376b1cbfb827d641db591@haskell.org> #13861: Take more advantage of STG representation invariance (follows up #9291) -------------------------------------+------------------------------------- Reporter: heisenbug | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.0.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): Brain dump of conversation with SPJ at Haskell eXchange, London. Currently pointer tagging only effective for "small constructor families". If not small, the tag is 1 on pointers to evaluated constructors. See `isSmallFamily` in `compiler/codeGen/StgCmmClosure.hs`. Of course this penalizes big families. I suggest to set tags 1..6 for non-small families' lower constructors, 7 for all other (overflowing) constructors. This would allow more precise branching for big families too (in a significant number of cases), as the ''former'' constructors are usually the more common ones (keeping fingers crossed). Also the coercion between small and big families would be straightforward, with following ranges directly castable: || || |||| from || || || ||= small =||= big =|| ||= to =||= small =|| 1..7 || 1..6 || || ||= big =|| 1..7 || 1..7 || Conservatively in the beginning one could only allow 1..6. Note: `(-1 :: Int) .&. 7 == 7` so that would lead to all-ones too. It is not immediately clear how to find out whether the constructor is n a big family. We could add the family size as an additional piece of information. A (future) wiki page should explain the new conventions. Many references to pinter tagging in the code should be updated. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 16 21:26:33 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 16 Oct 2017 21:26:33 -0000 Subject: [GHC] #13955: Backpack does not handle unlifted types In-Reply-To: <049.a67534eef775638b6e13621c35886744@haskell.org> References: <049.a67534eef775638b6e13621c35886744@haskell.org> Message-ID: <064.59ef97ad03dd751103d0cab24e04e4f4@haskell.org> #13955: Backpack does not handle unlifted types -------------------------------------+------------------------------------- Reporter: andrewthad | Owner: (none) Type: feature request | Status: new Priority: low | Milestone: Component: Compiler | Version: 8.2.1-rc2 Resolution: | Keywords: backpack | LevityPolymorphism 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:"fd8b044e9664181d4815e48e8f83be78bc9fe8d2/ghc" fd8b044e/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="fd8b044e9664181d4815e48e8f83be78bc9fe8d2" Levity polymorphic Backpack. This patch makes it possible to specify non * kinds of abstract data types in signatures, so you can have levity polymorphism through Backpack, without the runtime representation constraint! Signed-off-by: Edward Z. Yang Test Plan: validate Reviewers: andrewthad, bgamari, austin, goldfire Reviewed By: bgamari Subscribers: goldfire, rwbarton, thomie GHC Trac Issues: #13955 Differential Revision: https://phabricator.haskell.org/D3825 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 16 21:27:57 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 16 Oct 2017 21:27:57 -0000 Subject: [GHC] #13955: Backpack does not handle unlifted types In-Reply-To: <049.a67534eef775638b6e13621c35886744@haskell.org> References: <049.a67534eef775638b6e13621c35886744@haskell.org> Message-ID: <064.680eed5834065ea64ae97eb8d9cf91a0@haskell.org> #13955: Backpack does not handle unlifted types -------------------------------------+------------------------------------- Reporter: andrewthad | Owner: (none) Type: feature request | Status: closed Priority: low | Milestone: 8.4.1 Component: Compiler | Version: 8.2.1-rc2 Resolution: fixed | Keywords: backpack | LevityPolymorphism 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.4.1 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 16 21:33:06 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 16 Oct 2017 21:33:06 -0000 Subject: [GHC] #13203: Implement Bits Natural clearBit In-Reply-To: <044.036af31a947c4008bf1dfa61730885bd@haskell.org> References: <044.036af31a947c4008bf1dfa61730885bd@haskell.org> Message-ID: <059.c7b772737693b7cbd641bd583ec261bf@haskell.org> #13203: Implement Bits Natural clearBit -------------------------------------+------------------------------------- Reporter: dylex | Owner: supersven Type: bug | Status: merge Priority: high | Milestone: 8.2.2 Component: libraries/base | Version: 7.10.1 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 bgamari): An implementation of `clearBit` for `Natural` has been merged to `ghc-8.2` with 3de07dcf221548e73c3623a085cae99d0b519c8b. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 16 21:33:26 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 16 Oct 2017 21:33:26 -0000 Subject: [GHC] #9274: GHC panic with UnliftedFFITypes+CApiFFI In-Reply-To: <042.a93530e65a57f7e254d144435628d197@haskell.org> References: <042.a93530e65a57f7e254d144435628d197@haskell.org> Message-ID: <057.5ff13b6a818f3ebd796ad2f6f7aad211@haskell.org> #9274: GHC panic with UnliftedFFITypes+CApiFFI -------------------------------------+------------------------------------- Reporter: hvr | Owner: igloo Type: bug | Status: closed Priority: high | Milestone: 8.2.2 Component: Compiler | Version: 7.6.3 Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): phab:D4092 Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: merge => closed * resolution: => fixed Comment: Merged to `ghc-8.2` in 95c1feeb9ce9b2d6a9453dc4da148b80a5ddce3d. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 16 22:47:23 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 16 Oct 2017 22:47:23 -0000 Subject: [GHC] #14312: Head does not build on Windows with the default make config. In-Reply-To: <047.086b87bb9b3dcf2f7a921149fa31eda2@haskell.org> References: <047.086b87bb9b3dcf2f7a921149fa31eda2@haskell.org> Message-ID: <062.d3d5149a50e4376e38d1dd5855ee3bf3@haskell.org> #14312: Head does not build on Windows with the default make config. -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: Component: Build System | Version: 8.2.1 Resolution: | Keywords: Operating System: Windows | Architecture: Type of failure: Building GHC | Unknown/Multiple failed | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4080 Wiki Page: | -------------------------------------+------------------------------------- Comment (by Phyx-): OK, this is a problem, the real issue here if `capi`. In a foreign import such as `foreign import capi unsafe "HsBase.h tcsetattr"` the header can be a local or a system include. Which leaves is how to generate the includes. We'd need to use quoted paths to get local headers in the same folder, but then we won't be able to use system headers, however I don't see a way around it without a backwards incompatible change... @bgamari, what do you think. Is the cost worth the change here? Keep in mind this isn't Windows specific. You should get the same error on any system. Directory has been updated so we can just update the submodule to fix it. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 16 22:50:10 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 16 Oct 2017 22:50:10 -0000 Subject: [GHC] #14268: Implement Explicit Foralls Proposal In-Reply-To: <046.b2c6e5199adb1a263d1f797400e3472d@haskell.org> References: <046.b2c6e5199adb1a263d1f797400e3472d@haskell.org> Message-ID: <061.7dc20ed829ff617b48e4c536fa79daf7@haskell.org> #14268: Implement Explicit Foralls Proposal -------------------------------------+------------------------------------- Reporter: johnleo | Owner: johnleo Type: task | 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: #13809 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Description changed by johnleo: Old description: > Implement Richard Eisenberg's Explicit Foralls proposal. > https://github.com/ghc-proposals/ghc-proposals/pull/55 > > For details see the proposal: > https://github.com/goldfirere/ghc-proposals/blob/instance- > forall/proposals/0000-instance-foralls.rst New description: Implement Richard Eisenberg's Explicit Foralls proposal. https://github.com/ghc-proposals/ghc-proposals/pull/55 For details see the proposal: https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0007 -instance-foralls.rst -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 16 23:14:27 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 16 Oct 2017 23:14:27 -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.454c39a72ee18411f6708eedc5be96c7@haskell.org> #14329: GHC 8.2.1 segfaults while bootstrapping master -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: patch 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: | -------------------------------------+------------------------------------- Comment (by Ben Gamari ): In [changeset:"a69fa5441c944d7f74c76bdae9f3dd198007ee42/ghc" a69fa544/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="a69fa5441c944d7f74c76bdae9f3dd198007ee42" rts/posix: Ensure that memory commit succeeds Previously we wouldn't check that mmap would succeed. I suspect this may have been the cause of #14329. Test Plan: Validate under low-memory condition Reviewers: simonmar, austin, erikd Reviewed By: simonmar Subscribers: rwbarton, thomie GHC Trac Issues: #14329 Differential Revision: https://phabricator.haskell.org/D4075 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 16 23:14:27 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 16 Oct 2017 23:14:27 -0000 Subject: [GHC] #11262: Test print022: wrong stdout on powerpc64 In-Reply-To: <047.0409b41ca7e7566752abaefb0ae702eb@haskell.org> References: <047.0409b41ca7e7566752abaefb0ae702eb@haskell.org> Message-ID: <062.d98a2bd9f7c84e24ec61b29d97656da4@haskell.org> #11262: Test print022: wrong stdout on powerpc64 -------------------------------------+------------------------------------- Reporter: trommler | Owner: trommler Type: bug | Status: new Priority: normal | Milestone: 8.4.1 Component: GHCi | Version: 7.11 Resolution: | Keywords: Operating System: Linux | Architecture: powerpc64 Type of failure: Incorrect result | Test Case: print022 at runtime | Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Ben Gamari ): In [changeset:"d6c33da89b97d0d2a3b3b8f8077de8a09432d086/ghc" d6c33da/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="d6c33da89b97d0d2a3b3b8f8077de8a09432d086" RtClosureInspect: Fix inspecting Char# on 64-bit big-endian Char# is represented with a full machine word, whereas Char's Storable instance uses an Int32, so we can't just treat it like a single-element Char array. Instead, read it as an Int and use chr to turn it into a Char. This fixes Trac #11262. Reviewers: austin, hvr, bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie GHC Trac Issues: #11262 Differential Revision: https://phabricator.haskell.org/D4089 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 16 23:18:26 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 16 Oct 2017 23:18:26 -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.151f5b6e3ce54b7cdcda2997ed4b4b6e@haskell.org> #14329: GHC 8.2.1 segfaults while bootstrapping master -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: closed Priority: highest | Milestone: 8.2.2 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:D4075 Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: patch => closed * resolution: => fixed Comment: Merged to `ghc-8.2` as a69fa5441c944d7f74c76bdae9f3dd198007ee42. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 16 23:18:43 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 16 Oct 2017 23:18:43 -0000 Subject: [GHC] #11262: Test print022: wrong stdout on powerpc64 In-Reply-To: <047.0409b41ca7e7566752abaefb0ae702eb@haskell.org> References: <047.0409b41ca7e7566752abaefb0ae702eb@haskell.org> Message-ID: <062.5377bb790f0e48e466ccd677112cfb44@haskell.org> #11262: Test print022: wrong stdout on powerpc64 -------------------------------------+------------------------------------- Reporter: trommler | Owner: trommler Type: bug | Status: closed Priority: normal | Milestone: 8.4.1 Component: GHCi | Version: 7.11 Resolution: fixed | Keywords: Operating System: Linux | Architecture: powerpc64 Type of failure: Incorrect result | Test Case: print022 at runtime | Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: new => closed * resolution: => fixed -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 16 23:40:34 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 16 Oct 2017 23:40:34 -0000 Subject: [GHC] #14358: GHCi does not exit after heap overflow exception Message-ID: <050.f22467688913acefddf9501307369611@haskell.org> #14358: GHCi does not exit after heap overflow exception -------------------------------------+------------------------------------- Reporter: ferdinandvw | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- Start GHCi as follows `ghci +RTS -M20m` Enter the following {{{#!hs > let xs = [1..10^6] :: [Int] > Data.List.foldl' (+) 0 xs }}} This results in (as expected): `*** Exception: heap overflow` However, GHCi did not exit. Entering any expression will result in the above given exception. And if you try to reload GHCi the following panic error will be produced: {{{#!hs Ok, 0 modules loaded. ghc: panic! (the 'impossible' happened) (GHC version 8.2.1 for x86_64-unknown-linux): heap overflow Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug }}} I tried the same using GHC 7.10.3 and 8.0.2. In both cases GHCi would exit after the initial heap overflow exception. With 8.2.1 this does not happen. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 16 23:58:10 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 16 Oct 2017 23:58:10 -0000 Subject: [GHC] #14359: C-- pipeline/NCG fails to optimize simple repeated addition Message-ID: <046.bcdd65b59703128c3357fd202e0f128d@haskell.org> #14359: C-- pipeline/NCG fails to optimize simple repeated addition -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: new Priority: low | Milestone: Component: Compiler | Version: 8.2.1 Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: Runtime Unknown/Multiple | performance bug Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- While debugging #14346 I noticed some rather abhorrent code in a disassembly of the `newPinnedByteArray#` primop: {{{ Dump of assembler code for function stg_newPinnedByteArrayzh: 0x00000000004a8518 <+0>: mov 0x378(%r13),%rax 0x00000000004a851f <+7>: cmpq $0x0,0x10(%rax) 0x00000000004a8524 <+12>: je 0x4a8593 0x00000000004a8526 <+14>: mov 0x4f5730,%rax 0x00000000004a852e <+22>: mov 0x38(%rax),%rax 0x00000000004a8532 <+26>: cmp 0x4f5718,%rax 0x00000000004a853a <+34>: jae 0x4a8593 0x00000000004a853c <+36>: mov %rbx,%rax 0x00000000004a853f <+39>: lea 0x7(%rax),%rcx 0x00000000004a8543 <+43>: shr $0x3,%rcx 0x00000000004a8547 <+47>: add $0x10,%rax <--- starts here 0x00000000004a854b <+51>: add $0xf,%rax 0x00000000004a854f <+55>: add $0x7,%rax 0x00000000004a8553 <+59>: shr $0x3,%rax 0x00000000004a8557 <+63>: mov $0x49d820,%ecx }}} That is three successive `add` instructions; surely those should be collapsed into one by the Cmm-to-Cmm pipeline. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 16 23:58:32 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 16 Oct 2017 23:58:32 -0000 Subject: [GHC] #14359: C-- pipeline/NCG fails to optimize simple repeated addition In-Reply-To: <046.bcdd65b59703128c3357fd202e0f128d@haskell.org> References: <046.bcdd65b59703128c3357fd202e0f128d@haskell.org> Message-ID: <061.2d7843ad5010a568a8dc899cb3b46af1@haskell.org> #14359: C-- pipeline/NCG fails to optimize simple repeated addition -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: new Priority: low | Milestone: Component: Compiler | Version: 8.2.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Description changed by bgamari: Old description: > While debugging #14346 I noticed some rather abhorrent code in a > disassembly of the `newPinnedByteArray#` primop: > {{{ > Dump of assembler code for function stg_newPinnedByteArrayzh: > 0x00000000004a8518 <+0>: mov 0x378(%r13),%rax > 0x00000000004a851f <+7>: cmpq $0x0,0x10(%rax) > 0x00000000004a8524 <+12>: je 0x4a8593 > > 0x00000000004a8526 <+14>: mov 0x4f5730,%rax > 0x00000000004a852e <+22>: mov 0x38(%rax),%rax > 0x00000000004a8532 <+26>: cmp 0x4f5718,%rax > 0x00000000004a853a <+34>: jae 0x4a8593 > > 0x00000000004a853c <+36>: mov %rbx,%rax > 0x00000000004a853f <+39>: lea 0x7(%rax),%rcx > 0x00000000004a8543 <+43>: shr $0x3,%rcx > 0x00000000004a8547 <+47>: add $0x10,%rax <--- starts here > 0x00000000004a854b <+51>: add $0xf,%rax > 0x00000000004a854f <+55>: add $0x7,%rax > 0x00000000004a8553 <+59>: shr $0x3,%rax > 0x00000000004a8557 <+63>: mov $0x49d820,%ecx > }}} > That is three successive `add` instructions; surely those should be > collapsed into one by the Cmm-to-Cmm pipeline. New description: While debugging #14346 I noticed some rather abhorrent code in a disassembly of the `newPinnedByteArray#` primop: {{{ Dump of assembler code for function stg_newPinnedByteArrayzh: 0x00000000004a8518 <+0>: mov 0x378(%r13),%rax 0x00000000004a851f <+7>: cmpq $0x0,0x10(%rax) 0x00000000004a8524 <+12>: je 0x4a8593 0x00000000004a8526 <+14>: mov 0x4f5730,%rax 0x00000000004a852e <+22>: mov 0x38(%rax),%rax 0x00000000004a8532 <+26>: cmp 0x4f5718,%rax 0x00000000004a853a <+34>: jae 0x4a8593 0x00000000004a853c <+36>: mov %rbx,%rax 0x00000000004a853f <+39>: lea 0x7(%rax),%rcx 0x00000000004a8543 <+43>: shr $0x3,%rcx 0x00000000004a8547 <+47>: add $0x10,%rax <--- starts here 0x00000000004a854b <+51>: add $0xf,%rax 0x00000000004a854f <+55>: add $0x7,%rax 0x00000000004a8553 <+59>: shr $0x3,%rax 0x00000000004a8557 <+63>: mov $0x49d820,%ecx ... }}} That is three successive `add` instructions; surely those should be collapsed into one by the Cmm-to-Cmm pipeline. -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 17 01:26:16 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 17 Oct 2017 01:26:16 -0000 Subject: [GHC] #14312: Head does not build on Windows with the default make config. In-Reply-To: <047.086b87bb9b3dcf2f7a921149fa31eda2@haskell.org> References: <047.086b87bb9b3dcf2f7a921149fa31eda2@haskell.org> Message-ID: <062.266dd92c8247112ad8351c4f73fd6a28@haskell.org> #14312: Head does not build on Windows with the default make config. -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: Component: Build System | Version: 8.3 Resolution: | Keywords: Operating System: Windows | Architecture: Type of failure: Building GHC | Unknown/Multiple failed | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4080 Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * cc: hvr (added) * version: 8.2.1 => 8.3 Comment: > Is the cost worth the change here? What is the change being proposed here? Teaching `capi` to use `#include "header.h"` instead of `#include `? CCing hvr who knows a fair amount about `capi`. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 17 03:09:29 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 17 Oct 2017 03:09:29 -0000 Subject: [GHC] #14333: GHC doesn't use the fact that Coercible is symmetric In-Reply-To: <051.317ebc999077ee18339a9e5fa0ad5d1c@haskell.org> References: <051.317ebc999077ee18339a9e5fa0ad5d1c@haskell.org> Message-ID: <066.8071bf8fc716098f298e704f963717b1@haskell.org> #14333: GHC doesn't use the fact that Coercible is symmetric -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: | Keywords: TypeFamilies, | 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 Iceland_jack): * Attachment "SelfContained.hs" added. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 17 03:13:20 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 17 Oct 2017 03:13:20 -0000 Subject: [GHC] #14333: GHC doesn't use the fact that Coercible is symmetric In-Reply-To: <051.317ebc999077ee18339a9e5fa0ad5d1c@haskell.org> References: <051.317ebc999077ee18339a9e5fa0ad5d1c@haskell.org> Message-ID: <066.520da3bef9e92d6ed27a3deb26103d92@haskell.org> #14333: GHC doesn't use the fact that Coercible is symmetric -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: | Keywords: TypeFamilies, | 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 attached an example, I found another need for this: encoding that the opposite category is coercible to the current: {{{#!hs type Cat obj = obj -> obj -> Type class (forall xx yy. Coercible (cat xx yy) (Op cat yy xx)) => Category (cat :: Cat obj) where type Op cat :: Cat obj }}} The use case is similar as the other one but I can elaborate if needed -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 17 04:20:04 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 17 Oct 2017 04:20:04 -0000 Subject: [GHC] #14360: traceM documentation not clear (and possibly incorrect) Message-ID: <051.5b22f6cea7eb7c70df5ec04d18196320@haskell.org> #14360: traceM documentation not clear (and possibly incorrect) -------------------------------------+------------------------------------- Reporter: saurabhnanda | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Core | Version: 8.0.2 Libraries | Keywords: docs | 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 code-example and the accompanying text at https://www.stackage.org/haddock/lts-9.0/base-4.9.1.0/Debug- Trace.html#v:traceM are out of sync. Also, it's not very clear what the following line means: > Note that the application of traceM is not an action in the Applicative context, as traceIO is in the IO type. I realised something was wrong when, during a refactor, I ended up with the equivalent of the following loop, which caused a thread to completely freeze and become unresponsive: > forever $ traceShowM "something" -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 17 05:33:48 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 17 Oct 2017 05:33:48 -0000 Subject: [GHC] #14359: C-- pipeline/NCG fails to optimize simple repeated addition In-Reply-To: <046.bcdd65b59703128c3357fd202e0f128d@haskell.org> References: <046.bcdd65b59703128c3357fd202e0f128d@haskell.org> Message-ID: <061.62a223cb34d0f31922744dac5c52d7cc@haskell.org> #14359: C-- pipeline/NCG fails to optimize simple repeated addition -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: new Priority: low | Milestone: Component: Compiler | Version: 8.2.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by alexbiehl): Actually compiling `PrimOps.cmm` with `-O` already results in the desired constant folding: {{{ $ ghc -ddump-asm -c rts/PrimOps.cmm | less ... stg_newPinnedByteArrayzh: _cv: movq 888(%r13),%rax cmpq $0,16(%rax) je _cl _cn: movq g0 at GOTPCREL(%rip),%rax movq (%rax),%rax movq 56(%rax),%rax movq large_alloc_lim at GOTPCREL(%rip),%rcx cmpq (%rcx),%rax jae _cl _co: subq $8,%rsp leaq -24(%r13),%rax leaq 38(%rbx),%rsi <- see here shrq $3,%rsi movq %rax,%rdi xorl %eax,%eax call allocatePinned addq $8,%rsp testq %rax,%rax ... }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 17 06:41:13 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 17 Oct 2017 06:41:13 -0000 Subject: [GHC] #14312: Head does not build on Windows with the default make config. In-Reply-To: <047.086b87bb9b3dcf2f7a921149fa31eda2@haskell.org> References: <047.086b87bb9b3dcf2f7a921149fa31eda2@haskell.org> Message-ID: <062.efbc548fa5f959730d93d30368f33a76@haskell.org> #14312: Head does not build on Windows with the default make config. -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: Component: Build System | Version: 8.3 Resolution: | Keywords: Operating System: Windows | Architecture: Type of failure: Building GHC | Unknown/Multiple failed | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4080 Wiki Page: | -------------------------------------+------------------------------------- Comment (by Phyx-): Well, the proposal is more to not add the current file's folder implicitly to the include list. Make it an implicit choice. Looking at the options, maybe `-isystem` or `-idirafter` would work. Will have to test. But if not, think we should drop adding the path. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 17 10:18:32 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 17 Oct 2017 10:18:32 -0000 Subject: [GHC] #14361: GHC HEAD miscompiles `text-containers` Message-ID: <042.4be1bbae1efce089b6c1063178d01328@haskell.org> #14361: GHC HEAD miscompiles `text-containers` -------------------------------------+------------------------------------- Reporter: hvr | Owner: (none) Type: bug | Status: new Priority: high | Milestone: 8.4.1 Component: Compiler | Version: 8.3 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: -------------------------------------+------------------------------------- When compiling and running `text-containers`'s test-suite, the test-cases involving lookup functions (e.g. `member :: Key -> TextSet -> Bool`) fail indeterministically. ''more details to follow'' -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 17 10:37:10 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 17 Oct 2017 10:37:10 -0000 Subject: [GHC] #7258: Compiling DynFlags is jolly slow In-Reply-To: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> References: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> Message-ID: <061.ff4702f9b149d142abfa0ae28868034f@haskell.org> #7258: Compiling DynFlags is jolly slow -------------------------------------+------------------------------------- Reporter: simonpj | Owner: simonpj Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.6.1 Resolution: | Keywords: deriving-perf 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): This commit: http://git.haskell.org/ghc.git/commitdiff/19a2ba3ea436b60466fc4022f53a6631e41b87a5 ...reduces complexity in register allocation spilling from quadratic to logarithmic. The old version would run a carthesian product on the list of allocated registers (`assig`) and the list of registers to `keep`; the new version uses set operations instead, based on `UniqSet` / `UniqFW`. I've also moved things around a little to pre-filter the list of allocations to only include the interesting entries in the first place, reducing the number of list items from linear to (as far as I can tell) constant. I believe there are further optimization opportunities here, such as: - changing the current list-based code to also use set/map operations - moving the register class check into the `candidates` part - precalculating the list of candidates (not sure about this one though) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 17 10:39:09 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 17 Oct 2017 10:39:09 -0000 Subject: [GHC] #7258: Compiling DynFlags is jolly slow In-Reply-To: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> References: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> Message-ID: <061.2c8e801dee161584c1a40328cf1ba772@haskell.org> #7258: Compiling DynFlags is jolly slow -------------------------------------+------------------------------------- Reporter: simonpj | Owner: simonpj Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.6.1 Resolution: | Keywords: deriving-perf 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): http://git.haskell.org/ghc.git/commitdiff/375d4bd0fc2afd72617bc827bf63b5eeb24f2f7c This one makes crucial parts of the pretty-printing code stricter; the modified functions score better in profiling, but the overall effect on compilation times seems to be minimal. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 17 10:45:27 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 17 Oct 2017 10:45:27 -0000 Subject: [GHC] #14361: GHC HEAD miscompiles `text-containers` In-Reply-To: <042.4be1bbae1efce089b6c1063178d01328@haskell.org> References: <042.4be1bbae1efce089b6c1063178d01328@haskell.org> Message-ID: <057.8222241c63548d6902cbef8617f1f37e@haskell.org> #14361: GHC HEAD miscompiles `text-containers` -------------------------------------+------------------------------------- Reporter: hvr | 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: Incorrect result | Unknown/Multiple at runtime | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Description changed by hvr: Old description: > When compiling and running `text-containers`'s test-suite, the test-cases > involving lookup functions (e.g. `member :: Key -> TextSet -> Bool`) fail > indeterministically. > > ''more details to follow'' New description: When compiling and running `text-containers`'s test-suite, the test-cases involving lookup functions (e.g. `member :: Key -> TextSet -> Bool`) fail indeterministically. NB: The code in question works perfectly for GHC 7.10.3/8.0.2/8.2.1; and I've also verified this isn't related to the new `compareByteArray#` primop; in fact you get the very same failures if you force `text- containers` to use the memcmp FFI (by editing the respective `if` conditional in the .cabal file). Repro instructions (sorry, haven't had time to minimize it yet): {{{#!sh # get wip/ghc-T14361 branch of `text-containers` git clone https://github.com/hvr/text-containers.git -b wip/ghc-T14361 cd text-containers/ # generate cabal.project.local cat > cabal.project.local < GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 17 10:54:45 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 17 Oct 2017 10:54:45 -0000 Subject: [GHC] #7258: Compiling DynFlags is jolly slow In-Reply-To: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> References: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> Message-ID: <061.fbcfd9331cf3528242965ba02c614a24@haskell.org> #7258: Compiling DynFlags is jolly slow -------------------------------------+------------------------------------- Reporter: simonpj | Owner: simonpj Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.6.1 Resolution: | Keywords: deriving-perf 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 heisenbug): Replying to [comment:33 tdammers]: > This commit: > > http://git.haskell.org/ghc.git/commitdiff/19a2ba3ea436b60466fc4022f53a6631e41b87a5 > > ...reduces complexity in register allocation spilling from quadratic to logarithmic. The old version would run a carthesian product on the list of allocated registers (`assig`) and the list of registers to `keep`; the new version uses set operations instead, based on `UniqSet` / `UniqFW`. I've also moved things around a little to pre-filter the list of allocations to only include the interesting entries in the first place, reducing the number of list items from linear to (as far as I can tell) constant. Hmmm, what do you think about having the cartesian product for a smaller cut-off size? Manipulating the sets surely also has a (large) constant factor built-in. > > I believe there are further optimization opportunities here, such as: > > - changing the current list-based code to also use set/map operations > - moving the register class check into the `candidates` part > - precalculating the list of candidates (not sure about this one though) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 17 12:50:48 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 17 Oct 2017 12:50:48 -0000 Subject: [GHC] #14361: GHC HEAD miscompiles `text-containers` In-Reply-To: <042.4be1bbae1efce089b6c1063178d01328@haskell.org> References: <042.4be1bbae1efce089b6c1063178d01328@haskell.org> Message-ID: <057.77a9ad792043e6579a131ffcf04c3526@haskell.org> #14361: GHC HEAD miscompiles `text-containers` -------------------------------------+------------------------------------- Reporter: hvr | 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: Incorrect result | Unknown/Multiple at runtime | 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 Oct 17 12:51:32 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 17 Oct 2017 12:51:32 -0000 Subject: [GHC] #8281: The impossible happened: primRepToFFIType In-Reply-To: <044.47e20917996e473150de04c1ce1afc0b@haskell.org> References: <044.47e20917996e473150de04c1ce1afc0b@haskell.org> Message-ID: <059.303d060b781e5b4f7e950a218756713f@haskell.org> #8281: The impossible happened: primRepToFFIType -------------------------------------+------------------------------------- Reporter: tibbe | Owner: (none) Type: bug | Status: new Priority: high | Milestone: 8.4.1 Component: Compiler | Version: 7.6.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D3619 Wiki Page: | -------------------------------------+------------------------------------- Changes (by angerman): * cc: angerman (added) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 17 13:18:14 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 17 Oct 2017 13:18:14 -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.78df0b60476b10fe78870121f69dfa7e@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 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Fuuzetsu): I hit this today on 8.2.1. This is on a proprietary project so I am unable to provide any substantial code to aid debugging this. Below is a highly inefficient program which re-sequences .hp so that you can at least use the data. {{{#!hs {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} module Main (main) where import Control.Monad (guard) import Data.Attoparsec.Combinator as P import Data.Attoparsec.Text as P import Data.List (sort) import Data.Monoid ((<>)) import Data.Text as T import qualified Data.Text.IO as T import System.Environment (getArgs) import System.Exit (exitFailure) import System.IO (hPutStrLn, stderr) data Sample = Sample !Double ![Text] deriving (Eq) instance Ord Sample where compare (Sample x _) (Sample y _) = compare x y data F = F ![Text] ![Sample] parseF :: Parser F parseF = do ls <- P.manyTill (P.takeTill isEndOfLine <* endOfLine) (P.lookAhead "BEGIN_SAMPLE") s <- P.many' parseSample pure $! F ls s parseSample :: Parser Sample parseSample = do s <- "BEGIN_SAMPLE " *> double <* endOfLine let endSample = do es <- "END_SAMPLE " *> double <* endOfLine guard (es == s) l = P.takeTill isEndOfLine <* endOfLine ls <- P.manyTill l endSample pure $! Sample s ls renderSample :: Sample -> Text renderSample (Sample d ls) = T.unlines $ ("BEGIN_SAMPLE " <> T.pack (show d)) : ls ++ [ "END_SAMPLE " <> T.pack (show d) ] main :: IO () main = getArgs >>= \case [input, output] -> do c <- T.readFile input case parseOnly parseF c of Left err -> do hPutStrLn stderr ("Parse failed: " <> err) exitFailure Right (F startLines samples) -> do let s' = T.concat . Prelude.map renderSample $ sort samples T.writeFile output (T.unlines startLines <> s') _ -> do hPutStrLn stderr "usage: fix-hp inputFile outputFile" exitFailure }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 17 13:22:10 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 17 Oct 2017 13:22:10 -0000 Subject: [GHC] #14347: Top-level RecordWildCards no longer working. In-Reply-To: <047.9d7d4bc51f0d30fd962b21bdfacfc205@haskell.org> References: <047.9d7d4bc51f0d30fd962b21bdfacfc205@haskell.org> Message-ID: <062.66a7e1ded305d242aae629241e0b5ba6@haskell.org> #14347: Top-level RecordWildCards no longer working. -------------------------------------+------------------------------------- Reporter: Fuuzetsu | 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): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Fuuzetsu): I highly dislike {{{RecordWildCards}}} and find its usage at the top-level especially disgusting though I know some that would disagree. *Personally* I am happy to not have this mis-feature but would like to request that the change is documented in GHC docs in the section about the extension. If that's done, please feel free to close the ticket, thanks! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 17 13:27:41 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 17 Oct 2017 13:27:41 -0000 Subject: [GHC] #14361: GHC HEAD miscompiles `text-containers` In-Reply-To: <042.4be1bbae1efce089b6c1063178d01328@haskell.org> References: <042.4be1bbae1efce089b6c1063178d01328@haskell.org> Message-ID: <057.dbd426697ae1150fe36b34d22a244f39@haskell.org> #14361: GHC HEAD miscompiles `text-containers` -------------------------------------+------------------------------------- Reporter: hvr | 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: Incorrect result | Unknown/Multiple at runtime | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): For better or worse I am able to reproduce this. Hrmph. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 17 13:29:50 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 17 Oct 2017 13:29:50 -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.8ae58a776bf476a2f7d30b47e47db32d@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 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by angerman): Ohh, i'm super sorry, not to have attached my reorder script. {{{#!haskell {-# LANGUAGE LambdaCase #-} import System.Environment (getArgs) import Data.List (mapAccumL, isPrefixOf) import GHC.Exts (sortWith) main :: IO () main = getArgs >>= \case [f] -> readFile f >>= pure . unlines . reorder . lines >>= putStr _ -> putStrLn $ "only one input" reorder :: [String] -> [String] reorder = map snd . sortWith fst . snd . mapAccumL f (-1.0) where g :: (Double, String) -> (Double, (Double, String)) g (x,y) = (x,(x,y)) f :: Double -> String -> (Double, (Double, String)) f acc line | "BEGIN_SAMPLE " `isPrefixOf` line = g (read $ drop 13 line, line) | "END_SAMPLE " `isPrefixOf` line && (read $ drop 11 line) /= acc = error "BEING/END missmatch" | otherwise = g (acc, line) }}} Could have saved someone else some time :( However, the generated output still looks rather garbled. [[Image(https://dl.dropbox.com/s/yz5d5ug656mziun/Screenshot%202017-10-03%2017.15.58.png)]] did you observe the same Fuuzetsu? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 17 13:38:00 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 17 Oct 2017 13:38:00 -0000 Subject: [GHC] #14358: GHCi does not exit after heap overflow exception In-Reply-To: <050.f22467688913acefddf9501307369611@haskell.org> References: <050.f22467688913acefddf9501307369611@haskell.org> Message-ID: <065.9b0174483c64791340b732fd36ec9327@haskell.org> #14358: GHCi does not exit after heap overflow exception --------------------------------+---------------------------------------- Reporter: ferdinandvw | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: GHCi | Version: 8.2.1 Resolution: | Keywords: Operating System: Linux | Architecture: Unknown/Multiple Type of failure: GHCi crash | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | --------------------------------+---------------------------------------- Changes (by ferdinandvw): * failure: None/Unknown => GHCi crash * component: Compiler => GHCi * os: Unknown/Multiple => Linux -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 17 13:47:00 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 17 Oct 2017 13:47:00 -0000 Subject: [GHC] #14361: GHC HEAD miscompiles `text-containers` In-Reply-To: <042.4be1bbae1efce089b6c1063178d01328@haskell.org> References: <042.4be1bbae1efce089b6c1063178d01328@haskell.org> Message-ID: <057.8f92c7eada1626a3a36ad8937432790b@haskell.org> #14361: GHC HEAD miscompiles `text-containers` -------------------------------------+------------------------------------- Reporter: hvr | 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: Incorrect result | Unknown/Multiple at runtime | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): Thankfully the failure is independent of GC frequency, which should make debugging easier. I'm going to finish up #14346 before diving into this though. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 17 14:19:49 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 17 Oct 2017 14:19:49 -0000 Subject: [GHC] #14362: Allow: Coercing (a:~:b) to (b:~:a) Message-ID: <051.de7b972e40c6148c97cf4a6c5f8259b3@haskell.org> #14362: Allow: Coercing (a:~:b) to (b:~:a) -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: feature | Status: new request | Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Keywords: roles | Operating System: Unknown/Multiple Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- Is there *any* sensible way to enable coercing [https://hackage.haskell.org/package/base-4.10.0.0/docs/Data-Type- Equality.html#t::-126-: (:~:)] swapping its arguments {{{#!hs coerce :: a:~:b -> b:~:a }}} Same for [https://hackage.haskell.org/package/base-4.10.0.0/docs/Data- Type-Coercion.html#t:Coercion Coercion] {{{#!hs coerce :: Coercion a b -> Coercion b a }}} Thanks! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 17 14:22:42 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 17 Oct 2017 14:22:42 -0000 Subject: [GHC] #14362: Allow: Coercing (a:~:b) to (b:~:a) In-Reply-To: <051.de7b972e40c6148c97cf4a6c5f8259b3@haskell.org> References: <051.de7b972e40c6148c97cf4a6c5f8259b3@haskell.org> Message-ID: <066.b634190705a6c710d480f9cd859a635c@haskell.org> #14362: Allow: Coercing (a:~:b) to (b:~:a) -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 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): Where the compiler knows constraints (`(~)` and `Coercible`) are symmetric -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 17 14:35:52 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 17 Oct 2017 14:35:52 -0000 Subject: [GHC] #14362: Allow: Coercing (a:~:b) to (b:~:a) In-Reply-To: <051.de7b972e40c6148c97cf4a6c5f8259b3@haskell.org> References: <051.de7b972e40c6148c97cf4a6c5f8259b3@haskell.org> Message-ID: <066.f436ea2a1db2f2ae3378f4be8a9c7a9c@haskell.org> #14362: Allow: Coercing (a:~:b) to (b:~:a) -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 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): Reminder {{{ data Coercion a b where Coercion :: Coercible a b => Coercion a b data a :~: b where Refl :: a :~: a }}} So you want to be able to prove {{{ [W] (a :~: b) ~R# (b :~: a) [W] Coercible a b ~R# Coercible b a }}} Once could imagine special cases in the compiler, these are really perfectly ordinary data type declarations. What makes these representational type equalities true? Well, representationally speaking * `Refl :: (a ~# b) => a :~: b` has no represented value arguments. I suppose that for such types it's true that `(a :~: b) ~R# (c :~: d)` for any `a, b, c, d`. Is that right? Let's think about that first; I expect that once we figure this one out, `Coercible` will follow. Richard? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 17 14:38:20 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 17 Oct 2017 14:38:20 -0000 Subject: [GHC] #7258: Compiling DynFlags is jolly slow In-Reply-To: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> References: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> Message-ID: <061.c553bca5663dc84ca0b57ab2fdd4f834@haskell.org> #7258: Compiling DynFlags is jolly slow -------------------------------------+------------------------------------- Reporter: simonpj | Owner: simonpj Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.6.1 Resolution: | Keywords: deriving-perf 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 heisenbug]: > Replying to [comment:33 tdammers]: > > This commit: > > > > http://git.haskell.org/ghc.git/commitdiff/19a2ba3ea436b60466fc4022f53a6631e41b87a5 > > > > ...reduces complexity in register allocation spilling from quadratic to logarithmic. The old version would run a carthesian product on the list of allocated registers (`assig`) and the list of registers to `keep`; the new version uses set operations instead, based on `UniqSet` / `UniqFW`. I've also moved things around a little to pre-filter the list of allocations to only include the interesting entries in the first place, reducing the number of list items from linear to (as far as I can tell) constant. > > Hmmm, what do you think about having the cartesian product for a smaller cut-off size? Manipulating the sets surely also has a (large) constant factor built-in. Could be worth it, but I'm a bit skeptical - the additional overhead of unpacking the sets into lists could easily cancel out the performance benefit, and it would make the code more complicated. I'll give it a try though. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 17 15:36:59 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 17 Oct 2017 15:36:59 -0000 Subject: [GHC] #14333: GHC doesn't use the fact that Coercible is symmetric In-Reply-To: <051.317ebc999077ee18339a9e5fa0ad5d1c@haskell.org> References: <051.317ebc999077ee18339a9e5fa0ad5d1c@haskell.org> Message-ID: <066.785e032b8a207716532c858273e58531@haskell.org> #14333: GHC doesn't use the fact that Coercible is symmetric -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: | Keywords: TypeFamilies, | 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): I found I could do this quite easily. (I happened to be in the area.) Patch coming. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 17 16:30:07 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 17 Oct 2017 16:30:07 -0000 Subject: [GHC] #14363: :type hangs on coerce Message-ID: <051.a5d2467b66df31be8b2c92e458401ba5@haskell.org> #14363: :type hangs on coerce -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- This works {{{ ghci -ignore-dot-ghci GHCi, version 8.2.1: http://www.haskell.org/ghc/ :? for help Prelude> import Data.Coerce Prelude Data.Coerce> :t [fmap, coerce] :1:8: error: • Occurs check: cannot construct the infinite type: b ~ f b arising from a use of ‘coerce’ • In the expression: coerce In the expression: [fmap, coerce] }}} But doing it with `contra` {{{ Prelude Data.Coerce> contra = undefined :: Functor f => (b -> a) -> (f a -> f b) }}} it hangs {{{ Prelude Data.Coerce> :t [coerce, contra] ^CInterrupted. Prelude Data.Coerce> :t [contra, coerce] ^CInterrupted. }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 17 16:30:24 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 17 Oct 2017 16:30:24 -0000 Subject: [GHC] #14363: :type hangs on coerce In-Reply-To: <051.a5d2467b66df31be8b2c92e458401ba5@haskell.org> References: <051.a5d2467b66df31be8b2c92e458401ba5@haskell.org> Message-ID: <066.f6b06cdcf0ea1886e690738b412a86f1@haskell.org> #14363: :type hangs on coerce -------------------------------------+------------------------------------- Reporter: Iceland_jack | 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): Wiki Page: | -------------------------------------+------------------------------------- Description changed by Iceland_jack: Old description: > This works > > {{{ > ghci -ignore-dot-ghci > GHCi, version 8.2.1: http://www.haskell.org/ghc/ :? for help > Prelude> import Data.Coerce > Prelude Data.Coerce> :t [fmap, coerce] > > :1:8: error: > • Occurs check: cannot construct the infinite type: b ~ f b > arising from a use of ‘coerce’ > • In the expression: coerce > In the expression: [fmap, coerce] > > }}} > > But doing it with `contra` > > {{{ > Prelude Data.Coerce> contra = undefined :: Functor f => (b -> a) -> (f a > -> f b) > }}} > > it hangs > > {{{ > Prelude Data.Coerce> :t [coerce, contra] > ^CInterrupted. > Prelude Data.Coerce> :t [contra, coerce] > ^CInterrupted. > }}} New description: This works {{{ $ ghci -ignore-dot-ghci GHCi, version 8.2.1: http://www.haskell.org/ghc/ :? for help Prelude> import Data.Coerce Prelude Data.Coerce> :t [fmap, coerce] :1:8: error: • Occurs check: cannot construct the infinite type: b ~ f b arising from a use of ‘coerce’ • In the expression: coerce In the expression: [fmap, coerce] }}} But doing it with `contra` {{{ Prelude Data.Coerce> contra = undefined :: Functor f => (b -> a) -> (f a -> f b) }}} it hangs {{{ Prelude Data.Coerce> :t [coerce, contra] ^CInterrupted. Prelude Data.Coerce> :t [contra, coerce] ^CInterrupted. }}} -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 17 16:38:15 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 17 Oct 2017 16:38:15 -0000 Subject: [GHC] #14361: GHC HEAD miscompiles `text-containers` In-Reply-To: <042.4be1bbae1efce089b6c1063178d01328@haskell.org> References: <042.4be1bbae1efce089b6c1063178d01328@haskell.org> Message-ID: <057.7e98f1787887745fccec2b6fdbae9809@haskell.org> #14361: GHC HEAD miscompiles `text-containers` -------------------------------------+------------------------------------- Reporter: hvr | 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: Incorrect result | Unknown/Multiple at runtime | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by hvr): To make things easier, here's a smaller repro-case which doesn't require building the test-suite of `text-containers`: {{{#!hs {-# LANGUAGE OverloadedLists #-} {-# LANGUAGE OverloadedStrings #-} module Main where import Control.Monad import qualified Data.List as List import Data.String import qualified Data.TextSet.Unboxed as TS main :: IO () main = do putStrLn "START" forM_ ([ 0 .. 10 ] :: [Int]) $ \_ -> do forM_ (zip [ 1::Int .. ] (List.inits testData)) $ \(j,xs) -> do unless (all (`TS.member` (TS.fromList xs)) xs) $ putStr (show j ++ " ") forM_ (zip [ 1::Int .. ] (List.tails testData)) $ \(j,xs) -> do unless (all (`TS.member` (TS.fromList xs)) xs) $ putStr (show (-j) ++ " ") putStrLn "" putStrLn "DONE" return () testData :: [TS.Key] testData = [ fromString [c] | c <- ['A' .. 'Z'] ] }}} If you have Cabal 2.1+, you can simply use its generated GHC environment file via {{{ # solve & build *only* the library component, and generate .ghc.environment.* file $ cabal new-build lib:text-containers --disable-tests -w ghc-8.3.20171016 # build test program $ ghc-8.3.20171016 --make -Wall -O1 bug-t14361.hs [1 of 1] Compiling Main ( bug-t14361.hs, bug-t14361.o ) Linking bug-t14361 ... # run test program $ ./bug-t14361 START 22 -2 -23 -3 -1 26 -1 -15 11 12 13 -8 7 15 18 -11 19 -2 -1 26 -1 26 -1 DONE }}} If the program was executed correctly the output would have no numbers, i.e. it would look like {{{ START DONE }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 17 16:41:17 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 17 Oct 2017 16:41:17 -0000 Subject: [GHC] #14363: :type hangs on coerce In-Reply-To: <051.a5d2467b66df31be8b2c92e458401ba5@haskell.org> References: <051.a5d2467b66df31be8b2c92e458401ba5@haskell.org> Message-ID: <066.e3ee3409fbe3034d5c350ec1ddb01a9d@haskell.org> #14363: :type hangs on coerce -------------------------------------+------------------------------------- Reporter: Iceland_jack | 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): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Iceland_jack): `Functor` constraint not needed to make it hang {{{ Prelude Data.Coerce> contra = undefined :: (a -> b) -> (f b -> f a) Prelude Data.Coerce> :t [contra, coerce] ^CInterrupted. }}} Giving it a concrete type gives an actual failure {{{ Prelude Data.Coerce> contra = undefined :: (a -> b) -> (Maybe b -> Maybe a) Prelude Data.Coerce> :t [contra, coerce] :1:10: error: • Occurs check: cannot construct the infinite type: b ~ Maybe (Maybe b) arising from a use of ‘coerce’ • In the expression: coerce In the expression: [contra, coerce] }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 17 16:50:33 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 17 Oct 2017 16:50:33 -0000 Subject: [GHC] #14364: Reduce repetition in derived Read instances Message-ID: <046.9abf8af51367f0badd76eab5f23e3eb1@haskell.org> #14364: Reduce repetition in derived Read instances -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: task | Status: new Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.2.1 Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: #10980 #7258 Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- While looking at #7258 with tdammers, I noticed that 5000 of the 7000 terms that the `W2` module simplifies to are attributed to `$creadPrec`. In fact, much of this is repetition of the form, {{{#!hs (GHC.Read.expectP (Text.Read.Lex.Ident (GHC.CString.unpackCString# "field1"#))) (>> @ Text.ParserCombinators.ReadPrec.ReadPrec Text.ParserCombinators.ReadPrec.$fMonadReadPrec @ () @ DT (GHC.Read.expectP (Text.Read.Lex.Punc (GHC.CString.unpackCString# "="#))) (>>= @ Text.ParserCombinators.ReadPrec.ReadPrec Text.ParserCombinators.ReadPrec.$fMonadReadPrec @ Int @ DT (Text.ParserCombinators.ReadPrec.reset @ Int (GHC.Read.readPrec @ Int GHC.Read.$fReadInt)) (\ (a1_a1oe :: Int) -> >> @ Text.ParserCombinators.ReadPrec.ReadPrec Text.ParserCombinators.ReadPrec.$fMonadReadPrec @ () @ DT (GHC.Read.expectP (Text.Read.Lex.Punc (GHC.CString.unpackCString# ","#))) }}} Let's factor this pattern out into a `readField` helper in `GHC.Read`, {{{#!hs readField :: String -> ReadPrec a -> ReadPrec a readField fieldName readVal = do expectP (Ident fieldName) expectP (Punc "=") readVal {-# NOINLINE readField #-} }}} This will at least knock off a constant factor from the size of what should not be performance-critical code. We could also try folding the terminal "," into this, although then we would need to somehow handle the last field specially. This might not be worth it. Perhaps instead just factor out the comma case as well, {{{#!hs readComma :: ReadPrec () readComma = expectP (Punc ",") {-# NOINLINE readField #-} }}} It's unclear whether this is worth it, however. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 17 16:51:40 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 17 Oct 2017 16:51:40 -0000 Subject: [GHC] #10980: Deriving Read instance from datatype with N fields leads to N^2 code size growth In-Reply-To: <045.4946614216cb9413670db0e02815dfbc@haskell.org> References: <045.4946614216cb9413670db0e02815dfbc@haskell.org> Message-ID: <060.69263beec1c96c05cb5851ea04f9d2f4@haskell.org> #10980: Deriving Read instance from datatype with N fields leads to N^2 code size growth -------------------------------------+------------------------------------- Reporter: slyfox | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.10.2 Resolution: | Keywords: deriving-perf Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: #13213 #14364 | Differential Rev(s): #7258 | Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * related: => #13213 #14364 #7258 Comment: See also: #14364, which tries to knock a factor off of the code size of derived `Read` instances. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 17 16:52:11 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 17 Oct 2017 16:52:11 -0000 Subject: [GHC] #7258: Compiling DynFlags is jolly slow In-Reply-To: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> References: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> Message-ID: <061.6a67b4e3e2314768ae600ff6a5e4c6a6@haskell.org> #7258: Compiling DynFlags is jolly slow -------------------------------------+------------------------------------- Reporter: simonpj | Owner: simonpj Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.6.1 Resolution: | Keywords: deriving-perf 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): While chatting with tdammers about this I had a peek at the core; it seems that 5000 terms of the 7000 terms in the simplified core of `W2` are in `creadPrec_rdaO`. Moreover, much of this is repetition. I've proposed an approach for dealing with this in #14364. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 17 16:56:57 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 17 Oct 2017 16:56:57 -0000 Subject: [GHC] #7258: Compiling DynFlags is jolly slow In-Reply-To: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> References: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> Message-ID: <061.8b63942bbc50c674b553e497d6de0745@haskell.org> #7258: Compiling DynFlags is jolly slow -------------------------------------+------------------------------------- Reporter: simonpj | Owner: simonpj Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.6.1 Resolution: | Keywords: deriving-perf 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 dterei): * cc: dterei (removed) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 17 18:26:25 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 17 Oct 2017 18:26:25 -0000 Subject: [GHC] #7258: Compiling DynFlags is jolly slow In-Reply-To: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> References: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> Message-ID: <061.d6b4e746fb22913c4729260f3f0793fa@haskell.org> #7258: Compiling DynFlags is jolly slow -------------------------------------+------------------------------------- Reporter: simonpj | Owner: simonpj Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.6.1 Resolution: | Keywords: deriving-perf 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): > Hmmm, what do you think about having the cartesian product for a smaller cut-off size? Manipulating the sets surely also has a (large) constant factor built-in. I actually suspected this in the past, but dfeuer did some measurements in the context of `ListSetUtils` and found that sets aren't measurably different. Don't let that stop you from quickly trying though. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 17 18:29:10 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 17 Oct 2017 18:29:10 -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.a5372e8bf031cc748dfdaf9dae92ce02@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 bgamari): * related: #664 => #664, #14257 Comment: I was looking at a similar issue, #14257, and thought I had a theory. Unfortunately it fell apart. I'll try to get back to this soon. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 17 18:29:22 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 17 Oct 2017 18:29:22 -0000 Subject: [GHC] #14257: Heap profiling with ghc and hp2ps and strict function application ($!) gives samples out of sequence (regression) In-Reply-To: <049.0b02f45f092991ff71d90010f90c58a1@haskell.org> References: <049.0b02f45f092991ff71d90010f90c58a1@haskell.org> Message-ID: <064.ddd2c3b8198ac93765a97b6775506877@haskell.org> #14257: Heap profiling with ghc and hp2ps and strict function application ($!) gives samples out of sequence (regression) -------------------------------------+------------------------------------- Reporter: carlostome | Owner: bgamari Type: bug | Status: new Priority: high | Milestone: 8.4.1 Component: Runtime System | Version: 8.2.1 Resolution: | Keywords: profiler Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #14006, #11645 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * keywords: => profiler * related: #14006 => #14006, #11645 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 17 18:35:01 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 17 Oct 2017 18:35:01 -0000 Subject: [GHC] #14359: C-- pipeline/NCG fails to optimize simple repeated addition In-Reply-To: <046.bcdd65b59703128c3357fd202e0f128d@haskell.org> References: <046.bcdd65b59703128c3357fd202e0f128d@haskell.org> Message-ID: <061.a2893a9bfab1aa401c0fc585773f37f1@haskell.org> #14359: C-- pipeline/NCG fails to optimize simple repeated addition -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: new Priority: low | Milestone: Component: Compiler | Version: 8.2.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): Well that is a relief. I guess this might just be an artifact from the fact I was using a `validate` build. I'll have to check this. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 17 18:37:54 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 17 Oct 2017 18:37:54 -0000 Subject: [GHC] #13203: Implement Bits Natural clearBit In-Reply-To: <044.036af31a947c4008bf1dfa61730885bd@haskell.org> References: <044.036af31a947c4008bf1dfa61730885bd@haskell.org> Message-ID: <059.d683eab6ebd61afbdd9187b430775ea5@haskell.org> #13203: Implement Bits Natural clearBit -------------------------------------+------------------------------------- Reporter: dylex | Owner: supersven Type: bug | Status: closed Priority: high | Milestone: 8.2.2 Component: libraries/base | Version: 7.10.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: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: merge => closed * resolution: => fixed -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 17 18:39:34 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 17 Oct 2017 18:39:34 -0000 Subject: [GHC] #13861: Take more advantage of STG representation invariance (follows up #9291) In-Reply-To: <048.651e325a747e822318af666cede88e81@haskell.org> References: <048.651e325a747e822318af666cede88e81@haskell.org> Message-ID: <063.6288e14c9da4efc303455d59434bd43f@haskell.org> #13861: Take more advantage of STG representation invariance (follows up #9291) -------------------------------------+------------------------------------- Reporter: heisenbug | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.0.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): It would be nice to know what the motivation for *not* using the available tag space for big families is. Surely there was a reason, even if it was just keeping implementation complexity at bay. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 17 18:53:02 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 17 Oct 2017 18:53:02 -0000 Subject: [GHC] #12970: Add default implementation for Bits.bitSize In-Reply-To: <045.18bc248265b05555e123c1ad78e88bb9@haskell.org> References: <045.18bc248265b05555e123c1ad78e88bb9@haskell.org> Message-ID: <060.34a6fab55facfeb6f5c3e3dbe196e312@haskell.org> #12970: Add default implementation for Bits.bitSize -------------------------------------+------------------------------------- Reporter: txnull | Owner: dfeuer Type: feature request | Status: patch Priority: high | Milestone: 8.4.1 Component: libraries/base | 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:D3723 Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): > By that argument we'd never remove anything, as the same situation would just re-present itself during GHC 8.5; if maintainers have been ignoring the warnings introduced in GHC 7.8, they'll likely ignore them forever... life's too short... ;-) Fair enough. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 17 18:53:50 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 17 Oct 2017 18:53:50 -0000 Subject: [GHC] #14333: GHC doesn't use the fact that Coercible is symmetric In-Reply-To: <051.317ebc999077ee18339a9e5fa0ad5d1c@haskell.org> References: <051.317ebc999077ee18339a9e5fa0ad5d1c@haskell.org> Message-ID: <066.cc00b6446695dd8fb5841d13c1be7048@haskell.org> #14333: GHC doesn't use the fact that Coercible is symmetric -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: | Keywords: TypeFamilies, | 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): Good news! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 17 18:55:46 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 17 Oct 2017 18:55:46 -0000 Subject: [GHC] #14360: traceM documentation not clear (and possibly incorrect) In-Reply-To: <051.5b22f6cea7eb7c70df5ec04d18196320@haskell.org> References: <051.5b22f6cea7eb7c70df5ec04d18196320@haskell.org> Message-ID: <066.30ffeb19fce457ca954ce181e1378755@haskell.org> #14360: traceM documentation not clear (and possibly incorrect) -------------------------------------+------------------------------------- Reporter: saurabhnanda | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Core Libraries | Version: 8.0.2 Resolution: | Keywords: docs 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): Can you suggest some better language? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 17 19:17:08 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 17 Oct 2017 19:17:08 -0000 Subject: [GHC] #14312: Head does not build on Windows with the default make config. In-Reply-To: <047.086b87bb9b3dcf2f7a921149fa31eda2@haskell.org> References: <047.086b87bb9b3dcf2f7a921149fa31eda2@haskell.org> Message-ID: <062.b24bfa887e03aac484afd7b839725f58@haskell.org> #14312: Head does not build on Windows with the default make config. -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: Component: Build System | Version: 8.3 Resolution: | Keywords: Operating System: Windows | Architecture: Type of failure: Building GHC | Unknown/Multiple failed | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4080 Wiki Page: | -------------------------------------+------------------------------------- Comment (by hvr): Replying to [comment:11 Phyx-]: > Well, the proposal is more to not add the current file's folder implicitly to the include list. Unfortunately, `capi` kinda follows the lead by the H2010 report: > **8.5.1 Standard C Calls** > > ... > > **Specification of Header Files** A C header specified in an import declaration is always included by `#include "chname"`. There is no explicit support for `#include ` style inclusion. The ISO C99 standard guarantees that any search path that would be used for a `#include ` is also used for `#include "chname"` and it is guaranteed that these paths are searched after all paths that are unique to `#include "chname"`. Furthermore, we require that chname ends in .h to make parsing of the specification of external entities unambiguous. So `capi` kinda adheres to that by using a `#include ` and compensating via a `-I.` path included early. (see https://www.haskell.org/onlinereport/haskell2010/haskellch8.html#x15-1610008.5) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 17 19:21:23 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 17 Oct 2017 19:21:23 -0000 Subject: [GHC] #14362: Allow: Coercing (a:~:b) to (b:~:a) In-Reply-To: <051.de7b972e40c6148c97cf4a6c5f8259b3@haskell.org> References: <051.de7b972e40c6148c97cf4a6c5f8259b3@haskell.org> Message-ID: <066.ce3eee6b0e6037cc87a8e7c7e90747c7@haskell.org> #14362: Allow: Coercing (a:~:b) to (b:~:a) -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 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): Is it not ultimately about implication of constraints ([https://www.reddit.com/r/haskell/comments/6me3sv/quantified_class_constraints_pdf/ quantified constraints]) {{{#!hs -- Witness Constraint data Dict :: Constraint -> Type where Dict :: ctx => Dict ctx instance (ctx => ctx') => Coercible (Dict ctx) (Dict ctx') instance (Coercible a b => Coercible a' b') => Coercible (Coercion a b) (Coercion a' b') instance ((a ~ b) => (a' ~ b')) => Coercible (a:~:b) (a':~:b') }}} In the case of symmetry, * To `coerce :: a:~:b -> b:~:a` we need to show * `a ~ b => b ~ a` * To `coerce :: Coercion a b -> Coercion b a` we need to show * `Coercible a b => Coercible b a` If we think of the class of data types witnessing an `Underlying` constraint {{{#!hs type family ToConstraint (kind :: Type) = (res :: Type) | res -> kind where ToConstraint Type = Constraint ToConstraint (a -> b) = a -> ToConstraint b type family Underlying (dataty :: kind) :: ToConstraint kind where Underlying (Dict ctx) = ctx Underlying Coercion = Coercible Underlying (:~:) = (~) Underlying (:~~:) = (~~) }}} we can could write these in a more general form: {{{#!hs instance (Underlying thing => Underlying thing') => Coercible thing thing' instance (Underlying thing a => Underlying thing' a') => Coercible (thing a) (thing' a') instance (Underlying thing a b => Underlying thing' a' b') => Coercible (thing a b) (thing' a' b') }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 17 19:58:56 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 17 Oct 2017 19:58:56 -0000 Subject: [GHC] #14365: Panic with (bogus?) deriving in hs-boot: newTyConEtadArity Message-ID: <050.6c81d89c96c68af001028e9be845ac26@haskell.org> #14365: Panic with (bogus?) deriving in hs-boot: newTyConEtadArity -------------------------------------+------------------------------------- Reporter: happykitten | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- {{{ $ cat A.hs module Main where import {-# SOURCE #-} B main = return () $ cat B.hs module B where data Foo a = Foo a deriving (Functor) $ cat B.hs-boot module B where data Foo a deriving (Functor) $ ghc --make A.hs [1 of 3] Compiling B[boot] ( B.hs-boot, B.o-boot ) ghc: panic! (the 'impossible' happened) (GHC version 8.2.1 for i386-unknown-linux): newTyConEtadArity Foo 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/types/TyCon.hs:2149:27 in ghc:TyCon 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 Oct 17 20:00:54 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 17 Oct 2017 20:00:54 -0000 Subject: [GHC] #13604: ghci no longer loads dynamic .o files by default if they were built with -O In-Reply-To: <045.626a6b40d9101c93e2935653ef7e4668@haskell.org> References: <045.626a6b40d9101c93e2935653ef7e4668@haskell.org> Message-ID: <060.86121f5a77509e75a6b50b4cd23ccac8@haskell.org> #13604: ghci no longer loads dynamic .o files by default if they were built with -O -------------------------------------+------------------------------------- Reporter: George | Owner: dfeuer Type: bug | Status: new Priority: highest | Milestone: 8.2.2 Component: Compiler | Version: 8.2.1-rc1 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): Phab:D3514 Wiki Page: | -------------------------------------+------------------------------------- Comment (by dfeuer): === Some summary === The essence of this ticket is explained quite well by Edward in comment:11. I don't think I agree with Edward about how the interpretation of `-fobject-code` should play into everything, but his essential points stand: 1. We want to be able to run `ghc --make` and be sure that we get compilation products entirely equivalent to compiling from scratch. 2. We want `ghci` (especially) to be able to load `-dynamic`-compiled modules even if those modules were compiled with slightly different options. The question of what "slightly different" means is really up to the user. === The solution === Fortunately, it looks like this is probably not hard! Currently, we use `fingerprintDynFlags` to calculate a fingerprint of all the dflags that it believes can affect the compilation result and (in `addFingerprints`) record that fingerprint in the `ModIface`. When we are compiling with flags that don't match, we recompile the dependencies. What we want to do, I believe, is record not only the fingerprint but also information about some of the individual options. Some thoughts: 1. A change in whether cost center profiling is enabled `gopt Opt_SccProfilingOn dflags` absolutely mandates recompilation. I believe we want users to be able to (selectively) ignore changes to - `-O` - `-fhpc` - `-fignore-asserts` - Automatic cost-center insertion (`-fprof-...`) I think we can do this by using one fingerprint for each of these options, or, even simpler, for each option and each module, either "This module and its dependencies use value X" or "At least one dependency uses a different value than this module". 2. I believe we're currently somewhat too conservative about language flags in general. For example, I wouldn't expect enabling `-X` + `DataKinds`, `AllowAmbiguousTypes`, `ExplicitNamespaces`, `ConstraintKinds`, `MultiParamTypeClasses`, `FunctionalDependencies`, `FlexibleInstances`, `FlexibleContexts`, `UndecidableInstances`, `TupleSections`, `TypeSynonymInstances`, `StandaloneDeriving`, `DefaultSignatures`, `NullaryTypeClasses`, `EmptyCase`, `MultiWayIf`, or `ConstrainedClassMethods` to be able to change the result of compiling any module that was successfully compiled before. For these options, we're really only interested if one of them is ''turned off'' that was previously ''turned on''. For these, rather than a proper fingerprint, we want to record, for each option and each module, whether the module or at least one of its dependencies was compiled with that flag. 3. We should consider fingerprinting the result of running the preprocessor(s) over the source. If the `-D`, `-U`, or `-I` options change, or an `#include`d file changes, we only need to recompile if the results of preprocessing have actually changed. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 17 20:06:01 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 17 Oct 2017 20:06:01 -0000 Subject: [GHC] #14364: Reduce repetition in derived Read instances In-Reply-To: <046.9abf8af51367f0badd76eab5f23e3eb1@haskell.org> References: <046.9abf8af51367f0badd76eab5f23e3eb1@haskell.org> Message-ID: <061.360b980ba868b887918265d6dfee02c1@haskell.org> #14364: Reduce repetition in derived Read instances -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: task | Status: new Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.2.1 Resolution: | Keywords: deriving Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #10980 #7258 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * keywords: => deriving -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 17 20:08:06 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 17 Oct 2017 20:08:06 -0000 Subject: [GHC] #14357: Document deriving strategies fully In-Reply-To: <046.91687c1a92b17e8af88be3338e9d0f5b@haskell.org> References: <046.91687c1a92b17e8af88be3338e9d0f5b@haskell.org> Message-ID: <061.820ecb2604d0882e32d42f241a1b778f@haskell.org> #14357: Document deriving strategies fully -------------------------------------+------------------------------------- Reporter: nomeata | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Documentation | Version: 8.2.1 Resolution: | Keywords: 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: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): OK. I ask since you seem to have a clear vision of what particular phrasing to add here, so it would probably be much more direct to have you write this down than for someone like me to guess what you'd like to see. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 17 20:21:23 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 17 Oct 2017 20:21:23 -0000 Subject: [GHC] #14362: Allow: Coercing (a:~:b) to (b:~:a) In-Reply-To: <051.de7b972e40c6148c97cf4a6c5f8259b3@haskell.org> References: <051.de7b972e40c6148c97cf4a6c5f8259b3@haskell.org> Message-ID: <066.7b450d87e47d9da289b2fbbb2a030a95@haskell.org> #14362: Allow: Coercing (a:~:b) to (b:~:a) -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 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): A user defined type with "no represented value arguments" could generate an `Underlying` type instance {{{#!hs type Cat obj = obj -> obj -> Type data LessThanEq :: Cat Nat where LessThanEq :: a <= b => LessThanEq a b data GreaterThanEq :: Cat Nat where GreaterThanEq :: a >= b => GreaterThanEq a b type instance Underlying (LessThanEq a b) = a <= b type instance Underlying (GreaterThanEq a b) = a => b }}} So depending how smart our constraint solver is, we can coerce {{{#!hs coerce :: LessThanEq a b -> LessThanEq a (10 + b) coerce :: LessThanEq a b -> GreaterThanEq b a }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 17 20:21:41 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 17 Oct 2017 20:21:41 -0000 Subject: [GHC] #14357: Document deriving strategies fully In-Reply-To: <046.91687c1a92b17e8af88be3338e9d0f5b@haskell.org> References: <046.91687c1a92b17e8af88be3338e9d0f5b@haskell.org> Message-ID: <061.a876bba044954b24b57b6eefa1f1a416@haskell.org> #14357: Document deriving strategies fully -------------------------------------+------------------------------------- Reporter: nomeata | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Documentation | Version: 8.2.1 Resolution: | Keywords: 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: | -------------------------------------+------------------------------------- Comment (by nomeata): Ok ok, I’ll give it a shot :-) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 17 20:32:43 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 17 Oct 2017 20:32:43 -0000 Subject: [GHC] #13604: ghci no longer loads dynamic .o files by default if they were built with -O In-Reply-To: <045.626a6b40d9101c93e2935653ef7e4668@haskell.org> References: <045.626a6b40d9101c93e2935653ef7e4668@haskell.org> Message-ID: <060.5ec030a49fcf8ccdbf85b5bf340c738b@haskell.org> #13604: ghci no longer loads dynamic .o files by default if they were built with -O -------------------------------------+------------------------------------- Reporter: George | Owner: dfeuer Type: bug | Status: new Priority: highest | Milestone: 8.2.2 Component: Compiler | Version: 8.2.1-rc1 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): Phab:D3514 Wiki Page: | -------------------------------------+------------------------------------- Comment (by George): I trust that this will be a good solution but I think it would be worthwhile to provide a draft of how this will be documented in the GHC user's guide so that end users can understand, at that level, what they will be getting with this fix. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 17 21:16:59 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 17 Oct 2017 21:16:59 -0000 Subject: [GHC] #14364: Reduce repetition in derived Read instances In-Reply-To: <046.9abf8af51367f0badd76eab5f23e3eb1@haskell.org> References: <046.9abf8af51367f0badd76eab5f23e3eb1@haskell.org> Message-ID: <061.93b29527a2fcf56356966169928d388e@haskell.org> #14364: Reduce repetition in derived Read instances -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: task | Status: new Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.2.1 Resolution: | Keywords: deriving Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #10980 #7258 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Sounds very plausible to me. And you could have two variants of `readField`, one with a comma and one not. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 17 21:19:18 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 17 Oct 2017 21:19:18 -0000 Subject: [GHC] #14271: ghci hangs with -fexternal-interpreter -prof In-Reply-To: <047.35b6ee83038ae67884e53737c2b92695@haskell.org> References: <047.35b6ee83038ae67884e53737c2b92695@haskell.org> Message-ID: <062.424dde5d8be2065878e91d6ba1188757@haskell.org> #14271: ghci hangs with -fexternal-interpreter -prof -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: GHCi | Version: 8.2.1 Resolution: | Keywords: Operating System: Windows | Architecture: | Unknown/Multiple Type of failure: GHCi crash | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Phyx-): I don't have an 8.2 installation handy, but I can't reproduce this on master. {{{ Tamar at Rage ~/ghc> inplace/bin/ghc-stage2.exe --interactive -fexternal- interpreter -prof GHCi, version 8.3.20171008: http://www.haskell.org/ghc/ :? for help Prelude> 1+1 2 Prelude> :q Leaving GHCi. Tamar at Rage ~/ghc> inplace/bin/ghci.exe -fexternal-interpreter -prof WARNING: GHCi invoked via 'ghci.exe' in MinTTY consoles (e.g., Cygwin or MSYS) doesn't handle Ctrl-C well; use the 'ghcii.sh' shell wrapper instead GHCi, version 8.3.20171008: http://www.haskell.org/ghc/ :? for help Prelude> :q Leaving GHCi. }}} @AndreasK have you tried with master? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 17 21:20:28 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 17 Oct 2017 21:20:28 -0000 Subject: [GHC] #13861: Take more advantage of STG representation invariance (follows up #9291) In-Reply-To: <048.651e325a747e822318af666cede88e81@haskell.org> References: <048.651e325a747e822318af666cede88e81@haskell.org> Message-ID: <063.1ef6c79a0c93320f6f66db8f28f42c43@haskell.org> #13861: Take more advantage of STG representation invariance (follows up #9291) -------------------------------------+------------------------------------- Reporter: heisenbug | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.0.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 paper doesn't say and there are no comments to explain, the last port of call would be Simon Marlow. Otherwise I'd assume it was just becuase it seemed like the easiest thing, and most data types are smaller. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 17 21:32:49 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 17 Oct 2017 21:32:49 -0000 Subject: [GHC] #13861: Take more advantage of STG representation invariance (follows up #9291) In-Reply-To: <048.651e325a747e822318af666cede88e81@haskell.org> References: <048.651e325a747e822318af666cede88e81@haskell.org> Message-ID: <063.057bd9358f129ef83ad03ddcc30eb114@haskell.org> #13861: Take more advantage of STG representation invariance (follows up #9291) -------------------------------------+------------------------------------- Reporter: heisenbug | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.0.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): Replying to [comment:7 bgamari]: > It would be nice to know what the motivation for *not* using the available tag space for big families is. Surely there was a reason, even if it was just keeping implementation complexity at bay. Probably the motivation was "we'll think about this later". Implementation complexity seems to be fairly low, see my branch (caveat: ''very WIP'') https://github.com/ggreif/ghc/tree/wip/tag-big-families -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 17 21:33:09 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 17 Oct 2017 21:33:09 -0000 Subject: [GHC] #14362: Allow: Coercing (a:~:b) to (b:~:a) In-Reply-To: <051.de7b972e40c6148c97cf4a6c5f8259b3@haskell.org> References: <051.de7b972e40c6148c97cf4a6c5f8259b3@haskell.org> Message-ID: <066.f7a2c6cf1c5cec39ae1eb2253e587dfc@haskell.org> #14362: Allow: Coercing (a:~:b) to (b:~:a) -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 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): > Is it not ultimately about implication of constraints? I don't thuink so. Take `:~:`. Could I write this function? {{{ convert :: (a :~: b) -> (b :~: a) }}} Sure! Thus {{{ convert Refl = Refl }}} Plus, the two represntationns are the same. So yes, they should be coercible. No quantification stuff. I think. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 17 21:42:31 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 17 Oct 2017 21:42:31 -0000 Subject: [GHC] #14357: Document deriving strategies fully In-Reply-To: <046.91687c1a92b17e8af88be3338e9d0f5b@haskell.org> References: <046.91687c1a92b17e8af88be3338e9d0f5b@haskell.org> Message-ID: <061.eb4d65509540a6e4420100e82ea31a99@haskell.org> #14357: Document deriving strategies fully -------------------------------------+------------------------------------- Reporter: nomeata | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Documentation | Version: 8.2.1 Resolution: | Keywords: 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: | -------------------------------------+------------------------------------- Comment (by Joachim Breitner ): In [changeset:"317aa966b3d89e45227a5870feba339e34d77a18/ghc" 317aa966/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="317aa966b3d89e45227a5870feba339e34d77a18" Improve user’s guide around deriving In particular: * add an intro to “10.6. Extensions to the “deriving” mechanism” giving an overview, * make the various sections on `-XDerivingFoo` subsections of “10.6.3. Deriving instances of extra classes (Data, etc.)” * Move the reference anchors for the various `DerivingFoo` extensions to a more appropriate spot. * Add subsection “10.6.6.1. Default deriving strategy” to the deriving section (#14357) }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 17 21:44:58 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 17 Oct 2017 21:44:58 -0000 Subject: [GHC] #14357: Document deriving strategies fully In-Reply-To: <046.91687c1a92b17e8af88be3338e9d0f5b@haskell.org> References: <046.91687c1a92b17e8af88be3338e9d0f5b@haskell.org> Message-ID: <061.439cbfde17e46724c777eede223679b7@haskell.org> #14357: Document deriving strategies fully -------------------------------------+------------------------------------- Reporter: nomeata | Owner: (none) Type: task | Status: closed Priority: normal | Milestone: Component: Documentation | Version: 8.2.1 Resolution: fixed | Keywords: 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 nomeata): * status: new => closed * resolution: => fixed Comment: Ok, I gave it a shot. Ryan, I’d appreciate if you could check that I did not introduce any wrong facts there (and feel free to fix any mistakes or do any other kind of improvement directly in `master`). -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 17 22:04:46 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 17 Oct 2017 22:04:46 -0000 Subject: [GHC] #14363: :type hangs on coerce In-Reply-To: <051.a5d2467b66df31be8b2c92e458401ba5@haskell.org> References: <051.a5d2467b66df31be8b2c92e458401ba5@haskell.org> Message-ID: <066.f946d6d2196e26ebda84a62b462e7f65@haskell.org> #14363: :type hangs on coerce -------------------------------------+------------------------------------- Reporter: Iceland_jack | 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): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Gah! How has this bug survived so long? I see this {{{ Inert set: [G] co1: a ~R# f b Work item: [B] co2: b ~R# f a }}} We can't rewrite the work item `co2` with the inert `co1`, because the role of f's argument is Nominal, sot`co1` can't rewrite it. So we add `co2` to the inert set. Alas we then kick out `co1` becuase it has a free `b`, thinking that it might be rewritten by `co2`. But of course it can't and we get an infinite loop instead. Sigh! What's wrong? I think that `anyRewritableTyVar` needs to beecome role- aware. Richard do you agree? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 17 22:10:43 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 17 Oct 2017 22:10:43 -0000 Subject: [GHC] #14363: :type hangs on coerce In-Reply-To: <051.a5d2467b66df31be8b2c92e458401ba5@haskell.org> References: <051.a5d2467b66df31be8b2c92e458401ba5@haskell.org> Message-ID: <066.278e0a3ab7ad18c9d3d865e1a09d63cf@haskell.org> #14363: :type hangs on coerce -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 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 Iceland_jack): * keywords: => Roles -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 17 22:11:44 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 17 Oct 2017 22:11:44 -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.f7507f952c54b7b68e47bbee62558d25@haskell.org> #14331: Overzealous free-floating kind check causes deriving clause to be rejected -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: merge Priority: normal | Milestone: 8.2.2 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): Where are we on this? I claim in commment:16 that the error message in comment 12 is spot on. So what remains is to document the behaviour. The other loose end is Richard's "Howver, in writing this up..." point in comment:20. I agree with Ryan's response in comment:21. Do we need any futher documentation? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 17 22:12:04 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 17 Oct 2017 22:12:04 -0000 Subject: [GHC] #9112: support for deriving Vector/MVector instances In-Reply-To: <045.090ab3f8e8b58a66c61af9e1c7e40cfe@haskell.org> References: <045.090ab3f8e8b58a66c61af9e1c7e40cfe@haskell.org> Message-ID: <060.8aeac1fde723d8d2425835ae8c20ee92@haskell.org> #9112: support for deriving Vector/MVector instances -------------------------------------+------------------------------------- Reporter: jwlato | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.8.2 Resolution: | Keywords: deriving, | 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 Iceland_jack): * cc: Iceland_jack (added) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 17 22:15:38 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 17 Oct 2017 22:15:38 -0000 Subject: [GHC] #14332: Deriving clauses can have forall types In-Reply-To: <050.6c2c9b47d51bbd6274ba7997829a8360@haskell.org> References: <050.6c2c9b47d51bbd6274ba7997829a8360@haskell.org> Message-ID: <065.5ddb7d7f15c8e4780ae2b59945814831@haskell.org> #14332: Deriving clauses can have forall types -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.2.1 checker) | Resolution: | Keywords: deriving 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): > Ryan, might you be able to do this? I meant less than you think! I think. In comment:14 I say that GHC is behaving right. We just need * Document the behaviour and rationale in the user manual. * Make it work without requirinng extra parens (this is mostly just syuntax I think * Add an example in the manual along the lines of the second example. In short, virtually no implementation, just documentation. You seem to think I'm asking for something subtle in the implementationn, but I'm not. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 17 22:18:38 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 17 Oct 2017 22:18: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.150975f6d33a0db3a6732a7d4ae5823a@haskell.org> #14331: Overzealous free-floating kind check causes deriving clause to be rejected -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: merge Priority: normal | Milestone: 8.2.2 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): Uh... are we reading the same ticket? Richard and I have come to the opposite conclusion, that the program in comment:12 //should// be accepted, according to the rationale in comment:20. (Richard and I initially differed on //why// that program should be accepted, but I came around to his explanation after some debate.) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 17 22:22:55 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 17 Oct 2017 22:22:55 -0000 Subject: [GHC] #14332: Deriving clauses can have forall types In-Reply-To: <050.6c2c9b47d51bbd6274ba7997829a8360@haskell.org> References: <050.6c2c9b47d51bbd6274ba7997829a8360@haskell.org> Message-ID: <065.b2befb0a16c1e8808a7e1e248a5b40e1@haskell.org> #14332: Deriving clauses can have forall types -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.2.1 checker) | Resolution: | Keywords: deriving 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): Replying to [comment:16 simonpj]: > In comment:14 I say that GHC is behaving right. Except that it's clearly not, as evidenced in comment:7. I don't see a way to fix that short of overhauling how `deriving` clauses are renamed/typechecked, which I don't feel like I'd be able to accomplish without some mentoring. > You seem to think I'm asking for something subtle in the implementationn, but I'm not. I firmly disagree here—the way GHC typechecks `deriving` clauses is ripe with subtlety! It's caused me endless amounts of headaches trying to fix bugs like #10524 and #10561 in the past, as just two data points. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 17 22:29:01 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 17 Oct 2017 22:29:01 -0000 Subject: [GHC] #14357: Document deriving strategies fully In-Reply-To: <046.91687c1a92b17e8af88be3338e9d0f5b@haskell.org> References: <046.91687c1a92b17e8af88be3338e9d0f5b@haskell.org> Message-ID: <061.93391609e332eebf4673953a86a2319a@haskell.org> #14357: Document deriving strategies fully -------------------------------------+------------------------------------- Reporter: nomeata | Owner: (none) Type: task | Status: closed Priority: normal | Milestone: Component: Documentation | Version: 8.2.1 Resolution: fixed | Keywords: 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: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): Thanks, Joachim! That patch looks great. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 17 22:40:11 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 17 Oct 2017 22:40:11 -0000 Subject: [GHC] #13175: Documenting what can be derived 'out of the box' by GHC's "deriving" In-Reply-To: <046.ec8db13b6efff688fc4aec1eff3b3d67@haskell.org> References: <046.ec8db13b6efff688fc4aec1eff3b3d67@haskell.org> Message-ID: <061.82712a318591cb0b57aa956733ade15b@haskell.org> #13175: Documenting what can be derived 'out of the box' by GHC's "deriving" -------------------------------------+------------------------------------- Reporter: carette | Owner: (none) Type: task | Status: closed Priority: normal | Milestone: 8.4.1 Component: Documentation | Version: 8.0.1 Resolution: fixed | Keywords: newcomer, | deriving 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): * status: new => closed * resolution: => fixed * milestone: => 8.4.1 Comment: I believe this can be considered fixed as of 317aa966b3d89e45227a5870feba339e34d77a18. The [http://git.haskell.org/ghc.git/blob/317aa966b3d89e45227a5870feba339e34d77a18:/docs/users_guide/glasgow_exts.rst#l3646 beginning of the users' guide section] on GHC's extensions to `deriving` now mentions: {{{ * In Haskell 98, the only derivable classes are ``Eq``, ``Ord``, ``Enum``, ``Ix``, ``Bounded``, ``Read``, and ``Show``. `Various langauge extensions <#deriving-extra>`__ extend this list. }}} The `deriving-extra` section then proceeds to mention each of the remaining classes that are stock derivable. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 17 22:41:58 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 17 Oct 2017 22:41:58 -0000 Subject: [GHC] #14271: ghci hangs with -fexternal-interpreter -prof In-Reply-To: <047.35b6ee83038ae67884e53737c2b92695@haskell.org> References: <047.35b6ee83038ae67884e53737c2b92695@haskell.org> Message-ID: <062.7e0803535c802814f38f2addf0c2f0b4@haskell.org> #14271: ghci hangs with -fexternal-interpreter -prof -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: GHCi | Version: 8.2.1 Resolution: | Keywords: Operating System: Windows | Architecture: | Unknown/Multiple Type of failure: GHCi crash | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by AndreasK): When I tried back then it failed on master with a different Error then on 8.2. It works on the current head it seems. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 17 22:43:39 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 17 Oct 2017 22:43:39 -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.7f422244cd89d81714f4cbdd4e984128@haskell.org> #14331: Overzealous free-floating kind check causes deriving clause to be rejected -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: merge Priority: normal | Milestone: 8.2.2 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): Ah! I disagee with comment:20. Let's start with this, after renaming: {{{ class C a b data D c = D deriving (forall k. C (c :: k)) }}} Now we typecheck the class and `data D` decls, but not yet the `deriving` part, yielding {{{ class C {k1} {k2} (a:k1) (b:k2) data D {k3} (c:k3) = D deriving (forall k. C (c :: k)) }}} Now we move on to typechecking the `deriving` clause. Here we fail, becuase `c` has kind `k3` but its occurrence in the deriving clause claims it has kind `k`, where those two binders are quite different. And that's just what the error message says. To make it work, write {{{ data D (c::k) = D deriving( D c ) }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 17 22:43:48 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 17 Oct 2017 22:43:48 -0000 Subject: [GHC] #14362: Allow: Coercing (a:~:b) to (b:~:a) In-Reply-To: <051.de7b972e40c6148c97cf4a6c5f8259b3@haskell.org> References: <051.de7b972e40c6148c97cf4a6c5f8259b3@haskell.org> Message-ID: <066.59be8137957944fc6931e8c55a46df0c@haskell.org> #14362: Allow: Coercing (a:~:b) to (b:~:a) -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 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): But what is the most general type of `convert Refl = Refl`? We cannot write {{{#!hs -- Could not deduce: a' ~ b' -- from the context: a ~ b convert :: (a :~: b) -> (a' :~: b') convert Refl = Refl }}} note how type checking this depends on the ‘underlying constraint’ of `(:~:)`: `(~)`. We have to be deduce `a' ~ b'` from the given context `a ~ b`, which is this? {{{#!hs convert :: ((a~b) => (a'~b')) => (a :~: b) -> (a' :~: b') convert Refl = Refl }}} so I would expect `coerce` to have that type. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 17 23:10:03 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 17 Oct 2017 23:10:03 -0000 Subject: [GHC] #14362: Allow: Coercing (a:~:b) to (b:~:a) In-Reply-To: <051.de7b972e40c6148c97cf4a6c5f8259b3@haskell.org> References: <051.de7b972e40c6148c97cf4a6c5f8259b3@haskell.org> Message-ID: <066.81c027f1fc29ddeb555838392aac34b8@haskell.org> #14362: Allow: Coercing (a:~:b) to (b:~:a) -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 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): But I don't want the most general type of `convert`! The general principle of `Coercible` is that it simply automates what you could do by hand. E.g {{{ newtype Age = MkAge Int convert :: [Int] -> [Age] convert xs = map MkAge xs }}} And back. So we can reasonably claim `Coercible [Age] [Int]`. It's the same with `Coercible (a :~: b) (b :~: a)`, which is what you asked for. I can do it by hand (with `convert`); using `coerce` just automates it. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 18 00:07:32 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 18 Oct 2017 00:07:32 -0000 Subject: [GHC] #14346: 8.2.1 regression: heap corruption after safe foreign calls In-Reply-To: <049.7a4af7d8399ac93444ea4b9211bf91ff@haskell.org> References: <049.7a4af7d8399ac93444ea4b9211bf91ff@haskell.org> Message-ID: <064.e305069101a1310efc4a9f122f784376@haskell.org> #14346: 8.2.1 regression: heap corruption after safe foreign calls -------------------------------------+------------------------------------- Reporter: andrewchen | Owner: (none) Type: bug | Status: infoneeded Priority: highest | Milestone: Component: Runtime System | Version: 8.2.1 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): On looking at this with fresh eyes, it seems that unfortunately my analysis from comment:11 is flawed; the `movq %rbx,$rdi` is completely correct. We spill to the callee-saved `%rbx register before `suspendThread` and then more the value from `%rbx` to `%rdi`, which is where we expect the first argument to reside. The second spill is simply preserving `_u4RH`, which is still alive after the call to `test`. Back to the drawing board. I think now I'll focus on catching the issue earlier in execution; namely, when we first get the `value mismatch` message. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 18 01:02:56 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 18 Oct 2017 01:02:56 -0000 Subject: [GHC] #14346: 8.2.1 regression: heap corruption after safe foreign calls In-Reply-To: <049.7a4af7d8399ac93444ea4b9211bf91ff@haskell.org> References: <049.7a4af7d8399ac93444ea4b9211bf91ff@haskell.org> Message-ID: <064.3fd1567b66aa412770aaae64ce5554da@haskell.org> #14346: 8.2.1 regression: heap corruption after safe foreign calls -------------------------------------+------------------------------------- Reporter: andrewchen | Owner: (none) Type: bug | Status: infoneeded Priority: highest | Milestone: Component: Runtime System | Version: 8.2.1 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 hsyl20): You don't need the FFI to trigger the bug. You can replace: {{{#!haskell foreign import ccall safe "test" c_test :: Ptr Word32 -> IO () }}} with: {{{#!haskell {-# NOINLINE c_test #-} c_test :: Ptr Word32 -> IO () c_test ptr = poke ptr 0xDEADBEEF }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 18 01:42:57 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 18 Oct 2017 01:42:57 -0000 Subject: [GHC] #14365: Panic with (bogus?) deriving in hs-boot: newTyConEtadArity In-Reply-To: <050.6c81d89c96c68af001028e9be845ac26@haskell.org> References: <050.6c81d89c96c68af001028e9be845ac26@haskell.org> Message-ID: <065.035772b39abe50ed8068ed8fa97fc49e@haskell.org> #14365: Panic with (bogus?) deriving in hs-boot: newTyConEtadArity -------------------------------------+------------------------------------- Reporter: happykitten | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: | Keywords: deriving Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4102 Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * status: new => patch * keywords: => deriving * differential: => Phab:D4102 Comment: Well that's embarrassing. The [http://git.haskell.org/ghc.git/blob/317aa966b3d89e45227a5870feba339e34d77a18:/docs/users_guide/separate_compilation.rst#l731 GHC users' guide] states that you can't have derived instances in `.hs- boot` files, but clearly we weren't checking for this in practice. Phab:D4102 is an attempt to do so. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 18 02:18:16 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 18 Oct 2017 02:18:16 -0000 Subject: [GHC] #14362: Allow: Coercing (a:~:b) to (b:~:a) In-Reply-To: <051.de7b972e40c6148c97cf4a6c5f8259b3@haskell.org> References: <051.de7b972e40c6148c97cf4a6c5f8259b3@haskell.org> Message-ID: <066.232c1d18aee1a4d6a453bc8ca97c5101@haskell.org> #14362: Allow: Coercing (a:~:b) to (b:~:a) -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 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): I'm not really sure what this ticket is about. The relation `~R#` defines representational equality. The rules for this are written in the Coercible paper. There are several other tickets floating about talking about things that are provably `~R#`, but that GHC's solver can't figure it out. This ticket is different, though: it seems to propose new rules for `~R#`. (Note: `Coercible` is defined as {{{#!hs class a ~R# b => Coercible a b instance a ~R# b => Coercible a b }}} ) According to the rules for `~R#`, we don't have `(a :~: b) ~R# (b :~: a)`: the parameters to `:~:` both have a nominal role. (Note that role inference looks at constraints as well as other data members, so the `a ~ b` constraint in the type of `Refl` is what induces the nominal roles.) It's conceivable that we could have newtype-GADTs, like {{{#!hs newtype a :~: b where Refl :: a ~ b => a :~: b }}} With a newtype-GADT, we could imagine forming `(a :~: b) ~R# (b :~: a)` by unwrapping, using `sym` and then wrapping using the newtype constructor. (I'm unsure how the solver would work here... but at least it's possible in Core.) Of course, we don't have newtype-GADTs. And I'm afraid I don't understand what's going on in comment:3 and comment:4. How do these ideas relate to the definition of `~R#`? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 18 02:26:02 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 18 Oct 2017 02:26:02 -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.49fa8e479f55276e4bb1e1766b0f76d9@haskell.org> #14331: Overzealous free-floating kind check causes deriving clause to be rejected -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: merge Priority: normal | Milestone: 8.2.2 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 initially thought the same as comment:26, but then I realized that the logic in comment:26 also means that `data Proxy a = P deriving Functor` should fail. We allow unifying kind variables in a data declaration to be unified when processing a `deriving` clause. The program in comment:12 has the same action. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 18 02:38:36 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 18 Oct 2017 02:38:36 -0000 Subject: [GHC] #14312: Head does not build on Windows with the default make config. In-Reply-To: <047.086b87bb9b3dcf2f7a921149fa31eda2@haskell.org> References: <047.086b87bb9b3dcf2f7a921149fa31eda2@haskell.org> Message-ID: <062.1fd3744e3e6e14cbc83bcc8d7496600e@haskell.org> #14312: Head does not build on Windows with the default make config. -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: Component: Build System | Version: 8.3 Resolution: | Keywords: Operating System: Windows | Architecture: Type of failure: Building GHC | Unknown/Multiple failed | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4080 Wiki Page: | -------------------------------------+------------------------------------- Comment (by Rufflewind): In ordinary C code I would always expect `#include "..."` to search the current directory of the file (as apparent to the user), whereas `#include <...>` should not do that unless explicitly asked for. I think Haskell should aim to retain similar behavior. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 18 02:45:25 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 18 Oct 2017 02:45:25 -0000 Subject: [GHC] #14363: :type hangs on coerce In-Reply-To: <051.a5d2467b66df31be8b2c92e458401ba5@haskell.org> References: <051.a5d2467b66df31be8b2c92e458401ba5@haskell.org> Message-ID: <066.5450ed7debb873308ec070a387834975@haskell.org> #14363: :type hangs on coerce -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 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): Yes, `anyRewritableTyVar` needs to become role-aware. It should pass a role to the predicate function, I think. But I'm not sure why the "occurs check" failure in the original post is correct. IIUC, we're trying to check `coerce :: (a -> b) -> (f a -> f b)`. In other words, we want to prove `Coercible (a -> b) (f a -> f b)`, which decomposes to `Coercible a (f a)` and `Coercible b (f b)`. These aren't insoluble, and I don't think we should report an occurs-check problem. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 18 02:49:50 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 18 Oct 2017 02:49:50 -0000 Subject: [GHC] #14333: GHC doesn't use the fact that Coercible is symmetric In-Reply-To: <051.317ebc999077ee18339a9e5fa0ad5d1c@haskell.org> References: <051.317ebc999077ee18339a9e5fa0ad5d1c@haskell.org> Message-ID: <066.b825d13d62c50b85bb5d4fd9bbd3b076@haskell.org> #14333: GHC doesn't use the fact that Coercible is symmetric -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: | Keywords: TypeFamilies, | 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): Replying to [comment:7 simonpj]: > I found I could do this quite easily. (I happened to be in the area.) Patch coming. Ooh. I'm curious. I'm not yet ready to backtrack from my opinion that this would be hard. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 18 03:32:18 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 18 Oct 2017 03:32:18 -0000 Subject: [GHC] #14346: 8.2.1 regression: heap corruption after safe foreign calls In-Reply-To: <049.7a4af7d8399ac93444ea4b9211bf91ff@haskell.org> References: <049.7a4af7d8399ac93444ea4b9211bf91ff@haskell.org> Message-ID: <064.6dcc7cefebb800ec053b43b5cd2a3fd9@haskell.org> #14346: 8.2.1 regression: heap corruption after safe foreign calls -------------------------------------+------------------------------------- Reporter: andrewchen | Owner: (none) Type: bug | Status: infoneeded Priority: highest | Milestone: Component: Runtime System | Version: 8.2.1 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 hsyl20): Smaller reproducer: {{{#!haskell -- ghc -Wall -fforce-recomp -O1 Test.hs -threaded module Main where import Control.Concurrent import Control.Monad import Data.Word import Foreign.Marshal.Alloc import Foreign.Storable import Numeric main :: IO () main = do replicateM_ 100 $ threadDelay 100 allocaBytes 4 $ \p -> do forever $ do poke p (0xDEADBEEF :: Word32) threadDelay 10 x <- peek p unless (x == 0xDEADBEEF) $ putStrLn (showHex x "") }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 18 04:48:25 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 18 Oct 2017 04:48:25 -0000 Subject: [GHC] #12002: Pragmas after a module declaration are ignored without warning. In-Reply-To: <050.a06dfff8e83390aaf98ce91845f96e30@haskell.org> References: <050.a06dfff8e83390aaf98ce91845f96e30@haskell.org> Message-ID: <065.eeae807d350a7cdbe60c657613a427ce@haskell.org> #12002: Pragmas after a module declaration are ignored without warning. -------------------------------------+------------------------------------- Reporter: seanparsons | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 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: #2260 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by harpocrates): Maybe things have changed since 10 years ago when the comment quoted in comment:2 was made, but this is now a two line change. I propose that GHC try to report an unrecognized pragma when meeting a header pragma outside of the header. That's one of the default warnings anyways. I'll be submitting a fix for this shortly. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 18 05:55:31 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 18 Oct 2017 05:55:31 -0000 Subject: [GHC] #13745: Investigate compile-time regressions in regex-tdfa-1.2.2 In-Reply-To: <046.b7de3eed99bc2dfd75756f4f73799d3c@haskell.org> References: <046.b7de3eed99bc2dfd75756f4f73799d3c@haskell.org> Message-ID: <061.4241d841bb38408cd83a6a9f52112573@haskell.org> #13745: Investigate compile-time regressions in regex-tdfa-1.2.2 -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: task | Status: new Priority: high | Milestone: 8.2.3 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 rahulmutt): I recently merged the DmdAnal module from ghc master into Eta and observed a 2-3x blowup in generated codesize for the exact same module - Text.Regex.TDFA.NewDFA.Engine_FA. Given that the Eta code base does not yet contain the early inlining patch or anything relating to join points, I think one thing to be looking at is the impact of the new changes to the demand analyzer and how the inliner reacts to strictness/usage information. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 18 06:08:38 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 18 Oct 2017 06:08:38 -0000 Subject: [GHC] #12002: Pragmas after a module declaration are ignored without warning. In-Reply-To: <050.a06dfff8e83390aaf98ce91845f96e30@haskell.org> References: <050.a06dfff8e83390aaf98ce91845f96e30@haskell.org> Message-ID: <065.1f3745755863a9618640faaf4d6cb3c7@haskell.org> #12002: Pragmas after a module declaration are ignored without warning. -------------------------------------+------------------------------------- Reporter: seanparsons | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 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: #2260 #13918 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by AntC): * related: #2260 => #2260 #13918 Comment: See also #13918 and other tickets linked to it. I guess GHC treats a pragma in an unexpected place as just a comment `{-` which it is `-}`. (@vanto seems to have a small cottage industry going of reporting these.) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 18 06:12:20 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 18 Oct 2017 06:12:20 -0000 Subject: [GHC] #12002: Pragmas after a module declaration are ignored without warning. In-Reply-To: <050.a06dfff8e83390aaf98ce91845f96e30@haskell.org> References: <050.a06dfff8e83390aaf98ce91845f96e30@haskell.org> Message-ID: <065.dcff62adda1a277c8b5f1d8be331a182@haskell.org> #12002: Pragmas after a module declaration are ignored without warning. -------------------------------------+------------------------------------- Reporter: seanparsons | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 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: #2260 #13918 | Differential Rev(s): #13921 | Wiki Page: | -------------------------------------+------------------------------------- Changes (by AntC): * related: #2260 #13918 => #2260 #13918 #13921 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 18 07:16:38 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 18 Oct 2017 07:16:38 -0000 Subject: [GHC] #7258: Compiling DynFlags is jolly slow In-Reply-To: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> References: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> Message-ID: <061.ccd93bb724cc81b47c7971c5c5597189@haskell.org> #7258: Compiling DynFlags is jolly slow -------------------------------------+------------------------------------- Reporter: simonpj | Owner: simonpj Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.6.1 Resolution: | Keywords: deriving-perf 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:37 bgamari]: > While chatting with tdammers about this I had a peek at the core; it seems that 5000 terms of the 7000 terms in the simplified core of `W2` are in `creadPrec_rdaO`. Moreover, much of this is repetition. I've proposed an approach for dealing with this in #14364. I've just done a bit more profiling, and it turns out that removing the derived `Read` instance from the `W3` example (`W2` extended to 500 fields) cuts overall compilation time down from 25.5 seconds to 3.6. So it seems that the edge case isn't just "constructors with many fields", but rather, "derived `Read` instances for constructors with many fields". -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 18 07:28:11 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 18 Oct 2017 07:28:11 -0000 Subject: [GHC] #14261: ghc stopped recognizing some arm triplets that used to work: Failed to lookup the datalayout for armv7a-hardfloat-linux-gnueabi; available targets: In-Reply-To: <045.3936f21bdd3848870db3bf9280c23e0a@haskell.org> References: <045.3936f21bdd3848870db3bf9280c23e0a@haskell.org> Message-ID: <060.be0c403c0f5532c779c7ab3583fe7a85@haskell.org> #14261: ghc stopped recognizing some arm triplets that used to work: Failed to lookup the datalayout for armv7a-hardfloat-linux-gnueabi; available targets: -------------------------------------+------------------------------------- Reporter: slyfox | 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: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by slyfox): It looks like armv7a-unknown-linux-gnueabi still does not compile current ghc-HEAD as a shared library: {{{ "inplace/bin/ghc-stage1" -this-unit-id rts -shared -dynamic -dynload deploy -no-auto-link-packages -Lrts/dist/build -lffi -optl-Wl,-rpath -optl-Wl,'$ORIGIN' ... -o rts/dist/build/libHSrts_thr- ghc8.3.20171017.so /usr/libexec/gcc/armv7a-unknown-linux-gnueabi/ld: error: rts/dist/build /libHSrts-ghc8.3.20171017.so uses VFP register arguments, rts/dist/build/StgStartup.dyn_o does not /usr/libexec/gcc/armv7a-unknown-linux-gnueabi/ld: failed to merge target specific data of file rts/dist/build/StgStartup.dyn_o }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 18 07:34:26 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 18 Oct 2017 07:34:26 -0000 Subject: [GHC] #14261: ghc stopped recognizing some arm triplets that used to work: Failed to lookup the datalayout for armv7a-hardfloat-linux-gnueabi; available targets: In-Reply-To: <045.3936f21bdd3848870db3bf9280c23e0a@haskell.org> References: <045.3936f21bdd3848870db3bf9280c23e0a@haskell.org> Message-ID: <060.f7edf613010a5bea67c913bfb868a16d@haskell.org> #14261: ghc stopped recognizing some arm triplets that used to work: Failed to lookup the datalayout for armv7a-hardfloat-linux-gnueabi; available targets: -------------------------------------+------------------------------------- Reporter: slyfox | 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: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by slyfox): Replying to [comment:5 slyfox]: Full build log: https://dev.gentoo.org/~slyfox/bugs/ghc-trac/14261/cross- armv7a-unknown-linux-gnueabi:ghc-9999:20171018-052036.log -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 18 07:46:24 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 18 Oct 2017 07:46:24 -0000 Subject: [GHC] #14346: 8.2.1 regression: heap corruption after safe foreign calls In-Reply-To: <049.7a4af7d8399ac93444ea4b9211bf91ff@haskell.org> References: <049.7a4af7d8399ac93444ea4b9211bf91ff@haskell.org> Message-ID: <064.ee2fb0f3ed0252a9a39041547f06f6ac@haskell.org> #14346: 8.2.1 regression: heap corruption after safe foreign calls -------------------------------------+------------------------------------- Reporter: andrewchen | Owner: (none) Type: bug | Status: infoneeded Priority: highest | Milestone: Component: Runtime System | Version: 8.2.1 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 andrewchen): Really interestingly replacing `forever` with `replicateM_ 1000000000` doesn't trigger the bug anymore. A bit of speculation: compiler sees that the `touch#` at the end of `allocaBytes` is unreachable due to `forever`, and so ignores it and allows the allocated are to be GC'ed. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 18 08:15:06 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 18 Oct 2017 08:15:06 -0000 Subject: [GHC] #14362: Allow: Coercing (a:~:b) to (b:~:a) In-Reply-To: <051.de7b972e40c6148c97cf4a6c5f8259b3@haskell.org> References: <051.de7b972e40c6148c97cf4a6c5f8259b3@haskell.org> Message-ID: <066.64bf4e263f64efceafa14876073a53dc@haskell.org> #14362: Allow: Coercing (a:~:b) to (b:~:a) -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 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): >> I'm not really sure what this ticket is about. It's about the following questions: * Is `(a :~: b) ~R# (b :~: a)` sound? * And if so, what would be its evidence? Remember we are talking only of when a value of type `(a :~: b)` can be coerced to one of type `(b :~: a)`, ust as we speak of coercing a value of type `[Int]` to one of type `[Age]`. Curiuosly, the paper doesn't actually articulate the circumstances under which such a coercion is OK -- instead it describes role inference. My sanity check (again not articulated explicitly in the paper) is this: it's sound to coerce a value of type `t1` into a value of type `t2`, and vice versa, if * I could write code of type `t1 -> t2` and `t2 -> t1` * The runtime representations of the two are identical Both properties hold for `(a :~: b)` and `(b :~: a)`, regardless of `a` and `b`, don't they? So I claim that `(a :~: b) ~R# (b :~: a)` is sound. But `(a :~: a) ~R# (a :~: b)` obviously must ''not'' hold, else I could write {{{ good :: forall a. a :~: a good = Refl bad :: forall a b. a -> b bad x = case (coerce (good @ a)) :: a :~: b of Refl -> x }}} (And, returning to the sanity check, I could not write a function of type `(a :~: a) -> (a :~: b)`.) So how ''could'' we prove `(a :~: b) ~R# (b :~: a)`? We have two ways to prove `Coercible`: * Decomposition on `(T ts1) ~R# (T ts2)`, using the roles of T. That isn't going to work here because it loses the crucial connection bettween `ts1` and `ts2`. * Newtype-unwrapping on `(N ts1) ~R# t2`. And (you are way ahead of me as usual), we could do that here if only `:~:` was a newtype. But, even leaving aside that we don't have newtype GADTs (I think we could maybe fix that), after decomposing both sides we'd have `(a ~ b) ~R# (b ~ a)`. And now we are back to the original problem: what would be the evidence for such an equality? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 18 08:17:20 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 18 Oct 2017 08:17:20 -0000 Subject: [GHC] #14364: Reduce repetition in derived Read instances In-Reply-To: <046.9abf8af51367f0badd76eab5f23e3eb1@haskell.org> References: <046.9abf8af51367f0badd76eab5f23e3eb1@haskell.org> Message-ID: <061.a0fe47c4039e12b646c84950d4716312@haskell.org> #14364: Reduce repetition in derived Read instances -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: task | Status: new Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.2.1 Resolution: | Keywords: deriving Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #10980 #7258 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by tdammers): The problem is not just repetition, it's also very deep (>800 levels) nesting, which might explain why the register allocator gets swamped. This makes me suspect that factoring out `readField` would not really solve the issue, because we'd still be stuck with the deep nesting. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 18 08:32:01 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 18 Oct 2017 08:32:01 -0000 Subject: [GHC] #14261: ghc stopped recognizing some arm triplets that used to work: Failed to lookup the datalayout for armv7a-hardfloat-linux-gnueabi; available targets: In-Reply-To: <045.3936f21bdd3848870db3bf9280c23e0a@haskell.org> References: <045.3936f21bdd3848870db3bf9280c23e0a@haskell.org> Message-ID: <060.b14d95428888cab2fd752ac0cd9bee58@haskell.org> #14261: ghc stopped recognizing some arm triplets that used to work: Failed to lookup the datalayout for armv7a-hardfloat-linux-gnueabi; available targets: -------------------------------------+------------------------------------- Reporter: slyfox | 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: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by angerman): Bah. llvm tools are a mess. Thanks for the report! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 18 08:36:30 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 18 Oct 2017 08:36:30 -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.8fbdddaedee02be560409eeb3945f248@haskell.org> #14331: Overzealous free-floating kind check causes deriving clause to be rejected -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: merge Priority: normal | Milestone: 8.2.2 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): > the logic in comment:26 also means that `data Proxy a = P deriving Functor` should fail Not at all! After elaborating the data type decl we have {{{ data P {k} (a::k) = P deriving( Functor ) }}} Now we create an instance declaration in which we are free to instantiate `k` (and indeed `a`) as much as we plase: {{{ instance Functor (P (*->*)) where ... }}} The quantified variables of the data type decl can freely be instantiated in the (derived) instance. We want the most general such instantiation so that the derived instance is applicable as much as poss; hence unification. I have belatedly realised that the real stumbling block here is when the same variable appears ''both'' in the data type decl ''and'' in the `deriving` clause. For example here {{{ -- C :: * -> * -> Constraint data D k (a::k) = ... deriving( forall x. C x ) }}} is fine: we get an instance looking like {{{ instance forall x (b::*). (...) => C x (D * b) where ... }}} The `x` from the `deriving` is universally quantified in the instance; the `k` and `a` are instantiated to `*` and `b` respectively; then we quantify over `b`. But the nasty case is this: {{{ data D k (a::k) = ... deriving( C2 k a ) }}} The `k` and `a` belong both to the data decl (hence it's in the "freely instantiate" camp) but also belong somehow in the instance. Can I freely instantiate the `k` in the instance? And the `k`? It'd be very odd if I got an instance like {{{ instance ... => C2 * a (D * a) where ... }}} because the `deriving` part explicitly said `k` not `*`. This seems very hard to specify. It's much easier to think of the data type decl and the instance entirely separately. Do we need the same variable to appear in both places? That is, what if we said that the type variables from the data type don't scope over the 'deriving' clause? Then {{{ data D k (a::k) = ... deriving( C2 k a ) }}} would mean {{{ data D k (a::k) = ... deriving( forall kk aa. C2 kk aa ) }}} where I've alpha-renamed to make it clear. What would go wrong if we did that? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 18 08:37:47 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 18 Oct 2017 08:37:47 -0000 Subject: [GHC] #13450: Better parse error for empy character literal In-Reply-To: <050.83e6f9a404a53c1bc5e7037bac0334a8@haskell.org> References: <050.83e6f9a404a53c1bc5e7037bac0334a8@haskell.org> Message-ID: <065.58e5167e638b8b05d4478af8836a321a@haskell.org> #13450: Better parse error for empy character literal -------------------------------------+------------------------------------- Reporter: parsonsmatt | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.0.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): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Simon Peyton Jones ): In [changeset:"74cd1be0b2778ad99566cde085328bde2090294a/ghc" 74cd1be0/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="74cd1be0b2778ad99566cde085328bde2090294a" Don't deeply expand insolubles Trac #13450 went bananas if we expand insoluble constraints. Better just to leave them un-expanded. I'm not sure in detail about why it goes so badly wrong; but regardless, the less we mess around with insoluble contraints the better the error messages will be. }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 18 08:37:47 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 18 Oct 2017 08:37:47 -0000 Subject: [GHC] #14333: GHC doesn't use the fact that Coercible is symmetric In-Reply-To: <051.317ebc999077ee18339a9e5fa0ad5d1c@haskell.org> References: <051.317ebc999077ee18339a9e5fa0ad5d1c@haskell.org> Message-ID: <066.f535fc31e909f868dd2af51d6d704a35@haskell.org> #14333: GHC doesn't use the fact that Coercible is symmetric -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: | Keywords: TypeFamilies, | 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 Simon Peyton Jones ): In [changeset:"5a66d574890ed09859ca912c9e0969dba72f4a23/ghc" 5a66d57/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="5a66d574890ed09859ca912c9e0969dba72f4a23" Better solving for representational equalities This patch adds a bit of extra solving power for representational equality constraints to fix Trac #14333 The main changes: * Fix a buglet in TcType.isInsolubleOccursCheck which wrongly reported a definite occurs-check error for (a ~R# b a) * Get rid of TcSMonad.emitInsolubles. It had an ad-hoc duplicate-removal piece that is better handled in interactIrred, now that insolubles are Irreds. We need a little care to keep inert_count (which does not include insolubles) accurate. * Refactor TcInteract.solveOneFromTheOther, to return a much simpler type. It was just over-complicated before. * Make TcInteract.interactIrred look for constraints that match either way around, in TcInteract.findMatchingIrreds This wasn't hard and it cleaned up quite a bit of code. }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 18 08:44:24 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 18 Oct 2017 08:44:24 -0000 Subject: [GHC] #13450: Better parse error for empy character literal In-Reply-To: <050.83e6f9a404a53c1bc5e7037bac0334a8@haskell.org> References: <050.83e6f9a404a53c1bc5e7037bac0334a8@haskell.org> Message-ID: <065.77f4970be6ff37022b03a12a68dec1cd@haskell.org> #13450: Better parse error for empy character literal -------------------------------------+------------------------------------- Reporter: parsonsmatt | Owner: (none) Type: feature request | Status: closed Priority: normal | Milestone: Component: Compiler | Version: 8.0.1 Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Poor/confusing | Test Case: error message | typecheck/should_fail/T14350 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * status: new => closed * testcase: => typecheck/should_fail/T14350 * resolution: => fixed -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 18 08:45:30 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 18 Oct 2017 08:45:30 -0000 Subject: [GHC] #14333: GHC doesn't use the fact that Coercible is symmetric In-Reply-To: <051.317ebc999077ee18339a9e5fa0ad5d1c@haskell.org> References: <051.317ebc999077ee18339a9e5fa0ad5d1c@haskell.org> Message-ID: <066.df71a6b1987c10f9fabf82c22a77cc90@haskell.org> #14333: GHC doesn't use the fact that Coercible is symmetric -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: | Keywords: TypeFamilies, | 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): > Ooh. I'm curious. OK, take a look. Most of the patch is good regardless. If you disagree with the payload of the change (matching either way round) it'd be one- line change to take it out again. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 18 11:00:17 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 18 Oct 2017 11:00:17 -0000 Subject: [GHC] #13450: Better parse error for empy character literal In-Reply-To: <050.83e6f9a404a53c1bc5e7037bac0334a8@haskell.org> References: <050.83e6f9a404a53c1bc5e7037bac0334a8@haskell.org> Message-ID: <065.2f4da8d9cecd396abb4f7ce41795c023@haskell.org> #13450: Better parse error for empy character literal -------------------------------------+------------------------------------- Reporter: parsonsmatt | Owner: (none) Type: feature request | Status: closed Priority: normal | Milestone: Component: Compiler | Version: 8.0.1 Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Poor/confusing | Test Case: error message | typecheck/should_fail/T14350 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): Simon, the commit here doesn't fix this issue. (Did you mean #14350?) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 18 11:33:42 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 18 Oct 2017 11:33:42 -0000 Subject: [GHC] #14271: ghci hangs with -fexternal-interpreter -prof In-Reply-To: <047.35b6ee83038ae67884e53737c2b92695@haskell.org> References: <047.35b6ee83038ae67884e53737c2b92695@haskell.org> Message-ID: <062.78e86f015057413d6a17d18acb8274ac@haskell.org> #14271: ghci hangs with -fexternal-interpreter -prof -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: GHCi | Version: 8.2.1 Resolution: | Keywords: Operating System: Windows | Architecture: | Unknown/Multiple Type of failure: GHCi crash | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Phyx-): That's slightly worrying.. Do you happen to know which commit you were on before? I'd like to bisected this. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 18 11:43:33 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 18 Oct 2017 11:43:33 -0000 Subject: [GHC] #14323: Occurs check regressions in GHC 8.2.1 (and HEAD) In-Reply-To: <050.dbbfdd1cdcddb65fbaceda43a16d7074@haskell.org> References: <050.dbbfdd1cdcddb65fbaceda43a16d7074@haskell.org> Message-ID: <065.6a292eacad33013532b1b8ba44662bac@haskell.org> #14323: Occurs check regressions in GHC 8.2.1 (and HEAD) -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: 8.4.1 Component: Compiler (Type | Version: 8.2.1 checker) | Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #14333 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * status: new => closed * resolution: => fixed * related: => #14333 * milestone: => 8.4.1 Comment: Thanks to commit 5a66d574890ed09859ca912c9e0969dba72f4a23 (`Better solving for representational equalities`), both `hm2` and `hm3` from the original description now typecheck. See `typecheck/should_compile/T14333` from the testsuite. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 18 11:46:32 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 18 Oct 2017 11:46:32 -0000 Subject: [GHC] #14333: GHC doesn't use the fact that Coercible is symmetric In-Reply-To: <051.317ebc999077ee18339a9e5fa0ad5d1c@haskell.org> References: <051.317ebc999077ee18339a9e5fa0ad5d1c@haskell.org> Message-ID: <066.ab49288a07d7532f238abcc0b5764123@haskell.org> #14333: GHC doesn't use the fact that Coercible is symmetric -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: | Keywords: TypeFamilies, | Roles Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #14323 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * related: => #14323 Comment: Commit 5a66d574890ed09859ca912c9e0969dba72f4a23 fixed #14323 as well, so if the payload of that commit is reverted, make sure to re-open #14323 as well. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 18 12:13:37 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 18 Oct 2017 12:13:37 -0000 Subject: [GHC] #13450: Better parse error for empy character literal In-Reply-To: <050.83e6f9a404a53c1bc5e7037bac0334a8@haskell.org> References: <050.83e6f9a404a53c1bc5e7037bac0334a8@haskell.org> Message-ID: <065.baeaf49459d510756e2d3f081e0860d1@haskell.org> #13450: Better parse error for empy character literal -------------------------------------+------------------------------------- Reporter: parsonsmatt | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.0.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): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * status: closed => new * testcase: typecheck/should_fail/T14350 => * resolution: fixed => Comment: Darn. Yes, typo. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 18 12:13:55 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 18 Oct 2017 12:13:55 -0000 Subject: [GHC] #14350: Infinite loop when typechecking incorrect implementation (GHC HEAD only) In-Reply-To: <050.13c8453cb18174ae45ace93d1d6319c0@haskell.org> References: <050.13c8453cb18174ae45ace93d1d6319c0@haskell.org> Message-ID: <065.177bce7e840d8bc4b0e3139fef819618@haskell.org> #14350: Infinite loop when typechecking incorrect implementation (GHC HEAD only) -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: closed Priority: high | Milestone: 8.4.1 Component: Compiler (Type | Version: 8.3 checker) | Resolution: fixed | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: | typecheck/should_fail/T14350 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * status: new => closed * testcase: => typecheck/should_fail/T14350 * resolution: => fixed Comment: Fixed by {{{ In 74cd1be0/ghc: Don't deeply expand insolubles Trac #13450 went bananas if we expand insoluble constraints. Better just to leave them un-expanded. I'm not sure in detail about why it goes so badly wrong; but regardless, the less we mess around with insoluble contraints the better the error messages will be. }}} Sorry I mis-typed the trac ticket in the commit. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 18 12:14:41 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 18 Oct 2017 12:14:41 -0000 Subject: [GHC] #14346: 8.2.1 regression: heap corruption after safe foreign calls In-Reply-To: <049.7a4af7d8399ac93444ea4b9211bf91ff@haskell.org> References: <049.7a4af7d8399ac93444ea4b9211bf91ff@haskell.org> Message-ID: <064.308b09904cad03b88530e5c94e9c5041@haskell.org> #14346: 8.2.1 regression: heap corruption after safe foreign calls -------------------------------------+------------------------------------- Reporter: andrewchen | Owner: (none) Type: bug | Status: infoneeded Priority: highest | Milestone: Component: Runtime System | Version: 8.2.1 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 alexbiehl): I had a look at the cmm code for comment [comment:14] and I have some questions: {{{ c4CO: // global _s4Bx::I64 = R1 + 16; <---- assign _s4Bx the pointer to the first byte of the bytearray (16 byte = infotable ptr + length field ) goto c4CW; c4CW: // global I32[_s4Bx::I64] = 3735928559 :: W32; (_s4BE::I64) = call "ccall" arg hints: [] result hints: [`signed'] rtsSupportsBoundThreads(); if (_s4BE::I64 != 0) goto c4Dz; else goto c4DE; c4Dz: // global I64[Sp - 8] = block_c4Dx_info; R2 = Main.main2_closure+1; I64[Sp] = _s4Bx::I64; <------ is it ok to store an address which clearly points into heap allocated memory but doesn't point to an info table? Sp = Sp - 8; call GHC.Conc.Windows.threadDelay1_info(R2) returns to c4Dx, args: 8, res: 8, upd: 8; c4Dx: // global _s4Bx::I64 = I64[Sp + 8]; goto c4D2; c4DE: // global I64[Sp - 8] = block_c4DD_info; R1 = 10; <------- overwrite R1, R1 was our *only* reference to the bytearray closure. I64[Sp] = _s4Bx::I64; Sp = Sp - 8; call stg_delay#(R1) returns to c4DD, args: 8, res: 8, upd: 8; c4DD: // global _s4Bx::I64 = I64[Sp + 8]; goto c4D2; c4D2: // global }}} - The only reference to the ByteArray closure is in R1 - _s4Bx points to the first byte in the byte array - In block c4DE R1 is overwritten. - The rtsSupportsBoundThreads is a ccall, don't we have to save R1 over these calls? Maybe the garbage collector assumes the ByteArray is dead and collects it too early? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 18 12:18:29 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 18 Oct 2017 12:18:29 -0000 Subject: [GHC] #14364: Reduce repetition in derived Read instances In-Reply-To: <046.9abf8af51367f0badd76eab5f23e3eb1@haskell.org> References: <046.9abf8af51367f0badd76eab5f23e3eb1@haskell.org> Message-ID: <061.62318753a4a481d5952ccf16939b68eb@haskell.org> #14364: Reduce repetition in derived Read instances -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: task | Status: new Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.2.1 Resolution: | Keywords: deriving Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #10980 #7258 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by tdammers): Some manual experimentation using hand-written `Read` instances suggests that factoring out `readField` would indeed cut down compile times significantly. For a 10-field record type, the generated `Read` instance and a hand- written one with all the field parsers written inline both take 0.14 seconds to compile, and the register allocator shows up high in the profile. Manually rewriting the `Read` instance to use `readField` instead cuts it to 0.11 seconds, so I am now implementing this in `TcGenDeriv` to see how much of a difference it makes on larger record types. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 18 13:04:46 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 18 Oct 2017 13:04:46 -0000 Subject: [GHC] #14366: Type family equation refuses to unify wildcard type patterns Message-ID: <050.99fc7b3497a7cbec29b57a49c9d2896b@haskell.org> #14366: Type family equation refuses to unify wildcard type patterns -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 (Type checker) | Keywords: TypeFamilies, | Operating System: Unknown/Multiple TypeInType | Architecture: | Type of failure: GHC rejects Unknown/Multiple | valid program Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- This typechecks: {{{#!hs {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeInType #-} {-# LANGUAGE TypeOperators #-} import Data.Kind import Data.Type.Equality type family Cast (e :: a :~: b) (x :: a) :: b where Cast Refl x = x }}} However, if you try to make the kinds `a` and `b` explicit arguments to `Cast`: {{{#!hs {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeInType #-} {-# LANGUAGE TypeOperators #-} import Data.Kind import Data.Type.Equality type family Cast (a :: Type) (b :: Type) (e :: a :~: b) (x :: a) :: b where Cast _ _ Refl x = x }}} Then GHC gets confused: {{{ GHCi, version 8.2.1: http://www.haskell.org/ghc/ :? for help Loaded GHCi configuration from /home/ryanglscott/.ghci [1 of 1] Compiling Main ( Bug.hs, interpreted ) Bug.hs:9:12: error: • Expected kind ‘_ :~: _1’, but ‘'Refl’ has kind ‘_ :~: _’ • In the third argument of ‘Cast’, namely ‘Refl’ In the type family declaration for ‘Cast’ | 9 | Cast _ _ Refl x = x | ^^^^ }}} A workaround is to explicitly write out what should be inferred by the underscores: {{{#!hs {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeInType #-} {-# LANGUAGE TypeOperators #-} import Data.Kind import Data.Type.Equality type family Cast (a :: Type) (b :: Type) (e :: a :~: b) (x :: a) :: b where Cast a a Refl x = x }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 18 13:04:50 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 18 Oct 2017 13:04:50 -0000 Subject: [GHC] #14367: Lazy evaluation can be invalidated Message-ID: <044.160607d34b23537b8391703de15721cd@haskell.org> #14367: Lazy evaluation can be invalidated -------------------------------------+------------------------------------- Reporter: vanto | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: Other Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- Evaluating arguments only if and when they are needed. This is the first principle of lazy evaluation.\\ Example:\\ {{{ Prelude> let f True x y = x Prelude> f True 3 (3/0) 3 }}} Good answer! See this:\\ {{{ Prelude> f True 8 undefined 8 }}} and:\\ {{{ Prelude> f True undefined 8 *** Exception: Prelude.undefined CallStack (from HasCallStack): error, called at libraries\base\GHC\Err.hs:79:14 in base:GHC.Err undefined, called at :2:8 in interactive:Ghci2 }}} These results are all correct because the evaluated expression (function) is non-strict.\\ The same expression below with a changed argument:\\ {{{ Prelude> f True 3 _ :54:10: error: * Found hole: _ :: p20 Where: `p20' is an ambiguous type variable * In the third argument of `f', namely `_' In the expression: f True 3 _ In an equation for `it': it = f True 3 _ * Relevant bindings include it :: p1 (bound at :54:1) }}} I understand this error, it is legitimate except that here, in this specific case, I would never use this expression.( i.e{{{_}}}) or the result of that expression if that result were to be used. Here the error message should not have priority. \\ This argument ( i.e {{{_}}}) does not need to be evaluated to calculate the result.\\ With Normal-Order Reduction, an expression is reduced only when absolutely necessary to continue the reduction.\\ So, here, who cares! Since this expression (i.e{{{_}}}), or the result is supposed never to be used.\\ It is the same for this example:\\ {{{ Prelude> f True 3 r :55:10: error: Variable not in scope: r }}} Idem, here the error message should not have priority. About {{{r}}} here, who cares! \\ By contrast here in this other example,{{{r}}} must be in the scope to be used:\\ {{{ Prelude> let g x t = x + t + r :56:21: error: Variable not in scope: r }}} Anyway,{{{(+)}}} is strict in both arguments.\\ I think leaving the priority to lazy evaluation will bring much more consistency in the results. Of course, ghc would take this error into account and send it after the compilation if needed. \\ These examples are not exaustive examples. See ticket [ticket:14355]. (although in this ticket, the thing is slightly different). -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 18 13:16:36 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 18 Oct 2017 13:16:36 -0000 Subject: [GHC] #14368: GHC 8.2.1 doesn't inform you when the monomorphism restriction kicks in anymore Message-ID: <050.621f9e352a173175860adefb5e5fb1ff@haskell.org> #14368: GHC 8.2.1 doesn't inform you when the monomorphism restriction kicks in anymore -------------------------------------+------------------------------------- Reporter: RyanGlScott | 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: Poor/confusing Unknown/Multiple | error message Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- This program doesn't typecheck due to the monomorphism restriction: {{{#!hs f = (==) }}} In GHC 8.0.2, the error message was quite helpful in informing you of this fact: {{{ GHCi, version 8.0.2: http://www.haskell.org/ghc/ :? for help Loaded GHCi configuration from /home/rgscott/.ghci [1 of 1] Compiling Main ( Bug.hs, interpreted ) Bug.hs:1:1: error: • Ambiguous type variable ‘a0’ arising from a use of ‘==’ prevents the constraint ‘(Eq a0)’ from being solved. Probable fix: use a type annotation to specify what ‘a0’ should be. These potential instances exist: instance Eq Ordering -- Defined in ‘GHC.Classes’ instance Eq Integer -- Defined in ‘integer-gmp-1.0.0.1:GHC.Integer.Type’ instance Eq a => Eq (Maybe a) -- Defined in ‘GHC.Base’ ...plus 22 others ...plus 7 instances involving out-of-scope types (use -fprint-potential-instances to see them all) • When instantiating ‘f’, initially inferred to have this overly-general type: forall a. Eq a => a -> a -> Bool NB: This instantiation can be caused by the monomorphism restriction. }}} Notice the `NB: This instantiation can be caused by the monomorphism restriction` part. But in GHC 8.2.1, this advice has mysteriously vanished! {{{ GHCi, version 8.2.1: http://www.haskell.org/ghc/ :? for help Loaded GHCi configuration from /home/rgscott/.ghci [1 of 1] Compiling Main ( Bug.hs, interpreted ) Bug.hs:1:5: error: • Ambiguous type variable ‘a0’ arising from a use of ‘==’ prevents the constraint ‘(Eq a0)’ from being solved. Relevant bindings include f :: a0 -> a0 -> Bool (bound at Bug.hs:1:1) Probable fix: use a type annotation to specify what ‘a0’ should be. These potential instances exist: instance Eq Ordering -- Defined in ‘GHC.Classes’ instance Eq Integer -- Defined in ‘integer-gmp-1.0.1.0:GHC.Integer.Type’ instance Eq a => Eq (Maybe a) -- Defined in ‘GHC.Base’ ...plus 22 others ...plus 9 instances involving out-of-scope types (use -fprint-potential-instances to see them all) • In the expression: (==) In an equation for ‘f’: f = (==) | 1 | f = (==) | ^^^^ }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 18 13:17:37 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 18 Oct 2017 13:17:37 -0000 Subject: [GHC] #14333: GHC doesn't use the fact that Coercible is symmetric In-Reply-To: <051.317ebc999077ee18339a9e5fa0ad5d1c@haskell.org> References: <051.317ebc999077ee18339a9e5fa0ad5d1c@haskell.org> Message-ID: <066.9f114ec00ce386c443e5c7b903f70c97@haskell.org> #14333: GHC doesn't use the fact that Coercible is symmetric -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: | Keywords: TypeFamilies, | Roles Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #14323 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by goldfire): Your patch solves a smaller problem than I was thinking of... but now I can't seem to think of it again. Regardless, your patch looks correct to me. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 18 13:18:14 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 18 Oct 2017 13:18:14 -0000 Subject: [GHC] #14364: Reduce repetition in derived Read instances In-Reply-To: <046.9abf8af51367f0badd76eab5f23e3eb1@haskell.org> References: <046.9abf8af51367f0badd76eab5f23e3eb1@haskell.org> Message-ID: <061.fd6b1c3a68433077a7785b71fdaa70b1@haskell.org> #14364: Reduce repetition in derived Read instances -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: task | Status: new Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.2.1 Resolution: | Keywords: deriving Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #10980 #7258 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by tdammers): Replying to [ticket:14364 bgamari]: > Let's factor this pattern out into a `readField` helper in `GHC.Read`, > {{{#!hs > readField :: String -> ReadPrec a -> ReadPrec a > readField fieldName readVal = do > expectP (Ident fieldName) > expectP (Punc "=") > readVal > {-# NOINLINE readField #-} > }}} > This will at least knock off a constant factor from the size of what should not be performance-critical code. The `readField` function actually has to be a bit more complex than that to cater for symbol-named fields (e.g. `(#)`). We can however make the decision at compile time, because we already know the label. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 18 13:20:49 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 18 Oct 2017 13:20:49 -0000 Subject: [GHC] #14368: GHC 8.2.1 doesn't inform you when the monomorphism restriction kicks in anymore In-Reply-To: <050.621f9e352a173175860adefb5e5fb1ff@haskell.org> References: <050.621f9e352a173175860adefb5e5fb1ff@haskell.org> Message-ID: <065.2b9bd344b6c69b5d05aec8ed524e86e2@haskell.org> #14368: GHC 8.2.1 doesn't inform you when the monomorphism restriction kicks in anymore -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.2.1 checker) | 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: simonpj (added) Comment: This regression occurred in commit 3f5673f34a2f761423027bf46f64f7499708725f (`A collection of type-inference refactorings.`). Simon, do you recall why you changed this error message? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 18 13:26:50 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 18 Oct 2017 13:26:50 -0000 Subject: [GHC] #14367: Lazy evaluation can be invalidated In-Reply-To: <044.160607d34b23537b8391703de15721cd@haskell.org> References: <044.160607d34b23537b8391703de15721cd@haskell.org> Message-ID: <059.57c390c33ab7e4ee7a74f51dae9a7aa4@haskell.org> #14367: Lazy evaluation can be invalidated -------------------------------------+------------------------------------- Reporter: vanto | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: invalid | 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 goldfire): * status: new => closed * resolution: => invalid Comment: It sounds like you want `-fdefer-type-errors` or `-fdefer-typed-holes`. Otherwise, GHC will run only well-typed programs. If you'd like a change in this behavior, please submit a ghc-proposal: that's the only accepted way to suggest a change to GHC's specification. Until then, this ticket is out of scope. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 18 13:28:53 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 18 Oct 2017 13:28:53 -0000 Subject: [GHC] #14366: Type family equation refuses to unify wildcard type patterns In-Reply-To: <050.99fc7b3497a7cbec29b57a49c9d2896b@haskell.org> References: <050.99fc7b3497a7cbec29b57a49c9d2896b@haskell.org> Message-ID: <065.ce7db00bbb1775d5393162ce250859ed@haskell.org> #14366: Type family equation refuses to unify wildcard type patterns -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.2.1 checker) | Keywords: TypeFamilies, Resolution: | 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 could go either way on this one. (Where I'm choosing between "that's correct behavior" and "that's a bug".) I interpret `_` in a type family equation to mean the same as a fresh type variable. And I also think that `Cast a b Refl x = x` is suspect. On the other hand, this is a bit silly of GHC not to unify. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 18 13:39:56 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 18 Oct 2017 13:39: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.767ebc1d69213ac44cc0e8615304fa4e@haskell.org> #14331: Overzealous free-floating kind check causes deriving clause to be rejected -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: merge Priority: normal | Milestone: 8.2.2 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'm afraid I mostly disagree with comment:28. Your first example is {{{#!hs -- C :: Type -> Type -> Constraint data D k (a :: k) = ... deriving (forall x. C x) }}} I think we get an instance {{{#!hs instance forall x k (a :: k). (...) => C x (D k a) }}} No instantiation is needed to get `D k a` to have kind `Type`. But I'm not terribly bothered here -- I don't think the general argument is wrong, just the example. In the next example (with `C2`), I'm not sure the kind of `C2`. Perhaps it's `forall k -> k -> Type -> Constraint`? But even so, we can get {{{#!hs instance ... => C2 k a (D k a) }}} without getting hurt. Regardless, I don't see how this argument refutes comment:27. The example I was considering was {{{#!hs class C a b data D a = D deriving (C (a :: k)) }}} where the `k` in the `deriving` clause is ''not'' mentioned in the data declaration. Thus the concerns in comment:28 don't apply. The `a` ''is'' mentioned, but it needs no unification. I do agree that this is hard to nail down. It seems, though, that one way forward is to say that any variables explicitly mentioned in the `deriving` clause are ''not'' free for unification. Other variables in the data decl but ''not'' in the deriving clause can be unified. This is a little strange perhaps, but not hard to articulate or understand. I do think it's worth asking if anyone ever really needs variables shared between the data decl and the `deriving` (Simon's last point in comment:28). -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 18 13:52:40 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 18 Oct 2017 13:52:40 -0000 Subject: [GHC] #14364: Reduce repetition in derived Read instances In-Reply-To: <046.9abf8af51367f0badd76eab5f23e3eb1@haskell.org> References: <046.9abf8af51367f0badd76eab5f23e3eb1@haskell.org> Message-ID: <061.fb92cc01e28d19b3f275d0e48e4c106c@haskell.org> #14364: Reduce repetition in derived Read instances -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: task | Status: new Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.2.1 Resolution: | Keywords: deriving Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #10980 #7258 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by tdammers): http://git.haskell.org/ghc.git/commitdiff/a6dd03e751d17467be10eea3ff1b1773d8d35893 factors out the field reader into `readField` and `readSymField` (the latter being used for symbol-named fields). Performance improvement is significant; before and after profiling output for a 500-field record example: Before: {{{ Wed Oct 18 09:02 2017 Time and Allocation Profiling Report (Final) ghc-stage2 +RTS -p -h -RTS -B/home/tobias/well- typed/devel/ghc/inplace/lib -B/home/tobias/well- typed/devel/ghc/inplace/lib -fforce-recomp -c /home/tobias/Downloads/W3.hs total time = 25.50 secs (25505 ticks @ 1000 us, 1 processor) total alloc = 24,693,071,936 bytes (excludes profiling overheads) COST CENTRE MODULE SRC %time %alloc RegAlloc-linear AsmCodeGen compiler/nativeGen/AsmCodeGen.hs:(658,27)-(660,55) 29.6 25.6 pprNativeCode AsmCodeGen compiler/nativeGen/AsmCodeGen.hs:(529,37)-(530,65) 16.9 22.2 regLiveness AsmCodeGen compiler/nativeGen/AsmCodeGen.hs:(591,17)-(593,52) 8.8 6.5 StgCmm HscMain compiler/main/HscMain.hs:(1426,13)-(1427,62) 8.7 8.3 NativeCodeGen CodeOutput compiler/main/CodeOutput.hs:171:18-78 7.3 7.9 genMachCode AsmCodeGen compiler/nativeGen/AsmCodeGen.hs:(580,17)-(582,62) 6.0 6.3 SimplTopBinds SimplCore compiler/simplCore/SimplCore.hs:761:39-74 2.8 3.9 CoreTidy HscMain compiler/main/HscMain.hs:1253:27-67 2.6 3.2 layoutStack CmmPipeline compiler/cmm/CmmPipeline.hs:(97,13)-(99,40) 2.1 2.6 deSugar HscMain compiler/main/HscMain.hs:511:7-44 2.0 2.7 CorePrep HscMain compiler/main/HscMain.hs:(1313,24)-(1314,57) 1.4 2.0 generateJumpTables AsmCodeGen compiler/nativeGen/AsmCodeGen.hs:689:17-50 1.3 0.7 fixStgRegisters AsmCodeGen compiler/nativeGen/AsmCodeGen.hs:566:17-42 1.1 0.7 cmmToCmm AsmCodeGen compiler/nativeGen/AsmCodeGen.hs:571:17-50 1.1 1.1 OccAnal SimplCore compiler/simplCore/SimplCore.hs:(739,22)-(740,67) 1.1 1.1 }}} After: {{{ Wed Oct 18 15:41 2017 Time and Allocation Profiling Report (Final) ghc-stage2 +RTS -p -h -RTS -B/home/tobias/well- typed/devel/ghc/inplace/lib -B/home/tobias/well- typed/devel/ghc/inplace/lib -fforce-recomp -c /home/tobias/Downloads/W3.hs total time = 14.78 secs (14784 ticks @ 1000 us, 1 processor) total alloc = 14,528,601,400 bytes (excludes profiling overheads) COST CENTRE MODULE SRC %time %alloc RegAlloc-linear AsmCodeGen compiler/nativeGen/AsmCodeGen.hs:(658,27)-(660,55) 26.0 22.0 pprNativeCode AsmCodeGen compiler/nativeGen/AsmCodeGen.hs:(529,37)-(530,65) 14.7 19.2 StgCmm HscMain compiler/main/HscMain.hs:(1426,13)-(1427,62) 8.8 7.8 regLiveness AsmCodeGen compiler/nativeGen/AsmCodeGen.hs:(591,17)-(593,52) 7.8 5.7 NativeCodeGen CodeOutput compiler/main/CodeOutput.hs:171:18-78 6.3 6.8 genMachCode AsmCodeGen compiler/nativeGen/AsmCodeGen.hs:(580,17)-(582,62) 5.3 5.5 SimplTopBinds SimplCore compiler/simplCore/SimplCore.hs:761:39-74 4.5 6.5 CoreTidy HscMain compiler/main/HscMain.hs:1253:27-67 4.4 5.5 deSugar HscMain compiler/main/HscMain.hs:511:7-44 3.4 4.5 CorePrep HscMain compiler/main/HscMain.hs:(1313,24)-(1314,57) 2.5 3.2 OccAnal SimplCore compiler/simplCore/SimplCore.hs:(739,22)-(740,67) 2.1 1.9 layoutStack CmmPipeline compiler/cmm/CmmPipeline.hs:(97,13)-(99,40) 1.9 2.3 Stg2Stg HscMain compiler/main/HscMain.hs:1489:12-44 1.4 1.0 generateJumpTables AsmCodeGen compiler/nativeGen/AsmCodeGen.hs:689:17-50 1.2 0.6 fixStgRegisters AsmCodeGen compiler/nativeGen/AsmCodeGen.hs:566:17-42 1.1 0.6 tc_rn_src_decls TcRnDriver compiler/typecheck/TcRnDriver.hs:(493,4)-(555,7) 1.1 0.8 cmmToCmm AsmCodeGen compiler/nativeGen/AsmCodeGen.hs:571:17-50 1.0 1.0 occAnalBind.assoc OccurAnal compiler/simplCore/OccurAnal.hs:853:13-60 0.9 1.0 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 18 13:55:57 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 18 Oct 2017 13:55:57 -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.e008d6c058cd7651bf4d7df628be5ab5@haskell.org> #14331: Overzealous free-floating kind check causes deriving clause to be rejected -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: merge Priority: normal | Milestone: 8.2.2 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): Replying to [comment:29 goldfire]: > I do think it's worth asking if anyone ever really needs variables shared between the data decl and the `deriving` (Simon's last point in comment:28). We certainly do. Here's an example from #3955: {{{#!hs newtype T a x = T (Reader a x) deriving (Monad, MonadReader a) }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 18 13:55:57 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 18 Oct 2017 13:55:57 -0000 Subject: [GHC] #14271: ghci hangs with -fexternal-interpreter -prof In-Reply-To: <047.35b6ee83038ae67884e53737c2b92695@haskell.org> References: <047.35b6ee83038ae67884e53737c2b92695@haskell.org> Message-ID: <062.48689a95ead7d264843941d77683b32b@haskell.org> #14271: ghci hangs with -fexternal-interpreter -prof -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: GHCi | Version: 8.2.1 Resolution: | Keywords: Operating System: Windows | Architecture: | Unknown/Multiple Type of failure: GHCi crash | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by AndreasK): Replying to [comment:7 Phyx-]: > That's slightly worrying.. Do you happen to know which commit you were on before? I'd like to bisected this. At commit a4ee28978acbcf68da9dfb6f198cb6e1ff38ccca on the tree I had on my laptop with a validating build. Seems like an error independent of the other issue though. {{{ inplace/bin/ghci.exe -fexternal-interpreter -prof WARNING: GHCi invoked via 'ghci.exe' in MinTTY consoles (e.g., Cygwin or MSYS) doesn't handle Ctrl-C well; use the 'ghcii.sh' shell wrapper instead GHCi, version 8.3.20171003: http://www.haskell.org/ghc/ :? for help :1:19: error: Not in scope: `System.IO.hSetBuffering' No module named `System.IO' is imported. :1:43: error: Not in scope: `System.IO.stdin' No module named `System.IO' is imported. :1:60: error: Not in scope: data constructor `System.IO.NoBuffering' No module named `System.IO' is imported. :1:81: error: Not in scope: `GHC.Base.thenIO' No module named `GHC.Base' is imported. :1:99: error: Not in scope: `System.IO.hSetBuffering' No module named `System.IO' is imported. :1:123: error: Not in scope: `System.IO.stdout' No module named `System.IO' is imported. :1:140: error: Not in scope: data constructor `System.IO.NoBuffering' No module named `System.IO' is imported. :1:161: error: Not in scope: `GHC.Base.thenIO' No module named `GHC.Base' is imported. :1:179: error: Not in scope: `System.IO.hSetBuffering' No module named `System.IO' is imported. :1:203: error: Not in scope: `System.IO.stderr' No module named `System.IO' is imported. :1:220: error: Not in scope: data constructor `System.IO.NoBuffering' No module named `System.IO' is imported. }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 18 13:57:00 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 18 Oct 2017 13:57:00 -0000 Subject: [GHC] #14362: Allow: Coercing (a:~:b) to (b:~:a) In-Reply-To: <051.de7b972e40c6148c97cf4a6c5f8259b3@haskell.org> References: <051.de7b972e40c6148c97cf4a6c5f8259b3@haskell.org> Message-ID: <066.bcccd3e1d8b6319c75160c3f9706084d@haskell.org> #14362: Allow: Coercing (a:~:b) to (b:~:a) -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 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): Replying to [comment:9 simonpj]: > * Is `(a :~: b) ~R# (b :~: a)` sound? You have described in your comment a new specification for representational equality: that two types are representationally equal when they are isomorphic and have identical runtime representations. It's too bad we never said that in the paper, because I agree with that specification. The paper then describes an incomplete "implementation" of that specification in its rules for representational equality. This is not the only source of incompleteness. See Appendix A.1 of [http://repository.brynmawr.edu/cgi/viewcontent.cgi?article=1013&context=compsci_pubs the extended version of the original ICFP paper]. So, to your question: Is such a thing sound? It would appear to be so, yes. But until we have a full theory that allows such a coercion without breaking something else, I can't be sure. > * And if so, what would be its evidence? We don't have any representation. And you're right that even if we had newtype-GADTs (which would give a new challenge to the Constraint-vs-Type debate, because they're somewhat the converse of newtype-classes), we couldn't pull this off. (I was wrong on this point, above.) The question is whether `(a ~# b) ~# (b ~# a)`. Right now, the answer is "no" because we can decompose `(~#)`. However, Stephanie's new theory ''can'' handle such things, because it was designed not to be able to decompose `(~#)`. I'm not intimately familiar with that end of her work, though. (In particular, I know it's forward-compatible with these ideas, but I don't know whether this end of the theory has been worked out in detail.) My bottom line: GHC's notion of representational equality is useful, but still quite limited. There are lots of ways of expanding it. This is one of them. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 18 14:00:52 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 18 Oct 2017 14:00:52 -0000 Subject: [GHC] #14366: Type family equation refuses to unify wildcard type patterns In-Reply-To: <050.99fc7b3497a7cbec29b57a49c9d2896b@haskell.org> References: <050.99fc7b3497a7cbec29b57a49c9d2896b@haskell.org> Message-ID: <065.9c2b7681c484c1b4ba9b1f4d70696671@haskell.org> #14366: Type family equation refuses to unify wildcard type patterns -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.2.1 checker) | Keywords: TypeFamilies, Resolution: | 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 RyanGlScott): Ah, you bring up a good point. I suppose the thing we really should be scrutinizng is `Cast a b Refl x = x`. I'm also a bit baffled that that doesn't work either—after all, something quite similar works at the term level! {{{#!hs {-# LANGUAGE GADTs #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeOperators #-} import Data.Type.Equality cast :: a :~: b -> a -> b -> Int cast Refl (_ :: a) (_ :: b) = 42 }}} I'm aware that this is a bit of a strawman, since comparing type families and scoped type pattern variables is a bit apples-and-oranges. But surely you can see the point I'm driving at here—if `a` and `b` are equated by the pattern match on `Refl`, should we reject the use of two syntactically different type variables for the second and third arguments of `cast`? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 18 14:13:48 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 18 Oct 2017 14:13:48 -0000 Subject: [GHC] #14366: Type family equation refuses to unify wildcard type patterns In-Reply-To: <050.99fc7b3497a7cbec29b57a49c9d2896b@haskell.org> References: <050.99fc7b3497a7cbec29b57a49c9d2896b@haskell.org> Message-ID: <065.93f80b9cd634d8a437e50f4839050fa5@haskell.org> #14366: Type family equation refuses to unify wildcard type patterns -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.2.1 checker) | Keywords: TypeFamilies, Resolution: | 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 RyanGlScott): Contrast this with a similar type family declaration, which is rejected: {{{#!hs {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeInType #-} {-# LANGUAGE TypeOperators #-} import Data.Kind import Data.Type.Equality import GHC.TypeNats type family Cast (e :: a :~: b) (x :: a) (y :: b) :: Nat where Cast Refl (_ :: a) (_ :: b) = 42 }}} {{{ GHCi, version 8.2.1: http://www.haskell.org/ghc/ :? for help Loaded GHCi configuration from /home/rgscott/.ghci [1 of 1] Compiling Main ( Bug.hs, interpreted ) Bug.hs:10:22: error: • Expected kind ‘a’, but ‘_’ has kind ‘b’ • In the third argument of ‘Cast’, namely ‘(_ :: b)’ In the type family declaration for ‘Cast’ | 10 | Cast Refl (_ :: a) (_ :: b) = 42 | ^^^^^^^^ }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 18 14:20:25 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 18 Oct 2017 14:20:25 -0000 Subject: [GHC] #14366: Type family equation refuses to unify wildcard type patterns In-Reply-To: <050.99fc7b3497a7cbec29b57a49c9d2896b@haskell.org> References: <050.99fc7b3497a7cbec29b57a49c9d2896b@haskell.org> Message-ID: <065.ff62f9f3e7291796290c140ea9aa8d0c@haskell.org> #14366: Type family equation refuses to unify wildcard type patterns -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.2.1 checker) | Keywords: TypeFamilies, Resolution: | 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 Agda used to reject having two different variables here, though it seems to be accepting it now. (Any Agda experts out there?) I think the pattern-signature version is a red herring, because those variables are meant to stand in for others -- indeed, that's their whole point. But I'm still not terribly bothered by this rejection. Yes, I suppose it's better to accept here, but I don't think that goal is easily achieved. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 18 14:29:10 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 18 Oct 2017 14:29:10 -0000 Subject: [GHC] #14367: Lazy evaluation can be invalidated In-Reply-To: <044.160607d34b23537b8391703de15721cd@haskell.org> References: <044.160607d34b23537b8391703de15721cd@haskell.org> Message-ID: <059.9d88b7e132c18399b3077b57f1de4413@haskell.org> #14367: Lazy evaluation can be invalidated -------------------------------------+------------------------------------- Reporter: vanto | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: invalid | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Other | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by vanto): replying to [[span(style=color: #FF0000, goldfire )]]:\\ >It sounds like you want -fdefer-type-errors or -fdefer-typed-holes.\\ Not at all.\\ By this answer it seems that you did not understand, or rather that you do not want to understand. And this is not the first time. Be a little more respectful, please. I would prefer a little more reflection on your part, this response to the fast looks like an inconsiderate rejection. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 18 15:03:56 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 18 Oct 2017 15:03:56 -0000 Subject: [GHC] #14367: Lazy evaluation can be invalidated In-Reply-To: <044.160607d34b23537b8391703de15721cd@haskell.org> References: <044.160607d34b23537b8391703de15721cd@haskell.org> Message-ID: <059.351a3d9b0fba8b8e804806e4d91fde48@haskell.org> #14367: Lazy evaluation can be invalidated -------------------------------------+------------------------------------- Reporter: vanto | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: invalid | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Other | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by int-e): There is a curiosity here, IMHO: {{{ GHCi, version 8.2.1: http://www.haskell.org/ghc/ :? for help Prelude> :set -fdefer-typed-holes -Wno-typed-holes Prelude> :set -fdefer-out-of-scope-variables -Wno-deferred-out-of-scope- variables Prelude> let x = [_]; y = [r] Prelude> (length x, length y) (1,1) Prelude> length [_] :4:9: error: • Found hole: _ :: a0 Where: ‘a0’ is an ambiguous type variable • In the expression: _ In the first argument of ‘length’, namely ‘[_]’ In the expression: length [_] • Relevant bindings include it :: Int (bound at :4:1) Prelude> length [r] 1 }}} Why does the `length [_]` expression produce a compile time error? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 18 15:25:13 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 18 Oct 2017 15:25:13 -0000 Subject: [GHC] #14367: Lazy evaluation can be invalidated In-Reply-To: <044.160607d34b23537b8391703de15721cd@haskell.org> References: <044.160607d34b23537b8391703de15721cd@haskell.org> Message-ID: <059.eb2e239884c8b643e3bf2ffba7df1409@haskell.org> #14367: Lazy evaluation can be invalidated -------------------------------------+------------------------------------- Reporter: vanto | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: invalid | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Other | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by vanto): replying to [[span(style=color: #FF0000, int-e )]]:\\ Because here it is calculated, so there is an error. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 18 15:44:32 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 18 Oct 2017 15:44:32 -0000 Subject: [GHC] #14135: PatternSynonyms regression in GHC HEAD (expectJust mkOneConFull) In-Reply-To: <050.a39b92c3108f361708a6e28740f79fdc@haskell.org> References: <050.a39b92c3108f361708a6e28740f79fdc@haskell.org> Message-ID: <065.db79769c65f762aecabb80a142dd61cd@haskell.org> #14135: PatternSynonyms regression in GHC HEAD (expectJust mkOneConFull) -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.4.1 Component: Compiler | Version: 8.3 Resolution: | Keywords: | PatternSynonyms 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): Phab:D3981 Wiki Page: | -------------------------------------+------------------------------------- Changes (by carlostome): * owner: carlostome => (none) * status: patch => new Comment: I'm still stuck on this, and right now I don't have that much time to work on it. I'll drop it for someone else to work on it. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 18 15:50:43 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 18 Oct 2017 15:50:43 -0000 Subject: [GHC] #14369: GHC warns an injective type family "may not be injective" Message-ID: <050.6468df70b5f2384c406960d5a58f21dc@haskell.org> #14369: GHC warns an injective type family "may not be injective" -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 (Type checker) | Keywords: | Operating System: Unknown/Multiple InjectiveFamilies | Architecture: | Type of failure: Poor/confusing Unknown/Multiple | error message Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- {{{#!hs {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilyDependencies #-} {-# LANGUAGE TypeInType #-} {-# LANGUAGE TypeOperators #-} data family Sing (a :: k) data instance Sing (z :: Maybe a) where SNothing :: Sing Nothing SJust :: Sing x -> Sing (Just x) class SingKind k where type Demote k = r | r -> k fromSing :: Sing (a :: k) -> Demote k instance SingKind a => SingKind (Maybe a) where type Demote (Maybe a) = Maybe (Demote a) fromSing SNothing = Nothing fromSing (SJust x) = Just (fromSing x) f :: forall (x :: forall a. Maybe a) a. SingKind a => Sing x -> Maybe (Demote a) f = fromSing }}} {{{ GHCi, version 8.2.1: http://www.haskell.org/ghc/ :? for help Loaded GHCi configuration from /home/rgscott/.ghci [1 of 1] Compiling Main ( Bug.hs, interpreted ) Bug.hs:26:5: error: • Couldn't match type ‘Demote a’ with ‘Demote a1’ Expected type: Sing (x a) -> Maybe (Demote a1) Actual type: Sing (x a) -> Demote (Maybe a) NB: ‘Demote’ is a type function, and may not be injective • In the expression: fromSing In an equation for ‘f’: f = fromSing • Relevant bindings include f :: Sing (x a) -> Maybe (Demote a1) (bound at Bug.hs:26:1) | 26 | f = fromSing | ^^^^^^^^ }}} That `NB: ‘Demote’ is a type function, and may not be injective` suggestion shouldn't be shown here, since `Demote` is definitely injective. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 18 16:06:32 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 18 Oct 2017 16:06:32 -0000 Subject: [GHC] #14367: Lazy evaluation can be invalidated In-Reply-To: <044.160607d34b23537b8391703de15721cd@haskell.org> References: <044.160607d34b23537b8391703de15721cd@haskell.org> Message-ID: <059.8c2944930b9ec2884edeae4d52e81bd6@haskell.org> #14367: Lazy evaluation can be invalidated -------------------------------------+------------------------------------- Reporter: vanto | 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: Other | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by vanto): * status: closed => new * resolution: invalid => Comment: Replying to [[span(style=color: #FF0000, goldfire, second time )]]:\\ I reopened this ticket for you to answer.\\ What do you say about that?\\ {{{ Prelude> f True 6 (\x -> ('r'/'u')) :4:18: error: * Could not deduce (Fractional Char) arising from a use of `/' from the context: Num p1 bound by the inferred type of it :: Num p1 => p1 at :4:1-26 * In the expression: ('r' / 'u') In the third argument of `f', namely `(\ x -> ('r' / 'u'))' In the expression: f True 6 (\ x -> ('r' / 'u')) }}} Who cares! the result must be 6 because of the lazy evaluation.\\ And this:\\ {{{ Prelude> f True 6 (\x -> x+x)1 :8:1: error: * Non type-variable argument in the constraint: Num (t1 -> t2) (Use FlexibleContexts to permit this) * When checking the inferred type it :: forall t1 t2. (Num (t1 -> t2), Num t1) => t2 }}} the result must be 6 because of the lazy evaluation too.\\ But here, that run:\\ {{{ Prelude> f True 6 ((\x -> x+x)1) 6 }}} that does not make sense,it should not have an evaluation on the last expression taken into account. \\ some result given by the compiler are '''not coherent,''' but however they are fair because GHC has been coded in this sense. '''Some priorities should be reversed,''' including lazy evaluation and errors. with -fdefer- typed-holes and -fdefer-out-of-scope-variables you answered the problem in part, but not in its entirety.\\ take your time to think about that.\\ do you understand this time? Thanks! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 18 16:26:02 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 18 Oct 2017 16:26:02 -0000 Subject: [GHC] #14369: GHC warns an injective type family "may not be injective" In-Reply-To: <050.6468df70b5f2384c406960d5a58f21dc@haskell.org> References: <050.6468df70b5f2384c406960d5a58f21dc@haskell.org> Message-ID: <065.f34e25a4b952976b777c2272f74c27b4@haskell.org> #14369: GHC warns an injective type family "may not be injective" -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: Component: Compiler (Type | Version: 8.2.1 checker) | Keywords: Resolution: | InjectiveFamilies 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:D4106 Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * status: new => patch * differential: => Phab:D4106 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 18 17:51:38 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 18 Oct 2017 17:51:38 -0000 Subject: [GHC] #7258: Compiling DynFlags is jolly slow In-Reply-To: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> References: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> Message-ID: <061.a201957fe5e228584d6680e94542b381@haskell.org> #7258: Compiling DynFlags is jolly slow -------------------------------------+------------------------------------- Reporter: simonpj | Owner: simonpj Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.6.1 Resolution: | Keywords: deriving-perf 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): On further thought, #14364 is a bit of a stop-gap measure; generating more efficient `Read` instances is of course a good thing, but the register allocator edge case remains, and hand-written code (or TH-generated code) that follows a similar pattern will still hit it. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 18 19:22:30 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 18 Oct 2017 19:22:30 -0000 Subject: [GHC] #14367: Lazy evaluation can be invalidated In-Reply-To: <044.160607d34b23537b8391703de15721cd@haskell.org> References: <044.160607d34b23537b8391703de15721cd@haskell.org> Message-ID: <059.ba4199e4f5a799c14eba48b592b1d540@haskell.org> #14367: Lazy evaluation can be invalidated -------------------------------------+------------------------------------- Reporter: vanto | 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: Other | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by vanto): Replying to [[span(style=color: #FF0000, goldfire, third time )]]:\\ > If you'd like a change in this behavior, please submit a ghc-proposal: that's the only accepted way to suggest a change to GHC's specification. \\ Yes I know that but you are not interested in what I say, is'nt it? \\ >Until then, this ticket is out of scope.\\ This is your point of view, not mine because these are ideas that serve for the ticket, like you, when you write your ideas in other tickets. It's the same thing. \\ >Otherwise, GHC will run only well-typed programs.\\ Yes. Imagine that behind the argument {{{x}}} there are a hundred other expressions? And still imagines there are hundred other functions like this one? This is possible, you do not know! All these expressions must be well typed. And yet they will never be used. They will still be checked by the type inference algorithm. Waste of time! And possible danger thereafter. We do not keep unnecessary things in a program. The type inference algorithm computes, it does not make any decision. And why? Because it was never thought to do this. It would have been better to ask oneself before checking whether the expression or the function to be used is well typed if it will later serve in another function or in another expression.Otherwise what is the use of testing functions or expressions if we know that they will never be used? Since the language exists, has anyone ever thought of that? The type inference can be improved not by calculation but by adding decision making. But that is another matter, is'nt it? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 18 19:50:52 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 18 Oct 2017 19:50:52 -0000 Subject: [GHC] #11343: Unable to infer type when using DuplicateRecordFields In-Reply-To: <049.6becc7f1facb1381b419a45f19851622@haskell.org> References: <049.6becc7f1facb1381b419a45f19851622@haskell.org> Message-ID: <064.7517a32cc02972bc078730409ef0b53f@haskell.org> #11343: Unable to infer type when using DuplicateRecordFields -------------------------------------+------------------------------------- Reporter: mpickering | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 7.11 checker) | 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 adamgundry): I've just put together this GHC proposal, which if accepted would essentially resolve this ticket as wontfix (and restrict the uses of `DuplicateRecordFields` still further): https://github.com/ghc-proposals /ghc-proposals/pull/84 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 18 19:51:49 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 18 Oct 2017 19:51:49 -0000 Subject: [GHC] #13861: Take more advantage of STG representation invariance (follows up #9291) In-Reply-To: <048.651e325a747e822318af666cede88e81@haskell.org> References: <048.651e325a747e822318af666cede88e81@haskell.org> Message-ID: <063.38c0c3f29a2b027aaa04a401a43da817@haskell.org> #13861: Take more advantage of STG representation invariance (follows up #9291) -------------------------------------+------------------------------------- Reporter: heisenbug | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.0.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): Replying to [comment:9 heisenbug]: > > Probably the motivation was "we'll think about this later". Implementation complexity seems to be fairly low, see my branch (caveat: ''very WIP'') https://github.com/ggreif/ghc/tree/wip/tag-big-families The last checkin does bootstrap GHC and seems to do well not he test side. Code still is not as pretty as I want it, but I shall clean it up in the next days. Can somebody do a perf evaluation with it? Thanks! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 18 19:54:17 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 18 Oct 2017 19:54:17 -0000 Subject: [GHC] #14312: Head does not build on Windows with the default make config. In-Reply-To: <047.086b87bb9b3dcf2f7a921149fa31eda2@haskell.org> References: <047.086b87bb9b3dcf2f7a921149fa31eda2@haskell.org> Message-ID: <062.2009e388e396589f0ce55b75e4003a24@haskell.org> #14312: Head does not build on Windows with the default make config. -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: Component: Build System | Version: 8.3 Resolution: | Keywords: Operating System: Windows | Architecture: Type of failure: Building GHC | Unknown/Multiple failed | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4080 Wiki Page: | -------------------------------------+------------------------------------- Changes (by Phyx-): * cc: Phyx- (added) Comment: Replying to [comment:12 hvr]: > > > > **Specification of Header Files** A C header specified in an import declaration is always included by `#include "chname"`. There is no explicit support for `#include ` style inclusion. The ISO C99 standard guarantees that any search path that would be used for a `#include ` is also used for `#include "chname"` and it is guaranteed that these paths are searched after all paths that are unique to `#include "chname"`. Furthermore, we require that chname ends in .h to make parsing of the specification of external entities unambiguous. > > So `capi` kinda adheres to that by using a `#include ` and compensating via a `-I.` path included early. > Unless I'm mistaken, isn't that actually saying that `capi` doesn't follow the report? since your quote of the report says: > A C header specified in an import declaration is always included by `#include "chname"`. So from this line it means we're not following it by generating `#include ` doesn't it? Using `#include "..."` would solve this problem because it means we can avoid the `-I`, which I think it a very bad thing to add implicitly, as it overrides everything else. We're actually making correct programs break, which is unexpected... -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 18 20:07:19 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 18 Oct 2017 20:07:19 -0000 Subject: [GHC] #14370: non-deferred typed hole despite -fdefer-typed-holes Message-ID: <044.22e5f2aa694f3f07f37c874e3f79e431@haskell.org> #14370: non-deferred typed hole despite -fdefer-typed-holes -------------------------------------+------------------------------------- Reporter: int-e | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 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: -------------------------------------+------------------------------------- Consider the following ghci session. {{{ GHCi, version 8.2.1: http://www.haskell.org/ghc/ :? for help Prelude> :set -fdefer-typed-holes -Wno-typed-holes Prelude> :set -fdefer-out-of-scope-variables -Wno-deferred-out-of-scope- variables Prelude> let x = [_]; y = [r] Prelude> (length x, length y) (1,1) Prelude> length [_] :4:9: error: • Found hole: _ :: a0 Where: ‘a0’ is an ambiguous type variable • In the expression: _ In the first argument of ‘length’, namely ‘[_]’ In the expression: length [_] • Relevant bindings include it :: Int (bound at :4:1) Prelude> length [r] 1 }}} Why does the `length [_]` expression produce a type error immediately instead of being deferred? (I've asked the same question in #14367 but this looks like a real bug.) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 18 21:15:44 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 18 Oct 2017 21:15:44 -0000 Subject: [GHC] #14364: Reduce repetition in derived Read instances In-Reply-To: <046.9abf8af51367f0badd76eab5f23e3eb1@haskell.org> References: <046.9abf8af51367f0badd76eab5f23e3eb1@haskell.org> Message-ID: <061.68f0db2eb197fc5797b27763a5eda19c@haskell.org> #14364: Reduce repetition in derived Read instances -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: task | Status: new Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.2.1 Resolution: | Keywords: deriving Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #10980 #7258 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): Quite a difference indeed. It's not every day you see a 40% reduction in compile time. Can you put the patch up for review? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 18 21:17:42 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 18 Oct 2017 21:17:42 -0000 Subject: [GHC] #14371: ghc: panic! when reloading file with code Message-ID: <046.2ca65b2ac8b1dfae9409c8f965504c19@haskell.org> #14371: ghc: panic! when reloading file with code -------------------------------------+------------------------------------- Reporter: xvrbka1 | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- Hello, I have no idea what causes it (maybe my mistake) so I probably will give you more code then necessaty. Sorry for that. \\ **I had working code:** {{{ f :: [[Bool]] -> ([Bool], [[Bool]]) f [] = ([True], g []) f (x:xs) = (g x, g xs) g :: [a] -> [a] g [] = [] g x = x listITE :: [Bool] -> [a] -> [a] -> [a] listITE [] _ _ = [] listITE _ _ [] = [] listITE _ [] _ = [] listITE (b:bs) (x:xs) (y:ys) = [(if b then x else y)] ++ listITE bs xs ys --zipWith (\x,y -> if ) ; firstMatch :: (a -> a -> Bool) -> [a] -> a -> a firstMatch _ [] y = y firstMatch p (x:s) y = if index >= (length (x:s)) then y else (x:s) !! index where index = indexOf True (zipWith p (x:s) s) indexOf :: (Eq a) => a -> [a] -> Int indexOf _ [] = 10 indexOf c (x:s) = if c==x then 0 else 1 + indexOf c s }}} that I could load, run and reload. \\ ** After I wrote this and tried to reload:** {{{ countInversions :: (Ord a) => [a] -> Int countInversions [] = 0 countInversions (x:s) = (countSame (True==) (map (x>) s)) + countInversions s countSame :: (Ord a) => (a -> Bool) [a] -> Int countSame _ [] = 0; countSame p (x:s) = (if p x then 1 else 0) + indexOf c s }}} \\ **I get error:** ''ghc: panic! (the 'impossible' happened) (GHC version 8.2.1 for x86_64-unknown-linux): repSplitAppTys a_a6Xb[sk:1] Bool [] 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/types/Type.hs:808:9 in ghc:Type'' \\ I hope I found u a bug :) \\ Have a nice day -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 18 21:19:55 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 18 Oct 2017 21:19:55 -0000 Subject: [GHC] #14371: ghc: panic! when reloading file with code In-Reply-To: <046.2ca65b2ac8b1dfae9409c8f965504c19@haskell.org> References: <046.2ca65b2ac8b1dfae9409c8f965504c19@haskell.org> Message-ID: <061.905f8e4db81edf0def393bbb389c6dad@haskell.org> #14371: ghc: panic! when reloading file with code -------------------------------------+------------------------------------- Reporter: xvrbka1 | 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): Wiki Page: | -------------------------------------+------------------------------------- Description changed by xvrbka1: Old description: > Hello, > > I have no idea what causes it (maybe my mistake) so I probably will give > you more code then necessaty. Sorry for that. > \\ > **I had working code:** > > {{{ > f :: [[Bool]] -> ([Bool], [[Bool]]) > f [] = ([True], g []) > f (x:xs) = (g x, g xs) > > g :: [a] -> [a] > g [] = [] > g x = x > > listITE :: [Bool] -> [a] -> [a] -> [a] > listITE [] _ _ = [] > listITE _ _ [] = [] > listITE _ [] _ = [] > listITE (b:bs) (x:xs) (y:ys) = [(if b then x else y)] ++ listITE bs xs ys > --zipWith (\x,y -> if ) ; > > firstMatch :: (a -> a -> Bool) -> [a] -> a -> a > firstMatch _ [] y = y > firstMatch p (x:s) y = if index >= (length (x:s)) then y else (x:s) !! > index > where index = indexOf True (zipWith p (x:s) > s) > > indexOf :: (Eq a) => a -> [a] -> Int > indexOf _ [] = 10 > indexOf c (x:s) = if c==x then 0 else 1 + indexOf c s > }}} > that I could load, run and reload. > \\ > > ** > After I wrote this and tried to reload:** > {{{ > countInversions :: (Ord a) => [a] -> Int > countInversions [] = 0 > countInversions (x:s) = (countSame (True==) (map (x>) s)) + > countInversions s > > countSame :: (Ord a) => (a -> Bool) [a] -> Int > countSame _ [] = 0; > countSame p (x:s) = (if p x then 1 else 0) + indexOf c s > > }}} > \\ > > **I get error:** > ''ghc: panic! (the 'impossible' happened) > (GHC version 8.2.1 for x86_64-unknown-linux): > repSplitAppTys > a_a6Xb[sk:1] > Bool > [] > 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/types/Type.hs:808:9 in ghc:Type'' > \\ > > I hope I found u a bug :) > \\ > > Have a nice day New description: Hello, I have no idea what causes it (maybe my mistake) so I probably will give you more code then necessaty. Sorry for that. \\ **I had working code:** {{{ f :: [[Bool]] -> ([Bool], [[Bool]]) f [] = ([True], g []) f (x:xs) = (g x, g xs) g :: [a] -> [a] g [] = [] g x = x listITE :: [Bool] -> [a] -> [a] -> [a] listITE [] _ _ = [] listITE _ _ [] = [] listITE _ [] _ = [] listITE (b:bs) (x:xs) (y:ys) = [(if b then x else y)] ++ listITE bs xs ys --zipWith (\x,y -> if ) ; firstMatch :: (a -> a -> Bool) -> [a] -> a -> a firstMatch _ [] y = y firstMatch p (x:s) y = if index >= (length (x:s)) then y else (x:s) !! index where index = indexOf True (zipWith p (x:s) s) indexOf :: (Eq a) => a -> [a] -> Int indexOf _ [] = 10 indexOf c (x:s) = if c==x then 0 else 1 + indexOf c s }}} that I could load, run and reload. \\ ** After I wrote this and tried to reload:** {{{ countInversions :: (Ord a) => [a] -> Int countInversions [] = 0 countInversions (x:s) = (countSame (True==) (map (x>) s)) + countInversions s countSame :: (Ord a) => (a -> Bool) [a] -> Int countSame _ [] = 0; countSame p (x:s) = (if p x then 1 else 0) + indexOf c s }}} \\ **I get error:**\\ ''ghc: panic! (the 'impossible' happened) (GHC version 8.2.1 for x86_64-unknown-linux): repSplitAppTys a_a6Xb[sk:1] Bool [] 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/types/Type.hs:808:9 in ghc:Type'' \\ Now I cannot reaload or even load this file \\ I hope I found u a bug :) \\ Have a nice day -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 18 21:23:44 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 18 Oct 2017 21:23:44 -0000 Subject: [GHC] #14371: ghc: panic! when reloading file with code In-Reply-To: <046.2ca65b2ac8b1dfae9409c8f965504c19@haskell.org> References: <046.2ca65b2ac8b1dfae9409c8f965504c19@haskell.org> Message-ID: <061.da971d7a70e47c76742b02692b004d79@haskell.org> #14371: ghc: panic! when reloading file with code -------------------------------------+------------------------------------- Reporter: xvrbka1 | 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): Wiki Page: | -------------------------------------+------------------------------------- Description changed by xvrbka1: Old description: > Hello, > > I have no idea what causes it (maybe my mistake) so I probably will give > you more code then necessaty. Sorry for that. > \\ > **I had working code:** > > {{{ > f :: [[Bool]] -> ([Bool], [[Bool]]) > f [] = ([True], g []) > f (x:xs) = (g x, g xs) > > g :: [a] -> [a] > g [] = [] > g x = x > > listITE :: [Bool] -> [a] -> [a] -> [a] > listITE [] _ _ = [] > listITE _ _ [] = [] > listITE _ [] _ = [] > listITE (b:bs) (x:xs) (y:ys) = [(if b then x else y)] ++ listITE bs xs ys > --zipWith (\x,y -> if ) ; > > firstMatch :: (a -> a -> Bool) -> [a] -> a -> a > firstMatch _ [] y = y > firstMatch p (x:s) y = if index >= (length (x:s)) then y else (x:s) !! > index > where index = indexOf True (zipWith p (x:s) > s) > > indexOf :: (Eq a) => a -> [a] -> Int > indexOf _ [] = 10 > indexOf c (x:s) = if c==x then 0 else 1 + indexOf c s > }}} > that I could load, run and reload. > \\ > > ** > After I wrote this and tried to reload:** > {{{ > countInversions :: (Ord a) => [a] -> Int > countInversions [] = 0 > countInversions (x:s) = (countSame (True==) (map (x>) s)) + > countInversions s > > countSame :: (Ord a) => (a -> Bool) [a] -> Int > countSame _ [] = 0; > countSame p (x:s) = (if p x then 1 else 0) + indexOf c s > > }}} > \\ > > **I get error:**\\ > > ''ghc: panic! (the 'impossible' happened) > (GHC version 8.2.1 for x86_64-unknown-linux): > repSplitAppTys > a_a6Xb[sk:1] > Bool > [] > 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/types/Type.hs:808:9 in ghc:Type'' > \\ > Now I cannot reaload or even load this file > \\ > > I hope I found u a bug :) > \\ > > Have a nice day New description: Hello, I have no idea what causes it (maybe my mistake) so I probably will give you more code then necessaty. Sorry for that. \\ **I had working code:** {{{ f :: [[Bool]] -> ([Bool], [[Bool]]) f [] = ([True], g []) f (x:xs) = (g x, g xs) g :: [a] -> [a] g [] = [] g x = x listITE :: [Bool] -> [a] -> [a] -> [a] listITE [] _ _ = [] listITE _ _ [] = [] listITE _ [] _ = [] listITE (b:bs) (x:xs) (y:ys) = [(if b then x else y)] ++ listITE bs xs ys --zipWith (\x,y -> if ) ; firstMatch :: (a -> a -> Bool) -> [a] -> a -> a firstMatch _ [] y = y firstMatch p (x:s) y = if index >= (length (x:s)) then y else (x:s) !! index where index = indexOf True (zipWith p (x:s) s) indexOf :: (Eq a) => a -> [a] -> Int indexOf _ [] = 10 indexOf c (x:s) = if c==x then 0 else 1 + indexOf c s }}} that I could load, run and reload. \\ ** After I wrote this and tried to reload:** {{{ countInversions :: (Ord a) => [a] -> Int countInversions [] = 0 countInversions (x:s) = (countSame (True==) (map (x>) s)) + countInversions s countSame :: (Ord a) => (a -> Bool) [a] -> Int countSame _ [] = 0; countSame p (x:s) = (if p x then 1 else 0) + indexOf c s }}} \\ **I get error:**\\ ''ghc: panic! (the 'impossible' happened) (GHC version 8.2.1 for x86_64-unknown-linux): repSplitAppTys a_a6Xb[sk:1] Bool [] 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/types/Type.hs:808:9 in ghc:Type'' \\ Now I cannot reaload or even load this file (but when I remove the added part, everything is OK) \\ I hope I found u a bug :) \\ Have a nice day ps. with my playing I discover that == **THIS GIVES THE ERROR** \\ {{{ countSame :: (Ord a) => (a -> Bool) [a] -> Int countSame _ [] = 0; countSame p (x:s) = (if p x then 1 else 0) + indexOf c s }}} -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 18 21:25:49 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 18 Oct 2017 21:25:49 -0000 Subject: [GHC] #14371: ghc: panic! when reloading file with code In-Reply-To: <046.2ca65b2ac8b1dfae9409c8f965504c19@haskell.org> References: <046.2ca65b2ac8b1dfae9409c8f965504c19@haskell.org> Message-ID: <061.6917a2e7184652b47217f02f69d671b1@haskell.org> #14371: ghc: panic! when reloading file with code -------------------------------------+------------------------------------- Reporter: xvrbka1 | 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): Wiki Page: | -------------------------------------+------------------------------------- Description changed by xvrbka1: Old description: > Hello, > > I have no idea what causes it (maybe my mistake) so I probably will give > you more code then necessaty. Sorry for that. > \\ > **I had working code:** > > {{{ > f :: [[Bool]] -> ([Bool], [[Bool]]) > f [] = ([True], g []) > f (x:xs) = (g x, g xs) > > g :: [a] -> [a] > g [] = [] > g x = x > > listITE :: [Bool] -> [a] -> [a] -> [a] > listITE [] _ _ = [] > listITE _ _ [] = [] > listITE _ [] _ = [] > listITE (b:bs) (x:xs) (y:ys) = [(if b then x else y)] ++ listITE bs xs ys > --zipWith (\x,y -> if ) ; > > firstMatch :: (a -> a -> Bool) -> [a] -> a -> a > firstMatch _ [] y = y > firstMatch p (x:s) y = if index >= (length (x:s)) then y else (x:s) !! > index > where index = indexOf True (zipWith p (x:s) > s) > > indexOf :: (Eq a) => a -> [a] -> Int > indexOf _ [] = 10 > indexOf c (x:s) = if c==x then 0 else 1 + indexOf c s > }}} > that I could load, run and reload. > \\ > > ** > After I wrote this and tried to reload:** > {{{ > countInversions :: (Ord a) => [a] -> Int > countInversions [] = 0 > countInversions (x:s) = (countSame (True==) (map (x>) s)) + > countInversions s > > countSame :: (Ord a) => (a -> Bool) [a] -> Int > countSame _ [] = 0; > countSame p (x:s) = (if p x then 1 else 0) + indexOf c s > > }}} > \\ > > **I get error:**\\ > > ''ghc: panic! (the 'impossible' happened) > (GHC version 8.2.1 for x86_64-unknown-linux): > repSplitAppTys > a_a6Xb[sk:1] > Bool > [] > 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/types/Type.hs:808:9 in ghc:Type'' > \\ > Now I cannot reaload or even load this file (but when I remove the added > part, everything is OK) > \\ > > I hope I found u a bug :) > \\ > > Have a nice day > > ps. with my playing I discover that > > == **THIS GIVES THE ERROR** \\ > > {{{ > > countSame :: (Ord a) => (a -> Bool) [a] -> Int > countSame _ [] = 0; > countSame p (x:s) = (if p x then 1 else 0) + indexOf c s > }}} New description: Hello, I have no idea what causes it (maybe my mistake) so I probably will give you more code then necessaty. Sorry for that. \\ **I had working code:** {{{ f :: [[Bool]] -> ([Bool], [[Bool]]) f [] = ([True], g []) f (x:xs) = (g x, g xs) g :: [a] -> [a] g [] = [] g x = x listITE :: [Bool] -> [a] -> [a] -> [a] listITE [] _ _ = [] listITE _ _ [] = [] listITE _ [] _ = [] listITE (b:bs) (x:xs) (y:ys) = [(if b then x else y)] ++ listITE bs xs ys --zipWith (\x,y -> if ) ; firstMatch :: (a -> a -> Bool) -> [a] -> a -> a firstMatch _ [] y = y firstMatch p (x:s) y = if index >= (length (x:s)) then y else (x:s) !! index where index = indexOf True (zipWith p (x:s) s) indexOf :: (Eq a) => a -> [a] -> Int indexOf _ [] = 10 indexOf c (x:s) = if c==x then 0 else 1 + indexOf c s }}} that I could load, run and reload. \\ ** After I wrote this and tried to reload:** {{{ countInversions :: (Ord a) => [a] -> Int countInversions [] = 0 countInversions (x:s) = (countSame (True==) (map (x>) s)) + countInversions s countSame :: (Ord a) => (a -> Bool) [a] -> Int countSame _ [] = 0; countSame p (x:s) = (if p x then 1 else 0) + indexOf c s }}} \\ **I get error:**\\ ''ghc: panic! (the 'impossible' happened) (GHC version 8.2.1 for x86_64-unknown-linux): repSplitAppTys a_a6Xb[sk:1] Bool [] 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/types/Type.hs:808:9 in ghc:Type'' \\ Now I cannot reaload or even load this file (but when I remove the added part, everything is OK) \\ I hope I found u a bug :) \\ Have a nice day ps. with my playing I discover that == **THIS GIVES THE ERROR** \\ {{{ countSame :: (Ord a) => (a -> Bool) [a] -> Int countSame _ [] = 0; countSame p (x:s) = (if p x then 1 else 0) + indexOf c s }}} \\And works OK when header is gone -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 18 21:37:38 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 18 Oct 2017 21:37:38 -0000 Subject: [GHC] #14371: ghc: panic! when reloading file with code In-Reply-To: <046.2ca65b2ac8b1dfae9409c8f965504c19@haskell.org> References: <046.2ca65b2ac8b1dfae9409c8f965504c19@haskell.org> Message-ID: <061.d3bf5d5a6fa34988a6ddd1c8d618dbf6@haskell.org> #14371: ghc: panic! when reloading file with code -------------------------------------+------------------------------------- Reporter: xvrbka1 | 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): Wiki Page: | -------------------------------------+------------------------------------- Description changed by xvrbka1: Old description: > Hello, > > I have no idea what causes it (maybe my mistake) so I probably will give > you more code then necessaty. Sorry for that. > \\ > **I had working code:** > > {{{ > f :: [[Bool]] -> ([Bool], [[Bool]]) > f [] = ([True], g []) > f (x:xs) = (g x, g xs) > > g :: [a] -> [a] > g [] = [] > g x = x > > listITE :: [Bool] -> [a] -> [a] -> [a] > listITE [] _ _ = [] > listITE _ _ [] = [] > listITE _ [] _ = [] > listITE (b:bs) (x:xs) (y:ys) = [(if b then x else y)] ++ listITE bs xs ys > --zipWith (\x,y -> if ) ; > > firstMatch :: (a -> a -> Bool) -> [a] -> a -> a > firstMatch _ [] y = y > firstMatch p (x:s) y = if index >= (length (x:s)) then y else (x:s) !! > index > where index = indexOf True (zipWith p (x:s) > s) > > indexOf :: (Eq a) => a -> [a] -> Int > indexOf _ [] = 10 > indexOf c (x:s) = if c==x then 0 else 1 + indexOf c s > }}} > that I could load, run and reload. > \\ > > ** > After I wrote this and tried to reload:** > {{{ > countInversions :: (Ord a) => [a] -> Int > countInversions [] = 0 > countInversions (x:s) = (countSame (True==) (map (x>) s)) + > countInversions s > > countSame :: (Ord a) => (a -> Bool) [a] -> Int > countSame _ [] = 0; > countSame p (x:s) = (if p x then 1 else 0) + indexOf c s > > }}} > \\ > > **I get error:**\\ > > ''ghc: panic! (the 'impossible' happened) > (GHC version 8.2.1 for x86_64-unknown-linux): > repSplitAppTys > a_a6Xb[sk:1] > Bool > [] > 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/types/Type.hs:808:9 in ghc:Type'' > \\ > Now I cannot reaload or even load this file (but when I remove the added > part, everything is OK) > \\ > > I hope I found u a bug :) > \\ > > Have a nice day > > ps. with my playing I discover that > > == **THIS GIVES THE ERROR** \\ > > {{{ > > countSame :: (Ord a) => (a -> Bool) [a] -> Int > countSame _ [] = 0; > countSame p (x:s) = (if p x then 1 else 0) + indexOf c s > }}} > \\And works OK when header is gone New description: Hello, \\ ** This code:** {{{ countSame :: (Ord a) => (a -> Bool) [a] -> Int countSame _ [] = 0; countSame p (x:s) = (if p x then 1 else 0) + (countSame p s) }}} \\ **gives me an error:**\\ ''ghc: panic! (the 'impossible' happened) (GHC version 8.2.1 for x86_64-unknown-linux): repSplitAppTys a_a6Xb[sk:1] Bool [] 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/types/Type.hs:808:9 in ghc:Type'' \\ - All works when header is gone. - I put this code in separate file and error still occurs so it should not have any dependencies. I hope I found u a bug :) \\ Have a nice day -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 18 21:46:24 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 18 Oct 2017 21:46:24 -0000 Subject: [GHC] #14371: ghc: panic! when reloading file with code In-Reply-To: <046.2ca65b2ac8b1dfae9409c8f965504c19@haskell.org> References: <046.2ca65b2ac8b1dfae9409c8f965504c19@haskell.org> Message-ID: <061.215f7fef854b4605da0a9ab4defd9f69@haskell.org> #14371: ghc: panic! when reloading file with code -------------------------------------+------------------------------------- Reporter: xvrbka1 | 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): Wiki Page: | -------------------------------------+------------------------------------- Description changed by xvrbka1: Old description: > Hello, > > \\ > ** > This code:** > {{{ > countSame :: (Ord a) => (a -> Bool) [a] -> Int > countSame _ [] = 0; > countSame p (x:s) = (if p x then 1 else 0) + (countSame p s) > }}} > \\ > > **gives me an error:**\\ > > ''ghc: panic! (the 'impossible' happened) > (GHC version 8.2.1 for x86_64-unknown-linux): > repSplitAppTys > a_a6Xb[sk:1] > Bool > [] > 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/types/Type.hs:808:9 in ghc:Type'' > \\ > > - All works when header is gone. > - I put this code in separate file and error still occurs so it should > not have any dependencies. > > I hope I found u a bug :) > \\ > Have a nice day New description: Hello, \\ ** This code:** {{{ countSame :: (Ord a) => (a -> Bool) [a] -> Int countSame _ [] = 0; countSame p (x:s) = (if p x then 1 else 0) + (countSame p s) }}} \\ (There is a mistake in heared countSame :: (Ord a) => (a -> Bool) **->** [a] -> Int) \\ **gives me an error:**\\ ''ghc: panic! (the 'impossible' happened) (GHC version 8.2.1 for x86_64-unknown-linux): repSplitAppTys a_a6Xb[sk:1] Bool [] 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/types/Type.hs:808:9 in ghc:Type'' \\ - On some machines correctly recognized as broken header - I put this code in separate file and error still occurs so it should not have any dependencies. I hope I found u a bug :) \\ Have a nice day -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 18 21:49:56 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 18 Oct 2017 21:49:56 -0000 Subject: [GHC] #14371: ghc: panic! when reloading file with code In-Reply-To: <046.2ca65b2ac8b1dfae9409c8f965504c19@haskell.org> References: <046.2ca65b2ac8b1dfae9409c8f965504c19@haskell.org> Message-ID: <061.65753e3a2b135abf5793d3b0e4c4d3ee@haskell.org> #14371: ghc: panic! when reloading file with code -------------------------------------+------------------------------------- Reporter: xvrbka1 | 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): Wiki Page: | -------------------------------------+------------------------------------- Description changed by xvrbka1: Old description: > Hello, > > \\ > ** > This code:** > {{{ > countSame :: (Ord a) => (a -> Bool) [a] -> Int > countSame _ [] = 0; > countSame p (x:s) = (if p x then 1 else 0) + (countSame p s) > }}} > \\ > (There is a mistake in heared countSame :: (Ord a) => (a -> Bool) **->** > [a] -> Int) > \\ > > **gives me an error:**\\ > > ''ghc: panic! (the 'impossible' happened) > (GHC version 8.2.1 for x86_64-unknown-linux): > repSplitAppTys > a_a6Xb[sk:1] > Bool > [] > 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/types/Type.hs:808:9 in ghc:Type'' > \\ > > - On some machines correctly recognized as broken header > - I put this code in separate file and error still occurs so it should > not have any dependencies. > > I hope I found u a bug :) > \\ > Have a nice day New description: Hello, \\ ** This code:** {{{ countSame :: (Ord a) => (a -> Bool) [a] -> Int countSame _ [] = 0; countSame p (x:s) = (if p x then 1 else 0) + (countSame p s) }}} \\ (There is a mistake in heared countSame :: (Ord a) => (a -> Bool) **->** [a] -> Int) \\ **gives me an error:**\\ ''ghc: panic! (the 'impossible' happened) (GHC version 8.2.1 for x86_64-unknown-linux): repSplitAppTys a_a6Xb[sk:1] Bool [] 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/types/Type.hs:808:9 in ghc:Type'' \\ - On some machines correctly recognized as broken header - I put this code in separate file and error still occurs so it should not have any dependencies. - (found on manjaro linux, ubuntu works OK. I have no other machines to compare) I hope I found u a bug :) \\ Have a nice day -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 18 21:50:58 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 18 Oct 2017 21:50:58 -0000 Subject: [GHC] #14371: ghc: panic! when reloading file with code In-Reply-To: <046.2ca65b2ac8b1dfae9409c8f965504c19@haskell.org> References: <046.2ca65b2ac8b1dfae9409c8f965504c19@haskell.org> Message-ID: <061.f56eafc6280c9c1736fde5ee5787cb8f@haskell.org> #14371: ghc: panic! when reloading file with code -------------------------------------+------------------------------------- Reporter: xvrbka1 | 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): Wiki Page: | -------------------------------------+------------------------------------- Description changed by xvrbka1: Old description: > Hello, > > \\ > ** > This code:** > {{{ > countSame :: (Ord a) => (a -> Bool) [a] -> Int > countSame _ [] = 0; > countSame p (x:s) = (if p x then 1 else 0) + (countSame p s) > }}} > \\ > (There is a mistake in heared countSame :: (Ord a) => (a -> Bool) **->** > [a] -> Int) > \\ > > **gives me an error:**\\ > > ''ghc: panic! (the 'impossible' happened) > (GHC version 8.2.1 for x86_64-unknown-linux): > repSplitAppTys > a_a6Xb[sk:1] > Bool > [] > 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/types/Type.hs:808:9 in ghc:Type'' > \\ > > - On some machines correctly recognized as broken header > - I put this code in separate file and error still occurs so it should > not have any dependencies. > - (found on manjaro linux, ubuntu works OK. I have no other machines to > compare) > > I hope I found u a bug :) > \\ > Have a nice day New description: Hello, \\ ** This code:** {{{ countSame :: (Ord a) => (a -> Bool) [a] -> Int countSame _ [] = 0; countSame p (x:s) = (if p x then 1 else 0) + (countSame p s) }}} \\ (There is a mistake in header ''countSame :: (Ord a) => (a -> Bool) **!->!** [a] -> Int'') \\ **gives me an error:**\\ ''ghc: panic! (the 'impossible' happened) (GHC version 8.2.1 for x86_64-unknown-linux): repSplitAppTys a_a6Xb[sk:1] Bool [] 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/types/Type.hs:808:9 in ghc:Type'' \\ - On some machines correctly recognized as broken header - I put this code in separate file and error still occurs so it should not have any dependencies. - (found on manjaro linux, ubuntu works OK. I have no other machines to compare) I hope I found u a bug :) \\ Have a nice day -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 18 21:51:37 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 18 Oct 2017 21:51:37 -0000 Subject: [GHC] #14371: ghc: panic! when reloading file with code In-Reply-To: <046.2ca65b2ac8b1dfae9409c8f965504c19@haskell.org> References: <046.2ca65b2ac8b1dfae9409c8f965504c19@haskell.org> Message-ID: <061.7f06106f4beb8cac7b9c67bb3a353b73@haskell.org> #14371: ghc: panic! when reloading file with code -------------------------------------+------------------------------------- Reporter: xvrbka1 | 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): Wiki Page: | -------------------------------------+------------------------------------- Description changed by xvrbka1: Old description: > Hello, > > \\ > ** > This code:** > {{{ > countSame :: (Ord a) => (a -> Bool) [a] -> Int > countSame _ [] = 0; > countSame p (x:s) = (if p x then 1 else 0) + (countSame p s) > }}} > \\ > (There is a mistake in header ''countSame :: (Ord a) => (a -> Bool) > **!->!** [a] -> Int'') > \\ > > **gives me an error:**\\ > > ''ghc: panic! (the 'impossible' happened) > (GHC version 8.2.1 for x86_64-unknown-linux): > repSplitAppTys > a_a6Xb[sk:1] > Bool > [] > 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/types/Type.hs:808:9 in ghc:Type'' > \\ > > - On some machines correctly recognized as broken header > - I put this code in separate file and error still occurs so it should > not have any dependencies. > - (found on manjaro linux, ubuntu works OK. I have no other machines to > compare) > > I hope I found u a bug :) > \\ > Have a nice day New description: Hello, \\ ** This code:** {{{ countSame :: (Ord a) => (a -> Bool) [a] -> Int countSame _ [] = 0; countSame p (x:s) = (if p x then 1 else 0) + (countSame p s) }}} \\ (There is a mistake in header ''countSame :: (Ord a) => (a -> Bool) **#->#** [a] -> Int'') \\ **gives me an error:**\\ ''ghc: panic! (the 'impossible' happened) (GHC version 8.2.1 for x86_64-unknown-linux): repSplitAppTys a_a6Xb[sk:1] Bool [] 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/types/Type.hs:808:9 in ghc:Type'' \\ - On some machines correctly recognized as broken header - I put this code in separate file and error still occurs so it should not have any dependencies. - (found on manjaro linux, ubuntu works OK. I have no other machines to compare) I hope I found u a bug :) \\ Have a nice day -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 18 22:43:35 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 18 Oct 2017 22:43:35 -0000 Subject: [GHC] #13604: ghci no longer loads dynamic .o files by default if they were built with -O In-Reply-To: <045.626a6b40d9101c93e2935653ef7e4668@haskell.org> References: <045.626a6b40d9101c93e2935653ef7e4668@haskell.org> Message-ID: <060.52317f5da2dccf60f7de8889a233f5d5@haskell.org> #13604: ghci no longer loads dynamic .o files by default if they were built with -O -------------------------------------+------------------------------------- Reporter: George | Owner: dfeuer Type: bug | Status: new Priority: highest | Milestone: 8.2.2 Component: Compiler | Version: 8.2.1-rc1 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): Phab:D3514 Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): Yes, having a description of what this will look like from the users' perspective would help us ascertain whether or not this will address the issue. Once we have that perhaps elaforge could also comment. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 18 22:52:23 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 18 Oct 2017 22:52:23 -0000 Subject: [GHC] #14370: non-deferred typed hole despite -fdefer-typed-holes In-Reply-To: <044.22e5f2aa694f3f07f37c874e3f79e431@haskell.org> References: <044.22e5f2aa694f3f07f37c874e3f79e431@haskell.org> Message-ID: <059.9118a0441f94c188ab7b3102dc6496e0@haskell.org> #14370: non-deferred typed hole despite -fdefer-typed-holes -------------------------------------+------------------------------------- Reporter: int-e | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 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 monoidal): Does [https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/glasgow_exts.html #deferred-type-errors-in-ghci this] answer your question? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 18 23:21:16 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 18 Oct 2017 23:21:16 -0000 Subject: [GHC] #14346: 8.2.1 regression: heap corruption after safe foreign calls In-Reply-To: <049.7a4af7d8399ac93444ea4b9211bf91ff@haskell.org> References: <049.7a4af7d8399ac93444ea4b9211bf91ff@haskell.org> Message-ID: <064.0552a85417cff129f200c5d74fbaadf7@haskell.org> #14346: 8.2.1 regression: heap corruption after safe foreign calls -------------------------------------+------------------------------------- Reporter: andrewchen | Owner: (none) Type: bug | Status: infoneeded Priority: highest | Milestone: Component: Runtime System | Version: 8.2.1 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): Very good insights, alexbiehl and andrewchen. Indeed it looks indeed the GC is (correctly, given the code) concluding that the array is unreachable. Looking at the `-dverbose-core2core` output one sees that the `touch#` call is dropped during one of the simplifier passes (`SimplMode {Phase = 0 [post-call-arity], inline, rules, eta-expand, case-of-case}`). That is certainly the bug. To answer, a few of your questions: > is it ok to store an address which clearly points > into heap allocated memory but doesn't point to > an info table? In the above case, the answer is probably yes. This pointer is saved as a field of a stack frame (namely a return frame for `block_c4Dx_info`). The info table for this frame likely declares this field as a non-pointer. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 19 00:26:55 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 19 Oct 2017 00:26:55 -0000 Subject: [GHC] #14346: 8.2.1 regression: heap corruption after safe foreign calls In-Reply-To: <049.7a4af7d8399ac93444ea4b9211bf91ff@haskell.org> References: <049.7a4af7d8399ac93444ea4b9211bf91ff@haskell.org> Message-ID: <064.86d8e9a04573b04c8361aa8b6297d609@haskell.org> #14346: 8.2.1 regression: heap corruption after safe foreign calls -------------------------------------+------------------------------------- Reporter: andrewchen | Owner: (none) Type: bug | Status: infoneeded Priority: highest | Milestone: Component: Runtime System | Version: 8.2.1 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): So However, in general I wonder whether `touch#` is more unsafe than strictly necessary. It seems to me that for a tad of stack allocation you can get a much safer way to keep values alive. The trick is to introduce a primop, {{{ with# :: a -> r -> r }}} When `with# a cont` is entered, the entry code will, 1. Push an `StgWithFrame`, a new sort of return frame which carries a reference to `a`, onto the stack 2. Enters `cont` When `cont` returns, it will enter the entry code for `StgWithFrame`, which will simply pop itself and return. This way we don't need to worry about Core simplifications dropping important `touch#`s. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 19 00:33:30 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 19 Oct 2017 00:33:30 -0000 Subject: [GHC] #14371: ghc: panic! when reloading file with code In-Reply-To: <046.2ca65b2ac8b1dfae9409c8f965504c19@haskell.org> References: <046.2ca65b2ac8b1dfae9409c8f965504c19@haskell.org> Message-ID: <061.8ba304e956d32fa6960f0f29ab99fcb7@haskell.org> #14371: ghc: panic! when reloading file with code -------------------------------------+------------------------------------- Reporter: xvrbka1 | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: duplicate | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #13819 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * status: new => closed * resolution: => duplicate * related: => #13819 Comment: Thanks for the bug report. This is a duplicate of #13819, and has been fixed in the upcoming GHC 8.2.2 release: {{{ $ /opt/ghc/8.2.2/bin/ghci Bug.hs GHCi, version 8.2.1.20170928: http://www.haskell.org/ghc/ :? for help Loaded GHCi configuration from /home/rgscott/.ghci [1 of 1] Compiling Main ( Bug.hs, interpreted ) Bug.hs:1:25: error: • Expecting one fewer arguments to ‘a -> Bool’ Expected kind ‘* -> *’, but ‘a -> Bool’ has kind ‘*’ • In the type signature: countSame :: (Ord a) => (a -> Bool) [a] -> Int | 1 | countSame :: (Ord a) => (a -> Bool) [a] -> Int | ^^^^^^^^^^^^^^^ }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 19 07:11:34 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 19 Oct 2017 07:11:34 -0000 Subject: [GHC] #14346: 8.2.1 regression: heap corruption after safe foreign calls In-Reply-To: <049.7a4af7d8399ac93444ea4b9211bf91ff@haskell.org> References: <049.7a4af7d8399ac93444ea4b9211bf91ff@haskell.org> Message-ID: <064.e167637fb5470390d000f370693037af@haskell.org> #14346: 8.2.1 regression: heap corruption after safe foreign calls -------------------------------------+------------------------------------- Reporter: andrewchen | Owner: (none) Type: bug | Status: infoneeded Priority: highest | Milestone: Component: Runtime System | Version: 8.2.1 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 simonpj): * cc: simonmar (added) Comment: > It looks like to avoid this we will either need to teach the simplifier not to throw away otherwise dead continuations which contain some "important" primops Can you give an example to show what it is throwing away, and why that's bad? I don't get it yet. I have even forgotten why `touch#` exists. Copying Simon Marlow. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 19 09:32:48 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 19 Oct 2017 09:32:48 -0000 Subject: [GHC] #14356: "Main: thread blocked indefinitely in an MVar operation" in fixIO In-Reply-To: <046.213052b44c9d3401325e49943e41332d@haskell.org> References: <046.213052b44c9d3401325e49943e41332d@haskell.org> Message-ID: <061.4270da50a8905b7f9cb7bba9d5bcd7b4@haskell.org> #14356: "Main: thread blocked indefinitely in an MVar operation" in fixIO -------------------------------------+------------------------------------- Reporter: nickkuk | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Runtime System | Version: 8.2.1 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 nickkuk): I tried to test my example with David's fixIO (#13613), but couldn't got it compiled, because I'm not familiar with these ghc internals. Does #13613 solves the problem in this ticket? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 19 09:33:47 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 19 Oct 2017 09:33:47 -0000 Subject: [GHC] #14356: "Main: thread blocked indefinitely in an MVar operation" in fixIO In-Reply-To: <046.213052b44c9d3401325e49943e41332d@haskell.org> References: <046.213052b44c9d3401325e49943e41332d@haskell.org> Message-ID: <061.bb25405868e551b166fb5f437c69dfef@haskell.org> #14356: "Main: thread blocked indefinitely in an MVar operation" in fixIO -------------------------------------+------------------------------------- Reporter: nickkuk | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Runtime System | Version: 8.2.1 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 nickkuk): * cc: dfeuer (added) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 19 10:02:18 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 19 Oct 2017 10:02:18 -0000 Subject: [GHC] #14370: non-deferred typed hole despite -fdefer-typed-holes In-Reply-To: <044.22e5f2aa694f3f07f37c874e3f79e431@haskell.org> References: <044.22e5f2aa694f3f07f37c874e3f79e431@haskell.org> Message-ID: <059.82217567e3ad7ef58403104d5de87fab@haskell.org> #14370: non-deferred typed hole despite -fdefer-typed-holes -------------------------------------+------------------------------------- Reporter: int-e | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 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 int-e): Replying to [comment:1 monoidal]: > Does [https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/glasgow_exts.html #deferred-type-errors-in-ghci this] answer your question? Yes and no. I still believe that the behavior is surprising, but this means it's a feature, not a bug (I don't care enough to argue otherwise). Btw, from this section I would conclude that `length [r]` should also produce an error, since both typed holes and out of scope variables fall under the headline [https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/glasgow_exts.html #deferring-type-errors-to-runtime Deferring type errors to runtime]. In any case it appears that the documentation can be improved a bit. * clarify in [https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/glasgow_exts.html #deferred-type-errors-in-ghci Deferred type errors in GHCi] that this applies to type checking errors (including typed holes) but not to name resolution (out of scope variables) * I didn't find the GHCi exception when reading [https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/glasgow_exts.html #typed-holes Typed Holes] so a forward reference may be helpful * The description of [https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/using- warnings.html#ghc-flag--fdefer-type-errors -fdefer-type-errors] should mention that it implies -fdefer-out-of-scope-variables -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 19 10:36:33 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 19 Oct 2017 10:36:33 -0000 Subject: [GHC] #14362: Allow: Coercing (a:~:b) to (b:~:a) In-Reply-To: <051.de7b972e40c6148c97cf4a6c5f8259b3@haskell.org> References: <051.de7b972e40c6148c97cf4a6c5f8259b3@haskell.org> Message-ID: <066.64ecb6c079d4980d3ad664604fc14137@haskell.org> #14362: Allow: Coercing (a:~:b) to (b:~:a) -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 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): > My bottom line: GHC's notion of representational equality is useful, but still quite limited. There are lots of ways of expanding it. This is one of them. Agreed. I'm meantally "parking" this. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 19 10:41:17 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 19 Oct 2017 10:41:17 -0000 Subject: [GHC] #11469: GHCi should get LANGUAGE extensions/defaulting from the module whose full top-level scope is visible In-Reply-To: <045.1992743c6be5a313d344284f20ce0d35@haskell.org> References: <045.1992743c6be5a313d344284f20ce0d35@haskell.org> Message-ID: <060.bcd1ce6f340b9c3cbd3061ff822747e5@haskell.org> #11469: GHCi should get LANGUAGE extensions/defaulting from the module whose full top-level scope is visible -------------------------------------+------------------------------------- Reporter: ezyang | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: GHCi | Version: 7.11 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): This can also lead to failures when loading modules. The NoOverloadedStrings Pragma in a Module will be overwritten by GHCi so it tries to load it with `-XOverloadedStrings` and (potentially fails.) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 19 10:46:34 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 19 Oct 2017 10:46:34 -0000 Subject: [GHC] #14366: Type family equation refuses to unify wildcard type patterns In-Reply-To: <050.99fc7b3497a7cbec29b57a49c9d2896b@haskell.org> References: <050.99fc7b3497a7cbec29b57a49c9d2896b@haskell.org> Message-ID: <065.fff4cebd8806ea48e832fb1261eb5811@haskell.org> #14366: Type family equation refuses to unify wildcard type patterns -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.2.1 checker) | Keywords: TypeFamilies, Resolution: | 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 simonpj): These wildcards are more like wildards in types. E.g {{{ f :: _ -> _ f x = x }}} Here `f` gets the infeerred type `f :: forall a. a -> a`, and both `_` holes are reported as standing for `a`. Similarly (untested) you can write wildcards in pattern signatures. Thus: {{{ f :: a -> (a -> Char -> Bool) -> Bool f x (g :: p -> _ -> _) = g (x :: p) 'v' :: Bool }}} Here the pattern tyupe `(p -> _ -> _)` gives the shepe of the type expected for `g`. But the two underscores can certainly turn out to the same type. So I think yes, we should accept the Description. I don't know how hard it'd be. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 19 11:09:07 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 19 Oct 2017 11:09:07 -0000 Subject: [GHC] #14346: 8.2.1 regression: heap corruption after safe foreign calls In-Reply-To: <049.7a4af7d8399ac93444ea4b9211bf91ff@haskell.org> References: <049.7a4af7d8399ac93444ea4b9211bf91ff@haskell.org> Message-ID: <064.87aadb292ac9d7fa8de3d861216b6154@haskell.org> #14346: 8.2.1 regression: heap corruption after safe foreign calls -------------------------------------+------------------------------------- Reporter: andrewchen | Owner: (none) Type: bug | Status: infoneeded Priority: highest | Milestone: Component: Runtime System | Version: 8.2.1 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 simonmar): Interesting, can someone boil down the transformation that dropped the `touch#`? Simon: `touch#` is keeping the `ByteArray#` alive until after the `action`, in `allocaBytes` (see comment:18). The action itself doesn't keep the array alive, because it is working with the raw pointer, not the `ByteArray#`. This is how we allocate temporary memory for marshalling data between Haskell and C, because it's a lot faster to allocate memory on the Haskell heap than to use `malloc()` and `free()`. I imagine the simplifier has proven that `action` never returns and then dropped the `case` with the continuation containing the `touch#`. That seems like a reasonable thing to do. I like @bgamari's alternative suggestion of `with#`, although we probably want it to be {{{ with# :: a -> (State# s -> (# State# s, b #)) -> State# s -> (# State# s, b #) }}} otherwise the second argument must be a thunk (yuck). -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 19 12:00:25 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 19 Oct 2017 12:00:25 -0000 Subject: [GHC] #14367: Lazy evaluation can be invalidated In-Reply-To: <044.160607d34b23537b8391703de15721cd@haskell.org> References: <044.160607d34b23537b8391703de15721cd@haskell.org> Message-ID: <059.f6a8f431a7a03ad5035993da62e75456@haskell.org> #14367: Lazy evaluation can be invalidated -------------------------------------+------------------------------------- Reporter: vanto | 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: Other | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by AntC): Replying to [ticket:14367 vanto]: > Evaluating arguments only if and when they are needed. This is the first principle of lazy evaluation.\\ > Example:\\ > ...\\ > These results are all correct because the evaluated expression (function) is non-strict.\\ No, not an accurate statement. Those examples are ''both'' type-correct ''and'' evaluate a non-strict function. > > The same expression below with a changed argument:\\ > ...\\ That example is not type-correct. > Here the error message should not have priority. \\ Type errors ''always'' "have priority" before evaluating an expression. (Except if you set `-fdefer-type-errors` or `-fdefer-typed-holes`, as @goldfire correctly points out.) GHC is chiefly a compiler, not an interpreter. Haskell is a statically- typed language. Compiled code would be unusable in general if GHC accepted type-incorrect code, then delayed until run-time to see whether it needed to evaluate some type-incorrect expression. Programs would run ok today but crash tomorrow. I think you'll find every statically-typed compiled language behaves like that. It really has nothing to do with lazy evaluation. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 19 12:25:30 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 19 Oct 2017 12:25:30 -0000 Subject: [GHC] #14367: Lazy evaluation can be invalidated In-Reply-To: <044.160607d34b23537b8391703de15721cd@haskell.org> References: <044.160607d34b23537b8391703de15721cd@haskell.org> Message-ID: <059.ea0ac905baee679599439381368761bc@haskell.org> #14367: Lazy evaluation can be invalidated -------------------------------------+------------------------------------- Reporter: vanto | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: invalid | 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 vanto): * status: new => closed * resolution: => invalid Comment: before closing the ticket here two things:\\ {{{-fdefer-typed-holes}}} and {{{-fdefer-type-errors}}} should not exist in GHC. either an expression is well-typed or it is not well-typed. but you, you invent a "naked" expression that will ultimately still make an error output from the compiler. you hide an existing error for what to do in the end? make the compiler create an error when calculating this expression. that's wonderful! it does not help. It serve no purpose. back to the ticket. Haskell is three main things. lambda-calculus, type inference and lazy evaluation. that's all. in this ticket I point the lazy evaluation. I repeat my question: why give a type to an expression that is known to be unusable by the program?(yes I know why, here it is rather an interrogative sentence). choose between two actions: - it is necessary to give a type to the expression and then to check if it is used.\\ or\\ - it is necessary to check the expression if it is used before giving a type to the expression. \\ We can do it using an identity function, for instance.\\ in both cases the lazy evaluation will not use this expression. Each well-formed expression has, by definition, a value. this value does not work since the expression is not used by the lazy evaluation. this value serve no purpose. I prefer the second action although this does not happen so in GHC. he would probably have thought of that from the beginning. moreover, the lazy evaluation must be given a high priority in relation to the priority of errors or warning.(in this precise case).\\ anyway the type inference has already been changed in the past so why not once again? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 19 13:09:35 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 19 Oct 2017 13:09:35 -0000 Subject: [GHC] #14346: 8.2.1 regression: heap corruption after safe foreign calls In-Reply-To: <049.7a4af7d8399ac93444ea4b9211bf91ff@haskell.org> References: <049.7a4af7d8399ac93444ea4b9211bf91ff@haskell.org> Message-ID: <064.61763bf84e07e06b1f41ea7786399e0b@haskell.org> #14346: 8.2.1 regression: heap corruption after safe foreign calls -------------------------------------+------------------------------------- Reporter: andrewchen | Owner: (none) Type: bug | Status: infoneeded Priority: highest | Milestone: Component: Runtime System | Version: 8.2.1 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): > I imagine the simplifier has proven that action never returns and then dropped the case with the continuation containing the `touch#`. That seems like a reasonable thing to do. Correct. I believe it is `Simplify.rebuildCall` that is responsible for this. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 19 13:36:01 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 19 Oct 2017 13:36:01 -0000 Subject: [GHC] #14346: 8.2.1 regression: heap corruption after safe foreign calls In-Reply-To: <049.7a4af7d8399ac93444ea4b9211bf91ff@haskell.org> References: <049.7a4af7d8399ac93444ea4b9211bf91ff@haskell.org> Message-ID: <064.22bc252d4c9c20935da42c158207bb8c@haskell.org> #14346: 8.2.1 regression: heap corruption after safe foreign calls -------------------------------------+------------------------------------- Reporter: andrewchen | Owner: (none) Type: bug | Status: patch Priority: highest | Milestone: 8.2.2 Component: Runtime System | Version: 8.2.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Runtime crash | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4110 Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: infoneeded => patch * differential: => Phab:D4110 * milestone: => 8.2.2 Comment: See Phab:D4110 for an implementation. Still need to add a test. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 19 14:12:13 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 19 Oct 2017 14:12:13 -0000 Subject: [GHC] #13745: Investigate compile-time regressions in regex-tdfa-1.2.2 In-Reply-To: <046.b7de3eed99bc2dfd75756f4f73799d3c@haskell.org> References: <046.b7de3eed99bc2dfd75756f4f73799d3c@haskell.org> Message-ID: <061.86366f573dcbc6de92a4616032a65636@haskell.org> #13745: Investigate compile-time regressions in regex-tdfa-1.2.2 -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: task | Status: new Priority: high | Milestone: 8.2.3 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 bgamari): rahulmutt, thanks for the datapoint. Can you say more specifically which revision of `DmdAnal` you were previously using and which you updated to? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 19 14:16:02 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 19 Oct 2017 14:16:02 -0000 Subject: [GHC] #13707: xmobar crashes with segmentation faults? In-Reply-To: <046.fbf7af7bdea4e00dc6b71cd4d89ec01e@haskell.org> References: <046.fbf7af7bdea4e00dc6b71cd4d89ec01e@haskell.org> Message-ID: <061.9f30f3cb358534365c0569b74ba167b0@haskell.org> #13707: xmobar crashes with segmentation faults? -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.2.1 Component: Compiler | Version: 8.2.1-rc2 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 bgamari): I wonder if any of the number of correctness fixes that we have merged recently will address this. Particularly I wonder about #14361. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 19 14:21:04 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 19 Oct 2017 14:21:04 -0000 Subject: [GHC] #14356: "Main: thread blocked indefinitely in an MVar operation" in fixIO In-Reply-To: <046.213052b44c9d3401325e49943e41332d@haskell.org> References: <046.213052b44c9d3401325e49943e41332d@haskell.org> Message-ID: <061.5d22c55bc6f0b97882415f5f17a021d5@haskell.org> #14356: "Main: thread blocked indefinitely in an MVar operation" in fixIO -------------------------------------+------------------------------------- Reporter: nickkuk | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Runtime System | Version: 8.2.1 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: | -------------------------------------+------------------------------------- Old description: > I'm not sure whether such behavior is expected, but this program > {{{ > import System.IO > > main = fixIO (\x -> return 1) >>= print > }}} > prints "1"; and this > {{{ > import System.IO > > main = fixIO (\(x, _) -> return (1, print x)) >>= print . fst > }}} > prints "Main: thread blocked indefinitely in an MVar operation". > > Second program arises from something like > {{{ > {-# LANUGAGE RecursiveDo #-} > > main = mdo > ... > x <- return 1 > let f = do > ... > print x > ... > ... > return f > }}} > It is not necessary to call f somewhere in mdo to get "Main: thread > blocked indefinitely in an MVar operation". New description: I'm not sure whether such behavior is expected, but this program {{{#!hs import System.IO main = fixIO (\x -> return 1) >>= print }}} prints "1"; and this {{{#!hs import System.IO main = fixIO (\(x, _) -> return (1, print x)) >>= print . fst }}} prints "Main: thread blocked indefinitely in an MVar operation". Second program arises from something like {{{#!hs {-# LANUGAGE RecursiveDo #-} main = mdo ... x <- return 1 let f = do ... print x ... ... return f }}} It is not necessary to call f somewhere in mdo to get "Main: thread blocked indefinitely in an MVar operation". -- Comment (by bgamari): David, could you look at this? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 19 14:21:43 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 19 Oct 2017 14:21:43 -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.134e51c34f871730c32a9cf3e3a7ce6e@haskell.org> #14338: Simplifier fails with "Simplifier ticks exhausted" -------------------------------------+------------------------------------- Reporter: dredozubov | Owner: (none) Type: bug | Status: new Priority: high | Milestone: 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: | -------------------------------------+------------------------------------- Changes (by bgamari): * priority: normal => high Comment: Hmm, bad news bears. We'll need to have a look at this. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 19 14:22:56 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 19 Oct 2017 14:22:56 -0000 Subject: [GHC] #13604: ghci no longer loads dynamic .o files by default if they were built with -O In-Reply-To: <045.626a6b40d9101c93e2935653ef7e4668@haskell.org> References: <045.626a6b40d9101c93e2935653ef7e4668@haskell.org> Message-ID: <060.1d612b66a0afb63a386962a23f9df2e2@haskell.org> #13604: ghci no longer loads dynamic .o files by default if they were built with -O -------------------------------------+------------------------------------- Reporter: George | Owner: dfeuer Type: bug | Status: new Priority: highest | Milestone: 8.2.2 Component: Compiler | Version: 8.2.1-rc1 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): Phab:D3514 Wiki Page: | -------------------------------------+------------------------------------- Changes (by George): * cc: elaforge (added) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 19 14:26:11 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 19 Oct 2017 14:26:11 -0000 Subject: [GHC] #14350: Infinite loop when typechecking incorrect implementation (GHC HEAD only) In-Reply-To: <050.13c8453cb18174ae45ace93d1d6319c0@haskell.org> References: <050.13c8453cb18174ae45ace93d1d6319c0@haskell.org> Message-ID: <065.90ce4e9056fab936bf541cb80ad39862@haskell.org> #14350: Infinite loop when typechecking incorrect implementation (GHC HEAD only) -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: closed Priority: high | Milestone: 8.4.1 Component: Compiler (Type | Version: 8.3 checker) | Resolution: fixed | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: | typecheck/should_fail/T14350 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Ryan Scott ): In [changeset:"20ae22b08c79dc1cf851c79a73601c7c62abca16/ghc" 20ae22b/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="20ae22b08c79dc1cf851c79a73601c7c62abca16" Accept test output for #14350 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 19 14:26:11 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 19 Oct 2017 14:26:11 -0000 Subject: [GHC] #14365: Panic with (bogus?) deriving in hs-boot: newTyConEtadArity In-Reply-To: <050.6c81d89c96c68af001028e9be845ac26@haskell.org> References: <050.6c81d89c96c68af001028e9be845ac26@haskell.org> Message-ID: <065.3d728ef0468d963a2e02921a1920b349@haskell.org> #14365: Panic with (bogus?) deriving in hs-boot: newTyConEtadArity -------------------------------------+------------------------------------- Reporter: happykitten | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: | Keywords: deriving Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4102 Wiki Page: | -------------------------------------+------------------------------------- Comment (by Ryan Scott ): In [changeset:"101a8c770b9d3abd57ff289bffea3d838cf25c80/ghc" 101a8c7/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="101a8c770b9d3abd57ff289bffea3d838cf25c80" Error when deriving instances in hs-boot files Summary: According to the GHC users' guide, one cannot derive instances for data types in `.hs-boot` files. However, GHC was not enforcing this in practice, which led to #14365. Fix this by actually throwing an error if a derived instance is detected in an `.hs-boot` file (and recommend how to fix it in the error message.) Test Plan: make test TEST=T14365 Reviewers: ezyang, austin, bgamari, simonpj Reviewed By: simonpj Subscribers: simonpj, rwbarton, thomie GHC Trac Issues: #14365 Differential Revision: https://phabricator.haskell.org/D4102 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 19 14:26:11 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 19 Oct 2017 14:26:11 -0000 Subject: [GHC] #13385: ghci fails to start when -XRebindableSyntax is passed In-Reply-To: <046.49534d46a543f72893ed665a08de1bb0@haskell.org> References: <046.49534d46a543f72893ed665a08de1bb0@haskell.org> Message-ID: <061.f9895cfa09dc1fdf46c515e43b15dc25@haskell.org> #13385: ghci fails to start when -XRebindableSyntax is passed -------------------------------------+------------------------------------- Reporter: mgsloan | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: 8.2.1 Component: GHCi | 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): Phab:D3621 Wiki Page: | -------------------------------------+------------------------------------- Comment (by Ryan Scott ): In [changeset:"e023e78bc13ffae168f00a52324fc406a146b40f/ghc" e023e78/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="e023e78bc13ffae168f00a52324fc406a146b40f" Disable -XRebindableSyntax when running internal GHCi expressions Summary: It's well known that `-XRebindableSyntax` doesn't play nicely with some of the internal expressions that GHCi runs. #13385 was one example where this problem arose, which was fixed at the time by simply avoiding the use of `do`-notation in these internal GHCi expressions. That seemed to work, but it was a technique that proved not to scale, as #14342 demonstrated //another// example where `-XRebindableSyntax` can bite. Instead of delicately arranging the internal GHCi expressions to avoid anything that might be covered under `-XRebindableSyntax`, this patch takes the much more direct approach of disabling `-XRebindableSyntax` entirely when running any internal GHCi expression. This shouldn't hurt, since nothing internal to GHCi was taking advantage of the extension in the first place, and moreover, we can have greater confidence that some other obscure `-XRebindableSyntax` corner case won't pop up in the future. As an added bonus, this lets us once again use `do`-notation in the code that had to be changed when #13385 was (hackily) fixed before. Test Plan: make test TEST=T14342 Reviewers: bgamari, austin Subscribers: rwbarton, thomie GHC Trac Issues: #14342 Differential Revision: https://phabricator.haskell.org/D4086 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 19 14:26:12 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 19 Oct 2017 14:26:12 -0000 Subject: [GHC] #14369: GHC warns an injective type family "may not be injective" In-Reply-To: <050.6468df70b5f2384c406960d5a58f21dc@haskell.org> References: <050.6468df70b5f2384c406960d5a58f21dc@haskell.org> Message-ID: <065.30613d5819027c64049f53abfdc99f68@haskell.org> #14369: GHC warns an injective type family "may not be injective" -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: Component: Compiler (Type | Version: 8.2.1 checker) | Keywords: Resolution: | InjectiveFamilies 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:D4106 Wiki Page: | -------------------------------------+------------------------------------- Comment (by Ryan Scott ): In [changeset:"8846a7fdcf2060dd37e66b4d1f89bd8fdfad4620/ghc" 8846a7fd/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="8846a7fdcf2060dd37e66b4d1f89bd8fdfad4620" Fix #14369 by making injectivity warnings finer-grained Summary: Previously, GHC would always raise the possibility that a type family might not be injective in certain error messages, even if that type family actually //was// injective. Fix this by actually checking for a type family's lack of injectivity before emitting such an error message. Test Plan: ./validate Reviewers: goldfire, austin, bgamari, simonpj Reviewed By: simonpj Subscribers: simonpj, rwbarton, thomie GHC Trac Issues: #14369 Differential Revision: https://phabricator.haskell.org/D4106 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 19 14:26:11 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 19 Oct 2017 14:26:11 -0000 Subject: [GHC] #14342: ghci fails to start with RebindableSyntax and OverloadedStrings In-Reply-To: <051.d10c8c6e8127d1aec95b8f77a4602f20@haskell.org> References: <051.d10c8c6e8127d1aec95b8f77a4602f20@haskell.org> Message-ID: <066.62f400420b5a0d63a538cc91810a3d10@haskell.org> #14342: ghci fails to start with RebindableSyntax and OverloadedStrings ---------------------------------+---------------------------------------- Reporter: NeilMitchell | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: Component: GHCi | Version: 8.2.1 Resolution: | Keywords: RebindableSyntax Operating System: Windows | Architecture: Unknown/Multiple Type of failure: GHCi crash | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4086 Wiki Page: | ---------------------------------+---------------------------------------- Comment (by Ryan Scott ): In [changeset:"e023e78bc13ffae168f00a52324fc406a146b40f/ghc" e023e78/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="e023e78bc13ffae168f00a52324fc406a146b40f" Disable -XRebindableSyntax when running internal GHCi expressions Summary: It's well known that `-XRebindableSyntax` doesn't play nicely with some of the internal expressions that GHCi runs. #13385 was one example where this problem arose, which was fixed at the time by simply avoiding the use of `do`-notation in these internal GHCi expressions. That seemed to work, but it was a technique that proved not to scale, as #14342 demonstrated //another// example where `-XRebindableSyntax` can bite. Instead of delicately arranging the internal GHCi expressions to avoid anything that might be covered under `-XRebindableSyntax`, this patch takes the much more direct approach of disabling `-XRebindableSyntax` entirely when running any internal GHCi expression. This shouldn't hurt, since nothing internal to GHCi was taking advantage of the extension in the first place, and moreover, we can have greater confidence that some other obscure `-XRebindableSyntax` corner case won't pop up in the future. As an added bonus, this lets us once again use `do`-notation in the code that had to be changed when #13385 was (hackily) fixed before. Test Plan: make test TEST=T14342 Reviewers: bgamari, austin Subscribers: rwbarton, thomie GHC Trac Issues: #14342 Differential Revision: https://phabricator.haskell.org/D4086 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 19 14:27:25 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 19 Oct 2017 14:27:25 -0000 Subject: [GHC] #14365: Panic with (bogus?) deriving in hs-boot: newTyConEtadArity In-Reply-To: <050.6c81d89c96c68af001028e9be845ac26@haskell.org> References: <050.6c81d89c96c68af001028e9be845ac26@haskell.org> Message-ID: <065.30479f4cfd3c8576d3fb8a2903474f2c@haskell.org> #14365: Panic with (bogus?) deriving in hs-boot: newTyConEtadArity -------------------------------------+------------------------------------- Reporter: happykitten | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.2.1 Resolution: fixed | Keywords: deriving Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: | deriving/should_fail/T14365 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4102 Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * status: patch => closed * testcase: => deriving/should_fail/T14365 * resolution: => fixed * milestone: => 8.4.1 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 19 14:28:21 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 19 Oct 2017 14:28:21 -0000 Subject: [GHC] #14369: GHC warns an injective type family "may not be injective" In-Reply-To: <050.6468df70b5f2384c406960d5a58f21dc@haskell.org> References: <050.6468df70b5f2384c406960d5a58f21dc@haskell.org> Message-ID: <065.5f5a7f68dfed1876102d286605af54e8@haskell.org> #14369: GHC warns an injective type family "may not be injective" -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: 8.4.1 Component: Compiler (Type | Version: 8.2.1 checker) | Keywords: Resolution: fixed | InjectiveFamilies Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Poor/confusing | Test Case: indexed- error message | types/should_fail/T14369 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4106 Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * testcase: => indexed-types/should_fail/T14369 * status: patch => closed * resolution: => fixed * milestone: => 8.4.1 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 19 14:29:19 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 19 Oct 2017 14:29:19 -0000 Subject: [GHC] #14342: ghci fails to start with RebindableSyntax and OverloadedStrings In-Reply-To: <051.d10c8c6e8127d1aec95b8f77a4602f20@haskell.org> References: <051.d10c8c6e8127d1aec95b8f77a4602f20@haskell.org> Message-ID: <066.4655863a465c20b21eecf247a6febb75@haskell.org> #14342: ghci fails to start with RebindableSyntax and OverloadedStrings -------------------------------------+------------------------------------- Reporter: NeilMitchell | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: 8.4.1 Component: GHCi | Version: 8.2.1 Resolution: fixed | Keywords: | RebindableSyntax Operating System: Windows | Architecture: | Unknown/Multiple Type of failure: GHCi crash | Test Case: | ghci/scripts/T14342 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4086 Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * testcase: => ghci/scripts/T14342 * status: patch => closed * resolution: => fixed * milestone: => 8.4.1 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 19 15:13:58 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 19 Oct 2017 15:13:58 -0000 Subject: [GHC] #14346: 8.2.1 regression: heap corruption after safe foreign calls In-Reply-To: <049.7a4af7d8399ac93444ea4b9211bf91ff@haskell.org> References: <049.7a4af7d8399ac93444ea4b9211bf91ff@haskell.org> Message-ID: <064.4188e02550af134a644301fc6b8fbb3f@haskell.org> #14346: 8.2.1 regression: heap corruption after safe foreign calls -------------------------------------+------------------------------------- Reporter: andrewchen | Owner: (none) Type: bug | Status: patch Priority: highest | Milestone: 8.2.2 Component: Runtime System | Version: 8.2.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Runtime crash | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4110 Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): ...for an implementation of `with#`, that is. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 19 15:51:26 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 19 Oct 2017 15:51:26 -0000 Subject: [GHC] #7258: Compiling DynFlags is jolly slow In-Reply-To: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> References: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> Message-ID: <061.e2cc600a79a2963b1750c9d408f70961@haskell.org> #7258: Compiling DynFlags is jolly slow -------------------------------------+------------------------------------- Reporter: simonpj | Owner: simonpj Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.6.1 Resolution: | Keywords: deriving-perf 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): A few things I have tried that do not seem to make a difference: - Pre-filtering the `assig` list to retain only the "interesting" entries (`InReg` and `InBoth`), and passing the filtered list around separately; while in theory this would get rid of unnecessary list filtering passes, in practice it seems that the overhead of maintaining a second list in parallel cancels out anything we may have won - Collecting the `InReg` and `InBoth` candidate lists in a single pass. The idea behind this was that we would visit each list entry just once, putting it in one bin or the other, rather than traversing the list of candidates twice. In practice however there is no measurable performance benefit. - Merging the filtering predicates (checking whether a candidate is `InReg` or `InBoth`, and checking whether the register class matches); the idea here was that doing both checks in one pass might help, but it doesn't, the performance is exactly the same. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 19 16:41:11 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 19 Oct 2017 16:41:11 -0000 Subject: [GHC] #14372: CMM contains a bunch of tail-merging opportunities Message-ID: <048.1c543d9c1482e4763ed7a0bf48a66309@haskell.org> #14372: CMM contains a bunch of tail-merging opportunities -------------------------------------+------------------------------------- Reporter: heisenbug | Owner: (none) Type: feature | Status: new request | Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- 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; }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 19 16:54:21 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 19 Oct 2017 16:54:21 -0000 Subject: [GHC] #14373: Introduce PTR-tagging for big constructor families Message-ID: <048.fd4e2364f8515bbd8b92613edf1e7763@haskell.org> #14373: Introduce PTR-tagging for big constructor families -------------------------------------+------------------------------------- Reporter: heisenbug | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- Currently only ''small'' constructor families come into the benefit of pointer tagging. In big fams, 1 is the tag that says "I am evaluated". I suggest to do best-effort pointer tagging on big families too by this scheme: Ptr-tag 1..6 for the first 6 constructors, 7 would signify "look into the info table and branch on that tag". In the info table the tags will then be 6..(familySize - 1). I have an implementation which I'll submit to fabricator soon. TODOs: update wiki pages. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 19 16:57:02 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 19 Oct 2017 16:57:02 -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.3ea3094d1a1bde69e7cc8618547eed8a@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 heisenbug): See also #14226. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 19 16:57:46 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 19 Oct 2017 16:57:46 -0000 Subject: [GHC] #14356: "Main: thread blocked indefinitely in an MVar operation" in fixIO In-Reply-To: <046.213052b44c9d3401325e49943e41332d@haskell.org> References: <046.213052b44c9d3401325e49943e41332d@haskell.org> Message-ID: <061.cf6ae5671ff882904a18a4f2a3a70dd4@haskell.org> #14356: "Main: thread blocked indefinitely in an MVar operation" in fixIO -------------------------------------+------------------------------------- Reporter: nickkuk | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Runtime System | Version: 8.2.1 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 alexbiehl): By using a lazy pattern match it is working again: {{{ main = fixIO (\ ~(x, _) -> return (1, print x)) >>= print . fst }}} Looking at the core for the reported version we find: (compiled with -O2 to better understand the flow) {{{#!haskell main1 = \ s_a1AP -> case newMVar# s_a1AP of { (# ipv_a1AZ, ipv1_a1B0 #) -> case ((unsafeDupableInterleaveIO ((\ eta_a1B8 -> readMVar# ipv1_a1B0 eta_a1B8) `cast` )) `cast` ) ipv_a1AZ of { (# ipv2_X1B5, ipv3_X1B7 #) -> -- ipv3_X1B7 is our chunk which delays the readMVar# -- entering ipv3_X1B7 causes a deadlock! case ipv3_X1B7 of { (x_aV8, ds2_d1zX) -> case putMVar# ipv1_a1B0 (main3, (hPutStr2 stdout ($fShowInteger_$cshow x_aV8) True) `cast` ) ipv2_X1B5 of s2#_a25J { __DEFAULT -> hPutStr2 stdout main2 True s2#_a25J } } } } }}} By using a strict pattern match on the tuple we trigger the `readMVar#` which blocks and deadlocks as we can't make further progress. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 19 16:59:03 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 19 Oct 2017 16:59:03 -0000 Subject: [GHC] #14356: "Main: thread blocked indefinitely in an MVar operation" in fixIO In-Reply-To: <046.213052b44c9d3401325e49943e41332d@haskell.org> References: <046.213052b44c9d3401325e49943e41332d@haskell.org> Message-ID: <061.df19bf9fc1f15e18abbfab14d074768f@haskell.org> #14356: "Main: thread blocked indefinitely in an MVar operation" in fixIO -------------------------------------+------------------------------------- Reporter: nickkuk | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Runtime System | Version: 8.2.1 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 dfeuer): Yes, I'll look at this happily. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 19 17:05:40 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 19 Oct 2017 17:05:40 -0000 Subject: [GHC] #14356: "Main: thread blocked indefinitely in an MVar operation" in fixIO In-Reply-To: <046.213052b44c9d3401325e49943e41332d@haskell.org> References: <046.213052b44c9d3401325e49943e41332d@haskell.org> Message-ID: <061.c3553fc322470081a322e7c19d3826d9@haskell.org> #14356: "Main: thread blocked indefinitely in an MVar operation" in fixIO -------------------------------------+------------------------------------- Reporter: nickkuk | Owner: (none) Type: bug | Status: new Priority: low | Milestone: Component: Runtime System | 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): Wiki Page: | -------------------------------------+------------------------------------- Changes (by dfeuer): * priority: normal => low * failure: Incorrect result at runtime => Poor/confusing error message Comment: nickkuk, as alexbiehl sort of suggests, this is the expected behavior for the second example, although I think it would be worth trying to improve the error message. Unfortunately, your `mdo` example was stripped down too far to be able to interpret. Do you think you can provide a proper reproduction of what you see as bad `mdo` desugaring? I'll mark this low priority for the error message improvement; if you find a real desugaring problem we'll bump it back up. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 19 17:16:47 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 19 Oct 2017 17:16:47 -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.fe24b3821dcfcad97dcc6fa46cab6d2a@haskell.org> #14331: Overzealous free-floating kind check causes deriving clause to be rejected -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: merge Priority: normal | Milestone: 8.2.2 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): Simon and I debated this all at some length this morning. We basically settled on agreeing to my paragraph at the end of comment:29. Spelling this out: 1. The variables introduces in the `data` declaration head scope over the `deriving` clause. (Throughout this comment, `newtype` is treated identically to `data`.) This is true even for GADT-syntax declarations where any variables in the head typically have no scope. 2. Any type variables mentioned in a `deriving` clause but not already in scope are brought into scope locally in that `deriving` clause. Independent comma-separated clauses are separate and quantify separately. 3. The user may write an explicit `forall` in a `deriving` clause scoped over only one clause. This is understood as a scoping construct, not quite as a full-blooded `forall`. 4. Process a `data` declaration on its own, without further regard to any `deriving` clauses. 5. For each `deriving` clause: a. Let the kind of the head of the clause (the part without the `forall`) be `ki` and the set of variables locally quantified be `bs`. Let the head of the clause be `drv`. b. Unify `ki` with `kappa -> Constraint`, getting a substitution for `kappa`; let the result of this substitution be `ki2`. (Issue an error if unification fails.) c. It is required that `ki2` have the form `... -> Type` or `kappa2` for some variable `kappa2`. If `ki2` is `kappa2`, then choose `kappa2 := Type`. Now, we have something of the form `... -> Type`. Let the number of arguments in the `...` be `n`. d. Let the set of variables mentioned in the `deriving` clause but not locally scoped (that is, they are also mentioned in the `data` declaration head) be `as`. e. It is an error if any variable in `as` is mentioned in any of the last `n` arguments in the `data` declaration head. f. Drop the last `n` arguments (whether visible or invisible) to the datatype. Call the result `ty`. g. Replace any type variables in `ty` but '''not''' mentioned in the `deriving` clause with fresh unification variables. h. Unify the kind of `ty` with `ki2`, issuing an error if unification fails. Zonk `ty`, replacing any unfilled unification variable with fresh skolems. Call the set of these skolems `sks`. i. Produce `instance forall {bs sks as}. ... => drv ty`, where the braces around the variables is meant to imply that order does not matter; GHC will do a topological sort to get these variables in the right order. j. Solve for the unknown context `...` and insert that into the declaration. k. Declare victory. I think that does it. Simon had wanted a much more declarative specification (and I agree), but I'm stuck on how to write one at the moment. Let's perhaps agree on this algorithmic specification and then see if there are ways to clean it up. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 19 18:08:27 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 19 Oct 2017 18:08:27 -0000 Subject: [GHC] #14374: group by using groupWith seems stricter than it need be Message-ID: <046.0af219297e1722688aaf2332fbad2f41@haskell.org> #14374: group by using groupWith seems stricter than it need be -------------------------------------+------------------------------------- Reporter: newthin | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- Using TransformListComps: {{{#!hs is = [1..10] fs = map ((,) False) is ts = map ((,) True ) is a = [(the b, take 5 n) | (b,n) <- ts ++ fs, then group by b using groupWith] b = [(the b, take 5 n) | (b,n) <- ts ++ fs ++ [undefined], then group by b using groupWith] c = take 2 b }}} As of GHC 8.2.1, both b and c fail. While getting b to work seems difficult - it would require realizing that the domain of Bool has been satisfied - c seems like it might be more feasible to get working. As a motivator, this pattern is pretty common in data science, where we want to map elements of a large list to a small result domain and get examples of those elements with each result without iterating through the whole list. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 19 18:09:38 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 19 Oct 2017 18:09:38 -0000 Subject: [GHC] #14374: group by using groupWith seems stricter than it need be In-Reply-To: <046.0af219297e1722688aaf2332fbad2f41@haskell.org> References: <046.0af219297e1722688aaf2332fbad2f41@haskell.org> Message-ID: <061.bce1ba110f59bb849a2dab440f7ef0d3@haskell.org> #14374: group by using groupWith seems stricter than it need be -------------------------------------+------------------------------------- Reporter: newthin | 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): Wiki Page: | -------------------------------------+------------------------------------- Description changed by newthin: Old description: > Using TransformListComps: > > {{{#!hs > is = [1..10] > fs = map ((,) False) is > ts = map ((,) True ) is > > a = [(the b, take 5 n) | (b,n) <- ts ++ fs, then group by b using > groupWith] > b = [(the b, take 5 n) | (b,n) <- ts ++ fs ++ [undefined], then group by > b using groupWith] > c = take 2 b > }}} > > As of GHC 8.2.1, both b and c fail. > > While getting b to work seems difficult - it would require realizing that > the domain of Bool has been satisfied - c seems like it might be more > feasible to get working. > > As a motivator, this pattern is pretty common in data science, where we > want to map elements of a large list to a small result domain and get > examples of those elements with each result without iterating through the > whole list. New description: Using TransformListComps: {{{#!hs import GHC.Exts (the, groupWith) is = [1..10] fs = map ((,) False) is ts = map ((,) True ) is a = [(the b, take 5 n) | (b,n) <- ts ++ fs, then group by b using groupWith] b = [(the b, take 5 n) | (b,n) <- ts ++ fs ++ [undefined], then group by b using groupWith] c = take 2 b }}} As of GHC 8.2.1, both b and c fail. While getting b to work seems difficult - it would require realizing that the domain of Bool has been satisfied - c seems like it might be more feasible to get working. As a motivator, this pattern is pretty common in data science, where we want to map elements of a large list to a small result domain and get examples of those elements with each result without iterating through the whole list. -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 19 19:05:58 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 19 Oct 2017 19:05:58 -0000 Subject: [GHC] #13745: Investigate compile-time regressions in regex-tdfa-1.2.2 In-Reply-To: <046.b7de3eed99bc2dfd75756f4f73799d3c@haskell.org> References: <046.b7de3eed99bc2dfd75756f4f73799d3c@haskell.org> Message-ID: <061.b09af27e96cf1fdfeed1af1f36a11dd4@haskell.org> #13745: Investigate compile-time regressions in regex-tdfa-1.2.2 -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: task | Status: new Priority: high | Milestone: 8.2.3 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 rahulmutt): Before: 63205f719287cb011388b4beddf30d3229238b9f (DmdAnal in ghc-7.10.3a- release tag) After: b5b7d820afd8fca098bf1f4a7380d425ca6be31d I still need to merge in the recent occurrence analyzer changes since I recall reading that OneShotInfo is not longer handled in the demand analyzer and has moved to the occurence analyzer. Nonetheless, I don't think lack of OneShotInfo would cause the observed magnitude of code size difference, but I may be wrong. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 19 19:12:46 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 19 Oct 2017 19:12:46 -0000 Subject: [GHC] #14370: non-deferred typed hole despite -fdefer-typed-holes In-Reply-To: <044.22e5f2aa694f3f07f37c874e3f79e431@haskell.org> References: <044.22e5f2aa694f3f07f37c874e3f79e431@haskell.org> Message-ID: <059.1129b63de984ae2197acfc306b16f974@haskell.org> #14370: non-deferred typed hole despite -fdefer-typed-holes -------------------------------------+------------------------------------- Reporter: int-e | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 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 int-e): #10249 and #11130 provide some rationale for the current behavior from ghc's side. See also https://phabricator.haskell.org/D1527 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 19 19:16:28 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 19 Oct 2017 19:16:28 -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.b4b7d988568bda899df65edec54d1c3f@haskell.org> #14331: Overzealous free-floating kind check causes deriving clause to be rejected -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: merge Priority: normal | Milestone: 8.2.2 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): Thanks Richard, this looks wonderful. I have some questions/comments about your algorithm: 3. What happens if the user writes an explicit `forall` in a `deriving` clause but leaves out a variable, such as in `data Foo a = ... deriving (forall b. C b c)`? Also, in what sense is this not a "full-blooded `forall`"? 5. c. I'm not sure I understand this business about `kappa2` (or why you'd choose `kappa2 := Type`). Can you give an example of where this would arise? 5. e. Some more validity checks that would need to be performed for data family instances are documented [http://git.haskell.org/ghc.git/blob/7ac22b73b38b60bc26ad2508f57732aa17532a80:/compiler/typecheck/TcDeriv.hs#l747 here]. 5. h. I was hoping for a little more detail on this skolem business. For instance, we'd want to reject `data D = D deriving (forall k. C k)` (where we have `class C k (a :: k)`) since the `k` is skolem, yes? (Disclaimer: due to my lack of experience with typechecker terminology, I'm guessing that "skolem" is a fancy way of saying "can't unify with other types". Please correct me if I'm off-track here.) Currently, this just says "replacing any unfilled unification variable with fresh skolems", which doesn't give me a sense of //where// the skolems are coming from. Also, does the skolemicity only kick in if you write an explicit `forall`? Or would the `k` in `data D = D deriving (C k)` also get skolemized? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 19 19:19:51 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 19 Oct 2017 19:19:51 -0000 Subject: [GHC] #14370: improve documentation of -fdefer-typed-holes for naked expressions in ghci (was: non-deferred typed hole despite -fdefer-typed-holes) In-Reply-To: <044.22e5f2aa694f3f07f37c874e3f79e431@haskell.org> References: <044.22e5f2aa694f3f07f37c874e3f79e431@haskell.org> Message-ID: <059.0ca0242431ab1ba4b7d5cd80a8b135d3@haskell.org> #14370: improve documentation of -fdefer-typed-holes for naked expressions in ghci -------------------------------------+------------------------------------- Reporter: int-e | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Documentation | Version: 8.2.1 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: | -------------------------------------+------------------------------------- Changes (by int-e): * type: bug => task * component: Compiler => Documentation Old description: > Consider the following ghci session. > > {{{ > GHCi, version 8.2.1: http://www.haskell.org/ghc/ :? for help > Prelude> :set -fdefer-typed-holes -Wno-typed-holes > Prelude> :set -fdefer-out-of-scope-variables -Wno-deferred-out-of-scope- > variables > Prelude> let x = [_]; y = [r] > Prelude> (length x, length y) > (1,1) > Prelude> length [_] > > :4:9: error: > • Found hole: _ :: a0 > Where: ‘a0’ is an ambiguous type variable > • In the expression: _ > In the first argument of ‘length’, namely ‘[_]’ > In the expression: length [_] > • Relevant bindings include it :: Int (bound at :4:1) > Prelude> length [r] > 1 > }}} > > Why does the `length [_]` expression produce a type error immediately > instead of being deferred? > > (I've asked the same question in #14367 but this looks like a real bug.) New description: Consider the following ghci session. {{{ GHCi, version 8.2.1: http://www.haskell.org/ghc/ :? for help Prelude> :set -fdefer-typed-holes -Wno-typed-holes Prelude> :set -fdefer-out-of-scope-variables -Wno-deferred-out-of-scope- variables Prelude> let x = [_]; y = [r] Prelude> (length x, length y) (1,1) Prelude> length [_] :4:9: error: • Found hole: _ :: a0 Where: ‘a0’ is an ambiguous type variable • In the expression: _ In the first argument of ‘length’, namely ‘[_]’ In the expression: length [_] • Relevant bindings include it :: Int (bound at :4:1) Prelude> length [r] 1 }}} Why does the `length [_]` expression produce a type error immediately instead of being deferred? ~~(I've asked the same question in #14367 but this looks like a real bug.)~~ The documentation can be improved here, see [#comment:2 comment 2] -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 19 19:35:44 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 19 Oct 2017 19:35:44 -0000 Subject: [GHC] #14356: "Main: thread blocked indefinitely in an MVar operation" in fixIO In-Reply-To: <046.213052b44c9d3401325e49943e41332d@haskell.org> References: <046.213052b44c9d3401325e49943e41332d@haskell.org> Message-ID: <061.a420709921a5adf994179e476e55ace1@haskell.org> #14356: "Main: thread blocked indefinitely in an MVar operation" in fixIO -------------------------------------+------------------------------------- Reporter: nickkuk | Owner: (none) Type: bug | Status: new Priority: low | Milestone: Component: Runtime System | 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): Wiki Page: | -------------------------------------+------------------------------------- Old description: > I'm not sure whether such behavior is expected, but this program > {{{#!hs > import System.IO > > main = fixIO (\x -> return 1) >>= print > }}} > prints "1"; and this > {{{#!hs > import System.IO > > main = fixIO (\(x, _) -> return (1, print x)) >>= print . fst > }}} > prints "Main: thread blocked indefinitely in an MVar operation". > > Second program arises from something like > {{{#!hs > {-# LANUGAGE RecursiveDo #-} > > main = mdo > ... > x <- return 1 > let f = do > ... > print x > ... > ... > return f > }}} > It is not necessary to call f somewhere in mdo to get "Main: thread > blocked indefinitely in an MVar operation". New description: I'm not sure whether such behavior is expected, but this program {{{#!hs import System.IO main = fixIO (\x -> return 1) >>= print }}} prints "1"; and this {{{#!hs import System.IO main = fixIO (\(x, _) -> return (1, print x)) >>= print . fst }}} prints "Main: thread blocked indefinitely in an MVar operation". -- Comment (by nickkuk): alexbiehl, thanks a lot! I understand this stuff better now. David, sorry! I believe that you are right - I can't produce example with mdo that behaves like my second program. Desugarer (that builded in my brain :) did mistake when I consider this more easier program: {{{#!hs {-# LANGUAGE RecursiveDo #-} main = mdo print x x <- return 1 return () }}} (btw, it throws "Main: thread blocked indefinitely in an MVar operation" too). I will delete last part of ticket with mdo to decrease confusing. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 19 19:47:14 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 19 Oct 2017 19:47:14 -0000 Subject: [GHC] #14356: "Main: thread blocked indefinitely in an MVar operation" in fixIO In-Reply-To: <046.213052b44c9d3401325e49943e41332d@haskell.org> References: <046.213052b44c9d3401325e49943e41332d@haskell.org> Message-ID: <061.0091580694c6bfc632768502e49ae033@haskell.org> #14356: "Main: thread blocked indefinitely in an MVar operation" in fixIO -------------------------------------+------------------------------------- Reporter: nickkuk | Owner: (none) Type: bug | Status: new Priority: low | Milestone: Component: Runtime System | 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): Wiki Page: | -------------------------------------+------------------------------------- Description changed by nickkuk: Old description: > I'm not sure whether such behavior is expected, but this program > {{{#!hs > import System.IO > > main = fixIO (\x -> return 1) >>= print > }}} > prints "1"; and this > {{{#!hs > import System.IO > > main = fixIO (\(x, _) -> return (1, print x)) >>= print . fst > }}} > prints "Main: thread blocked indefinitely in an MVar operation". New description: I'm not sure whether such behavior is expected, but this program {{{#!hs import System.IO main = fixIO (\x -> return 1) >>= print }}} prints "1"; and this {{{#!hs import System.IO main = fixIO (\(x, _) -> return (1, print x)) >>= print . fst }}} prints "Main: thread blocked indefinitely in an MVar operation". This behavior can be fixed with additional ~ as alexbiehl said below. Also, this program with mdo {{{#!hs {-# LANGUAGE RecursiveDo #-} main = mdo print x x <- return 1 return () }}} prints "Main: thread blocked indefinitely in an MVar operation". -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 19 20:01:40 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 19 Oct 2017 20:01:40 -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.c091c63fc43d6895cb600ade0b16dc18@haskell.org> #14331: Overzealous free-floating kind check causes deriving clause to be rejected -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: merge Priority: normal | Milestone: 8.2.2 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've clarified point 3, above. Replying to [comment:32 RyanGlScott]: > > 5. c. I'm not sure I understand this business about `kappa2` (or why you'd choose `kappa2 := Type`). Can you give an example of where this would arise? {{{#!hs class C a data D a = D deriving C }}} We see that `C :: forall k. k -> Constraint`. So we have `ki` = `forall k. k -> Constraint`. We then instantiate (note new step, above) to get `ki` = `kappa3 -> Constraint`, where `kappa3` is a fresh unification variable. Unifying with `kappa -> Constraint` simply sets `kappa := kappa3`. So, `ki2` is really just `kappa3`. This is the special case in (d). What's really going on here is that both the following are well-kinded: {{{#!hs instance C D instance C (D a) }}} We choose the second -- that's the `kappa2 := Type`. Alternatively, we could issue an error here; it's all a free design choice. > > 5. e. Some more validity checks that would need to be performed for data family instances are documented [http://git.haskell.org/ghc.git/blob/7ac22b73b38b60bc26ad2508f57732aa17532a80:/compiler/typecheck/TcDeriv.hs#l747 here]. I've updated my algorithm. Thanks. > > 5. h. I was hoping for a little more detail on this skolem business. A skolem is a type variable that is held distinct from any other type. For example: {{{#!hs nid :: a -> a nid True = False }}} This fails to type-check because, in the body of `nid`, `a` is a skolem. If it were a unification variable, we would just unify `a := Bool`. The "Practical Type Inference" paper has a good discussion of skolems. In a `deriving` clause, any variable quantified in the clause is considered to be a skolem. These skolems are basically unrelated, though, to the skolems mentioned in step (i). The skolems in step (i) would come from something like this: {{{#!hs class C (a :: Type) data D k (b :: k) = D deriving C }}} leads to {{{#!hs instance ... => C (D alpha beta) }}} where `alpha` and `beta` are unification variables. Because these variables are unconstrained, we wish to quantify over them, leading to the final instance declaration {{{#!hs instance forall a (b :: a). ... => C (D a b) }}} The `a` and `b` here are the fresh skolems of stem (i). Your example is {{{#!hs class C j (a :: j) data D = D deriving (forall k. C k) }}} Here, we learn that `ki2` (of step (c)) is the skolem `k`. (This is a skolem because user-written variables are skolems, like in the `nid` example.) That is not of the form `... -> Type`, nor is it a unification variable. (I just added the key qualifier "unification" to that step.) So we reject at this point. > > Also, does the skolemicity only kick in if you write an explicit `forall`? Or would the `k` in `data D = D deriving (C k)` also get skolemized? The user-written variables in a `deriving` clause are skolems whether or not they are explicitly quantified. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 19 20:07:49 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 19 Oct 2017 20:07:49 -0000 Subject: [GHC] #14356: "Main: thread blocked indefinitely in an MVar operation" in fixIO In-Reply-To: <046.213052b44c9d3401325e49943e41332d@haskell.org> References: <046.213052b44c9d3401325e49943e41332d@haskell.org> Message-ID: <061.593ccf82aa4c2d8f952208b200a0b911@haskell.org> #14356: "Main: thread blocked indefinitely in an MVar operation" in fixIO -------------------------------------+------------------------------------- Reporter: nickkuk | Owner: (none) Type: bug | Status: patch Priority: low | Milestone: Component: Runtime System | 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:D4113 Wiki Page: | -------------------------------------+------------------------------------- Changes (by dfeuer): * status: new => patch * differential: => Phab:D4113 Comment: I've put up a differential to improve the error message. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 19 20:10:12 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 19 Oct 2017 20:10:12 -0000 Subject: [GHC] #13613: Simplify fixIO In-Reply-To: <045.c07b977628342bd8755457ac2cab62eb@haskell.org> References: <045.c07b977628342bd8755457ac2cab62eb@haskell.org> Message-ID: <060.36af12bf27a08f3945688b4f4f935dcb@haskell.org> #13613: Simplify fixIO -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: (none) Type: task | Status: closed Priority: normal | Milestone: 8.4.1 Component: Core Libraries | 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 dfeuer): * status: new => closed * resolution: => fixed Comment: This turned out to be the wrong fix; instead we switched to `readMVar` with `unsafeDupableInterleaveIO`. See 239418cf94dede0f116bb859d1bb95891235eb76. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 19 20:52:49 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 19 Oct 2017 20:52:49 -0000 Subject: [GHC] #14374: group by using groupWith seems stricter than it need be In-Reply-To: <046.0af219297e1722688aaf2332fbad2f41@haskell.org> References: <046.0af219297e1722688aaf2332fbad2f41@haskell.org> Message-ID: <061.0aa5eb244ebb7324bf6d75235bc17717@haskell.org> #14374: group by using groupWith seems stricter than it need be -------------------------------------+------------------------------------- Reporter: newthin | 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): Wiki Page: | -------------------------------------+------------------------------------- Description changed by newthin: Old description: > Using TransformListComps: > > {{{#!hs > import GHC.Exts (the, groupWith) > > is = [1..10] > fs = map ((,) False) is > ts = map ((,) True ) is > > a = [(the b, take 5 n) | (b,n) <- ts ++ fs, then group by b using > groupWith] > b = [(the b, take 5 n) | (b,n) <- ts ++ fs ++ [undefined], then group by > b using groupWith] > c = take 2 b > }}} > > As of GHC 8.2.1, both b and c fail. > > While getting b to work seems difficult - it would require realizing that > the domain of Bool has been satisfied - c seems like it might be more > feasible to get working. > > As a motivator, this pattern is pretty common in data science, where we > want to map elements of a large list to a small result domain and get > examples of those elements with each result without iterating through the > whole list. New description: Using TransformListComps: {{{#!hs import GHC.Exts (the, groupWith) is = [1..10] fs = map ((,) False) is ts = map ((,) True ) is r1 = [(the b, take 5 n) | (b,n) <- ts ++ fs, then group by b using groupWith] r2 = [(the b, take 5 n) | (b,n) <- ts ++ fs ++ [undefined], then group by b using groupWith] r3 = take 2 r2 }}} As of GHC 8.2.1, both r2 and r3 fail. While getting r2 to work seems difficult - it would require realizing that the domain of Bool has been satisfied - r3 seems like it might be more feasible to get working. As a motivator, this pattern is pretty common in data science, where we want to map elements of a large list to a small result domain and get examples of those elements with each result without iterating through the whole list. -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 19 21:37:05 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 19 Oct 2017 21:37:05 -0000 Subject: [GHC] #10189: explicit promotions of prefix data constructors can't be parsed naturally In-Reply-To: <048.7a1fa374089d49b55ac4c378c43baf5b@haskell.org> References: <048.7a1fa374089d49b55ac4c378c43baf5b@haskell.org> Message-ID: <063.890ecb997bcd3e1441bdd281bc602d60@haskell.org> #10189: explicit promotions of prefix data constructors can't be parsed naturally -------------------------------------+------------------------------------- Reporter: Kinokkory | Owner: Kinokkory Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 7.8.4 (Parser) | Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: GHC rejects | Unknown/Multiple valid program | Test Case: Blocked By: | Blocking: Related Tickets: #10188 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by dfeuer): * milestone: => 8.6.1 Comment: This is still horribly confusing and unexpected. I also don't think it's documented. I'm definitely in the "just fix it" camp. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 19 21:37:18 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 19 Oct 2017 21:37:18 -0000 Subject: [GHC] #10189: explicit promotions of prefix data constructors can't be parsed naturally In-Reply-To: <048.7a1fa374089d49b55ac4c378c43baf5b@haskell.org> References: <048.7a1fa374089d49b55ac4c378c43baf5b@haskell.org> Message-ID: <063.803cbdc4af12f16d938c7e4fd4562cd3@haskell.org> #10189: explicit promotions of prefix data constructors can't be parsed naturally -------------------------------------+------------------------------------- Reporter: Kinokkory | Owner: Kinokkory Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 7.8.4 (Parser) | Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: GHC rejects | Unknown/Multiple valid program | Test Case: Blocked By: | Blocking: Related Tickets: #10188 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by dfeuer): * cc: dfeuer (added) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 19 22:04:11 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 19 Oct 2017 22:04:11 -0000 Subject: [GHC] #14346: 8.2.1 regression: heap corruption after safe foreign calls In-Reply-To: <049.7a4af7d8399ac93444ea4b9211bf91ff@haskell.org> References: <049.7a4af7d8399ac93444ea4b9211bf91ff@haskell.org> Message-ID: <064.159b23ba47ba28e58a09f762e4c1cba8@haskell.org> #14346: 8.2.1 regression: heap corruption after safe foreign calls -------------------------------------+------------------------------------- Reporter: andrewchen | Owner: (none) Type: bug | Status: patch Priority: highest | Milestone: 8.2.2 Component: Runtime System | Version: 8.2.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Runtime crash | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4110 Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): Indeed Phab:D4110 appears to fix the testcase from comment:14. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 19 23:08:23 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 19 Oct 2017 23:08:23 -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.1b8ea58ceb84a9a55f50266290449d4e@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 nomeata): > It would be nice to factor out the common tails, e.g. by branching to the first tail already emitted. Branches can be expensive, so this might not be a clear win. Have you measured the effect? (You can do that without modifying GHC: Just get your hands on the assembly file, make the changes you want to see, and compare.) The other idea, detecting blocks that are equal up-to a constant, sounds fun. But again, the question is: Is it worth it? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 20 02:42:53 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 20 Oct 2017 02:42:53 -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.c776e155bcee00d8584a4f2da1fd234c@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 Ben Gamari ): In [changeset:"13758c6cfec1cfc8211d8c549ab69ee269f15b1e/ghc" 13758c6c/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="13758c6cfec1cfc8211d8c549ab69ee269f15b1e" Added a test for 'timeout' to be accurate. This is the first in a series of regression tests prompted by https://ghc.haskell.org/trac/ghc/ticket/8684 and D4011, D4012, D4041 Test Plan: This _is_ a test. Reviewers: nh2, austin, hvr, bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie GHC Trac Issues: #8684 Differential Revision: https://phabricator.haskell.org/D4074 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 20 03:07:47 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 20 Oct 2017 03:07:47 -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.a4cca9faaf8e7258165da81c85561b8f@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 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. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 20 05:10:52 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 20 Oct 2017 05:10:52 -0000 Subject: [GHC] #14109: GHC matches -- as a varsym when lexing a qvarsym In-Reply-To: <044.68208d60fba75e18bd381d8d54ed301c@haskell.org> References: <044.68208d60fba75e18bd381d8d54ed301c@haskell.org> Message-ID: <059.86406204c0b2bff9e1f3d1aab212f548@haskell.org> #14109: GHC matches -- as a varsym when lexing a qvarsym -------------------------------------+------------------------------------- Reporter: glguy | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 (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: | -------------------------------------+------------------------------------- Comment (by harpocrates): It looks like the lexer does absolutely no validation for anything that is qualified. Things like `Prelude.|`, `Prelude.->`, `Prelude.data`, etc. all make it all the way through to the renamer. Most of these should (according to the report) probably lex as 3 or more separate tokens. Alternatively (and I prefer this), we could just report a lexer error. The functions for validating qualified symbols, constructors, etc. are already defined in `basicTypes/Lexeme.hs`, so there isn't a much work to be done here. I'm also volunteering to implement either of these options. :) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 20 08:59:12 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 20 Oct 2017 08:59:12 -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.fe42fa8a51105f32b1b86d4c94f2c33c@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 simonpj): Across an entire module I think there are quite a lot of code blocks that are byte-for-byte identical; i.e. no extra branch or "equal up to constant" required. I wonder if we could simply gather stats on the top 100 code-blocks, put them into the RTS, and use them whenever we come across one? I bet that'd be highly effective; but I do not have data to back up my claim. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 20 09:04:37 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 20 Oct 2017 09:04:37 -0000 Subject: [GHC] #14375: Implement with# primop Message-ID: <046.d97bc36423b0cbcf2ececb77831c1a4a@haskell.org> #14375: Implement with# primop -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): ​Phab:D4110 | Wiki Page: -------------------------------------+------------------------------------- In Trac #14346 we proposed the new `with#` primop {{{ with# :: a -> (State# s -> (# State# s, b #)) -> State# s -> (# State# s, b #) }}} This ticket is to track progress. See ​Phab:D4110. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 20 09:05:38 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 20 Oct 2017 09:05:38 -0000 Subject: [GHC] #14346: 8.2.1 regression: heap corruption after safe foreign calls In-Reply-To: <049.7a4af7d8399ac93444ea4b9211bf91ff@haskell.org> References: <049.7a4af7d8399ac93444ea4b9211bf91ff@haskell.org> Message-ID: <064.f862b23b880dcbebb6bd33521b1efec3@haskell.org> #14346: 8.2.1 regression: heap corruption after safe foreign calls -------------------------------------+------------------------------------- Reporter: andrewchen | Owner: (none) Type: bug | Status: patch Priority: highest | Milestone: 8.2.2 Component: Runtime System | Version: 8.2.1 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 simonpj): * differential: Phab:D4110 => Comment: Let's move discussion of `with#` to new ticket just for that purpose: #14375. This ticket remains to track the bug reported in the Description. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 20 09:45:39 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 20 Oct 2017 09:45:39 -0000 Subject: [GHC] #14375: Implement with# primop In-Reply-To: <046.d97bc36423b0cbcf2ececb77831c1a4a@haskell.org> References: <046.d97bc36423b0cbcf2ececb77831c1a4a@haskell.org> Message-ID: <061.102e0d298047dfe702119d28bc3ac460@haskell.org> #14375: Implement with# primop -------------------------------------+------------------------------------- Reporter: simonpj | 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: #14346 | Differential Rev(s): ​Phab:D4110 Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * related: => #14346 Comment: In Phab:D4110 Simon M says > The one downside of this is that we have to build a function closure to pass to with#, which entails more allocation than we were doing previously. But there's an alternative approach that would avoid this: expand with# during CoreToStg (or CorePrep perhaps) into the original case expression + touch#. There should be no extra allocation, no new primops needed, all it does is prevent the simplifier from eliminating the continuation. That's a good point. We implement `runST` in this way too. But that seems very ad hoc. I've realised that we have quite a bunch of primops that take continuations. For example {{{ maskAsyncExceptions# :: (State# RealWorld -> (# State# RealWorld, a #)) -> (State# RealWorld -> (# State# RealWorld, a #)) }}} We don't really want to allocate a continuation here, only to immediately enter it. But in fact we do! I've also realised that it's quite easy to avoid: * When converting to STG, instead of insisting that the argument to `maskAsyncExceptions#` is a variable, insiste that it is a lambda `(\s.e)` * When doing code-gen for `maskAsyncExceptions# (\s.e) s2`, emit the mask code (as now) and continue code-gen for `e`. That would mean altering STG a bit to allow non-variable arguments. An alternative would be to convert `maskAsyncExceptions# e s` to this STG: {{{ join j s = e in maskAsyncExceptions# j s }}} This isn't quite as good because it flushes the live variables of `e` to the stack, and then takes a jump to it (the latter will be elminated in Cmm land); but it's much better than what we do now. NB: this would not be valid Core because `j` is not saturated; but here it's just an intermediate step in codegen. Moreover, we don't want to make it ''too'' much like join points; in particular not in the simplifier. For example {{{ case (maskAsyncExceptions# (\s. e) s2) of (# s3, r #) -> blah ----> ???? maskAsyncExceptions (\s. case e of (# s3, r #) -> blah) s2 }}} Probably not! Because that would broaden the scope of the mask. But it's fine to treat it in a very join-point-like way at codegen time. We can apply similar thinking to `catch#`. {{{ catch# :: (State# RealWorld -> (# State# RealWorld, a #) ) -> (b -> State# RealWorld -> (# State# RealWorld, a #) ) -> State# RealWorld -> (# State# RealWorld, a #) }}} Here we allocate two continuations. But we'd really prefer to allocate none! Just push a catch frame (which we do anyway). Perhaps we can generate this STG: {{{ join jnormal s = e1 s in join jexception b s = e2 b s in catch# jnormal jexception s }}} Again we compile those join point just as we normally do (live variables on the stack), so that invoking one is just "adjust SP and jump". Again this would not be valid Core, just a codegen intermediate. I like this. Conclusion: let's not do any special codegen stuff for `with#` until we've worked this out. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 20 09:51:52 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 20 Oct 2017 09:51:52 -0000 Subject: [GHC] #14375: Implement with# primop In-Reply-To: <046.d97bc36423b0cbcf2ececb77831c1a4a@haskell.org> References: <046.d97bc36423b0cbcf2ececb77831c1a4a@haskell.org> Message-ID: <061.48a0eb498aff87c4610612fc9e2af876@haskell.org> #14375: Implement with# primop -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: | Keywords: JoinPoints Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #14346 | Differential Rev(s): ​Phab:D4110 Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * keywords: => JoinPoints -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 20 09:56:07 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 20 Oct 2017 09:56:07 -0000 Subject: [GHC] #7259: Eta expansion of products in System FC In-Reply-To: <046.eb91fb12bdf35396d79679c78f7a6c38@haskell.org> References: <046.eb91fb12bdf35396d79679c78f7a6c38@haskell.org> Message-ID: <061.e5778c907d96f9bbe71da68cd05f9059@haskell.org> #7259: Eta expansion of products in System FC -------------------------------------+------------------------------------- Reporter: simonpj | Owner: simonpj Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.6.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 Iceland_jack): What is the status of this? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 20 10:03:42 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 20 Oct 2017 10:03:42 -0000 Subject: [GHC] #7259: Eta expansion of products in System FC In-Reply-To: <046.eb91fb12bdf35396d79679c78f7a6c38@haskell.org> References: <046.eb91fb12bdf35396d79679c78f7a6c38@haskell.org> Message-ID: <061.3321f5b1376e3bb1bfe911b68a86faf0@haskell.org> #7259: Eta expansion of products in System FC -------------------------------------+------------------------------------- Reporter: simonpj | Owner: simonpj Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.6.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 simonpj): > What is the status of this? It's parked at the moment. No one actually working on it that I know of. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 20 11:51:40 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 20 Oct 2017 11:51:40 -0000 Subject: [GHC] #13604: ghci no longer loads dynamic .o files by default if they were built with -O In-Reply-To: <045.626a6b40d9101c93e2935653ef7e4668@haskell.org> References: <045.626a6b40d9101c93e2935653ef7e4668@haskell.org> Message-ID: <060.34d79fbd59e440a5a109ed32161d9742@haskell.org> #13604: ghci no longer loads dynamic .o files by default if they were built with -O -------------------------------------+------------------------------------- Reporter: George | Owner: dfeuer Type: bug | Status: new Priority: highest | Milestone: 8.2.2 Component: Compiler | Version: 8.2.1-rc1 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): Phab:D3514 Wiki Page: | -------------------------------------+------------------------------------- Comment (by dfeuer): I'm working on the separate optimization level tracking. I'll probably have that done by the end of the day. I'll likely need a bit of help to get the user interface sorted. I'm not sure how that should look. Maybe a separate `-frecompile-for-opt-level-change`? By the way, as far as I can tell, we ''don't'' track changes in ''individual'' optimization flags, like `-ffull-laziness`. I imagine we should do something about that. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 20 12:01:52 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 20 Oct 2017 12:01:52 -0000 Subject: [GHC] #14363: :type hangs on coerce In-Reply-To: <051.a5d2467b66df31be8b2c92e458401ba5@haskell.org> References: <051.a5d2467b66df31be8b2c92e458401ba5@haskell.org> Message-ID: <066.4ee5065979507e1e7ab6ccd9dc1a4fce@haskell.org> #14363: :type hangs on coerce -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 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 Simon Peyton Jones ): In [changeset:"3acd6164fea6d4d5d87521a291455a18c9c9a8ee/ghc" 3acd616/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="3acd6164fea6d4d5d87521a291455a18c9c9a8ee" Improve kick-out in the constraint solver This patch was provoked by Trac #14363. Turned out that we were kicking out too many constraints in TcSMonad.kickOutRewritable, and that mean that the work-list never became empty: infinite loop! That in turn made me look harder at the Main Theorem in Note [Extending the inert equalities]. Main changes * Replace TcType.isTyVarExposed by TcType.isTyVarHead. The over-agressive isTyVarExposed is what caused Trac #14363. See Note [K3: completeness of solving] in TcSMonad. * TcType.Make anyRewriteableTyVar role-aware. In particular, a ~R ty cannot rewrite b ~R f a See Note [anyRewriteableTyVar must be role-aware]. That means it has to be given a role argument, which forces a little refactoring. I think this change is fixing a bug that hasn't yet been reported. The actual reported bug is handled by the previous bullet. But this change is definitely the Right Thing The main changes are in TcSMonad.kick_out_rewritable, and in TcType (isTyVarExposed ---> isTyVarHead). I did a little unforced refactoring: * Use the cc_eq_rel field of a CTyEqCan when it is available, rather than recomputing it. * Define eqCanRewrite :: EqRel -> EqRel -> EqRel, and use it, instead of duplicating its logic }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 20 12:04:28 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 20 Oct 2017 12:04:28 -0000 Subject: [GHC] #14363: :type hangs on coerce In-Reply-To: <051.a5d2467b66df31be8b2c92e458401ba5@haskell.org> References: <051.a5d2467b66df31be8b2c92e458401ba5@haskell.org> Message-ID: <066.adb627fe6cd742df055b835dd0bb3fcc@haskell.org> #14363: :type hangs on coerce -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: fixed | Keywords: Roles Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: | typecheck/should_compile/T14363, | T14363a Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * status: new => closed * testcase: => typecheck/should_compile/T14363, T14363a * resolution: => fixed Comment: My patch fixes the loop. The occurs-check problem was already fixed, perhaps by my `wc_insol` changes. I've added tests for both. Richard I'd appreciate a quick look at the patch, but I'm pretty confident (following our discussion) hence committing. Perhaps you can then close. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 20 12:19:43 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 20 Oct 2017 12:19:43 -0000 Subject: [GHC] #14363: :type hangs on coerce In-Reply-To: <051.a5d2467b66df31be8b2c92e458401ba5@haskell.org> References: <051.a5d2467b66df31be8b2c92e458401ba5@haskell.org> Message-ID: <066.cebe25810fc9dee3ca67e0dc32daa2fc@haskell.org> #14363: :type hangs on coerce -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: fixed | Keywords: Roles Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: | typecheck/should_compile/T14363, | T14363a Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Iceland_jack): Thank you Simon. A coworker of mine met you at yesterday's Papers We Love, she said you were working on a patch fixing a loop in the type checker :] I'm curious if this was it -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 20 12:23:07 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 20 Oct 2017 12:23:07 -0000 Subject: [GHC] #14375: Implement with# primop In-Reply-To: <046.d97bc36423b0cbcf2ececb77831c1a4a@haskell.org> References: <046.d97bc36423b0cbcf2ececb77831c1a4a@haskell.org> Message-ID: <061.f1a1789d4d5160f6ec40fa4a7a915331@haskell.org> #14375: Implement with# primop -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: | Keywords: JoinPoints Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #14346 | Differential Rev(s): ​Phab:D4110 Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): I'm not entirely sure I see what this means for the join point saturation invariant. Indeed we under no obligation to obey the say invariants surrounding join points that we obey in Core, but in that case what invariants are we obeying? Specifically, when is an unsaturated join point allowed? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 20 12:42:18 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 20 Oct 2017 12:42:18 -0000 Subject: [GHC] #14363: :type hangs on coerce In-Reply-To: <051.a5d2467b66df31be8b2c92e458401ba5@haskell.org> References: <051.a5d2467b66df31be8b2c92e458401ba5@haskell.org> Message-ID: <066.ed84f22f7df97ea75840c6be5b1f86e5@haskell.org> #14363: :type hangs on coerce -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: fixed | Keywords: Roles Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: | typecheck/should_compile/T14363, | T14363a Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Yes, that was it :-). -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 20 12:44:17 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 20 Oct 2017 12:44:17 -0000 Subject: [GHC] #14375: Implement with# primop In-Reply-To: <046.d97bc36423b0cbcf2ececb77831c1a4a@haskell.org> References: <046.d97bc36423b0cbcf2ececb77831c1a4a@haskell.org> Message-ID: <061.5197e411a6291811e836d4b49d970288@haskell.org> #14375: Implement with# primop -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: | Keywords: JoinPoints Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #14346 | Differential Rev(s): ​Phab:D4110 Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Like I say, I'm thinking of this as STG only; an intermediate on the way to codegen. Yes there are still invariants. To be a bit more precise `maskAsyncExceptions# j s`, `j` must be an arity-1 join point. Always. But I am only thinking aloud here. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 20 12:50:48 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 20 Oct 2017 12:50:48 -0000 Subject: [GHC] #14347: Top-level RecordWildCards no longer working. In-Reply-To: <047.9d7d4bc51f0d30fd962b21bdfacfc205@haskell.org> References: <047.9d7d4bc51f0d30fd962b21bdfacfc205@haskell.org> Message-ID: <062.8ed09747ede207937b1120be1d94bd2b@haskell.org> #14347: Top-level RecordWildCards no longer working. -------------------------------------+------------------------------------- Reporter: Fuuzetsu | 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): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Simon Peyton Jones ): In [changeset:"e375bd350bc9e719b757f4dc8c907c330b26ef6e/ghc" e375bd35/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="e375bd350bc9e719b757f4dc8c907c330b26ef6e" Update record-wildcard docs This patch clarifies the story for record wildcards, following the discussion on Trac #14347. }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 20 13:09:41 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 20 Oct 2017 13:09:41 -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.0040c400431159423b2f1cb27df24af6@haskell.org> #14331: Overzealous free-floating kind check causes deriving clause to be rejected -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: merge Priority: normal | Milestone: 8.2.2 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): Replying to [comment:33 goldfire]: > {{{#!hs > class C a > data D a = D deriving C > }}} > > We see that `C :: forall k. k -> Constraint`. So we have `ki` = `forall k. k -> Constraint`. We then instantiate (note new step, above) to get `ki` = `kappa3 -> Constraint`, where `kappa3` is a fresh unification variable. Unifying with `kappa -> Constraint` simply sets `kappa := kappa3`. So, `ki2` is really just `kappa3`. This is the special case in (d). OK. My question is: why do we need to special-case this at all? After all, in step (i) we unify the kind of `ty` with `ki2`, and the kind of `ty` will always be of the form `... -> Type` by virtue of the kind of `ty` coming from a data type. So we achieve the same effect without needing a special case at all. (In fact, this is currently what the implementation of `TcDeriv` does.) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 20 13:14:48 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 20 Oct 2017 13:14:48 -0000 Subject: [GHC] #14368: GHC 8.2.1 doesn't inform you when the monomorphism restriction kicks in anymore In-Reply-To: <050.621f9e352a173175860adefb5e5fb1ff@haskell.org> References: <050.621f9e352a173175860adefb5e5fb1ff@haskell.org> Message-ID: <065.983bf3d250189cc02e442e9389383b1f@haskell.org> #14368: GHC 8.2.1 doesn't inform you when the monomorphism restriction kicks in anymore -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.2.1 checker) | 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 simonpj): It was an ad-hoc special case before. This is tricky to report well. For example {{{ f = Just (==) }}} does not give that hint. And {{{ f = (==) foo = (f 'c', f True) }}} gives {{{ • Couldn't match expected type ‘Char’ with actual type ‘Bool’ • In the first argument of ‘f’, namely ‘True’ }}} Ironically, we do generate a warning {{{ Foo.hs:7:1: warning: The Monomorphism Restriction applies to the binding for ‘f’ Consider giving it a type signature }}} but since it's a warning it is suppressed when there is an error. Maybe errors should not suppress warnings? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 20 13:18:45 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 20 Oct 2017 13:18:45 -0000 Subject: [GHC] #14368: GHC 8.2.1 doesn't inform you when the monomorphism restriction kicks in anymore In-Reply-To: <050.621f9e352a173175860adefb5e5fb1ff@haskell.org> References: <050.621f9e352a173175860adefb5e5fb1ff@haskell.org> Message-ID: <065.7fb4166e41185fe41008205134009e75@haskell.org> #14368: GHC 8.2.1 doesn't inform you when the monomorphism restriction kicks in anymore -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.2.1 checker) | 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 RyanGlScott): I'm OK with not being able to report every possible occurrences of the monomorphism restriction. But as you've demonstrated, GHC clearly //can// detect that the monorphism restriction is kicking in here (in a warning)—can't we just copy that message in the error? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 20 13:24:33 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 20 Oct 2017 13:24:33 -0000 Subject: [GHC] #14368: GHC 8.2.1 doesn't inform you when the monomorphism restriction kicks in anymore In-Reply-To: <050.621f9e352a173175860adefb5e5fb1ff@haskell.org> References: <050.621f9e352a173175860adefb5e5fb1ff@haskell.org> Message-ID: <065.28244e2491acca291ce9228505f783a0@haskell.org> #14368: GHC 8.2.1 doesn't inform you when the monomorphism restriction kicks in anymore -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.2.1 checker) | 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 simonpj): > can't we just copy that message in the error But ''which'' errors? The two sites are quite separate. E.g. the Char/Bool error is much later. I'm sure there are improvements to be had here; just not sure exactly what and how. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 20 13:28:10 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 20 Oct 2017 13:28:10 -0000 Subject: [GHC] #14375: Implement with# primop In-Reply-To: <046.d97bc36423b0cbcf2ececb77831c1a4a@haskell.org> References: <046.d97bc36423b0cbcf2ececb77831c1a4a@haskell.org> Message-ID: <061.9d943ad3e29f50dab8cdd32a50bac665@haskell.org> #14375: Implement with# primop -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: | Keywords: JoinPoints Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #14346 | Differential Rev(s): ​Phab:D4110 Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): > To be a bit more precise `maskAsyncExceptions# j s`, `j` must be an arity-1 join point. Always. Sure, so in effect we just lift the saturation requirement on arguments of some primops. That makes sense. I just wanted to make sure that we wouldn't be sacrificing even more STG- linting with this change. I can have a swing at implementing this once we feel the design hss converged, if you would like. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 20 13:28:42 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 20 Oct 2017 13:28:42 -0000 Subject: [GHC] #14368: GHC 8.2.1 doesn't inform you when the monomorphism restriction kicks in anymore In-Reply-To: <050.621f9e352a173175860adefb5e5fb1ff@haskell.org> References: <050.621f9e352a173175860adefb5e5fb1ff@haskell.org> Message-ID: <065.02efddce16bee08ed4c45f730b131848@haskell.org> #14368: GHC 8.2.1 doesn't inform you when the monomorphism restriction kicks in anymore -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: Component: Compiler (Type | Version: 8.2.1 checker) | Resolution: invalid | 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): * status: new => closed * resolution: => invalid Comment: Oh, I see what you mean. This program: {{{#!hs f = (==) foo = (f 'c', f True) }}} //only// emits an error about `foo`, and doesn't separately error for `f`. Blast. In that case, I agree that this is probably not worth the effort to implement. I'll close as invalid (but feel free to reopen if you can think of a feasible way to do this.) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 20 14:04:51 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 20 Oct 2017 14:04:51 -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.7e39c10fd12f5948416f69f642732437@haskell.org> #14373: Introduce PTR-tagging for big constructor families -------------------------------------+------------------------------------- Reporter: heisenbug | 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): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): See branch `wip/T14373` -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 20 14:28:10 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 20 Oct 2017 14:28:10 -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.96c68e3dfc8f7d006c5af54b524a230c@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 bgamari): I wonder what prior art exists in this area; I'm sure other compilers have considered this in the past. An interesting and loosely related bit of work that I have seen in the past is the work in the LLVM community on a technique they call outlining. See the [[https://www.youtube.com/watch?v=yorld-WSOeU|talk]] for details. This was pursued as a means of reducing code size and is no doubt more sophisticated than what Simon was looking for in comment:4, but I thought I'd leave the reference here nevertheless. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 20 14:31:34 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 20 Oct 2017 14:31:34 -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.85515011f79e8895ab4c67601e9fab43@haskell.org> #14373: Introduce PTR-tagging for big constructor families -------------------------------------+------------------------------------- Reporter: heisenbug | Owner: (none) 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): Wiki Page: | -------------------------------------+------------------------------------- Changes (by heisenbug): * status: new => patch -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 20 14:37:48 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 20 Oct 2017 14:37: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.f402dbf865bec148ba0093631271796d@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 heisenbug): Replying to [comment:2 nomeata]: > > It would be nice to factor out the common tails, e.g. by branching to the first tail already emitted. > > Branches can be expensive, so this might not be a clear win. Have you measured the effect? (You can do that without modifying GHC: Just get your hands on the assembly file, make the changes you want to see, and compare.) These will probably be short, known branches. Since more ''relevant'' code now can reside in the instruction cache, I expect less misses and no prediction failures. > > The other idea, detecting blocks that are equal up-to a constant, sounds fun. But again, the question is: Is it worth it? Well, it makes code straight-line and branchless. Eliminates jump-tables. Shrinks code size. Which one of these is a penalty? ;-) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 20 15:11:49 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 20 Oct 2017 15:11:49 -0000 Subject: [GHC] #13604: ghci no longer loads dynamic .o files by default if they were built with -O In-Reply-To: <045.626a6b40d9101c93e2935653ef7e4668@haskell.org> References: <045.626a6b40d9101c93e2935653ef7e4668@haskell.org> Message-ID: <060.81349f066a7a1ad11ff72d49e52bbb22@haskell.org> #13604: ghci no longer loads dynamic .o files by default if they were built with -O -------------------------------------+------------------------------------- Reporter: George | Owner: dfeuer Type: bug | Status: new Priority: highest | Milestone: 8.2.2 Component: Compiler | Version: 8.2.1-rc1 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): Phab:D3514 Wiki Page: | -------------------------------------+------------------------------------- Comment (by dfeuer): One flag we should ideally treat specially (at some point) is `-fignore- interface-pragmas`. If the ''importing'' module uses that pragma, we can be much more aggressive about recompilation avoidance. In particular, if we don't already do this, we should really produce two interface hashes, one of which ignores interface pragmas. That way we won't recompile a module just because the pieces it's explicitly said it doesn't care about have changed. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 20 15:17:43 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 20 Oct 2017 15:17:43 -0000 Subject: [GHC] #14152: Float exit paths out of recursive functions In-Reply-To: <046.dc062d85b02b871348583b82e3b8d72a@haskell.org> References: <046.dc062d85b02b871348583b82e3b8d72a@haskell.org> Message-ID: <061.e897d3c30383b21938272486690f12bf@haskell.org> #14152: Float exit paths out of recursive functions -------------------------------------+------------------------------------- Reporter: nomeata | Owner: (none) Type: task | Status: patch Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: | Keywords: JoinPoints Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #14137 #10918 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Description changed by nomeata: Old description: > This is a spin off of a discussion from #14137. > > == The problem == > > We generally avoid inlining or floating a binding into a recursive > function, because we do not want to duplicat work/allocations. > > But sometimes the binding is only used inside the recursive function on > the “exit path”. In which case it would be good to inline. Example: > > {{{#!hs > let x = f x0 > in let go 10 = h x > go i = go (i+1) > in go (0::Int) + 100 > }}} > > It would be beneficial to inline `x`. > > The problem is that it is not very obvious that this occurence of `x` is > ok for inlining. In particular, it is not syntactically visible. > > == Proposed solution == > > If we apply loopification (#14068), this would turn into > > {{{#!hs > let x = f x0 > in let go n = > joinrec jgo 10 = h x > jgo i = call jgo (i+1) > in call jgo n > in go (0::Int) + 100 > }}} > > I’d like to call this ''first joinrec normal form'', defined as “every > recursive function where all recursive calls are tail-recursive is a > recursive join point”. > > This ticket proposes to transform this even further and ''float out all > case alternatives that do not mention `jgo` as non-recursive join- > points'', as so: > > {{{#!hs > let x = f x0 > in let go n = > join jexit = h x > joinrec jgo 10 = call jexit > jgo i = call jgo (i+1) > in call jgo n > in go (0::Int) + 100 > }}} > > I’d like to call this ''second `joinrec` normal form'', defined as “in > first `joinrec` normal form, and all subexpressions of a recursive join > point `j` that are in tail-call position and do not mention `j` are join > calls”. > > If the floated expression has free variables that are bound inside the > `joinrec`, they turn into parameters of the newly created joinpoint. > > At this point, GHC can tell that `go` is called at most once, and will > therefore happily inline `x` into the right hand side of `jexit. > > == Alternative solutions == > > Ticket #10918 uses Call Arity results to learn that `x` is one-Shot, and > inline it even in the original code. This works, but the problem is that > float-out will undo this. See [ticket:10918#comment:5]. > > == Limitation == > > It only works for recursive functions that are join points, or can be > turned into join points by loopification (#14068). It does not work > forexample for > > {{{#!hs > let x = f x0 > let go 0 = h x > go n = (go (n-1) + 1 > in go 10 > }}} > > although it would be equally desirable to float `h x` out of `go` so > that `x` can be inlined. > > == Preservation == > > A remaining tricky point is that we need to stop one of these carefully- > constructed non-recursive join points being inlined into a recursive join > point, even if it is invoked at just one place. That should not be hard. > And in a final run of the simplifer (or in CorePrep) we could switch off > that restriction and let it inline. (Ticket #14137 is about inlining > ''more'' join points into recursive join points, so it is the antithesis > to the present ticket.) New description: This is a spin off of a discussion from #14137. == The problem == We generally avoid inlining or floating a binding into a recursive function, because we do not want to duplicat work/allocations. But sometimes the binding is only used inside the recursive function on the “exit path”. In which case it would be good to inline. Example: {{{#!hs let x = f x0 in let go 10 = h x go i = go (i+1) in go (0::Int) + 100 }}} It would be beneficial to inline `x`. The problem is that it is not very obvious that this occurence of `x` is ok for inlining. In particular, it is not syntactically visible. == Proposed solution == If we apply loopification (#14068), this would turn into {{{#!hs let x = f x0 in let go n = joinrec jgo 10 = h x jgo i = call jgo (i+1) in jump jgo n in go (0::Int) + 100 }}} I’d like to call this ''first joinrec normal form'', defined as “every recursive function where all recursive calls are tail-recursive is a recursive join point”. This ticket proposes to transform this even further and ''float out all case alternatives that do not mention `jgo` as non-recursive join- points'', as so: {{{#!hs let x = f x0 in let go n = join jexit = h x joinrec jgo 10 = call jexit jgo i = call jgo (i+1) in jump jgo n in go (0::Int) + 100 }}} I’d like to call this ''second `joinrec` normal form'', defined as “in first `joinrec` normal form, and all subexpressions of a recursive join point `j` that are in tail-call position and do not mention `j` are join calls”. If the floated expression has free variables that are bound inside the `joinrec`, they turn into parameters of the newly created joinpoint. At this point, GHC can tell that `go` is called at most once, and will therefore happily inline `x` into the right hand side of `jexit. == Alternative solutions == Ticket #10918 uses Call Arity results to learn that `x` is one-Shot, and inline it even in the original code. This works, but the problem is that float-out will undo this. See [ticket:10918#comment:5]. == Limitation == It only works for recursive functions that are join points, or can be turned into join points by loopification (#14068). It does not work forexample for {{{#!hs let x = f x0 let go 0 = h x go n = (go (n-1) + 1 in go 10 }}} although it would be equally desirable to float `h x` out of `go` so that `x` can be inlined. == Preservation == A remaining tricky point is that we need to stop one of these carefully- constructed non-recursive join points being inlined into a recursive join point, even if it is invoked at just one place. That should not be hard. And in a final run of the simplifer (or in CorePrep) we could switch off that restriction and let it inline. (Ticket #14137 is about inlining ''more'' join points into recursive join points, so it is the antithesis to the present ticket.) -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 20 15:27:04 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 20 Oct 2017 15:27:04 -0000 Subject: [GHC] #12479: build fail of commercialhaskell.com with stack build on mac os x sierra In-Reply-To: <047.7670c81fff3911fb27fec4bdb084ac72@haskell.org> References: <047.7670c81fff3911fb27fec4bdb084ac72@haskell.org> Message-ID: <062.62c7c018b200633e61985a4b91eb0332@haskell.org> #12479: build fail of commercialhaskell.com with stack build on mac os x sierra -------------------------------------+------------------------------------- Reporter: stephenb | Owner: (none) Type: bug | Status: closed Priority: highest | Milestone: 8.0.2 Component: Compiler | Version: 8.0.1 Resolution: fixed | Keywords: Operating System: MacOS X | Architecture: Type of failure: Compile-time | Unknown/Multiple crash | Test Case: Blocked By: | Blocking: Related Tickets: #12198 | Differential Rev(s): Phab:D2532 Wiki Page: | -------------------------------------+------------------------------------- Comment (by dredozubov): I'm experiencing the same problem with OS X Sierra: {{{ [ 53 of 176] Compiling Auth.DB.Model.User ( src/Auth/DB/Model/User.hs, .stack-work/dist/x86_64-osx/Cabal-2.0.0.2/build/Auth/DB/Model/User.o ) ghc: panic! (the 'impossible' happened) (GHC version 8.2.1 for x86_64-apple-darwin): Loading temp shared object failed: dlopen(/var/folders/f8/2_rc4tgd1gj9vbgv7q9gbk4c0000gn/T/ghc45626_0/libghc_261.dylib, 5): no suitable image found. Did find: /var/folders/f8/2_rc4tgd1gj9vbgv7q9gbk4c0000gn/T/ghc45626_0/libghc_261.dylib: malformed mach-o: load commands size (32936) > 32768 Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug }}} Not sure if that's a GHC or stack issue. I can only reproduce it only on a few big projects with 8.2.1 and a bigger number of projects failing with 7.10.3. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 20 15:57:18 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 20 Oct 2017 15:57:18 -0000 Subject: [GHC] #12479: build fail of commercialhaskell.com with stack build on mac os x sierra In-Reply-To: <047.7670c81fff3911fb27fec4bdb084ac72@haskell.org> References: <047.7670c81fff3911fb27fec4bdb084ac72@haskell.org> Message-ID: <062.e18c1f8ab052decc14a4b1baeb42ff7d@haskell.org> #12479: build fail of commercialhaskell.com with stack build on mac os x sierra -------------------------------------+------------------------------------- Reporter: stephenb | Owner: (none) Type: bug | Status: closed Priority: highest | Milestone: 8.0.2 Component: Compiler | Version: 8.0.1 Resolution: fixed | Keywords: Operating System: MacOS X | Architecture: Type of failure: Compile-time | Unknown/Multiple crash | Test Case: Blocked By: | Blocking: Related Tickets: #12198 | Differential Rev(s): Phab:D2532 Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): dredozubov, since this ticket is getting a bit long could you open another one? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 20 15:58:55 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 20 Oct 2017 15:58:55 -0000 Subject: [GHC] #12479: build fail of commercialhaskell.com with stack build on mac os x sierra In-Reply-To: <047.7670c81fff3911fb27fec4bdb084ac72@haskell.org> References: <047.7670c81fff3911fb27fec4bdb084ac72@haskell.org> Message-ID: <062.8de214ad83868fd10a73dc80628c700b@haskell.org> #12479: build fail of commercialhaskell.com with stack build on mac os x sierra -------------------------------------+------------------------------------- Reporter: stephenb | Owner: (none) Type: bug | Status: closed Priority: highest | Milestone: 8.0.2 Component: Compiler | Version: 8.0.1 Resolution: fixed | Keywords: Operating System: MacOS X | Architecture: Type of failure: Compile-time | Unknown/Multiple crash | Test Case: Blocked By: | Blocking: Related Tickets: #12198 | Differential Rev(s): Phab:D2532 Wiki Page: | -------------------------------------+------------------------------------- Comment (by glguy): There's already a ticket for the problem of the load command size limit added in macOS 10.12 (I don't remember what it was) but it doesn't need a new ticket "malformed mach-o: load commands size (32936) > 32768" -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 20 16:48:43 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 20 Oct 2017 16:48:43 -0000 Subject: [GHC] #14375: Implement with# primop In-Reply-To: <046.d97bc36423b0cbcf2ececb77831c1a4a@haskell.org> References: <046.d97bc36423b0cbcf2ececb77831c1a4a@haskell.org> Message-ID: <061.57dc1c150413fdd12cc3ed861c1ef95b@haskell.org> #14375: Implement with# primop -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: | Keywords: JoinPoints Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #14346 | Differential Rev(s): ​Phab:D4110 Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonmar): But if we had {{{ join j s = e in maskAsyncExceptions# j s }}} How can we compile this? `maskAsyncExceptions#` entails pushing a stack frame, but jumping to the join point entails truncating the stack back to the `join`. We can't do both! Am I missing something? I suggest that we treat `with#` in the same way as `runST` for the purposes of fixing the current bug. I think it'll be simpler to do it this way than what we have in Phab:D4110, because we don't need any support in the RTS at all. I agree it would be nicer to find a unified way of handing all these primops that take IO continuations, and especially it'd be great to avoid the allocation for `catch#`. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 20 21:39:43 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 20 Oct 2017 21:39: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.7581bb168463aa6beb3b7fd1f64bd1c9@haskell.org> #14331: Overzealous free-floating kind check causes deriving clause to be rejected -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: merge Priority: normal | Milestone: 8.2.2 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): But we can only get `ty` after dropping `n` arguments. Relating this to the existing code in `deriveTyData`, what I've called `ki2` is `cls_arg_kind` and what I've called `n` is `n_args_to_drop`. `n_args_to_drop` is computed by counting the number of args spun off by a call to `splitFunTys cls_arg_kind`. For a unification variable `kappa`, `splitFunTys` will return no arguments -- just like it would when `cls_arg_kind` is `Type`. So GHC currently behaves like my algorithm; I just have more checks here. However, calling `splitFunTys` on a unification variable is bogus, because that variable could potentially stand for anything, including a function. This bogus use happens to work out, but that's more luck than science in this case, I think. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Oct 21 00:02:53 2017 From: ghc-devs at haskell.org (GHC) Date: Sat, 21 Oct 2017 00:02:53 -0000 Subject: [GHC] #13112: Windows 64-bit GHC HEAD segfaults on the code with a lot of TH stuff. In-Reply-To: <044.8846313dfa837f257582237983583132@haskell.org> References: <044.8846313dfa837f257582237983583132@haskell.org> Message-ID: <059.d979534a4ef78f161db43f4a20caa150@haskell.org> #13112: Windows 64-bit GHC HEAD segfaults on the code with a lot of TH stuff. ---------------------------------+-------------------------------------- Reporter: awson | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.1 Resolution: | Keywords: Operating System: Windows | Architecture: x86_64 (amd64) Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | ---------------------------------+-------------------------------------- Comment (by RyanGlScott): jbetz, which code are you referring to? This is the code snippet at the top of https://github.com/tomjaguarpaw/haskell-opaleye/issues/338 at the time of writing: {{{#!hs module Main where import Data.Int import Data.Profunctor.Product (p1) import Database.PostgreSQL.Simple (Connection, connect, connectDatabase, connectPassword, defaultConnectInfo) import Opaleye (Column, PGText, Query, Table (Table), queryTable, required, runInsertMany, runQuery) import qualified Opaleye.PGTypes as P main :: IO () main = do connection <- connect $ defaultConnectInfo { connectDatabase = "postgres", connectPassword = "changeme"} r1 <- doTestInsertQuery connection print r1 r2 <- doTestSelectQuery connection print r2 doTestInsertQuery :: Connection -> IO Int64 doTestInsertQuery connection = runInsertMany connection testTable [P.pgString "ok"] doTestSelectQuery :: Connection -> IO [String] doTestSelectQuery connection = runQuery connection testQuery testQuery :: Query (Column PGText) testQuery = queryTable testTable testTable :: Table (Column PGText) (Column PGText) testTable = Table "test" (p1 (required "message")) }}} But compiling this with GHC 8.2.1 on my 64-bit Windows machine seems to work! {{{ $ ghc -fforce-recomp Bug.hs [1 of 1] Compiling Main ( Bug.hs, Bug.o ) Linking Bug.exe ... $ ./Bug.exe Bug.exe: SqlError {sqlState = "", sqlExecStatus = FatalError, sqlErrorMsg = "could not connect to server: Connection refused (0x0000274D/10061)\n\tIs the server running on host \"127.0.0.1\" and accepting\n\tTCP/IP connections on port 5432?\n", sqlErrorDetail = "", sqlErrorHint = ""} }}} The same thing happens if I compile with `-O2`. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Oct 21 09:40:36 2017 From: ghc-devs at haskell.org (GHC) Date: Sat, 21 Oct 2017 09:40:36 -0000 Subject: [GHC] #14376: Testsuite contains "ddump-cps-cmm" Message-ID: <048.250067081cc87f448de0d42b76e1cc6e@haskell.org> #14376: Testsuite contains "ddump-cps-cmm" -------------------------------------+------------------------------------- Reporter: heisenbug | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- Low hanging: change those to "ddump-cmm-cps". Run test suite. Implement warning for non-recognised dump flags. -------- IRC ---------- heisenbug: git grep ddump-cps-cmm | grep -v /tests/ [11:26am] heisenbug: ^^^^ is empty [11:27am] heisenbug: git grep ddump-cmm-cps [11:27am] heisenbug: ^^^^ correct spelling [11:27am] slyfox: should be fixed [11:28am] heisenbug: should I update the tests? [11:28am] slyfox: i'd say yes. do they run and fail? [11:29am] heisenbug: I just found it, cannot say [11:29am] heisenbug: I am researching… [11:30am] heisenbug: strange that the wrong -ddump flags are not rejected… [11:30am] slyfox: 'git log -p -Scps-cmm' shows the flag was renamed in f6f881f09c1ac69be2ae1850cb3067459f623360 [11:31am] heisenbug: but not the tests ? [11:31am] slyfox: maybe they should emit at least a warning. that way tests would fails with stderr rejection [11:31am] slyfox: not the tests [11:31am] heisenbug: absolutely -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Oct 21 10:14:33 2017 From: ghc-devs at haskell.org (GHC) Date: Sat, 21 Oct 2017 10:14:33 -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.8bedf214cfffc4205ffd7a2def69aeec@haskell.org> #14373: Introduce PTR-tagging for big constructor families -------------------------------------+------------------------------------- Reporter: heisenbug | Owner: (none) 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): Wiki Page: | -------------------------------------+------------------------------------- Comment (by heisenbug): `-fcmm-elim-common-blocks` helps a bit, but many equal ones are not caught: These hash the same {{{ hash_block c3dj 170 hash_block c3dp 170 hash_block c3dv 170 hash_block c3dB 170 }}} but are not commoned: {{{ ==================== Post switch plan ==================== {offset c3dj: // global R1 = R1 + 7; call (P64[(old + 8)])(R1) args: 8, res: 0, upd: 8; } ==================== Post switch plan ==================== {offset c3dp: // global R1 = R1 + 7; call (P64[(old + 8)])(R1) args: 8, res: 0, upd: 8; } ==================== Post switch plan ==================== {offset c3dv: // global R1 = R1 + 7; call (P64[(old + 8)])(R1) args: 8, res: 0, upd: 8; } ==================== Post switch plan ==================== {offset c3dB: // global R1 = R1 + 7; call (P64[(old + 8)])(R1) args: 8, res: 0, upd: 8; } }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Oct 21 10:21:14 2017 From: ghc-devs at haskell.org (GHC) Date: Sat, 21 Oct 2017 10:21:14 -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.9a69eb5dc1fe4ac40d91d5e9158d0a66@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 heisenbug): `-fcmm-elim-common-blocks` helps a bit, but many equal ones are not caught: These hash the same {{{ hash_block c3dj 170 hash_block c3dp 170 hash_block c3dv 170 hash_block c3dB 170 }}} but are not commoned: {{{ ==================== Post switch plan ==================== {offset c3dj: // global R1 = R1 + 7; call (P64[(old + 8)])(R1) args: 8, res: 0, upd: 8; } ==================== Post switch plan ==================== {offset c3dp: // global R1 = R1 + 7; call (P64[(old + 8)])(R1) args: 8, res: 0, upd: 8; } ==================== Post switch plan ==================== {offset c3dv: // global R1 = R1 + 7; call (P64[(old + 8)])(R1) args: 8, res: 0, upd: 8; } ==================== Post switch plan ==================== {offset c3dB: // global R1 = R1 + 7; call (P64[(old + 8)])(R1) args: 8, res: 0, upd: 8; } }}} Maybe the reason is the "result register" updates are not considered in `CmmCommonBlockElim.hs`. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Oct 21 14:08:46 2017 From: ghc-devs at haskell.org (GHC) Date: Sat, 21 Oct 2017 14:08:46 -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.b96f58daf992012edb76c964d8706d51@haskell.org> #14331: Overzealous free-floating kind check causes deriving clause to be rejected -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: merge Priority: normal | Milestone: 8.2.2 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): Alright, that sounds reasonable enough. After thinking about this some more, though, I realized that there's another incongruity with your proposal and how `TcDeriv` currently operates. In particular, there can be //more// unification after part (i) if you are deriving `Functor`, `Foldable`, or `Traversable`. Here is an example of such a situation (taken from Trac #10561): {{{#!hs newtype Compose (f :: k2 -> Type) (g :: k1 -> k2) (x :: k1) = Compose (f (g a)) deriving stock Functor }}} In part (i), we would unify `Type -> Type` (the kind of the argument to `Functor`) with `k1 -> Type` (the kind of `Compose f g`, giving us: {{{#!hs instance forall {k2 (f :: k2 -> Type) (g :: Type -> k2)}. (Functor f, Functor g) => Functor (Compose f g) }}} But note that this won't kind-check yet, since the kinds of `f` and `g` are still too general. This is where [http://git.haskell.org/ghc.git/blob/e375bd350bc9e719b757f4dc8c907c330b26ef6e:/compiler/typecheck/TcDerivInfer.hs#l179 this code] in `TcDerivInfer` kicks in: it takes every type on the RHS of the datatype that accepts one argument (in the example above, that would be `f` and `g`), unifies their kinds with `Type -> Type`, and applies the resulting substitution to the type variables. In the example above, this substitution would be `[k2 |-> Type]`, so applying that would yield the instance: {{{#!hs instance forall {(f :: Type -> Type) (g :: Type -> Type)}. (Functor f, Functor g) => Functor (Compose f g) }}} And now it kind-checks, so we can feed the instance context into the simplifier (part (k)). My question is: where does this extra unification for deriving `Functor`, `Foldable`, or `Traversable` fall into your algorithm? In part (j) you write `instance forall {bs sks as}. ... => drv ty`, which seems to suggest that the type variables shouldn't be unified any more after that step, but that's not true in this particular example. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Oct 21 16:03:23 2017 From: ghc-devs at haskell.org (GHC) Date: Sat, 21 Oct 2017 16:03:23 -0000 Subject: [GHC] #14377: false result in the addition Message-ID: <044.b2ada1f8b8e39ba20773f6a6e815abcd@haskell.org> #14377: false result in the addition -------------------------------------+------------------------------------- Reporter: vanto | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: Incorrect result Unknown/Multiple | at runtime Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- {{{ Prelude> 1.1+2.2 3.3000000000000003 Prelude> 1.11+2.22 3.33 Prelude> 1.111+2.222 3.333 Prelude> 1.1111+2.2222 3.3333 Prelude> 1.11111+2.22222 3.33333 Prelude> 1.111111+2.222222 3.3333329999999997 Prelude> 1.1111111+2.2222222 3.3333333 Prelude> 1.11111111+2.22222222 3.33333333 Prelude> 1.111111111+2.222222222 3.333333333 Prelude> 1.1111111111+2.2222222222 3.3333333333 Prelude> 1.11111111111+2.22222222222 3.33333333333 Prelude> 1.111111111111+2.222222222222 3.333333333333 Prelude> 1.1111111111111+2.2222222222222 3.3333333333333 Prelude> 1.11111111111111+2.22222222222222 3.3333333333333304 Prelude> 1.111111111111111+2.222222222222222 3.333333333333333 }}} Given the other additions, three results can be improved. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Oct 21 16:12:19 2017 From: ghc-devs at haskell.org (GHC) Date: Sat, 21 Oct 2017 16:12:19 -0000 Subject: [GHC] #14377: false result in the addition In-Reply-To: <044.b2ada1f8b8e39ba20773f6a6e815abcd@haskell.org> References: <044.b2ada1f8b8e39ba20773f6a6e815abcd@haskell.org> Message-ID: <059.9a344e2c5dfee8f9e67f6a69a716e9bf@haskell.org> #14377: false result in the addition -------------------------------------+------------------------------------- Reporter: vanto | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: invalid | 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 nickkuk): * status: new => closed * resolution: => invalid Comment: Please, use Rational instead of float arithmetics: {{{ Prelude> fromRational (1.1 + 2.2) 3.3 Prelude> fromRational (1.111111+2.222222) 3.333333 Prelude> fromRational (1.11111111111111+2.22222222222222) 3.33333333333333 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Oct 21 18:02:25 2017 From: ghc-devs at haskell.org (GHC) Date: Sat, 21 Oct 2017 18:02:25 -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.7b84b494727f87ef40a659c042e50494@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 heisenbug): Replying to [comment:7 heisenbug]: > `-fcmm-elim-common-blocks` helps a bit, but many equal ones are not caught: > Turns out c-b-e is a local optimisation, i.e. per procedure. We need a global one to crack this. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Oct 21 18:46:19 2017 From: ghc-devs at haskell.org (GHC) Date: Sat, 21 Oct 2017 18:46:19 -0000 Subject: [GHC] #14378: Unreasonably high memory use when compiling with profiling and -O2/-O2 Message-ID: <047.a8b592bdf4c4944a022c676f27e79424@haskell.org> #14378: Unreasonably high memory use when compiling with profiling and -O2/-O2 -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 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: -------------------------------------+------------------------------------- Based on [https://github.com/Daniel-Diaz/matrix/issues/43] I tried that myself. * Without profiling: <10 sec, <110M Residency * Profiling and -O: 90sec, 1.5GB Residency * Profiling and -O2: Killed it after 4 Minutes and it started swapping on a 16GB Ram machine. The invocation was: ghc Matrix.hs -prof -fprof-auto -c -fforce-recomp -O -v -fprof-auto-exported -caf-all -auto-all -fstatic-argument- transformation Numbers above from 8.0.2. 8.2.1 improved to slightly worse than -O1 with ~95 sec and ~2.5GB ram usage. Still seems like a bug though. I haven't tried HEAD yet. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Oct 21 18:50:52 2017 From: ghc-devs at haskell.org (GHC) Date: Sat, 21 Oct 2017 18:50:52 -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.bab665c394efa70e3810d9fb26887d17@haskell.org> #14378: Unreasonably high memory use when compiling with profiling and -O2/-O2 -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.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: | -------------------------------------+------------------------------------- Description changed by AndreasK: Old description: > Based on [https://github.com/Daniel-Diaz/matrix/issues/43] I tried that > myself. > > * Without profiling: <10 sec, <110M Residency > * Profiling and -O: 90sec, 1.5GB Residency > * Profiling and -O2: Killed it after 4 Minutes and it started swapping on > a 16GB Ram machine. > > The invocation was: ghc Matrix.hs -prof -fprof-auto -c -fforce-recomp -O > -v -fprof-auto-exported -caf-all -auto-all -fstatic-argument- > transformation > > Numbers above from 8.0.2. > > 8.2.1 improved to slightly worse than -O1 with ~95 sec and ~2.5GB ram > usage. Still seems like a bug though. > > I haven't tried HEAD yet. New description: Based on [https://github.com/Daniel-Diaz/matrix/issues/43] I tried that myself. * Without profiling: <10 sec, <110M Residency * Profiling and -O: 90sec, 1.5GB Residency * Profiling and -O2: Killed it after 4 Minutes and it started swapping on a 16GB Ram machine. The invocation was: ghc Matrix.hs -prof -fprof-auto -c -fforce-recomp -O -v -fprof-auto-exported -caf-all -auto-all -fstatic-argument- transformation Numbers above from 8.0.2. Edit: I messed up the meassurement somehow. 8.2.1 improved to -O1 with ~70 sec and shy of 1GB ram usage. Not sure if that would still be considered a bug. -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Oct 21 18:52:08 2017 From: ghc-devs at haskell.org (GHC) Date: Sat, 21 Oct 2017 18:52:08 -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.6c9fcf674b2d67a2d065428715e9a4f3@haskell.org> #14378: Unreasonably high memory use when compiling with profiling and -O2/-O2 -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.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: | -------------------------------------+------------------------------------- Description changed by AndreasK: Old description: > Based on [https://github.com/Daniel-Diaz/matrix/issues/43] I tried that > myself. > > * Without profiling: <10 sec, <110M Residency > * Profiling and -O: 90sec, 1.5GB Residency > * Profiling and -O2: Killed it after 4 Minutes and it started swapping on > a 16GB Ram machine. > > The invocation was: ghc Matrix.hs -prof -fprof-auto -c -fforce-recomp -O > -v -fprof-auto-exported -caf-all -auto-all -fstatic-argument- > transformation > > Numbers above from 8.0.2. > > Edit: I messed up the meassurement somehow. > 8.2.1 improved to -O1 with ~70 sec and shy of 1GB ram usage. Not sure if > that would still be considered a bug. New description: Based on [https://github.com/Daniel-Diaz/matrix/issues/43] I tried that myself. * Without profiling: <10 sec, <110M Residency * Profiling and -O: 90sec, 1.5GB Residency * Profiling and -O2: Killed it after 4 Minutes and it started swapping on a 16GB Ram machine. The invocation was: ghc Matrix.hs -prof -fprof-auto -c -fforce-recomp -O -v -fprof-auto-exported -caf-all -auto-all -fstatic-argument- transformation Numbers above from 8.0.2. Edit: I messed up the meassurement somehow. 8.2.1 improved to ~70 sec and shy of 1GB ram usage. Not sure if that would still be considered a bug. -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Oct 21 19:22:29 2017 From: ghc-devs at haskell.org (GHC) Date: Sat, 21 Oct 2017 19:22:29 -0000 Subject: [GHC] #14377: false result in the addition In-Reply-To: <044.b2ada1f8b8e39ba20773f6a6e815abcd@haskell.org> References: <044.b2ada1f8b8e39ba20773f6a6e815abcd@haskell.org> Message-ID: <059.51cb0889f9c3b3923bb6face7210a7ab@haskell.org> #14377: false result in the addition -------------------------------------+------------------------------------- Reporter: vanto | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 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 vanto): * status: closed => new * resolution: invalid => Comment: Replying to [[span(style=color: #FF0000, nickkuk )]]:\\ Thank you. {{{ Prelude> :t 1.1+2.2 1.1+2.2 :: Fractional a => a }}} I know the failures with real numbers in calculations on computers. OK, but overall we could be sure of the result by decreasing the number of decimal places in real number, for example. should we use your method with all real numbers? I think not at all. example:\\ {{{ Prelude> 2.71828182846**3.14159265359 23.14069263280959 }}} it's a good result.\\ Another example:\\ {{{ Prelude> fromRational(2.71828182846**3.14159265359) :18:14: error: * Could not deduce (Floating Rational) arising from a use of `**' from the context: Fractional a bound by the inferred type of it :: Fractional a => a at :18:1-42 * In the first argument of `fromRational', namely `(2.71828182846 ** 3.14159265359)' In the expression: fromRational (2.71828182846 ** 3.14159265359) In an equation for `it': it = fromRational (2.71828182846 ** 3.14159265359) }}} I am not convinced by your answer. it works in a specific example but not in a general way. I think we could do better. I am doubtful, I reopen this ticket to have other opinions.\\ look at the difference with Hugs (Haskell 98 Compatability):\\ {{{ Hugs> 1.1+2.2 3.3 :: Double (32 reductions, 75 cells) Hugs> 1.111111+2.222222 3.333333 :: Double (27 reductions, 41 cells) Hugs> 1.11111111111111+2.22222222222222 3.33333333333333 :: Double (27 reductions, 49 cells) Hugs> :t 1.1+2.2 1.1 + 2.2 :: Double }}} Hugs calculates a lot better. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Oct 22 00:19:57 2017 From: ghc-devs at haskell.org (GHC) Date: Sun, 22 Oct 2017 00:19:57 -0000 Subject: [GHC] #14379: GHC 2.8.1 Consumes All Memory On Build Message-ID: <047.3a29f02e3bbd9a0f2379ab1644f26326@haskell.org> #14379: GHC 2.8.1 Consumes All Memory On Build -------------------------------------+------------------------------------- Reporter: jm4games | Owner: (none) Type: bug | Status: new Priority: high | Milestone: Component: Compiler | Version: 8.2.1 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 code will cause GHC to consume all memory/swap and eventually crash. {{{ #!div style="font-size: 80%" Code highlighting: {{{#!haskell module Test.Test where import Data.Text (Text) import Data.Monoid ((<>)) import Data.Vector as V import TextShow (showt) compileTest :: V.Vector (Text, V.Vector (Int, V.Vector a)) -> V.Vector (Text, V.Vector (Int, V.Vector a)) -> Either Text () compileTest vecA vecB = V.ifoldl' validateSym (Right ()) vecB where validateSym :: Either Text () -> Int -> (Text, V.Vector (Int, V.Vector a)) -> Either Text () validateSym res iSym (sym, freqs) | Just sym == (fst <$> (vecA V.!? iSym)) = V.ifoldl' validateFreq res freqs | otherwise = Left $ if iSym < V.length vecA then "Seed data" <> " not found at index [" <> showt iSym <> "]." else "No " <> sym <> " at index " <> showt iSym <> "." where validateFreq :: Either Text () -> Int -> (Int, V.Vector a) -> Either Text () validateFreq res2 iFreq (freq, _) | freq == fst (snd (vecA V.! iSym) V.! iFreq) = res2 | otherwise = Left $ "Seed data " <> (fst (vecA V.! iSym)) <> " at frequency " <> showt (fst (snd (vecA V.! iSym) V.! iFreq)) <> " not found at index [" <> showt iSym <> "][" <> showt iFreq -- <> "]." }}} }}} NOTE: The snippet is large (and messy) because there seems to be an exact sequence of evaluation to causing the out of memory. For example if you comment out line 26 (<> showt iFreq) it will allow the code to compile. Like wise if I comment out all of line 25 it will compile. I can't seem to figure out what exact combination of things causes the issue. Cabal file (used with stack 1.5.1, resolver: nightly-2017-10-21). {{{ #!div style="font-size: 80%" Code highlighting: {{{#!text name: some-test version: 0.2.1.0 build-type: Simple cabal-version: >= 1.10 library default-language: Haskell2010 ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -fno-warn- unused-do-bind -O2 ghc-prof-options: -fprof-auto exposed-modules: Test.Test build-depends: base >= 4.9 && < 4.11, text >= 1.2, text-show >= 3.4 && < 3.7, vector >= 0.10 && < 0.13 default-extensions: OverloadedStrings }}} }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Oct 22 00:25:42 2017 From: ghc-devs at haskell.org (GHC) Date: Sun, 22 Oct 2017 00:25:42 -0000 Subject: [GHC] #14380: Compile error for PatternSynonyms together with OverloadedLists Message-ID: <045.c5aedfba2a7a6300bf201d20c6b5bb6e@haskell.org> #14380: Compile error for PatternSynonyms together with OverloadedLists -------------------------------------+------------------------------------- Reporter: lehins | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.3 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 OverloadedLists #-} {-# LANGUAGE PatternSynonyms #-} data Foo = Foo [Int] pattern Bar :: Foo pattern Bar = Foo [] }}} This code results in a cryptic compilation error: {{{ $ ghc main.hs [1 of 1] Compiling Main ( main.hs, main.o ) main.hs:7:19: error: • Couldn't match expected type ‘[a0] -> [Int]’ with actual type ‘[GHC.Exts.Item Int]’ • This rebindable syntax expects a function with two arguments, but its type ‘Int -> [GHC.Exts.Item Int]’ has only one In the first argument of ‘Foo’, namely ‘[]’ In the expression: Foo [] | 7 | pattern Bar = Foo [] | ^^ }}} As soon as `OverloadedLists` is removed, this error goes away. In itself the problem isn't too critical, but very unexpected. I got above error with GHC 8.0 and 8.2, so decided to check it with current version as well: {{{ $ ghc --version The Glorious Glasgow Haskell Compilation System, version 8.3.20171020 }}} Looking a bit more into `PatternSynonyms` extension I was able to work around this by declaring an explicit bidirectional pattern, which, surprisingly, solved the problem: {{{#!hs pattern Bar :: Foo pattern Bar <- Foo [] where Bar = Foo [] }}} If fixing this issue is too much trouble than it is worth, than at least a mention about it in documentation will be helpful. Out of curiosity I also tried it with `String`, which did not trigger this error and compiled just fine: {{{#!hs {-# LANGUAGE OverloadedLists #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternSynonyms #-} data Foo = Foo [Char] pattern Bar :: Foo pattern Bar = Foo "" }}} PS. Even if this issue is closed, searching the internet for the error message will now at least return some info. :) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Oct 22 03:25:05 2017 From: ghc-devs at haskell.org (GHC) Date: Sun, 22 Oct 2017 03:25:05 -0000 Subject: =?utf-8?b?UmU6IFtHSENdICM4NjExOiBub2ZpYuKAmXMgY2FjaGVwcm9m4oCZ?= =?utf-8?q?s_allocations_nondeterminisitic?= In-Reply-To: <046.9452bfe64045e297fcab99166dcd73b9@haskell.org> References: <046.9452bfe64045e297fcab99166dcd73b9@haskell.org> Message-ID: <061.37bb88c743da6eccb5e00f32d3b6caf2@haskell.org> #8611: nofib’s cacheprof’s allocations nondeterminisitic ------------------------------------------+-------------------------------- Reporter: nomeata | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: NoFib benchmark suite | Version: 7.6.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | ------------------------------------------+-------------------------------- Comment (by Joachim Breitner ): In [changeset:"c24195479551800e1e3f45b1d977f04a546889d3/nofib" c241954/nofib]: {{{ #!CommitTicketReference repository="nofib" revision="c24195479551800e1e3f45b1d977f04a546889d3" Notes: Link to #8611 (cacheprof nondeterministic) }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Oct 22 03:36:57 2017 From: ghc-devs at haskell.org (GHC) Date: Sun, 22 Oct 2017 03:36:57 -0000 Subject: [GHC] #11251: isInstance does not work on Typeable with base-4.8 anymore In-Reply-To: <045.6032ac627aa889ca8ac6f2a84e970c9c@haskell.org> References: <045.6032ac627aa889ca8ac6f2a84e970c9c@haskell.org> Message-ID: <060.d9a335203ab5ab8e62655876e1655c9b@haskell.org> #11251: isInstance does not work on Typeable with base-4.8 anymore -------------------------------------+------------------------------------- Reporter: songzh | Owner: goldfire Type: bug | Status: new Priority: normal | Milestone: Component: Template Haskell | Version: 7.10.1 Resolution: | Keywords: Typeable, | isInstance 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 songzh): I also find it is allowed to derive `Typeable` class several times for one data type. I am no with GHC 8.2 {{{ {-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-} import Data.Typeable data TT = TT deriving instance Typeable TT -- allowed to derive twice. deriving instance Typeable TT deriving instance Show TT -- Not allowed to derive twice -- deriving instance Show TT }}} Should this be allowed? Or they are the same problem with this ticket. I speculate these are the same problem since GHC does not know `TT` is already an instance of `Typeable` or not after the first time of deriving. Do I need to open another ticket for this problem? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Oct 22 03:42:47 2017 From: ghc-devs at haskell.org (GHC) Date: Sun, 22 Oct 2017 03:42:47 -0000 Subject: [GHC] #11251: isInstance does not work on Typeable with base-4.8 anymore In-Reply-To: <045.6032ac627aa889ca8ac6f2a84e970c9c@haskell.org> References: <045.6032ac627aa889ca8ac6f2a84e970c9c@haskell.org> Message-ID: <060.f56664bb0032fe18faf6da5af9d4ce91@haskell.org> #11251: isInstance does not work on Typeable with base-4.8 anymore -------------------------------------+------------------------------------- Reporter: songzh | Owner: goldfire Type: bug | Status: new Priority: normal | Milestone: Component: Template Haskell | Version: 7.10.1 Resolution: | Keywords: Typeable, | isInstance 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 songzh): Replying to [comment:2 goldfire]: > Will fix. Thanks! I want to see what is actually the problems is in `template-haskell` package but I did not find any clue by following the definition of `isInstance`. Could you give me any clues on this problem in the source code of GHC? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Oct 22 05:30:28 2017 From: ghc-devs at haskell.org (GHC) Date: Sun, 22 Oct 2017 05:30:28 -0000 Subject: [GHC] #14381: Consider making ghc-pkg fill in abi-depends based on depends Message-ID: <045.a757b4d974e51bd6ab6f6869ba65de4c@haskell.org> #14381: Consider making ghc-pkg fill in abi-depends based on depends -------------------------------------+------------------------------------- Reporter: ezyang | Owner: (none) Type: bug | Status: new Priority: high | 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: -------------------------------------+------------------------------------- In GHC 8.2, we introduced `abi-depends` to solve #12485. Following the same pattern as all ghc-pkg fields, this field is to be fllled by whoever is performing the registration. I now suspect designing it this way was a mistake. In https://github.com/haskell/cabal/issues/4728 we have a bug where Cabal is writing nonsense data for `abi-depends`, `ghc-pkg` isn't noticing it, and GHC is rejecting the package (with a "shadow" warning) when it gets to the end. The problem is the Cabal aggressively caches the contents of the package database (ostensibly because it is expensive to query `ghc-pkg`); this means that it is easy to get into a situation where its understanding of the ABIs of its dependencies is out-of-date (because it is not re- reading the database in order to get newer information). The insult to the injury is, in most cases, ghc-pkg already knows what the ABIs are supposed to be: they're whatever the ABIs of the packages pointed at by 'depends' already in the database are. So ghc-pkg could have computed the abi dependency itself, and prevented this stale data situation from ever happening. This sounds quite attractive to me. What do people think? Here is one possible proposal (but it is just one in the space): * `ghc-pkg` will be modified to ignore the `abi-depends` field (perhaps with a warning), to prevent itself from being poisoned by buggy versions of Cabal which are giving bad ABI information * Instead, `ghc-pkg` generates the `abi-depends` field by looking up dependency IDs from the database. If an ID is not found, it omits the dep from `abi-depends` (this is equivalent to suspending ABI checking in GHC, so this won't break anything; it will just make ABI checking less robust) * Possibly, introduce a new "virtual" field, which can be used to override `ghc-pkg` default -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Oct 22 08:56:29 2017 From: ghc-devs at haskell.org (GHC) Date: Sun, 22 Oct 2017 08:56:29 -0000 Subject: [GHC] #14168: Installing math-functions with GHC-8.2.1 on windows crashed In-Reply-To: <044.4f270678bb008a7a39539de06752d80f@haskell.org> References: <044.4f270678bb008a7a39539de06752d80f@haskell.org> Message-ID: <059.22dbbebe33b50731c8d35793e3c0b663@haskell.org> #14168: Installing math-functions with GHC-8.2.1 on windows crashed ---------------------------------+---------------------------------------- Reporter: Qinka | Owner: (none) Type: bug | Status: infoneeded Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 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: | ---------------------------------+---------------------------------------- Comment (by Phyx-): Hi @Qinka, are you still experiencing this problem? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Oct 22 09:28:05 2017 From: ghc-devs at haskell.org (GHC) Date: Sun, 22 Oct 2017 09:28:05 -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.6b9d5abfe7425616b064fd2b71b1d4ff@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 heisenbug): Replying to [comment:8 heisenbug]: > Replying to [comment:7 heisenbug]: > > `-fcmm-elim-common-blocks` helps a bit, but many equal ones are not caught: > > > > Turns out c-b-e is a local optimisation, i.e. per procedure. We need a global one to crack this. Okay I now have the beginnings of a global CMM C-B-E here: https://github.com/ggreif/ghc/tree/wip/global-cmm-cbe Feedback welcome! Some comments (for self) * better use `ST(Refs)` to not mess with GHC's `-j` mode (multi-module compilation) * `CmmProc`s should be transformed. Not yet done. Graph label to branch transformation is bogus, but keeping it as an example for now. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Oct 22 10:23:06 2017 From: ghc-devs at haskell.org (GHC) Date: Sun, 22 Oct 2017 10:23:06 -0000 Subject: [GHC] #14382: The 'impossible' happened whilst installing gi-gtk via cabal Message-ID: <052.f9c10851d0906622baeb7996269cc8e7@haskell.org> #14382: The 'impossible' happened whilst installing gi-gtk via cabal --------------------------------------+--------------------------------- Reporter: maartenjacobs | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Keywords: gtk, pango | 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've been trying to install gi-gtk using "cabal install gi-gtk". In the process I upgraded to the most recent stable GHC and cabal. I've also installed gtk3 libraries which I thought were necessary. {{{ ... [91 of 95] Compiling GI.Pango.Objects.Layout ( GI/Pango/Objects/Layout.hs, dist/build/GI/Pango/Objects/Layout.o ) ghc: panic! (the 'impossible' happened) (GHC version 8.2.1 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 Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug Failed to install gi-pango-1.0.15 cabal: Error: some packages failed to install: gi-gdk-3.0.14-INozoUgbf2HFkX3VeIwKfl depends on gi-gdk-3.0.14 which failed to install. gi-gtk-3.0.17-1AObKz0Ppj5GXVupmEC7Yc depends on gi-gtk-3.0.17 which failed to install. gi-pango-1.0.15-E4HLwHGC2n62ObUIQeuwp8 failed during the building phase. The exception was: ExitFailure 1 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Oct 22 11:15:29 2017 From: ghc-devs at haskell.org (GHC) Date: Sun, 22 Oct 2017 11:15:29 -0000 Subject: [GHC] #14377: some results not expected with the addition (was: false result in the addition) In-Reply-To: <044.b2ada1f8b8e39ba20773f6a6e815abcd@haskell.org> References: <044.b2ada1f8b8e39ba20773f6a6e815abcd@haskell.org> Message-ID: <059.df1b8e2e1e957b578a3f5fbea7d16aef@haskell.org> #14377: some results not expected with the addition -------------------------------------+------------------------------------- Reporter: vanto | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 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 vanto): \\ \\\\ I changed the title that did not seem appropriate. The word "false" was not suitable for these results. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Oct 22 11:47:35 2017 From: ghc-devs at haskell.org (GHC) Date: Sun, 22 Oct 2017 11:47:35 -0000 Subject: [GHC] #14377: some results not expected with the addition In-Reply-To: <044.b2ada1f8b8e39ba20773f6a6e815abcd@haskell.org> References: <044.b2ada1f8b8e39ba20773f6a6e815abcd@haskell.org> Message-ID: <059.b80fb874cecb5149b6d1b91674166a9e@haskell.org> #14377: some results not expected with the addition -------------------------------------+------------------------------------- Reporter: vanto | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 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 vanto): I discovered that OCaml computes with the same errors. maybe a shared file?\\ {{{ $ ocaml OCaml version 4.04.0 # 1.1+.2.2;; - : float = 3.3000000000000003 # 1.11+.2.22;; - : float = 3.33 # 1.111+.2.222;; - : float = 3.333 # 1.1111+.2.2222;; - : float = 3.3333 # 1.11111+.2.22222;; - : float = 3.33333 # 1.111111+.2.222222;; - : float = 3.3333329999999997 # 1.1111111+.2.2222222;; - : float = 3.3333333 # 1.11111111+.2.22222222;; - : float = 3.33333333 # 1.111111111+.2.222222222;; - : float = 3.333333333 # 1.1111111111+.2.2222222222;; - : float = 3.3333333333 # 1.11111111111+.2.22222222222;; - : float = 3.33333333333 # 1.111111111111+.2.222222222222;; - : float = 3.333333333333 # 1.1111111111111+.2.2222222222222;; - : float = 3.3333333333333 # 1.11111111111111+.2.22222222222222;; - : float = 3.3333333333333304 # 1.111111111111111+.2.222222222222222;; - : float = 3.333333333333333 # }}} while the other interpreters all give an expected result.\\ {{{ T h e M i r a n d a S y s t e m version 2.041 last revised 15 August 2008 Copyright Research Software Ltd 1985-2008 World Wide Web: http://miranda.org.uk new file script.m for help type /h Miranda 1.1+2.2 3.3 Miranda 1.111111+2.222222 3.333333 Miranda 1.11111111111111+2.22222222222222 3.333333333333 Miranda }}} \\ {{{ Standard ML of New Jersey v110.81 [built: Thu May 04 14:21:06 2017] - 1.1+2.2; val it = 3.3 : real - 1.111111+2.222222; val it = 3.333333 : real - 1.11111111111111+2.22222222222222; val it = 3.33333333333 : real - }}} \\ {{{ > Caml Light version 0.74 #1.1+.2.2;; - : float = 3.3 #1.111111+.2.222222;; - : float = 3.333333 #1.11111111111111+.2.22222222222222;; - : float = 3.33333333333 # }}} You can read the difference between Caml Light and OCaml. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Oct 22 14:37:08 2017 From: ghc-devs at haskell.org (GHC) Date: Sun, 22 Oct 2017 14:37:08 -0000 Subject: [GHC] #4020: Please consider adding support for local type synonyms In-Reply-To: <041.4d1fc687182926effba30be48457cbb9@haskell.org> References: <041.4d1fc687182926effba30be48457cbb9@haskell.org> Message-ID: <056.7efba99407a34f205b84c566b9de34a8@haskell.org> #4020: Please consider adding support for local type synonyms -------------------------------------+------------------------------------- Reporter: nr | Owner: (none) Type: feature request | Status: new Priority: low | Milestone: Component: Compiler (Type | Version: 6.12.2 checker) | Resolution: | Keywords: type synonym 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 AntC): Replying to [ticket:4020 nr]: > I would really like to be able to put a type synonym in a where clause. Please explain why you couldn't declare the synonym at top level, as usual. Do you want the synonym to work wherever this module gets imported into? How will that go if it's nested? > > For an example use case, please see line 202 of the attachment. Please provide a more focussed example. Line 202 of 707. Do you really need 707 lines to explain the need? I suggest you make a proposal through the github process. (Or those who've recently added themselves to the ticket do.) Type synonyms are top level/global because all types and classes are. Otherwise type solving might be incoherent. -1 from me. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Oct 22 16:01:39 2017 From: ghc-devs at haskell.org (GHC) Date: Sun, 22 Oct 2017 16:01:39 -0000 Subject: [GHC] #14377: some results not expected with the addition In-Reply-To: <044.b2ada1f8b8e39ba20773f6a6e815abcd@haskell.org> References: <044.b2ada1f8b8e39ba20773f6a6e815abcd@haskell.org> Message-ID: <059.169c6d60e8512e131b17296f322e2105@haskell.org> #14377: some results not expected with the addition -------------------------------------+------------------------------------- Reporter: vanto | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 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 vanto): After making several calculations it seems to me that this is more a display error rather than a miscalculation (mathematical error). I think it could be repaired easily. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Oct 22 16:07:24 2017 From: ghc-devs at haskell.org (GHC) Date: Sun, 22 Oct 2017 16:07:24 -0000 Subject: [GHC] #14379: Regression - GHC 2.8.1 Consumes All Memory On Build (was: GHC 2.8.1 Consumes All Memory On Build) In-Reply-To: <047.3a29f02e3bbd9a0f2379ab1644f26326@haskell.org> References: <047.3a29f02e3bbd9a0f2379ab1644f26326@haskell.org> Message-ID: <062.90d663e5017e0be026b4b473ced88407@haskell.org> #14379: Regression - GHC 2.8.1 Consumes All Memory On Build -------------------------------------+------------------------------------- Reporter: jm4games | Owner: (none) Type: bug | Status: new Priority: high | Milestone: 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): 8.0.2 Wiki Page: | -------------------------------------+------------------------------------- Changes (by jm4games): * differential: => 8.0.2 Old description: > The following code will cause GHC to consume all memory/swap and > eventually crash. > > {{{ > #!div style="font-size: 80%" > Code highlighting: > {{{#!haskell > module Test.Test where > > import Data.Text (Text) > > import Data.Monoid ((<>)) > import Data.Vector as V > import TextShow (showt) > > compileTest :: V.Vector (Text, V.Vector (Int, V.Vector a)) -> V.Vector > (Text, V.Vector (Int, V.Vector a)) -> Either Text () > compileTest vecA vecB = V.ifoldl' validateSym (Right ()) vecB > where > validateSym :: Either Text () -> Int -> (Text, V.Vector (Int, > V.Vector a)) -> Either Text () > validateSym res iSym (sym, freqs) > | Just sym == (fst <$> (vecA V.!? iSym)) = V.ifoldl' validateFreq > res freqs > | otherwise = Left $ > if iSym < V.length vecA then > "Seed data" <> " not found at index [" <> showt iSym <> > "]." > else "No " <> sym <> " at index " <> showt iSym <> "." > where > validateFreq :: Either Text () -> Int -> (Int, V.Vector a) -> > Either Text () > validateFreq res2 iFreq (freq, _) > | freq == fst (snd (vecA V.! iSym) V.! iFreq) = res2 > | otherwise = Left $ > "Seed data " <> (fst (vecA V.! iSym)) <> > " at frequency " <> showt (fst (snd (vecA V.! iSym) V.! > iFreq)) <> > " not found at index [" <> showt iSym <> "][" <> showt > iFreq -- <> "]." > }}} > }}} > > NOTE: The snippet is large (and messy) because there seems to be an exact > sequence of evaluation to causing the out of memory. For example if you > comment out line 26 (<> showt iFreq) it will allow the code to compile. > Like wise if I comment out all of line 25 it will compile. I can't seem > to figure out what exact combination of things causes the issue. > > Cabal file (used with stack 1.5.1, resolver: nightly-2017-10-21). > {{{ > #!div style="font-size: 80%" > Code highlighting: > {{{#!text > name: some-test > version: 0.2.1.0 > build-type: Simple > cabal-version: >= 1.10 > > library > default-language: Haskell2010 > ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -fno-warn- > unused-do-bind -O2 > ghc-prof-options: -fprof-auto > > exposed-modules: > Test.Test > > build-depends: > base >= 4.9 && < 4.11, > text >= 1.2, > text-show >= 3.4 && < 3.7, > vector >= 0.10 && < 0.13 > > default-extensions: > OverloadedStrings > }}} > }}} New description: The following code will cause GHC to consume all memory/swap and eventually crash (a regression from 8.0.2). {{{ #!div style="font-size: 80%" Code highlighting: {{{#!haskell module Test.Test where import Data.Text (Text) import Data.Monoid ((<>)) import Data.Vector as V import TextShow (showt) compileTest :: V.Vector (Text, V.Vector (Int, V.Vector a)) -> V.Vector (Text, V.Vector (Int, V.Vector a)) -> Either Text () compileTest vecA vecB = V.ifoldl' validateSym (Right ()) vecB where validateSym :: Either Text () -> Int -> (Text, V.Vector (Int, V.Vector a)) -> Either Text () validateSym res iSym (sym, freqs) | Just sym == (fst <$> (vecA V.!? iSym)) = V.ifoldl' validateFreq res freqs | otherwise = Left $ if iSym < V.length vecA then "Seed data" <> " not found at index [" <> showt iSym <> "]." else "No " <> sym <> " at index " <> showt iSym <> "." where validateFreq :: Either Text () -> Int -> (Int, V.Vector a) -> Either Text () validateFreq res2 iFreq (freq, _) | freq == fst (snd (vecA V.! iSym) V.! iFreq) = res2 | otherwise = Left $ "Seed data " <> (fst (vecA V.! iSym)) <> " at frequency " <> showt (fst (snd (vecA V.! iSym) V.! iFreq)) <> " not found at index [" <> showt iSym <> "][" <> showt iFreq -- <> "]." }}} }}} NOTE: The snippet is large (and messy) because there seems to be an exact sequence of evaluation to causing the out of memory. For example if you comment out line 26 (<> showt iFreq) it will allow the code to compile. Like wise if I comment out all of line 25 it will compile. I can't seem to figure out what exact combination of things causes the issue. Cabal file (used with stack 1.5.1, resolver: nightly-2017-10-21). {{{ #!div style="font-size: 80%" Code highlighting: {{{#!text name: some-test version: 0.2.1.0 build-type: Simple cabal-version: >= 1.10 library default-language: Haskell2010 ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -fno-warn- unused-do-bind -O2 ghc-prof-options: -fprof-auto exposed-modules: Test.Test build-depends: base >= 4.9 && < 4.11, text >= 1.2, text-show >= 3.4 && < 3.7, vector >= 0.10 && < 0.13 default-extensions: OverloadedStrings }}} }}} -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Oct 22 16:55:01 2017 From: ghc-devs at haskell.org (GHC) Date: Sun, 22 Oct 2017 16:55:01 -0000 Subject: [GHC] #4020: Please consider adding support for local type synonyms In-Reply-To: <041.4d1fc687182926effba30be48457cbb9@haskell.org> References: <041.4d1fc687182926effba30be48457cbb9@haskell.org> Message-ID: <056.476b0191acef1f337d18264701382d02@haskell.org> #4020: Please consider adding support for local type synonyms -------------------------------------+------------------------------------- Reporter: nr | Owner: (none) Type: feature request | Status: new Priority: low | Milestone: Component: Compiler (Type | Version: 6.12.2 checker) | Resolution: | Keywords: type synonym 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): Allowing local data declarations would be more useful (local pattern synonyms even more so) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Oct 22 18:47:07 2017 From: ghc-devs at haskell.org (GHC) Date: Sun, 22 Oct 2017 18:47:07 -0000 Subject: [GHC] #14377: some results not expected with the addition In-Reply-To: <044.b2ada1f8b8e39ba20773f6a6e815abcd@haskell.org> References: <044.b2ada1f8b8e39ba20773f6a6e815abcd@haskell.org> Message-ID: <059.ccd558fb0c9c4b8eaca14854f82bd77f@haskell.org> #14377: some results not expected with the addition -------------------------------------+------------------------------------- Reporter: vanto | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 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 svenpanne): A tiny bit of googling would have showed that the problem is not easy at all, see e.g. the 2nd part of https://cs.stackexchange.com/a/81039 or the 2nd volume of Knuth's TAOCP (Radix Conversions). Apart from the fact that numeric algorithms are notoriously hard, there are tradeoffs here, e.g. speed vs. "minimality" of the resulting string. Different implementations just choose different points in the design space, so GHC's behavior is not a bug at all and I propose to close this ticket. Remember: If there was a single, universally "right" way to convert binary floats to a decimal string, people probably wouldn't write papers/blogs/etc. about it for several decades... -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Oct 22 20:05:26 2017 From: ghc-devs at haskell.org (GHC) Date: Sun, 22 Oct 2017 20:05:26 -0000 Subject: [GHC] #14377: some results not expected with the addition In-Reply-To: <044.b2ada1f8b8e39ba20773f6a6e815abcd@haskell.org> References: <044.b2ada1f8b8e39ba20773f6a6e815abcd@haskell.org> Message-ID: <059.25e38edfa9d1eed23696448a20854097@haskell.org> #14377: some results not expected with the addition -------------------------------------+------------------------------------- Reporter: vanto | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 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 vanto): It has nothing to do with what you say otherwise why other languages give correct results and not GHC? Maybe there is something in common between OCaml and GHC. And that produces this error. We need to find.\\ This problem, you says, began to manifest itself from the 1950s, and we still talk about it. In the past we managed to get results as we wanted.\\ So two things: - the way followed by GHC (in computation) is not the right one.\\ or\\ - there is a breakdown somewhere. and as you can see, the other systems stand out from GHC. if it is the fault of the base on which GHC is built then it is necessary to change the base.\\ look again at this result, do you think it is reasonable? while the other languages write a good result that is consistent with our expectations? These results are repetitive, so why always the same poorly written results?\\ {{{ Prelude> 16.0/0.2 80.0 Prelude> 16.0/0.02 800.0 Prelude> 16.0/0.002 8000.0 Prelude> 16.0/0.0002 80000.0 Prelude> 16.0/0.00002 799999.9999999999 Prelude> 16.0/0.000002 8000000.0 Prelude> 16.0/0.0000002 8.0e7 Prelude> 16.0/0.00000002 8.0e8 Prelude> 16.0/0.000000002 7.999999999999999e9 Prelude> 16.0/0.0000000002 8.0e10 Prelude> 16.0/0.00000000002 8.0e11 Prelude> 16.0/0.000000000002 8.0e12 Prelude> 16.0/0.0000000000002 8.0e13 Prelude> 16.0/0.00000000000002 8.0e14 Prelude> 16.0/0.000000000000002 7.999999999999999e15 Prelude> 16.0/0.0000000000000002 8.0e16 Prelude> 16.0/0.00000000000000002 8.0e17 Prelude> 16.0/0.000000000000000002 7.999999999999999e18 Prelude> 16.0/0.0000000000000000002 8.0e19 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Oct 22 20:07:51 2017 From: ghc-devs at haskell.org (GHC) Date: Sun, 22 Oct 2017 20:07:51 -0000 Subject: [GHC] #14383: Allocation in VS up 500% Message-ID: <046.09fed3efcb8eb9fbaef7fe703e241a9a@haskell.org> #14383: Allocation in VS up 500% -------------------------------------+------------------------------------- Reporter: nomeata | Owner: (none) Type: bug | Status: new Priority: low | Milestone: Component: Compiler | Version: 8.3 Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: Runtime Unknown/Multiple | performance bug Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- Somewhere in between the commits fee253fc and 99c61e22 nofib’s `VS` benchmark has allocations increased by 500%. perf.haskell.org is currently defuct (linker errors due to recent changes to the ffi stuff, I believe Moritz is trying to find that out), so I cannot just look there to see which commit broke it. But maybe someone feels like bisecting this. If not maybe perf.haskell.org will be able to tell us once its fixed (although keeping up with GHC commits there is a bit of a pain these days.) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Oct 22 21:32:18 2017 From: ghc-devs at haskell.org (GHC) Date: Sun, 22 Oct 2017 21:32:18 -0000 Subject: [GHC] #14312: Head does not build on Windows with the default make config. In-Reply-To: <047.086b87bb9b3dcf2f7a921149fa31eda2@haskell.org> References: <047.086b87bb9b3dcf2f7a921149fa31eda2@haskell.org> Message-ID: <062.be6c8ee376565af6590210013316626c@haskell.org> #14312: Head does not build on Windows with the default make config. -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: Component: Build System | Version: 8.3 Resolution: | Keywords: Operating System: Windows | Architecture: Type of failure: Building GHC | Unknown/Multiple failed | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4080 Wiki Page: | -------------------------------------+------------------------------------- Comment (by Phyx-): This seems to have been introduced by {{{ commit 06d46b1e4507e09eb2a7a04998a92610c8dc6277 Author: Edward Z. Yang Date: Fri Jul 24 15:13:49 2015 -0700 Unify hsig and hs-boot; add preliminary "hs-boot" merging. This patch drops the file level distinction between hs-boot and hsig; we figure out which one we are compiling based on whether or not there is a corresponding hs file lying around. To make the "import A" syntax continue to work for bare hs-boot files, we also introduce hs-boot merging, which takes an A.hi-boot and converts it to an A.hi when there is no A.hs file in scope. This will be generalized in Backpack to merge multiple A.hi files together; which means we can jettison the "load multiple interface files" functionality. This works automatically for --make, but for one-shot compilation we need a new mode: ghc --merge-requirements A will generate an A.hi/A.o from a local A.hi-boot file; Backpack will extend this mechanism further. Has Haddock submodule update to deal with change in msHsFilePath behavior. - This commit drops support for the hsig extension. Can we support it? It's annoying because the finder code is written with the assumption that where there's an hs-boot file, there's always an hs file too. To support hsig, you'd have to probe two locations. Easier to just not support it. - #10333 affects us, modifying an hs-boot still doesn't trigger recomp. - See compiler/main/Finder.hs: this diff is very skeevy, but it seems to work. - This code cunningly doesn't drop hs-boot files from the "drop hs-boot files" module graph, if they don't have a corresponding hs file. I have no idea if this actually is useful. Signed-off-by: Edward Z. Yang Test Plan: validate Reviewers: simonpj, austin, bgamari, spinda Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1098 }}} with the comment {{{ + -- We add the directory in which the .hs files resides) to the import + -- path. This is needed when we try to compile the .hc file later, if it + -- imports a _stub.h file that we created here. }}} So it seems unrelated to `capi` but the `capi` test require this to pass. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 23 01:55:23 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 23 Oct 2017 01:55:23 -0000 Subject: [GHC] #4020: Please consider adding support for local type synonyms In-Reply-To: <041.4d1fc687182926effba30be48457cbb9@haskell.org> References: <041.4d1fc687182926effba30be48457cbb9@haskell.org> Message-ID: <056.bc56e2ab4b475ab6502e5b336a3f59ea@haskell.org> #4020: Please consider adding support for local type synonyms -------------------------------------+------------------------------------- Reporter: nr | Owner: (none) Type: feature request | Status: new Priority: low | Milestone: Component: Compiler (Type | Version: 6.12.2 checker) | Resolution: | Keywords: type synonym 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 AntC): Replying to [comment:15 Iceland_jack]: > Allowing local data declarations would be more useful (local pattern synonyms even more so) Those are two further proposals. Let's not muddle them up on one ticket. (Do consider raising them as github proposals; but it'll need more than three words to explain what you mean.) It would be worth asking first on StackOverflow or the cafe why Haskell doesn't currently do "local" anything in the type system. You can use export/import settings to make the declared names local to a module. But I guess that's not what you're talking about(?) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 23 02:48:05 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 23 Oct 2017 02:48:05 -0000 Subject: [GHC] #14383: Allocation in VS up 500% In-Reply-To: <046.09fed3efcb8eb9fbaef7fe703e241a9a@haskell.org> References: <046.09fed3efcb8eb9fbaef7fe703e241a9a@haskell.org> Message-ID: <061.bbe8f9b855276f346de72242f6d1706b@haskell.org> #14383: Allocation in VS up 500% -------------------------------------+------------------------------------- Reporter: nomeata | Owner: (none) Type: bug | Status: new Priority: low | Milestone: 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: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by nomeata): I can restrict the problem to the range `33452dfc..99c61e22` (only 340 commits left) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 23 05:00:45 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 23 Oct 2017 05:00:45 -0000 Subject: [GHC] #3919: Or-patterns as GHC extension In-Reply-To: <051.27f4dc97a096cc6bd656d7691ce3afb5@haskell.org> References: <051.27f4dc97a096cc6bd656d7691ce3afb5@haskell.org> Message-ID: <066.9137c7ebbfd4217c909b81e885c03a69@haskell.org> #3919: Or-patterns as GHC extension -------------------------------------+------------------------------------- Reporter: BjornEdstrom | Owner: (none) Type: feature request | 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): Proposal link: https://github.com/ghc-proposals/ghc-proposals/pull/43 (waiting for committee review) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 23 08:03:58 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 23 Oct 2017 08:03:58 -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.fea494d332b24c1d8b245fe340999e3c@haskell.org> #14331: Overzealous free-floating kind check causes deriving clause to be rejected -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: merge Priority: normal | Milestone: 8.2.2 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): > there can be more unification after part (i) if you are deriving Functor, Foldable, or Traversable That is terrible! I had no idea we did this. It seems absurdly ad-hoc. I can see two ways forward. 1. Require standalone deriving in such cases. It's not so bad, and is a lot clearer! I'm against inferring too much. Indeed I'd happily weaken our existing inference further. (Acknowledging back-compat issues.) 2. Do it properly. That is, after simplifying the instance constraints we'll end up with`k~Type` in these cases, and perhaps others. Instead of rejecting such constraints as too exotic, simply commit to them. That's the "extra unification". -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 23 09:24:01 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 23 Oct 2017 09:24:01 -0000 Subject: [GHC] #14377: some results not expected with the addition In-Reply-To: <044.b2ada1f8b8e39ba20773f6a6e815abcd@haskell.org> References: <044.b2ada1f8b8e39ba20773f6a6e815abcd@haskell.org> Message-ID: <059.7879a6313bdf810ff3b35ffc05e594c9@haskell.org> #14377: some results not expected with the addition -------------------------------------+------------------------------------- Reporter: vanto | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: invalid | 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 vanto): * status: new => closed * resolution: => invalid Comment: In this other example, you can see that the calculation results between OCaml and GHC occur for the same numbers. For me there is a relationship between these two systems. It is necessary to do another search to find it and thus to eliminate this miscalculation.\\ {{{ $ ocaml OCaml version 4.04.0 # 16.0/.0.2;; - : float = 80. # 16.0/.0.02;; - : float = 800. # 16.0/.0.002;; - : float = 8000. # 16.0/.0.0002;; - : float = 80000. # 16.0/.0.00002;; - : float = 799999.99999999988 # 16.0/.0.000002;; - : float = 8000000. # 16.0/.0.0000002;; - : float = 80000000. # 16.0/.0.00000002;; - : float = 800000000. # 16.0/.0.000000002;; - : float = 7999999999.999999 # 16.0/.0.0000000002;; - : float = 80000000000. # 16.0/.0.00000000002;; - : float = 800000000000. # 16.0/.0.000000000002;; - : float = 8e+012 # 16.0/.0.0000000000002;; - : float = 8e+013 # 16.0/.0.00000000000002;; - : float = 8e+014 # 16.0/.0.000000000000002;; - : float = 7999999999999999. # 16.0/.0.0000000000000002;; - : float = 8e+016 # 16.0/.0.00000000000000002;; - : float = 8e+017 # 16.0/.0.000000000000000002;; - : float = 7.999999999999999e+018 # 16.0/.0.0000000000000000002;; - : float = 8e+019 # 16.0/.0.00000000000000000002;; - : float = 8e+020 # }}} Today I decided to close this ticket as invalid because I do not know what else to choose to close this ticket. But of course you can reopen it. Thank you for reading this. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 23 09:38:55 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 23 Oct 2017 09:38:55 -0000 Subject: [GHC] #14377: some results not expected with the addition In-Reply-To: <044.b2ada1f8b8e39ba20773f6a6e815abcd@haskell.org> References: <044.b2ada1f8b8e39ba20773f6a6e815abcd@haskell.org> Message-ID: <059.3ceb31d8340421ded72a54bcf03e9ce4@haskell.org> #14377: some results not expected with the addition -------------------------------------+------------------------------------- Reporter: vanto | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: invalid | 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 svenpanne): Replying to [comment:7 vanto]: > It has nothing to do with what you say otherwise why other languages give correct results and not GHC? [...] Within `Double`'s precision, all the results are correct. They might not be ''minimal'' in the sense that they output the minimum number of characters necessary, but they are nevertheless correct: The Haskell Report doesn't require minimality AFAICT. If we wanted such minimality, this would be a feature request, not a bug report. One would have to make detailed performance measurements for such a change: It's easy to get more than an order of magnitude slower here, which might be a deal-breaker for lots of people. I propose you google for "What Every Computer Scientist Should Know About Floating-Point Arithmetic" and/or have a look at the papers and blogs mentioned in the previous Stack Exchange link. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 23 10:42:35 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 23 Oct 2017 10:42:35 -0000 Subject: [GHC] #13356: gmp/ghc.mk's use of TARGETPLATFORM and BUILDPLATFORM is wrong In-Reply-To: <047.fe20157f46c7998038a1955d7e7d86ef@haskell.org> References: <047.fe20157f46c7998038a1955d7e7d86ef@haskell.org> Message-ID: <062.f423dcf1091890a3f7bbb7ad6be527fb@haskell.org> #13356: gmp/ghc.mk's use of TARGETPLATFORM and BUILDPLATFORM is wrong -------------------------------------+------------------------------------- Reporter: rwbarton | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Build System | Version: 8.1 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: | -------------------------------------+------------------------------------- Changes (by nicolast): * cc: nicolast (added) Comment: Interesting, I wasn't aware those variables don't correspond to what Autoconf handles when landing the related change (https://phabricator.haskell.org/D1960) Somewhat related: looking for `TargetPlatformAll` in the GHC tree, I noticed {{{ rules/build-package-data.mk:$1_$2_CONFIGURE_OPTS += --configure- option=--host=$(TargetPlatformFull) }}} which seems a bit odd. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 23 11:13:32 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 23 Oct 2017 11:13:32 -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.0a02e9fad00a15a3e03609b84fc46cbf@haskell.org> #14331: Overzealous free-floating kind check causes deriving clause to be rejected -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: merge Priority: normal | Milestone: 8.2.2 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): Replying to [comment:37 simonpj]: > It seems absurdly ad-hoc. I'm not sure what makes this any more //ad hoc// than anything else we do to derive `Functor`. I'd caution against letting the tail wag the dog here—if something in our algorithm rules out a fundamentally important case like deriving `Functor` for `Compose`, then I'd interpret that as meaning our algorithm is wrong, not the example. > 1. Require standalone deriving in such cases. It's not so bad, and is a lot clearer! I'm against inferring too much. Indeed I'd happily weaken our existing inference further. (Acknowledging back-compat issues.) I'm strongly opposed to this. There's no intuitive reason why `deriving Functor` shouldn't just work in this case, and now we'd have to explain to a mob of pitchfork-wielding Haskell users why their code broke due to GHC not "inferring too much". > 2. Do it properly. That is, after simplifying the instance constraints we'll end up with`k~Type` in these cases, and perhaps others. Instead of rejecting such constraints as too exotic, simply commit to them. That's the "extra unification". For obvious reasons, I'd prefer this option to option 1. But I'll admit that I don't understand the proposed fix here. At what point does instance constraint simplification derive a `k ~ Type` constraint? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 23 13:14:32 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 23 Oct 2017 13:14:32 -0000 Subject: [GHC] #14382: The 'impossible' happened whilst installing gi-gtk via cabal In-Reply-To: <052.f9c10851d0906622baeb7996269cc8e7@haskell.org> References: <052.f9c10851d0906622baeb7996269cc8e7@haskell.org> Message-ID: <067.530a7612c05a4df750d1681abc827d2d@haskell.org> #14382: The 'impossible' happened whilst installing gi-gtk via cabal ----------------------------------+-------------------------------------- Reporter: maartenjacobs | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: | Keywords: gtk, pango Operating System: Linux | Architecture: x86_64 (amd64) Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | ----------------------------------+-------------------------------------- Comment (by simonpj): Can anyone reproduce with 8.2.2? gtk is notoriously difficult to compile. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 23 13:21:22 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 23 Oct 2017 13:21:22 -0000 Subject: [GHC] #14383: Allocation in VS up 500% In-Reply-To: <046.09fed3efcb8eb9fbaef7fe703e241a9a@haskell.org> References: <046.09fed3efcb8eb9fbaef7fe703e241a9a@haskell.org> Message-ID: <061.6da9b2c7db0748f93f5c88a99ef1c266@haskell.org> #14383: Allocation in VS up 500% -------------------------------------+------------------------------------- Reporter: nomeata | Owner: (none) Type: bug | Status: new Priority: low | Milestone: 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: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Where is nofib's VS benchmark? What's the latest released compiler with good perf? 8.2? 8.0? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 23 13:21:59 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 23 Oct 2017 13:21:59 -0000 Subject: [GHC] #14377: some results not expected with the addition In-Reply-To: <044.b2ada1f8b8e39ba20773f6a6e815abcd@haskell.org> References: <044.b2ada1f8b8e39ba20773f6a6e815abcd@haskell.org> Message-ID: <059.06a8527ab625a741e5a192c7989bb17e@haskell.org> #14377: some results not expected with the addition -------------------------------------+------------------------------------- Reporter: vanto | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: invalid | 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 vanto): look at these calculations:\\ {{{ a) Prelude> (16.0/0.00002) 799999.9999999999 it :: Fractional a => a b) Prelude> fromRational(16.0/0.00002) 800000.0 it :: Fractional a => a c) Prelude> (16.0/0.00002)**2.1 2.491661103847512e12 it :: Floating a => a d) Prelude> (fromRational(16.0/0.00002))**2.1 2.491661103847512e12 it :: Floating a => a e) Prelude> 800000.0**2.1 2.491661103847512e12 it :: Floating a => a f) Prelude> let a = (16.0/0.00002) a :: Fractional a => a g) Prelude> a 799999.9999999999 it :: Fractional a => a h) Prelude> a**2.1 2.491661103847512e12 it :: Floating a => a }}} the reference calculation will be the expression in e). the results from c), d), e) and h) are equal and yet their calculations are different.\\ compare results from a) and b). the results are not identical. then compare the results from c) and d). the results are identical.\\ first observation: it is not obligatory to write fromRational in front of the numerical expression to have a correct result. second observation: look at f) and g) and the result in h) which is identical to the other results in c), d) or e).\\ as I said above, this demonstration shows that GHC calculates well but the result provided in a) does not conform to our view and this result does not come from an error due to the calculation of Floats. I think this can be fixed. No? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 23 13:31:35 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 23 Oct 2017 13:31:35 -0000 Subject: [GHC] #14383: Allocation in VS up 500% In-Reply-To: <046.09fed3efcb8eb9fbaef7fe703e241a9a@haskell.org> References: <046.09fed3efcb8eb9fbaef7fe703e241a9a@haskell.org> Message-ID: <061.0f2d738bb3f7f1e8ca59dfb4ad694d4e@haskell.org> #14383: Allocation in VS up 500% -------------------------------------+------------------------------------- Reporter: nomeata | Owner: (none) Type: bug | Status: new Priority: low | Milestone: 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: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by nomeata): It’s in `real/eff/VS`, just added this August, so no released compiler has it in the suite. But I can of course test an old compiler with `make NoFibRuns=1 mode=slow HC=ghc-8.0`. I get {{{ 8.0 483117568 8.2 483117520 7ea5d41d 3123117584 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 23 13:31:43 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 23 Oct 2017 13:31:43 -0000 Subject: [GHC] #14375: Implement with# primop In-Reply-To: <046.d97bc36423b0cbcf2ececb77831c1a4a@haskell.org> References: <046.d97bc36423b0cbcf2ececb77831c1a4a@haskell.org> Message-ID: <061.c413a9cdb807d926d3944ee0700f4c3f@haskell.org> #14375: Implement with# primop -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: | Keywords: JoinPoints Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #14346 | Differential Rev(s): ​Phab:D4110 Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): I think I was going too fast. Let's try this instead: * `maskAsyncExceptions#` is allowed to have `\s.e` as its argument. Perhaps even required. * The codegen looks like {{{ cgExpr (maskAsyncExceptions (\s.e) s2) = do { emit (mask frame) ; bind s:=s2 (cgExpr e) } }}} Essentially just push the stack frame and carry on with e. For the "exception handler" argument for `catch#`, a join might make more sense. But the "main event" argument for `catch#` should work as above. Does that make more sense? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 23 13:53:16 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 23 Oct 2017 13:53:16 -0000 Subject: [GHC] #14384: real numbers, digits after the decimal point - digits of precision Message-ID: <044.8e6149b05869bc4131752d14bf9bb9d7@haskell.org> #14384: real numbers, digits after the decimal point - digits of precision -------------------------------------+------------------------------------- Reporter: vanto | Owner: (none) Type: feature | Status: new request | Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- the results from computation should have eleven digits after the decimal point for real numbers. (11 digits of precision) it seems reasonable.\\ instead of: {{{ Prelude> (16.0/0.00002)**2.1 2.491661103847512e12 }}} this is better:\\ {{{ 2.49166110385e12 }}} it should be noted that a lot of computing system uses this precision. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 23 14:00:38 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 23 Oct 2017 14:00:38 -0000 Subject: [GHC] #11251: isInstance does not work on Typeable with base-4.8 anymore In-Reply-To: <045.6032ac627aa889ca8ac6f2a84e970c9c@haskell.org> References: <045.6032ac627aa889ca8ac6f2a84e970c9c@haskell.org> Message-ID: <060.cb081dc5621f18f5d94f6e8a79919799@haskell.org> #11251: isInstance does not work on Typeable with base-4.8 anymore -------------------------------------+------------------------------------- Reporter: songzh | Owner: goldfire Type: bug | Status: new Priority: normal | Milestone: Component: Template Haskell | Version: 7.10.1 Resolution: | Keywords: Typeable, | isInstance 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): Re comment:3, we automatically derive a `Typeable` instance for every type, so it should probably be an error to derive it explicitly. Does everyone agree? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 23 14:23:29 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 23 Oct 2017 14:23:29 -0000 Subject: [GHC] #11251: isInstance does not work on Typeable with base-4.8 anymore In-Reply-To: <045.6032ac627aa889ca8ac6f2a84e970c9c@haskell.org> References: <045.6032ac627aa889ca8ac6f2a84e970c9c@haskell.org> Message-ID: <060.ed7697679c7b634d25c4bf71f1dca78f@haskell.org> #11251: isInstance does not work on Typeable with base-4.8 anymore -------------------------------------+------------------------------------- Reporter: songzh | Owner: goldfire Type: bug | Status: new Priority: normal | Milestone: Component: Template Haskell | Version: 7.10.1 Resolution: | Keywords: Typeable, | isInstance 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): FWIW, there is already a warning for this sort of thing in the form of `-Wderiving-typeable`: {{{ $ ghci Bug.hs -Wderiving-typeable GHCi, version 8.2.1: http://www.haskell.org/ghc/ :? for help Loaded GHCi configuration from /home/rgscott/.ghci [1 of 1] Compiling Main ( Bug.hs, interpreted ) Bug.hs:6:1: warning: [-Wderiving-typeable] • Deriving ‘Typeable’ has no effect: all types now auto-derive Typeable • In the stand-alone deriving instance for ‘Typeable TT’ | 6 | deriving instance Typeable TT | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ Bug.hs:8:1: warning: [-Wderiving-typeable] • Deriving ‘Typeable’ has no effect: all types now auto-derive Typeable • In the stand-alone deriving instance for ‘Typeable TT’ | 8 | deriving instance Typeable TT | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ }}} Why this isn't enabled in `-Wall` is beyond me. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 23 14:34:29 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 23 Oct 2017 14:34:29 -0000 Subject: [GHC] #11251: isInstance does not work on Typeable with base-4.8 anymore In-Reply-To: <045.6032ac627aa889ca8ac6f2a84e970c9c@haskell.org> References: <045.6032ac627aa889ca8ac6f2a84e970c9c@haskell.org> Message-ID: <060.d26ef5fa21d11e647e13422e94bac8d7@haskell.org> #11251: isInstance does not work on Typeable with base-4.8 anymore -------------------------------------+------------------------------------- Reporter: songzh | Owner: goldfire Type: bug | Status: new Priority: normal | Milestone: Component: Template Haskell | Version: 7.10.1 Resolution: | Keywords: Typeable, | isInstance 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): > Why this isn't enabled in `-Wall` is beyond me. Yes, at this point it sounds like it should be.m -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 23 14:35:04 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 23 Oct 2017 14:35:04 -0000 Subject: [GHC] #14377: some results not expected with the addition In-Reply-To: <044.b2ada1f8b8e39ba20773f6a6e815abcd@haskell.org> References: <044.b2ada1f8b8e39ba20773f6a6e815abcd@haskell.org> Message-ID: <059.a954e29a86d63d1bb1e06e91bf7b10b1@haskell.org> #14377: some results not expected with the addition -------------------------------------+------------------------------------- Reporter: vanto | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: invalid | 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 svenpanne): Just a few more hints why this is not a bug (all from the Haskell Report): * Numerical literals with a dot in it have an implicit `fromRational` around it. * Not surprisingly, `fromRational` forces its 1st argument to be a `Rational`. * The default default is `default (Integer, Double)`. * `(**) :: Floating a => a -> a -> a`. With that information you can figure out why e.g. the division in a) is a different kind of division than the one in b). -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 23 14:37:39 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 23 Oct 2017 14:37:39 -0000 Subject: [GHC] #14382: The 'impossible' happened whilst installing gi-gtk via cabal In-Reply-To: <052.f9c10851d0906622baeb7996269cc8e7@haskell.org> References: <052.f9c10851d0906622baeb7996269cc8e7@haskell.org> Message-ID: <067.8a5268c8d58bbe33aa16c5072af2769c@haskell.org> #14382: The 'impossible' happened whilst installing gi-gtk via cabal ----------------------------------+-------------------------------------- Reporter: maartenjacobs | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: | Keywords: gtk, pango Operating System: Linux | Architecture: x86_64 (amd64) Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | ----------------------------------+-------------------------------------- Comment (by bgamari): I'm trying. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 23 14:49:25 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 23 Oct 2017 14:49:25 -0000 Subject: [GHC] #14384: real numbers, digits after the decimal point - digits of precision In-Reply-To: <044.8e6149b05869bc4131752d14bf9bb9d7@haskell.org> References: <044.8e6149b05869bc4131752d14bf9bb9d7@haskell.org> Message-ID: <059.0ae5c7781b7b7daac790d3ec17b68552@haskell.org> #14384: real numbers, digits after the decimal point - digits of precision -------------------------------------+------------------------------------- Reporter: vanto | Owner: (none) Type: feature request | Status: closed Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 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 svenpanne): * status: new => closed * resolution: => invalid Comment: Shortening like this would be wrong, because it would lose precision: {{{ Prelude> decodeFloat ((16.0/0.00002)**2.1) (5102921940679704,-11) Prelude> decodeFloat 2.49166110385e12 (5102921940684800,-11) }}} The default `Show` instance should at least produce as many digits as necessary to reproduce the underlying binary representation, otherwise a lot of code out there would be ''very'' unhappy. If you have other formatting needs, you can use e.g. `Text.Printf.printf`. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 23 15:44:36 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 23 Oct 2017 15:44:36 -0000 Subject: [GHC] #14384: real numbers, digits after the decimal point - digits of precision In-Reply-To: <044.8e6149b05869bc4131752d14bf9bb9d7@haskell.org> References: <044.8e6149b05869bc4131752d14bf9bb9d7@haskell.org> Message-ID: <059.3bb81e11c566f04b29ea0bb928b630f3@haskell.org> #14384: real numbers, digits after the decimal point - digits of precision -------------------------------------+------------------------------------- Reporter: vanto | 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 vanto): * status: closed => new * resolution: invalid => Comment: Replying to [[span(style=color: #FF0000, svenpanne )]]. \\ you misunderstood. I do not mention that I was talking about the precision of the display. Here you confuse the precision digits of the display of the result and the digits of precision of the calculation made by GHC.\\ if you misunderstood ask a question.\\ ''' And please, stop closing my tickets because you do not agree or you understand nothing. you are not alone here. '''\\ this ticket is reopened. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 23 15:44:51 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 23 Oct 2017 15:44:51 -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.ce0f9ff6a140c3b2ec019a7d297fa08d@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: | -------------------------------------+------------------------------------- Changes (by bgamari): * owner: (none) => bgamari * milestone: => 8.4.1 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 23 15:51:00 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 23 Oct 2017 15:51:00 -0000 Subject: [GHC] #14377: some results not expected with the addition In-Reply-To: <044.b2ada1f8b8e39ba20773f6a6e815abcd@haskell.org> References: <044.b2ada1f8b8e39ba20773f6a6e815abcd@haskell.org> Message-ID: <059.68ff28a1199417ddca129ec4c81e410b@haskell.org> #14377: some results not expected with the addition -------------------------------------+------------------------------------- Reporter: vanto | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 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 vanto): * status: closed => new * resolution: invalid => Comment: I just figured out how to fix that. that's why I re-open this ticket. This idea came to me when calculating numbers with my HP Prime calculator.\\ as I said above, GHC calculates well. it's a matter of displaying a number. we can give ourselves a limit in the display of the number which will be for example 5 digits of precision after the decimal point. in a new request ticket I talked about 11 precision digits in the display.\\ I specify for those who have not understood anything yet that it is a precision in the display and not in the internal calculation. \\ 5 digits may seem sufficient considering that GHC is more used in the functional part more than in the intensive mathematical calculation. example:\\ if the number is:{{{79.999999}}} he can become {{{80}}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 23 16:24:23 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 23 Oct 2017 16:24:23 -0000 Subject: [GHC] #14384: real numbers, digits after the decimal point - digits of precision In-Reply-To: <044.8e6149b05869bc4131752d14bf9bb9d7@haskell.org> References: <044.8e6149b05869bc4131752d14bf9bb9d7@haskell.org> Message-ID: <059.2f0f6bee0b4365af83760a536fe90bf6@haskell.org> #14384: real numbers, digits after the decimal point - digits of precision -------------------------------------+------------------------------------- Reporter: vanto | Owner: (none) Type: feature request | Status: closed Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 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 hsyl20): * status: new => closed * resolution: => invalid Comment: Replying to vanto: It seems like you are new to Haskell (and to programming with floating- point numbers in general). `read . show` must be `id`. Do you understand the following code? {{{#!hs > read (show ((16.0/0.00002)**2.1)) - (((16.0/0.00002)**2.1) :: Double) 0.0 > read "2.49166110385e12" - (((16.0/0.00002)**2.1) :: Double) 2.48828125 }}} Use `printf` as suggested or [https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/ghci.html#using-a -custom-interactive-printing-function `-interactive-print` in GHCi]. Please use the haskell-beginners mailing-list to ask questions instead of GHC's bug tracker when you don't understand. You are not alone here. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 23 18:05:08 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 23 Oct 2017 18:05:08 -0000 Subject: [GHC] #14377: some results not expected with the addition In-Reply-To: <044.b2ada1f8b8e39ba20773f6a6e815abcd@haskell.org> References: <044.b2ada1f8b8e39ba20773f6a6e815abcd@haskell.org> Message-ID: <059.cdf5bca820b2a9c4a5f7817543c40a0b@haskell.org> #14377: some results not expected with the addition -------------------------------------+------------------------------------- Reporter: vanto | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: invalid | 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 svenpanne): * status: new => closed * resolution: => invalid Comment: I fully understand that you want to change the standard way of `Show`ing `Double`s, but this won't happen: There is an informal understanding that `read` and `show` are a (weak) kind of inverses: {{{ #!haskell almostIdentity x = read (show x) `asTypeOf` x }}} There is no formal requirement in the Haskell Report for this, but you can be sure that lots of code out there would break for no good reason if the standard `Show` instance would simply lower the precision. Improving the implementation so that it would output as few characters as possible while retaining precision ''and'' performance would be another story, as has already been pointed out. Again: If you want some special formatting, use e.g.: {{{ Prelude> Text.Printf.printf "%.5g\n" 12.3456789 12.34568 }}} Just for the record: Try the equivalent of your examples in Chrome's JavaScript console, in Firefox, Python 3.6's IDLE, in DrRacket's console etc. etc., and you will see the same results as in GHC(i), and for a good reason. Another thing: A bug tracker is not really the right place to discuss wild new ideas, IRC e.g. might be a better place to get some initial feedback and perhaps learn why things are done they way they are. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 23 18:32:59 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 23 Oct 2017 18:32:59 -0000 Subject: [GHC] #14377: some results not expected with the addition In-Reply-To: <044.b2ada1f8b8e39ba20773f6a6e815abcd@haskell.org> References: <044.b2ada1f8b8e39ba20773f6a6e815abcd@haskell.org> Message-ID: <059.8a72e35784c45c1d01140185041aea9e@haskell.org> #14377: some results not expected with the addition -------------------------------------+------------------------------------- Reporter: vanto | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 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 vanto): * status: closed => new * resolution: invalid => Comment: Replying to [[span(style=color: #FF0000, svenpanne )]]. \\ not at all. not at all.\\ in his book entitled "Thinking Functionally with Haskell" Richard Bird says page 12-13:\\ {{{ One of the tools is an interactive calculator, called GHCi...You can now use GHCi as a super-calculator: Prelude> 3^5 243 }}} when I write {{{Prelude> 1.1+2.2}}}, the answer is {{{3.3000000000000003}}} \\ But if I use Hugs 98 (Haskell 98 Compatability): \\ when I write {{{Hugs> 1.1+2.2}}}, the answer is \\ {{{3.3 :: Double(32 reductions, 75ells)}}} that's all.\\ and you do not see any difference in these two results.\\ Stubborn?\\ -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 23 18:53:52 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 23 Oct 2017 18:53:52 -0000 Subject: [GHC] #14384: real numbers, digits after the decimal point - digits of precision In-Reply-To: <044.8e6149b05869bc4131752d14bf9bb9d7@haskell.org> References: <044.8e6149b05869bc4131752d14bf9bb9d7@haskell.org> Message-ID: <059.e1588a755e39cf2aa8f157ded64bb9a9@haskell.org> #14384: real numbers, digits after the decimal point - digits of precision -------------------------------------+------------------------------------- Reporter: vanto | 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 vanto): * status: closed => new * resolution: invalid => Comment: Replying to [[span(style=color: #FF0000, hsyl20 )]] \\ look what I wrote in ticket {{{#14377}}} and hope you understand.\\ because this ticket is an idea for a possible improvement of GHC. That's all. and I do not want to change anything else! yes I am new to Haskell language and I certainly have abilities in areas that you do not have. It's not good to tell me what you say because you know more than me the language. Here I do not need help, I only bring some ideas that maybe someday will be used to improve GHC. That's all I want. and I still know how to close a ticket myself if it does not fit the majority. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 23 19:37:25 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 23 Oct 2017 19:37:25 -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.f680105778c19512fb70b4d7a49180f4@haskell.org> #14331: Overzealous free-floating kind check causes deriving clause to be rejected -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: merge Priority: normal | Milestone: 8.2.2 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 see what's Simon's getting at with his (2). Let me try to explain by way of a much simpler example. Suppose the user has written {{{#!hs f :: _ => a -> a f True = False f False = True }}} GHC rejects. But it doesn't have to do so: it could infer `_ := (a ~ Bool)`, thus giving `f` the type `(a ~ Bool) => a -> a`, a perfectly fine type for that definition. Of course, GHC doesn't do this, because it leads to a bad user experience. It's similar with `deriving` inference: GHC is free to infer whatever constraints it wants for the instance. It ''could'' choose to infer a `k ~ Type` constraint. Currently, it doesn't because that's too like the `a ~ Bool` constraint above. So Simon is proposing to unrestrict GHC in this regard. Sadly, however, this doesn't actually work. Again, I'll use a simpler example to demonstrate: {{{#!hs g :: forall k (a :: k). k ~ Type => a -> a g x = x }}} GHC rejects this type signature, saying that `a` has kind `k`. This isn't a bug. It was decided en route to `TypeInType` that GHC wouldn't allow kind-level equality constraints to be used in the same type that they're brought into scope. (Essentially, we don't Pi-quantify constraints.) One reason for this is that `~` is lifted and can be forged. (There are some disorganized notes about all this [https://ghc.haskell.org/trac/ghc/wiki/DependentHaskell/Internal#Liftedvs.Unliftedequality here].) The `k ~ Type` constraint Simon proposes would suffer from the same non- feature. So, even if GHC did infer `k ~ Type`, we couldn't just stuff this constraint in the inferred theta and declare victory. So, while Simon's (2) is nice in theory, it wouldn't work until we have more dependent types. I, too, am against Simon's (1). `stock` deriving is all ad-hoc. I'm not bothered by this particular piece of ad-hockery. It should be documented, of course, but I think it's OK. I don't think my algorithm should accommodate this, though, precisely because it is indeed ad-hoc. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 23 20:01:48 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 23 Oct 2017 20:01:48 -0000 Subject: [GHC] #14377: some results not expected with the addition In-Reply-To: <044.b2ada1f8b8e39ba20773f6a6e815abcd@haskell.org> References: <044.b2ada1f8b8e39ba20773f6a6e815abcd@haskell.org> Message-ID: <059.644eabc53e6d6fcd2f6c9334995822d7@haskell.org> #14377: some results not expected with the addition -------------------------------------+------------------------------------- Reporter: vanto | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: invalid | 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 svenpanne): * status: new => closed * resolution: => invalid Comment: Please stop re-opening tickets and try to gather some information from relevant papers/blogs, and ask on mailing lists. This is a bug tracker, not a learning tool. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 23 20:02:49 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 23 Oct 2017 20:02:49 -0000 Subject: [GHC] #14384: real numbers, digits after the decimal point - digits of precision In-Reply-To: <044.8e6149b05869bc4131752d14bf9bb9d7@haskell.org> References: <044.8e6149b05869bc4131752d14bf9bb9d7@haskell.org> Message-ID: <059.ff55abe963684eaa610a4ba5f13d7682@haskell.org> #14384: real numbers, digits after the decimal point - digits of precision -------------------------------------+------------------------------------- Reporter: vanto | Owner: (none) Type: feature request | Status: closed Priority: normal | Milestone: Component: Compiler | Version: 8.2.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 svenpanne): * status: new => closed * resolution: => wontfix -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 23 20:45:41 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 23 Oct 2017 20:45:41 -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.0af29c453d2a5764c27b68505c9308a5@haskell.org> #14331: Overzealous free-floating kind check causes deriving clause to be rejected -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: merge Priority: normal | Milestone: 8.2.2 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): > So, while Simon's (2) is nice in theory, it wouldn't work until we have more dependent types. Yes it will -- I just explained it badly. In `TcDerivInfer.inferConstaints` we figure out the context of the derived instance decl. To do so we call `TcDerivInfer.simplifyDeriv`, which in turn calls `TcSimplify.solveWantedsAndDrop`. It's the latter that will come up with that `k~Type` constraint. Now if that `k` is a unification variable, `solveWantedsAndDrop` will go right ahead and unify it. Which, you are saying, is precisely what we want. But, unlike the current ad-hoc setup, that will happen though constraint solving in general, rather than through a magical `Functor`-specific wim-wam. So, I say, make those unifiable k's into real unification variables, and let the constraint solver do its thing. Then, when the dust settles, gather up all the free variables and quantify over them, much as we do in any other inferred type. This does mean we can't fix on the quantified variables until after `inferConstraints`. But it's simple and systematic. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 23 20:57:26 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 23 Oct 2017 20:57:26 -0000 Subject: [GHC] #7258: Compiling DynFlags is jolly slow In-Reply-To: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> References: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> Message-ID: <061.c26cc76d6af3805625ee3ca37439fbf3@haskell.org> #7258: Compiling DynFlags is jolly slow -------------------------------------+------------------------------------- Reporter: simonpj | Owner: simonpj Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.6.1 Resolution: | Keywords: deriving-perf 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 tdammers): * Attachment "ghc-large-record-types.png" added. Profile samples for W2.hs-style record types, comparing GHC performance for just the raw record type, derived Read, derived Show, and a hand- written getLine-based applicative record construction function. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 23 20:59:22 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 23 Oct 2017 20:59:22 -0000 Subject: [GHC] #7258: Compiling DynFlags is jolly slow In-Reply-To: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> References: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> Message-ID: <061.b3e380bead54ffe002c7fa2e7a8cbe2e@haskell.org> #7258: Compiling DynFlags is jolly slow -------------------------------------+------------------------------------- Reporter: simonpj | Owner: simonpj Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.6.1 Resolution: | Keywords: deriving-perf 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 tdammers): * Attachment "profiles.csv" added. Sample GHC profile data for W2.hs style record type, comparing just the record type, derived Read, derived Show, and a hand-written getLine-based applicative record construction function -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 24 06:58:58 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 24 Oct 2017 06:58:58 -0000 Subject: [GHC] #10607: Auto derive from top to bottom In-Reply-To: <045.e09b97a7eafdf9652cf786c0b3852657@haskell.org> References: <045.e09b97a7eafdf9652cf786c0b3852657@haskell.org> Message-ID: <060.7206a37c43ac182f3a598af4ca8e3846@haskell.org> #10607: Auto derive from top to bottom -------------------------------------+------------------------------------- Reporter: songzh | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.11 Resolution: | Keywords: deriving, | typeclass, auto Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #13324 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by songzh): Dear All I am very happy to announce that I released `derive-topdown-0.0.0.9`. I tested with `Info` type in `template-haskell` and `HsModule` type in `haskell-src`. It can derive class instances for most common cases I think. It also can be used with other type classes with template Haskell deriving mechanism via a function with type `Name -> Q [Dec]`. I also considered `DerivingStrategies` in GHC 8.2. Please try it if you are interested. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 24 07:39:46 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 24 Oct 2017 07:39:46 -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.2b598324e44c8c308a0eee5bc8dfb084@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 simonpj): It's hard to review code without a spec, or even some input/output examples. And an overview Note to explain the goal and how the impl works would be useful. Based on a very quick look, it seems that you hope to branch from one `CmmProc` to a label in another. That's a huge thing to do, because it messes up all dataflow analyses, which expect to be able to see all the places that jump to a block (e.g. constant propagation). I'm 99% sure that you can't translate it into LLVM. Before you invest a lot more effort, can we debate the goal? There are others on ghc-devs who know about this back-end stuff. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 24 08:31:42 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 24 Oct 2017 08:31:42 -0000 Subject: [GHC] #14380: Compile error for PatternSynonyms together with OverloadedLists In-Reply-To: <045.c5aedfba2a7a6300bf201d20c6b5bb6e@haskell.org> References: <045.c5aedfba2a7a6300bf201d20c6b5bb6e@haskell.org> Message-ID: <060.2a3644b7493392913a22adbc604dd607@haskell.org> #14380: Compile error for PatternSynonyms together with OverloadedLists -------------------------------------+------------------------------------- Reporter: lehins | 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: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): OK, I know what is happening here. * The message is utterly bogus. * It arise because, with ''implicitly-bidirectional'' pattern synonyms, we have to translate a pattern into an expression. See `TcPatSyn` {{{ tcPatToExpr :: Name -> [Located Name] -> LPat GhcRn -> Either MsgDoc (LHsExpr GhcRn) }}} Note that this happens to a renamed, but not typechecked, pattern. * With rebindable syntax, a renamed list pattern `[p1, p2]`, implemented with `ListPat`, looks like {{{ ListPat [p1, p2] (Just toList) }}} where the `toList` is the name of the in-scope `toList` function. Matching on the pattern will call `toList` to convert the actual arg to a list, and match that list against `[p1, p2]` * But when converting a `ListPat` ''patttern'' to a to an `ExplicitList` ''expression'' we need `fromList` not `toList`!! Stupidly, `tcPatToExpr` just plops the `toList` in the `ExplicitList`. Wrong wrong. What do to? The typechecker (which is where `tcPatToExpr` is currently called) isn't really the right place to look up `fromList`, although it might be possible. E.g. the renamer would then not see this use of `fromList`, and hence perhaps complain about an unused import. I think the Right Thing is to move `tcPatToExpr` to the renamer, and which can look up that `fromList` just as it does the `toList`. To do that we'd need to alter `HsPatSynDir` thus {{{ data HsPatSynDir id = Unidirectional | ImplicitBidirectional (PostRn (LHsExpr id)) | ExplicitBidirectional (MatchGroup id (LHsExpr id)) }}} This adds a `LHsExpr` field to `ImplicitBidirectional`, the result of doing that conversion. I suppose that `tcPatToExpr` would then become monadic so that it can look up `fromList`. And then it can report errors rather than returning them in an `Either`. Would anyone like to try this? Meanwhile, I think I'll just reject programs that use implicitly- bidirectional syntax with overloaded lists, pointing to this ticket so that users can yell if it happens. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 24 09:09:26 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 24 Oct 2017 09:09:26 -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.bfb83b66a64d2d2a7901da589c28153a@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 heisenbug): Replying to [comment:10 simonpj]: > It's hard to review code without a spec, or even some input/output examples. > > And an overview Note to explain the goal and how the impl works would be useful. Will do. I am in a very early stage :-) > > Based on a very quick look, it seems that you hope to branch from one `CmmProc` to a label in another. That's a huge thing to do, because it messes up all dataflow analyses, which expect to be able to see all the places that jump to a block (e.g. constant propagation). I'm 99% sure that you can't translate it into LLVM. You are correct. We can only branch to labels that we emit. So this probably will be a NCG-only thing (C-backend is off-limits too), unless we find a way to invoke the "outliner" in LLVM specifically. What I have observed that sometimes previously noted labels disappear due to optimisation. So I'll have to move the commoning to the end of the Cmm pipeline. > > Before you invest a lot more effort, can we debate the goal? There are others on ghc-devs who know about this back-end stuff. Sure. First and above all I am trying to learn and understand the inner workings of Cmm. Let me just get this working with bootstrap and we can discuss. I'll also need to gather some statistics. Thanks for the review, Simon! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 24 09:48:57 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 24 Oct 2017 09:48:57 -0000 Subject: [GHC] #7258: Compiling DynFlags is jolly slow In-Reply-To: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> References: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> Message-ID: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> #7258: Compiling DynFlags is jolly slow -------------------------------------+------------------------------------- Reporter: simonpj | Owner: simonpj Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.6.1 Resolution: | Keywords: deriving-perf 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 tdammers): * Attachment "ghc-large-record-types.png" removed. Profile samples for W2.hs-style record types, comparing GHC performance for just the raw record type, derived Read, derived Show, and a hand- written getLine-based applicative record construction function. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 24 09:48:57 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 24 Oct 2017 09:48:57 -0000 Subject: [GHC] #7258: Compiling DynFlags is jolly slow In-Reply-To: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> References: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> Message-ID: <061.a8f2ebbb3b7a4bf3741bf123c2e4a2b0@haskell.org> #7258: Compiling DynFlags is jolly slow -------------------------------------+------------------------------------- Reporter: simonpj | Owner: simonpj Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.6.1 Resolution: | Keywords: deriving-perf 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 tdammers): * Attachment "ghc-large-record-types.png" added. Performance profiling data for large record types. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 24 09:50:26 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 24 Oct 2017 09:50:26 -0000 Subject: [GHC] #7258: Compiling DynFlags is jolly slow In-Reply-To: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> References: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> Message-ID: <061.6505bb48c80fa78269fbb12d9692ddc0@haskell.org> #7258: Compiling DynFlags is jolly slow -------------------------------------+------------------------------------- Reporter: simonpj | Owner: simonpj Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.6.1 Resolution: | Keywords: deriving-perf 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 tdammers): * Attachment "examples.zip" added. Code examples for the large records performance plot -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 24 10:11:02 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 24 Oct 2017 10:11:02 -0000 Subject: [GHC] #14377: some results not expected with the addition In-Reply-To: <044.b2ada1f8b8e39ba20773f6a6e815abcd@haskell.org> References: <044.b2ada1f8b8e39ba20773f6a6e815abcd@haskell.org> Message-ID: <059.06b0a1faf6182306d2be13cdb5f94580@haskell.org> #14377: some results not expected with the addition -------------------------------------+------------------------------------- Reporter: vanto | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 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 vanto): * status: closed => new * resolution: invalid => Comment: This ticket shows a bug. I do not seek help in this ticket, I have all the help I need in the books I read. Please, svenpanne, stop to close this ticket. I re-open it. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 24 10:20:53 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 24 Oct 2017 10:20:53 -0000 Subject: [GHC] #14384: real numbers, digits after the decimal point - digits of precision In-Reply-To: <044.8e6149b05869bc4131752d14bf9bb9d7@haskell.org> References: <044.8e6149b05869bc4131752d14bf9bb9d7@haskell.org> Message-ID: <059.5f195e953e1226b04575cd17e29c60fb@haskell.org> #14384: real numbers, digits after the decimal point - digits of precision -------------------------------------+------------------------------------- Reporter: vanto | 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 vanto): * status: closed => new * resolution: wontfix => Comment: This ticket shows a future request. You have expressed your point of view, others can express themselves too. Please, svenpanne, stop to close this ticket. I re-open it.\\ I add that with the Ada language we can change the number of digits of precision and that we can be inspired by it. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 24 10:26:02 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 24 Oct 2017 10:26:02 -0000 Subject: [GHC] #14380: Compile error for PatternSynonyms together with OverloadedLists In-Reply-To: <045.c5aedfba2a7a6300bf201d20c6b5bb6e@haskell.org> References: <045.c5aedfba2a7a6300bf201d20c6b5bb6e@haskell.org> Message-ID: <060.d386102ddf225c683621a527a62d02bc@haskell.org> #14380: Compile error for PatternSynonyms together with OverloadedLists -------------------------------------+------------------------------------- Reporter: lehins | 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: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Simon Peyton Jones ): In [changeset:"d1eaeadb08c1412c1572124efaf341bdc0976ccb/ghc" d1eaead/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="d1eaeadb08c1412c1572124efaf341bdc0976ccb" Temporary fix to Trac #14380 This fix replaces an utterly bogus error message with a decent one, rejecting a pattern synonym with a list pattern and rebindable syntax. Not hard to fix properly, but I'm going to wait for a willing volunteer and/or more user pressure. }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 24 11:14:46 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 24 Oct 2017 11:14:46 -0000 Subject: [GHC] #14384: real numbers, digits after the decimal point - digits of precision In-Reply-To: <044.8e6149b05869bc4131752d14bf9bb9d7@haskell.org> References: <044.8e6149b05869bc4131752d14bf9bb9d7@haskell.org> Message-ID: <059.dc9483c1d3d483b029403b591d9faf19@haskell.org> #14384: real numbers, digits after the decimal point - digits of precision -------------------------------------+------------------------------------- Reporter: vanto | Owner: (none) Type: feature request | Status: closed Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 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 hsyl20): * status: new => closed * resolution: => invalid Comment: The feature already exists. {{{#!haskell {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE FlexibleInstances #-} import Text.Printf class MyPrint a where myshow :: a -> IO () default myshow :: Show a => a -> IO () myshow = print instance MyPrint [Char] instance MyPrint Int instance MyPrint Double where myshow d = printf "%.11e\n" d }}} {{{ > :load MyPrint.hs [1 of 1] Compiling Main ( MyPrint.hs, interpreted ) Ok, 1 module loaded. > :set -interactive-print myshow > (16.0/0.00002)**2.1 2.49166110385e12 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 24 11:23:57 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 24 Oct 2017 11:23:57 -0000 Subject: [GHC] #7258: Compiling DynFlags is jolly slow In-Reply-To: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> References: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> Message-ID: <061.3a58723a37e2a264ee69941e09195bfc@haskell.org> #7258: Compiling DynFlags is jolly slow -------------------------------------+------------------------------------- Reporter: simonpj | Owner: simonpj Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.6.1 Resolution: | Keywords: deriving-perf 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): Latest profiling results: - graph plot: https://ghc.haskell.org/trac/ghc/attachment/ticket/7258/ghc- large-record-types.png - raw results: https://ghc.haskell.org/trac/ghc/attachment/ticket/7258/profiles.csv - example code: https://ghc.haskell.org/trac/ghc/attachment/ticket/7258/examples.zip The test module defines a record type of N fields, named `field0` through `field{N-1}`, called `DT`; the performance metric is the "total time" value from the profiler output for GHC compiling the module on its own. The codenames refer to different versions of the test module (all of them defining the same `DT` type though): - `nothing`: just a raw record type, no instances or functions. This is the baseline. - `show`: a derived Show instance (`deriving (Show)`) - `read`: a derived Read instance (`deriving (Read)`) - `read-appl`: a hand-written Read instance using applicative syntax (`DT <$> a1 <*> a2 <*> a3 <*> ...`) - `getline`: a hand-written function consisting of a series of N monadic binds followed by a `return` of an N-argument call to the `DT` constructor. This is the same shape as what the derived Read and Show instances produce internally. - `getline-appl`: a hand-written function that reads fields from stdin using `getLine` and applicatively combines them into a value of our record type: `DT <$> (read <$> getLine) <*> (read <$> getLine) <*> ...` - `getline-standalone`: a set of N functions performing one `getLine` call each: `getlD :: Int -> IO Int; getlD i = read <$> getLine` - `show-standalone`: a set of N functions, each constructing a string by combining an integer argument with the function's index The `-standalone` and `nothing` flavors were added as controls. Looking at the plot, the pattern is pretty obvious: the applicative versions show performance patterns very similar to the control, while the three versions that use many monadic binds all exhibit clearly nonlinear performance. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 24 11:25:07 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 24 Oct 2017 11:25:07 -0000 Subject: [GHC] #7258: Compiling DynFlags is jolly slow In-Reply-To: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> References: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> Message-ID: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> #7258: Compiling DynFlags is jolly slow -------------------------------------+------------------------------------- Reporter: simonpj | Owner: simonpj Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.6.1 Resolution: | Keywords: deriving-perf 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 tdammers): * Attachment "examples.zip" removed. Code examples for the large records performance plot -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 24 11:25:07 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 24 Oct 2017 11:25:07 -0000 Subject: [GHC] #7258: Compiling DynFlags is jolly slow In-Reply-To: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> References: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> Message-ID: <061.a1778bd7f7b86506dd67f9f423e02611@haskell.org> #7258: Compiling DynFlags is jolly slow -------------------------------------+------------------------------------- Reporter: simonpj | Owner: simonpj Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.6.1 Resolution: | Keywords: deriving-perf 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 tdammers): * Attachment "examples.zip" added. Code examples for the large records performance plot -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 24 12:38:18 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 24 Oct 2017 12:38:18 -0000 Subject: [GHC] #14377: some results not expected with the addition In-Reply-To: <044.b2ada1f8b8e39ba20773f6a6e815abcd@haskell.org> References: <044.b2ada1f8b8e39ba20773f6a6e815abcd@haskell.org> Message-ID: <059.2863c8c4fd6abe1e038de2acd2f4a8f2@haskell.org> #14377: some results not expected with the addition -------------------------------------+------------------------------------- Reporter: vanto | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: invalid | 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 vanto): * status: new => closed * resolution: => invalid Comment: I close this ticket permanently. the bug persists. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 24 12:59:49 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 24 Oct 2017 12:59:49 -0000 Subject: [GHC] #14384: real numbers, digits after the decimal point - digits of precision In-Reply-To: <044.8e6149b05869bc4131752d14bf9bb9d7@haskell.org> References: <044.8e6149b05869bc4131752d14bf9bb9d7@haskell.org> Message-ID: <059.aa7b6cc1c6f28279ea82e90f05ece9e6@haskell.org> #14384: real numbers, digits after the decimal point - digits of precision -------------------------------------+------------------------------------- Reporter: vanto | Owner: (none) Type: feature request | Status: closed Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 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: | -------------------------------------+------------------------------------- Comment (by vanto): It's not the same thing as in the Ada language. Thank you for the demonstration. But do not think I am looking for help in the ticket. By the way, I take the opportunity to say that I knew how to answer your question.(comment3) - Book "Thinking Functionally with Haskell" Professor Richard Bird , Page 41 Exercise H. See read and show.\\ I am new, however, I acquire little by little new knowledge coming from books that I read. This ticket will remain permanently closed. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 24 14:26:17 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 24 Oct 2017 14:26:17 -0000 Subject: [GHC] #7258: Compiling DynFlags is jolly slow In-Reply-To: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> References: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> Message-ID: <061.698dc1d28b6b37d5eca8ebb123d6b308@haskell.org> #7258: Compiling DynFlags is jolly slow -------------------------------------+------------------------------------- Reporter: simonpj | Owner: simonpj Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.6.1 Resolution: | Keywords: deriving-perf 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): So apparently, good shape (linear-ish performance): {{{ D <$> a1 <*> a2 <*> a2 <*> ... <*> aN }}} Bad shape (exponential-ish performance): {{{ do v1 <- a1 v2 <- a2 v3 <- a3 ... vN <- aN return $ D v1 v2 v3 ... vN }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 24 14:32:45 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 24 Oct 2017 14:32:45 -0000 Subject: [GHC] #7258: Compiling DynFlags is jolly slow In-Reply-To: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> References: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> Message-ID: <061.dd51ec6de7a2be44e24e8f681e2c5c6f@haskell.org> #7258: Compiling DynFlags is jolly slow -------------------------------------+------------------------------------- Reporter: simonpj | Owner: simonpj Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.6.1 Resolution: | Keywords: deriving-perf 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): Core for monadic-bind style Read instance: {{{ [1 of 1] Compiling D ( examples/t-10-read.hs, examples/t-10-read.o ) ==================== Tidy Core ==================== Result size of Tidy Core = {terms: 373, types: 324, coercions: 0} -- RHS size: {terms: 269, types: 160, coercions: 0} $creadPrec_r1Hl $creadPrec_r1Hl = parens (prec (I# 11#) (>> $fMonadReadPrec (expectP (Ident (unpackCString# "DT"#))) (>> $fMonadReadPrec (expectP (Punc (unpackCString# "{"#))) (>> $fMonadReadPrec (expectP (Ident (unpackCString# "field0"#))) (>> $fMonadReadPrec (expectP (Punc (unpackCString# "="#))) (>>= $fMonadReadPrec (reset (readPrec $fReadInt)) (\ a1_a1tq -> >> $fMonadReadPrec (expectP (Punc (unpackCString# ","#))) (>> $fMonadReadPrec (expectP (Ident (unpackCString# "field2"#))) (>> $fMonadReadPrec (expectP (Punc (unpackCString# "="#))) (>>= $fMonadReadPrec (reset (readPrec $fReadInt)) (\ a2_a1tr -> >> $fMonadReadPrec (expectP (Punc (unpackCString# ","#))) (>> $fMonadReadPrec (expectP (Ident (unpackCString# "field3"#))) (>> $fMonadReadPrec (expectP (Punc (unpackCString# "="#))) (>>= $fMonadReadPrec (reset (readPrec $fReadInt)) (\ a3_a1ts -> >> $fMonadReadPrec (expectP (Punc (unpackCString# ","#))) (>> $fMonadReadPrec (expectP (Ident (unpackCString# "field4"#))) (>> $fMonadReadPrec (expectP (Punc (unpackCString# "="#))) (>>= $fMonadReadPrec (reset (readPrec $fReadInt)) (\ a4_a1tt -> >> $fMonadReadPrec (expectP (Punc (unpackCString# ","#))) (>> $fMonadReadPrec (expectP (Ident (unpackCString# "field5"#))) (>> $fMonadReadPrec (expectP (Punc (unpackCString# "="#))) (>>= $fMonadReadPrec (reset (readPrec $fReadInt)) (\ a5_a1tu -> >> $fMonadReadPrec (expectP (Punc (unpackCString# ","#))) (>> $fMonadReadPrec (expectP (Ident (unpackCString# "field6"#))) (>> $fMonadReadPrec (expectP (Punc (unpackCString# "="#))) (>>= $fMonadReadPrec (reset (readPrec $fReadInt)) (\ a6_a1tv -> >> $fMonadReadPrec (expectP (Punc (unpackCString# ","#))) (>> $fMonadReadPrec (expectP (Ident (unpackCString# "field7"#))) (>> $fMonadReadPrec (expectP (Punc (unpackCString# "="#))) (>>= $fMonadReadPrec (reset (readPrec $fReadInt)) (\ a7_a1tw -> >> $fMonadReadPrec (expectP (Punc (unpackCString# ","#))) (>> $fMonadReadPrec (expectP (Ident (unpackCString# "field8"#))) (>> $fMonadReadPrec (expectP (Punc (unpackCString# "="#))) (>>= $fMonadReadPrec (reset (readPrec $fReadInt)) (\ a8_a1tx -> >> $fMonadReadPrec (expectP (Punc (unpackCString# ","#))) (>> $fMonadReadPrec (expectP (Ident (unpackCString# "field9"#))) (>> $fMonadReadPrec (expectP (Punc (unpackCString# "="#))) (>>= $fMonadReadPrec (reset (readPrec $fReadInt)) (\ a9_a1ty -> >> $fMonadReadPrec (expectP (Punc (unpackCString# ","#))) (>> $fMonadReadPrec (expectP (Ident (unpackCString# "field10"#))) (>> $fMonadReadPrec (expectP (Punc (unpackCString# "="#))) (>>= $fMonadReadPrec (reset (readPrec $fReadInt)) (\ a10_a1tz -> >> $fMonadReadPrec (expectP (Punc (unpackCString# "}"#))) (return $fMonadReadPrec (DT a1_a1tq a2_a1tr a3_a1ts a4_a1tt a5_a1tu a6_a1tv a7_a1tw a8_a1tx a9_a1ty a10_a1tz))))))))))))))))))))))))))))))))))))))))))))) Rec { -- RHS size: {terms: 5, types: 1, coercions: 0} $fReadDT $fReadDT = C:Read $creadsPrec_r1I5 $creadList_r1I6 $creadPrec_r1Hl $creadListPrec_r1I7 -- RHS size: {terms: 2, types: 1, coercions: 0} $creadsPrec_r1I5 $creadsPrec_r1I5 = $dmreadsPrec $fReadDT -- RHS size: {terms: 2, types: 1, coercions: 0} $creadList_r1I6 $creadList_r1I6 = readListDefault $fReadDT -- RHS size: {terms: 2, types: 1, coercions: 0} $creadListPrec_r1I7 $creadListPrec_r1I7 = readListPrecDefault $fReadDT end Rec } -- RHS size: {terms: 5, types: 12, coercions: 0} field9 field9 = \ ds_d1H8 -> case ds_d1H8 of _ { DT ds1_d1H9 ds2_d1Ha ds3_d1Hb ds4_d1Hc ds5_d1Hd ds6_d1He ds7_d1Hf ds8_d1Hg ds9_d1Hh ds10_d1Hi -> ds9_d1Hh } -- RHS size: {terms: 5, types: 12, coercions: 0} field8 field8 = \ ds_d1GX -> case ds_d1GX of _ { DT ds1_d1GY ds2_d1GZ ds3_d1H0 ds4_d1H1 ds5_d1H2 ds6_d1H3 ds7_d1H4 ds8_d1H5 ds9_d1H6 ds10_d1H7 -> ds8_d1H5 } -- RHS size: {terms: 5, types: 12, coercions: 0} field7 field7 = \ ds_d1GM -> case ds_d1GM of _ { DT ds1_d1GN ds2_d1GO ds3_d1GP ds4_d1GQ ds5_d1GR ds6_d1GS ds7_d1GT ds8_d1GU ds9_d1GV ds10_d1GW -> ds7_d1GT } -- RHS size: {terms: 5, types: 12, coercions: 0} field6 field6 = \ ds_d1GB -> case ds_d1GB of _ { DT ds1_d1GC ds2_d1GD ds3_d1GE ds4_d1GF ds5_d1GG ds6_d1GH ds7_d1GI ds8_d1GJ ds9_d1GK ds10_d1GL -> ds6_d1GH } -- RHS size: {terms: 5, types: 12, coercions: 0} field5 field5 = \ ds_d1Gq -> case ds_d1Gq of _ { DT ds1_d1Gr ds2_d1Gs ds3_d1Gt ds4_d1Gu ds5_d1Gv ds6_d1Gw ds7_d1Gx ds8_d1Gy ds9_d1Gz ds10_d1GA -> ds5_d1Gv } -- RHS size: {terms: 5, types: 12, coercions: 0} field4 field4 = \ ds_d1Gf -> case ds_d1Gf of _ { DT ds1_d1Gg ds2_d1Gh ds3_d1Gi ds4_d1Gj ds5_d1Gk ds6_d1Gl ds7_d1Gm ds8_d1Gn ds9_d1Go ds10_d1Gp -> ds4_d1Gj } -- RHS size: {terms: 5, types: 12, coercions: 0} field3 field3 = \ ds_d1G4 -> case ds_d1G4 of _ { DT ds1_d1G5 ds2_d1G6 ds3_d1G7 ds4_d1G8 ds5_d1G9 ds6_d1Ga ds7_d1Gb ds8_d1Gc ds9_d1Gd ds10_d1Ge -> ds3_d1G7 } -- RHS size: {terms: 5, types: 12, coercions: 0} field2 field2 = \ ds_d1FT -> case ds_d1FT of _ { DT ds1_d1FU ds2_d1FV ds3_d1FW ds4_d1FX ds5_d1FY ds6_d1FZ ds7_d1G0 ds8_d1G1 ds9_d1G2 ds10_d1G3 -> ds2_d1FV } -- RHS size: {terms: 5, types: 12, coercions: 0} field10 field10 = \ ds_d1FI -> case ds_d1FI of _ { DT ds1_d1FJ ds2_d1FK ds3_d1FL ds4_d1FM ds5_d1FN ds6_d1FO ds7_d1FP ds8_d1FQ ds9_d1FR ds10_d1FS -> ds10_d1FS } -- RHS size: {terms: 5, types: 12, coercions: 0} field0 field0 = \ ds_d1Fx -> case ds_d1Fx of _ { DT ds1_d1Fy ds2_d1Fz ds3_d1FA ds4_d1FB ds5_d1FC ds6_d1FD ds7_d1FE ds8_d1FF ds9_d1FG ds10_d1FH -> ds1_d1Fy } -- RHS size: {terms: 2, types: 0, coercions: 0} $trModule1_r1I8 $trModule1_r1I8 = TrNameS "main"# -- RHS size: {terms: 2, types: 0, coercions: 0} $trModule2_r1I9 $trModule2_r1I9 = TrNameS "D"# -- RHS size: {terms: 3, types: 0, coercions: 0} $trModule $trModule = Module $trModule1_r1I8 $trModule2_r1I9 -- RHS size: {terms: 2, types: 0, coercions: 0} $tc'DT1_r1Ia $tc'DT1_r1Ia = TrNameS "'DT"# -- RHS size: {terms: 5, types: 0, coercions: 0} $tc'DT $tc'DT = TyCon 9521127001609462311## 17424978011088396301## $trModule $tc'DT1_r1Ia -- RHS size: {terms: 2, types: 0, coercions: 0} $tcDT1_r1Ib $tcDT1_r1Ib = TrNameS "DT"# -- RHS size: {terms: 5, types: 0, coercions: 0} $tcDT $tcDT = TyCon 14693474152448962618## 5168028270650093369## $trModule $tcDT1_r1Ib }}} And for applicative-style Read implementation: {{{ [1 of 1] Compiling D ( examples/t-10-read-appl.hs, examples/t-10-read-appl.o ) ==================== Tidy Core ==================== Result size of Tidy Core = {terms: 272, types: 324, coercions: 0} -- RHS size: {terms: 168, types: 160, coercions: 0} $creadsPrec_r1Gi $creadsPrec_r1Gi = \ p_aNu -> readP_to_S (<* $fApplicativeReadP (*> $fApplicativeReadP (string (unpackCString# "DT{"#)) (<*> $fApplicativeReadP (<*> $fApplicativeReadP (<*> $fApplicativeReadP (<*> $fApplicativeReadP (<*> $fApplicativeReadP (<*> $fApplicativeReadP (<*> $fApplicativeReadP (<*> $fApplicativeReadP (<*> $fApplicativeReadP (<$> $fFunctorReadP DT (*> $fApplicativeReadP (string (unpackCString# "field0="#)) (readS_to_P (readsPrec $fReadInt p_aNu)))) (*> $fApplicativeReadP (string (unpackCString# ","#)) (*> $fApplicativeReadP (string (unpackCString# "field1="#)) (readS_to_P (readsPrec $fReadInt p_aNu))))) (*> $fApplicativeReadP (string (unpackCString# ","#)) (*> $fApplicativeReadP (string (unpackCString# "field2="#)) (readS_to_P (readsPrec $fReadInt p_aNu))))) (*> $fApplicativeReadP (string (unpackCString# ","#)) (*> $fApplicativeReadP (string (unpackCString# "field3="#)) (readS_to_P (readsPrec $fReadInt p_aNu))))) (*> $fApplicativeReadP (string (unpackCString# ","#)) (*> $fApplicativeReadP (string (unpackCString# "field4="#)) (readS_to_P (readsPrec $fReadInt p_aNu))))) (*> $fApplicativeReadP (string (unpackCString# ","#)) (*> $fApplicativeReadP (string (unpackCString# "field5="#)) (readS_to_P (readsPrec $fReadInt p_aNu))))) (*> $fApplicativeReadP (string (unpackCString# ","#)) (*> $fApplicativeReadP (string (unpackCString# "field6="#)) (readS_to_P (readsPrec $fReadInt p_aNu))))) (*> $fApplicativeReadP (string (unpackCString# ","#)) (*> $fApplicativeReadP (string (unpackCString# "field7="#)) (readS_to_P (readsPrec $fReadInt p_aNu))))) (*> $fApplicativeReadP (string (unpackCString# ","#)) (*> $fApplicativeReadP (string (unpackCString# "field8="#)) (readS_to_P (readsPrec $fReadInt p_aNu))))) (*> $fApplicativeReadP (string (unpackCString# ","#)) (*> $fApplicativeReadP (string (unpackCString# "field9="#)) (readS_to_P (readsPrec $fReadInt p_aNu)))))) (string (unpackCString# "}"#))) Rec { -- RHS size: {terms: 5, types: 1, coercions: 0} $fReadDT $fReadDT = C:Read $creadsPrec_r1Gi $creadList_r1GT $creadPrec_r1GU $creadListPrec_r1GV -- RHS size: {terms: 2, types: 1, coercions: 0} $creadList_r1GT $creadList_r1GT = $dmreadList $fReadDT -- RHS size: {terms: 2, types: 1, coercions: 0} $creadPrec_r1GU $creadPrec_r1GU = $dmreadPrec $fReadDT -- RHS size: {terms: 2, types: 1, coercions: 0} $creadListPrec_r1GV $creadListPrec_r1GV = $dmreadListPrec $fReadDT end Rec } -- RHS size: {terms: 5, types: 12, coercions: 0} field9 field9 = \ ds_d1G5 -> case ds_d1G5 of _ { DT ds1_d1G6 ds2_d1G7 ds3_d1G8 ds4_d1G9 ds5_d1Ga ds6_d1Gb ds7_d1Gc ds8_d1Gd ds9_d1Ge ds10_d1Gf -> ds9_d1Ge } -- RHS size: {terms: 5, types: 12, coercions: 0} field8 field8 = \ ds_d1FU -> case ds_d1FU of _ { DT ds1_d1FV ds2_d1FW ds3_d1FX ds4_d1FY ds5_d1FZ ds6_d1G0 ds7_d1G1 ds8_d1G2 ds9_d1G3 ds10_d1G4 -> ds8_d1G2 } -- RHS size: {terms: 5, types: 12, coercions: 0} field7 field7 = \ ds_d1FJ -> case ds_d1FJ of _ { DT ds1_d1FK ds2_d1FL ds3_d1FM ds4_d1FN ds5_d1FO ds6_d1FP ds7_d1FQ ds8_d1FR ds9_d1FS ds10_d1FT -> ds7_d1FQ } -- RHS size: {terms: 5, types: 12, coercions: 0} field6 field6 = \ ds_d1Fy -> case ds_d1Fy of _ { DT ds1_d1Fz ds2_d1FA ds3_d1FB ds4_d1FC ds5_d1FD ds6_d1FE ds7_d1FF ds8_d1FG ds9_d1FH ds10_d1FI -> ds6_d1FE } -- RHS size: {terms: 5, types: 12, coercions: 0} field5 field5 = \ ds_d1Fn -> case ds_d1Fn of _ { DT ds1_d1Fo ds2_d1Fp ds3_d1Fq ds4_d1Fr ds5_d1Fs ds6_d1Ft ds7_d1Fu ds8_d1Fv ds9_d1Fw ds10_d1Fx -> ds5_d1Fs } -- RHS size: {terms: 5, types: 12, coercions: 0} field4 field4 = \ ds_d1Fc -> case ds_d1Fc of _ { DT ds1_d1Fd ds2_d1Fe ds3_d1Ff ds4_d1Fg ds5_d1Fh ds6_d1Fi ds7_d1Fj ds8_d1Fk ds9_d1Fl ds10_d1Fm -> ds4_d1Fg } -- RHS size: {terms: 5, types: 12, coercions: 0} field3 field3 = \ ds_d1F1 -> case ds_d1F1 of _ { DT ds1_d1F2 ds2_d1F3 ds3_d1F4 ds4_d1F5 ds5_d1F6 ds6_d1F7 ds7_d1F8 ds8_d1F9 ds9_d1Fa ds10_d1Fb -> ds3_d1F4 } -- RHS size: {terms: 5, types: 12, coercions: 0} field2 field2 = \ ds_d1EQ -> case ds_d1EQ of _ { DT ds1_d1ER ds2_d1ES ds3_d1ET ds4_d1EU ds5_d1EV ds6_d1EW ds7_d1EX ds8_d1EY ds9_d1EZ ds10_d1F0 -> ds2_d1ES } -- RHS size: {terms: 5, types: 12, coercions: 0} field10 field10 = \ ds_d1EF -> case ds_d1EF of _ { DT ds1_d1EG ds2_d1EH ds3_d1EI ds4_d1EJ ds5_d1EK ds6_d1EL ds7_d1EM ds8_d1EN ds9_d1EO ds10_d1EP -> ds10_d1EP } -- RHS size: {terms: 5, types: 12, coercions: 0} field0 field0 = \ ds_d1Eu -> case ds_d1Eu of _ { DT ds1_d1Ev ds2_d1Ew ds3_d1Ex ds4_d1Ey ds5_d1Ez ds6_d1EA ds7_d1EB ds8_d1EC ds9_d1ED ds10_d1EE -> ds1_d1Ev } -- RHS size: {terms: 2, types: 0, coercions: 0} $trModule1_r1GW $trModule1_r1GW = TrNameS "main"# -- RHS size: {terms: 2, types: 0, coercions: 0} $trModule2_r1GX $trModule2_r1GX = TrNameS "D"# -- RHS size: {terms: 3, types: 0, coercions: 0} $trModule $trModule = Module $trModule1_r1GW $trModule2_r1GX -- RHS size: {terms: 2, types: 0, coercions: 0} $tc'DT1_r1GY $tc'DT1_r1GY = TrNameS "'DT"# -- RHS size: {terms: 5, types: 0, coercions: 0} $tc'DT $tc'DT = TyCon 9521127001609462311## 17424978011088396301## $trModule $tc'DT1_r1GY -- RHS size: {terms: 2, types: 0, coercions: 0} $tcDT1_r1GZ $tcDT1_r1GZ = TrNameS "DT"# -- RHS size: {terms: 5, types: 0, coercions: 0} $tcDT $tcDT = TyCon 14693474152448962618## 5168028270650093369## $trModule $tcDT1_r1GZ }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 24 14:37:35 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 24 Oct 2017 14:37:35 -0000 Subject: [GHC] #7258: Compiling DynFlags is jolly slow In-Reply-To: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> References: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> Message-ID: <061.4e84d702cc513003b647eb431702e12b@haskell.org> #7258: Compiling DynFlags is jolly slow -------------------------------------+------------------------------------- Reporter: simonpj | Owner: simonpj Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.6.1 Resolution: | Keywords: deriving-perf 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): getLine examples: monadic-bind style: {{{ [1 of 1] Compiling D ( examples/t-10-getline.hs, examples/t-10-getline.o ) ==================== Tidy Core ==================== Result size of Tidy Core = {terms: 182, types: 231, coercions: 0} -- RHS size: {terms: 5, types: 12, coercions: 0} field10 field10 = \ ds_d1JC -> case ds_d1JC of _ { DT ds1_d1JD ds2_d1JE ds3_d1JF ds4_d1JG ds5_d1JH ds6_d1JI ds7_d1JJ ds8_d1JK ds9_d1JL ds10_d1JM -> ds10_d1JM } -- RHS size: {terms: 5, types: 12, coercions: 0} field9 field9 = \ ds_d1Jr -> case ds_d1Jr of _ { DT ds1_d1Js ds2_d1Jt ds3_d1Ju ds4_d1Jv ds5_d1Jw ds6_d1Jx ds7_d1Jy ds8_d1Jz ds9_d1JA ds10_d1JB -> ds9_d1JA } -- RHS size: {terms: 5, types: 12, coercions: 0} field8 field8 = \ ds_d1Jg -> case ds_d1Jg of _ { DT ds1_d1Jh ds2_d1Ji ds3_d1Jj ds4_d1Jk ds5_d1Jl ds6_d1Jm ds7_d1Jn ds8_d1Jo ds9_d1Jp ds10_d1Jq -> ds8_d1Jo } -- RHS size: {terms: 5, types: 12, coercions: 0} field7 field7 = \ ds_d1J5 -> case ds_d1J5 of _ { DT ds1_d1J6 ds2_d1J7 ds3_d1J8 ds4_d1J9 ds5_d1Ja ds6_d1Jb ds7_d1Jc ds8_d1Jd ds9_d1Je ds10_d1Jf -> ds7_d1Jc } -- RHS size: {terms: 5, types: 12, coercions: 0} field6 field6 = \ ds_d1IU -> case ds_d1IU of _ { DT ds1_d1IV ds2_d1IW ds3_d1IX ds4_d1IY ds5_d1IZ ds6_d1J0 ds7_d1J1 ds8_d1J2 ds9_d1J3 ds10_d1J4 -> ds6_d1J0 } -- RHS size: {terms: 5, types: 12, coercions: 0} field5 field5 = \ ds_d1IJ -> case ds_d1IJ of _ { DT ds1_d1IK ds2_d1IL ds3_d1IM ds4_d1IN ds5_d1IO ds6_d1IP ds7_d1IQ ds8_d1IR ds9_d1IS ds10_d1IT -> ds5_d1IO } -- RHS size: {terms: 5, types: 12, coercions: 0} field4 field4 = \ ds_d1Iy -> case ds_d1Iy of _ { DT ds1_d1Iz ds2_d1IA ds3_d1IB ds4_d1IC ds5_d1ID ds6_d1IE ds7_d1IF ds8_d1IG ds9_d1IH ds10_d1II -> ds4_d1IC } -- RHS size: {terms: 5, types: 12, coercions: 0} field3 field3 = \ ds_d1In -> case ds_d1In of _ { DT ds1_d1Io ds2_d1Ip ds3_d1Iq ds4_d1Ir ds5_d1Is ds6_d1It ds7_d1Iu ds8_d1Iv ds9_d1Iw ds10_d1Ix -> ds3_d1Iq } -- RHS size: {terms: 5, types: 12, coercions: 0} field2 field2 = \ ds_d1Ic -> case ds_d1Ic of _ { DT ds1_d1Id ds2_d1Ie ds3_d1If ds4_d1Ig ds5_d1Ih ds6_d1Ii ds7_d1Ij ds8_d1Ik ds9_d1Il ds10_d1Im -> ds2_d1Ie } -- RHS size: {terms: 5, types: 12, coercions: 0} field0 field0 = \ ds_d1I1 -> case ds_d1I1 of _ { DT ds1_d1I2 ds2_d1I3 ds3_d1I4 ds4_d1I5 ds5_d1I6 ds6_d1I7 ds7_d1I8 ds8_d1I9 ds9_d1Ia ds10_d1Ib -> ds1_d1I2 } -- RHS size: {terms: 2, types: 0, coercions: 0} $trModule1_r1EM $trModule1_r1EM = TrNameS "main"# -- RHS size: {terms: 2, types: 0, coercions: 0} $trModule2_r1Ke $trModule2_r1Ke = TrNameS "D"# -- RHS size: {terms: 3, types: 0, coercions: 0} $trModule $trModule = Module $trModule1_r1EM $trModule2_r1Ke -- RHS size: {terms: 2, types: 0, coercions: 0} $tc'DT1_r1Kf $tc'DT1_r1Kf = TrNameS "'DT"# -- RHS size: {terms: 5, types: 0, coercions: 0} $tc'DT $tc'DT = TyCon 9521127001609462311## 17424978011088396301## $trModule $tc'DT1_r1Kf -- RHS size: {terms: 2, types: 0, coercions: 0} $tcDT1_r1Kg $tcDT1_r1Kg = TrNameS "DT"# -- RHS size: {terms: 5, types: 0, coercions: 0} $tcDT $tcDT = TyCon 14693474152448962618## 5168028270650093369## $trModule $tcDT1_r1Kg -- RHS size: {terms: 93, types: 82, coercions: 0} getlD getlD = >>= $fMonadIO (<$> $fFunctorIO (read $fReadInt) getLine) (\ field1_aGE -> >>= $fMonadIO (<$> $fFunctorIO (read $fReadInt) getLine) (\ field12_aGF -> >>= $fMonadIO (<$> $fFunctorIO (read $fReadInt) getLine) (\ field13_aGG -> >>= $fMonadIO (<$> $fFunctorIO (read $fReadInt) getLine) (\ field14_aGH -> >>= $fMonadIO (<$> $fFunctorIO (read $fReadInt) getLine) (\ field15_aGI -> >>= $fMonadIO (<$> $fFunctorIO (read $fReadInt) getLine) (\ field16_aGJ -> >>= $fMonadIO (<$> $fFunctorIO (read $fReadInt) getLine) (\ field17_aGK -> >>= $fMonadIO (<$> $fFunctorIO (read $fReadInt) getLine) (\ field18_aGL -> >>= $fMonadIO (<$> $fFunctorIO (read $fReadInt) getLine) (\ field19_aGM -> >>= $fMonadIO (<$> $fFunctorIO (read $fReadInt) getLine) (\ field20_aGN -> return $fMonadIO (DT field1_aGE field12_aGF field13_aGG field14_aGH field15_aGI field16_aGJ field17_aGK field18_aGL field19_aGM field20_aGN))))))))))) }}} vs. applicative: {{{ [1 of 1] Compiling D ( examples/t-10-getline-appl.hs, examples/t-10-getline-appl.o ) ==================== Tidy Core ==================== Result size of Tidy Core = {terms: 160, types: 264, coercions: 0} -- RHS size: {terms: 5, types: 12, coercions: 0} field10 field10 = \ ds_d1Je -> case ds_d1Je of _ { DT ds1_d1Jf ds2_d1Jg ds3_d1Jh ds4_d1Ji ds5_d1Jj ds6_d1Jk ds7_d1Jl ds8_d1Jm ds9_d1Jn ds10_d1Jo -> ds10_d1Jo } -- RHS size: {terms: 5, types: 12, coercions: 0} field9 field9 = \ ds_d1J3 -> case ds_d1J3 of _ { DT ds1_d1J4 ds2_d1J5 ds3_d1J6 ds4_d1J7 ds5_d1J8 ds6_d1J9 ds7_d1Ja ds8_d1Jb ds9_d1Jc ds10_d1Jd -> ds9_d1Jc } -- RHS size: {terms: 5, types: 12, coercions: 0} field8 field8 = \ ds_d1IS -> case ds_d1IS of _ { DT ds1_d1IT ds2_d1IU ds3_d1IV ds4_d1IW ds5_d1IX ds6_d1IY ds7_d1IZ ds8_d1J0 ds9_d1J1 ds10_d1J2 -> ds8_d1J0 } -- RHS size: {terms: 5, types: 12, coercions: 0} field7 field7 = \ ds_d1IH -> case ds_d1IH of _ { DT ds1_d1II ds2_d1IJ ds3_d1IK ds4_d1IL ds5_d1IM ds6_d1IN ds7_d1IO ds8_d1IP ds9_d1IQ ds10_d1IR -> ds7_d1IO } -- RHS size: {terms: 5, types: 12, coercions: 0} field6 field6 = \ ds_d1Iw -> case ds_d1Iw of _ { DT ds1_d1Ix ds2_d1Iy ds3_d1Iz ds4_d1IA ds5_d1IB ds6_d1IC ds7_d1ID ds8_d1IE ds9_d1IF ds10_d1IG -> ds6_d1IC } -- RHS size: {terms: 5, types: 12, coercions: 0} field5 field5 = \ ds_d1Il -> case ds_d1Il of _ { DT ds1_d1Im ds2_d1In ds3_d1Io ds4_d1Ip ds5_d1Iq ds6_d1Ir ds7_d1Is ds8_d1It ds9_d1Iu ds10_d1Iv -> ds5_d1Iq } -- RHS size: {terms: 5, types: 12, coercions: 0} field4 field4 = \ ds_d1Ia -> case ds_d1Ia of _ { DT ds1_d1Ib ds2_d1Ic ds3_d1Id ds4_d1Ie ds5_d1If ds6_d1Ig ds7_d1Ih ds8_d1Ii ds9_d1Ij ds10_d1Ik -> ds4_d1Ie } -- RHS size: {terms: 5, types: 12, coercions: 0} field3 field3 = \ ds_d1HZ -> case ds_d1HZ of _ { DT ds1_d1I0 ds2_d1I1 ds3_d1I2 ds4_d1I3 ds5_d1I4 ds6_d1I5 ds7_d1I6 ds8_d1I7 ds9_d1I8 ds10_d1I9 -> ds3_d1I2 } -- RHS size: {terms: 5, types: 12, coercions: 0} field2 field2 = \ ds_d1HO -> case ds_d1HO of _ { DT ds1_d1HP ds2_d1HQ ds3_d1HR ds4_d1HS ds5_d1HT ds6_d1HU ds7_d1HV ds8_d1HW ds9_d1HX ds10_d1HY -> ds2_d1HQ } -- RHS size: {terms: 5, types: 12, coercions: 0} field0 field0 = \ ds_d1HD -> case ds_d1HD of _ { DT ds1_d1HE ds2_d1HF ds3_d1HG ds4_d1HH ds5_d1HI ds6_d1HJ ds7_d1HK ds8_d1HL ds9_d1HM ds10_d1HN -> ds1_d1HE } -- RHS size: {terms: 2, types: 0, coercions: 0} $trModule1_r1Ey $trModule1_r1Ey = TrNameS "main"# -- RHS size: {terms: 2, types: 0, coercions: 0} $trModule2_r1JQ $trModule2_r1JQ = TrNameS "D"# -- RHS size: {terms: 3, types: 0, coercions: 0} $trModule $trModule = Module $trModule1_r1Ey $trModule2_r1JQ -- RHS size: {terms: 2, types: 0, coercions: 0} $tc'DT1_r1JR $tc'DT1_r1JR = TrNameS "'DT"# -- RHS size: {terms: 5, types: 0, coercions: 0} $tc'DT $tc'DT = TyCon 9521127001609462311## 17424978011088396301## $trModule $tc'DT1_r1JR -- RHS size: {terms: 2, types: 0, coercions: 0} $tcDT1_r1JS $tcDT1_r1JS = TrNameS "DT"# -- RHS size: {terms: 5, types: 0, coercions: 0} $tcDT $tcDT = TyCon 14693474152448962618## 5168028270650093369## $trModule $tcDT1_r1JS -- RHS size: {terms: 71, types: 115, coercions: 0} getlD getlD = <*> $fApplicativeIO (<*> $fApplicativeIO (<*> $fApplicativeIO (<*> $fApplicativeIO (<*> $fApplicativeIO (<*> $fApplicativeIO (<*> $fApplicativeIO (<*> $fApplicativeIO (<*> $fApplicativeIO (<$> $fFunctorIO DT (<$> $fFunctorIO (read $fReadInt) getLine)) (<$> $fFunctorIO (read $fReadInt) getLine)) (<$> $fFunctorIO (read $fReadInt) getLine)) (<$> $fFunctorIO (read $fReadInt) getLine)) (<$> $fFunctorIO (read $fReadInt) getLine)) (<$> $fFunctorIO (read $fReadInt) getLine)) (<$> $fFunctorIO (read $fReadInt) getLine)) (<$> $fFunctorIO (read $fReadInt) getLine)) (<$> $fFunctorIO (read $fReadInt) getLine)) (<$> $fFunctorIO (read $fReadInt) getLine) }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 24 14:44:00 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 24 Oct 2017 14:44:00 -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.ae98f449db5b515aa7c6ac8dd85f3a9c@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.2 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: | -------------------------------------+------------------------------------- Changes (by thoughtpolice): * owner: (none) => thoughtpolice * milestone: => 8.2.2 Comment: This issue is causing us a large amount of pain at work, and we're currently blocked on a major upgrade to GHC 8.2.1 because of it. So I'm going to be taking a look at fixing this later this week (at least "Part 1" and "Part 2" of the above proposal). For our case, we're using Nix to control and keep everything working, including GHC -- so we can limp by with approaches that aren't fully upstream-worthy for now, it's easy enough to apply a temporary patch. (I'll of course see it through until it lands in HEAD, just a fore-warning on immediate time constraints.) Ben, I'm tentatively marking this as slated for 8.2.2, although admittedly I don't know what its current schedule looks like. If it doesn't make it this isn't world-ending for us, but I imagine it would make several people happy anyway. Feel free to push it out if needed. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 24 15:36:20 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 24 Oct 2017 15:36:20 -0000 Subject: [GHC] #14385: Clarify error message when missing GADTs extension Message-ID: <044.e15073ad95f4a8ec466187fd8001a2b6@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 Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- If we write a GADT declaration and forget to enable `GADTs` we get the following error message: {{{ ww.hs:1:1: error: • Illegal generalised algebraic data declaration for ‘T’ (Use GADTs to allow GADTs) • In the data declaration for ‘T’ }}} It could be made more explicit for new users that the suggestion is to use the '''extension''' `GADTs`. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 24 16:18:16 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 24 Oct 2017 16:18:16 -0000 Subject: [GHC] #14382: The 'impossible' happened whilst installing gi-gtk via cabal In-Reply-To: <052.f9c10851d0906622baeb7996269cc8e7@haskell.org> References: <052.f9c10851d0906622baeb7996269cc8e7@haskell.org> Message-ID: <067.7a4c9d4323d2a2924d58db30639d1571@haskell.org> #14382: The 'impossible' happened whilst installing gi-gtk via cabal ----------------------------------+-------------------------------------- Reporter: maartenjacobs | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: | Keywords: gtk, pango Operating System: Linux | Architecture: x86_64 (amd64) Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | ----------------------------------+-------------------------------------- Comment (by bgamari): Sadly I am indeed able to reproduce this with 8.2.2. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 24 17:18:49 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 24 Oct 2017 17:18:49 -0000 Subject: [GHC] #14346: 8.2.1 regression: heap corruption after safe foreign calls In-Reply-To: <049.7a4af7d8399ac93444ea4b9211bf91ff@haskell.org> References: <049.7a4af7d8399ac93444ea4b9211bf91ff@haskell.org> Message-ID: <064.8988b64e50baf427d0822a00419adea8@haskell.org> #14346: 8.2.1 regression: heap corruption after safe foreign calls -------------------------------------+------------------------------------- Reporter: andrewchen | Owner: (none) Type: bug | Status: patch Priority: highest | Milestone: 8.4.1 Component: Runtime System | Version: 8.2.1 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 bgamari): * milestone: 8.2.2 => 8.4.1 Comment: Alright, I have marked `allocaBytes` and `allocaBytesAligned` as `NOINLINE` for 8.2.2. A more principled solution, in the form of #14375, coming in 8.4.1. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 24 17:20:34 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 24 Oct 2017 17:20:34 -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.aed4af4702dc5fc86120b379667e6168@haskell.org> #14331: Overzealous free-floating kind check causes deriving clause to be rejected -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: merge Priority: normal | Milestone: 8.2.2 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 bgamari): What is the conclusion here? Do we want to merge comment:10 to 8.2.2? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 24 18:08:23 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 24 Oct 2017 18:08:23 -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.7806ee9bc2b9e93d30497aaad7ba28b9@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: | -------------------------------------+------------------------------------- Changes (by bgamari): * differential: => Phab:D4122 Comment: Hmm, yes, I can see how this would be confusing. There are actually a number of errors referring to extensions which are confusing in much the same way. See Phab:D4122 for a quick fix. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 24 20:14:17 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 24 Oct 2017 20:14:17 -0000 Subject: [GHC] #12389: Limit duplicate export warnings for datatypes In-Reply-To: <045.b9512948fd651abba4c3deecd83cbcfe@haskell.org> References: <045.b9512948fd651abba4c3deecd83cbcfe@haskell.org> Message-ID: <060.8d6f090d1b217dba1eb27346b527e303@haskell.org> #12389: Limit duplicate export warnings for datatypes -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 7.10.3 Resolution: | Keywords: newcomer Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect | Unknown/Multiple warning at compile-time | Test Case: Blocked By: | Blocking: Related Tickets: #11959 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by parsonsmatt): I'm going to attempt a patch for this. By my first look, it should require a change to the `compiler/parser/Parser.y` Happy file, specifically the `qcnames` parse rule. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 24 20:31:27 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 24 Oct 2017 20:31:27 -0000 Subject: [GHC] #13604: ghci no longer loads dynamic .o files by default if they were built with -O In-Reply-To: <045.626a6b40d9101c93e2935653ef7e4668@haskell.org> References: <045.626a6b40d9101c93e2935653ef7e4668@haskell.org> Message-ID: <060.8ddf44b8203f1c024419bbd8850e22fd@haskell.org> #13604: ghci no longer loads dynamic .o files by default if they were built with -O -------------------------------------+------------------------------------- Reporter: George | Owner: dfeuer Type: bug | Status: patch Priority: highest | Milestone: 8.2.2 Component: Compiler | Version: 8.2.1-rc1 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): Phab:D4123 Wiki Page: | -------------------------------------+------------------------------------- Changes (by dfeuer): * status: new => patch * differential: Phab:D3514 => Phab:D4123 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 24 20:34:44 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 24 Oct 2017 20:34:44 -0000 Subject: [GHC] #13604: ghci no longer loads dynamic .o files by default if they were built with -O In-Reply-To: <045.626a6b40d9101c93e2935653ef7e4668@haskell.org> References: <045.626a6b40d9101c93e2935653ef7e4668@haskell.org> Message-ID: <060.815f7a1382ffe3924f41fc9569cc8a42@haskell.org> #13604: ghci no longer loads dynamic .o files by default if they were built with -O -------------------------------------+------------------------------------- Reporter: George | Owner: dfeuer Type: bug | Status: patch Priority: highest | Milestone: 8.2.2 Component: Compiler | Version: 8.2.1-rc1 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): Phab:D4123 Wiki Page: | -------------------------------------+------------------------------------- Comment (by dfeuer): It took me a bit to understand enough about how the fingerprinting process worked to do this right. I ''think'' the differential I just put up should fix the optimization issue. If others agree that's the right approach, it can easily be applied to `-fhpc` as well. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 24 20:39:02 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 24 Oct 2017 20:39:02 -0000 Subject: [GHC] #13604: ghci no longer loads dynamic .o files by default if they were built with -O In-Reply-To: <045.626a6b40d9101c93e2935653ef7e4668@haskell.org> References: <045.626a6b40d9101c93e2935653ef7e4668@haskell.org> Message-ID: <060.ea993464fcee51762a200a74829147bc@haskell.org> #13604: ghci no longer loads dynamic .o files by default if they were built with -O -------------------------------------+------------------------------------- Reporter: George | Owner: dfeuer Type: bug | Status: patch Priority: highest | Milestone: 8.2.2 Component: Compiler | Version: 8.2.1-rc1 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): Phab:D4123 Wiki Page: | -------------------------------------+------------------------------------- Comment (by George): So after this fix if I load a file compiled with -O2 into ghci will ghci just load it without recompiling it? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 24 20:45:03 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 24 Oct 2017 20:45:03 -0000 Subject: [GHC] #14375: Implement with# primop In-Reply-To: <046.d97bc36423b0cbcf2ececb77831c1a4a@haskell.org> References: <046.d97bc36423b0cbcf2ececb77831c1a4a@haskell.org> Message-ID: <061.deb881997ea7e5e9b27f02dec58552c9@haskell.org> #14375: Implement with# primop -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: | Keywords: JoinPoints Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #14346 | Differential Rev(s): ​Phab:D4110 Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonmar): * cc: simonmar (added) Comment: Yes, I think that would work. The mechanisms that we have in the code generator for pushing update frames should also work for pushing mask/unmask frames and catch frames. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 24 21:11:39 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 24 Oct 2017 21:11:39 -0000 Subject: [GHC] #13604: ghci no longer loads dynamic .o files by default if they were built with -O In-Reply-To: <045.626a6b40d9101c93e2935653ef7e4668@haskell.org> References: <045.626a6b40d9101c93e2935653ef7e4668@haskell.org> Message-ID: <060.8d9664c6d8bd53b497336caf92e578d0@haskell.org> #13604: ghci no longer loads dynamic .o files by default if they were built with -O -------------------------------------+------------------------------------- Reporter: George | Owner: dfeuer Type: bug | Status: patch Priority: highest | Milestone: 8.2.2 Component: Compiler | Version: 8.2.1-rc1 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): Phab:D4123 Wiki Page: | -------------------------------------+------------------------------------- Comment (by dfeuer): Replying to [comment:38 George]: > So after this fix if I load a file compiled with -O2 into ghci will ghci just load it without recompiling it? After this fix, you'll be able to load a compiled module (including one compiled with `-O` or `-O2`) into GHCi without recompiling it if nothing substantial has changed (e.g., source files) and both of the following are true: 1. The file was compiled with `-dynamic` 2. GHCi is run with `-fignore-optim-changes` The latter tells GHC that a file shouldn't be recompiled just because an "optimization flag" has changed. That's a bit of a fuzzy designation, but it includes all the flags included in `-O2` and several others as well. The one that might be most surprising is `-fignore-asserts`. If we need to add additional flags in the future to refine the way we handle such, we can consider it. Will this let you do what you need? I intend to do something similar for HPC, but I haven't yet. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 24 21:13:37 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 24 Oct 2017 21:13:37 -0000 Subject: [GHC] #13604: ghci no longer loads dynamic .o files by default if they were built with -O In-Reply-To: <045.626a6b40d9101c93e2935653ef7e4668@haskell.org> References: <045.626a6b40d9101c93e2935653ef7e4668@haskell.org> Message-ID: <060.d640892917563f046e4683e676effa92@haskell.org> #13604: ghci no longer loads dynamic .o files by default if they were built with -O -------------------------------------+------------------------------------- Reporter: George | Owner: dfeuer Type: bug | Status: patch Priority: highest | Milestone: 8.2.2 Component: Compiler | Version: 8.2.1-rc1 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): Phab:D4123 Wiki Page: | -------------------------------------+------------------------------------- Comment (by elaforge): It feels like an odd approach. The situation implied by -fignore-optim- changes is that I'm not passing the same flags, but I want to load '.o's anyway. But from my point of view, I *am* passing the same flags, the problem is that ghci is filtering them out. So with that new flag, it becomes: pass the same flags, ghci filters out some making them not the same, pass another flag that says ignore when some flags are not the same. We'll need another flag that does the same thing for -fhpc (as you mention) and then possibly in the future some more to ignore any other symptoms of ghci filtering out flags. Doesn't it seem a bit convoluted? If I weren't following this thread, and ran into this problem, I'm not sure I'd be able to find all proper flags to get it to work. Compare that to making ghci no longer change the flags you pass, even if it can't implement them: it just works, no flags needed. You could add one to suppress the warning about "ignoring some of your flags" but we have some general verbosity level stuff already. That said, I am following this thread, so I will know about the flags, so they (once you put in one for -fhpc of course) will fix my problem. So aside from my worry that it seems overcomplicated, I'm in favor. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 24 21:24:44 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 24 Oct 2017 21:24:44 -0000 Subject: [GHC] #13604: ghci no longer loads dynamic .o files by default if they were built with -O In-Reply-To: <045.626a6b40d9101c93e2935653ef7e4668@haskell.org> References: <045.626a6b40d9101c93e2935653ef7e4668@haskell.org> Message-ID: <060.b600219934e84db2d8abd929c0879f9c@haskell.org> #13604: ghci no longer loads dynamic .o files by default if they were built with -O -------------------------------------+------------------------------------- Reporter: George | Owner: dfeuer Type: bug | Status: patch Priority: highest | Milestone: 8.2.2 Component: Compiler | Version: 8.2.1-rc1 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): Phab:D4123 Wiki Page: | -------------------------------------+------------------------------------- Comment (by dfeuer): elaforge, so you want GHCi to load everything with the optimization level you specify? The downside I see is that if you have a bunch of object code (for dependencies) but you want to be able to set breakpoints and such in the specific module you're working on right now, you're stuck; you'll have to load everything to get that module in interpreted mode. Or do you want to load the modules you list on the command line in interpreted mode and load object code for the dependencies? Or something else? I'm not sure exactly what else you want. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 24 21:27:20 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 24 Oct 2017 21:27:20 -0000 Subject: [GHC] #13604: ghci no longer loads dynamic .o files by default if they were built with -O In-Reply-To: <045.626a6b40d9101c93e2935653ef7e4668@haskell.org> References: <045.626a6b40d9101c93e2935653ef7e4668@haskell.org> Message-ID: <060.db28b18f275e31cdc28af331d3a785a6@haskell.org> #13604: ghci no longer loads dynamic .o files by default if they were built with -O -------------------------------------+------------------------------------- Reporter: George | Owner: dfeuer Type: bug | Status: patch Priority: highest | Milestone: 8.2.2 Component: Compiler | Version: 8.2.1-rc1 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): Phab:D4123 Wiki Page: | -------------------------------------+------------------------------------- Comment (by George): Replying to [comment:39 dfeuer]: > Replying to [comment:38 George]: > > So after this fix if I load a file compiled with -O2 into ghci will ghci just load it without recompiling it? > > After this fix, you'll be able to load a compiled module (including one compiled with `-O` or `-O2`) into GHCi without recompiling it if nothing substantial has changed (e.g., source files) and both of the following are true: > > 1. The file was compiled with `-dynamic` > 2. GHCi is run with `-fignore-optim-changes` > > The latter tells GHC that a file shouldn't be recompiled just because an "optimization flag" has changed. That's a bit of a fuzzy designation, but it includes all the flags included in `-O2` and several others as well. The one that might be most surprising is `-fignore-asserts`. If we need to add additional flags in the future to refine the way we handle such, we can consider it. > > Will this let you do what you need? Works perfectly for me. Thanks! > > I intend to do something similar for HPC, but I haven't yet. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 24 21:50:48 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 24 Oct 2017 21:50:48 -0000 Subject: [GHC] #13604: ghci no longer loads dynamic .o files by default if they were built with -O In-Reply-To: <045.626a6b40d9101c93e2935653ef7e4668@haskell.org> References: <045.626a6b40d9101c93e2935653ef7e4668@haskell.org> Message-ID: <060.70bef8529b6c9b7674c43f0f804a700e@haskell.org> #13604: ghci no longer loads dynamic .o files by default if they were built with -O -------------------------------------+------------------------------------- Reporter: George | Owner: dfeuer Type: bug | Status: patch Priority: highest | Milestone: 8.2.2 Component: Compiler | Version: 8.2.1-rc1 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): Phab:D4123 Wiki Page: | -------------------------------------+------------------------------------- Comment (by elaforge): I don't totally understand the point about the debugger. I thought ghci always loads binary if it can? I usually use the * syntax for :load, so the current module is always interpreted, so I can see private names if there an export list. Hasn't it always been true that to set a breakpoint you have to force the module to load as bytecode, either with * or by touching it so it thinks the binary is out of date? I don't really use the debugger so I might be missing some detail. For context, I'm loading modules in two situations: one is from command line ghci, where I'm loading test modules, which were compiled with -fhpc. I also link the modules into a test binary, which I do I want -fhpc for so I can get coverage, but when testing from ghci I don't care about that stuff, I just want it to load the binary modules, not recompile everything as bytecode every time. The other situation is that I use the GHC API to load modules into a running application. Those modules are compiled with -O, and I use GHC.setSessionDynFlags to get the same flags used to compile them when compiling the application itself so I can load them. But the GHCI API then goes and filters out -O, making the flags different... if I'm remembering the results of my research correctly. After that, I'll give it some expressions to evaluate, or maybe reload some modules as bytecode, just like you might do in ghci. Similar to the -fhpc case, I don't actually care that the interpreted code is not optimized, I just want to load the binary modules. My suggestion was to turn off the thing that filters the flags. Of course even if it retains -O it doesn't mean the bytecode interpreter can magically do optimizations, so it would be a bit of a lie. But it seems like the lie is not so bad. It would be optimizing if it could, and it will act as if the flag is set for the purposes of loading modules, but by its nature bytecode is not optimized, so it just doesn't apply when it compiles bytecode. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 25 01:33:29 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 25 Oct 2017 01:33:29 -0000 Subject: [GHC] #14386: GHC doesn't allow Coercion between partly-saturated type constructors Message-ID: <051.c69fb09d236cbd3265f3896d9e479b59@haskell.org> #14386: GHC doesn't allow Coercion between partly-saturated type constructors -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.3 Keywords: roles | Operating System: Unknown/Multiple Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- If I define an "opposite category" `newtype Op cat a b = Op (cat b a)` then representationally it forms an involution: applying `Op` twice gives the same representation as not applying it at all {{{ $ ... -ignore-dot-ghci GHCi, version 8.3.20170920: http://www.haskell.org/ghc/ :? for help Prelude> import Data.Coerce Prelude Data.Coerce> import Data.Type.Coercion Prelude Data.Coerce Data.Type.Coercion> newtype Op cat a b = Op (cat b a) Prelude Data.Coerce Data.Type.Coercion> :t coerce :: Op (Op cat) a b -> cat a b coerce :: Op (Op cat) a b -> cat a b :: Op (Op cat) a b -> cat a b Prelude Data.Coerce Data.Type.Coercion> :t Coercion :: Coercion (Op (Op cat) a b) (cat a b) Coercion :: Coercion (Op (Op cat) a b) (cat a b) :: Coercion (Op (Op cat) a b) (cat a b) }}} But these don't work: {{{ Prelude Data.Coerce Data.Type.Coercion> :t Coercion :: Coercion (Op (Op cat) a) (cat a) :1:1: error: • Couldn't match representation of type ‘Op (Op cat1) a1’ with that of ‘cat1 a1’ arising from a use of ‘Coercion’ • In the expression: Coercion :: Coercion (Op (Op cat) a) (cat a) Prelude Data.Coerce Data.Type.Coercion> :t Coercion :: Coercion (Op (Op cat) cat :1:38: error: parse error (possibly incorrect indentation or mismatched brackets) Prelude Data.Coerce Data.Type.Coercion> :t Coercion :: Coercion (Op (Op cat)) cat :1:1: error: • Couldn't match representation of type ‘cat1’ with that of ‘Op (Op cat1)’ arising from a use of ‘Coercion’ ‘cat1’ is a rigid type variable bound by an expression type signature: forall (cat1 :: * -> * -> *). Coercion (Op (Op cat1)) cat1 at :1:13-38 • In the expression: Coercion :: Coercion (Op (Op cat)) cat }}} I'm wondering if this is intentional -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 25 01:45:21 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 25 Oct 2017 01:45:21 -0000 Subject: [GHC] #14386: GHC doesn't allow Coercion between partly-saturated type constructors In-Reply-To: <051.c69fb09d236cbd3265f3896d9e479b59@haskell.org> References: <051.c69fb09d236cbd3265f3896d9e479b59@haskell.org> Message-ID: <066.84ce8e1dc6abd884aed9c10400abe44d@haskell.org> #14386: GHC doesn't allow Coercion between partly-saturated type constructors -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.3 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 nomeata): Maybe not quite intentional, but certainly expected. I think the coercion you want is not even expressible at the level of Core, because the newtype gives you the axiom {{{ forall cat a b. Op cat a b ~R cat b a }}} And as you can see you can only use this axiom once `Op` has all three arguments. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 25 01:50:38 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 25 Oct 2017 01:50:38 -0000 Subject: [GHC] #14386: GHC doesn't allow Coercion between partly-saturated type constructors In-Reply-To: <051.c69fb09d236cbd3265f3896d9e479b59@haskell.org> References: <051.c69fb09d236cbd3265f3896d9e479b59@haskell.org> Message-ID: <066.d28cb4888e75ee4255a8cbfa6c6aa70b@haskell.org> #14386: GHC doesn't allow Coercion between partly-saturated type constructors -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.3 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 wondered because we allow {{{#!hs import Data.Type.Coercion newtype USD = USD Int wit :: Coercion (Either USD) (Either Int) wit = Coercion }}} I don't understand Core enough to get the difference, but (prima facie) it doesn't seem wrong to allow `Coercion (Op (Op cat)) cat`. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 25 02:12:17 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 25 Oct 2017 02:12:17 -0000 Subject: [GHC] #14386: GHC doesn't allow Coercion between partly-saturated type constructors In-Reply-To: <051.c69fb09d236cbd3265f3896d9e479b59@haskell.org> References: <051.c69fb09d236cbd3265f3896d9e479b59@haskell.org> Message-ID: <066.fc6d106e231f00cb27e74c1d7829df6e@haskell.org> #14386: GHC doesn't allow Coercion between partly-saturated type constructors -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.3 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 nomeata): No, it would not be wrong. We just don't have the machinery yet. Interestingly, had you had {{{ newtype NotOp cat a b = NotOp (cat b a) }}} then `:t Coercion :: Coercion (NotOp (NotOp cat)) cat` would work. Why? Because the axiom you get out of a `newtype` is eta-contracted as far as possible; in this case. {{{ NotOp cat ~ cat }}} The thing with `Either` is a completely different story. Note that you are coercing _an argument of `Either`_ (still `Either` on both sides) whereas originally you are coercing between `Op` and it’s representation. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 25 02:16:45 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 25 Oct 2017 02:16:45 -0000 Subject: [GHC] #14386: GHC doesn't allow Coercion between partly-saturated type constructors In-Reply-To: <051.c69fb09d236cbd3265f3896d9e479b59@haskell.org> References: <051.c69fb09d236cbd3265f3896d9e479b59@haskell.org> Message-ID: <066.1049bfd1a304c87b379e7088d0698a74@haskell.org> #14386: GHC doesn't allow Coercion between partly-saturated type constructors -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.3 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): Replying to [comment:3 nomeata]: > Interestingly, had you had > > {{{ > newtype NotOp cat a b = NotOp (cat b a) > }}} > then `:t Coercion :: Coercion (NotOp (NotOp cat)) cat` would work. Did you mean {{{#!hs newtype NotOp cat a b = NotOp (cat a b) }}} > The thing with `Either` is a completely different story. Note that you are coercing _an argument of `Either`_ (still `Either` on both sides) whereas originally you are coercing between `Op` and it’s representation. With quantified constraints, could we write? {{{#!hs type OpOp cat = forall xx yy. cat xx yy `Coercible` Op (Op cat) xx yy wit :: OpOp cat => Op (Op cat) `Coercion` cat wit = Coercion }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 25 02:56:44 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 25 Oct 2017 02:56:44 -0000 Subject: [GHC] #14387: listToMaybe doesn't participate in foldr/build fusion Message-ID: <043.502b369a22f4944e5a5f0570931d7cbe@haskell.org> #14387: listToMaybe doesn't participate in foldr/build fusion -------------------------------------+------------------------------------- Reporter: duog | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Core | Version: 8.2.1 Libraries | 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 that `Data.OldList.findIndex` seems to use more memory than necessary, and that changing the definition of `listToMaybe` to be in terms of `foldr` fixed the situation. Consider the following module: {{{ {-# LANGUAGE MagicHash #-} {-# OPTIONS_GHC -ddump-to-file -ddump-prep -O #-} module FindIndex where import GHC.Base (Int(I#), build) import GHC.Prim -- | The definitions of listToMaybe, findIndices and findIndex are taken from base listToMaybe :: [a] -> Maybe a listToMaybe [] = Nothing listToMaybe (a:_) = Just a findIndices :: (a -> Bool) -> [a] -> [Int] findIndices p ls = build $ \c n -> let go x r k | p x = I# k `c` r (k +# 1#) | otherwise = r (k +# 1#) in foldr go (\_ -> n) ls 0# {-# inline findIndices #-} findIndex :: (a -> Bool) -> [a] -> Maybe Int findIndex p = listToMaybe . findIndices p -- This is the definition of findIndices when USE_REPORT_PRELUDE is defined findIndices' :: (a -> Bool) -> [a] -> [Int] findIndices' p xs = [ i | (x,i) <- zip xs [0..], p x] {-# inline findIndices' #-} listToMaybe' :: [a] -> Maybe a listToMaybe' = foldr (const . Just) Nothing -- | using listToMaybe', we get a join point findIndex2 :: (a -> Bool) -> [a] -> Maybe Int findIndex2 p = listToMaybe' . findIndices p -- | a "manual" implementaiton, we get a join point findIndex3 :: (a -> Bool) -> [a] -> Maybe Int findIndex3 p = go . zip [0..] where go [] = Nothing go ((i, x) : xs) | p x = Just i | otherwise = go xs -- | alternate version of findIndices, stock listToMaybe, no join point findIndex4 :: (a -> Bool) -> [a] -> Maybe Int findIndex4 p = listToMaybe . findIndices' p -- | alternate version of findIndices, foldr listToMaybe, we get a join point findIndex5 :: (a -> Bool) -> [a] -> Maybe Int findIndex5 p = listToMaybe' . findIndices' p }}} Find attached .dump-prep files with ghc-8.2.1 and ghc-head at commit 5c178012f47420b5dfa417be21146ca82959d273. My interpretation of this is: with both ghc-8.2.1 and ghc-head, findIndex{2,4,5} get join points and findIndex{"",3} don't. Having a join point means constant stack space, not having a join point means linear stack space. I don't understand the simplifier well enough to know whether ghc could do better here, but it seems that changing the definition of `listToMaybe` to {{{ listToMaybe :: [a] -> Maybe a listToMaybe = foldr (const . Just) Nothing }}} would be a win. Are there any downsides? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 25 02:57:05 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 25 Oct 2017 02:57:05 -0000 Subject: [GHC] #14387: listToMaybe doesn't participate in foldr/build fusion In-Reply-To: <043.502b369a22f4944e5a5f0570931d7cbe@haskell.org> References: <043.502b369a22f4944e5a5f0570931d7cbe@haskell.org> Message-ID: <058.59eea7bfc51c9d9ffac4cc76c993098d@haskell.org> #14387: listToMaybe doesn't participate in foldr/build fusion -------------------------------------+------------------------------------- Reporter: duog | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Core Libraries | 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 duog): * Attachment "FindIndex.hs" added. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 25 02:57:20 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 25 Oct 2017 02:57:20 -0000 Subject: [GHC] #14387: listToMaybe doesn't participate in foldr/build fusion In-Reply-To: <043.502b369a22f4944e5a5f0570931d7cbe@haskell.org> References: <043.502b369a22f4944e5a5f0570931d7cbe@haskell.org> Message-ID: <058.cf1b23a7931c73a0494e27b455fbd2cb@haskell.org> #14387: listToMaybe doesn't participate in foldr/build fusion -------------------------------------+------------------------------------- Reporter: duog | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Core Libraries | 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 duog): * Attachment "FindIndex.ghc-head.dump-prep" added. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 25 02:57:35 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 25 Oct 2017 02:57:35 -0000 Subject: [GHC] #14387: listToMaybe doesn't participate in foldr/build fusion In-Reply-To: <043.502b369a22f4944e5a5f0570931d7cbe@haskell.org> References: <043.502b369a22f4944e5a5f0570931d7cbe@haskell.org> Message-ID: <058.b1faec885e6f36a6c5c3f431d10bfe3d@haskell.org> #14387: listToMaybe doesn't participate in foldr/build fusion -------------------------------------+------------------------------------- Reporter: duog | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Core Libraries | 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 duog): * Attachment "FindIndex.ghc-8.2.1.dump-prep" added. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 25 02:58:46 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 25 Oct 2017 02:58:46 -0000 Subject: [GHC] #14387: listToMaybe doesn't participate in foldr/build fusion In-Reply-To: <043.502b369a22f4944e5a5f0570931d7cbe@haskell.org> References: <043.502b369a22f4944e5a5f0570931d7cbe@haskell.org> Message-ID: <058.011fb95225f72e96c5b66d79d82eb339@haskell.org> #14387: listToMaybe doesn't participate in foldr/build fusion -------------------------------------+------------------------------------- Reporter: duog | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Core Libraries | 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: | -------------------------------------+------------------------------------- Description changed by duog: Old description: > I noticed that `Data.OldList.findIndex` seems to use more memory than > necessary, and that changing the definition of `listToMaybe` to be in > terms of `foldr` fixed the situation. > > Consider the following module: > {{{ > {-# LANGUAGE MagicHash #-} > {-# OPTIONS_GHC -ddump-to-file -ddump-prep -O #-} > > module FindIndex where > > import GHC.Base (Int(I#), build) > import GHC.Prim > > -- | The definitions of listToMaybe, findIndices and findIndex are taken > from base > listToMaybe :: [a] -> Maybe a > listToMaybe [] = Nothing > listToMaybe (a:_) = Just a > > findIndices :: (a -> Bool) -> [a] -> [Int] > findIndices p ls = build $ \c n -> > let go x r k | p x = I# k `c` r (k +# 1#) > | otherwise = r (k +# 1#) > in foldr go (\_ -> n) ls 0# > {-# inline findIndices #-} > > findIndex :: (a -> Bool) -> [a] -> Maybe Int > findIndex p = listToMaybe . findIndices p > > -- This is the definition of findIndices when USE_REPORT_PRELUDE is > defined > findIndices' :: (a -> Bool) -> [a] -> [Int] > findIndices' p xs = [ i | (x,i) <- zip xs [0..], p x] > {-# inline findIndices' #-} > > listToMaybe' :: [a] -> Maybe a > listToMaybe' = foldr (const . Just) Nothing > > -- | using listToMaybe', we get a join point > findIndex2 :: (a -> Bool) -> [a] -> Maybe Int > findIndex2 p = listToMaybe' . findIndices p > > -- | a "manual" implementaiton, we get a join point > findIndex3 :: (a -> Bool) -> [a] -> Maybe Int > findIndex3 p = go . zip [0..] > where > go [] = Nothing > go ((i, x) : xs) > | p x = Just i > | otherwise = go xs > > -- | alternate version of findIndices, stock listToMaybe, no join point > findIndex4 :: (a -> Bool) -> [a] -> Maybe Int > findIndex4 p = listToMaybe . findIndices' p > > -- | alternate version of findIndices, foldr listToMaybe, we get a join > point > findIndex5 :: (a -> Bool) -> [a] -> Maybe Int > findIndex5 p = listToMaybe' . findIndices' p > }}} > > Find attached .dump-prep files with ghc-8.2.1 and ghc-head at commit > 5c178012f47420b5dfa417be21146ca82959d273. > > My interpretation of this is: with both ghc-8.2.1 and ghc-head, > findIndex{2,4,5} get join points and findIndex{"",3} don't. Having a join > point means constant stack space, not having a join point means linear > stack space. > > I don't understand the simplifier well enough to know whether ghc could > do better here, but it seems that changing the definition of > `listToMaybe` to > {{{ > listToMaybe :: [a] -> Maybe a > listToMaybe = foldr (const . Just) Nothing > }}} > would be a win. Are there any downsides? New description: I noticed that `Data.OldList.findIndex` seems to use more memory than necessary, and that changing the definition of `listToMaybe` to be in terms of `foldr` fixed the situation. Consider the following module: {{{ {-# LANGUAGE MagicHash #-} {-# OPTIONS_GHC -ddump-to-file -ddump-prep -O #-} module FindIndex where import GHC.Base (Int(I#), build) import GHC.Prim -- | The definitions of listToMaybe, findIndices and findIndex are taken from base listToMaybe :: [a] -> Maybe a listToMaybe [] = Nothing listToMaybe (a:_) = Just a findIndices :: (a -> Bool) -> [a] -> [Int] findIndices p ls = build $ \c n -> let go x r k | p x = I# k `c` r (k +# 1#) | otherwise = r (k +# 1#) in foldr go (\_ -> n) ls 0# {-# inline findIndices #-} findIndex :: (a -> Bool) -> [a] -> Maybe Int findIndex p = listToMaybe . findIndices p -- This is the definition of findIndices when USE_REPORT_PRELUDE is defined findIndices' :: (a -> Bool) -> [a] -> [Int] findIndices' p xs = [ i | (x,i) <- zip xs [0..], p x] {-# inline findIndices' #-} listToMaybe' :: [a] -> Maybe a listToMaybe' = foldr (const . Just) Nothing -- | using listToMaybe', we get a join point findIndex2 :: (a -> Bool) -> [a] -> Maybe Int findIndex2 p = listToMaybe' . findIndices p -- | a "manual" implementaiton, we get a join point findIndex3 :: (a -> Bool) -> [a] -> Maybe Int findIndex3 p = go . zip [0..] where go [] = Nothing go ((i, x) : xs) | p x = Just i | otherwise = go xs -- | alternate version of findIndices, stock listToMaybe, no join point findIndex4 :: (a -> Bool) -> [a] -> Maybe Int findIndex4 p = listToMaybe . findIndices' p -- | alternate version of findIndices, foldr listToMaybe, we get a join point findIndex5 :: (a -> Bool) -> [a] -> Maybe Int findIndex5 p = listToMaybe' . findIndices' p }}} Find attached .dump-prep files with ghc-8.2.1 and ghc-head at commit 8843a39b3c941b1908a8d839f52bc323f3b45081. My interpretation of this is: with both ghc-8.2.1 and ghc-head, findIndex{2,4,5} get join points and findIndex{"",3} don't. Having a join point means constant stack space, not having a join point means linear stack space. I don't understand the simplifier well enough to know whether ghc could do better here, but it seems that changing the definition of `listToMaybe` to {{{ listToMaybe :: [a] -> Maybe a listToMaybe = foldr (const . Just) Nothing }}} would be a win. Are there any downsides? -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 25 03:12:20 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 25 Oct 2017 03:12:20 -0000 Subject: [GHC] #14386: GHC doesn't allow Coercion between partly-saturated type constructors In-Reply-To: <051.c69fb09d236cbd3265f3896d9e479b59@haskell.org> References: <051.c69fb09d236cbd3265f3896d9e479b59@haskell.org> Message-ID: <066.a824e6bae2fdb330544979e863a23233@haskell.org> #14386: GHC doesn't allow Coercion between partly-saturated type constructors -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.3 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 nomeata): > With quantified constraints, could we write? I don’t think so. It would require a rule “eta-expansion rule” {{{ ∀a. T1 a ~R T2 b −−−−−−−−−−−−−− T1 ~R T2 }}} which does not exist. But others will have to tell you if that can exist or if it would break things. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 25 06:17:59 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 25 Oct 2017 06:17:59 -0000 Subject: [GHC] #7258: Compiling DynFlags is jolly slow In-Reply-To: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> References: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> Message-ID: <061.d055b599038f1475af0db16146d48c17@haskell.org> #7258: Compiling DynFlags is jolly slow -------------------------------------+------------------------------------- Reporter: simonpj | Owner: simonpj Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.6.1 Resolution: | Keywords: deriving-perf 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 tdammers): * Attachment "ghc-large-record-types-optimized.png" added. Performance profiling data for large record types, using -O2. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 25 07:24:44 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 25 Oct 2017 07:24:44 -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.13f1b5e912cb8c0955aeb675046e6707@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 Tamar Christina ): In [changeset:"3825b7e222bc1b7d643fce0755cf6b728fb1d854/ghc" 3825b7e/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="3825b7e222bc1b7d643fce0755cf6b728fb1d854" Remove the 'legroom' part of the timeout-accurate-pure test. Summary: This removes the part of the test that checks whether the timeout happened in a 'reasonable' amount of time, because it is flaky. In subsequent work, we can turn this into a benchmark. Test Plan: This _is_ a test Reviewers: nh2, bgamari, Phyx, austin, hvr Reviewed By: Phyx Subscribers: rwbarton, thomie GHC Trac Issues: #8684 Differential Revision: https://phabricator.haskell.org/D4120 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 25 07:33:42 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 25 Oct 2017 07:33:42 -0000 Subject: [GHC] #7258: Compiling DynFlags is jolly slow In-Reply-To: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> References: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> Message-ID: <061.cf8c3e541b4314f72fc93feb346bddac@haskell.org> #7258: Compiling DynFlags is jolly slow -------------------------------------+------------------------------------- Reporter: simonpj | Owner: simonpj Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.6.1 Resolution: | Keywords: deriving-perf 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): Ha. Reminds me of #13253. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 25 07:36:15 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 25 Oct 2017 07:36:15 -0000 Subject: [GHC] #7258: Compiling DynFlags is jolly slow In-Reply-To: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> References: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> Message-ID: <061.5cd6217d7bb212fd39a934a14998738a@haskell.org> #7258: Compiling DynFlags is jolly slow -------------------------------------+------------------------------------- Reporter: simonpj | Owner: simonpj Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.6.1 Resolution: | Keywords: deriving-perf 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): Is the labelling in the graph after comment:46 correct? read-appl looks worst by a long way, which wasn't true bef.re Ditto geline-appl seems worse than getline (which is invisible). -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 25 10:47:04 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 25 Oct 2017 10:47:04 -0000 Subject: [GHC] #13707: xmobar crashes with segmentation faults? In-Reply-To: <046.fbf7af7bdea4e00dc6b71cd4d89ec01e@haskell.org> References: <046.fbf7af7bdea4e00dc6b71cd4d89ec01e@haskell.org> Message-ID: <061.511089eba62b688a484bf9bc3a205d35@haskell.org> #13707: xmobar crashes with segmentation faults? -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: closed Priority: highest | Milestone: 8.2.1 Component: Compiler | Version: 8.2.1-rc2 Resolution: fixed | 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 trippels): * status: new => closed * resolution: => fixed Comment: Fixed by "base: Make Foreign.Marshal.Alloc.allocBytes[Aligned] NOINLINE". Took some time, but thanks. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 25 10:47:21 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 25 Oct 2017 10:47:21 -0000 Subject: [GHC] #14382: The 'impossible' happened whilst installing gi-gtk via cabal In-Reply-To: <052.f9c10851d0906622baeb7996269cc8e7@haskell.org> References: <052.f9c10851d0906622baeb7996269cc8e7@haskell.org> Message-ID: <067.c7017acf1f2e69e219f52137434626c1@haskell.org> #14382: The 'impossible' happened whilst installing gi-gtk via cabal ----------------------------------+-------------------------------------- Reporter: maartenjacobs | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: | Keywords: gtk, pango Operating System: Linux | Architecture: x86_64 (amd64) Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | ----------------------------------+-------------------------------------- Comment (by simonpj): I have no idea how to reproduce this. {{{ bash$ cabal unpack gi-pango-1.0.15 bash$ cd gi-pango-1.0.15 bash$ cabal install --with- ghc=/home/simonpj/5builds/ghc-8.2-branch/inplace/bin/ghc-stage2 Resolving dependencies... cabal: Could not resolve dependencies: trying: gi-pango-1.0.15 (user goal) next goal: haskell-gi (dependency of gi-pango-1.0.15) rejecting: haskell-gi-0.20.3, haskell-gi-0.20.2, haskell-gi-0.20.1 (conflict: requires pkg-config package gobject-introspection-1.0>=1.32, not found in the pkg-config database) rejecting: haskell-gi-0.20, haskell-gi-0.18, haskell-gi-0.17.4, haskell-gi-0.17.3, haskell-gi-0.17.2, haskell-gi-0.17.1, haskell-gi-0.17, haskell-gi-0.15, haskell-gi-0.14, haskell-gi-0.13, haskell-gi-0.12, haskell-gi-0.11, haskell-gi-0.10.2, haskell-gi-0.10.1, haskell-gi-0.10, haskell-gi-0.9, haskell-gi-0.8 (conflict: gi-pango => haskell-gi>=0.20.1 && <1) Dependency tree exhaustively searched. }}} Moreover there seem be no source files. Try building compiler with `-DDEBUG` and add `HasDebugCallStack` to `tcIfaceGlobal`. In the panic in `tcIfaceGlobal` get hold of the `if_loc` field of the `IfLclEnv` and add that to the error message. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 25 10:54:14 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 25 Oct 2017 10:54:14 -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.f4660ac39aa9960b5d0eb1ec7459308f@haskell.org> #14331: Overzealous free-floating kind check causes deriving clause to be rejected -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: merge Priority: normal | Milestone: 8.2.2 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): Personally I think comment:10 is an improvement, but there is clearly more to do. Either way, it won't affect many users, so you could leave it out of 8.2 without any significant impact, I think. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 25 10:58:27 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 25 Oct 2017 10:58:27 -0000 Subject: [GHC] #14379: Regression - GHC 2.8.1 Consumes All Memory On Build In-Reply-To: <047.3a29f02e3bbd9a0f2379ab1644f26326@haskell.org> References: <047.3a29f02e3bbd9a0f2379ab1644f26326@haskell.org> Message-ID: <062.2b58dfc97d8c7528e8719ce9cc50366c@haskell.org> #14379: Regression - GHC 2.8.1 Consumes All Memory On Build -------------------------------------+------------------------------------- Reporter: jm4games | Owner: (none) Type: bug | Status: new Priority: high | Milestone: 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): 8.0.2 Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): As so often, I failed to reproduce this with HEAD, at the first fence {{{ simonpj at cam-05-unx:/cam-01-srv/simonpj/tmp/T14379$ cabal install --with- ghc=/home/simonpj/5builds/HEAD/inplace/bin/ghc-stage2 --allow-newer Resolving dependencies... Configuring primitive-0.6.2.0... Building primitive-0.6.2.0... Failed to install primitive-0.6.2.0 Build log ( /home/simonpj/.cabal/logs/primitive-0.6.2.0.log ): cabal: Entering directory '/tmp/cabal-tmp-46331/primitive-0.6.2.0' Configuring primitive-0.6.2.0... Building primitive-0.6.2.0... Preprocessing library primitive-0.6.2.0... [ 1 of 12] Compiling Control.Monad.Primitive ( Control/Monad/Primitive.hs, dist/build/Control/Monad/Primitive.o ) Control/Monad/Primitive.hs:45:1: warning: [-Wdeprecations] Module ‘Control.Monad.Trans.List’ is deprecated: This transformer is invalid on most monads | 45 | import Control.Monad.Trans.List ( ListT ) | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ ...plus many more similar deprecation warnings... [ 2 of 12] Compiling Data.Primitive.Internal.Compat ( Data/Primitive/Internal/Compat.hs, dist/build/Data/Primitive/Internal/Compat.o ) [ 3 of 12] Compiling Data.Primitive.Array ( Data/Primitive/Array.hs, dist/build/Data/Primitive/Array.o ) Data/Primitive/Array.hs:531:10: error: • No instance for (Semigroup (Array a)) arising from the superclasses of an instance declaration • In the instance declaration for ‘Monoid (Array a)’ | 531 | instance Monoid (Array a) where | ^^^^^^^^^^^^^^^^ cabal: Leaving directory '/tmp/cabal-tmp-46331/primitive-0.6.2.0' cabal: Error: some packages failed to install: primitive-0.6.2.0 failed during the building phase. The exception was: ExitFailure 1 some-test-0.2.1.0 depends on primitive-0.6.2.0 which failed to install. vector-0.12.0.1 depends on primitive-0.6.2.0 which failed to install. simonpj at cam-05-unx:/cam-01-srv/simonpj/tmp/T14379$ }}} Without `--allow-newer` it falls over much faster. Any ideas for how to fix? I will try again with 8.2. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 25 11:07:37 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 25 Oct 2017 11:07:37 -0000 Subject: [GHC] #7258: Compiling DynFlags is jolly slow In-Reply-To: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> References: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> Message-ID: <061.290a192a3dc84718973f04d57fcb8dc2@haskell.org> #7258: Compiling DynFlags is jolly slow -------------------------------------+------------------------------------- Reporter: simonpj | Owner: simonpj Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.6.1 Resolution: | Keywords: deriving-perf 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 mystery. * I took `t-10-getline.hs` and `t-10-getine-appl.hs` from `examples.zip` just before comment:44 * I compiled both with `-O -dshow-passes -ddump-simpl`. * Both produced ''identical'' Core. In the early stages `getline-appl` is a little bigger, but they become identical after the first run of the simplifier following specialise/float-out. (I.e. early) I am at a loss for how to reconcile these results with the dramatically worse compile times for `getline` compared with `getline-appl` reported in the graph plot in comment:43. Tobias, any ideas? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 25 11:19:02 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 25 Oct 2017 11:19:02 -0000 Subject: [GHC] #7258: Compiling DynFlags is jolly slow In-Reply-To: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> References: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> Message-ID: <061.639267cf1ab86e932e30b9160004cd24@haskell.org> #7258: Compiling DynFlags is jolly slow -------------------------------------+------------------------------------- Reporter: simonpj | Owner: simonpj Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.6.1 Resolution: | Keywords: deriving-perf 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:48 simonpj]: > Is the labelling in the graph after comment:46 correct? read-appl looks worst by a long way, which wasn't true bef.re Ditto geline-appl seems worse than getline (which is invisible). Yes, it is correct; the difference between this new graph and the previous one is that the new one uses `-O2`, while the old one doesn't use any optimizations. The profiler breakdown looks radically different between the optimized and unoptimized versions, for *all* examples - RegAlloc- linear and ppr, which are the most serious offenders in the unoptimized run, account for less than 1% of execution time in the optimized case. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 25 11:20:42 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 25 Oct 2017 11:20:42 -0000 Subject: [GHC] #14379: Regression - GHC 2.8.1 Consumes All Memory On Build In-Reply-To: <047.3a29f02e3bbd9a0f2379ab1644f26326@haskell.org> References: <047.3a29f02e3bbd9a0f2379ab1644f26326@haskell.org> Message-ID: <062.2f6462b19385a63d03b6a5a0f9156ee2@haskell.org> #14379: Regression - GHC 2.8.1 Consumes All Memory On Build -------------------------------------+------------------------------------- Reporter: jm4games | Owner: (none) Type: bug | Status: new Priority: high | Milestone: 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): 8.0.2 Wiki Page: | -------------------------------------+------------------------------------- Comment (by mpickering): Since Herbert merged the commit which made Semigroup a superclass of Monoid it became much more difficult to build packages with HEAD. https://phabricator.haskell.org/rGHC8ae263ceb3566a7c82336400b09cb8f381217405 The most reliable way I found now was to use the package overlay he posted about but it is more fiddly to set up. https://mail.haskell.org/pipermail/ghc-devs/2017-September/014682.html -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 25 11:22:20 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 25 Oct 2017 11:22:20 -0000 Subject: [GHC] #7258: Compiling DynFlags is jolly slow In-Reply-To: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> References: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> Message-ID: <061.b4731dfb9611cb3fba02496d9f841ced@haskell.org> #7258: Compiling DynFlags is jolly slow -------------------------------------+------------------------------------- Reporter: simonpj | Owner: simonpj Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.6.1 Resolution: | Keywords: deriving-perf 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 simonpj]: > Here's a mystery. > > * I took `t-10-getline.hs` and `t-10-getine-appl.hs` from `examples.zip` just before comment:44 > > * I compiled both with `-O -dshow-passes -ddump-simpl`. > > * Both produced ''identical'' Core. In the early stages `getline-appl` is a little bigger, but they become identical after the first run of the simplifier following specialise/float-out. (I.e. early) > > I am at a loss for how to reconcile these results with the dramatically worse compile times for `getline` compared with `getline-appl` reported in the graph plot in comment:43. > > Tobias, any ideas? Hmm, maybe `-O` vs. `-O2`? I'll run a few trials myself. Other thought, though probably not really an explanation: the t-10-XXXX examples are maybe too small to produce useful metrics, the performance differences only start to get dramatic past 100 fields or so. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 25 11:33:15 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 25 Oct 2017 11:33:15 -0000 Subject: [GHC] #14387: listToMaybe doesn't participate in foldr/build fusion In-Reply-To: <043.502b369a22f4944e5a5f0570931d7cbe@haskell.org> References: <043.502b369a22f4944e5a5f0570931d7cbe@haskell.org> Message-ID: <058.f19a35fa543fdd7b2de1d3d93ed95334@haskell.org> #14387: listToMaybe doesn't participate in foldr/build fusion -------------------------------------+------------------------------------- Reporter: duog | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Core Libraries | 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 simonpj): > findIndex{2,4,5} get join points and findIndex{"",3} don't. Actually `findIndex3` does get a join point: {{{ FindIndex.findIndex3 = \ (@ a_a1kV) (p_s2Z2 [Occ=OnceL!] :: a_a1kV -> GHC.Types.Bool) (eta_s2Z3 [Occ=Once] :: [a_a1kV]) -> case GHC.List.zip @ GHC.Types.Int @ a_a1kV FindIndex.findIndex1 eta_s2Z3 of sat_s2Zd { __DEFAULT -> joinrec { go_s2Z4 [Occ=LoopBreakerT[1]] :: [(GHC.Types.Int, a_a1kV)] -> GHC.Base.Maybe GHC.Types.Int [LclId[JoinId(1)], Arity=1, Str=, Unf=OtherCon []] go_s2Z4 (ds_s2Z5 [Occ=Once!] :: [(GHC.Types.Int, a_a1kV)]) = case ds_s2Z5 of { [] -> GHC.Base.Nothing @ GHC.Types.Int; : ds1_s2Z7 [Occ=Once!] xs_s2Z8 [Occ=Once] -> case ds1_s2Z7 of { (i_s2Za [Occ=Once], x_s2Zb [Occ=Once]) -> case p_s2Z2 x_s2Zb of { GHC.Types.False -> jump go_s2Z4 xs_s2Z8; GHC.Types.True -> GHC.Base.Just @ GHC.Types.Int i_s2Za } } }; } in jump go_s2Z4 sat_s2Zd } }}} Note the join point. But `findIndex4` and `findIndex` do not. Maybe that was a typo. > Having a join point means constant stack space, not having a join point means linear stack space. This definitely isn't true. Here's `findIndex` (the one that does not get a join point): {{{ findIndex = \ (@ a_a1IQ) (p_a1eN :: a_a1IQ -> Bool) (x_a1Ld :: [a_a1IQ]) -> letrec { go_a1KZ [Occ=LoopBreaker] :: [a_a1IQ] -> Int# -> [Int] [LclId, Arity=2, Str=, Unf=OtherCon []] go_a1KZ = \ (ds_a1L0 :: [a_a1IQ]) (eta_B1 :: Int#) -> case ds_a1L0 of { [] -> GHC.Types.[] @ Int; : y_a1L5 ys_a1L6 -> case p_a1eN y_a1L5 of { False -> go_a1KZ ys_a1L6 (+# eta_B1 1#); True -> GHC.Types.: @ Int (GHC.Types.I# eta_B1) (go_a1KZ ys_a1L6 (+# eta_B1 1#)) } }; } in case go_a1KZ x_a1Ld 0# of { [] -> GHC.Base.Nothing @ Int; : a1_aX7 ds_d1KM -> GHC.Base.Just @ Int a1_aX7 } }}} In the `False` branch inside `go`, there's a tail-call to `go` (no stack growth). In the `True` branch, `go` returns a cons-cell, and stops. Then the `case go x o# of ...` scrutinises that cons cell and returns a `Just`. All done. No stack growth in either case. Why does `listToMaybe'` work (slightly) better? Because it can perform foldr/build fusion with the list producer. > it seems that changing the definition of listToMaybe to use `foldr` would be a win Yes I agree. It's a bit like making `map` use `foldr` rather than being written directly. But you'd need an INLINE pragma on it. I can't see a downside. If it doesn't fuse you get the original `listToMaybe` back instead. If someone makes that change (in `base`) do add a Note to explain. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 25 11:40:19 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 25 Oct 2017 11:40:19 -0000 Subject: [GHC] #7258: Compiling DynFlags is jolly slow In-Reply-To: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> References: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> Message-ID: <061.4ab75f84d762bac2f62ecf398778a094@haskell.org> #7258: Compiling DynFlags is jolly slow -------------------------------------+------------------------------------- Reporter: simonpj | Owner: simonpj Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.6.1 Resolution: | Keywords: deriving-perf 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 t-10-XXXX examples are maybe too small to produce useful metrics, I wasn't measuring performance; I was just eye-balling the (identical) code. > The profiler breakdown looks radically different between the optimized and unoptimized versions, for *all* examples OK, so there are two perhaps-different problems * With -O compiling `DynFlags` is jolly slow. (The original bug report.) * Without -O we get non-linear stuff going on (comment:43) I think the -O case is the higher-priority item. (Though I accept that compiling without -O is supposed to be fast.) I would stick to -O for now, not -O2. The latter involves `SpecConstr` and `LiberateCase` both of which can generate a lot of code. Again let's not ignore -O2 but let's nail -O first. So what do the -O graphs look like? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 25 11:45:24 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 25 Oct 2017 11:45:24 -0000 Subject: [GHC] #7258: Compiling DynFlags is jolly slow In-Reply-To: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> References: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> Message-ID: <061.9f16ea1f0929fc3ead9e0b503e838012@haskell.org> #7258: Compiling DynFlags is jolly slow -------------------------------------+------------------------------------- Reporter: simonpj | Owner: simonpj Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.6.1 Resolution: | Keywords: deriving-perf 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 don't have -O graphs yet, unfortunately it takes a good while to generate those (I aborted the -O2 one after running all night and only making it to 420 fields). I'll start up a job and report back. One-shot experiments do suggest though that pretty-printing and register allocation aren't going to be bottlenecks here either. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 25 12:33:55 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 25 Oct 2017 12:33:55 -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.bc97e1bae4b7742849824cef62a407d4@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: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: merge => new * milestone: 8.2.2 => 8.4.1 Comment: Alright, let's punt then. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 25 14:31:53 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 25 Oct 2017 14:31:53 -0000 Subject: [GHC] #14388: GHC Panic Message-ID: <048.ff04d4b22c4f4e0aec9c19da64e2231b@haskell.org> #14388: GHC Panic -------------------------------------+------------------------------------- Reporter: aferrandi | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.0.2 Keywords: IfaceTyLit | Operating System: Linux panic | Architecture: | Type of failure: Compile-time Unknown/Multiple | crash or panic Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- Building the project exmap I,ve got: Information:stack: Building 'exmap' ... Information:stack: /usr/bin/stack build . --stack-yaml /home/andrea/prj/exmap/server/stack.yaml "--ghc-options=-Wall -Werror" exmap-0.1.0.0: configure (exe) Configuring exmap-0.1.0.0... exmap-0.1.0.0: build (exe) Preprocessing executable 'exmap' for exmap-0.1.0.0... ghc: panic! (the 'impossible' happened) (GHC version 8.0.2 for x86_64-unknown-linux): get IfaceTyLit 255 Information:stack: Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug Information:stack: -- While building package exmap-0.1.0.0 using: /home/andrea/.stack/setup-exe-cache/x86_64-linux/Cabal- simple_mPHDZzAJ_1.24.2.0_ghc-8.0.2 --builddir=.stack- work/dist/x86_64-linux/Cabal-1.24.2.0 build exe:exmap --ghc-options " -ddump-hi -ddump-to-file" Process exited with code: ExitFailure 1 Information:25.10.17 16:19 - Compilation completed with 1 error and 0 warnings in 1s 946ms Error:stack: Stack build failed with nonzero exit status -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 25 15:43:06 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 25 Oct 2017 15:43:06 -0000 Subject: [GHC] #14389: Improved results in GHCi during basic calculations Message-ID: <044.095b6c2ec55cfe6869c1e521514f22b5@haskell.org> #14389: Improved results in GHCi during basic calculations -------------------------------------+------------------------------------- Reporter: vanto | Owner: (none) Type: feature | Status: new request | Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: Other Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- We can use GHCi as a calculator using {{{+}}}, {{{-}}}, {{{*}}}, {{{/}}}, {{{sin}}}, {{{cos}}}, and others. sometimes the result does not meet our expectations. for example if I calculate 3 + 2, the result is 5 and in line with our expectations. \\ {{{ Prelude> 3+2 5 }}} but sometimes it is not.\\ for the two examples below, please, can we have in GHCi a result other than the one given?\\ {{{ Prelude> exp(log(1000)-log(10)) 99.99999999999996 }}} can we have a result equal to {{{100}}}? \\ {{{ Prelude> 12*(1/3-1/4)-1 -2.220446049250313e-16 }}} can we have a result equal to {{{0}}}? \\ -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 25 16:09:05 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 25 Oct 2017 16:09:05 -0000 Subject: [GHC] #14386: GHC doesn't allow Coercion between partly-saturated type constructors In-Reply-To: <051.c69fb09d236cbd3265f3896d9e479b59@haskell.org> References: <051.c69fb09d236cbd3265f3896d9e479b59@haskell.org> Message-ID: <066.f695f90c335493079c193203b349b026@haskell.org> #14386: GHC doesn't allow Coercion between partly-saturated type constructors -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.3 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): This seems to be yet another way representational equality could, theoretically, expand. Note that, unlike certain other problems, this isn't a limitation of the solver, but of the definition of the equality relation itself. It might be helpful to maintain a list of such deficiencies. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 25 17:35:57 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 25 Oct 2017 17:35:57 -0000 Subject: [GHC] #14388: GHC Panic In-Reply-To: <048.ff04d4b22c4f4e0aec9c19da64e2231b@haskell.org> References: <048.ff04d4b22c4f4e0aec9c19da64e2231b@haskell.org> Message-ID: <063.75fcb6d9612911dbef4f40a9aa575398@haskell.org> #14388: GHC Panic -------------------------------------+------------------------------------- Reporter: aferrandi | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.0.2 Resolution: | Keywords: IfaceTyLit | panic Operating System: Linux | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Old description: > Building the project exmap I,ve got: > > Information:stack: Building 'exmap' ... > Information:stack: /usr/bin/stack build . --stack-yaml > /home/andrea/prj/exmap/server/stack.yaml "--ghc-options=-Wall -Werror" > exmap-0.1.0.0: configure (exe) > Configuring exmap-0.1.0.0... > exmap-0.1.0.0: build (exe) > Preprocessing executable 'exmap' for exmap-0.1.0.0... > ghc: panic! (the 'impossible' happened) > (GHC version 8.0.2 for x86_64-unknown-linux): > get IfaceTyLit 255 > Information:stack: Please report this as a GHC bug: > http://www.haskell.org/ghc/reportabug > Information:stack: -- While building package exmap-0.1.0.0 using: > /home/andrea/.stack/setup-exe-cache/x86_64-linux/Cabal- > simple_mPHDZzAJ_1.24.2.0_ghc-8.0.2 --builddir=.stack- > work/dist/x86_64-linux/Cabal-1.24.2.0 build exe:exmap --ghc-options " > -ddump-hi -ddump-to-file" > Process exited with code: ExitFailure 1 > Information:25.10.17 16:19 - Compilation completed with 1 error and 0 > warnings in 1s 946ms > Error:stack: Stack build failed with nonzero exit status New description: Building the project exmap I,ve got: {{{ Information:stack: Building 'exmap' ... Information:stack: /usr/bin/stack build . --stack-yaml /home/andrea/prj/exmap/server/stack.yaml "--ghc-options=-Wall -Werror" exmap-0.1.0.0: configure (exe) Configuring exmap-0.1.0.0... exmap-0.1.0.0: build (exe) Preprocessing executable 'exmap' for exmap-0.1.0.0... ghc: panic! (the 'impossible' happened) (GHC version 8.0.2 for x86_64-unknown-linux): get IfaceTyLit 255 Information:stack: Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug Information:stack: -- While building package exmap-0.1.0.0 using: /home/andrea/.stack/setup-exe-cache/x86_64-linux/Cabal- simple_mPHDZzAJ_1.24.2.0_ghc-8.0.2 --builddir=.stack- work/dist/x86_64-linux/Cabal-1.24.2.0 build exe:exmap --ghc-options " -ddump-hi -ddump-to-file" Process exited with code: ExitFailure 1 Information:25.10.17 16:19 - Compilation completed with 1 error and 0 warnings in 1s 946ms Error:stack: Stack build failed with nonzero exit status }}} -- Comment (by bgamari): What is `exmap`? I don't see a package by this name on Hackage. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 25 18:30:19 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 25 Oct 2017 18:30:19 -0000 Subject: [GHC] #13986: TypeApplications causes parse errors in @-patterns with certain Unicode characters In-Reply-To: <045.43debcfc336746ece79049ad6e0544ea@haskell.org> References: <045.43debcfc336746ece79049ad6e0544ea@haskell.org> Message-ID: <060.82c19ea3909b8994fa0396537ab0c98b@haskell.org> #13986: TypeApplications causes parse errors in @-patterns with certain Unicode characters -------------------------------------+------------------------------------- Reporter: Tikhon | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.0.1 (Parser) | Keywords: Resolution: | TypeApplications 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: | https://phabricator.haskell.org/D4105 -------------------------------------+------------------------------------- Changes (by harpocrates): * differential: => https://phabricator.haskell.org/D4105 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 25 19:47:34 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 25 Oct 2017 19:47:34 -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.27975d0c3d3fbf4f90b8969635ae7b33@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 Ben Gamari ): In [changeset:"bf83435b5c62776072977b9b1fc5aba2bffa97b4/ghc" bf83435/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="bf83435b5c62776072977b9b1fc5aba2bffa97b4" typecheck: Clarify errors mentioned in #14385 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 25 19:47:34 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 25 Oct 2017 19:47:34 -0000 Subject: [GHC] #7258: Compiling DynFlags is jolly slow In-Reply-To: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> References: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> Message-ID: <061.1dc2418db120af9c0bf1f226b5674319@haskell.org> #7258: Compiling DynFlags is jolly slow -------------------------------------+------------------------------------- Reporter: simonpj | Owner: simonpj Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.6.1 Resolution: | Keywords: deriving-perf 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 Ben Gamari ): In [changeset:"2a4c24e40462832a4a97cd7a65119542e842de81/ghc" 2a4c24e4/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="2a4c24e40462832a4a97cd7a65119542e842de81" Make layLeft and reduceDoc stricter (#7258) Making the pretty-printer based assembly output stricter in strategically chosen locations produces a minor performance improvement when compiling large derived Read instance (on the order of 5-10%). Reviewers: austin, bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie Differential Revision: https://phabricator.haskell.org/D4111 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 25 19:54:29 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 25 Oct 2017 19:54:29 -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.cabb9952ba3f302dea3f47863ad85316@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 bgamari): Is this better, lyxia? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 25 20:12:20 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 25 Oct 2017 20:12:20 -0000 Subject: [GHC] #8822: Allow -- ^ Haddock syntax on record constructors In-Reply-To: <047.9e31292a58062fe675a519afe89cb025@haskell.org> References: <047.9e31292a58062fe675a519afe89cb025@haskell.org> Message-ID: <062.ae2495153c20665b8c328b67b46ad7ba@haskell.org> #8822: Allow -- ^ Haddock syntax on record constructors -------------------------------------+------------------------------------- Reporter: Fuuzetsu | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.9 (Parser) | Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #9770, #12050 | Differential Rev(s): Wiki Page: | https://phabricator.haskell.org/D4094 -------------------------------------+------------------------------------- Changes (by harpocrates): * differential: => https://phabricator.haskell.org/D4094 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 25 20:12:40 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 25 Oct 2017 20:12:40 -0000 Subject: [GHC] #12050: Allow haddock comments on non-record types In-Reply-To: <046.f6b7a2b632eb5ba65b0da9770c2d4b66@haskell.org> References: <046.f6b7a2b632eb5ba65b0da9770c2d4b66@haskell.org> Message-ID: <061.c4bdf35e3579df528c56c639a8886091@haskell.org> #12050: Allow haddock comments on non-record types -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.10.3 (Parser) | Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #8822 | Differential Rev(s): Wiki Page: | https://phabricator.haskell.org/D4094 -------------------------------------+------------------------------------- Changes (by harpocrates): * differential: => https://phabricator.haskell.org/D4094 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 25 20:30:44 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 25 Oct 2017 20:30:44 -0000 Subject: [GHC] #14387: listToMaybe doesn't participate in foldr/build fusion In-Reply-To: <043.502b369a22f4944e5a5f0570931d7cbe@haskell.org> References: <043.502b369a22f4944e5a5f0570931d7cbe@haskell.org> Message-ID: <058.83f422e6572c99576e2248c231e8cc52@haskell.org> #14387: listToMaybe doesn't participate in foldr/build fusion -------------------------------------+------------------------------------- Reporter: duog | Owner: duog Type: bug | Status: new Priority: normal | Milestone: Component: Core Libraries | 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 duog): * owner: (none) => duog Comment: Replying to [comment:2 simonpj]: Thank you very much for your explanations. > Note the join point. But `findIndex4` and `findIndex` do not. Maybe that was a typo. Yes it was, sorry about that. > > > Having a join point means constant stack space, not having a join point means linear stack space. > > This definitely isn't true. Here's `findIndex` (the one that does not get a join point): > In the `False` branch inside `go`, there's a tail-call to `go` (no stack growth). In the `True` branch, `go` returns a cons-cell, and stops. Then the `case go x o# of ...` scrutinises that cons cell and returns a `Just`. All done. No stack growth in either case. Ah I see, I didn't understand that tail-calls to let bindings worked like that. I will examine the Notes on join points to try to understand the difference between calling a join point and tail-calling a let binding; I guess that the tail-call is a bit more expensive because the let binding has additional code for the case when it is not tail-called. > > > it seems that changing the definition of listToMaybe to use `foldr` would be a win > > Yes I agree. It's a bit like making `map` use `foldr` rather than being written directly. But you'd need an INLINE pragma on it. > > I can't see a downside. If it doesn't fuse you get the original `listToMaybe` back instead. If someone makes that change (in `base`) do add a Note to explain. I will prepare a patch. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 25 20:44:35 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 25 Oct 2017 20:44:35 -0000 Subject: [GHC] #7258: Compiling DynFlags is jolly slow In-Reply-To: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> References: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> Message-ID: <061.785644a459190047e152f2b1d5824c08@haskell.org> #7258: Compiling DynFlags is jolly slow -------------------------------------+------------------------------------- Reporter: simonpj | Owner: simonpj Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.6.1 Resolution: | Keywords: deriving-perf 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 Ben Gamari ): In [changeset:"df636682f3b8299268d189bfaf6de1d672c19a73/ghc" df636682/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="df636682f3b8299268d189bfaf6de1d672c19a73" Performance improvements linear regAlloc (#7258) When allocating and potentially spilling registers, we need to check the desired allocations against current allocations to decide where we can spill to, cq. which allocations we can toss and if so, how. Previously, this was done by walking the Cartesian product of the current allocations (`assig`) and the allocations to keep (`keep`), which has quadratic complexity. This patch introduces two improvements: 1. pre-filter the `assig` list, because we are only interested in two types of allocations (in register, and in register+memory), which will only make up a small and constant portion of the list; and 2. use set / map operations instead of lists, which reduces algorithmic complexity. Reviewers: austin, bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie Differential Revision: https://phabricator.haskell.org/D4109 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 25 20:44:35 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 25 Oct 2017 20:44:35 -0000 Subject: [GHC] #7169: Warning for incomplete record field label used as function In-Reply-To: <047.31629c8fe32b813e38c132e8d4305995@haskell.org> References: <047.31629c8fe32b813e38c132e8d4305995@haskell.org> Message-ID: <062.c3e6bc06fbf348c21e4a9a2d83680f14@haskell.org> #7169: Warning for incomplete record field label used as function -------------------------------------+------------------------------------- Reporter: goldfire | Owner: nakaji_dayo Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.7 Resolution: | Keywords: Warnings, | newcomer 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): Phab:D4083 Wiki Page: | -------------------------------------+------------------------------------- Comment (by Ben Gamari ): In [changeset:"f7f270eb6ba616feda79d370336db7e66f9ab79c/ghc" f7f270e/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="f7f270eb6ba616feda79d370336db7e66f9ab79c" Implement `-Wpartial-fields` warning (#7169) Warning on declaring a partial record selector. However, disable warn with field names that start with underscore. Test Plan: Added 1 test case. Reviewers: austin, bgamari, simonpj Reviewed By: bgamari, simonpj Subscribers: goldfire, simonpj, duog, rwbarton, thomie GHC Trac Issues: #7169 Differential Revision: https://phabricator.haskell.org/D4083 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 25 20:44:35 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 25 Oct 2017 20:44:35 -0000 Subject: [GHC] #14214: Users guide lies about default optimization level In-Reply-To: <046.736805dbdfc6944b76008d4f99ba283f@haskell.org> References: <046.736805dbdfc6944b76008d4f99ba283f@haskell.org> Message-ID: <061.2df26fbdcb28f45e299bfad8813c7d7e@haskell.org> #14214: Users guide lies about default optimization level -------------------------------------+------------------------------------- Reporter: bgamari | Owner: bgamari Type: bug | Status: new Priority: high | Milestone: 8.4.1 Component: Compiler | Version: 8.2.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Documentation | Unknown/Multiple bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4098 Wiki Page: | -------------------------------------+------------------------------------- Comment (by Ben Gamari ): In [changeset:"2c23fff2e03e77187dc4d01f325f5f43a0e7cad2/ghc" 2c23fff2/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="2c23fff2e03e77187dc4d01f325f5f43a0e7cad2" user-guide: Clarify default optimization flags Begins to fix #14214. [skip ci] Test Plan: Read it. Reviewers: austin Subscribers: rwbarton, thomie GHC Trac Issues: #14214 Differential Revision: https://phabricator.haskell.org/D4098 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 25 20:44:35 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 25 Oct 2017 20:44:35 -0000 Subject: [GHC] #13986: TypeApplications causes parse errors in @-patterns with certain Unicode characters In-Reply-To: <045.43debcfc336746ece79049ad6e0544ea@haskell.org> References: <045.43debcfc336746ece79049ad6e0544ea@haskell.org> Message-ID: <060.2fc8918331ab1820f724a3e27fe457d0@haskell.org> #13986: TypeApplications causes parse errors in @-patterns with certain Unicode characters -------------------------------------+------------------------------------- Reporter: Tikhon | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.0.1 (Parser) | Keywords: Resolution: | TypeApplications 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: | https://phabricator.haskell.org/D4105 -------------------------------------+------------------------------------- Comment (by Ben Gamari ): In [changeset:"821adee12e89dbd0a52fde872b633e4e2e9051dc/ghc" 821adee1/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="821adee12e89dbd0a52fde872b633e4e2e9051dc" Fix a bug in 'alexInputPrevChar' The lexer hacks around unicode by squishing any character into a 'Word8' and then storing the actual character in its state. This happens at 'alexGetByte'. That is all and well, but we ought to be careful that the characters we retrieve via 'alexInputPrevChar' also fit this convention. In fact, #13986 exposes nicely what can go wrong: the regex in the left context of the type application rule uses the '$idchar' character set which relies on the unicode hack. However, a left context corresponds to a call to 'alexInputPrevChar', and we end up passing full blown unicode characters to '$idchar', despite it not being equipped to deal with these. Test Plan: Added a regression test case Reviewers: austin, bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie GHC Trac Issues: #13986 Differential Revision: https://phabricator.haskell.org/D4105 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 25 20:44:59 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 25 Oct 2017 20:44:59 -0000 Subject: [GHC] #14214: Users guide lies about default optimization level In-Reply-To: <046.736805dbdfc6944b76008d4f99ba283f@haskell.org> References: <046.736805dbdfc6944b76008d4f99ba283f@haskell.org> Message-ID: <061.450c900fda25bdc716382480142f5d05@haskell.org> #14214: Users guide lies about default optimization level -------------------------------------+------------------------------------- Reporter: bgamari | Owner: bgamari Type: bug | Status: new Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.2.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Documentation | Unknown/Multiple bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4098 Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * priority: high => normal Comment: Merged comment:6 although I'll leave this open since I think we could improve this further. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 25 20:46:33 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 25 Oct 2017 20:46:33 -0000 Subject: [GHC] #13986: TypeApplications causes parse errors in @-patterns with certain Unicode characters In-Reply-To: <045.43debcfc336746ece79049ad6e0544ea@haskell.org> References: <045.43debcfc336746ece79049ad6e0544ea@haskell.org> Message-ID: <060.d9ddab48742f98fe1c8d7e60bee2d1ff@haskell.org> #13986: TypeApplications causes parse errors in @-patterns with certain Unicode characters -------------------------------------+------------------------------------- Reporter: Tikhon | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.0.1 (Parser) | Keywords: Resolution: fixed | TypeApplications Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: GHC rejects | Test Case: valid program | parser/should_compile/T13986.hs Blocked By: | Blocking: Related Tickets: | Differential Rev(s): phab:D4105 Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * testcase: => parser/should_compile/T13986.hs * status: new => closed * differential: https://phabricator.haskell.org/D4105 => phab:D4105 * resolution: => fixed * milestone: => 8.4.1 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 25 20:48:49 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 25 Oct 2017 20:48:49 -0000 Subject: [GHC] #7169: Warning for incomplete record field label used as function In-Reply-To: <047.31629c8fe32b813e38c132e8d4305995@haskell.org> References: <047.31629c8fe32b813e38c132e8d4305995@haskell.org> Message-ID: <062.dc72586320348e7a4555d3fb749ea311@haskell.org> #7169: Warning for incomplete record field label used as function -------------------------------------+------------------------------------- Reporter: goldfire | Owner: nakaji_dayo Type: feature request | Status: closed Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 7.7 Resolution: fixed | Keywords: Warnings, | newcomer 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): Phab:D4083 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 Wed Oct 25 21:54:38 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 25 Oct 2017 21:54:38 -0000 Subject: [GHC] #14387: listToMaybe doesn't participate in foldr/build fusion In-Reply-To: <043.502b369a22f4944e5a5f0570931d7cbe@haskell.org> References: <043.502b369a22f4944e5a5f0570931d7cbe@haskell.org> Message-ID: <058.a0077eed4c10a00c34e2052dc75701a2@haskell.org> #14387: listToMaybe doesn't participate in foldr/build fusion -------------------------------------+------------------------------------- Reporter: duog | Owner: duog Type: bug | Status: patch Priority: normal | Milestone: Component: Core Libraries | 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:D4126 Wiki Page: | -------------------------------------+------------------------------------- Changes (by duog): * status: new => patch * differential: => Phab:D4126 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 25 22:04:05 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 25 Oct 2017 22:04:05 -0000 Subject: [GHC] #13604: ghci no longer loads dynamic .o files by default if they were built with -O In-Reply-To: <045.626a6b40d9101c93e2935653ef7e4668@haskell.org> References: <045.626a6b40d9101c93e2935653ef7e4668@haskell.org> Message-ID: <060.9ffe59902dc6b3f635da80e661938817@haskell.org> #13604: ghci no longer loads dynamic .o files by default if they were built with -O -------------------------------------+------------------------------------- Reporter: George | Owner: dfeuer Type: bug | Status: patch Priority: highest | Milestone: 8.2.2 Component: Compiler | Version: 8.2.1-rc1 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): Phab:D4123 Wiki Page: | -------------------------------------+------------------------------------- Comment (by dfeuer): elaforge, I think I understand kind of what you're asking for now, but there are some tricky questions about the UI. The biggest question is probably how to make interaction with `-fobject-code` sensible. In particular, we don't currently produce object code (ever) when `-fobject- code` is off. So if I type `ghci -O2 A`, where `A` depends on `B`, what should happen if `B` was not compiled `-O2`? Should we generate object code for `B` anyway to obey `-O2`? That seems a bit surprising. Should we load it interpreted? That seems inconsistent. Or perhaps we should change the interpretation of `-fobject-code` in a slightly different direction. What if we make `:load *A` guarantee that it loads `A` interpreted whether or not `A` has been compiled already and whether or not GHCi was run with `-fobject-code`? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 25 22:27:27 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 25 Oct 2017 22:27:27 -0000 Subject: [GHC] #14390: Panic when defining an instance for (~~) [ppr_equality: homogeneity] Message-ID: <050.b158dc2933d34aa54c38d85462566822@haskell.org> #14390: Panic when defining an instance for (~~) [ppr_equality: homogeneity] -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 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: -------------------------------------+------------------------------------- In GHC 8.2.1 and HEAD, compiling this file panics: {{{#!hs import Data.Type.Equality instance (~~) Int Int }}} {{{ $ /opt/ghc/8.2.1/bin/ghc Bug.hs [1 of 1] Compiling Main ( Bug.hs, Bug.o ) Bug.hs:2:10: error:ghc: panic! (the 'impossible' happened) (GHC version 8.2.1 for x86_64-unknown-linux): ppr_equality: homogeneity ~~ 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/IfaceType.hs:1008:31 in ghc:IfaceType }}} We should probably give a similar error as for when one attempts to define an instance for `(~)`: {{{#!hs instance (~) Int Int }}} {{{ $ /opt/ghc/8.2.1/bin/ghc Bug.hs [1 of 1] Compiling Main ( Bug.hs, Bug.o ) Bug.hs:1:10: error: • Illegal instance declaration for ‘Int ~ Int’ Manual instances of this class are not permitted. • In the instance declaration for ‘(~) Int Int’ | 1 | instance (~) Int Int | ^^^^^^^^^^^ }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Oct 25 23:19:40 2017 From: ghc-devs at haskell.org (GHC) Date: Wed, 25 Oct 2017 23:19:40 -0000 Subject: [GHC] #7169: Warning for incomplete record field label used as function In-Reply-To: <047.31629c8fe32b813e38c132e8d4305995@haskell.org> References: <047.31629c8fe32b813e38c132e8d4305995@haskell.org> Message-ID: <062.c53bc7cc31a59475499ca0c68aada516@haskell.org> #7169: Warning for incomplete record field label used as function -------------------------------------+------------------------------------- Reporter: goldfire | Owner: nakaji_dayo Type: feature request | Status: closed Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 7.7 Resolution: fixed | Keywords: Warnings, | newcomer 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): Phab:D4083 Wiki Page: | -------------------------------------+------------------------------------- Comment (by AntC): Replying to [comment:27 Ben Gamari ]: > {{{ > Warning on declaring a partial record selector. > However, disable warn with field names that start with underscore. > > }}} Eek. I may be too late. Don't the lenses people use underscore prefix on record labels? So that TH can detect that and produce a lens name with the `_` stripped off? Then they're going to miss out on this warning of partiality. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 26 00:03:06 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 26 Oct 2017 00:03:06 -0000 Subject: [GHC] #14387: listToMaybe doesn't participate in foldr/build fusion In-Reply-To: <043.502b369a22f4944e5a5f0570931d7cbe@haskell.org> References: <043.502b369a22f4944e5a5f0570931d7cbe@haskell.org> Message-ID: <058.f0de5d8a17f08a7d7ed09552f137e485@haskell.org> #14387: listToMaybe doesn't participate in foldr/build fusion -------------------------------------+------------------------------------- Reporter: duog | Owner: duog Type: bug | Status: patch Priority: normal | Milestone: Component: Core Libraries | 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:D4126 Wiki Page: | -------------------------------------+------------------------------------- Comment (by Ben Gamari ): In [changeset:"4c06ccb71737b77a8165e888ad75417a425549dd/ghc" 4c06ccb/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="4c06ccb71737b77a8165e888ad75417a425549dd" base: Enable listToMaybe to fuse via foldr/build Test Plan: Consider whether this is a good idea. Reviewers: austin, hvr, bgamari, nomeata Reviewed By: bgamari, nomeata Subscribers: nomeata, rwbarton, thomie GHC Trac Issues: #14387 Differential Revision: https://phabricator.haskell.org/D4126 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 26 00:03:06 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 26 Oct 2017 00:03:06 -0000 Subject: [GHC] #14364: Reduce repetition in derived Read instances In-Reply-To: <046.9abf8af51367f0badd76eab5f23e3eb1@haskell.org> References: <046.9abf8af51367f0badd76eab5f23e3eb1@haskell.org> Message-ID: <061.f2a8164f01e054dc46a7d2af71cf5ec4@haskell.org> #14364: Reduce repetition in derived Read instances -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: task | Status: new Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.2.1 Resolution: | Keywords: deriving Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #10980 #7258 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Ben Gamari ): In [changeset:"dbd81f7e86514498218572b9d978373b1699cc5b/ghc" dbd81f7/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="dbd81f7e86514498218572b9d978373b1699cc5b" Factor out readField (#14364) Improves compiler performance of deriving Read instances, as suggested in the issue. Additionally, we introduce `readSymField`, a companion to `readField` that parses symbol-type fields (where the field name is a symbol, e.g. `(#)`, rather than an alphanumeric identifier. The decision between these two functions is made a compile time, because we already know which one we need based on the field name. Reviewers: austin, hvr, bgamari, RyanGlScott Reviewed By: bgamari Subscribers: RyanGlScott, rwbarton, thomie Differential Revision: https://phabricator.haskell.org/D4108 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 26 00:03:30 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 26 Oct 2017 00:03:30 -0000 Subject: [GHC] #14387: listToMaybe doesn't participate in foldr/build fusion In-Reply-To: <043.502b369a22f4944e5a5f0570931d7cbe@haskell.org> References: <043.502b369a22f4944e5a5f0570931d7cbe@haskell.org> Message-ID: <058.5072d7bdcb94306f0b877345b7ff5908@haskell.org> #14387: listToMaybe doesn't participate in foldr/build fusion -------------------------------------+------------------------------------- Reporter: duog | Owner: duog Type: bug | Status: closed Priority: normal | Milestone: 8.4.1 Component: Core Libraries | 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:D4126 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 Oct 26 06:31:44 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 26 Oct 2017 06:31:44 -0000 Subject: [GHC] #14389: Improved results in GHCi during basic calculations In-Reply-To: <044.095b6c2ec55cfe6869c1e521514f22b5@haskell.org> References: <044.095b6c2ec55cfe6869c1e521514f22b5@haskell.org> Message-ID: <059.8d95c2a0715c821f8adb9257d6e50321@haskell.org> #14389: Improved results in GHCi during basic calculations -------------------------------------+------------------------------------- Reporter: vanto | Owner: (none) Type: feature request | Status: closed Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: invalid | 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 svenpanne): * status: new => closed * resolution: => invalid Comment: Sorry to say, but this ticket is basically the same as your previous tickets #14377 and #14384. The bottom line is: The floating point numbers/operations available on normal HW are fundamentally different from the usual numbers/operations from math. If you want to understand the details, please have a look at ''the'' paper in this area "What Every Computer Scientist Should Know About Floating-Point Arithmetic" (available at e.g. http://www.validlab.com/goldberg/paper.pdf). Your `exp`/`log` result is therefore fully expected, and the same holds for the last example, although there you can calculate in a different domain by adding a `:: Rational` after it. Before opening more tickets in this area, please have a look at that paper first and try to understand Haskell's defaulting mechanism, too. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 26 07:30:49 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 26 Oct 2017 07:30:49 -0000 Subject: [GHC] #7258: Compiling DynFlags is jolly slow In-Reply-To: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> References: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> Message-ID: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> #7258: Compiling DynFlags is jolly slow -------------------------------------+------------------------------------- Reporter: simonpj | Owner: simonpj Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.6.1 Resolution: | Keywords: deriving-perf 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 tdammers): * Attachment "ghc-large-record-types-optimized.png" removed. Performance profiling data for large record types, using -O2. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 26 07:30:49 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 26 Oct 2017 07:30:49 -0000 Subject: [GHC] #7258: Compiling DynFlags is jolly slow In-Reply-To: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> References: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> Message-ID: <061.83c414c189fb985a36fd1b2d09779bc1@haskell.org> #7258: Compiling DynFlags is jolly slow -------------------------------------+------------------------------------- Reporter: simonpj | Owner: simonpj Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.6.1 Resolution: | Keywords: deriving-perf 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 tdammers): * Attachment "ghc-large-record-types-optimized.png" added. Performance graph for various examples, compiling with -O -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 26 07:31:05 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 26 Oct 2017 07:31:05 -0000 Subject: [GHC] #7258: Compiling DynFlags is jolly slow In-Reply-To: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> References: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> Message-ID: <061.d6b4e199b9f72c35241393dd26893040@haskell.org> #7258: Compiling DynFlags is jolly slow -------------------------------------+------------------------------------- Reporter: simonpj | Owner: simonpj Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.6.1 Resolution: | Keywords: deriving-perf 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 tdammers): * Attachment "ghc-large-record-types-optimized-O2.png" added. Performance graph for various examples, compiling with -O2 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 26 07:36:42 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 26 Oct 2017 07:36:42 -0000 Subject: [GHC] #7258: Compiling DynFlags is jolly slow In-Reply-To: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> References: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> Message-ID: <061.ed966167dd72d77129546276ec553f7d@haskell.org> #7258: Compiling DynFlags is jolly slow -------------------------------------+------------------------------------- Reporter: simonpj | Owner: simonpj Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.6.1 Resolution: | Keywords: deriving-perf 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): Updated performance graph: https://ghc.haskell.org/trac/ghc/attachment/ticket/7258/ghc-large-record- types-optimized.png (this one uses -O, not -O2) Key observation: read, read-appl and show "explode" while all the other examples, including getline-appl and getline, behave properly. A sample profile like the one for 400-field read, shows that the bottleneck is no longer ASM output or register allocation anymore once -O is involved: {{{ Thu Oct 26 01:25 2017 Time and Allocation Profiling Report (Final) ghc-stage2 +RTS -p -h -RTS -B/home/tobias/well- typed/devel/ghc/inplace/lib -B/home/tobias/well- typed/devel/ghc/inplace/lib -O -fforce-recomp -c examples/t-400-read.hs total time = 128.62 secs (128624 ticks @ 1000 us, 1 processor) total alloc = 37,659,351,320 bytes (excludes profiling overheads) COST CENTRE MODULE SRC %time %alloc sink CmmPipeline compiler/cmm/CmmPipeline.hs:(104,13)-(105,59) 77.8 23.6 SimplTopBinds SimplCore compiler/simplCore/SimplCore.hs:761:39-74 9.6 30.0 FloatOutwards SimplCore compiler/simplCore/SimplCore.hs:471:40-66 3.0 10.4 RegAlloc-linear AsmCodeGen compiler/nativeGen/AsmCodeGen.hs:(658,27)-(660,55) 1.6 5.0 OccAnal SimplCore compiler/simplCore/SimplCore.hs:(739,22)-(740,67) 1.1 4.2 pprNativeCode AsmCodeGen compiler/nativeGen/AsmCodeGen.hs:(529,37)-(530,65) 1.0 4.7 NewStranal SimplCore compiler/simplCore/SimplCore.hs:480:40-63 0.9 4.2 CoreTidy HscMain compiler/main/HscMain.hs:1253:27-67 0.7 2.9 StgCmm HscMain compiler/main/HscMain.hs:(1426,13)-(1427,62) 0.6 1.9 regLiveness AsmCodeGen compiler/nativeGen/AsmCodeGen.hs:(591,17)-(593,52) 0.5 1.4 genMachCode AsmCodeGen compiler/nativeGen/AsmCodeGen.hs:(580,17)-(582,62) 0.4 1.3 NativeCodeGen CodeOutput compiler/main/CodeOutput.hs:171:18-78 0.4 1.6 CommonSubExpr SimplCore compiler/simplCore/SimplCore.hs:462:40-56 0.2 1.1 deSugar HscMain compiler/main/HscMain.hs:511:7-44 0.2 1.1 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 26 08:05:08 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 26 Oct 2017 08:05:08 -0000 Subject: [GHC] #14254: The Binary instance for TypeRep smells a bit expensive In-Reply-To: <045.b0b485439de28cadfa61420f4ccc13a7@haskell.org> References: <045.b0b485439de28cadfa61420f4ccc13a7@haskell.org> Message-ID: <060.b7a479875bd3af399695e93122a294fb@haskell.org> #14254: The Binary instance for TypeRep smells a bit expensive -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.2.1 Resolution: | Keywords: Typeable Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: #14337 | Differential Rev(s): Phab:D3998, Wiki Page: | Phab:D4082, Phab:D4085 -------------------------------------+------------------------------------- Comment (by dfeuer): Replying to [comment:14 simonpj]: > and if the cache field is strict you build an infinite data structure. I don't need the cache field to be strict. I just need to force values before installing them in that field, except when constructing `typeRep @Type`. I think I need to know where in the solver we deal with the special case of `typeRep @Type`, which I ''think'' is already a special case somewhere or other. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 26 08:19:54 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 26 Oct 2017 08:19:54 -0000 Subject: [GHC] #7258: Compiling DynFlags is jolly slow In-Reply-To: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> References: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> Message-ID: <061.fb8e40b805630811372862507a968be3@haskell.org> #7258: Compiling DynFlags is jolly slow -------------------------------------+------------------------------------- Reporter: simonpj | Owner: simonpj Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.6.1 Resolution: | Keywords: deriving-perf 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): > read, read-appl and show "explode" while all the other examples, including getline-appl and getline, behave properly. Very good! {{{ sink CmmPipeline compiler/cmm/CmmPipeline.hs:(104,13)-(105,59) 77.8 23.6 SimplTopBinds SimplCore compiler/simplCore/SimplCore.hs:761:39-74 9.6 30.0 FloatOutwards SimplCore compiler/simplCore/SimplCore.hs:471:40-66 3.0 10.4 }}} What does `-dshow-passes` show about the program size? I.e. are we getting very large Core? So `sink` in C-- seems very slow. Nearly 4 bytes in 5 of all allocation is in tis pass alone. Is this a non-linear algorithmic effect. e.g if you double the size of the input, does the `sink` time go up non-linearly while `simplTopBinds` goes up linearly? That's my guess. (Related question: does `sink` show up a a big item when compiling "normal" programs?) Guessing: the "shape" of the C-- code makes `sink` behave very badly. Can you characterise what that shape is, and where the algorithmic badness comes from? This is good... fixing these performance bumps will likely help ALL programs, even ones that don't hit the really bad spots. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 26 08:27:54 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 26 Oct 2017 08:27:54 -0000 Subject: [GHC] #14254: The Binary instance for TypeRep smells a bit expensive In-Reply-To: <045.b0b485439de28cadfa61420f4ccc13a7@haskell.org> References: <045.b0b485439de28cadfa61420f4ccc13a7@haskell.org> Message-ID: <060.765c8ec6231d4febbed5cb583557207d@haskell.org> #14254: The Binary instance for TypeRep smells a bit expensive -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.2.1 Resolution: | Keywords: Typeable Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: #14337 | Differential Rev(s): Phab:D3998, Wiki Page: | Phab:D4082, Phab:D4085 -------------------------------------+------------------------------------- Comment (by simonpj): All this is re Phab:D4085. > I don't need the cache field to be strict. I just need to force values before installing them in that field, Right: and that happens in the "smart constructor", `mkTrApp`. Doesn't the plan in comment:14 work? Just spot the special case in `mkTrApp`; and call `mkTrApp` whenever constructing a `TrApp`. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 26 08:39:23 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 26 Oct 2017 08:39:23 -0000 Subject: [GHC] #14390: Panic when defining an instance for (~~) [ppr_equality: homogeneity] In-Reply-To: <050.b158dc2933d34aa54c38d85462566822@haskell.org> References: <050.b158dc2933d34aa54c38d85462566822@haskell.org> Message-ID: <065.1b265e867facf3ca900ce3eaeaf29b61@haskell.org> #14390: Panic when defining an instance for (~~) [ppr_equality: homogeneity] -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 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): > We should probably give a similar error as for when one attempts to define an instance for (~): Yes please! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 26 10:12:31 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 26 Oct 2017 10:12:31 -0000 Subject: [GHC] #14389: Improved results in GHCi during basic calculations In-Reply-To: <044.095b6c2ec55cfe6869c1e521514f22b5@haskell.org> References: <044.095b6c2ec55cfe6869c1e521514f22b5@haskell.org> Message-ID: <059.032373c8263aca472eee4d4257f8c9fe@haskell.org> #14389: Improved results in GHCi during basic calculations -------------------------------------+------------------------------------- Reporter: vanto | 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: Other | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by vanto): * status: closed => new * resolution: invalid => Comment: Hello svenpanne, happy to read you again. Sorry to say, but when you solve these equations in Xcas (formal computation) or in Wolfram Mathematica, the results are just, fair, rightful (i.e 100 or 0) I know what's in this paper for a long time. in the past, when I was younger I started to calculate with a slide-rule and now I use a calculator. I am new to Haskell, not in this word! so if you can not do it, just say "I do not know how to do it." There is no shame in that. I reopen this ticket just to see it closed by you again, apparently you like playing with tickets, is'nt it? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 26 10:25:47 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 26 Oct 2017 10:25:47 -0000 Subject: [GHC] #14389: Improved results in GHCi during basic calculations In-Reply-To: <044.095b6c2ec55cfe6869c1e521514f22b5@haskell.org> References: <044.095b6c2ec55cfe6869c1e521514f22b5@haskell.org> Message-ID: <059.35a38e261d2b5ebe5ae129498e5cb8c0@haskell.org> #14389: Improved results in GHCi during basic calculations -------------------------------------+------------------------------------- Reporter: vanto | 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: Other | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by hsyl20): > I know what's in this paper for a long time. Your memory fails you then as you don't seem to understand the difference between formal and floating-point computations. > I reopen this ticket just to see it closed by you again, apparently you like playing with tickets, is'nt it? Could you stop trolling? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 26 10:26:01 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 26 Oct 2017 10:26:01 -0000 Subject: [GHC] #14389: Improved results in GHCi during basic calculations In-Reply-To: <044.095b6c2ec55cfe6869c1e521514f22b5@haskell.org> References: <044.095b6c2ec55cfe6869c1e521514f22b5@haskell.org> Message-ID: <059.68486202161f740366b98551803882cd@haskell.org> #14389: Improved results in GHCi during basic calculations -------------------------------------+------------------------------------- Reporter: vanto | Owner: (none) Type: feature request | Status: closed Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: invalid | 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 hsyl20): * status: new => closed * resolution: => invalid -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 26 10:37:22 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 26 Oct 2017 10:37:22 -0000 Subject: [GHC] #7258: Compiling DynFlags is jolly slow In-Reply-To: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> References: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> Message-ID: <061.8a47a5385150b9d504cfab417e39eff5@haskell.org> #7258: Compiling DynFlags is jolly slow -------------------------------------+------------------------------------- Reporter: simonpj | Owner: simonpj Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.6.1 Resolution: | Keywords: deriving-perf 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:57 simonpj]: > > read, read-appl and show "explode" while all the other examples, including getline-appl and getline, behave properly. > > Very good! > > {{{ > sink CmmPipeline compiler/cmm/CmmPipeline.hs:(104,13)-(105,59) 77.8 23.6 > SimplTopBinds SimplCore compiler/simplCore/SimplCore.hs:761:39-74 9.6 30.0 > FloatOutwards SimplCore compiler/simplCore/SimplCore.hs:471:40-66 3.0 10.4 > }}} > > What does `-dshow-passes` show about the program size? I.e. are we getting very large Core? For a 100-line read example: {{{ Glasgow Haskell Compiler, Version 8.3.20171016, stage 2 booted by GHC version 8.0.1 Using binary package database: /home/tobias/well- typed/devel/ghc/inplace/lib/package.conf.d/package.cache package flags [] loading package database /home/tobias/well- typed/devel/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.3 wired-in package dph-seq not found. wired-in package dph-par not found. *** Checking old interface for D (use -ddump-hi-diffs for more details): *** Parser [D]: !!! Parser [D]: finished in 3.22 milliseconds, allocated 3.170 megabytes *** Renamer/typechecker [D]: !!! Renamer/typechecker [D]: finished in 124.33 milliseconds, allocated 72.473 megabytes *** Desugar [D]: Result size of Desugar (after optimization) = {terms: 2,667, types: 11,534, coercions: 0, joins: 0/0} !!! Desugar [D]: finished in 174.52 milliseconds, allocated 59.456 megabytes *** Simplifier [D]: Result size of Simplifier iteration=1 = {terms: 7,375, types: 18,990, coercions: 6,881, joins: 0/913} Result size of Simplifier iteration=2 = {terms: 3,722, types: 13,604, coercions: 1,351, joins: 0/198} Result size of Simplifier iteration=3 = {terms: 3,319, types: 12,598, coercions: 1,342, joins: 0/1} Result size of Simplifier = {terms: 3,319, types: 12,598, coercions: 1,342, joins: 0/1} !!! Simplifier [D]: finished in 1306.06 milliseconds, allocated 749.648 megabytes *** Specialise [D]: Result size of Specialise = {terms: 3,319, types: 12,598, coercions: 1,342, joins: 0/1} !!! Specialise [D]: finished in 19.96 milliseconds, allocated 17.006 megabytes *** Float out(FOS {Lam = Just 0, Consts = True, OverSatApps = False}) [D]: Result size of Float out(FOS {Lam = Just 0, Consts = True, OverSatApps = False}) = {terms: 4,923, types: 15,504, coercions: 1,342, joins: 0/0} !!! Float out(FOS {Lam = Just 0, Consts = True, OverSatApps = False}) [D]: finished in 122.82 milliseconds, allocated 103.551 megabytes *** Simplifier [D]: Result size of Simplifier iteration=1 = {terms: 4,115, types: 13,888, coercions: 1,342, joins: 0/0} Result size of Simplifier = {terms: 4,115, types: 13,888, coercions: 1,342, joins: 0/0} !!! Simplifier [D]: finished in 216.40 milliseconds, allocated 122.592 megabytes *** Simplifier [D]: Result size of Simplifier iteration=1 = {terms: 4,115, types: 13,282, coercions: 1,342, joins: 0/0} Result size of Simplifier = {terms: 4,115, types: 13,282, coercions: 1,342, joins: 0/0} !!! Simplifier [D]: finished in 183.50 milliseconds, allocated 131.494 megabytes *** Simplifier [D]: Result size of Simplifier iteration=1 = {terms: 4,523, types: 14,200, coercions: 1,342, joins: 0/0} Result size of Simplifier = {terms: 4,523, types: 14,200, coercions: 1,342, joins: 0/0} !!! Simplifier [D]: finished in 183.89 milliseconds, allocated 126.382 megabytes *** Float inwards [D]: Result size of Float inwards = {terms: 4,523, types: 14,200, coercions: 1,342, joins: 0/0} !!! Float inwards [D]: finished in 8.67 milliseconds, allocated 4.238 megabytes *** Called arity analysis [D]: Result size of Called arity analysis = {terms: 4,523, types: 14,200, coercions: 1,342, joins: 0/0} !!! Called arity analysis [D]: finished in 5.66 milliseconds, allocated 5.974 megabytes *** Simplifier [D]: Result size of Simplifier = {terms: 4,523, types: 14,200, coercions: 1,342, joins: 0/0} !!! Simplifier [D]: finished in 67.09 milliseconds, allocated 62.910 megabytes *** Demand analysis [D]: Result size of Demand analysis = {terms: 4,523, types: 14,200, coercions: 1,342, joins: 0/0} !!! Demand analysis [D]: finished in 170.27 milliseconds, allocated 91.193 megabytes *** Worker Wrapper binds [D]: Result size of Worker Wrapper binds = {terms: 4,541, types: 14,225, coercions: 1,342, joins: 0/3} !!! Worker Wrapper binds [D]: finished in 5.09 milliseconds, allocated 3.614 megabytes *** Simplifier [D]: Result size of Simplifier iteration=1 = {terms: 4,530, types: 14,215, coercions: 1,342, joins: 0/0} Result size of Simplifier = {terms: 4,530, types: 14,215, coercions: 1,342, joins: 0/0} !!! Simplifier [D]: finished in 351.93 milliseconds, allocated 219.389 megabytes *** Float out(FOS {Lam = Just 0, Consts = True, OverSatApps = True}) [D]: Result size of Float out(FOS {Lam = Just 0, Consts = True, OverSatApps = True}) = {terms: 4,530, types: 14,215, coercions: 1,342, joins: 0/0} !!! Float out(FOS {Lam = Just 0, Consts = True, OverSatApps = True}) [D]: finished in 268.13 milliseconds, allocated 280.555 megabytes *** Common sub-expression [D]: Result size of Common sub-expression = {terms: 3,740, types: 13,522, coercions: 1,342, joins: 0/0} !!! Common sub-expression [D]: finished in 38.50 milliseconds, allocated 48.593 megabytes *** Float inwards [D]: Result size of Float inwards = {terms: 3,740, types: 13,522, coercions: 1,342, joins: 0/0} !!! Float inwards [D]: finished in 5.37 milliseconds, allocated 3.369 megabytes *** Simplifier [D]: Result size of Simplifier = {terms: 2,952, types: 12,337, coercions: 1,342, joins: 0/0} !!! Simplifier [D]: finished in 140.01 milliseconds, allocated 98.855 megabytes *** Demand analysis [D]: Result size of Demand analysis = {terms: 2,952, types: 12,337, coercions: 1,342, joins: 0/0} !!! Demand analysis [D]: finished in 77.63 milliseconds, allocated 86.076 megabytes *** CoreTidy [D]: Result size of Tidy Core = {terms: 2,952, types: 12,337, coercions: 1,342, joins: 0/0} !!! CoreTidy [D]: finished in 54.47 milliseconds, allocated 69.051 megabytes Created temporary directory: /tmp/ghc27776_0 *** CorePrep [D]: Result size of CorePrep = {terms: 3,569, types: 13,155, coercions: 1,342, joins: 0/204} !!! CorePrep [D]: finished in 25.73 milliseconds, allocated 32.097 megabytes *** Stg2Stg: *** CodeGen [D]: !!! CodeGen [D]: finished in 2109.26 milliseconds, allocated 1630.642 megabytes *** Assembler: *** Deleting temp files: Warning: deleting non-existent /tmp/ghc27776_0/ghc_2.c *** Deleting temp dirs: }}} At 200 lines, we're looking at: {{{ Glasgow Haskell Compiler, Version 8.3.20171016, stage 2 booted by GHC version 8.0.1 Using binary package database: /home/tobias/well- typed/devel/ghc/inplace/lib/package.conf.d/package.cache package flags [] loading package database /home/tobias/well- typed/devel/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.3 wired-in package dph-seq not found. wired-in package dph-par not found. *** Checking old interface for D (use -ddump-hi-diffs for more details): *** Parser [D]: !!! Parser [D]: finished in 3.80 milliseconds, allocated 6.207 megabytes *** Renamer/typechecker [D]: !!! Renamer/typechecker [D]: finished in 230.12 milliseconds, allocated 138.058 megabytes *** Desugar [D]: Result size of Desugar (after optimization) = {terms: 5,267, types: 43,034, coercions: 0, joins: 0/0} !!! Desugar [D]: finished in 289.66 milliseconds, allocated 201.767 megabytes *** Simplifier [D]: Result size of Simplifier iteration=1 = {terms: 14,575, types: 57,790, coercions: 13,681, joins: 0/1,813} Result size of Simplifier iteration=2 = {terms: 7,322, types: 47,104, coercions: 2,651, joins: 0/398} Result size of Simplifier iteration=3 = {terms: 6,519, types: 45,098, coercions: 2,642, joins: 0/1} Result size of Simplifier = {terms: 6,519, types: 45,098, coercions: 2,642, joins: 0/1} !!! Simplifier [D]: finished in 5652.80 milliseconds, allocated 2700.163 megabytes *** Specialise [D]: Result size of Specialise = {terms: 6,519, types: 45,098, coercions: 2,642, joins: 0/1} !!! Specialise [D]: finished in 62.79 milliseconds, allocated 58.261 megabytes *** Float out(FOS {Lam = Just 0, Consts = True, OverSatApps = False}) [D]: Result size of Float out(FOS {Lam = Just 0, Consts = True, OverSatApps = False}) = {terms: 9,723, types: 50,904, coercions: 2,642, joins: 0/0} !!! Float out(FOS {Lam = Just 0, Consts = True, OverSatApps = False}) [D]: finished in 401.80 milliseconds, allocated 374.441 megabytes *** Simplifier [D]: Result size of Simplifier iteration=1 = {terms: 8,115, types: 47,688, coercions: 2,642, joins: 0/0} Result size of Simplifier = {terms: 8,115, types: 47,688, coercions: 2,642, joins: 0/0} !!! Simplifier [D]: finished in 754.47 milliseconds, allocated 393.159 megabytes *** Simplifier [D]: Result size of Simplifier iteration=1 = {terms: 8,115, types: 46,482, coercions: 2,642, joins: 0/0} Result size of Simplifier = {terms: 8,115, types: 46,482, coercions: 2,642, joins: 0/0} !!! Simplifier [D]: finished in 579.29 milliseconds, allocated 411.892 megabytes *** Simplifier [D]: Result size of Simplifier iteration=1 = {terms: 8,923, types: 48,300, coercions: 2,642, joins: 0/0} Result size of Simplifier = {terms: 8,923, types: 48,300, coercions: 2,642, joins: 0/0} !!! Simplifier [D]: finished in 630.25 milliseconds, allocated 382.851 megabytes *** Float inwards [D]: Result size of Float inwards = {terms: 8,923, types: 48,300, coercions: 2,642, joins: 0/0} !!! Float inwards [D]: finished in 8.17 milliseconds, allocated 8.300 megabytes *** Called arity analysis [D]: Result size of Called arity analysis = {terms: 8,923, types: 48,300, coercions: 2,642, joins: 0/0} !!! Called arity analysis [D]: finished in 21.61 milliseconds, allocated 11.860 megabytes *** Simplifier [D]: Result size of Simplifier = {terms: 8,923, types: 48,300, coercions: 2,642, joins: 0/0} !!! Simplifier [D]: finished in 362.68 milliseconds, allocated 190.967 megabytes *** Demand analysis [D]: Result size of Demand analysis = {terms: 8,923, types: 48,300, coercions: 2,642, joins: 0/0} !!! Demand analysis [D]: finished in 551.36 milliseconds, allocated 339.529 megabytes *** Worker Wrapper binds [D]: Result size of Worker Wrapper binds = {terms: 8,941, types: 48,325, coercions: 2,642, joins: 0/3} !!! Worker Wrapper binds [D]: finished in 7.70 milliseconds, allocated 11.542 megabytes *** Simplifier [D]: Result size of Simplifier iteration=1 = {terms: 8,930, types: 48,315, coercions: 2,642, joins: 0/0} Result size of Simplifier = {terms: 8,930, types: 48,315, coercions: 2,642, joins: 0/0} !!! Simplifier [D]: finished in 1307.95 milliseconds, allocated 727.784 megabytes *** Float out(FOS {Lam = Just 0, Consts = True, OverSatApps = True}) [D]: Result size of Float out(FOS {Lam = Just 0, Consts = True, OverSatApps = True}) = {terms: 8,930, types: 48,315, coercions: 2,642, joins: 0/0} !!! Float out(FOS {Lam = Just 0, Consts = True, OverSatApps = True}) [D]: finished in 1393.21 milliseconds, allocated 1078.391 megabytes *** Common sub-expression [D]: Result size of Common sub-expression = {terms: 7,340, types: 46,922, coercions: 2,642, joins: 0/0} !!! Common sub-expression [D]: finished in 227.12 milliseconds, allocated 194.184 megabytes *** Float inwards [D]: Result size of Float inwards = {terms: 7,340, types: 46,922, coercions: 2,642, joins: 0/0} !!! Float inwards [D]: finished in 11.63 milliseconds, allocated 6.545 megabytes *** Simplifier [D]: Result size of Simplifier = {terms: 5,752, types: 44,537, coercions: 2,642, joins: 0/0} !!! Simplifier [D]: finished in 590.60 milliseconds, allocated 349.746 megabytes *** Demand analysis [D]: Result size of Demand analysis = {terms: 5,752, types: 44,537, coercions: 2,642, joins: 0/0} !!! Demand analysis [D]: finished in 485.19 milliseconds, allocated 330.909 megabytes *** CoreTidy [D]: Result size of Tidy Core = {terms: 5,752, types: 44,537, coercions: 2,642, joins: 0/0} !!! CoreTidy [D]: finished in 293.13 milliseconds, allocated 258.898 megabytes Created temporary directory: /tmp/ghc18725_0 *** CorePrep [D]: Result size of CorePrep = {terms: 6,969, types: 46,155, coercions: 2,642, joins: 0/404} !!! CorePrep [D]: finished in 163.49 milliseconds, allocated 113.842 megabytes *** Stg2Stg: *** CodeGen [D]: !!! CodeGen [D]: finished in 23041.19 milliseconds, allocated 12665.144 megabytes *** Assembler: *** Deleting temp files: Warning: deleting non-existent /tmp/ghc18725_0/ghc_2.c *** Deleting temp dirs: }}} Not sure whether this qualifies as "unusually large". `-ddump-cmm` shows that the C-- for a 100-field read instance is more than twice as large as that for the 100-field getline example (39234 lines vs 14895), but size alone doesn't explain the huge difference. However, at 300 fields, the read example produces 237541 lines of C--, while getline grows roughly linearly, to 47312 lines, meaning that there is definitely some sort of nonlinearity going on wrt C-- code size. > So `sink` in C-- seems very slow. Nearly 4 bytes in 5 of all allocation is in tis pass alone. Is this a non-linear algorithmic effect. e.g if you double the size of the input, does the `sink` time go up non-linearly while `simplTopBinds` goes up linearly? That's my guess. Yes, in fact it does, quite clearly so: 10-field example: {{{ Wed Oct 25 14:57 2017 Time and Allocation Profiling Report (Final) ghc-stage2 +RTS -p -h -RTS -B/home/tobias/well- typed/devel/ghc/inplace/lib -B/home/tobias/well- typed/devel/ghc/inplace/lib -O -fforce-recomp -c examples/t-10-read.hs total time = 0.19 secs (188 ticks @ 1000 us, 1 processor) total alloc = 134,109,112 bytes (excludes profiling overheads) COST CENTRE MODULE SRC %time %alloc SimplTopBinds SimplCore compiler/simplCore/SimplCore.hs:761:39-74 35.6 28.7 tc_rn_src_decls TcRnDriver compiler/typecheck/TcRnDriver.hs:(493,4)-(555,7) 9.0 9.0 OccAnal SimplCore compiler/simplCore/SimplCore.hs:(739,22)-(740,67) 4.8 5.5 FloatOutwards SimplCore compiler/simplCore/SimplCore.hs:471:40-66 4.3 5.1 pprNativeCode AsmCodeGen compiler/nativeGen/AsmCodeGen.hs:(529,37)-(530,65) 3.7 3.5 tcRnImports TcRnDriver compiler/typecheck/TcRnDriver.hs:240:20-50 3.7 3.6 StgCmm HscMain compiler/main/HscMain.hs:(1426,13)-(1427,62) 3.7 2.1 sink CmmPipeline compiler/cmm/CmmPipeline.hs:(104,13)-(105,59) 3.2 1.5 setSessionDynFlags GHC compiler/main/GHC.hs:(578,1)-(584,16) 3.2 4.7 NativeCodeGen CodeOutput compiler/main/CodeOutput.hs:171:18-78 2.1 0.9 NewStranal SimplCore compiler/simplCore/SimplCore.hs:480:40-63 2.1 2.9 bin_tycldecls HscTypes compiler/main/HscTypes.hs:1085:52-57 1.6 1.0 initGhcMonad GHC compiler/main/GHC.hs:(493,1)-(503,25) 1.6 4.7 MAIN MAIN 1.1 0.3 fixStgRegisters AsmCodeGen compiler/nativeGen/AsmCodeGen.hs:566:17-42 1.1 0.2 genMachCode AsmCodeGen compiler/nativeGen/AsmCodeGen.hs:(580,17)-(582,62) 1.1 1.3 shortcutBranches AsmCodeGen compiler/nativeGen/AsmCodeGen.hs:694:17-54 1.1 0.2 elimCommonBlocks CmmPipeline compiler/cmm/CmmPipeline.hs:(71,13)-(72,76) 1.1 1.0 CAF PrimOp 1.1 0.5 CAF PrelInfo 1.1 1.0 deSugar HscMain compiler/main/HscMain.hs:511:7-44 1.1 0.9 CorePrep HscMain compiler/main/HscMain.hs:(1313,24)-(1314,57) 1.1 0.6 withCleanupSession GHC compiler/main/GHC.hs:(466,1)-(475,37) 1.1 0.8 regLiveness AsmCodeGen compiler/nativeGen/AsmCodeGen.hs:(591,17)-(593,52) 0.5 2.0 RegAlloc-linear AsmCodeGen compiler/nativeGen/AsmCodeGen.hs:(658,27)-(660,55) 0.5 2.4 layoutStack CmmPipeline compiler/cmm/CmmPipeline.hs:(97,13)-(99,40) 0.5 1.0 CoreTidy HscMain compiler/main/HscMain.hs:1253:27-67 0.5 1.0 }}} 100 fields: {{{ Wed Oct 25 15:00 2017 Time and Allocation Profiling Report (Final) ghc-stage2 +RTS -p -h -RTS -B/home/tobias/well- typed/devel/ghc/inplace/lib -B/home/tobias/well- typed/devel/ghc/inplace/lib -O -fforce-recomp -c examples/t-100-read.hs total time = 3.10 secs (3103 ticks @ 1000 us, 1 processor) total alloc = 2,397,379,664 bytes (excludes profiling overheads) COST CENTRE MODULE SRC %time %alloc SimplTopBinds SimplCore compiler/simplCore/SimplCore.hs:761:39-74 38.9 36.6 sink CmmPipeline compiler/cmm/CmmPipeline.hs:(104,13)-(105,59) 16.0 7.3 FloatOutwards SimplCore compiler/simplCore/SimplCore.hs:471:40-66 7.9 10.8 OccAnal SimplCore compiler/simplCore/SimplCore.hs:(739,22)-(740,67) 4.3 5.8 pprNativeCode AsmCodeGen compiler/nativeGen/AsmCodeGen.hs:(529,37)-(530,65) 4.1 5.3 RegAlloc-linear AsmCodeGen compiler/nativeGen/AsmCodeGen.hs:(658,27)-(660,55) 3.8 4.6 StgCmm HscMain compiler/main/HscMain.hs:(1426,13)-(1427,62) 2.8 2.5 NewStranal SimplCore compiler/simplCore/SimplCore.hs:480:40-63 2.8 4.8 regLiveness AsmCodeGen compiler/nativeGen/AsmCodeGen.hs:(591,17)-(593,52) 1.8 1.9 CoreTidy HscMain compiler/main/HscMain.hs:1253:27-67 1.8 2.9 genMachCode AsmCodeGen compiler/nativeGen/AsmCodeGen.hs:(580,17)-(582,62) 1.8 1.6 tc_rn_src_decls TcRnDriver compiler/typecheck/TcRnDriver.hs:(493,4)-(555,7) 1.3 1.3 NativeCodeGen CodeOutput compiler/main/CodeOutput.hs:171:18-78 1.0 1.7 CommonSubExpr SimplCore compiler/simplCore/SimplCore.hs:462:40-56 0.8 1.2 deSugar HscMain compiler/main/HscMain.hs:511:7-44 0.8 1.3 }}} 400 fields: {{{ Thu Oct 26 01:25 2017 Time and Allocation Profiling Report (Final) ghc-stage2 +RTS -p -h -RTS -B/home/tobias/well- typed/devel/ghc/inplace/lib -B/home/tobias/well- typed/devel/ghc/inplace/lib -O -fforce-recomp -c examples/t-400-read.hs total time = 128.62 secs (128624 ticks @ 1000 us, 1 processor) total alloc = 37,659,351,320 bytes (excludes profiling overheads) COST CENTRE MODULE SRC %time %alloc sink CmmPipeline compiler/cmm/CmmPipeline.hs:(104,13)-(105,59) 77.8 23.6 SimplTopBinds SimplCore compiler/simplCore/SimplCore.hs:761:39-74 9.6 30.0 FloatOutwards SimplCore compiler/simplCore/SimplCore.hs:471:40-66 3.0 10.4 RegAlloc-linear AsmCodeGen compiler/nativeGen/AsmCodeGen.hs:(658,27)-(660,55) 1.6 5.0 OccAnal SimplCore compiler/simplCore/SimplCore.hs:(739,22)-(740,67) 1.1 4.2 pprNativeCode AsmCodeGen compiler/nativeGen/AsmCodeGen.hs:(529,37)-(530,65) 1.0 4.7 NewStranal SimplCore compiler/simplCore/SimplCore.hs:480:40-63 0.9 4.2 CoreTidy HscMain compiler/main/HscMain.hs:1253:27-67 0.7 2.9 StgCmm HscMain compiler/main/HscMain.hs:(1426,13)-(1427,62) 0.6 1.9 regLiveness AsmCodeGen compiler/nativeGen/AsmCodeGen.hs:(591,17)-(593,52) 0.5 1.4 genMachCode AsmCodeGen compiler/nativeGen/AsmCodeGen.hs:(580,17)-(582,62) 0.4 1.3 NativeCodeGen CodeOutput compiler/main/CodeOutput.hs:171:18-78 0.4 1.6 CommonSubExpr SimplCore compiler/simplCore/SimplCore.hs:462:40-56 0.2 1.1 deSugar HscMain compiler/main/HscMain.hs:511:7-44 0.2 1.1 }}} > (Related question: does `sink` show up a a big item when compiling "normal" programs?) It does, but nowhere near this dominantly. E.g. getline, 400 fields: {{{ Thu Oct 26 02:54 2017 Time and Allocation Profiling Report (Final) ghc-stage2 +RTS -p -h -RTS -B/home/tobias/well- typed/devel/ghc/inplace/lib -B/home/tobias/well- typed/devel/ghc/inplace/lib -O -fforce-recomp -c examples/t-400-getline.hs total time = 14.13 secs (14126 ticks @ 1000 us, 1 processor) total alloc = 12,479,030,504 bytes (excludes profiling overheads) COST CENTRE MODULE SRC %time %alloc sink CmmPipeline compiler/cmm/CmmPipeline.hs:(104,13)-(105,59) 31.7 3.3 SimplTopBinds SimplCore compiler/simplCore/SimplCore.hs:761:39-74 24.7 39.0 OccAnal SimplCore compiler/simplCore/SimplCore.hs:(739,22)-(740,67) 7.2 9.7 NewStranal SimplCore compiler/simplCore/SimplCore.hs:480:40-63 6.5 10.4 CoreTidy HscMain compiler/main/HscMain.hs:1253:27-67 5.2 7.6 FloatOutwards SimplCore compiler/simplCore/SimplCore.hs:471:40-66 4.1 6.2 StgCmm HscMain compiler/main/HscMain.hs:(1426,13)-(1427,62) 2.0 1.6 deSugar HscMain compiler/main/HscMain.hs:511:7-44 2.0 3.3 CommonSubExpr SimplCore compiler/simplCore/SimplCore.hs:462:40-56 1.9 3.2 CorePrep HscMain compiler/main/HscMain.hs:(1313,24)-(1314,57) 1.4 2.5 Specialise SimplCore compiler/simplCore/SimplCore.hs:486:40-50 0.8 1.3 StgCse SimplStg compiler/simplStg/SimplStg.hs:(88,14)-(91,44) 0.5 1.3 }}} > Guessing: the "shape" of the C-- code makes `sink` behave very badly. Can you characterise what that shape is, and where the algorithmic badness comes from? Not yet, but I have a hunch that it's simply a matter of producing too much of it. Maybe there is quadratic behavior there, where the number of lines of C-- grows proportionally with the square of the number of fields? That seems like a plausible explanation so far. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 26 10:50:34 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 26 Oct 2017 10:50:34 -0000 Subject: [GHC] #7258: Compiling DynFlags is jolly slow In-Reply-To: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> References: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> Message-ID: <061.352faef0e827ff4a003999a1d0a15569@haskell.org> #7258: Compiling DynFlags is jolly slow -------------------------------------+------------------------------------- Reporter: simonpj | Owner: simonpj Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.6.1 Resolution: | Keywords: deriving-perf 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): > Maybe there is quadratic behavior there, where the number of lines of C-- grows proportionally with the square of the number of fields? But then all the C-- passes would get slower, wouldn't they? Still it'd be easy to measure code size of * Core * C-- as the number of fields increases. My guess is that there's an algorithmic blow-up (quadratic or worse) in `sink`, so that it starts to dominate when there is a very large `CmmProc`. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 26 12:31:50 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 26 Oct 2017 12:31:50 -0000 Subject: [GHC] #7258: Compiling DynFlags is jolly slow In-Reply-To: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> References: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> Message-ID: <061.656d4fa2d865bfac718f05c7ab4e0903@haskell.org> #7258: Compiling DynFlags is jolly slow -------------------------------------+------------------------------------- Reporter: simonpj | Owner: simonpj Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.6.1 Resolution: | Keywords: deriving-perf 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 had a quick glimpse over CmmSink and [https://github.com/ghc/ghc/blob/master/compiler/cmm/CmmSink.hs#L409 `skipped`] looks suspicious: For every assignment `l = e` which is not sunk `l` is [https://github.com/ghc/ghc/blob/master/compiler/cmm/CmmSink.hs#L409 consed] to `skipped`. And for each assignment `l = e` is checked a) is it element of sink and b) is there any register in skipped mentioned in `e`: {{{ cannot_inline = skipped `regsUsedIn` rhs -- Note [dependent assignments] || l `elem` skipped || not (okToInline dflags rhs node) }}} Considering the amount of code generated this might be a thing. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 26 12:48:12 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 26 Oct 2017 12:48:12 -0000 Subject: [GHC] #7258: Compiling DynFlags is jolly slow In-Reply-To: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> References: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> Message-ID: <061.52151a72a9c8d8c5e1e09b17cffaf8dc@haskell.org> #7258: Compiling DynFlags is jolly slow -------------------------------------+------------------------------------- Reporter: simonpj | Owner: simonpj Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.6.1 Resolution: | Keywords: deriving-perf 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): Indeed. Actually any use of `elem` on a long list is suspicious. c.f. `ListSetOpts.unionLists` which warns if it sees long lists. Maybe we could have `ListSetOps.checkedElem` which checks for over-long lists and warns. And change all uses of `elem` into `checkedElem`. There may be more of these land-mines! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 26 12:51:56 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 26 Oct 2017 12:51:56 -0000 Subject: [GHC] #14389: Improved results in GHCi during basic calculations In-Reply-To: <044.095b6c2ec55cfe6869c1e521514f22b5@haskell.org> References: <044.095b6c2ec55cfe6869c1e521514f22b5@haskell.org> Message-ID: <059.cbcb22eba48669dcb7a40f46e37581cd@haskell.org> #14389: Improved results in GHCi during basic calculations -------------------------------------+------------------------------------- Reporter: vanto | 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: Other | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by vanto): * status: closed => new * resolution: invalid => Comment: hsylv20, you are rude. your susceptibility outweighs the reason. Trolling? I do not know what is it? you do not understand humor and you are stubborn too. this ticket is a new request requesting the opinion of a member of the Committe. hsyl20 and svennpanne, you are not a member of the current Committee, so I do not recognize you as the authority to close this ticket. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 26 13:19:33 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 26 Oct 2017 13:19:33 -0000 Subject: [GHC] #7258: Compiling DynFlags is jolly slow In-Reply-To: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> References: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> Message-ID: <061.d18778155352970139cd870796c457a3@haskell.org> #7258: Compiling DynFlags is jolly slow -------------------------------------+------------------------------------- Reporter: simonpj | Owner: simonpj Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.6.1 Resolution: | Keywords: deriving-perf 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 tdammers): * Attachment "ghc-large-record-types-cmm-size.png" added. Size of C-- for large record examples -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 26 13:23:46 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 26 Oct 2017 13:23:46 -0000 Subject: [GHC] #7258: Compiling DynFlags is jolly slow In-Reply-To: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> References: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> Message-ID: <061.83ef1113350ec553cdee80664d53c1ec@haskell.org> #7258: Compiling DynFlags is jolly slow -------------------------------------+------------------------------------- Reporter: simonpj | Owner: simonpj Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.6.1 Resolution: | Keywords: deriving-perf 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): More data! https://ghc.haskell.org/trac/ghc/attachment/ticket/7258/ghc- large-record-types-cmm-size.png shows C-- code size growth as the number of fields grows for the same generated examples as in the other graphs. getline and getline-appl generate the exact same C--, so there's no point including both in the graph; they are the only ones that grow linearly among the "interesting" examples. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 26 13:25:30 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 26 Oct 2017 13:25:30 -0000 Subject: [GHC] #7258: Compiling DynFlags is jolly slow In-Reply-To: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> References: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> Message-ID: <061.612cb3b07a8dea9c2c4a952cd64c976d@haskell.org> #7258: Compiling DynFlags is jolly slow -------------------------------------+------------------------------------- Reporter: simonpj | Owner: simonpj Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.6.1 Resolution: | Keywords: deriving-perf 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): Interesting. I can't tell whether that's as non-linear as the runtime, but the bad cases are clearly big! What happens to the size of Core? (Neglect types and coercions which are erased.) And finally does the Core-to-Cmm size ratio go up? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 26 13:26:11 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 26 Oct 2017 13:26:11 -0000 Subject: [GHC] #7258: Compiling DynFlags is jolly slow In-Reply-To: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> References: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> Message-ID: <061.b261140d327ff35aa6e10698e45ae184@haskell.org> #7258: Compiling DynFlags is jolly slow -------------------------------------+------------------------------------- Reporter: simonpj | Owner: simonpj Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.6.1 Resolution: | Keywords: deriving-perf 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:61 simonpj]: > Indeed. Actually any use of `elem` on a long list is suspicious. c.f. `ListSetOpts.unionLists` which warns if it sees long lists. > > Maybe we could have `ListSetOps.checkedElem` which checks for over-long lists and warns. And change all uses of `elem` into `checkedElem`. There may be more of these land-mines! What about using a different kind of data structure like a map or similar, that has logarithmic lookup performance? That would work even if we cannot reduce the size of the list, but if the list is short-lived, constructing the map might introduce prohibitive overhead? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 26 13:27:31 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 26 Oct 2017 13:27:31 -0000 Subject: [GHC] #7258: Compiling DynFlags is jolly slow In-Reply-To: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> References: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> Message-ID: <061.dffd45e9d7e44a24cf940efac81ddf5d@haskell.org> #7258: Compiling DynFlags is jolly slow -------------------------------------+------------------------------------- Reporter: simonpj | Owner: simonpj Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.6.1 Resolution: | Keywords: deriving-perf 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:63 simonpj]: > Interesting. I can't tell whether that's as non-linear as the runtime, but the bad cases are clearly big! > > What happens to the size of Core? (Neglect types and coercions which are erased.) > > And finally does the Core-to-Cmm size ratio go up? I'll check that next, unfortunately this means I have to run all those examples again... -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 26 13:27:49 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 26 Oct 2017 13:27:49 -0000 Subject: [GHC] #7258: Compiling DynFlags is jolly slow In-Reply-To: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> References: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> Message-ID: <061.695f918e46dcaa1f0d1cc5ad992be980@haskell.org> #7258: Compiling DynFlags is jolly slow -------------------------------------+------------------------------------- Reporter: simonpj | Owner: simonpj Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.6.1 Resolution: | Keywords: deriving-perf 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): > What about using a different kind of data structure like a map or similar Of course that the first thing we should do, once we are convinced that's where the time is going! (We only ave suggestive evidence so far.) Small maps should be cheap; that's the business of the containers library. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 26 13:31:08 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 26 Oct 2017 13:31:08 -0000 Subject: [GHC] #7258: Compiling DynFlags is jolly slow In-Reply-To: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> References: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> Message-ID: <061.7589addbcfaba75aa8fbc29fb889df04@haskell.org> #7258: Compiling DynFlags is jolly slow -------------------------------------+------------------------------------- Reporter: simonpj | Owner: simonpj Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.6.1 Resolution: | Keywords: deriving-perf 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): Replying to [comment:66 simonpj]: > > What about using a different kind of data structure like a map or similar > > Of course that the first thing we should do, once we are convinced that's where the time is going! (We only ave suggestive evidence so far.) Small maps should be cheap; that's the business of the containers library. `LocalReg` is `Uniquable` so something like this should work: {{{ type LocalRegSet = UniqSet LocalReg emptyLocalRegSet :: LocalRegSet emptyLocalRegSet = emptyUniqSet nullLocalRegSet :: LocalRegSet -> Bool nullLocalRegSet = isEmptyUniqSet elemLocalRegSet :: LocalReg -> LocalRegSet -> Bool elemLocalRegSet = elementOfUniqSet insertLocalRegSet :: LocalRegSet -> LocalReg -> LocalRegSet insertLocalRegSet = addOneToUniqSet cannot_inline = skipped `regsUsedIn` rhs -- Note [dependent assignments] || l `elemLocalRegSet` skipped || not (okToInline dflags rhs node) regsUsedIn :: LocalRegSet -> CmmExpr -> Bool regsUsedIn ls _ | nullLocalRegSet ls = False regsUsedIn ls e = wrapRecExpf f e False where f (CmmReg (CmmLocal l)) _ | l `elemLocalRegSet` ls = True f (CmmRegOff (CmmLocal l) _) _ | l `elemLocalRegSet` ls = True f _ z = z }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 26 13:59:35 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 26 Oct 2017 13:59:35 -0000 Subject: [GHC] #7258: Compiling DynFlags is jolly slow In-Reply-To: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> References: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> Message-ID: <061.639a1cff983f5386cd31607b6c6379df@haskell.org> #7258: Compiling DynFlags is jolly slow -------------------------------------+------------------------------------- Reporter: simonpj | Owner: simonpj Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.6.1 Resolution: | Keywords: deriving-perf 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 tdammers): * Attachment "ghc-large-record-types-cmm-per-core.png" added. C-- / Core size ratio for large record modules -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 26 13:59:39 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 26 Oct 2017 13:59:39 -0000 Subject: [GHC] #14391: Make the simplifier independent of the typechecker Message-ID: <046.0a550c305c7e5731d1526aa1438cdf9f@haskell.org> #14391: Make the simplifier independent of the typechecker -------------------------------------+------------------------------------- Reporter: nomeata | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.3 Keywords: newcomer | 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 that the simplifier module depends on all of the type checker, and HsSyn stuff, and renamer stuff, which I found strange. After a little investigation, it seems that the simplifier depends on CoreMonad, and that pulls some very few type-checker related things: 1. {{{ import TcRnMonad ( initTcForLookup ) import {-# SOURCE #-} TcSplice ( lookupThName_maybe ) }}} for {{{ thNameToGhcName :: TH.Name -> CoreM (Maybe Name) thNameToGhcName th_name = do hsc_env <- getHscEnv liftIO $ initTcForLookup hsc_env (lookupThName_maybe th_name) }}} which is not even used in GHC, but only in GHC Plugins, so this could probably be moved to a separate module pulled in by GhcPlugins.hs 2. {{{ import TcEnv ( lookupGlobal ) }}} for {{{ instance MonadThings CoreM where lookupThing name = do { hsc_env <- getHscEnv ; liftIO $ lookupGlobal hsc_env name } }}} This might be a bit harder to disentangle. But if successful, it would probably make building GHC in parallel quite a bit faster. And it just seems strange to me that the Core-to-Core code should depend on the type checker… Simon says: > Both of these code paths go through initTcForLookup which is massive overkill, as the comment with `TcEnv.lookupGlobal` says. There's clearly a ToDo here to strip off the redundant stuff and do a minimal lookup. I am optimistically marking this as `newcomer` because it is a refactoring task, and a good way of learning a bit about various pieces, with a reasonably clear notion of “success”. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 26 14:02:50 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 26 Oct 2017 14:02:50 -0000 Subject: [GHC] #7258: Compiling DynFlags is jolly slow In-Reply-To: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> References: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> Message-ID: <061.719c9e3438ec0163a8d5fe267b324933@haskell.org> #7258: Compiling DynFlags is jolly slow -------------------------------------+------------------------------------- Reporter: simonpj | Owner: simonpj Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.6.1 Resolution: | Keywords: deriving-perf 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): Interesting: https://ghc.haskell.org/trac/ghc/attachment/ticket/7258/ghc- large-record-types-cmm-per-core.png For the three offenders (read, show, read-appl), the C--/Core ratio goes *up* as the total code size grows, for the well-behaved examples it goes down. The latter is expected (constant overhead + linear code size), the former hints at some sort of nonlinearity. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 26 14:04:40 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 26 Oct 2017 14:04:40 -0000 Subject: [GHC] #14389: Improved results in GHCi during basic calculations In-Reply-To: <044.095b6c2ec55cfe6869c1e521514f22b5@haskell.org> References: <044.095b6c2ec55cfe6869c1e521514f22b5@haskell.org> Message-ID: <059.137fe40e83139fd8687213eadac982dd@haskell.org> #14389: Improved results in GHCi during basic calculations -------------------------------------+------------------------------------- Reporter: vanto | Owner: (none) Type: feature request | Status: closed Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: invalid | 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 svenpanne): * status: new => closed * resolution: => invalid Comment: This is a bug tracker for GHC, so one doesn't need to be a member of any Haskell Committee or such to open/close/modify tickets. Open Source is largely based on mutual agreement, not on organizational hierarchies. If you want to propose changes to the Haskell language per se, you can open a pull request on https://github.com/haskell/rfcs, but probably you should better start on the haskell-cafe mailing list to test your ideas. Anyway, for the current ticket at hand such a proposal would very probably have no success: You propose adding some kind of symbolic computation, but Haskell doesn't aim to be a computer algebra system like MATLAB or Mathematica. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 26 14:08:07 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 26 Oct 2017 14:08:07 -0000 Subject: [GHC] #12143: ApplicativeDo Fails to Desugar 'return True' In-Reply-To: <051.25105ae3fe7e38a6681426345f9fe806@haskell.org> References: <051.25105ae3fe7e38a6681426345f9fe806@haskell.org> Message-ID: <066.fe80f1c3dadb34dd61962b773a794aa6@haskell.org> #12143: ApplicativeDo Fails to Desugar 'return True' -------------------------------------+------------------------------------- Reporter: MichaelBurge | Owner: simonmar Type: bug | Status: new Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.0.1 Resolution: | Keywords: ApplicativeDo Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: 10892 | Blocking: Related Tickets: | Differential Rev(s): Phab:D4128 Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonmar): * differential: => Phab:D4128 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 26 14:17:33 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 26 Oct 2017 14:17:33 -0000 Subject: [GHC] #7258: Compiling DynFlags is jolly slow In-Reply-To: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> References: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> Message-ID: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> #7258: Compiling DynFlags is jolly slow -------------------------------------+------------------------------------- Reporter: simonpj | Owner: simonpj Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.6.1 Resolution: | Keywords: deriving-perf 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 tdammers): * Attachment "ghc-large-record-types-cmm-per-core.png" removed. C-- / Core size ratio for large record modules -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 26 14:17:33 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 26 Oct 2017 14:17:33 -0000 Subject: [GHC] #7258: Compiling DynFlags is jolly slow In-Reply-To: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> References: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> Message-ID: <061.9345908cd89be7d17f2d8cc3563e06e0@haskell.org> #7258: Compiling DynFlags is jolly slow -------------------------------------+------------------------------------- Reporter: simonpj | Owner: simonpj Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.6.1 Resolution: | Keywords: deriving-perf 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 tdammers): * Attachment "ghc-large-record-types-cmm-per-core.png" added. C-- / Core size ratio for large record modules -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 26 14:48:05 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 26 Oct 2017 14:48:05 -0000 Subject: [GHC] #7258: Compiling DynFlags is jolly slow In-Reply-To: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> References: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> Message-ID: <061.2659359a4094079262886a12f2f4acc3@haskell.org> #7258: Compiling DynFlags is jolly slow -------------------------------------+------------------------------------- Reporter: simonpj | Owner: simonpj Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.6.1 Resolution: | Keywords: deriving-perf 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): That is indeed interesting. * The bad cases are `read`, `read-appl` and `show` (comment:56) * They all generate very big Cmm (png just before (comment:62) * They all generate unusually large Core-to-Cmm ratio (comment:68) * This very large Cmm makes `sink` go bananas. Is the large Cmm accounted for by the big Core-to-Cmm ratio, or do these examples also have Core sizes that scale badly (look at term size only)? I'm guessing that the Core size does not scale badly. If that was so our questions would be * Why do we generate so much Cmm per unit of Core * Can we make `sink` scale better Both are worth working on. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 26 14:56:21 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 26 Oct 2017 14:56:21 -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.55a81f6f9bbf0e3d41084f2230e741d2@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 taylorfausak): I also ran into this problem trying to build hasql-0.20.0.1 with GHC 8.0.2: https://github.com/nikita- volkov/hasql/issues/79#issuecomment-339441282 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 26 14:59:15 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 26 Oct 2017 14:59:15 -0000 Subject: [GHC] #14379: Regression - GHC 2.8.1 Consumes All Memory On Build In-Reply-To: <047.3a29f02e3bbd9a0f2379ab1644f26326@haskell.org> References: <047.3a29f02e3bbd9a0f2379ab1644f26326@haskell.org> Message-ID: <062.f930dc1d299d52f9b0bf0e1027fbf859@haskell.org> #14379: Regression - GHC 2.8.1 Consumes All Memory On Build -------------------------------------+------------------------------------- Reporter: jm4games | Owner: (none) Type: bug | Status: new Priority: high | Milestone: 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): 8.0.2 Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): OK I have a fix for this. It was `SpecConstr` going wild. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 26 15:20:16 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 26 Oct 2017 15:20:16 -0000 Subject: [GHC] #14364: Reduce repetition in derived Read instances In-Reply-To: <046.9abf8af51367f0badd76eab5f23e3eb1@haskell.org> References: <046.9abf8af51367f0badd76eab5f23e3eb1@haskell.org> Message-ID: <061.3dfde061fd127a10114abf9d0bd4a893@haskell.org> #14364: Reduce repetition in derived Read instances -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: task | Status: closed Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.2.1 Resolution: fixed | Keywords: deriving Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #10980 #7258 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: new => closed * resolution: => fixed Comment: Comment:8 nails this. One additional change that we may investigate in the future is to emit `Applicative` parsers instead of using monadic bind. tdammers did some experiments and found that this helped compilation time quite dramatically in the unoptimized case although hurt when optimization was enabled. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 26 16:06:36 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 26 Oct 2017 16:06:36 -0000 Subject: [GHC] #14389: Improved results in GHCi during basic calculations In-Reply-To: <044.095b6c2ec55cfe6869c1e521514f22b5@haskell.org> References: <044.095b6c2ec55cfe6869c1e521514f22b5@haskell.org> Message-ID: <059.aee9bdf5896b855c84fe236338c8851b@haskell.org> #14389: Improved results in GHCi during basic calculations -------------------------------------+------------------------------------- Reporter: vanto | Owner: (none) Type: feature request | Status: closed Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: invalid | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Other | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by vanto): Replying to [[span(style=color: #FF0000, svenpanne )]]: \\ Thanks svenpanne for your explanations.\\ >Open Source is largely based on mutual agreement, not on organizational hierarchies. Sorry. It's new to me.\\ >you should better start on the haskell-cafe mailing list to test your ideas It's a good idea. I have never used a mailing list yet. I hope people are kind. To be honest, I do not speak the English language well, and that penalizes me in a conversation when I have to discuss technical details. That's why I would never make a proposal for GHC.\\ >Anyway, for the current ticket at hand such a proposal would very probably have no success It does not matter to me. My ideas are for everyone.\\ >but Haskell doesn't aim to be a computer algebra system like MATLAB or Mathematica. It is an answer that suits me. I understand. It took a lot of time and energy for each of us to say it. \\ \\ One more thing. I hope I was not rude to you with my humor. I try to always be polite to people. (even if sometimes I speak a little loudly). This ticket will remain closed permanently. Thanks again. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 26 16:21:18 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 26 Oct 2017 16:21:18 -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.cae8bdce2d1ac0b3d2a26c669fba6a94@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 see we've all come to happy agreement on what to do... but there's been no talk of who will do it. I'm afraid if it comes to my plate, it will have fairly low priority... -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 26 16:24:55 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 26 Oct 2017 16:24:55 -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.6529cbbd305a9e41bfa9eb23a30894df@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 would be willing to try this, but implementing this would require knowledge that I'm not currently privy to... -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 26 16:32:06 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 26 Oct 2017 16:32:06 -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.dc3c5bd7cab590e5884469e4b752db50@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): Let's have a Skype call and I can reveal the secret knowledge! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 26 17:35:56 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 26 Oct 2017 17:35:56 -0000 Subject: [GHC] #14347: Top-level RecordWildCards no longer working. In-Reply-To: <047.9d7d4bc51f0d30fd962b21bdfacfc205@haskell.org> References: <047.9d7d4bc51f0d30fd962b21bdfacfc205@haskell.org> Message-ID: <062.077d1183564985ff22c36acb466eb321@haskell.org> #14347: Top-level RecordWildCards no longer working. -------------------------------------+------------------------------------- Reporter: Fuuzetsu | 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): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Fuuzetsu): I think we can close this? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 26 17:40:10 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 26 Oct 2017 17:40:10 -0000 Subject: [GHC] #14392: `make binary-dist` is broken Message-ID: <047.e12bb26020da23d6c31cd3a9b180d24f@haskell.org> #14392: `make binary-dist` is broken -------------------------------------+------------------------------------- Reporter: Fuuzetsu | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Build System | Version: 8.3 Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- If we run {{{#!bash ./boot ./configure make make binary-dist }}} We are soon greeted with the following error {{{ cd bindistprep && "/bin/tar" hcf - -T ../bindist-list.uniq | /usr/bin/xz -c > ../bindistprep/ghc-8.3.20171025-x86_64-unknown-linux.tar.xz /bin/tar: ghc-8.3.20171025/testsuite/utils/check-api-annotations/dist- install/build/.depend.c_asm: Cannot stat: No such file or directory /bin/tar: ghc-8.3.20171025/testsuite/utils/check-api-annotations/dist- install/build/.depend.haskell: Cannot stat: No such file or directory /bin/tar: ghc-8.3.20171025/testsuite/utils/check-api-annotations/dist- install/package-data.mk: Cannot stat: No such file or directory /bin/tar: ghc-8.3.20171025/testsuite/utils/check-api-annotations/ghc.mk: Cannot stat: No such file or directory /bin/tar: ghc-8.3.20171025/testsuite/utils/check-ppr/dist- install/build/.depend.c_asm: Cannot stat: No such file or directory /bin/tar: ghc-8.3.20171025/testsuite/utils/check-ppr/dist- install/build/.depend.haskell: Cannot stat: No such file or directory /bin/tar: ghc-8.3.20171025/testsuite/utils/check-ppr/dist-install/package- data.mk: Cannot stat: No such file or directory /bin/tar: ghc-8.3.20171025/testsuite/utils/check-ppr/ghc.mk: Cannot stat: No such file or directory /bin/tar: Exiting with failure status due to previous errors mv bindistprep/*.tar.xz "." }}} I suspect https://github.com/ghc/ghc/commit/1e9f90af7311c33de0f7f5b7dba594725596d675 is to blame: bindist was not updated. A temporary work around I'm using is {{{ + $(filter-out testsuite/utils/check-ppr/% testsuite/utils/check-api- annotations/% %/project.mk mk/config.mk %/mk/install.mk,$(MAKEFILE_LIST)) \ }}} in top level {{{ghc.mk}}} in {{{bindist-list}}} {{{eval}}} section. I have reported this in #ghc to Ben but I am creating this ticket such that we can track the progress. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 26 18:08:38 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 26 Oct 2017 18:08:38 -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.6447c7b15a3fa84464fadd148aae5683@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 bgamari): Note that comment:15 is likely a different issue; there are many reasons why the the simplifier may exhaust its ticks limit. I believe this particular issue wasn't observed in 8.0.2 (although it would be nice if 4e6 could confirm this). -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 26 18:27:25 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 26 Oct 2017 18:27:25 -0000 Subject: [GHC] #14377: some results not expected with the addition In-Reply-To: <044.b2ada1f8b8e39ba20773f6a6e815abcd@haskell.org> References: <044.b2ada1f8b8e39ba20773f6a6e815abcd@haskell.org> Message-ID: <059.8f32838b2b15916737ddb1bfb6a0fca3@haskell.org> #14377: some results not expected with the addition -------------------------------------+------------------------------------- Reporter: vanto | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: invalid | 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 vanto): Correction: there is no bug in this ticket. The results are consistent with the Floating-Point Arithmetic. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 26 20:19:04 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 26 Oct 2017 20:19:04 -0000 Subject: [GHC] #14325: Erroneous program emits no errors In-Reply-To: <046.40df183102ba61ea001c050698aa9aba@haskell.org> References: <046.40df183102ba61ea001c050698aa9aba@haskell.org> Message-ID: <061.d3cd97558a1500e8896e35792645ff0a@haskell.org> #14325: Erroneous program emits no errors -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: merge 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: | typecheck/should_fail/T14325 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): Merged with 8a07a522ec9062886fd79b78d55924622ed72a69. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 26 20:19:21 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 26 Oct 2017 20:19:21 -0000 Subject: [GHC] #14325: Erroneous program emits no errors In-Reply-To: <046.40df183102ba61ea001c050698aa9aba@haskell.org> References: <046.40df183102ba61ea001c050698aa9aba@haskell.org> Message-ID: <061.9541ee0f4bc9bd958258d9c370daeaae@haskell.org> #14325: Erroneous program emits no errors -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: 8.2.2 Component: Compiler | Version: 8.2.1 Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: | typecheck/should_fail/T14325 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: merge => closed * resolution: => fixed * milestone: => 8.2.2 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 26 20:39:52 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 26 Oct 2017 20:39:52 -0000 Subject: [GHC] #7169: Warning for incomplete record field label used as function In-Reply-To: <047.31629c8fe32b813e38c132e8d4305995@haskell.org> References: <047.31629c8fe32b813e38c132e8d4305995@haskell.org> Message-ID: <062.8e1cd83fb46621ae8210debd743db706@haskell.org> #7169: Warning for incomplete record field label used as function -------------------------------------+------------------------------------- Reporter: goldfire | Owner: nakaji_dayo Type: feature request | Status: closed Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 7.7 Resolution: fixed | Keywords: Warnings, | newcomer 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): Phab:D4083 Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): Yes, but I don't see an alternative here; we unfortunately only have so many options. There is already precedent within GHC to treat underscore- prefixed identifiers specially. I would much rather continue relying on that same convention than introduce yet more special cases. Ultimately the right solution here would likely be something like #602, but seeing as that's not on the horizon, I think we'll just have to make due with what we have. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 26 21:39:05 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 26 Oct 2017 21:39:05 -0000 Subject: [GHC] #14382: The 'impossible' happened whilst installing gi-gtk via cabal In-Reply-To: <052.f9c10851d0906622baeb7996269cc8e7@haskell.org> References: <052.f9c10851d0906622baeb7996269cc8e7@haskell.org> Message-ID: <067.d10a7f252cfa722b722393050118f1e2@haskell.org> #14382: The 'impossible' happened whilst installing gi-gtk via cabal ----------------------------------+-------------------------------------- Reporter: maartenjacobs | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: | Keywords: gtk, pango Operating System: Linux | Architecture: x86_64 (amd64) Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | ----------------------------------+-------------------------------------- Comment (by bgamari): Alright, so I managed to reproduce this on `HEAD` as well. The call stack looks like, {{{ ghc-stage2: panic! (the 'impossible' happened) (GHC version 8.3.20171026 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 IsFile which was lazily initialized by initIfaceCheck typecheckLoop, I tried to tie the knot, but I couldn't find IsFile 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. This little catastrophe occurred while compiling GI.Gio.Interfaces.File Contents of current type environment: [] Call stack: CallStack (from HasCallStack): callStackDoc, called at compiler/utils/Outputable.hs:1147:37 in ghc:Outputable pprPanic, called at compiler/iface/TcIface.hs:1717:23 in ghc:TcIface tcIfaceGlobal, called at compiler/iface/TcIface.hs:1775:19 in ghc:TcIface tcIfaceTyCon, called at compiler/iface/TcIface.hs:1275:21 in ghc:TcIface tcIfaceType, called at compiler/iface/TcIface.hs:878:17 in ghc:TcIface tc_ax_branch, called at compiler/iface/TcIface.hs:866:37 in ghc:TcIface tc_ax_branches, called at compiler/iface/TcIface.hs:819:25 in ghc:TcIface tc_iface_decl, called at compiler/iface/TcIface.hs:640:15 in ghc:TcIface tcIfaceDecl, called at compiler/iface/LoadIface.hs:681:37 in ghc:LoadIface Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug }}} Moreover, I was able to pare down the affected module quite far. Replacing `GI.Gio.Interfaces.File` from `gi-gio-2.0.14` with the following still reproduces the issue, {{{#!hs module GI.Gio.Interfaces.File where import qualified GI.GObject.Objects.Object as GObject.Object import qualified GI.Gio.Callbacks as Gio.Callbacks import {-# SOURCE #-} qualified GI.Gio.Objects.FileEnumerator as Gio.FileEnumerator import {-# SOURCE #-} qualified GI.Gio.Structs.FileAttributeInfoList as Gio.FileAttributeInfoList class GObject o => IsFile o }}} Every line of this seems to be important; removing any one eliminates the panic. I have a repro but it's quite involved. I'm going to try to reduce it further before trying to explain it. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 26 21:55:22 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 26 Oct 2017 21:55:22 -0000 Subject: [GHC] #13604: ghci no longer loads dynamic .o files by default if they were built with -O In-Reply-To: <045.626a6b40d9101c93e2935653ef7e4668@haskell.org> References: <045.626a6b40d9101c93e2935653ef7e4668@haskell.org> Message-ID: <060.53bd04db9abd44657ddc7a1293095441@haskell.org> #13604: ghci no longer loads dynamic .o files by default if they were built with -O -------------------------------------+------------------------------------- Reporter: George | Owner: dfeuer Type: bug | Status: patch Priority: highest | Milestone: 8.2.2 Component: Compiler | Version: 8.2.1-rc1 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): Phab:D4123 Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): elaforge, thoughts? I would really like to wrap this up soon so we can get 8.2.2 out. If it's not done by Monday I'm afraid we'll need to punt this to 8.4. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 26 22:26:31 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 26 Oct 2017 22:26:31 -0000 Subject: [GHC] #14382: The 'impossible' happened whilst installing gi-gtk via cabal In-Reply-To: <052.f9c10851d0906622baeb7996269cc8e7@haskell.org> References: <052.f9c10851d0906622baeb7996269cc8e7@haskell.org> Message-ID: <067.d62d40c9161fdeb84f422997b8988020@haskell.org> #14382: The 'impossible' happened whilst installing gi-gtk via cabal ----------------------------------+-------------------------------------- Reporter: maartenjacobs | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: | Keywords: gtk, pango Operating System: Linux | Architecture: x86_64 (amd64) Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | ----------------------------------+-------------------------------------- Comment (by bgamari): I just noticed that comment:5 describes a different failure point from what the original reporter saw. There seems to be something odd going on in the `haskell-gi` package more generally. I'm still trying to pin down the specific cause of this, but I suspect the fact that the package has a densely-connected set of `hs-boot` files is central to the issue. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Oct 26 22:55:26 2017 From: ghc-devs at haskell.org (GHC) Date: Thu, 26 Oct 2017 22:55:26 -0000 Subject: [GHC] #13604: ghci no longer loads dynamic .o files by default if they were built with -O In-Reply-To: <045.626a6b40d9101c93e2935653ef7e4668@haskell.org> References: <045.626a6b40d9101c93e2935653ef7e4668@haskell.org> Message-ID: <060.d8288b24bdad6d655c1e7fccdf425acc@haskell.org> #13604: ghci no longer loads dynamic .o files by default if they were built with -O -------------------------------------+------------------------------------- Reporter: George | Owner: dfeuer Type: bug | Status: patch Priority: highest | Milestone: 8.2.2 Component: Compiler | Version: 8.2.1-rc1 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): Phab:D4123 Wiki Page: | -------------------------------------+------------------------------------- Comment (by elaforge): If -fobject-code is off, then ghci -O2 A B can load both modules by the usual rules, which is to say if it finds .o files that were also compiled with -O2, then it will load them. Otherwise, it loads them as bytecode. For `ghci -O2 A B` example, I think it should load B as bytecode if the flags don't match. It doesn't seem inconsistent to me, here are the rules: With -fobject-code, always load binary, which means recompile (as binary) if the flags don't match. With -fbyte-code, load binary if there already is one, and the flags match, otherwise load as bytecode. Flags that don't apply to bytecode (namely -O and -fhpc) are ignored, but do affect whether or not the flags match when loading binary. Can you expand on how it seems inconsistent? I'm guessing that you're thinking that -O means "binary and bytecode are optimized" while I'm happy for it to mean "binary is optimized" with no implication for bytecode. I admit the case might be weaker for -fhpc, in that people might not expect that -fhpc means binary only. But I guess that's just an aspect of bytecode that it doesn't support those things, and if there's a warning that says "we're ignoring these for bytecode", as there already currently is, then it seems fine to me. I think the only change would be to have DynFlags.makeFlagsConsistent emit the warnings, but not mutate the dflags. Of course it might then trigger assertion failures down the line, but presumably they would be easy to fix. I just did an experiment with -prof, because presumably it's also not supported by bytedcode, but unlike -O it doesn't warn for ghci. But it looks like while it's happy to load binary modules compiled with -prof, even if you don't pass it to ghci, it will then crash trying to run things: {{{ ghc: panic! (the 'impossible' happened) (GHC version 8.0.2 for x86_64-apple-darwin): Loading temp shared object failed: dlopen(/var/folders/9p/tb878hlx67sdym1sndy4sxf40000gn/T/ghc93652_0/libghc_1.dylib, 5): Symbol not found: _CCS_DONT_CARE Referenced from: /var/folders/9p/tb878hlx67sdym1sndy4sxf40000gn/T/ghc93652_0/libghc_1.dylib Expected in: flat namespace in /var/folders/9p/tb878hlx67sdym1sndy4sxf40000gn/T/ghc93652_0/libghc_1.dylib Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug }}} Maybe I should file this as a separate bug. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 27 07:21:48 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 27 Oct 2017 07:21:48 -0000 Subject: [GHC] #14379: Regression - GHC 2.8.1 Consumes All Memory On Build In-Reply-To: <047.3a29f02e3bbd9a0f2379ab1644f26326@haskell.org> References: <047.3a29f02e3bbd9a0f2379ab1644f26326@haskell.org> Message-ID: <062.e21e027beae95899f2c0c01dba050398@haskell.org> #14379: Regression - GHC 2.8.1 Consumes All Memory On Build -------------------------------------+------------------------------------- Reporter: jm4games | Owner: (none) Type: bug | Status: new Priority: high | Milestone: 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): 8.0.2 Wiki Page: | -------------------------------------+------------------------------------- Comment (by Simon Peyton Jones ): In [changeset:"7d7d94fb4876dc7e58263abc9dd65921e09cddac/ghc" 7d7d94fb/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="7d7d94fb4876dc7e58263abc9dd65921e09cddac" Fix an exponential-blowup case in SpecConstr Trac #14379 showed a case where use of "forcing" to do "damn the torpedos" specialisation without resource limits (which 'vector' does a lot) led to exponential blowup. The fix is easy. Finding it wasn't. See Note [Forcing specialisation] and the one-line change in decreaseSpecCount. }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 27 08:17:23 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 27 Oct 2017 08:17:23 -0000 Subject: [GHC] #14379: Regression - GHC 2.8.1 Consumes All Memory On Build In-Reply-To: <047.3a29f02e3bbd9a0f2379ab1644f26326@haskell.org> References: <047.3a29f02e3bbd9a0f2379ab1644f26326@haskell.org> Message-ID: <062.b735270d99120e2bdf8e9c265408db4e@haskell.org> #14379: Regression - GHC 2.8.1 Consumes All Memory On Build -------------------------------------+------------------------------------- Reporter: jm4games | Owner: (none) Type: bug | Status: new Priority: high | Milestone: 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): 8.0.2 Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): This would be worth merging to 8.2. I have not added a test because the repro case is tricky. My change deliberately reduces the amount of specialisation that `SpecConstr` does; but I suppose it's possible that some other important use-case will get worse. But I think it's unlikely. Worth a check on `perf.haskell.org`. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 27 08:17:31 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 27 Oct 2017 08:17:31 -0000 Subject: [GHC] #14379: Regression - GHC 2.8.1 Consumes All Memory On Build In-Reply-To: <047.3a29f02e3bbd9a0f2379ab1644f26326@haskell.org> References: <047.3a29f02e3bbd9a0f2379ab1644f26326@haskell.org> Message-ID: <062.050fa6b941961d69e51ba437b3b22628@haskell.org> #14379: Regression - GHC 2.8.1 Consumes All Memory On Build -------------------------------------+------------------------------------- Reporter: jm4games | Owner: (none) Type: bug | Status: merge Priority: high | Milestone: 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): 8.0.2 Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * status: new => merge -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 27 12:35:33 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 27 Oct 2017 12:35:33 -0000 Subject: [GHC] #14393: Levity-polymorphic join point crashes 8.2 Message-ID: <046.a88021f5916fc6d39eb14fe83fd3a1e6@haskell.org> #14393: Levity-polymorphic join point crashes 8.2 -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.2.2 Component: Compiler | Version: 8.2.1 Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- This program crashes both GHC 8.0 and 8.2 {{{ {-# LANGUAGE ViewPatterns, PatternSynonyms #-} module Foo where data PrimOp = AddOp | Add2Op | OtherOp | BotherOp data Expr = Var PrimOp | App Expr Expr | BApp [Expr] | BOp Expr Expr | L Integer pattern BinOpApp :: Expr -> PrimOp -> Expr -> Expr pattern BinOpApp x op y = Var op `App` x `App` y pattern (:+:) :: Expr -> Expr -> Expr pattern x :+: y <- BinOpApp x (isAddOp -> True) y isAddOp :: PrimOp -> Bool isAddOp AddOp = True isAddOp Add2Op = True isAddOp _ = False pattern (:++:) :: Integer -> Expr -> Expr pattern l :++: x <- (isAdd -> Just (l,x)) isAdd :: Expr -> Maybe (Integer,Expr) {-# INLINE isAdd #-} isAdd e = case e of L l :+: x -> Just (l,x) x :+: L l -> Just (l,x) _ -> Nothing }}} Reason: the matching function, generated by the pattern synonym `:++:`, has a levity-polymorphic join point. 8.0 has a Lint Error. 8.2 crashes with {{{ (GHC version 8.2.1.20171024 for x86_64-unknown-linux): runtimeRepPrimRep typePrimRep (r_a1kX :: TYPE rep_a1kW) rep_a1kW 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/simplStg/RepType.hs:360:5 in ghc:RepType runtimeRepPrimRep, called at compiler/simplStg/RepType.hs:342:5 in ghc:RepType kindPrimRep, called at compiler/simplStg/RepType.hs:305:18 in ghc:RepType typePrimRep, called at compiler/simplStg/RepType.hs:128:19 in ghc:RepType }}} I think this is just #13394, comment:4 again. It was fixed in comment:5 of that ticket, but the fix has not yet been transferred to 8.2. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 27 12:36:03 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 27 Oct 2017 12:36:03 -0000 Subject: [GHC] #14393: Levity-polymorphic join point crashes 8.2 In-Reply-To: <046.a88021f5916fc6d39eb14fe83fd3a1e6@haskell.org> References: <046.a88021f5916fc6d39eb14fe83fd3a1e6@haskell.org> Message-ID: <061.91ac3c052f191eb5cecea30feeec3caf@haskell.org> #14393: Levity-polymorphic join point crashes 8.2 -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: new Priority: normal | 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): Wiki Page: | -------------------------------------+------------------------------------- Description changed by simonpj: Old description: > This program crashes both GHC 8.0 and 8.2 > {{{ > {-# LANGUAGE ViewPatterns, PatternSynonyms #-} > > module Foo where > > data PrimOp = AddOp | Add2Op | OtherOp | BotherOp > > data Expr = Var PrimOp | App Expr Expr | BApp [Expr] | BOp Expr Expr | L > Integer > > pattern BinOpApp :: Expr -> PrimOp -> Expr -> Expr > pattern BinOpApp x op y = Var op `App` x `App` y > > pattern (:+:) :: Expr -> Expr -> Expr > pattern x :+: y <- BinOpApp x (isAddOp -> True) y > > isAddOp :: PrimOp -> Bool > isAddOp AddOp = True > isAddOp Add2Op = True > isAddOp _ = False > > pattern (:++:) :: Integer -> Expr -> Expr > pattern l :++: x <- (isAdd -> Just (l,x)) > > isAdd :: Expr -> Maybe (Integer,Expr) > {-# INLINE isAdd #-} > isAdd e = case e of > L l :+: x -> Just (l,x) > x :+: L l -> Just (l,x) > _ -> Nothing > }}} > Reason: the matching function, generated by the pattern synonym `:++:`, > has a levity-polymorphic join point. > > 8.0 has a Lint Error. 8.2 crashes with > {{{ > (GHC version 8.2.1.20171024 for x86_64-unknown-linux): > runtimeRepPrimRep > typePrimRep (r_a1kX :: TYPE rep_a1kW) > rep_a1kW > 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/simplStg/RepType.hs:360:5 in > ghc:RepType > runtimeRepPrimRep, called at compiler/simplStg/RepType.hs:342:5 > in ghc:RepType > kindPrimRep, called at compiler/simplStg/RepType.hs:305:18 in > ghc:RepType > typePrimRep, called at compiler/simplStg/RepType.hs:128:19 in > ghc:RepType > }}} > I think this is just #13394, comment:4 again. It was fixed in comment:5 > of that ticket, but the fix has not yet been transferred to 8.2. New description: This program (derived from Phab:D2858) crashes both GHC 8.0 and 8.2 {{{ {-# LANGUAGE ViewPatterns, PatternSynonyms #-} module Foo where data PrimOp = AddOp | Add2Op | OtherOp | BotherOp data Expr = Var PrimOp | App Expr Expr | BApp [Expr] | BOp Expr Expr | L Integer pattern BinOpApp :: Expr -> PrimOp -> Expr -> Expr pattern BinOpApp x op y = Var op `App` x `App` y pattern (:+:) :: Expr -> Expr -> Expr pattern x :+: y <- BinOpApp x (isAddOp -> True) y isAddOp :: PrimOp -> Bool isAddOp AddOp = True isAddOp Add2Op = True isAddOp _ = False pattern (:++:) :: Integer -> Expr -> Expr pattern l :++: x <- (isAdd -> Just (l,x)) isAdd :: Expr -> Maybe (Integer,Expr) {-# INLINE isAdd #-} isAdd e = case e of L l :+: x -> Just (l,x) x :+: L l -> Just (l,x) _ -> Nothing }}} Reason: the matching function, generated by the pattern synonym `:++:`, has a levity-polymorphic join point. 8.0 has a Lint Error. 8.2 crashes with {{{ (GHC version 8.2.1.20171024 for x86_64-unknown-linux): runtimeRepPrimRep typePrimRep (r_a1kX :: TYPE rep_a1kW) rep_a1kW 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/simplStg/RepType.hs:360:5 in ghc:RepType runtimeRepPrimRep, called at compiler/simplStg/RepType.hs:342:5 in ghc:RepType kindPrimRep, called at compiler/simplStg/RepType.hs:305:18 in ghc:RepType typePrimRep, called at compiler/simplStg/RepType.hs:128:19 in ghc:RepType }}} I think this is just #13394, comment:4 again. It was fixed in comment:5 of that ticket, but the fix has not yet been transferred to 8.2. -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 27 13:27:23 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 27 Oct 2017 13:27:23 -0000 Subject: [GHC] #14379: Regression - GHC 2.8.1 Consumes All Memory On Build In-Reply-To: <047.3a29f02e3bbd9a0f2379ab1644f26326@haskell.org> References: <047.3a29f02e3bbd9a0f2379ab1644f26326@haskell.org> Message-ID: <062.cadcdb3c55406be786c42584fde45237@haskell.org> #14379: Regression - GHC 2.8.1 Consumes All Memory On Build -------------------------------------+------------------------------------- Reporter: jm4games | Owner: (none) Type: bug | Status: merge Priority: high | Milestone: 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): 8.0.2 Wiki Page: | -------------------------------------+------------------------------------- Comment (by jm4games): Thanks alot simon! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 27 13:31:37 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 27 Oct 2017 13:31:37 -0000 Subject: [GHC] #14379: Regression - GHC 8.2.1 Consumes All Memory On Build (was: Regression - GHC 2.8.1 Consumes All Memory On Build) In-Reply-To: <047.3a29f02e3bbd9a0f2379ab1644f26326@haskell.org> References: <047.3a29f02e3bbd9a0f2379ab1644f26326@haskell.org> Message-ID: <062.f881bd9b454c97d39a565c8e0ace8401@haskell.org> #14379: Regression - GHC 8.2.1 Consumes All Memory On Build -------------------------------------+------------------------------------- Reporter: jm4games | Owner: (none) Type: bug | Status: merge Priority: high | Milestone: 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): 8.0.2 Wiki Page: | -------------------------------------+------------------------------------- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 27 13:48:43 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 27 Oct 2017 13:48:43 -0000 Subject: [GHC] #10892: ApplicativeDo should use *> and <* In-Reply-To: <047.75544cc852e1b71af89f5571354ace9a@haskell.org> References: <047.75544cc852e1b71af89f5571354ace9a@haskell.org> Message-ID: <062.094e3da4ad9fd97c3768dbdab6d57813@haskell.org> #10892: ApplicativeDo should use *> and <* -------------------------------------+------------------------------------- Reporter: simonmar | Owner: bollu Type: task | Status: new Priority: high | Milestone: 8.4.1 Component: Compiler | Version: 7.11 Resolution: | Keywords: ApplicativeDo Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: 12143 Related Tickets: #13309 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Simon Marlow ): In [changeset:"41f905596dc2560f29657753e4c69ce695161786/ghc" 41f9055/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="41f905596dc2560f29657753e4c69ce695161786" ApplicativeDo: handle BodyStmt (#12143) Summary: It's simple to treat BodyStmt just like a BindStmt with a wildcard pattern, which is enough to fix #12143 without going all the way to using `<*` and `*>` (#10892). Test Plan: * new test cases in `ado004.hs` * validate Reviewers: niteria, simonpj, bgamari, austin, erikd Subscribers: rwbarton, thomie GHC Trac Issues: #12143 Differential Revision: https://phabricator.haskell.org/D4128 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 27 13:48:43 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 27 Oct 2017 13:48:43 -0000 Subject: [GHC] #12143: ApplicativeDo Fails to Desugar 'return True' In-Reply-To: <051.25105ae3fe7e38a6681426345f9fe806@haskell.org> References: <051.25105ae3fe7e38a6681426345f9fe806@haskell.org> Message-ID: <066.6b46a40552ab7dd6a483e4dea8e15271@haskell.org> #12143: ApplicativeDo Fails to Desugar 'return True' -------------------------------------+------------------------------------- Reporter: MichaelBurge | Owner: simonmar Type: bug | Status: new Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.0.1 Resolution: | Keywords: ApplicativeDo Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: 10892 | Blocking: Related Tickets: | Differential Rev(s): Phab:D4128 Wiki Page: | -------------------------------------+------------------------------------- Comment (by Simon Marlow ): In [changeset:"41f905596dc2560f29657753e4c69ce695161786/ghc" 41f9055/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="41f905596dc2560f29657753e4c69ce695161786" ApplicativeDo: handle BodyStmt (#12143) Summary: It's simple to treat BodyStmt just like a BindStmt with a wildcard pattern, which is enough to fix #12143 without going all the way to using `<*` and `*>` (#10892). Test Plan: * new test cases in `ado004.hs` * validate Reviewers: niteria, simonpj, bgamari, austin, erikd Subscribers: rwbarton, thomie GHC Trac Issues: #12143 Differential Revision: https://phabricator.haskell.org/D4128 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 27 16:12:19 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 27 Oct 2017 16:12:19 -0000 Subject: [GHC] #14394: Inferred type for pattern synonym has redundant equality constraint Message-ID: <050.9779b5323a2024633d6aeced4501599a@haskell.org> #14394: Inferred type for pattern synonym has redundant equality constraint -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 (Type checker) | Keywords: | Operating System: Unknown/Multiple PatternSynonyms, TypeInType | Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- Load this file into GHCi: {{{#!hs {-# LANGUAGE GADTs #-} {-# LANGUAGE PatternSynonyms #-} module Bug where import Data.Type.Equality pattern Foo = HRefl }}} {{{ $ /opt/ghc/8.2.1/bin/ghci Bug.hs GHCi, version 8.2.1: http://www.haskell.org/ghc/ :? for help Loaded GHCi configuration from /home/rgscott/.ghci [1 of 1] Compiling Bug ( Bug.hs, interpreted ) Ok, 1 module loaded. λ> :i Foo pattern Foo :: () => (* ~ *, b ~ a) => a :~~: b }}} Notice that the type signature for `Foo` has an entirely redundant `* ~ *` constraint. The same does not happen if `TypeInType` is enabled. {{{#!hs {-# LANGUAGE GADTs #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE TypeInType #-} module Works where import Data.Type.Equality pattern Foo = HRefl }}} {{{ λ> :i Foo pattern Foo :: forall k2 k1 (a :: k1) (b :: k2). () => (k2 ~ k1, (b :: k2) ~~ (a :: k1)) => a :~~: b }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 27 16:35:02 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 27 Oct 2017 16:35:02 -0000 Subject: =?utf-8?q?=5BGHC=5D_=2314395=3A_Redefining_pattern_synonym_in_GH?= =?utf-8?b?Q2kgdHJpZ2dlcnMgIuKAmHDigJkgaXMgdW50b3VjaGFibGUiIGVy?= =?utf-8?q?ror?= Message-ID: <050.cf61c6ee7a6236b0e7715eec7b752c2c@haskell.org> #14395: Redefining pattern synonym in GHCi triggers "‘p’ is untouchable" error -------------------------------------+------------------------------------- Reporter: RyanGlScott | 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: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- Load this file into GHCi: {{{#!hs {-# LANGUAGE GADTs #-} {-# LANGUAGE PatternSynonyms #-} module Bug where data Foo a where FooInt :: Foo Int pattern Bar :: () => (a ~ Int) => Foo a pattern Bar = FooInt }}} And attempt to redefine `Bar` as follows: {{{ $ /opt/ghc/8.2.1/bin/ghci Bug.hs GHCi, version 8.2.1: http://www.haskell.org/ghc/ :? for help Loaded GHCi configuration from /home/rgscott/.ghci [1 of 1] Compiling Bug ( Bug.hs, interpreted ) Ok, 1 module loaded. λ> pattern Bar = Nothing :1:15: error: • Couldn't match expected type ‘p’ with actual type ‘Maybe a0’ ‘p’ is untouchable inside the constraints: a ~ Int bound by a pattern with pattern synonym: Bar :: forall a. () => a ~ Int => Foo a, in an equation for ‘pattern’ at :1:9-11 ‘p’ is a rigid type variable bound by the inferred type of pattern :: Foo a -> p at :1:1-21 Possible fix: add a type signature for ‘pattern’ • In the expression: Nothing In an equation for ‘pattern’: pattern Bar = Nothing • Relevant bindings include pattern :: Foo a -> p (bound at :1:1) }}} There are two issues here: 1. There are several places in the error message that refer to a `pattern` with no name! {{{ in an equation for ‘pattern’ }}} {{{ the inferred type of pattern :: Foo a -> p at :1:1-21 }}} {{{ • Relevant bindings include pattern :: Foo a -> p (bound at :1:1) }}} 2. Why is this error happening in the first place? The error message mentions the type `Foo a -> p`, but in `pattern Bar = Nothing`, there isn't anything that should touch `Foo`. Note that this bug does not occur if a slightly different (but ostensibly equivalent) type signature for `Bar` is given in the original source file: {{{#!hs {-# LANGUAGE GADTs #-} {-# LANGUAGE PatternSynonyms #-} module Works where data Foo a where FooInt :: Foo Int pattern Bar :: Foo Int pattern Bar = FooInt }}} {{{ λ> pattern Bar = Nothing λ> :i Bar pattern Bar :: Foo Int }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 27 16:09:02 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 27 Oct 2017 16:09:02 -0000 Subject: [GHC] #13604: ghci no longer loads dynamic .o files by default if they were built with -O In-Reply-To: <045.626a6b40d9101c93e2935653ef7e4668@haskell.org> References: <045.626a6b40d9101c93e2935653ef7e4668@haskell.org> Message-ID: <060.25526dd58908483271f5ad1a588f6676@haskell.org> #13604: ghci no longer loads dynamic .o files by default if they were built with -O -------------------------------------+------------------------------------- Reporter: George | Owner: dfeuer Type: bug | Status: patch Priority: highest | Milestone: 8.2.2 Component: Compiler | Version: 8.2.1-rc1 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): Phab:D4123 Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): > Maybe I should file this as a separate bug. elaforge, yes, please do. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 27 17:20:43 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 27 Oct 2017 17:20:43 -0000 Subject: [GHC] #13394: PatternSynonyms/OverloadedStrings regression in GHC HEAD In-Reply-To: <050.ed25b2794b5079e532ea5ebc5d466375@haskell.org> References: <050.ed25b2794b5079e532ea5ebc5d466375@haskell.org> Message-ID: <065.2da78b84645c4f5a91e81f735ba767cb@haskell.org> #13394: PatternSynonyms/OverloadedStrings regression in GHC HEAD -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: closed Priority: highest | Milestone: 8.2.2 Component: Compiler | Version: 8.1 Resolution: fixed | Keywords: | PatternSynonyms Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Compile-time | Test Case: crash or panic | polykinds/T13394, T13394a Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * milestone: 8.2.1 => 8.2.2 Comment: I've merged comment:5 to `ghc-8.2` with 704cbae29ee09431cfbd6b1566a6ec6856f125fc. This will be present in 8.2.2. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 27 21:07:43 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 27 Oct 2017 21:07:43 -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.6f9c03f0426b8c048500e58cbae00ed7@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): The Algorithm informally explained: Use a recursive match function very similar to the current approach. match :: PatternMatrix -> DecompositionKnowledge -> FailExpr -> DsM(Expr) FailExpr: Same as now. DecompositionKnowledge: Represents the knowledge about each occurrence. Each entry is one of * Evaluated (`Case x of _ -> expr`) * The Value/Tag (`Case x of A -> expr`) * Constructors we can rule out. (`Case x of { _ -> expr; A -> notTaken }` ) PatternMatrix: Similar to the current EquationInfo. However each RHS is extended with a list of constraints which must be satisfied before we can sucessfully match on that RHS. The constraints codify the strictness semantices based on the actual values of the arguments. Each RHS has the constraint of it's own row and the ones of all rows above. So a equation `A !_ B = 1` has the following constraint in pseudo syntax: {{{ Eval (1) && if (Val(1) == A) then Eval (2) && Eval (3) else True }}} In match: * Check which occurrences are strict in ALL Rows. * Select one of these based on some heuristic * Generate alternatives for each constructor in that row (and possibly a default). * Generate the code for the alternatives by: * Removing the evaluated column and unreachable rows from the matrix * Add knowledge gained by taking this alternative. * Calling match again with the updated Matrix/Knowledge to generate the code. Only chosing from the strict set of occurrences is already **enough to guarantee we don't increase strictness**. BUT it can lead to a function being less strict though. See SPJ's example above. Ideally we chose the next occurrence from the strict set such that few comparisons are made to pick a RHS using little code. However so far it seems the heuristic chosen hardly matters. But I have only tried quiet simple ones namely: * Left to Right * Constructor Count in the Row * Constructor Count till the first irrefutable pattern. * Number of different Tags * Right to Left. (The only one which is clearly inferior) **To preserve strictness:** Once a RHS was selected all constraints must be satisfied before we can jump into the actual RHS code. We satisfy `Eval (x)` by evaluating the Occurrence x. When solving `Eval (x)` we generate alternatives for all Constructors mentioned in the constraints. If we resolve the constraints left to right until all are satisfied we can guarantee that we don't skip evaluation of any arguments that should have been evaluated. Going back to SPJ's example to see how this works. Once we evaluted the second argument to `C`: We can immediatly select the third RHS. However we still have the unsolved constraint `Eval(0) && if 0 == A then Eval(1) else True`. To satisfy it we simply create another case expression to evaluate the first argument with a single branch for A. After that all constraints are solved so we put the RHS as the expression of that branch. On top of the above it also require some special casing for View Patterns and Synonyms before it can implemented into GHC. However both can be dealt with by using a mixture rule similar to the current approach. ---- Results so far on ~190k unique simple patterns pulled from hackage packages. (No View/Synonym or N+K Patterns) Most patterns are boring and the result does not or barely change: * For ~150k patterns the resulting code is the some for the original algorithm and decision trees. ~120k of these have only a single equation and hence don't allow for any optimization either way. I used the simplest heuristic (choose the left most strict occurrence) to build a core like AST **so without applying GHC's simplifier** I got these results: * (+0.84%) more Terms are generated by decision trees. * Comparisons (sum over all patterns): * (-1.93%) fewer comparisons to select the worst case. * (-1.14%) fewer comparisons required to select a RHS on average. I tried a few other heuristics as well but there is not enough difference between these to look into it without also comparing in detail how running it through the simplifier changes things. Transpiling the AST used to GHC Source code and looking at the Core there are some small changes but I expect that above numbers to change very little based on these. Looking only at patterns where the algorithm makes a difference for the number of comparisons required the tree based approach makes about 30% fewer comparisons for both worst and average case. While this is a lot it comes with a larger code size (and more join points) so it's hard to tell how much of a difference it makes when it comes to generated machine code. Some of it might be because I didn't push it through the simplifier but that seems to hit the tree based code harder then the current approach for the examples I looked at I'm somewhat optimistic that it is a genuine reduction of case expressions evaluated. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Oct 27 23:10:03 2017 From: ghc-devs at haskell.org (GHC) Date: Fri, 27 Oct 2017 23:10:03 -0000 Subject: [GHC] #14396: Hs-boot woes during family instance consistency checks Message-ID: <046.2ccc4fa31be03dddd3503a257243a5e2@haskell.org> #14396: Hs-boot woes during family instance consistency checks -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- Consider this set of modules (related to #13981 but not the same) {{{ {-# LANGUAGE TypeFamilies #-} module Fam where type family XListPat a {-# LANGUAGE TypeFamilies #-} module T1 where import Fam import {-# SOURCE #-} T( SyntaxExpr ) type instance XListPat Int = SyntaxExpr {-# LANGUAGE TypeFamilies #-} module T2 where import Fam type instance XListPat Bool = Int -- T.hs-boot module T where data SyntaxExpr = S -- T.hs module T where import T1 import T2 data SyntaxExpr = S }}} Compiled with GHC 8.0, 8.2, and HEAD we get {{{ ghc.exe: panic! (the 'impossible' happened) (GHC version 8.0.2 for x86_64-unknown-mingw32): tcIfaceGlobal (local): not found You are in a maze of twisty little passages, all alike. While forcing the thunk for TyThing SyntaxExpr which was lazily initialized by initIfaceTcRn, I tried to tie the knot, but I couldn't find SyntaxExpr 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: [] }}} Reason: * After renaming, but before type checking, we try to do family-instance consistency checking in `FamInst.checkFamInstConsistency` * To do so we have to pull in the axioms from `T1` and `T2`. * Then we poke on those axioms, to check consistency, we pull in both LHS and RHS of the type instances. * Alas that pulls on `SyntaxExpr`, which we have not yet typechecked. I don't think it's enough to make lazier the loading of the RHS of the axiom, because I think `checkFamInstConsistency` ends up looking at the RHS too. See the call to `compatibleBranches` in `lookupFamInstEnvConflicts`. This setup is actually used in Alan's `wip/ttg-2017-10-13` branch for Trees That Grow. Here module `T` is `HsExpr`, `T1` is `HsPat`. And indeed GHC 8.0 crashes when compiling this branch. SO it's becoming a real problem. Generally I'm concerned that #13981 may also become more pressing; and #14080 is still open -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Oct 28 01:26:36 2017 From: ghc-devs at haskell.org (GHC) Date: Sat, 28 Oct 2017 01:26:36 -0000 Subject: [GHC] #14397: For type error involving inferred types, show source of the type Message-ID: <045.4807d2a1dace593629121c50e6806812@haskell.org> #14397: For type error involving inferred types, show source of the type -------------------------------------+------------------------------------- Reporter: max630 | Owner: (none) Type: feature | Status: new request | Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- Consider the code: {{{#!hs a = 42 b = a . "hello" }}} The type Error is (ghc-8.2.1): {{{ TestTypes.hs:3:5: error: • Couldn't match expected type ‘b0 -> c’ with actual type ‘Integer’ • In the first argument of ‘(.)’, namely ‘a’ In the expression: a . "hello" In an equation for ‘b’: b = a . "hello" • Relevant bindings include b :: a -> c (bound at TestTypes.hs:3:1) | 3 | b = a . "hello" | ^ TestTypes.hs:3:9: error: • Couldn't match expected type ‘a -> b0’ with actual type ‘[Char]’ • In the second argument of ‘(.)’, namely ‘"hello"’ In the expression: a . "hello" In an equation for ‘b’: b = a . "hello" • Relevant bindings include b :: a -> c (bound at TestTypes.hs:3:1) | 3 | b = a . "hello" | ^^^^^^^ }}} Actually, the real mistake may be in line 1, where `a` is inferred as of type `Integer`, while it probably was not meant to. But that location is not reported to the error. As you can guess, in real code location where the unexpected type is inferred for a binding is not that obvious to find. Suggestion: track locations where bindings' types are inferred, and in case of type error involvin the bindings, add them to the "Relevant bindings" section, or otherwise show it. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Oct 28 01:40:11 2017 From: ghc-devs at haskell.org (GHC) Date: Sat, 28 Oct 2017 01:40:11 -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.88024e4f764a3dcd9329a359871eadc4@haskell.org> #14396: Hs-boot woes during family instance consistency checks -------------------------------------+------------------------------------- Reporter: simonpj | 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): Wiki Page: | -------------------------------------+------------------------------------- Comment (by goldfire): There's an off chance that considering #9562 may help to inform the solution here. That ticket is about a type system hole that opens up when you mix type families with hs-boot files -- quite unlike this ticket -- but it somehow may pay you back if you consider all these tickets together. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Oct 28 06:19:43 2017 From: ghc-devs at haskell.org (GHC) Date: Sat, 28 Oct 2017 06:19:43 -0000 Subject: [GHC] #14397: For type error involving inferred types, show source of the type In-Reply-To: <045.4807d2a1dace593629121c50e6806812@haskell.org> References: <045.4807d2a1dace593629121c50e6806812@haskell.org> Message-ID: <060.bbb139a74be37388f896770bcd364a2d@haskell.org> #14397: For type error involving inferred types, show source of the type -------------------------------------+------------------------------------- Reporter: max630 | 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: | -------------------------------------+------------------------------------- Description changed by max630: Old description: > Consider the code: > > {{{#!hs > a = 42 > > b = a . "hello" > }}} > > The type Error is (ghc-8.2.1): > > {{{ > TestTypes.hs:3:5: error: > • Couldn't match expected type ‘b0 -> c’ with actual type ‘Integer’ > • In the first argument of ‘(.)’, namely ‘a’ > In the expression: a . "hello" > In an equation for ‘b’: b = a . "hello" > • Relevant bindings include b :: a -> c (bound at TestTypes.hs:3:1) > | > 3 | b = a . "hello" > | ^ > > TestTypes.hs:3:9: error: > • Couldn't match expected type ‘a -> b0’ with actual type ‘[Char]’ > • In the second argument of ‘(.)’, namely ‘"hello"’ > In the expression: a . "hello" > In an equation for ‘b’: b = a . "hello" > • Relevant bindings include b :: a -> c (bound at TestTypes.hs:3:1) > | > 3 | b = a . "hello" > | ^^^^^^^ > }}} > > Actually, the real mistake may be in line 1, where `a` is inferred as of > type `Integer`, while it probably was not meant to. But that location is > not reported to the error. As you can guess, in real code location where > the unexpected type is inferred for a binding is not that obvious to > find. > > Suggestion: track locations where bindings' types are inferred, and in > case of type error involvin the bindings, add them to the "Relevant > bindings" section, or otherwise show it. New description: Consider the code: {{{#!hs module TestTypes where a = 42 b = a ++ "hello" }}} The type Error is (ghc-8.2.1): {{{ TestTypes.hs:3:5: error: • No instance for (Num [Char]) arising from the literal ‘42’ • In the expression: 42 In an equation for ‘a’: a = 42 | 3 | a = 42 | ^^ }}} Actually, the real mistake is in line 3, where `a` is inferred as of type `[Char]`, while it was not meant to. But that location is not reported to the error. As you can guess, in real code location where the unexpected type is inferred for a binding is not that obvious to find. Suggestion: track locations where bindings' types are inferred, and in case of type error involvin the bindings, add them to the "Relevant bindings" section, or otherwise show it. -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Oct 28 06:21:43 2017 From: ghc-devs at haskell.org (GHC) Date: Sat, 28 Oct 2017 06:21:43 -0000 Subject: [GHC] #14397: For type error involving inferred types, show source of the type In-Reply-To: <045.4807d2a1dace593629121c50e6806812@haskell.org> References: <045.4807d2a1dace593629121c50e6806812@haskell.org> Message-ID: <060.f7194c0a3e39d32a36be3f73d98442e3@haskell.org> #14397: For type error involving inferred types, show source of the type -------------------------------------+------------------------------------- Reporter: max630 | 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 max630): I have fixed error in the example. This way the behavior is more clearly shown. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Oct 28 06:22:57 2017 From: ghc-devs at haskell.org (GHC) Date: Sat, 28 Oct 2017 06:22:57 -0000 Subject: [GHC] #14397: For type error involving inferred types, show source of the type In-Reply-To: <045.4807d2a1dace593629121c50e6806812@haskell.org> References: <045.4807d2a1dace593629121c50e6806812@haskell.org> Message-ID: <060.668ecee813df3eec5dbfdc55046479c4@haskell.org> #14397: For type error involving inferred types, show source of the type -------------------------------------+------------------------------------- Reporter: max630 | 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: | -------------------------------------+------------------------------------- Old description: > Consider the code: > > {{{#!hs > module TestTypes where > > a = 42 > > b = a ++ "hello" > }}} > > The type Error is (ghc-8.2.1): > > {{{ > TestTypes.hs:3:5: error: > • No instance for (Num [Char]) arising from the literal ‘42’ > • In the expression: 42 > In an equation for ‘a’: a = 42 > | > 3 | a = 42 > | ^^ > }}} > > Actually, the real mistake is in line 3, where `a` is inferred as of type > `[Char]`, while it was not meant to. But that location is not reported to > the error. As you can guess, in real code location where the unexpected > type is inferred for a binding is not that obvious to find. > > Suggestion: track locations where bindings' types are inferred, and in > case of type error involvin the bindings, add them to the "Relevant > bindings" section, or otherwise show it. New description: Consider the code: {{{#!hs module TestTypes where a = 42 b = a ++ "hello" }}} The type Error is (ghc-8.2.1): {{{ TestTypes.hs:3:5: error: • No instance for (Num [Char]) arising from the literal ‘42’ • In the expression: 42 In an equation for ‘a’: a = 42 | 3 | a = 42 | ^^ }}} Actually, the real mistake is in line 5, where `a` is inferred as of type `[Char]`, while it was not meant to. But that location is not reported to the error. As you can guess, in real code location where the unexpected type is inferred for a binding is not that obvious to find. Suggestion: track locations where bindings' types are inferred, and in case of type error involvin the bindings, add them to the "Relevant bindings" section, or otherwise show it. -- Comment (by max630): Fix the line reference in description -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Oct 28 13:50:59 2017 From: ghc-devs at haskell.org (GHC) Date: Sat, 28 Oct 2017 13:50:59 -0000 Subject: [GHC] #13038: implementation of Modus ponens and Modus tollens In-Reply-To: <044.ee87b0a017d5b08f838549b48bb4f0cf@haskell.org> References: <044.ee87b0a017d5b08f838549b48bb4f0cf@haskell.org> Message-ID: <059.2ac99ec05970741fe76291e7781bf095@haskell.org> #13038: implementation of Modus ponens and Modus tollens -------------------------------------+------------------------------------- Reporter: vanto | Owner: (none) Type: feature request | Status: infoneeded Priority: normal | Milestone: Component: libraries/base | 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 vanto): Replying to [[span(style=color: #FF0000, AntC )]]:\\ Here is an example.\\ P and Q are propositions (statements).\\ v(P) and v(Q) are logic values.\\ We say: if P is True : v(P) = 1; if P is False: v(P) = 0; idem for Q and v(Q).\\ First:\\ let the expression :{{{length (xs ++ (y:ys)) = 1 + length xs + length ys}}} We will prove that this expression is True.\\ we know that: {{{length (xs ++ ys) = length xs ++ length ys}}} is True. So,\\ {{{ length (xs ++ (y:ys)) = length xs + length (y:ys) = length xs + (1 + length ys) = 1 + length xs + length ys }}} Demonstration of Modus Tollens:\\ {{{ let xs = [1,2,3] let y:ys = [4,5,6] }}} Attention to the following: you have to replace v(P) by the variable{{{a}}} and v(Q) by the variable {{{b}}}, for instance, in GHCi for a good functioning.\\ {{{let v(P) = length (xs ++ (y:ys))}}} is 1\\ {{{let v(Q) = 1 + length xs + length ys}}} is 1\\ let the implication: v(length (xs ++ (y:ys)) -> 1 + length xs + length ys) is 1. Remember the implication:\\ {{{ P Q P->Q False False True False True True True False False True True True }}} explanation of Modus Tollens:\\ Theorem :v(P->Q), (not)v(Q){{{|-}}}(not)v(P)\\ This theorem become new inference rule:\\ {{{ v(P->Q) (not)v(Q) _________________{modTol} (not)v(P) }}} Now consider the values of v(P) and v(Q) as real values (equal to 1 since they are True)\\ (not)v(Q) = negate q = -6 is 0\\ the implication v(P->Q) is 1\\ so, (not)v(P) = negate p = -6 is 0\\ we have just inferred in the opposite direction of the Modus Ponens (from the conclusion and towards the premise).\\ I point out that my idea is to insert the Modus Tollens inside the type inference algorithm or it will make sense rather than control a finalized expression. We could put it in touch with Typed Hole, for example, to specify the answer of the compiler. Modus Tollens is not specific to programming, it can be found in electronic circuits.(We can build AND,OR,NAND Gates ...)\\ Hope that help. I stop here. Thank you. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Oct 28 18:31:27 2017 From: ghc-devs at haskell.org (GHC) Date: Sat, 28 Oct 2017 18:31:27 -0000 Subject: [GHC] #14390: Panic when defining an instance for (~~) [ppr_equality: homogeneity] In-Reply-To: <050.b158dc2933d34aa54c38d85462566822@haskell.org> References: <050.b158dc2933d34aa54c38d85462566822@haskell.org> Message-ID: <065.d4dc2a47be3363d6cd78e411b7bbc31a@haskell.org> #14390: Panic when defining an instance for (~~) [ppr_equality: homogeneity] -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 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): Phab:D4132 Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * status: new => patch * differential: => Phab:D4132 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Oct 28 21:50:40 2017 From: ghc-devs at haskell.org (GHC) Date: Sat, 28 Oct 2017 21:50:40 -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.c9c22ac12bc850994c9c319638d020c7@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 nomeata): I see these two blocks not being commoned up: {{{ c4bx: // global I64[_s3Yp::P64] = stg_MUT_ARR_PTRS_FROZEN0_info; // CmmStore _s3YJ::P64 = _s3Yp::P64; // CmmAssign _s3YJ::P64 = _s3YJ::P64; // CmmAssign I64[Hp - 48] = GHC.Types.I#_con_info; // CmmStore I64[Hp - 40] = _s3Yj::I64; // CmmStore _c4bX::P64 = Hp - 47; // CmmAssign I64[Hp - 32] = GHC.Arr.Array_con_info; // CmmStore P64[Hp - 24] = Database.idatabase1_closure+1; // CmmStore P64[Hp - 16] = _c4bX::P64; // CmmStore P64[Hp - 8] = _s3YJ::P64; // CmmStore I64[Hp] = _s3Yq::I64; // CmmStore _c4bY::P64 = Hp - 31; // CmmAssign _s3YW::P64 = _c4bY::P64; // CmmAssign goto c4b9; // CmmBranch }}} and {{{ c4bD: // global I64[_s3Yp::P64] = stg_MUT_ARR_PTRS_FROZEN0_info; // CmmStore _s3Yy::P64 = _s3Yp::P64; // CmmAssign _s3Yy::P64 = _s3Yy::P64; // CmmAssign I64[Hp - 48] = GHC.Types.I#_con_info; // CmmStore I64[Hp - 40] = _s3Yj::I64; // CmmStore _c4bZ::P64 = Hp - 47; // CmmAssign I64[Hp - 32] = GHC.Arr.Array_con_info; // CmmStore P64[Hp - 24] = Database.idatabase1_closure+1; // CmmStore P64[Hp - 16] = _c4bZ::P64; // CmmStore P64[Hp - 8] = _s3Yy::P64; // CmmStore I64[Hp] = _s3Yq::I64; // CmmStore _c4c0::P64 = Hp - 31; // CmmAssign _s3YW::P64 = _c4c0::P64; // CmmAssign goto c4b9; // CmmBranch }}} Should they? Does maybe the `_s3YJ::P64 = _s3YJ::P64;` throw CBE off? (This is from nofib’s `fem` with commit d871321ce20e – not sure how useful this commit ID is, as it is from a rebasing branch and so far it only lives on Phabricator.) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Oct 28 21:56:47 2017 From: ghc-devs at haskell.org (GHC) Date: Sat, 28 Oct 2017 21:56:47 -0000 Subject: [GHC] #14393: Levity-polymorphic join point crashes 8.2 In-Reply-To: <046.a88021f5916fc6d39eb14fe83fd3a1e6@haskell.org> References: <046.a88021f5916fc6d39eb14fe83fd3a1e6@haskell.org> Message-ID: <061.f67fc9b4dbb3bd7adc2d8187d34d57bc@haskell.org> #14393: Levity-polymorphic join point crashes 8.2 -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: 8.2.2 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: | -------------------------------------+------------------------------------- Changes (by hsyl20): * status: new => closed * resolution: => fixed Comment: Ben has merged comment 5 of #13394 into `ghc-8.2` (704cbae29ee09431cfbd6b1566a6ec6856f125fc) and it fixes the issue. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Oct 29 01:10:53 2017 From: ghc-devs at haskell.org (GHC) Date: Sun, 29 Oct 2017 01:10:53 -0000 Subject: [GHC] #13038: implementation of Modus ponens and Modus tollens In-Reply-To: <044.ee87b0a017d5b08f838549b48bb4f0cf@haskell.org> References: <044.ee87b0a017d5b08f838549b48bb4f0cf@haskell.org> Message-ID: <059.9ad4ae3c8c6d38a1aa0fc379d1374e9e@haskell.org> #13038: implementation of Modus ponens and Modus tollens -------------------------------------+------------------------------------- Reporter: vanto | Owner: (none) Type: feature request | Status: infoneeded Priority: normal | Milestone: Component: libraries/base | 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 AntC): Replying to [comment:10 vanto]: > Replying to [[span(style=color: #FF0000, AntC )]]:\\ > Here is an example.\\ Not needed: I understand how modus tollens works/how to use it. (And you can reasonably expect that anyone who replies to you would know.) > I point out that my idea is to insert the Modus Tollens inside the type > inference algorithm ... Then what is needed is an example of how type inference would work. > Modus Tollens is not specific to programming, it can be found in > electronic circuits.(We can build AND,OR,NAND Gates ...)\\ In Boolean logic, we have a closed world: not(True) ==> False; not(False) ==> True. In type inference we don't have a closed world. Knowing that type `a0` is `not(a0 ~ Int)` or `not(Num a0)` doesn't help draw any conclusions about `a0`. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Oct 29 03:10:45 2017 From: ghc-devs at haskell.org (GHC) Date: Sun, 29 Oct 2017 03:10:45 -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.8511d24ad5eec7c6ffc7a1eae94f226f@haskell.org> #14335: Annotations aren't supported with -fexternal-interpreter -------------------------------------+------------------------------------- Reporter: bgamari | Owner: bgamari 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: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by gnezdo): I hit this problem with ghc 8.0 as well. There also seems to be some evidence that -fplugin similarly requires -fno-external-interpreter. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Oct 29 04:01:10 2017 From: ghc-devs at haskell.org (GHC) Date: Sun, 29 Oct 2017 04:01:10 -0000 Subject: [GHC] #14398: Fail to install haskell platform on Windows Message-ID: <045.d86ee14cadb946edd5536f02e4b96185@haskell.org> #14398: Fail to install haskell platform on Windows -------------------------------------+------------------------------------- Reporter: KAAAsS | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: GHCi | Version: 8.2.1 Keywords: | Operating System: Windows Architecture: x86_64 | Type of failure: Installing GHC (amd64) | failed Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- I can't run WinGHCi after my installation. When I use command "ghci" in cmd, it returns: {{{ GHCi, version 8.2.1: http://www.haskell.org/ghc/ :? for help ghc.exe: internal error: mkPath failed converting char* to wchar_t* (GHC version 8.2.1 for x86_64_unknown_mingw32) Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug This application has requested the Runtime to terminate it in an unusual way. Please contact the application's support team for more information. }}} I had tried to reinstall or download the Core(64-bit) version, but nothing changed. I think there's nothing wrong with my install precedure. Sorry for my poor English! BTW, my windows is under Chinese code system. I don't know whether this matters or not. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Oct 29 04:57:40 2017 From: ghc-devs at haskell.org (GHC) Date: Sun, 29 Oct 2017 04:57:40 -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.29d5ba0a4e8048e3aa5f8761d7774db4@haskell.org> #14396: Hs-boot woes during family instance consistency checks -------------------------------------+------------------------------------- Reporter: simonpj | 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): Wiki Page: | -------------------------------------+------------------------------------- Comment (by ezyang): Going back to #11062 In this ticket, we decided to fix one particular version of the problem by *deferring* checking a boot-declared type family for conflicts until after we actually typechecked the type family. But as subsequent tickets demonstrated, it is not only the type family which can be defined too early: types referenced inside the LHS and RHS of the instance can also be referenced too early. So let's revisit the fix from before. Here is my proposal: For every axiom, check it for consistency with the environment after all hs-boot types it mentions on the LHS or RHS (I am not sure if this has to be transitive) are finished being typechecked. The most expedient way to implement this is probably to extend `FamInst` to also record a list of "involved" Names, which we can key off of (we can't actually poke `fi_tys` or `fi_rhs` because they would trigger typechecking of the hs-boot type.) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Oct 29 06:16:32 2017 From: ghc-devs at haskell.org (GHC) Date: Sun, 29 Oct 2017 06:16:32 -0000 Subject: [GHC] #12389: Limit duplicate export warnings for datatypes In-Reply-To: <045.b9512948fd651abba4c3deecd83cbcfe@haskell.org> References: <045.b9512948fd651abba4c3deecd83cbcfe@haskell.org> Message-ID: <060.9a1959eb6c865c2acb9bcab582ab8fc8@haskell.org> #12389: Limit duplicate export warnings for datatypes -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: parsonsmatt Type: feature request | Status: new Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 7.10.3 Resolution: | Keywords: newcomer Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect | Unknown/Multiple warning at compile-time | Test Case: Blocked By: | Blocking: Related Tickets: #11959 | Differential Rev(s): Phab:D4134 Wiki Page: | -------------------------------------+------------------------------------- Changes (by parsonsmatt): * owner: (none) => parsonsmatt * differential: => Phab:D4134 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Oct 29 11:15:53 2017 From: ghc-devs at haskell.org (GHC) Date: Sun, 29 Oct 2017 11:15:53 -0000 Subject: [GHC] #14398: Fail to install haskell platform on Windows In-Reply-To: <045.d86ee14cadb946edd5536f02e4b96185@haskell.org> References: <045.d86ee14cadb946edd5536f02e4b96185@haskell.org> Message-ID: <060.33038e37fbb1ea25894693896b5f0797@haskell.org> #14398: Fail to install haskell platform on Windows -------------------------------------+------------------------------------- Reporter: KAAAsS | 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: Installing GHC | (amd64) failed | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Phyx-): Hi, I need to know what path it's trying to convert. Can you download and extract https://1drv.ms/u/s!AuQz_u- 9HaJPmcQRFveWa9dMBi77hg Then download http://www.rohitab.com/download/api-monitor- v2r13-x86-x64.zip run the api monitor (64 bit) and click the `monitor new process` button, in the dialog for `Process` enter the path to the `GHCi.exe` in the GHC you downloaded above, and press `OK`. it should list 4 exe in the `monitored processes`, click on them each one at a time, and each time go to `File` -> `Save As`, and save the result. Attach the 4 captures here and I'll take a look. Thanks. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Oct 29 13:45:26 2017 From: ghc-devs at haskell.org (GHC) Date: Sun, 29 Oct 2017 13:45:26 -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.3e4ac8c8df400a719584a92016bc28aa@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 michalt): Replying to [comment:16 nomeata]: > [...] > Should they? Does maybe the `_s3YJ::P64 = _s3YJ::P64;` throw CBE off? Hmm.. Interesting. I'd expect that with the recent patch from bgamari this should be commoned up. Is this the final cmm or is it the input to `CmmCommonBlockElim`? (asking because sometimes the sinking pass can expose more opportunities for `CmmCommonBlockElim`, but we run sinking pass *after* eliminating common blocks; example: #12915) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Oct 29 14:24:24 2017 From: ghc-devs at haskell.org (GHC) Date: Sun, 29 Oct 2017 14:24:24 -0000 Subject: [GHC] #14399: NCG: dead code stripping prevention wastes space Message-ID: <048.5f378c3bf8dda7942233e1d7d36a1e6c@haskell.org> #14399: NCG: dead code stripping prevention wastes space -------------------------------------+------------------------------------- Reporter: heisenbug | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Keywords: low-hanging | Operating System: Unknown/Multiple Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- = Symptom Consider this NCG-generated code: {{{ .long _T5001a_zdp1Comorphism_info - _T5001a_zdp1Comorphism_info_dsp .data .align 3 .align 0 .globl _T5001a_mapzusentence_closure _T5001a_mapzusentence_closure: .quad _T5001a_mapzusentence_info .text .align 3 _T5001a_mapzusentence_info_dsp: .align 3 .quad 4294967301 .quad 0 .quad 14 .globl _T5001a_mapzusentence_info _T5001a_mapzusentence_info: }}} There is an inert `.long` at the end of each Cmm procedure. This fills up precious instruction cache and wastes space. = Potential solutions Some ideas to improve the situation follow: 1. Move all those longs to a "table" at the end of the compilation unit (idea by Henning Thielemann), 2. coalesce the relocation into the previous instruction by explicitly calculating the opcode (craziness by me), 3. coalesce the relocation into the following info table like this: {{{ .quad 4294967301 - 24 + _T5001a_zdp1Comorphism_info - _T5001a_zdp1Comorphism_info_dsp }}} 4. Instead of exporting `_T5001a_mapzusentence_info` export `_T5001a_mapzusentence_info_dsp` and jump/call `_T5001a_mapzusentence_info_dsp + 24` instead. (Idea by Henning Thielemann.) == Discussion 1. Improves instruction cache only 2. hard to implement, leads to ugly assembly 3. wastes a long per compilation unit (at the end), needs a new state in the assembly writer 4. leads to unintuitive (ugly?) assembly. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Oct 29 14:34:43 2017 From: ghc-devs at haskell.org (GHC) Date: Sun, 29 Oct 2017 14:34:43 -0000 Subject: [GHC] #14399: NCG: dead code stripping prevention wastes space In-Reply-To: <048.5f378c3bf8dda7942233e1d7d36a1e6c@haskell.org> References: <048.5f378c3bf8dda7942233e1d7d36a1e6c@haskell.org> Message-ID: <063.4bea19486c604538e794c0d4617065f4@haskell.org> #14399: NCG: dead code stripping prevention wastes space -------------------------------------+------------------------------------- Reporter: heisenbug | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: | Keywords: low-hanging 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): Note that this is only the case on OS X, which provides no reasonable way to hint symbol reachability. In light of this, I'm really not keen on adding complexity to NCG to fix this case. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Oct 29 14:55:19 2017 From: ghc-devs at haskell.org (GHC) Date: Sun, 29 Oct 2017 14:55:19 -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.821ce9794ffe5f8ec0002278dce9ee27@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 bgamari): Indeed it's hard to say much without knowing with certainty that this is the code that CBE looks at. That being said, I believe that the CBE implementation should be able to deal with `CmmAssign`s of the form `x=x` since it compares the RHSs up to alpha equivalence. It would of course be good to check this, however. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Oct 29 20:15:46 2017 From: ghc-devs at haskell.org (GHC) Date: Sun, 29 Oct 2017 20:15:46 -0000 Subject: [GHC] #13604: ghci no longer loads dynamic .o files by default if they were built with -O In-Reply-To: <045.626a6b40d9101c93e2935653ef7e4668@haskell.org> References: <045.626a6b40d9101c93e2935653ef7e4668@haskell.org> Message-ID: <060.6fe537e9b874a70073283e482214dfbd@haskell.org> #13604: ghci no longer loads dynamic .o files by default if they were built with -O -------------------------------------+------------------------------------- Reporter: George | Owner: dfeuer Type: bug | Status: patch Priority: highest | Milestone: 8.2.2 Component: Compiler | Version: 8.2.1-rc1 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): Phab:D4123 Wiki Page: | -------------------------------------+------------------------------------- Comment (by dfeuer): elaforge, I have an idea that feels like it provides a reasonably consistent UI, but I'd like to see what you think. 1. Optimization flags (including `-O0`) imply `-fobject-code`. This ensures that GHC respects optimization flags regardless of `--interactive`. 2. Even when `-fobject-code` is on, `:load *M` will load `M` as bytecode. This provides the "escape hatch" from `-fobject-code` that you need to use debugging features, etc. 3. We add `-fignore-optim-changes` and `-fignore-hpc-changes` (​Phab:D4123), enabling users to put together object code and bytecode with diverse optimization levels and HPC info while still updating automatically based on source changes and whether profiling is enabled. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Oct 29 21:01:36 2017 From: ghc-devs at haskell.org (GHC) Date: Sun, 29 Oct 2017 21:01:36 -0000 Subject: [GHC] #14398: Fail to install haskell platform on Windows In-Reply-To: <045.d86ee14cadb946edd5536f02e4b96185@haskell.org> References: <045.d86ee14cadb946edd5536f02e4b96185@haskell.org> Message-ID: <060.3672ec0547e849b10d0029bbb6a4336e@haskell.org> #14398: Fail to install haskell platform on Windows -------------------------------------+------------------------------------- Reporter: KAAAsS | 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: Installing GHC | (amd64) failed | 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 Sun Oct 29 21:43:16 2017 From: ghc-devs at haskell.org (GHC) Date: Sun, 29 Oct 2017 21:43:16 -0000 Subject: [GHC] #14400: Make :sprint, :print, and :force work with cyclical structures Message-ID: <045.01990250a6fc2c5f0497619b295a1c7e@haskell.org> #14400: Make :sprint, :print, and :force work with cyclical structures -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: (none) Type: feature | Status: new request | Priority: normal | Milestone: 8.6.1 Component: GHCi | 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: -------------------------------------+------------------------------------- {{{ > t = "hi" : t > :force t }}} never completes, because GHC races around and around in a loop forever. It would seem better to keep a hashset of nodes that have already been visited to avoid getting stuck, and print out a reasonable representation of the graph. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Oct 29 21:44:57 2017 From: ghc-devs at haskell.org (GHC) Date: Sun, 29 Oct 2017 21:44:57 -0000 Subject: [GHC] #14401: Add a test ensuring that TypeReps can be stored in compact regions Message-ID: <045.7850d3af995cddf93f5b8f7122e7e766@haskell.org> #14401: Add a test ensuring that TypeReps can be stored in compact regions -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: (none) Type: task | Status: new Priority: normal | Milestone: 8.2.2 Component: Test Suite | Version: 8.2.1 Keywords: Typeable | Operating System: Unknown/Multiple Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- My work thus far on Phab:D4085 has involved `TypeRep`s with cyclical structure. That bit me in `break011` and `break024` because `:force` doesn't work with cyclical structures. This would also have caused trouble for storing `TypeRep`s in compact regions. If we eventually make `:force` work with cyclical structures (see #14400), then cyclical `TypeRep`s won't break the test suite but might break user code using compact regions. So let's test for that. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Oct 29 22:09:52 2017 From: ghc-devs at haskell.org (GHC) Date: Sun, 29 Oct 2017 22:09:52 -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.e23545bbd4b3da43b4d6165957e70907@haskell.org> #5889: -fno-prof-count-entries leads to linking errors -------------------------------------+------------------------------------- Reporter: akio | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.3 Resolution: | Keywords: Operating System: Linux | Architecture: x86_64 Type of failure: GHC rejects | (amd64) valid program | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by duog): * status: closed => new * version: 7.4.1 => 8.3 * resolution: fixed => * milestone: 7.6.2 => Comment: I've encountered this error while building ghc; let me know if it would be more appropriate to create a new ticket. When building ghc, booting with ghc-8.2.1, with the following build.mk: {{{ BuildFlavour = prof ifneq "$(BuildFlavour)" "" include mk/flavours/$(BuildFlavour).mk endif GhcStage2HcOpts += -fprof-auto -fno-prof-count-entries }}} I get the following error while linking libHSghc-8.3.p_a: {{{ /home/doug/ghc- dev/validate/compiler/stage2/build/libHSghc-8.3_p.a(HscMain.p_o):s1afa_info: error: undefined reference to 'ghc_CoreToStg_coreToStgzipgmzq_Cq7W_cc' /home/doug/ghc- dev/validate/compiler/stage2/build/libHSghc-8.3_p.a(StgLint.p_o):sort_info: error: undefined reference to 'ghc_Type_newTyConInstRhszirhs_ChfI_cc' /home/doug/ghc- dev/validate/compiler/stage2/build/libHSghc-8.3_p.a(StgLint.p_o):soru_info: error: undefined reference to 'ghc_Type_newTyConInstRhszitvs_ChfH_cc' /home/doug/ghc- dev/validate/compiler/stage2/build/libHSghc-8.3_p.a(StgLint.p_o):sorC_info: error: undefined reference to 'ghc_Type_newTyConInstRhszirhs_ChfI_cc' /home/doug/ghc- dev/validate/compiler/stage2/build/libHSghc-8.3_p.a(StgLint.p_o):sorD_info: error: undefined reference to 'ghc_Type_newTyConInstRhszitvs_ChfH_cc' /home/doug/ghc- dev/validate/compiler/stage2/build/libHSghc-8.3_p.a(RtClosureInspect.p_o):sMUb_info: error: undefined reference to 'ghc_Type_newTyConInstRhszirhs_ChfI_cc' /home/doug/ghc- dev/validate/compiler/stage2/build/libHSghc-8.3_p.a(RtClosureInspect.p_o):sMUd_info: error: undefined reference to 'ghc_Type_newTyConInstRhszitvs_ChfH_cc' /home/doug/ghc- dev/validate/compiler/stage2/build/libHSghc-8.3_p.a(TcForeign.p_o):sy5L_info: error: undefined reference to 'ghc_Type_newTyConInstRhszirhs_ChfI_cc' /home/doug/ghc- dev/validate/compiler/stage2/build/libHSghc-8.3_p.a(TcForeign.p_o):sy5W_info: error: undefined reference to 'ghc_Type_newTyConInstRhszitvs_ChfH_cc' }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Oct 29 22:21:42 2017 From: ghc-devs at haskell.org (GHC) Date: Sun, 29 Oct 2017 22:21:42 -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.681281f7d18df889db7c9717b6706b04@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 nomeata): It’s the ouptut of `-ddump-cmm-cbe` -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Oct 29 22:36:09 2017 From: ghc-devs at haskell.org (GHC) Date: Sun, 29 Oct 2017 22:36:09 -0000 Subject: [GHC] #14152: Float exit paths out of recursive functions In-Reply-To: <046.dc062d85b02b871348583b82e3b8d72a@haskell.org> References: <046.dc062d85b02b871348583b82e3b8d72a@haskell.org> Message-ID: <061.a769ca3b239b83a6b98f128998382621@haskell.org> #14152: Float exit paths out of recursive functions -------------------------------------+------------------------------------- Reporter: nomeata | Owner: (none) Type: task | Status: patch Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: | Keywords: JoinPoints Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #14137 #10918 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Joachim Breitner ): In [changeset:"0e953da147c405648356f75ee67eda044fffad49/ghc" 0e953da1/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="0e953da147c405648356f75ee67eda044fffad49" Implement a dedicated exitfication pass #14152 The idea is described in #14152, and can be summarized: Float the exit path out of a joinrec, so that the simplifier can do more with it. See the test case for a nice example. The floating goes against what the simplifier usually does, hence we need to be careful not inline them back. The position of exitification in the pipeline was chosen after a small amount of experimentation, but may need to be improved. For example, exitification can allow rewrite rules to fire, but for that it would have to happen before the `simpl_phases`. Perf.haskell.org reports these nice performance wins: Nofib allocations fannkuch-redux 78446640 - 99.92% 64560 k-nucleotide 109466384 - 91.32% 9502040 simple 72424696 - 5.96% 68109560 Nofib instruction counts fannkuch-redux 1744331636 - 3.86% 1676999519 k-nucleotide 2318221965 - 6.30% 2172067260 scs 1978470869 - 3.35% 1912263779 simple 669858104 - 3.38% 647206739 spectral-norm 186423292 - 5.37% 176411536 Differential Revision: https://phabricator.haskell.org/D3903 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 30 00:52:31 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 30 Oct 2017 00:52: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.1668ae09ad8428027ffa3291fbd9b1a8@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 bgamari): Interesting; would you like to investigate or should I? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 30 01:51:18 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 30 Oct 2017 01:51:18 -0000 Subject: [GHC] #14390: Panic when defining an instance for (~~) [ppr_equality: homogeneity] In-Reply-To: <050.b158dc2933d34aa54c38d85462566822@haskell.org> References: <050.b158dc2933d34aa54c38d85462566822@haskell.org> Message-ID: <065.d49c6c8fc43533256d2994e389f0370f@haskell.org> #14390: Panic when defining an instance for (~~) [ppr_equality: homogeneity] -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 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): Phab:D4132 Wiki Page: | -------------------------------------+------------------------------------- Comment (by Ben Gamari ): In [changeset:"85aa1f4253163985fe07d172f8da73b784bb7b4b/ghc" 85aa1f42/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="85aa1f4253163985fe07d172f8da73b784bb7b4b" Fix #14390 by making toIfaceTyCon aware of equality GHC was panicking when pretty-printing a heterogeneous equality type constructor (#14390) because the function which produced the type constructor, `toIfaceTyCon`, wasn't attaching the appropriate `IfaceTyConSort` for equality type constructors, which is `IfaceEqualityTyCon`. This is fixed easily enough. Test Plan: make test TEST=T14390 Reviewers: austin, bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie GHC Trac Issues: #14390 Differential Revision: https://phabricator.haskell.org/D4132 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 30 01:51:18 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 30 Oct 2017 01:51:18 -0000 Subject: [GHC] #13945: 'ghc-pkg update' fails due to bad file descriptor error In-Reply-To: <049.b152863155a8f5ca5d2c78f97fc10495@haskell.org> References: <049.b152863155a8f5ca5d2c78f97fc10495@haskell.org> Message-ID: <064.4e1975a50a324e79931db37f67ce8cec@haskell.org> #13945: 'ghc-pkg update' fails due to bad file descriptor error ---------------------------------+---------------------------------------- Reporter: mpickering | Owner: bgamari Type: bug | Status: new Priority: high | Milestone: 8.2.2 Component: Compiler | Version: 8.2.1-rc3 Resolution: | Keywords: Operating System: Linux | Architecture: Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D3897 Wiki Page: | ---------------------------------+---------------------------------------- Comment (by Ben Gamari ): In [changeset:"3b784d440d4b01b4c549df7c9a3ed2058edfc780/ghc" 3b784d4/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="3b784d440d4b01b4c549df7c9a3ed2058edfc780" base: Implement file locking in terms of POSIX locks Hopefully these are more robust to NFS malfunction than BSD flock-style locks. See #13945. Test Plan: Validate via @simonpj Reviewers: austin, hvr Subscribers: rwbarton, thomie, erikd, simonpj GHC Trac Issues: #13945 Differential Revision: https://phabricator.haskell.org/D4129 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 30 01:51:18 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 30 Oct 2017 01:51:18 -0000 Subject: [GHC] #13825: Allow multiple constructor fields occupy the same word In-Reply-To: <046.a33ec6522f3fa0ad8c7d0d60af2159aa@haskell.org> References: <046.a33ec6522f3fa0ad8c7d0d60af2159aa@haskell.org> Message-ID: <061.9fa7453c9947cfdce15dbbf444e6a961@haskell.org> #13825: Allow multiple constructor fields occupy the same word -------------------------------------+------------------------------------- Reporter: michalt | Owner: michalt Type: bug | Status: new Priority: normal | Milestone: 8.4.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: #605 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Ben Gamari ): In [changeset:"cca2d6b78f97bfb79bef4dc3f75d6c4d15b94680/ghc" cca2d6b7/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="cca2d6b78f97bfb79bef4dc3f75d6c4d15b94680" Allow packing constructor fields This is another step for fixing #13825 and is based on D38 by Simon Marlow. The change allows storing multiple constructor fields within the same word. This currently applies only to `Float`s, e.g., ``` data Foo = Foo {-# UNPACK #-} !Float {-# UNPACK #-} !Float ``` on 64-bit arch, will now store both fields within the same constructor word. For `WordX/IntX` we'll need to introduce new primop types. Main changes: - We now use sizes in bytes when we compute the offsets for constructor fields in `StgCmmLayout` and introduce padding if necessary (word-sized fields are still word-aligned) - `ByteCodeGen` had to be updated to correctly construct the data types. This required some new bytecode instructions to allow pushing things that are not full words onto the stack (and updating `Interpreter.c`). Note that we only use the packed stuff when constructing data types (i.e., for `PACK`), in all other cases the behavior should not change. - `RtClosureInspect` was changed to handle the new layout when extracting subterms. This seems to be used by things like `:print`. I've also added a test for this. - I deviated slightly from Simon's approach and use `PrimRep` instead of `ArgRep` for computing the size of fields. This seemed more natural and in the future we'll probably want to introduce new primitive types (e.g., `Int8#`) and `PrimRep` seems like a better place to do that (where we already have `Int64Rep` for example). `ArgRep` on the other hand seems to be more focused on calling functions. Signed-off-by: Michal Terepeta Test Plan: ./validate Reviewers: bgamari, simonmar, austin, hvr, goldfire, erikd Reviewed By: bgamari Subscribers: maoe, rwbarton, thomie GHC Trac Issues: #13825 Differential Revision: https://phabricator.haskell.org/D3809 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 30 01:52:32 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 30 Oct 2017 01:52:32 -0000 Subject: [GHC] #13825: Allow multiple constructor fields occupy the same word In-Reply-To: <046.a33ec6522f3fa0ad8c7d0d60af2159aa@haskell.org> References: <046.a33ec6522f3fa0ad8c7d0d60af2159aa@haskell.org> Message-ID: <061.68e5f4566da1922c669851cfec79e563@haskell.org> #13825: Allow multiple constructor fields occupy the same word -------------------------------------+------------------------------------- Reporter: michalt | Owner: michalt Type: bug | 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: #605 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: new => closed * resolution: => fixed -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 30 01:52:49 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 30 Oct 2017 01:52:49 -0000 Subject: [GHC] #14390: Panic when defining an instance for (~~) [ppr_equality: homogeneity] In-Reply-To: <050.b158dc2933d34aa54c38d85462566822@haskell.org> References: <050.b158dc2933d34aa54c38d85462566822@haskell.org> Message-ID: <065.6c0d18f832c6788cd14e811081773f89@haskell.org> #14390: Panic when defining an instance for (~~) [ppr_equality: homogeneity] -------------------------------------+------------------------------------- Reporter: RyanGlScott | 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: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4132 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 Oct 30 01:53:00 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 30 Oct 2017 01:53:00 -0000 Subject: [GHC] #14390: Panic when defining an instance for (~~) [ppr_equality: homogeneity] In-Reply-To: <050.b158dc2933d34aa54c38d85462566822@haskell.org> References: <050.b158dc2933d34aa54c38d85462566822@haskell.org> Message-ID: <065.f40a598eab72ef4b7b021db7982fcbf5@haskell.org> #14390: Panic when defining an instance for (~~) [ppr_equality: homogeneity] -------------------------------------+------------------------------------- Reporter: RyanGlScott | 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: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: T14390 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4132 Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * testcase: => T14390 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 30 02:03:39 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 30 Oct 2017 02:03:39 -0000 Subject: [GHC] #14402: Compiler hangs - UdecidableInstances Message-ID: <045.f4b15566dfaaaa6f038c70b4b0636346@haskell.org> #14402: Compiler hangs - UdecidableInstances -------------------------------------+------------------------------------- Reporter: lehins | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 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: -------------------------------------+------------------------------------- Normally I wouldn't consider GHC going into infinite loop when `UndecidableInstances` is enabled as a bug, because compiler still terminates unless maybe something like `-freduction-depth=0` is supplied. That is not the case with this few lines of Haskell, as they cause GHC to hang for good and even made it use up all of my 32Gb of RAM, while I was looking the other way. Seems a bit unusual for GHC, so here is a record of it as a bug report. Compiling with `-v3` stops here: {{{ [1 of 1] Compiling Nested ( src/Nested.hs, .stack- work/dist/x86_64-linux/Cabal-2.0.0.2/build/Nested.o ) *** Parser [Nested]: !!! Parser [Nested]: finished in 1.03 milliseconds, allocated 0.566 megabytes *** Renamer/typechecker [Nested]: }}} Compilation with GHC 8.0.2 goes through just fine. Although, I did encounter it hanging as part of a much bigger picture because of the same few lines of code. Coming up with a small reproducible example is much harder for that case as it hangs while compiling the test suite, instead of the offending module. In order to replicate the problem, the included code has to be compiled as a library rather than as an executable. Using `stack build --install-ghc` should do it. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 30 02:04:46 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 30 Oct 2017 02:04:46 -0000 Subject: [GHC] #14402: Compiler hangs - UdecidableInstances In-Reply-To: <045.f4b15566dfaaaa6f038c70b4b0636346@haskell.org> References: <045.f4b15566dfaaaa6f038c70b4b0636346@haskell.org> Message-ID: <060.f8d07e904cf3ab3c77ebb286045826c7@haskell.org> #14402: Compiler hangs - UdecidableInstances -------------------------------------+------------------------------------- Reporter: lehins | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 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 lehins): * Attachment "Nested.hs" added. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 30 02:04:58 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 30 Oct 2017 02:04:58 -0000 Subject: [GHC] #14402: Compiler hangs - UdecidableInstances In-Reply-To: <045.f4b15566dfaaaa6f038c70b4b0636346@haskell.org> References: <045.f4b15566dfaaaa6f038c70b4b0636346@haskell.org> Message-ID: <060.7f090d3b48de293e86a3d8cb0fbf21d9@haskell.org> #14402: Compiler hangs - UdecidableInstances -------------------------------------+------------------------------------- Reporter: lehins | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 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 lehins): * Attachment "bug.cabal" added. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 30 02:05:07 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 30 Oct 2017 02:05:07 -0000 Subject: [GHC] #14402: Compiler hangs - UdecidableInstances In-Reply-To: <045.f4b15566dfaaaa6f038c70b4b0636346@haskell.org> References: <045.f4b15566dfaaaa6f038c70b4b0636346@haskell.org> Message-ID: <060.c270bd0d1891099fdf7df0dc3b8ded02@haskell.org> #14402: Compiler hangs - UdecidableInstances -------------------------------------+------------------------------------- Reporter: lehins | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 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 lehins): * Attachment "stack.yaml" added. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 30 04:17:03 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 30 Oct 2017 04:17: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.10564792bcdd661186f3e4eb7443d8ea@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 bgamari): So this is an interesting case. The module that blows up is quite small; it seems that the blowing up code all comes from unfoldings introduced via, {{{#!hs mainH :: HReader AppPayload Int :<|> HReader AppPayload Int mainH = handleReaderRequest' :<|> handleReaderRequest }}} where `AppPayload` is a type-level list. The number of coercions in the desugared core seems to scale quadratically with the length of this list, ||= Phase =||= N=1 =||= N=2 =||= N=3 =||= N=4 =||= N=5 =|| || Desugar (terms) || 74 || 87 || 100 || 113 || 126 || || Desugar (types) || 350 || 502 || 694 || 926 || 1198 || || Desugar (coerc) || 395 || 746 || 1238 || 1895 || 2741 || Yet in all of these cases somehow Core Tidy brings all of these programs down to precisely 67 terms and a couple hundred types/coercions. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 30 04:40:56 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 30 Oct 2017 04: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.b054bd6b6a292aa4f4d8877ce80ad100@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 bgamari): Indeed essentially all of this bloat comes from specialisations of the `HModify` and `HGet` dictionaries (see `Data.HSet` included in the testcase). For instance, we have, {{{#!hs -- RHS size: {terms: 5, types: 52, coercions: 426, joins: 0/0} $dHModify :: Data.HSet.HModify '[Payload 3, Payload 4, Payload 5, Payload 6, PayloadX] '[Payload 3, Payload 4, Payload 5, Payload 6, PayloadX] PayloadX PayloadX ('TypeFun.Data.Peano.S ('TypeFun.Data.Peano.S ('TypeFun.Data.Peano.S ('TypeFun.Data.Peano.S 'TypeFun.Data.Peano.Z)))) }}} It looks like we end up producing O(N) of these things, with each having O(N) (perhaps more?) coercions. I have added this ticket to the list of "coercion pile-up" issues on Performance/Compiler, since it seems pretty clear that this ticket falls in this bucket. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 30 04:43:24 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 30 Oct 2017 04:43:24 -0000 Subject: [GHC] #14403: strange closure type 2136315671 Message-ID: <049.1d55864784cfccd8ecb3de8d2fc8bfce@haskell.org> #14403: strange closure type 2136315671 -------------------------------------+------------------------------------- Reporter: matrixmike | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- cabal install aeson ghc: internal error: evacuate: strange closure type 2136315671 (GHC version 8.2.1 for x86_64_unknown_linux) Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug The Glorious Glasgow Haskell Compilation System, version 8.2.1 Version 1.5.1, Git revision 600c1f01435a10d127938709556c1682ecfd694e (4861 commits) x86_64 hpack-0.17.1 cabal-install version 1.24.0.2 compiled using version 1.24.2.0 of the Cabal library HLint v1.8.53, (C) Neil Mitchell 2006-2013 hindent 5.2.3 hpack version 0.17.1 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 30 04:53:11 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 30 Oct 2017 04:53:11 -0000 Subject: [GHC] #14404: Grammar mistake at https://www.haskell.org/platform/windows.html. Message-ID: <045.44f031cdf5fc881a99b85464ea8e445b@haskell.org> #14404: Grammar mistake at https://www.haskell.org/platform/windows.html. -------------------------------------+------------------------------------- Reporter: R030t1 | Owner: (none) Type: feature | Status: new request | Priority: normal | Milestone: Component: Documentation | Version: 8.2.1 Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: Documentation Unknown/Multiple | bug Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- https://www.haskell.org/platform/windows.html, under step 2: "Additionally, you may want to should double-check" Possible fix: "Additionally, you should double-check" My apologies if this is not the right tracker. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 30 04:58:35 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 30 Oct 2017 04:58:35 -0000 Subject: [GHC] #14403: strange closure type 2136315671 In-Reply-To: <049.1d55864784cfccd8ecb3de8d2fc8bfce@haskell.org> References: <049.1d55864784cfccd8ecb3de8d2fc8bfce@haskell.org> Message-ID: <064.45d8b3a0c609c0dc8950fe23d16a87af@haskell.org> #14403: strange closure type 2136315671 -------------------------------------+------------------------------------- Reporter: matrixmike | 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): Wiki Page: | -------------------------------------+------------------------------------- Description changed by bgamari: Old description: > cabal install aeson > > > ghc: internal error: evacuate: strange closure type 2136315671 > (GHC version 8.2.1 for x86_64_unknown_linux) > Please report this as a GHC bug: > http://www.haskell.org/ghc/reportabug > > The Glorious Glasgow Haskell Compilation System, version 8.2.1 > Version 1.5.1, Git revision 600c1f01435a10d127938709556c1682ecfd694e > (4861 commits) x86_64 hpack-0.17.1 > cabal-install version 1.24.0.2 > compiled using version 1.24.2.0 of the Cabal library > HLint v1.8.53, (C) Neil Mitchell 2006-2013 > hindent 5.2.3 > hpack version 0.17.1 New description: {{{ cabal install aeson ghc: internal error: evacuate: strange closure type 2136315671 (GHC version 8.2.1 for x86_64_unknown_linux) Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug The Glorious Glasgow Haskell Compilation System, version 8.2.1 Version 1.5.1, Git revision 600c1f01435a10d127938709556c1682ecfd694e (4861 commits) x86_64 hpack-0.17.1 cabal-install version 1.24.0.2 compiled using version 1.24.2.0 of the Cabal library HLint v1.8.53, (C) Neil Mitchell 2006-2013 hindent 5.2.3 hpack version 0.17.1 }}} -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 30 05:00:31 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 30 Oct 2017 05:00:31 -0000 Subject: [GHC] #14403: strange closure type 2136315671 In-Reply-To: <049.1d55864784cfccd8ecb3de8d2fc8bfce@haskell.org> References: <049.1d55864784cfccd8ecb3de8d2fc8bfce@haskell.org> Message-ID: <064.7480dbe9115be0e3943bec6138f1ef27@haskell.org> #14403: strange closure type 2136315671 -------------------------------------+------------------------------------- Reporter: matrixmike | 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): Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): Which process panicked (e.g. `cabal`, `ghc`, something else)? Is this on Linux/amd64? Is it reproducible? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 30 05:01:49 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 30 Oct 2017 05:01:49 -0000 Subject: [GHC] #13945: 'ghc-pkg update' fails due to bad file descriptor error In-Reply-To: <049.b152863155a8f5ca5d2c78f97fc10495@haskell.org> References: <049.b152863155a8f5ca5d2c78f97fc10495@haskell.org> Message-ID: <064.f2844d7b15195e3276ee899dd8d5f3f4@haskell.org> #13945: 'ghc-pkg update' fails due to bad file descriptor error ---------------------------------+---------------------------------------- Reporter: mpickering | Owner: bgamari Type: bug | Status: closed Priority: high | Milestone: 8.2.2 Component: Compiler | Version: 8.2.1-rc3 Resolution: fixed | Keywords: Operating System: Linux | Architecture: Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D3897 Wiki Page: | ---------------------------------+---------------------------------------- Changes (by bgamari): * status: new => closed * resolution: => fixed Comment: Merged to `ghc-8.2` in b71db1122de9d302febafbd3a77713c989f5b4c6. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 30 06:09:43 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 30 Oct 2017 06:09:43 -0000 Subject: [GHC] #14403: strange closure type 2136315671 In-Reply-To: <049.1d55864784cfccd8ecb3de8d2fc8bfce@haskell.org> References: <049.1d55864784cfccd8ecb3de8d2fc8bfce@haskell.org> Message-ID: <064.185a22768d3cb2e3029e36d277a7e681@haskell.org> #14403: strange closure type 2136315671 -------------------------------------+------------------------------------- Reporter: matrixmike | 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): Wiki Page: | -------------------------------------+------------------------------------- Comment (by matrixmike): The command that started this was 'cabal install aeson' . - - I have a script that reports the versions : ghc --version stack --version cabal --version hlint --version hindent --version hpack --version => which gives the following output... The Glorious Glasgow Haskell Compilation System, version 8.2.1 Version 1.5.1, Git revision 600c1f01435a10d127938709556c1682ecfd694e (4861 commits) x86_64 hpack-0.17.1 cabal-install version 1.24.0.2 compiled using version 1.24.2.0 of the Cabal library HLint v1.8.53, (C) Neil Mitchell 2006-2013 hindent 5.2.3 hpack version 0.17.1 the bug is repeatable on this machine - Linux Mint 17.3 Distributor ID: LinuxMint Description: Linux Mint 17.3 Rosa Release: 17.3 Codename: rosa - I have another laptop also with 17.3 Rosa and that works OK. I noticed the aeson version 1.2.3.0 fails on this PC and that 1.2.2.0 works on the other PC so I tried cabal install aeson-1.2.2.0 and that fails on THIS PC as shown below : [17 of 23] Compiling Data.Aeson.Types.ToJSON ( Data/Aeson/Types/ToJSON.hs, dist/build/Data/Aeson/Types/ToJSON.o ) ghc: internal error: evacuate: strange closure type 4332269 (GHC version 8.2.1 for x86_64_unknown_linux) Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug cabal: Leaving directory '/tmp/cabal-tmp-9392/aeson-1.2.2.0' Failed to install aeson-1.2.2.0 cabal: Error: some packages failed to install: aeson-1.2.2.0 failed during the building phase. The exception was: ExitFailure (-6) Let me know if I can be more helpful... regards Mike H (matrixmike on github) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 30 06:31:44 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 30 Oct 2017 06:31:44 -0000 Subject: [GHC] #7258: Compiling DynFlags is jolly slow In-Reply-To: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> References: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> Message-ID: <061.90c5fb6feed9531bda7ba305bc1c0161@haskell.org> #7258: Compiling DynFlags is jolly slow -------------------------------------+------------------------------------- Reporter: simonpj | Owner: simonpj Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.6.1 Resolution: | Keywords: deriving-perf 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): I tried the suggestion in comment [comment:67] and got these results for compiling `W2.hs` Vanilla: {{{ COST CENTRE MODULE SRC %time %alloc sink CmmPipeline compiler/cmm/CmmPipeline.hs:(104,13)-(105,59) 55.7 15.9 SimplTopBinds SimplCore compiler/simplCore/SimplCore.hs:761:39-74 19.5 30.6 FloatOutwards SimplCore compiler/simplCore/SimplCore.hs:471:40-66 4.2 9.0 RegAlloc-linear AsmCodeGen compiler/nativeGen/AsmCodeGen.hs:(658,27)-(660,55) 4.0 11.1 pprNativeCode AsmCodeGen compiler/nativeGen/AsmCodeGen.hs:(529,37)-(530,65) 2.8 6.3 NewStranal SimplCore compiler/simplCore/SimplCore.hs:480:40-63 1.6 3.7 OccAnal SimplCore compiler/simplCore/SimplCore.hs:(739,22)-(740,67) 1.5 3.5 StgCmm HscMain compiler/main/HscMain.hs:(1426,13)-(1427,62) 1.2 2.4 regLiveness AsmCodeGen compiler/nativeGen/AsmCodeGen.hs:(591,17)-(593,52) 1.2 1.9 genMachCode AsmCodeGen compiler/nativeGen/AsmCodeGen.hs:(580,17)-(582,62) 0.9 1.8 NativeCodeGen CodeOutput compiler/main/CodeOutput.hs:171:18-78 0.9 2.1 CoreTidy HscMain compiler/main/HscMain.hs:1253:27-67 0.8 1.9 }}} `skpped` as UniqSet: {{{ COST CENTRE MODULE SRC %time %alloc SimplTopBinds SimplCore compiler/simplCore/SimplCore.hs:761:39-74 38.3 29.0 sink CmmPipeline compiler/cmm/CmmPipeline.hs:(104,13)-(105,59) 13.2 20.3 RegAlloc-linear AsmCodeGen compiler/nativeGen/AsmCodeGen.hs:(658,27)-(660,55) 8.3 10.5 FloatOutwards SimplCore compiler/simplCore/SimplCore.hs:471:40-66 8.1 8.5 pprNativeCode AsmCodeGen compiler/nativeGen/AsmCodeGen.hs:(529,37)-(530,65) 5.4 5.9 NewStranal SimplCore compiler/simplCore/SimplCore.hs:480:40-63 3.1 3.5 OccAnal SimplCore compiler/simplCore/SimplCore.hs:(739,22)-(740,67) 2.9 3.3 StgCmm HscMain compiler/main/HscMain.hs:(1426,13)-(1427,62) 2.3 2.3 regLiveness AsmCodeGen compiler/nativeGen/AsmCodeGen.hs:(591,17)-(593,52) 2.1 1.8 NativeCodeGen CodeOutput compiler/main/CodeOutput.hs:171:18-78 1.7 2.0 genMachCode AsmCodeGen compiler/nativeGen/AsmCodeGen.hs:(580,17)-(582,62) 1.6 1.7 CoreTidy HscMain compiler/main/HscMain.hs:1253:27-67 1.4 1.8 foldNodesBwdOO Hoopl.Dataflow compiler/cmm/Hoopl/Dataflow.hs:(397,1)-(403,17) 1.1 0.8 }}} Good results I think. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 30 08:37:16 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 30 Oct 2017 08:37:16 -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.5db42466f90695516fc7d53576eada8c@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 dredozubov): I've seen quite a lot `HModify` and `HGet` popping up in a core dump, but haven't realized it's linked to coercions. The comments above supports my experience with this piece of code and the issue. The issue definitely arises when increasing the length of a type-level list `AppPayload` in this case. In the context of a larger project, it was pretty difficult to pinpoint, an additional servant endpoint can trigger it for example. Do I understand correctly that you're referring to the idea of dropping explicit coercions for compilation without `-dcore-lint`? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 30 09:06:03 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 30 Oct 2017 09:06:03 -0000 Subject: [GHC] #7258: Compiling DynFlags is jolly slow In-Reply-To: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> References: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> Message-ID: <061.aa1c08fd49a1d94cff93119cd42d0643@haskell.org> #7258: Compiling DynFlags is jolly slow -------------------------------------+------------------------------------- Reporter: simonpj | Owner: simonpj Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.6.1 Resolution: | Keywords: deriving-perf 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 tdammers): * Attachment "ghc-large-record-types-core-size.png" added. Core size for large record modules -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 30 09:47:07 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 30 Oct 2017 09:47:07 -0000 Subject: [GHC] #12389: Limit duplicate export warnings for datatypes In-Reply-To: <045.b9512948fd651abba4c3deecd83cbcfe@haskell.org> References: <045.b9512948fd651abba4c3deecd83cbcfe@haskell.org> Message-ID: <060.40651149117a0949998c984bfd60cc0a@haskell.org> #12389: Limit duplicate export warnings for datatypes -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: parsonsmatt Type: feature request | Status: new Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 7.10.3 Resolution: | Keywords: newcomer Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect | Unknown/Multiple warning at compile-time | Test Case: Blocked By: | Blocking: Related Tickets: #11959 | Differential Rev(s): Phab:D4134 Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): > I'm going to attempt a patch for this. Thanks! But what exactly is "this"? I think you mean something like "allow leading and trailing commas in the sub-export lists". As I said above, that's ok with me. but * It should be consistent with exports lists themselves. Do they allow leading commas? If not, it'd make sense to add them. Thus {{{ module M( , f, g, ) where ... }}} * Do we allow multiple leading or trailing commas? What about repeated commas in the middle of a list? * What about import lists? Should they not be consistent? * Should we require a language extension flag? So although this is a small and superficial change, it ''is'' a user- facing one, and so should really go through the [https://github.com/ghc- proposals/ghc-proposals GHC proposals process]. Because it's small, it'll be quick! But the debate is always helpful. I'm conscious that this may seem obstructive, but I've learned that it really is worth writing down the specification and debating it before implementing it. Doing so materially increases quality by giving a way for more people to contribute. Thanks for helping! Simon -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 30 09:57:07 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 30 Oct 2017 09:57:07 -0000 Subject: [GHC] #14400: Make :sprint, :print, and :force work with cyclical structures In-Reply-To: <045.01990250a6fc2c5f0497619b295a1c7e@haskell.org> References: <045.01990250a6fc2c5f0497619b295a1c7e@haskell.org> Message-ID: <060.d38aa4734f2f9198937b2670f8351bb7@haskell.org> #14400: Make :sprint, :print, and :force work with cyclical structures -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: 8.6.1 Component: GHCi | 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 simonpj): The GHCi debugger, which interactively forces data structures trying to figure out their types, could indeed do with Much Love. This would indeed be one thing one might try doing. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 30 10:00:07 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 30 Oct 2017 10:00:07 -0000 Subject: [GHC] #14401: Add a test ensuring that TypeReps can be stored in compact regions In-Reply-To: <045.7850d3af995cddf93f5b8f7122e7e766@haskell.org> References: <045.7850d3af995cddf93f5b8f7122e7e766@haskell.org> Message-ID: <060.c0acae81e8cf8651bff8d262ff102a96@haskell.org> #14401: Add a test ensuring that TypeReps can be stored in compact regions -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: (none) Type: task | Status: new Priority: normal | Milestone: 8.2.2 Component: Test Suite | Version: 8.2.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: | -------------------------------------+------------------------------------- Comment (by simonpj): Indeed. But the tail should not wag the dog. We only get a cyclic `TypeRep` in one extremely specialised situation. If that situation causes major problems elsewhere, let's revisit `TypeRep`. E.g. we could have a special `TypeRep` for `TYPE LiftedRep`. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 30 10:13:43 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 30 Oct 2017 10:13:43 -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.351fd62a48eb14b1de3d7ffe60b1aea8@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): Dropping coercions won't change the number of simplifier ticks though, will it? So even if we do that, we may still get this "ticks-exhausted" issue, no? Do you have any insight about that? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 30 10:29:21 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 30 Oct 2017 10:29:21 -0000 Subject: [GHC] #7258: Compiling DynFlags is jolly slow In-Reply-To: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> References: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> Message-ID: <061.d057a19e7cd3aa50b58350b66198699e@haskell.org> #7258: Compiling DynFlags is jolly slow -------------------------------------+------------------------------------- Reporter: simonpj | Owner: simonpj Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.6.1 Resolution: | Keywords: deriving-perf 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:69 simonpj]: > Is the large Cmm accounted for by the big Core-to-Cmm ratio, or do these examples also have Core sizes that scale badly (look at term size only)? > > I'm guessing that the Core size does not scale badly. If that was so our questions would be > > * Why do we generate so much Cmm per unit of Core > * Can we make `sink` scale better > > Both are worth working on. https://ghc.haskell.org/trac/ghc/attachment/ticket/7258/ghc-large-record- types-core-size.png suggests Core size has a slight nonlinearity to it, the behavior is roughly the same for all examples, so I believe your guess that Core size doesn't scale as badly as C-- size does is justified. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 30 10:34:48 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 30 Oct 2017 10:34:48 -0000 Subject: [GHC] #7258: Compiling DynFlags is jolly slow In-Reply-To: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> References: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> Message-ID: <061.5cf261ed1cab1fc406f332d75310277e@haskell.org> #7258: Compiling DynFlags is jolly slow -------------------------------------+------------------------------------- Reporter: simonpj | Owner: simonpj Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.6.1 Resolution: | Keywords: deriving-perf 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 tdammers): * Attachment "examples100.zip" added. 100-field record examples -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 30 10:35:11 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 30 Oct 2017 10:35:11 -0000 Subject: [GHC] #14402: Compiler hangs - UdecidableInstances In-Reply-To: <045.f4b15566dfaaaa6f038c70b4b0636346@haskell.org> References: <045.f4b15566dfaaaa6f038c70b4b0636346@haskell.org> Message-ID: <060.66a9039fec7dca2b67bd6205bc95fc2b@haskell.org> #14402: Compiler hangs - UdecidableInstances -------------------------------------+------------------------------------- Reporter: lehins | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 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 mpickering): Does compiling with `-fno-solve-constant-dicts` solve the problem? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 30 10:37:05 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 30 Oct 2017 10:37:05 -0000 Subject: [GHC] #14402: Compiler hangs - UdecidableInstances In-Reply-To: <045.f4b15566dfaaaa6f038c70b4b0636346@haskell.org> References: <045.f4b15566dfaaaa6f038c70b4b0636346@haskell.org> Message-ID: <060.45f43dd488a5b7db73b10f1b85ee62bd@haskell.org> #14402: Compiler hangs - UdecidableInstances -------------------------------------+------------------------------------- Reporter: lehins | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 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 mpickering): Perhaps a duplicate of #13943 Which is fixed by https://phabricator.haskell.org/rGHCa8fde1831f4b99885b8ed444f9cd7dffd9252150 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 30 10:37:08 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 30 Oct 2017 10:37:08 -0000 Subject: [GHC] #7258: Compiling DynFlags is jolly slow In-Reply-To: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> References: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> Message-ID: <061.9cceeb36ccf83697155ed3c143bf8c11@haskell.org> #7258: Compiling DynFlags is jolly slow -------------------------------------+------------------------------------- Reporter: simonpj | Owner: simonpj Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.6.1 Resolution: | Keywords: deriving-perf 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:70 alexbiehl]: > > I tried the suggestion in comment [comment:67] and got these results for compiling `W2.hs` > > [...] > > Good results I think. Though I need to check if allocation goes up significantly in common cases. You could try running the examples in examples100.zip (https://ghc.haskell.org/trac/ghc/attachment/ticket/7258/examples100.zip) to see whether any of them performs worse, that would be a good first indication. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 30 11:46:32 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 30 Oct 2017 11:46:32 -0000 Subject: [GHC] #14402: Compiler hangs - UdecidableInstances In-Reply-To: <045.f4b15566dfaaaa6f038c70b4b0636346@haskell.org> References: <045.f4b15566dfaaaa6f038c70b4b0636346@haskell.org> Message-ID: <060.e30c6581a4662f670ed04212c0c1ca49@haskell.org> #14402: Compiler hangs - UdecidableInstances -------------------------------------+------------------------------------- Reporter: lehins | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 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: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * status: new => closed * resolution: => duplicate Comment: > Perhaps a duplicate of #13943 Looks like it. Indeed `Nested.hs -O` fails makes GHC 8.2 loop, but HEAD is fine. I'll just close as dup Simon -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 30 11:48:03 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 30 Oct 2017 11:48:03 -0000 Subject: [GHC] #14382: The 'impossible' happened whilst installing gi-gtk via cabal In-Reply-To: <052.f9c10851d0906622baeb7996269cc8e7@haskell.org> References: <052.f9c10851d0906622baeb7996269cc8e7@haskell.org> Message-ID: <067.58018d131ee5c0e536b0a3f502af5553@haskell.org> #14382: The 'impossible' happened whilst installing gi-gtk via cabal ----------------------------------+-------------------------------------- Reporter: maartenjacobs | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: | Keywords: gtk, pango Operating System: Linux | Architecture: x86_64 (amd64) Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | ----------------------------------+-------------------------------------- Comment (by simonpj): May well be connected to #14396 (which is a much simpler case) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 30 11:50:17 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 30 Oct 2017 11:50:17 -0000 Subject: [GHC] #14382: The 'impossible' happened whilst installing gi-gtk via cabal In-Reply-To: <052.f9c10851d0906622baeb7996269cc8e7@haskell.org> References: <052.f9c10851d0906622baeb7996269cc8e7@haskell.org> Message-ID: <067.0e15765d6125dc1ddb65717dcb7e40ad@haskell.org> #14382: The 'impossible' happened whilst installing gi-gtk via cabal -------------------------------------+------------------------------------- Reporter: maartenjacobs | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: | Keywords: gtk, pango, | hs-boot 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 simonpj): * keywords: gtk, pango => gtk, pango, hs-boot -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 30 11:50:28 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 30 Oct 2017 11:50:28 -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.7ae46fb6d95252aee5cabc55f4b99c55@haskell.org> #14396: Hs-boot woes during family instance consistency checks -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: | 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): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * keywords: => hs-boot -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 30 11:58:15 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 30 Oct 2017 11:58:15 -0000 Subject: [GHC] #14152: Float exit paths out of recursive functions In-Reply-To: <046.dc062d85b02b871348583b82e3b8d72a@haskell.org> References: <046.dc062d85b02b871348583b82e3b8d72a@haskell.org> Message-ID: <061.93a0b8b81eb476191fb6f05ab3abcad6@haskell.org> #14152: Float exit paths out of recursive functions -------------------------------------+------------------------------------- Reporter: nomeata | Owner: (none) Type: task | Status: patch Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: | Keywords: JoinPoints Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #14137 #10918 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Great! Is the final "inline them back in" pass there, or not? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 30 12:28:27 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 30 Oct 2017 12:28:27 -0000 Subject: [GHC] #7258: Compiling DynFlags is jolly slow In-Reply-To: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> References: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> Message-ID: <061.8db67d9cbbedb3c428d01266b33cad0b@haskell.org> #7258: Compiling DynFlags is jolly slow -------------------------------------+------------------------------------- Reporter: simonpj | Owner: simonpj Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.6.1 Resolution: | Keywords: deriving-perf 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 tdammers): * Attachment "ghc-stage2-7258-deeper-SCC.prof" added. Profiling output with more SCC's added -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 30 12:30:09 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 30 Oct 2017 12:30:09 -0000 Subject: [GHC] #7258: Compiling DynFlags is jolly slow In-Reply-To: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> References: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> Message-ID: <061.f269d1375d78c6735ab78d765d413ce3@haskell.org> #7258: Compiling DynFlags is jolly slow -------------------------------------+------------------------------------- Reporter: simonpj | Owner: simonpj Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.6.1 Resolution: | Keywords: deriving-perf 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): Profiling a bit deeper (see https://ghc.haskell.org/trac/ghc/attachment/ticket/7258/ghc-stage2-7258 -deeper-SCC.prof) hints at a possible nonlinearity in `tryToInline`, particularly when recursing through the `keep` function. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 30 13:12:16 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 30 Oct 2017 13:12:16 -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.0f3421c816f37173fbd2864624820b03@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 bgamari): Indeed dropping coercions won't fix the simplifier ticks issue. Nevertheless, I thought it would be important to characterise the coercion issue since this is one of the simplest reproducers of non-linear coercion growth to-date. The major contributors to the ticks summary look like this, ||= N =||= PreInlineUncond =||= RuleFired =||= BetaReduction =||= Total =|| || 1 || 244 || 247 || 724 || 1772 || || 2 || 262 || 284 || 811 || 1940 || || 3 || 309 || 354 || 992 || 2295 || || 4 || 396 || 481 || 1343 || 2963 || || 5 || 569 || 713 || 2016 || 4227 || || 6 || 907 || 1146 || 3317 || 6653 || || 7 || 1561 || 1972 || 5848 || 11343 || || 8 || 2860 || 3575 || 10831 || 20555 || || 9 || 5444 || 6723 || 20696 || 38765 || In the case of `N=9` the most frequently-firing rules are, {{{ 6723 RuleFired 4348 Class op HEq_sc 1029 Class op $p1HModify 1029 Class op $p2HModify 114 Class op $p1HGet ... }}} The top `PreInlineUnconditionally` targets are, {{{ 5444 PreInlineUnconditionally 505 w 505 w 503 w 503 w1 503 w2 503 w3 503 w 503 w1 503 w2 503 w3 86 $dHGet ... }}} And the top beta reduction targets are, {{{ 20696 BetaReduction 505 i 505 e1 505 ex 505 els1 505 e2 505 els2 505 w 505 w1 505 w2 505 i 505 e1 505 ex 505 els1 505 e2 505 els2 505 w 505 w1 505 w2 503 i 503 e1 503 ex 503 els1 503 e2 503 els2 503 w 503 w1 503 w2 503 w3 503 i 503 e1 503 ex 503 els1 503 e2 503 els2 503 w 503 w1 503 w2 503 w3 86 i ... }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 30 13:46:09 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 30 Oct 2017 13:46:09 -0000 Subject: [GHC] #7258: Compiling DynFlags is jolly slow In-Reply-To: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> References: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> Message-ID: <061.b7a6db3ffd60032c03e4979e1ccfb26b@haskell.org> #7258: Compiling DynFlags is jolly slow -------------------------------------+------------------------------------- Reporter: simonpj | Owner: simonpj Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.6.1 Resolution: | Keywords: deriving-perf 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 tdammers): * Attachment "ghc-large-record-types-optimized-2.png" added. Performance graph for various examples, compiling with -O, using UniqSet (as in comment #67) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 30 14:02:02 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 30 Oct 2017 14:02:02 -0000 Subject: [GHC] #7258: Compiling DynFlags is jolly slow In-Reply-To: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> References: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> Message-ID: <061.72032a09fe9db871a476c80d2df671d7@haskell.org> #7258: Compiling DynFlags is jolly slow -------------------------------------+------------------------------------- Reporter: simonpj | Owner: simonpj Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.6.1 Resolution: | Keywords: deriving-perf 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): Modifications as proposed in comments [comment:67] / [comment:70] appear to improve performance for the "bad" cases, and not harm the "good" example cases significantly. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 30 14:49:59 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 30 Oct 2017 14:49:59 -0000 Subject: [GHC] #14403: strange closure type 2136315671 In-Reply-To: <049.1d55864784cfccd8ecb3de8d2fc8bfce@haskell.org> References: <049.1d55864784cfccd8ecb3de8d2fc8bfce@haskell.org> Message-ID: <064.7cebe4861fa96ed2b4b6f228d3bc3870@haskell.org> #14403: strange closure type 2136315671 -------------------------------------+------------------------------------- Reporter: matrixmike | 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): Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): Thanks for those details. This is indeed quite concerning. Do you suppose you could try 8.2.2-rc2 (just released)? There is one heap corruption issue in particular (#14346) that may be relevant here. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 30 15:29:18 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 30 Oct 2017 15:29:18 -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.0e0f68a7a091d0050ca4e6405ef17a9b@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): Vaguely reminds me of #13253. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 30 16:20:44 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 30 Oct 2017 16:20:44 -0000 Subject: [GHC] #14404: Grammar mistake at https://www.haskell.org/platform/windows.html. In-Reply-To: <045.44f031cdf5fc881a99b85464ea8e445b@haskell.org> References: <045.44f031cdf5fc881a99b85464ea8e445b@haskell.org> Message-ID: <060.a8c6710131de7784a446160142cce6a7@haskell.org> #14404: Grammar mistake at https://www.haskell.org/platform/windows.html. -------------------------------------+------------------------------------- Reporter: R030t1 | Owner: (none) Type: feature request | Status: closed Priority: normal | Milestone: Component: Documentation | Version: 8.2.1 Resolution: fixed | Keywords: 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 bgamari): * status: new => closed * resolution: => fixed Comment: Thanks for the report! I've forwarded this request to the Platform people. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 30 16:47:46 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 30 Oct 2017 16:47:46 -0000 Subject: [GHC] #14152: Float exit paths out of recursive functions In-Reply-To: <046.dc062d85b02b871348583b82e3b8d72a@haskell.org> References: <046.dc062d85b02b871348583b82e3b8d72a@haskell.org> Message-ID: <061.6fd662458495962b1342cf4c9d49026e@haskell.org> #14152: Float exit paths out of recursive functions -------------------------------------+------------------------------------- Reporter: nomeata | Owner: (none) Type: task | Status: patch Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: | Keywords: JoinPoints Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #14137 #10918 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by nomeata): I left it out for now, because instruction counts increase. I tried to analyse it, and here is what I found: I read through a lot of core, comparing `-dverbose-core2core` between the version without inlining exit join points at the end, and the version with. In `compress2`, I don’t spot a difference in Core. In `fem` (a big program), there are a fair number of exit join points, but I don’t see anything fishy going on… What I do, how ever, see is exit join points that are called from two positions in the code, where inlining duplicates the code. (Common block elimination might help with that, but #14226 seems to get in the way.) I also see calls to `stg_gc_noregs()` turn into calls to `stg_gc_unpt_r1(R1)`, but I am not sure what that means, or if that is a good thing or a bad thing. I expect that the “useless” unconditional jump to a non-inlined exit join point, which was the motivation for the final inlining, will be eliminated on the Cmm stage without much ado. So the performance measurement says “don't inline”, and looking at the Core, not inlining seems to be fine, and the Cmm also looks better. So in the light of that I think I’ll conclude that the final inlining is neither necessary nor useful. Anyways, the final inline patch still lives in `wip/T14152` for anyone to play with. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 30 16:50:58 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 30 Oct 2017 16:50:58 -0000 Subject: [GHC] #7258: Compiling DynFlags is jolly slow In-Reply-To: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> References: <046.5b0ca13f8e67074efa6f0020a75c7792@haskell.org> Message-ID: <061.cad349516fa39e747eecc5599cc44905@haskell.org> #7258: Compiling DynFlags is jolly slow -------------------------------------+------------------------------------- Reporter: simonpj | Owner: simonpj Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.6.1 Resolution: | Keywords: deriving-perf 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): During the call Simon hypothesized that we should keep the free variables lists in mind when comparing STG. I stated that I didn't think that we currently had a way to print closures' free variable lists. I've checked and this isn't quite true: the pretty-printer will print free variable lists when `-dppr-debug` is passed. I've broken this out into its own flag in Phab:D4140. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 30 17:07:49 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 30 Oct 2017 17:07:49 -0000 Subject: [GHC] #14346: 8.2.1 regression: heap corruption after safe foreign calls In-Reply-To: <049.7a4af7d8399ac93444ea4b9211bf91ff@haskell.org> References: <049.7a4af7d8399ac93444ea4b9211bf91ff@haskell.org> Message-ID: <064.775a1138a641100e27fbbd4755a01676@haskell.org> #14346: 8.2.1 regression: heap corruption after safe foreign calls -------------------------------------+------------------------------------- Reporter: andrewchen | Owner: bgamari Type: bug | Status: patch Priority: highest | Milestone: 8.4.1 Component: Runtime System | Version: 8.2.1 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 bgamari): * owner: (none) => bgamari -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 30 17:08:09 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 30 Oct 2017 17:08:09 -0000 Subject: [GHC] #14375: Implement with# primop In-Reply-To: <046.d97bc36423b0cbcf2ececb77831c1a4a@haskell.org> References: <046.d97bc36423b0cbcf2ececb77831c1a4a@haskell.org> Message-ID: <061.27c370217747e363509487f3f62f0253@haskell.org> #14375: Implement with# primop -------------------------------------+------------------------------------- Reporter: simonpj | Owner: bgamari Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: | Keywords: JoinPoints Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: 14346 Related Tickets: #14346 | Differential Rev(s): ​Phab:D4110 Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * owner: (none) => bgamari * blocking: => 14346 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 30 17:19:55 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 30 Oct 2017 17:19:55 -0000 Subject: [GHC] #14152: Float exit paths out of recursive functions In-Reply-To: <046.dc062d85b02b871348583b82e3b8d72a@haskell.org> References: <046.dc062d85b02b871348583b82e3b8d72a@haskell.org> Message-ID: <061.410bdf7147c0859ba62ca46a8d2bf99f@haskell.org> #14152: Float exit paths out of recursive functions -------------------------------------+------------------------------------- Reporter: nomeata | Owner: (none) Type: task | Status: patch Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: | Keywords: JoinPoints Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #14137 #10918 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): > I left it out for now, because instruction counts increase So, just to be sure: allocation counts did not change? > What I do, how ever, see is exit join points that are called from two positions in the code, where inlining duplicates the code. What if you inline only join points that are called once? So that no code duplication is involved. I'm having a hard time seeing why that should do anything bad. And it can do something good... if you have {{{ join j x = ...y... in ...jump j v... }}} then `y` will get pushed onto the stack at the `join`, so that its RHS knows where to find it. If it's inlined that may not happen. So may be more than just eliminating a jump. Still, I accept that it's not top priority. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 30 17:38:21 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 30 Oct 2017 17:38:21 -0000 Subject: [GHC] #14152: Float exit paths out of recursive functions In-Reply-To: <046.dc062d85b02b871348583b82e3b8d72a@haskell.org> References: <046.dc062d85b02b871348583b82e3b8d72a@haskell.org> Message-ID: <061.0dfea099294724c77befe39fe3d56dc7@haskell.org> #14152: Float exit paths out of recursive functions -------------------------------------+------------------------------------- Reporter: nomeata | Owner: (none) Type: task | Status: patch Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: | Keywords: JoinPoints Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #14137 #10918 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by nomeata): Replying to [comment:29 simonpj]: > > I left it out for now, because instruction counts increase > > So, just to be sure: allocation counts did not change? Nope. Byte-for-byte identical. > > What I do, how ever, see is exit join points that are called from two positions in the code, where inlining duplicates the code. > > What if you inline only join points that are called once? So that no code duplication is involved. I doubt that the code duplication is the real culprit here. More likely things like different order of blocks leading to different decision later in the code generation, e.g. in the register allocator, leading to less or more register pressure and different registers being saved? Do you know the difference between `stg_gc_noregs()` and `stg_gc_unpt_r1(R1)`? > I'm having a hard time seeing why that should do anything bad. And it can do something good... if you have > {{{ > join j x = ...y... > in > ...jump j v... > }}} > then `y` will get pushed onto the stack at the `join`, so that its RHS knows where to find it. If it's inlined that may not happen. So may be more than just eliminating a jump. Well, according to the numbers it's not happening. Remember that the `jump` to an exit point is almost always going to the right-hand-side of a case alternative. Which is, as far I as I can tell, already a jump target, so the `y` in your example would have to be pushed on the stack just the same, woudn’t it? I understand that this is all a bit unsatisfying intellectually, but I don’t want to sink more time into this, at least not without concrete examples or other evidence that show that what we are doing now is indeed bad. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 30 17:41:05 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 30 Oct 2017 17:41:05 -0000 Subject: [GHC] #12389: Limit duplicate export warnings for datatypes In-Reply-To: <045.b9512948fd651abba4c3deecd83cbcfe@haskell.org> References: <045.b9512948fd651abba4c3deecd83cbcfe@haskell.org> Message-ID: <060.f98574e4c00945daca1a9c6b37c7c556@haskell.org> #12389: Limit duplicate export warnings for datatypes -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: parsonsmatt Type: feature request | Status: new Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 7.10.3 Resolution: | Keywords: newcomer Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect | Unknown/Multiple warning at compile-time | Test Case: Blocked By: | Blocking: Related Tickets: #11959 | Differential Rev(s): Phab:D4134 Wiki Page: | -------------------------------------+------------------------------------- Comment (by parsonsmatt): You're correct -- that is what I meant :) I've collected the notes into a [https://github.com/ghc-proposals/ghc- proposals/pull/87 GHC Proposal #87]. I'll submit the proposal to the wider community and see what comes of that. Thanks! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 30 17:46:35 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 30 Oct 2017 17:46:35 -0000 Subject: [GHC] #14152: Float exit paths out of recursive functions In-Reply-To: <046.dc062d85b02b871348583b82e3b8d72a@haskell.org> References: <046.dc062d85b02b871348583b82e3b8d72a@haskell.org> Message-ID: <061.dbf20aeca5f448ff26f8d2a3744e2b7d@haskell.org> #14152: Float exit paths out of recursive functions -------------------------------------+------------------------------------- Reporter: nomeata | Owner: (none) Type: task | Status: patch Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: | Keywords: JoinPoints Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #14137 #10918 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): > I understand that this is all a bit unsatisfying intellectually, but I don’t want to sink more time into this, at least not without concrete examples or other evidence that show that what we are doing now is indeed bad. Yes that's fine. If we have 100 Joachim cycles I'd rather they were spent on the fattest target, and this doesn't look like one. Back to loopification next? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 30 18:08:27 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 30 Oct 2017 18:08:27 -0000 Subject: [GHC] #14152: Float exit paths out of recursive functions In-Reply-To: <046.dc062d85b02b871348583b82e3b8d72a@haskell.org> References: <046.dc062d85b02b871348583b82e3b8d72a@haskell.org> Message-ID: <061.83201c2e1d19853876d6d4aa29006f76@haskell.org> #14152: Float exit paths out of recursive functions -------------------------------------+------------------------------------- Reporter: nomeata | Owner: (none) Type: task | Status: patch Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: | Keywords: JoinPoints Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #14137 #10918 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by nomeata): > Back to loopification next? Aye! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 30 21:01:50 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 30 Oct 2017 21:01:50 -0000 Subject: [GHC] #13604: ghci no longer loads dynamic .o files by default if they were built with -O In-Reply-To: <045.626a6b40d9101c93e2935653ef7e4668@haskell.org> References: <045.626a6b40d9101c93e2935653ef7e4668@haskell.org> Message-ID: <060.38f05af0de4ca69eb2b373e19eb1c583@haskell.org> #13604: ghci no longer loads dynamic .o files by default if they were built with -O -------------------------------------+------------------------------------- Reporter: George | Owner: dfeuer Type: bug | Status: patch Priority: highest | Milestone: 8.2.3 Component: Compiler | Version: 8.2.1-rc1 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): Phab:D4123 Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * milestone: 8.2.2 => 8.2.3 Comment: Alright, I'm afraid we are going to have to punt on this for 8.2.2. Sorry elaforge! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 30 21:04:42 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 30 Oct 2017 21:04:42 -0000 Subject: [GHC] #14379: Regression - GHC 8.2.1 Consumes All Memory On Build In-Reply-To: <047.3a29f02e3bbd9a0f2379ab1644f26326@haskell.org> References: <047.3a29f02e3bbd9a0f2379ab1644f26326@haskell.org> Message-ID: <062.143e00cbfc0e7e5a8121871834b8acab@haskell.org> #14379: Regression - GHC 8.2.1 Consumes All Memory On Build -------------------------------------+------------------------------------- Reporter: jm4games | Owner: (none) Type: bug | Status: closed Priority: high | Milestone: 8.2.2 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): 8.0.2 Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: merge => closed * resolution: => fixed * milestone: => 8.2.2 Comment: Merged to `ghc-8.2` as 58bb1a781982d26729efb4a3b72186257a637013. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 30 21:07:26 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 30 Oct 2017 21:07:26 -0000 Subject: [GHC] #14054: Cabal generates ill-typed Paths module when relocatable In-Reply-To: <045.4319866d264e103497bc03abff674a19@haskell.org> References: <045.4319866d264e103497bc03abff674a19@haskell.org> Message-ID: <060.4412c91e0e59a748f3c5f3b5d72ee99f@haskell.org> #14054: Cabal generates ill-typed Paths module when relocatable -------------------------------------+------------------------------------- Reporter: ezyang | Owner: (none) Type: bug | Status: closed Priority: highest | Milestone: 8.2.2 Component: libraries | Version: 8.2.1 (other) | Resolution: fixed | Keywords: Cabal 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 bgamari): * status: upstream => closed * resolution: => fixed Comment: Fixed in `ghc-8.2` in Cabal bump in 5d02bca29596e28b0499f4706062c8c804908bd9. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 30 21:09:22 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 30 Oct 2017 21:09:22 -0000 Subject: [GHC] #14215: Coordinate re Cabal-2.0.0.3 or Cabal-2.0.1 release In-Reply-To: <042.f2da5496c03c753cd8a87d1fc1022cfc@haskell.org> References: <042.f2da5496c03c753cd8a87d1fc1022cfc@haskell.org> Message-ID: <057.97398b6d87e38ffc4e89ab9071a41d27@haskell.org> #14215: Coordinate re Cabal-2.0.0.3 or Cabal-2.0.1 release -------------------------------------+------------------------------------- Reporter: hvr | Owner: (none) Type: task | Status: closed Priority: high | Milestone: 8.2.2 Component: libraries | Version: 8.2.1 (other) | 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: Fix for Cabal 4808 was merged to `ghc-8.2` in Cabal bump in 5d02bca29596e28b0499f4706062c8c804908bd9. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 30 21:10:09 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 30 Oct 2017 21:10:09 -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.43969e1c5810430094ac9fd3299587a4@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.4.1 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: | -------------------------------------+------------------------------------- Changes (by bgamari): * milestone: 8.2.2 => 8.4.1 Comment: It seems unlikely that this will happen for 8.2. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 30 21:11:13 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 30 Oct 2017 21:11:13 -0000 Subject: [GHC] #14174: GHC panic with TypeInType and type family In-Reply-To: <045.87c0508a41a6d0d9834ba40ef8506297@haskell.org> References: <045.87c0508a41a6d0d9834ba40ef8506297@haskell.org> Message-ID: <060.05f5071b3a98f3ad15febd4465a593a9@haskell.org> #14174: GHC panic with TypeInType and type family -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.2.3 Component: Compiler (Type | Version: 8.2.1 checker) | Resolution: | Keywords: TypeInType 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 bgamari): * milestone: 8.2.2 => 8.2.3 Comment: It looks like this won't be fixed in 8.2.2. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 30 21:11:45 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 30 Oct 2017 21:11:45 -0000 Subject: [GHC] #14180: Strange/bad error message binding unboxed type variable In-Reply-To: <045.2cd418235dffeabd04a0de461895e7c1@haskell.org> References: <045.2cd418235dffeabd04a0de461895e7c1@haskell.org> Message-ID: <060.62874c811f6004de62ef3df8785ca8e0@haskell.org> #14180: Strange/bad error message binding unboxed type variable -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.2.3 Component: Compiler (Type | Version: 8.3 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 bgamari): * milestone: 8.2.2 => 8.2.3 Comment: It looks like this won't be fixed for 8.2.2. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 30 21:12:38 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 30 Oct 2017 21:12:38 -0000 Subject: [GHC] #14401: Add a test ensuring that TypeReps can be stored in compact regions In-Reply-To: <045.7850d3af995cddf93f5b8f7122e7e766@haskell.org> References: <045.7850d3af995cddf93f5b8f7122e7e766@haskell.org> Message-ID: <060.4239240c8c08b011551cd4b7883e2ce6@haskell.org> #14401: Add a test ensuring that TypeReps can be stored in compact regions -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: (none) Type: task | Status: new Priority: normal | Milestone: 8.4.1 Component: Test Suite | Version: 8.2.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 bgamari): * milestone: 8.2.2 => 8.4.1 Comment: None of the TypeRep refinements will be merged until 8.4; bumping. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 30 21:32:56 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 30 Oct 2017 21:32:56 -0000 Subject: [GHC] #14405: Remove core-spec.pdf from repository Message-ID: <046.63e8bab96844585065adc6def2c2a3b1@haskell.org> #14405: Remove core-spec.pdf from repository -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: task | Status: new Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.2.1 Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- Currently we track `core-spec.pdf` in the repository, which is generated from ott sources. This is a rather flagrant violation of a central tenant of version control: don't track derived files. However, simonpj would like to ensure that there is an easily accessible copy of this artifact somewhere, so we can't remove it yet. Let's ensure that it is produced by documentation artifact produced by CircleCI. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 30 21:34:22 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 30 Oct 2017 21:34:22 -0000 Subject: [GHC] #13716: Move CI to Jenkins In-Reply-To: <046.48e2facaae8e965ca7d5990f8113aa95@haskell.org> References: <046.48e2facaae8e965ca7d5990f8113aa95@haskell.org> Message-ID: <061.38ca403cc2ce9b7d74cda3c0d40671ff@haskell.org> #13716: Move CI to Jenkins -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: task | Status: closed Priority: normal | Milestone: Component: None | Version: 8.0.1 Resolution: wontfix | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: 13897, 14291 | Blocking: Related Tickets: #11958, #13205 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: new => closed * resolution: => wontfix Comment: Well, it's more-or-less official at this point. GHC will be moving not to Jenkins but rather to CircleCI and Appveyor. See the rather lengthy thread on the [[https://mail.haskell.org/pipermail/ghc-devops- group/2017-October/000037.html|ghc-devops]] list for details. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 30 21:34:47 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 30 Oct 2017 21:34:47 -0000 Subject: [GHC] #13222: Update formalism for join points In-Reply-To: <049.b34747a00c615a5f34c9610329937813@haskell.org> References: <049.b34747a00c615a5f34c9610329937813@haskell.org> Message-ID: <064.af01eda68fcd5206e76ffdbc32078d2d@haskell.org> #13222: Update formalism for join points -------------------------------------+------------------------------------- Reporter: lukemaurer | Owner: lukemaurer Type: task | Status: patch Priority: normal | Milestone: 8.2.2 Component: Compiler | Version: 8.1 Resolution: | Keywords: JoinPoints Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Other | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D3296 Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): Given that Jenkins is on hold for the moment, I've gone ahead and merged the formalism change. `core-spec.pdf` is still in the repository. Hopefully once we have documentation building via CI we'll be able to move it out. I've opened #14405 to track this. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 30 21:34:53 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 30 Oct 2017 21:34:53 -0000 Subject: [GHC] #13222: Update formalism for join points In-Reply-To: <049.b34747a00c615a5f34c9610329937813@haskell.org> References: <049.b34747a00c615a5f34c9610329937813@haskell.org> Message-ID: <064.7f6a9f997c52f23c678c0935078a53a0@haskell.org> #13222: Update formalism for join points -------------------------------------+------------------------------------- Reporter: lukemaurer | Owner: lukemaurer Type: task | Status: closed Priority: normal | Milestone: 8.2.2 Component: Compiler | Version: 8.1 Resolution: fixed | Keywords: JoinPoints Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Other | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D3296 Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: patch => closed * resolution: => fixed -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 30 21:36:22 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 30 Oct 2017 21:36:22 -0000 Subject: [GHC] #14080: GHC panic while forcing the thunk for TyThing IsFile (regression) In-Reply-To: <044.09b34dc4c0e2fa3e606fc911e20d53ee@haskell.org> References: <044.09b34dc4c0e2fa3e606fc911e20d53ee@haskell.org> Message-ID: <059.938d769df624a6d70f1c36ca36ebcbf8@haskell.org> #14080: GHC panic while forcing the thunk for TyThing IsFile (regression) -------------------------------------+------------------------------------- Reporter: inaki | Owner: (none) Type: bug | Status: closed Priority: high | Milestone: 8.2.2 Component: Compiler | Version: 8.2.1 Resolution: duplicate | Keywords: hs-boot Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: #13803, #13981, | Differential Rev(s): #14382 | Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: infoneeded => closed * resolution: => duplicate * related: #13803, #13981 => #13803, #13981, #14382 Comment: A dangerous category indeed. This was also reported as #14382. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 30 21:39:02 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 30 Oct 2017 21:39:02 -0000 Subject: [GHC] #14382: The 'impossible' happened whilst installing gi-gtk via cabal In-Reply-To: <052.f9c10851d0906622baeb7996269cc8e7@haskell.org> References: <052.f9c10851d0906622baeb7996269cc8e7@haskell.org> Message-ID: <067.390904803969594093f98929776bd1c6@haskell.org> #14382: The 'impossible' happened whilst installing gi-gtk via cabal -------------------------------------+------------------------------------- Reporter: maartenjacobs | Owner: (none) Type: bug | Status: new Priority: high | Milestone: 8.2.3 Component: Compiler | Version: 8.2.1 Resolution: | Keywords: gtk, pango, | hs-boot 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 bgamari): * priority: normal => high * milestone: => 8.2.3 Comment: It turns out that this was also reported as #14080. Unfortunately we won't be able to fix this for 8.2.2. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 30 21:55:59 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 30 Oct 2017 21:55:59 -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.cea86a0cfcca6e74e9bfd06f9a286453@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 bgamari): So I augmented the `-ddump-simpl-stats` output to show the types of the named binders. Here I'll be looking at the N=9 case, since this demonstrates the problem clearly. In the case of the the `PreInlineUnconditionally` ticks, the high-count binders are all of one of the following forms {{{ 505 w_i4Ig :: ('TypeFun.Data.Peano.S i_i4Ia :: TypeFun.Data.Peano.N) Data.Type.Equality.~ (TypeFun.Data.List.IndexOf e1_i4Ib (ex_i4Ic : els1_i4Id) :: TypeFun.Data.Peano.N) 503 w2_i4HF :: Data.HSet.HModify els1_i4HA els2_i4HC e1_i4Hy e2_i4HB i_i4Hx 503 w3_i4HG :: TypeFun.Data.List.NotElem ex_i4Hz els2_i4HC }}} There are ten binders in this list, each with either 505 or 503 ticks credited. The beta-reduced binders are all type variables of one of the following forms {{{ 505 i_i4Ia :: TypeFun.Data.Peano.N 505 e1_i4Ib :: * 505 els1_i4Id :: [*] 505 w_i4Ig :: ('TypeFun.Data.Peano.S i_i4Ia :: TypeFun.Data.Peano.N) Data.Type.Equality.~ (TypeFun.Data.List.IndexOf e1_i4Ib (ex_i4Ic : els1_i4Id) :: TypeFun.Data.Peano.N)}}} 505 w2_i4Ii :: Data.HSet.HModify els1_i4Id els2_i4If e1_i4Ib e2_i4Ie i_i4Ia }}} there are a few dozen of these, each with either 505 or 503 credited ticks. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 30 22:07:56 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 30 Oct 2017 22:07: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.c949436333db0e5e1592cd526c60dfcd@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 bgamari): To reproduce this with `HEAD` you will first need to install cabal-install from HEAD (this will only be a few minutes): {{{ $ git clone git://github.com/haskell/Cabal $ cd Cabal $ cabal install Cabal/ cabal-install/ }}} Now you can reproduce with, {{{ $ git clone git at github.com:bgamari/webapp-template-hs.git $ cd webapp-template-hs $ export ghc=$PATH_TO_GHC $ cabal new-build -w $ghc --only-dependencies $ n=9 ./build.sh -O1 -fsimpl-tick-factor=1000 -v -dverbose-core2core \ -ddump-to-file -dsuppress-ticks -ddump-simpl-stats \ -dsuppress-idinfo -dsuppress-coercions }}} There is also a `./build-all.sh` script which builds all `n`s from 1 to 9, dumping the output of each compiler run to a directory of the form `./dump-$n/`. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 30 22:39:58 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 30 Oct 2017 22:39:58 -0000 Subject: [GHC] #14382: The 'impossible' happened whilst installing gi-gtk via cabal In-Reply-To: <052.f9c10851d0906622baeb7996269cc8e7@haskell.org> References: <052.f9c10851d0906622baeb7996269cc8e7@haskell.org> Message-ID: <067.a75cf48d1137d6d3b4bae8eda0e03bb3@haskell.org> #14382: The 'impossible' happened whilst installing gi-gtk via cabal -------------------------------------+------------------------------------- Reporter: maartenjacobs | Owner: (none) Type: bug | Status: new Priority: high | Milestone: 8.2.3 Component: Compiler | Version: 8.2.1 Resolution: | Keywords: gtk, pango, | hs-boot 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 inaki): * cc: inaki (added) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Oct 30 23:52:35 2017 From: ghc-devs at haskell.org (GHC) Date: Mon, 30 Oct 2017 23:52:35 -0000 Subject: [GHC] #14382: The 'impossible' happened whilst installing gi-gtk via cabal In-Reply-To: <052.f9c10851d0906622baeb7996269cc8e7@haskell.org> References: <052.f9c10851d0906622baeb7996269cc8e7@haskell.org> Message-ID: <067.9ccd2d1bf8e33b848a0d744921d4016e@haskell.org> #14382: The 'impossible' happened whilst installing gi-gtk via cabal -------------------------------------+------------------------------------- Reporter: maartenjacobs | Owner: (none) Type: bug | Status: new Priority: high | Milestone: 8.2.3 Component: Compiler | Version: 8.2.1 Resolution: | Keywords: gtk, pango, | hs-boot Operating System: Linux | Architecture: x86_64 | (amd64) Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by ezyang): Can you please try https://phabricator.haskell.org/D4138 with this bug? It may address the problem here. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 31 00:02:02 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 31 Oct 2017 00:02:02 -0000 Subject: [GHC] #14406: Core Lint error when compiling ghc with -g3 Message-ID: <043.dd1eb786882d8011bcf529716f4960db@haskell.org> #14406: Core Lint error when compiling ghc with -g3 -------------------------------------+------------------------------------- Reporter: duog | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.3 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: -------------------------------------+------------------------------------- Building ghc with the following build.mk: {{{ BuildFlavour = validate ifneq "$(BuildFlavour)" "" include mk/flavours/$(BuildFlavour).mk endif GhcLibHcOpts += -g3 GhcRtsHcOpts += -g3 GhcStage2Opts += -g3 }}} gives {{{ *** Core Lint errors : in result of Simplifier *** : warning: [RHS of str_sjjS :: Addr#] The type of this binder is unlifted: str_sjjS Binder's type: Addr# *** Offending Program *** ... str_sjjS :: Addr# [LclId, Unf=Unf{Src=, TopLvl=False, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] str_sjjS = src ":%"# ... libraries/base/ghc.mk:4: recipe for target 'libraries/base/dist- install/build/Data/Data.o' failed }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 31 00:56:57 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 31 Oct 2017 00:56:57 -0000 Subject: [GHC] #10843: Allow do blocks without dollar signs as arguments In-Reply-To: <049.979a39a09d7a881598f53a6a6ce9bbe3@haskell.org> References: <049.979a39a09d7a881598f53a6a6ce9bbe3@haskell.org> Message-ID: <064.0e8344b048a41995128d9546a08e9998@haskell.org> #10843: Allow do blocks without dollar signs as arguments -------------------------------------+------------------------------------- Reporter: agibiansky | Owner: agibiansky Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.10.2 (Parser) | Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #11706 | Differential Rev(s): Phab:D1219 Wiki Page: | -------------------------------------+------------------------------------- Comment (by mentheta): Akio, did you get around to submitting a proposal? I'd be interested in being able to use this extension. Also, could I be of help somehow? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 31 01:03:34 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 31 Oct 2017 01:03:34 -0000 Subject: [GHC] #14406: Core Lint error when compiling ghc with -g3 In-Reply-To: <043.dd1eb786882d8011bcf529716f4960db@haskell.org> References: <043.dd1eb786882d8011bcf529716f4960db@haskell.org> Message-ID: <058.0e6b855e27df91665d03d047ae08bc05@haskell.org> #14406: Core Lint error when compiling ghc with -g3 -------------------------------------+------------------------------------- Reporter: duog | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.3 Resolution: duplicate | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Building GHC | Unknown/Multiple failed | Test Case: Blocked By: | Blocking: Related Tickets: #14123 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: new => closed * resolution: => duplicate * related: => #14123 * milestone: => 8.4.1 Comment: Yes, this is #14123. It is on my list but it's a task that takes a bit of focus to see to completion. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 31 01:29:12 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 31 Oct 2017 01:29:12 -0000 Subject: [GHC] #14407: rts: Threads/caps affinity Message-ID: <044.bf4507a98f68743970936df39c9089d2@haskell.org> #14407: rts: Threads/caps affinity -------------------------------------+------------------------------------- Reporter: pacak | Owner: (none) Type: feature | Status: new request | Priority: normal | Milestone: Component: Runtime | Version: 8.3 System | Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: Runtime Unknown/Multiple | performance bug Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- Currently GHC supports two kinds of threads with respect to thread migration - pinned to a specific capability and those it can migrate between any capabilities. For purposes of achieving lower latency in Haskell applications it would be nice to have something in between - threads GHC rts can migrate but within a certain subset of capabilities only. I'm developing a program that contains several kinds of threads - those that do little work and sensitive to latency and those that can spend more CPU time and less latency sensitive. I looked into several cases of increased latency in those sensitive threads (using GHC eventlog) and in all cases sensitive threads were waiting for non-sensitive threads to finish working. I was able to reduce worst case latency by factor of 10 by pinning all the threads in the program to specific capability but manually distributing threads (60+ of them) between capabilities (several different machines with different numbers of cores available) seems very fragile. World stopping GC is still a problem but at least in my case is much less frequently so. I have a patch for rts that implements this proposal {{{#!hs {- | 'setThreadAffinity' limits RTS ability to migrate thread to capabilities with numbers that matches set bits of affinity mask, thus mask of `0b101` (5) will allow RTS to migrate this thread to caps 0 (64, 128, ..) and 3 (64 + 3 = 67, 128 + 3 = 131, ...). Setting all bits to 0 or 1 will disable the restriction. -} setThreadAffinity :: ThreadId -> Int -> IO () }}} This allows to define up to 64 distinct groups and allow user to break down their threads into bigger number of potentially intersecting groups by specifying things like capability 0 does latency sensitive things, caps 1..5 - less sensitive things, caps 5-7 bulk things. Sample program using this API {{{#!hs {-# LANGUAGE LambdaCase #-} import Data.Time import Control.Monad import Control.Concurrent import System.Environment (getArgs) import GHC.Conc wastetime :: Bool -> IO () wastetime affine = do tid <- forkIO $ do myThreadId >>= \tid -> labelThread tid "timewaster" forever $ do when (sum [1..1000000] < (0 :: Integer)) $ print "impossible" threadDelay 100 yield when affine $ setThreadAffinity tid (255 - 2) client :: Bool -> IO () client affine = do myThreadId >>= \tid -> labelThread tid "client" when affine $ myThreadId >>= \tid -> setThreadAffinity tid 2 before <- getCurrentTime replicateM_ 10 $ do threadDelay 10000 after <- getCurrentTime print $ after `diffUTCTime` before startClient :: Bool -> IO () startClient = {- replicateM_ 10 . -} client main :: IO () main = do getArgs >>= \case [wno's, aff's] -> do let wno = read wno's aff = read aff's putStrLn $ unwords ["Affinity:", show aff, "Timewasters:", show wno] replicateM_ wno (wastetime aff) startClient aff _ -> putStrLn "Usage: " }}} Compiled with -threaded and running with rts -N8 on 6 core (12 threads) machine. Results are noisy but repeatable {{{ Affinity: False Timewasters: 24 0.42482036s }}} {{{ Affinity: True Timewasters: 24 0.111743474s }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 31 01:45:15 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 31 Oct 2017 01:45:15 -0000 Subject: [GHC] #14407: rts: Threads/caps affinity In-Reply-To: <044.bf4507a98f68743970936df39c9089d2@haskell.org> References: <044.bf4507a98f68743970936df39c9089d2@haskell.org> Message-ID: <059.8dccc44f6b8497de14f83168675836f1@haskell.org> #14407: rts: Threads/caps affinity -------------------------------------+------------------------------------- Reporter: pacak | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Runtime System | 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: | Differential Rev(s): D4143 Wiki Page: | -------------------------------------+------------------------------------- Changes (by pacak): * differential: => D4143 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 31 01:46:20 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 31 Oct 2017 01:46:20 -0000 Subject: [GHC] #14407: rts: Threads/caps affinity In-Reply-To: <044.bf4507a98f68743970936df39c9089d2@haskell.org> References: <044.bf4507a98f68743970936df39c9089d2@haskell.org> Message-ID: <059.48e9c197362275ba360f2e801153ba33@haskell.org> #14407: rts: Threads/caps affinity -------------------------------------+------------------------------------- Reporter: pacak | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Runtime System | 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: | Differential Rev(s): Phab:D4143 Wiki Page: | -------------------------------------+------------------------------------- Changes (by pacak): * differential: D4143 => Phab:D4143 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 31 09:00:27 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 31 Oct 2017 09:00:27 -0000 Subject: [GHC] #14406: Core Lint error when compiling ghc with -g3 In-Reply-To: <043.dd1eb786882d8011bcf529716f4960db@haskell.org> References: <043.dd1eb786882d8011bcf529716f4960db@haskell.org> Message-ID: <058.dc19daf455218bee716e1d8727f93b22@haskell.org> #14406: Core Lint error when compiling ghc with -g3 -------------------------------------+------------------------------------- Reporter: duog | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.3 Resolution: duplicate | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Building GHC | Unknown/Multiple failed | Test Case: Blocked By: | Blocking: Related Tickets: #14123 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Why are you sure it is #14123? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 31 10:14:54 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 31 Oct 2017 10:14:54 -0000 Subject: [GHC] #11080: Open data kinds In-Reply-To: <047.64e06093644ddd3cb76b94e28bef420a@haskell.org> References: <047.64e06093644ddd3cb76b94e28bef420a@haskell.org> Message-ID: <062.bb60a54f0a6f0c1f7999b229e94e5515@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 | -------------------------------------+------------------------------------- Changes (by alpmestan): * cc: alpmestan (added) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 31 11:10:38 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 31 Oct 2017 11:10:38 -0000 Subject: [GHC] #10843: Allow do blocks without dollar signs as arguments In-Reply-To: <049.979a39a09d7a881598f53a6a6ce9bbe3@haskell.org> References: <049.979a39a09d7a881598f53a6a6ce9bbe3@haskell.org> Message-ID: <064.549d8334770d2b94dc6ce9ee04049aa9@haskell.org> #10843: Allow do blocks without dollar signs as arguments -------------------------------------+------------------------------------- Reporter: agibiansky | Owner: agibiansky Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.10.2 (Parser) | Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #11706 | Differential Rev(s): Phab:D1219 Wiki Page: | -------------------------------------+------------------------------------- Comment (by akio): Oh yes, oops. I have forgot about this. I have a half-written proposal. I'll finish it and submit it before the next week. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 31 11:28:04 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 31 Oct 2017 11:28:04 -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.7edff737735f5c0db1503997ce0bfccd@haskell.org> #14396: Hs-boot woes during family instance consistency checks -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: | 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): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Gah! This is ridiculously complicated. Surely there must be a better way. In thinking about this I realised: * A very similar danger happens for ordinary data type decls: {{{ M.hs-boot data S M1.hs import {-# SOURCE #-} M data D (a::S) = ... M.hs import M1 data T a = MkT (D a) data S = A | B }}} The danger is that we'll kind-check the decl for T, suck in the interface decl for T1, and then find that S is not yet in the type envt. But we fixed that (conservatively) in `RnSource.addBootDeps`; `Note [Extra dependencies from .hs-boot files]` in `RnSource` * Even within one module we have an open ticket about when to typecheck 'type instance' decls: #12088. It has a very similar flavour to the Edward's solution here. * Edward's solution defers the type family consistency check, but the interface-file instance is there in the family-instance environment all the time. e.g. {{{ M.hs-boot data SyntaxExpr M1.hs import {-# SOURCE #-} M instance F Int = SyntaxExpr M.hs import M1 data T = ...(F Int)... data SyntaxExpr = SE }}} I'm worried that an "earlier" decl, for T, might make use of that instance, which would again prematurely look for SyntaxExpr in the M's type environment, before it has been looked at. Oh -- but maybe it's (just) ok: the fix in addBootDeps will ensure that SyntaxExpr is typechecked before T. But it's terribly delicate. I did have one simplifying idea. Thought experiment: * When typechecking M, begin by loading M.hi-boot (which we already do) /and/ extend the type environment. So we'll add `SyntaxExpr` and `W`, in the above examples, to the type envt. * Do none of this addBootDeps stuff, nor deferring family instances. If we need `W` or `SyntaxExpr` before they've been encountered, we'll use the boot-versions. * So when compiling M we'll have places where we only have the boot TyCon instead of the real TyCon. Maybe that does not matter? * When we are all done, we'll spit out a M.hi file. * In --make mode we'll now re-typecheck the loop from the .hi files, building all the knots just as expected. This is much much simpler. Would it work? Worth a a try? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 31 12:13:22 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 31 Oct 2017 12:13:22 -0000 Subject: [GHC] #14390: Panic when defining an instance for (~~) [ppr_equality: homogeneity] In-Reply-To: <050.b158dc2933d34aa54c38d85462566822@haskell.org> References: <050.b158dc2933d34aa54c38d85462566822@haskell.org> Message-ID: <065.3411a8e0897fd54af783a025ff66985e@haskell.org> #14390: Panic when defining an instance for (~~) [ppr_equality: homogeneity] -------------------------------------+------------------------------------- Reporter: RyanGlScott | 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: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: T14390 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4132 Wiki Page: | -------------------------------------+------------------------------------- Comment (by Simon Peyton Jones ): In [changeset:"29ae83374647e227d76acd896b89590fc15590d6/ghc" 29ae833/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="29ae83374647e227d76acd896b89590fc15590d6" Tidy up IfaceEqualityTyCon This commit commit 85aa1f4253163985fe07d172f8da73b784bb7b4b Date: Sun Oct 29 20:48:19 2017 -0400 Fix #14390 by making toIfaceTyCon aware of equality was a bit over-complicated. This patch simplifies the (horribly ad-hoc) treatement of IfaceEqualityTyCon, and documents it better. No visible change in behaviour. }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 31 12:40:54 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 31 Oct 2017 12:40:54 -0000 Subject: [GHC] #12143: ApplicativeDo Fails to Desugar 'return True' In-Reply-To: <051.25105ae3fe7e38a6681426345f9fe806@haskell.org> References: <051.25105ae3fe7e38a6681426345f9fe806@haskell.org> Message-ID: <066.331f48e670fc39f3afc6c0e86470bbdc@haskell.org> #12143: ApplicativeDo Fails to Desugar 'return True' -------------------------------------+------------------------------------- Reporter: MichaelBurge | Owner: simonmar Type: bug | Status: closed Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.0.1 Resolution: fixed | Keywords: ApplicativeDo Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4128 Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonmar): * status: new => closed * resolution: => fixed * blockedby: 10892 => Comment: Probably shouldn't merge this into the stable branch because it changes inferred types. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 31 14:56:53 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 31 Oct 2017 14:56:53 -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.7ff16f00111ce5e7797acfb544bdb3c7@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, | 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): It turns out that my earlier comment: Replying to [comment:2 RyanGlScott]: > But to my knowledge, there's no reasoning principle which states that `f a ~R g a` implies `f ~R g`. Is a bit misleading. I've re-read the [http://www.seas.upenn.edu/~sweirich/papers/coercible-JFP.pdf Safe Zero- cost Coercions for Haskell] paper recently, and it turns out that Section 2.8 (Supporting higher-order polymorphism) pertains to this very topic: > So far, we have only seen `Coercible` applied to types of kind `*`, but that is not sufficient to support all coercions that we might want. For example, consider a monad transformer such as > > {{{#!hs > data MaybeT m a = MaybeT (m (Maybe a)) > }}} > > and a newtype that wraps another monad, e.g. > > {{{#!hs > newtype MyIO a = MyIO (IO a) > }}} > > It is reasonable to expect that `Coercible (MaybeT MyIO a) (MaybeT IO a)` can be derived. Using the lifting rule for `MaybeT`, this requires `Coercible MyIO IO` to hold. Therefore, for a `newtype` declaration as the one above, GHC will //η//-reduce the unwrapping rule to say `Coercible IO MyIO` instead of `Coercible (IO a) (MyIO a)`. Using symmetry, this allows us to solve `Coercible (MaybeT MyIO a) (MaybeT IO a)`. Alas, that is the //only// discussion of eta-reducing unwrapping rules that I can find in the entire paper, as it doesn't appear to be brought up again at any point. But this would definitely explain why you can construct a `Coercion (EITHER USD) (Either Int)` with relative ease. Now it is clear to me why you still can't derive `Coercible Identity (Compose Identity Identity)` from `Coercible (Identity a) (Compose Identity Identity a)`. The reason is because you'd have to be able to //η//-reduce this unwrapping rule: {{{#!hs Coercible (Compose f g a) (f (g a)) }}} But there is no way to //η//-reduce the `a` from `f (g a)`, so GHC evidently does not attempt this. So I'm inclined to label this as not-a-bug. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 31 14:59:20 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 31 Oct 2017 14:59:20 -0000 Subject: [GHC] #14386: GHC doesn't allow Coercion between partly-saturated type constructors In-Reply-To: <051.c69fb09d236cbd3265f3896d9e479b59@haskell.org> References: <051.c69fb09d236cbd3265f3896d9e479b59@haskell.org> Message-ID: <066.85ca8badaf5f6647b721e526dc18c11e@haskell.org> #14386: GHC doesn't allow Coercion between partly-saturated type constructors -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.3 Resolution: | Keywords: roles Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #14317 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * related: => #14317 Comment: I think ultimately this ties back to GHC's inability to eta-reduce the unwrapping rule: {{{#!hs Coercible (Op cat a b) (cat b a) }}} In other words, it's the same symptom as in https://ghc.haskell.org/trac/ghc/ticket/14317#comment:6. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 31 14:59:47 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 31 Oct 2017 14:59:47 -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.3b56f142f9f9d5a5db9d5855038c04c3@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, | QuantifiedContexts 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 RyanGlScott): * related: => #14386 Comment: See also #14386, which shows another example of an unwrapping rule that fails to eta-reduce. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 31 15:19:10 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 31 Oct 2017 15:19:10 -0000 Subject: [GHC] #14406: Core Lint error when compiling ghc with -g3 In-Reply-To: <043.dd1eb786882d8011bcf529716f4960db@haskell.org> References: <043.dd1eb786882d8011bcf529716f4960db@haskell.org> Message-ID: <058.1cecad772499b537b3f924cd37a15d52@haskell.org> #14406: Core Lint error when compiling ghc with -g3 -------------------------------------+------------------------------------- Reporter: duog | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.3 Resolution: duplicate | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Building GHC | Unknown/Multiple failed | Test Case: Blocked By: | Blocking: Related Tickets: #14123 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): Because this is one of the many cases where a tick appears where we nominally say it shouldn't (in this case in a top-level primitive string binding). This is specifically a duplicate of #14122, which is one of piece of the mess that is #14123. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 31 15:19:52 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 31 Oct 2017 15:19:52 -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.7f96feb626440b0681f2f35af6f2548f@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, #142122, | Differential Rev(s): #8472, #14406 | Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * related: => #13233, #142122, #8472, #14406 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 31 17:49:35 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 31 Oct 2017 17:49:35 -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.d32a74c4b9bfcdc3f22e8934ea993bde@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, | QuantifiedContexts 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: | -------------------------------------+------------------------------------- Comment (by goldfire): Yet another thing that representational equality can't do, but perhaps could if it were better. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 31 19:14:25 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 31 Oct 2017 19:14:25 -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.b88c62302c3cd2a6704bba51d515c092@haskell.org> #14396: Hs-boot woes during family instance consistency checks -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: | 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): Wiki Page: | -------------------------------------+------------------------------------- Changes (by inaki): * cc: inaki (added) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 31 19:42:45 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 31 Oct 2017 19:42:45 -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.30c6b3ce11bb5c442076c38f6bd20811@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: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by augustss): Any chance we can get a fix for this? It really, really hurts. At a minimum, give us a flag to ignore plugin dependencies. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 31 19:45:20 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 31 Oct 2017 19:45:20 -0000 Subject: [GHC] #13604: ghci no longer loads dynamic .o files by default if they were built with -O In-Reply-To: <045.626a6b40d9101c93e2935653ef7e4668@haskell.org> References: <045.626a6b40d9101c93e2935653ef7e4668@haskell.org> Message-ID: <060.eb6cc311ae653d1db7c8f1b6623b7fe7@haskell.org> #13604: ghci no longer loads dynamic .o files by default if they were built with -O -------------------------------------+------------------------------------- Reporter: George | Owner: dfeuer Type: bug | Status: patch Priority: highest | Milestone: 8.2.3 Component: Compiler | Version: 8.2.1-rc1 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): Phab:D4123 Wiki Page: | -------------------------------------+------------------------------------- Comment (by elaforge): bgamari: No problem, I understand about release schedules. I'm sorry to drag it out a bit, but on the other hand it's good to be careful about flag design since it's one of those APIs that is hard to fix later. I'll copy paste this in the mailing list thread, just so there's a record in both places. I still don't feel like 1 is necessary, I'd rather flags cause other flags to be ignored with a warning, rather than turn on other flags. But that's just a vague preference, with no strong evidence for it. Maybe it could emit a warning if you didn't put -fobject-code in explicitly, e.g. "-O implies -fobject-code, adding that flag." So as long as we accept 1, then 2 and 3 follow naturally. Given that, I support this UI. Thanks for looking into it! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 31 21:15:25 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 31 Oct 2017 21:15:25 -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.a6675b330051274be9f2ff977877db05@haskell.org> #5889: -fno-prof-count-entries leads to linking errors -------------------------------------+------------------------------------- Reporter: akio | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.4.1 Component: Compiler | Version: 8.3 Resolution: | Keywords: Operating System: Linux | Architecture: x86_64 Type of failure: GHC rejects | (amd64) valid program | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * priority: normal => highest * milestone: => 8.4.1 Comment: I'll try to reproduce this. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Oct 31 21:59:02 2017 From: ghc-devs at haskell.org (GHC) Date: Tue, 31 Oct 2017 21:59:02 -0000 Subject: [GHC] #14408: error in refineFromInScope Message-ID: <043.032c0bafda9f7e231689ab772d2b28a6@haskell.org> #14408: error in refineFromInScope -------------------------------------+------------------------------------- Reporter: duog | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.3 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 several instances of the following line in the output in a validate build: {{{ WARNING: file compiler/simplCore/SimplEnv.hs, line 678 $j_setr }}} For example: https://phabricator.haskell.org/harbormaster/build/36855/?l=0, the harbourmaster build of 609f2844b92d5aa474f34b989c6ec5ad9fdb2ce3. That line indicates that said warning "is an error!" -- Ticket URL: GHC The Glasgow Haskell Compiler