From git at git.haskell.org Sun Jan 1 21:34:32 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 1 Jan 2017 21:34:32 +0000 (UTC) Subject: [commit: ghc] branch 'wip/all-inlinable' created Message-ID: <20170101213432.596B53A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/all-inlinable Referencing: 912a5cca80867b2bc7f2b8ca26d1ee430b08946a From git at git.haskell.org Sun Jan 1 21:34:35 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 1 Jan 2017 21:34:35 +0000 (UTC) Subject: [commit: ghc] wip/all-inlinable: Inline work start (5669ab3) Message-ID: <20170101213435.1B2FC3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/all-inlinable Link : http://ghc.haskell.org/trac/ghc/changeset/5669ab3d4bcbf777cd11dfd469d1d3ee432aa36a/ghc >--------------------------------------------------------------- commit 5669ab3d4bcbf777cd11dfd469d1d3ee432aa36a Author: Matthew Pickering Date: Sat Aug 6 22:17:09 2016 +0100 Inline work start >--------------------------------------------------------------- 5669ab3d4bcbf777cd11dfd469d1d3ee432aa36a compiler/deSugar/DsBinds.hs | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/compiler/deSugar/DsBinds.hs b/compiler/deSugar/DsBinds.hs index d8deff5..ab1cc75 100644 --- a/compiler/deSugar/DsBinds.hs +++ b/compiler/deSugar/DsBinds.hs @@ -327,7 +327,11 @@ makeCorePair :: DynFlags -> Id -> Bool -> Arity -> CoreExpr -> (Id, CoreExpr) makeCorePair dflags gbl_id is_default_method dict_arity rhs | is_default_method -- Default methods are *always* inlined = (gbl_id `setIdUnfolding` mkCompulsoryUnfolding rhs, rhs) - + | pprTrace "isOverloadedTy" (ppr $ idType gbl_id) + (isEmptyInlineSpec inline_spec) && + (isOverloadedTy (idType gbl_id)) + = pprTrace "overloaded" (ppr "") (gbl_id `setIdUnfolding` inlinable_unf, rhs) + -- Expose unfolding of overloaded function if we know no better | otherwise = case inlinePragmaSpec inline_prag of EmptyInlineSpec -> (gbl_id, rhs) @@ -337,6 +341,7 @@ makeCorePair dflags gbl_id is_default_method dict_arity rhs where inline_prag = idInlinePragma gbl_id + inline_spec = inlinePragmaSpec inline_prag inlinable_unf = mkInlinableUnfolding dflags rhs inline_pair | Just arity <- inlinePragmaSat inline_prag From git at git.haskell.org Sun Jan 1 21:34:37 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 1 Jan 2017 21:34:37 +0000 (UTC) Subject: [commit: ghc] wip/all-inlinable: Remove traces (912a5cc) Message-ID: <20170101213437.CB00A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/all-inlinable Link : http://ghc.haskell.org/trac/ghc/changeset/912a5cca80867b2bc7f2b8ca26d1ee430b08946a/ghc >--------------------------------------------------------------- commit 912a5cca80867b2bc7f2b8ca26d1ee430b08946a Author: Matthew Pickering Date: Sun Jan 1 21:34:05 2017 +0000 Remove traces >--------------------------------------------------------------- 912a5cca80867b2bc7f2b8ca26d1ee430b08946a compiler/deSugar/DsBinds.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/compiler/deSugar/DsBinds.hs b/compiler/deSugar/DsBinds.hs index ab1cc75..7ba0416 100644 --- a/compiler/deSugar/DsBinds.hs +++ b/compiler/deSugar/DsBinds.hs @@ -327,10 +327,10 @@ makeCorePair :: DynFlags -> Id -> Bool -> Arity -> CoreExpr -> (Id, CoreExpr) makeCorePair dflags gbl_id is_default_method dict_arity rhs | is_default_method -- Default methods are *always* inlined = (gbl_id `setIdUnfolding` mkCompulsoryUnfolding rhs, rhs) - | pprTrace "isOverloadedTy" (ppr $ idType gbl_id) + | (isEmptyInlineSpec inline_spec) && (isOverloadedTy (idType gbl_id)) - = pprTrace "overloaded" (ppr "") (gbl_id `setIdUnfolding` inlinable_unf, rhs) + = (gbl_id `setIdUnfolding` inlinable_unf, rhs) -- Expose unfolding of overloaded function if we know no better | otherwise = case inlinePragmaSpec inline_prag of From git at git.haskell.org Sun Jan 1 23:37:16 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 1 Jan 2017 23:37:16 +0000 (UTC) Subject: [commit: ghc] wip/all-inlinable: Check it is actually an Id (a93d4e6) Message-ID: <20170101233716.677B43A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/all-inlinable Link : http://ghc.haskell.org/trac/ghc/changeset/a93d4e6c0eafa63ed49088e146b8becd8deaac32/ghc >--------------------------------------------------------------- commit a93d4e6c0eafa63ed49088e146b8becd8deaac32 Author: Matthew Pickering Date: Sun Jan 1 23:37:00 2017 +0000 Check it is actually an Id >--------------------------------------------------------------- a93d4e6c0eafa63ed49088e146b8becd8deaac32 compiler/deSugar/DsBinds.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/deSugar/DsBinds.hs b/compiler/deSugar/DsBinds.hs index 7ba0416..ad514c3 100644 --- a/compiler/deSugar/DsBinds.hs +++ b/compiler/deSugar/DsBinds.hs @@ -327,7 +327,7 @@ makeCorePair :: DynFlags -> Id -> Bool -> Arity -> CoreExpr -> (Id, CoreExpr) makeCorePair dflags gbl_id is_default_method dict_arity rhs | is_default_method -- Default methods are *always* inlined = (gbl_id `setIdUnfolding` mkCompulsoryUnfolding rhs, rhs) - | + | (isId gbl_id) && (isEmptyInlineSpec inline_spec) && (isOverloadedTy (idType gbl_id)) = (gbl_id `setIdUnfolding` inlinable_unf, rhs) From git at git.haskell.org Mon Jan 2 04:25:49 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 2 Jan 2017 04:25:49 +0000 (UTC) Subject: [commit: ghc] master: Fix incorrect statement about plugin packages. (bab4ae8) Message-ID: <20170102042549.E2A2D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/bab4ae80cc5b14926896ea3d5f5ac4db5bb80035/ghc >--------------------------------------------------------------- commit bab4ae80cc5b14926896ea3d5f5ac4db5bb80035 Author: Edward Z. Yang Date: Sun Jan 1 09:41:45 2017 -0800 Fix incorrect statement about plugin packages. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- bab4ae80cc5b14926896ea3d5f5ac4db5bb80035 docs/users_guide/extending_ghc.rst | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/docs/users_guide/extending_ghc.rst b/docs/users_guide/extending_ghc.rst index c02c93f..10c1b3d 100644 --- a/docs/users_guide/extending_ghc.rst +++ b/docs/users_guide/extending_ghc.rst @@ -259,10 +259,10 @@ control specifically plugin packages: need to be explicitly exposed using :ghc-flag:`-plugin-package` options. -To declare a dependency on a plugin, add it to the ``ghc-plugins`` field -in Cabal. You should only put a plugin in ``build-depends`` if you -require compatibility with older versions of Cabal, or also have a source -import on the plugin in question. +At the moment, the only way to specify a dependency on a plugin +in Cabal is to put it in ``build-depends`` (which uses the conventional +:ghc-flag:`-package-id` flag); however, in the future there +will be a separate field for specifying plugin dependencies specifically. .. _writing-compiler-plugins: From git at git.haskell.org Mon Jan 2 04:27:01 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 2 Jan 2017 04:27:01 +0000 (UTC) Subject: [commit: ghc] master: Remove documentation about non-existent flag. (9ff0738) Message-ID: <20170102042701.69E633A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9ff07382ed377d38d677e8785b34536c39894467/ghc >--------------------------------------------------------------- commit 9ff07382ed377d38d677e8785b34536c39894467 Author: Edward Z. Yang Date: Sun Jan 1 20:26:01 2017 -0800 Remove documentation about non-existent flag. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- 9ff07382ed377d38d677e8785b34536c39894467 docs/users_guide/packages.rst | 9 --------- 1 file changed, 9 deletions(-) diff --git a/docs/users_guide/packages.rst b/docs/users_guide/packages.rst index d3da125..71059f1 100644 --- a/docs/users_guide/packages.rst +++ b/docs/users_guide/packages.rst @@ -235,15 +235,6 @@ The GHC command line options that control packages are: reserves the right to interpret other characters in a special way in later releases. -.. ghc-flag:: -library-name ⟨hash⟩ - - Tells GHC that the source of a Backpack file and its textual - dependencies is uniquely identified by ⟨hash⟩. Library names are - determined by Cabal; a usual recipe for a library name is that it is - the hash source package identifier of a package, as well as the - version hashes of all its textual dependencies. GHC will then use - this library name to generate more unit IDs. - .. ghc-flag:: -trust ⟨pkg⟩ This option causes the install package ⟨pkg⟩ to be both exposed and From git at git.haskell.org Mon Jan 2 15:09:42 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 2 Jan 2017 15:09:42 +0000 (UTC) Subject: [commit: ghc] branch 'wip/inlinable-bug' created Message-ID: <20170102150942.D20193A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/inlinable-bug Referencing: 96d0e5bb321850d5af3cf2aaf8e63e29a699ca29 From git at git.haskell.org Mon Jan 2 15:09:45 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 2 Jan 2017 15:09:45 +0000 (UTC) Subject: [commit: ghc] wip/inlinable-bug: Add INLINABLE pragma to (<**>) (96d0e5b) Message-ID: <20170102150945.89F913A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/inlinable-bug Link : http://ghc.haskell.org/trac/ghc/changeset/96d0e5bb321850d5af3cf2aaf8e63e29a699ca29/ghc >--------------------------------------------------------------- commit 96d0e5bb321850d5af3cf2aaf8e63e29a699ca29 Author: Matthew Pickering Date: Mon Jan 2 15:04:07 2017 +0000 Add INLINABLE pragma to (<**>) Reviewers: austin, hvr, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2912 >--------------------------------------------------------------- 96d0e5bb321850d5af3cf2aaf8e63e29a699ca29 libraries/base/GHC/Base.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/libraries/base/GHC/Base.hs b/libraries/base/GHC/Base.hs index 34a038d..f104656 100644 --- a/libraries/base/GHC/Base.hs +++ b/libraries/base/GHC/Base.hs @@ -425,6 +425,8 @@ class Functor f => Applicative f where (<**>) :: Applicative f => f a -> f (a -> b) -> f b (<**>) = liftA2 (flip ($)) +{-# INLINABLE (<**>) #-} + -- | Lift a function to actions. -- This function may be used as a value for `fmap` in a `Functor` instance. liftA :: Applicative f => (a -> b) -> f a -> f b From git at git.haskell.org Mon Jan 2 21:59:39 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 2 Jan 2017 21:59:39 +0000 (UTC) Subject: [commit: ghc] master: Disallow users to write instances of KnownNat and KnownSym (c560957) Message-ID: <20170102215939.1177E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c5609577fab8a214c50561bea861c70d4bfd47c7/ghc >--------------------------------------------------------------- commit c5609577fab8a214c50561bea861c70d4bfd47c7 Author: sjorn3 Date: Mon Jan 2 21:57:04 2017 +0000 Disallow users to write instances of KnownNat and KnownSym As noted in #12837, these classes are special and the user should not be able to define their own instances. Test Plan: Validate Reviewers: adamgundry, goldfire, mpickering, austin, bgamari Reviewed By: goldfire, mpickering Subscribers: goldfire, mpickering, thomie Differential Revision: https://phabricator.haskell.org/D2898 GHC Trac Issues: #12837 >--------------------------------------------------------------- c5609577fab8a214c50561bea861c70d4bfd47c7 compiler/typecheck/TcInstDcls.hs | 17 +++++++++++------ testsuite/tests/typecheck/should_fail/T12837.hs | 12 ++++++++++++ testsuite/tests/typecheck/should_fail/T12837.stderr | 12 ++++++++++++ testsuite/tests/typecheck/should_fail/all.T | 1 + 4 files changed, 36 insertions(+), 6 deletions(-) diff --git a/compiler/typecheck/TcInstDcls.hs b/compiler/typecheck/TcInstDcls.hs index dbc818b..8d8d23d 100644 --- a/compiler/typecheck/TcInstDcls.hs +++ b/compiler/typecheck/TcInstDcls.hs @@ -46,7 +46,8 @@ import Class import Var import VarEnv import VarSet -import PrelNames ( typeableClassName, genericClassNames ) +import PrelNames ( typeableClassName, genericClassNames + , knownNatClassName, knownSymbolClassName ) import Bag import BasicTypes import DynFlags @@ -518,9 +519,10 @@ doClsInstErrorChecks inst_info -- In hs-boot files there should be no bindings ; failIfTc (is_boot && not no_binds) badBootDeclErr - -- Handwritten instances of the poly-kinded Typeable - -- class are always forbidden - ; failIfTc (clas_nm == typeableClassName) typeable_err + -- Handwritten instances of any rejected + -- class is always forbidden + -- #12837 + ; failIfTc (clas_nm `elem` rejectedClassNames) clas_err -- Check for hand-written Generic instances (disallowed in Safe Haskell) ; when (clas_nm `elem` genericClassNames) $ @@ -538,11 +540,14 @@ doClsInstErrorChecks inst_info text "Replace the following instance:") 2 (pprInstanceHdr ispec) - -- Report an error or a warning for a Typeable instances. + -- Report an error or a warning for certain class instances. -- If we are working on an .hs-boot file, we just report a warning, -- and ignore the instance. We do this, to give users a chance to fix -- their code. - typeable_err = text "Class" <+> quotes (ppr clas_nm) + rejectedClassNames = [ typeableClassName + , knownNatClassName + , knownSymbolClassName ] + clas_err = text "Class" <+> quotes (ppr clas_nm) <+> text "does not support user-specified instances" {- diff --git a/testsuite/tests/typecheck/should_fail/T12837.hs b/testsuite/tests/typecheck/should_fail/T12837.hs new file mode 100644 index 0000000..414d333 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T12837.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE FlexibleInstances #-} + +module T12837 where + +import GHC.TypeLits +import Data.Typeable + +data K = K + +instance Typeable K +instance KnownNat n +instance KnownSymbol n diff --git a/testsuite/tests/typecheck/should_fail/T12837.stderr b/testsuite/tests/typecheck/should_fail/T12837.stderr new file mode 100644 index 0000000..893575f --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T12837.stderr @@ -0,0 +1,12 @@ + +T12837.hs:10:1: error: + • Class ‘Typeable’ does not support user-specified instances + • In the instance declaration for ‘Typeable K’ + +T12837.hs:11:1: error: + • Class ‘KnownNat’ does not support user-specified instances + • In the instance declaration for ‘KnownNat n’ + +T12837.hs:12:1: error: + • Class ‘KnownSymbol’ does not support user-specified instances + • In the instance declaration for ‘KnownSymbol n’ diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T index 69add40..df3f5c8 100644 --- a/testsuite/tests/typecheck/should_fail/all.T +++ b/testsuite/tests/typecheck/should_fail/all.T @@ -433,3 +433,4 @@ test('T12729', normal, compile_fail, ['']) test('T12803', normal, compile_fail, ['']) test('T12042', extra_clean(['T12042a.hi', 'T12042a.o', 'T12042.hi-boot', 'T12042.o-boot']), multimod_compile_fail, ['T12042', '']) test('T12966', normal, compile_fail, ['']) +test('T12837', normal, compile_fail, ['']) From git at git.haskell.org Mon Jan 2 22:15:14 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 2 Jan 2017 22:15:14 +0000 (UTC) Subject: [commit: ghc] master: Update .mailmap (cc0abfa) Message-ID: <20170102221514.513EF3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/cc0abfa40b00b3b3ad4f4cf31b060026d677488a/ghc >--------------------------------------------------------------- commit cc0abfa40b00b3b3ad4f4cf31b060026d677488a Author: Matthew Pickering Date: Mon Jan 2 22:14:59 2017 +0000 Update .mailmap >--------------------------------------------------------------- cc0abfa40b00b3b3ad4f4cf31b060026d677488a .mailmap | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/.mailmap b/.mailmap index 4da118d..c542bab 100644 --- a/.mailmap +++ b/.mailmap @@ -71,6 +71,7 @@ Dana N. Xu nx Daniel Fischer Daniel Franke df at dfranke.us Daniel Rogers daniel at phasevelocity.org +Darshan Kapashi David Feuer David Himmelstrup # http://www.haskellers.com/user/Lemmih David M Peixotto dmp at rice.edu @@ -95,6 +96,7 @@ Duncan Coutts Duncan Coutts Edward Z. Yang +Erik de Castro Lopo Evan Hauck Fumiaki Kinoshita Gabor Pali @@ -137,6 +139,7 @@ Jose Pedro Magalhaes Jose Pedro Magalhaes Jose Pedro Magalhaes jpm at cs.uu.nl Josef Svenningsson josefs +Josh Price Jost Berthold Jost Berthold berthold at mathematik.uni-marburg.de Juan J. Quintela quintela @@ -180,6 +183,7 @@ Michael D. Adams michaelw Mike Thomas mthomas Mikolaj Konarski +Moritz Angermann Nathan Huesken Neil Mitchell Neil Mitchell Neil Mitchell @@ -201,8 +205,8 @@ Peter Wortmann scpmw at leeds.ac.uk ralf # https://ghc.haskell.org/trac/ghc/wiki/TeamGHC Ravi Nanavati # Commit 70c044. Reuben Thomas rrt -Richard Eisenberg -Richard Eisenberg +Richard Eisenberg +Richard Eisenberg Rob Ennals rje # SPJ's student (rje33 at cam.ac.uk) Roman Leshchinskiy rl at cse.unsw.edu.au Ross Paterson ross @@ -212,6 +216,7 @@ Ryan Scott Sam Anklesaria amsay at amsay.net Sean Seefried sseefried +Sean Innes Sergei Trofimovich Sergei Trofimovich Sergei Trofimovich @@ -246,8 +251,10 @@ Sungwoo Park gla # http Sven Panne panne Sven Panne sven.panne at aedion.de Sylvain Henry +Sylvain Henry Sébastien Carlier sebc Takano Akio +Thijs Alkemade Thorkil Naur naur at post11.tele.dk Tibor Erdesz Tim Chevalier From git at git.haskell.org Mon Jan 2 22:45:14 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 2 Jan 2017 22:45:14 +0000 (UTC) Subject: [commit: ghc] master: Don't suggest enabling TypeApplications when it's already enabled (b28ca38) Message-ID: <20170102224514.C3DDD3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b28ca38e6e1d75f3c10cc593cdd2ac80ec29690f/ghc >--------------------------------------------------------------- commit b28ca38e6e1d75f3c10cc593cdd2ac80ec29690f Author: Maciej Bielecki Date: Mon Jan 2 17:03:00 2017 -0500 Don't suggest enabling TypeApplications when it's already enabled Previously when encountering EAsPat in an expression context, TypeApplications was suggested even when already enabled. This patch replaces the suggestion with more appropriate message. Test Plan: validate Reviewers: austin, bgamari, mpickering, goldfire, simonpj Reviewed By: mpickering, goldfire, simonpj Subscribers: simonpj, goldfire, mpickering, thomie Differential Revision: https://phabricator.haskell.org/D2877 GHC Trac Issues: #12879 >--------------------------------------------------------------- b28ca38e6e1d75f3c10cc593cdd2ac80ec29690f compiler/rename/RnExpr.hs | 10 ++++++++-- .../should_fail/T12529.hs => rename/should_fail/T12879.hs} | 5 ++--- testsuite/tests/rename/should_fail/T12879.stderr | 4 ++++ testsuite/tests/rename/should_fail/all.T | 1 + 4 files changed, 15 insertions(+), 5 deletions(-) diff --git a/compiler/rename/RnExpr.hs b/compiler/rename/RnExpr.hs index 811ecba..17c9042 100644 --- a/compiler/rename/RnExpr.hs +++ b/compiler/rename/RnExpr.hs @@ -336,8 +336,14 @@ We return a (bogus) EWildPat in each case. -} rnExpr EWildPat = return (hsHoleExpr, emptyFVs) -- "_" is just a hole -rnExpr e@(EAsPat {}) = - patSynErr e (text "Did you mean to enable TypeApplications?") +rnExpr e@(EAsPat {}) + = do { opt_TypeApplications <- xoptM LangExt.TypeApplications + ; let msg | opt_TypeApplications + = "Type application syntax requires a space before '@'" + | otherwise + = "Did you mean to enable TypeApplications?" + ; patSynErr e (text msg) + } rnExpr e@(EViewPat {}) = patSynErr e empty rnExpr e@(ELazyPat {}) = patSynErr e empty diff --git a/testsuite/tests/typecheck/should_fail/T12529.hs b/testsuite/tests/rename/should_fail/T12879.hs similarity index 50% copy from testsuite/tests/typecheck/should_fail/T12529.hs copy to testsuite/tests/rename/should_fail/T12879.hs index ac4e31d..3f62207 100644 --- a/testsuite/tests/typecheck/should_fail/T12529.hs +++ b/testsuite/tests/rename/should_fail/T12879.hs @@ -1,5 +1,4 @@ {-# LANGUAGE TypeApplications #-} +module ShouldFail where -module T12529 where - -f = p @ Int +f x = x at x diff --git a/testsuite/tests/rename/should_fail/T12879.stderr b/testsuite/tests/rename/should_fail/T12879.stderr new file mode 100644 index 0000000..1b3559c --- /dev/null +++ b/testsuite/tests/rename/should_fail/T12879.stderr @@ -0,0 +1,4 @@ + +T12879.hs:4:7: error: + Pattern syntax in expression context: x at x + Type application syntax requires a space before '@' diff --git a/testsuite/tests/rename/should_fail/all.T b/testsuite/tests/rename/should_fail/all.T index b8c1ac5..d42ca56 100644 --- a/testsuite/tests/rename/should_fail/all.T +++ b/testsuite/tests/rename/should_fail/all.T @@ -142,3 +142,4 @@ test('T11663', normal, compile_fail, ['']) test('T12229', normal, compile, ['']) test('T12681', normal, multimod_compile_fail, ['T12681','-v0']) test('T12686', normal, compile_fail, ['']) +test('T12879', normal, compile_fail, ['']) From git at git.haskell.org Mon Jan 2 22:45:11 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 2 Jan 2017 22:45:11 +0000 (UTC) Subject: [commit: ghc] master: Refactor importdecls/topdecls parsing. (8d63ca9) Message-ID: <20170102224511.7CC453A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8d63ca981f689463655766c252160d3fec160264/ghc >--------------------------------------------------------------- commit 8d63ca981f689463655766c252160d3fec160264 Author: Edward Z. Yang Date: Mon Jan 2 17:03:42 2017 -0500 Refactor importdecls/topdecls parsing. Previously, we had the following parser: xs : xs ';' x | xs ';' | x This is a very clever construction that handles duplicate, leading and trailing semicolons well, but it didn't work very well with annotations, where we wanted to attach the annotation for a semicolon to the *previous* x in the list. This lead to some very disgusting code in the parser. This commit refactors the parser into this form: semis1 : semis1 ';' | ';' xs_semi : xs x semis1 | {- empty -} xs : xs_semi x Now, when we parse one or more semicolons after an x, we can attach them immediately, eliminating some very grotty annotations swizzling that was previously in the parser. We now need to write the top-level parser for imports and then declarations in a slightly special way now: top : semis top1 top1 : importdecls_semi topdecls_semi | importdecls_semi topdecls | importdecls This is because the *_semi parsers always require a semicolon, but we're allowed to omit that last newline. So we need special cases to handle each of the possible cases where we may run out of semicolons. I don't know if there is a better way to structure this, but it is not much more complicated than what we had before for top (and asymptotically better!) Signed-off-by: Edward Z. Yang Test Plan: validate Reviewers: simonmar, austin, alanz, bgamari Reviewed By: alanz, bgamari Subscribers: thomie, mpickering Differential Revision: https://phabricator.haskell.org/D2893 >--------------------------------------------------------------- 8d63ca981f689463655766c252160d3fec160264 compiler/parser/Parser.y | 94 +++++++++++++++++++++++++----------------------- 1 file changed, 50 insertions(+), 44 deletions(-) diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y index befd52f..3fc20a1 100644 --- a/compiler/parser/Parser.y +++ b/compiler/parser/Parser.y @@ -708,23 +708,14 @@ body2 :: { ([AddAnn] | missing_module_keyword top close { ([],snd $2) } - top :: { ([AddAnn] ,([LImportDecl RdrName], [LHsDecl RdrName])) } - : importdecls { (fst $1 - ,(reverse $ snd $1,[]))} - | importdecls ';' cvtopdecls {% if null (snd $1) - then return ((mj AnnSemi $2:(fst $1)) - ,(reverse $ snd $1,$3)) - else do - { addAnnotation (gl $ head $ snd $1) - AnnSemi (gl $2) - ; return (fst $1 - ,(reverse $ snd $1,$3)) }} - | cvtopdecls { ([],([],$1)) } - -cvtopdecls :: { [LHsDecl RdrName] } - : topdecls { cvTopDecls $1 } + : semis top1 { ($1, $2) } + +top1 :: { ([LImportDecl RdrName], [LHsDecl RdrName]) } + : importdecls_semi topdecls_semi { (reverse $1, cvTopDecls $2) } + | importdecls_semi topdecls { (reverse $1, cvTopDecls $2) } + | importdecls { (reverse $1, []) } ----------------------------------------------------------------------------- -- Module declaration & imports only @@ -744,12 +735,19 @@ header :: { Located (HsModule RdrName) } Nothing)) } header_body :: { [LImportDecl RdrName] } - : '{' importdecls { snd $2 } - | vocurly importdecls { snd $2 } + : '{' header_top { $2 } + | vocurly header_top { $2 } header_body2 :: { [LImportDecl RdrName] } - : '{' importdecls { snd $2 } - | missing_module_keyword importdecls { snd $2 } + : '{' header_top { $2 } + | missing_module_keyword header_top { $2 } + +header_top :: { [LImportDecl RdrName] } + : semis header_top_importdecls { $2 } + +header_top_importdecls :: { [LImportDecl RdrName] } + : importdecls_semi { $1 } + | importdecls { $1 } ----------------------------------------------------------------------------- -- The Export List @@ -836,25 +834,31 @@ qcname :: { Located RdrName } -- Variable or type constructor ----------------------------------------------------------------------------- -- Import Declarations --- import decls can be *empty*, or even just a string of semicolons --- whereas topdecls must contain at least one topdecl. +-- importdecls and topdecls must contain at least one declaration; +-- top handles the fact that these may be optional. -importdecls :: { ([AddAnn],[LImportDecl RdrName]) } - : importdecls ';' importdecl - {% if null (snd $1) - then return (mj AnnSemi $2:fst $1,$3 : snd $1) - else do - { addAnnotation (gl $ head $ snd $1) - AnnSemi (gl $2) - ; return (fst $1,$3 : snd $1) } } - | importdecls ';' {% if null (snd $1) - then return ((mj AnnSemi $2:fst $1),snd $1) - else do - { addAnnotation (gl $ head $ snd $1) - AnnSemi (gl $2) - ; return $1} } - | importdecl { ([],[$1]) } - | {- empty -} { ([],[]) } +-- One or more semicolons +semis1 :: { [AddAnn] } +semis1 : semis1 ';' { mj AnnSemi $2 : $1 } + | ';' { [mj AnnSemi $1] } + +-- Zero or more semicolons +semis :: { [AddAnn] } +semis : semis ';' { mj AnnSemi $2 : $1 } + | {- empty -} { [] } + +-- No trailing semicolons, non-empty +importdecls :: { [LImportDecl RdrName] } +importdecls + : importdecls_semi importdecl + { $2 : $1 } + +-- May have trailing semicolons, can be empty +importdecls_semi :: { [LImportDecl RdrName] } +importdecls_semi + : importdecls_semi importdecl semis1 + {% ams $2 $3 >> return ($2 : $1) } + | {- empty -} { [] } importdecl :: { LImportDecl RdrName } : 'import' maybe_src maybe_safe optqualified maybe_pkg modid maybeas maybeimpspec @@ -932,12 +936,14 @@ ops :: { Located (OrdList (Located RdrName)) } ----------------------------------------------------------------------------- -- Top-Level Declarations +-- No trailing semicolons, non-empty topdecls :: { OrdList (LHsDecl RdrName) } - : topdecls ';' topdecl {% addAnnotation (oll $1) AnnSemi (gl $2) - >> return ($1 `appOL` unitOL $3) } - | topdecls ';' {% addAnnotation (oll $1) AnnSemi (gl $2) - >> return $1 } - | topdecl { unitOL $1 } + : topdecls_semi topdecl { $1 `snocOL` $2 } + +-- May have trailing semicolons, can be empty +topdecls_semi :: { OrdList (LHsDecl RdrName) } + : topdecls_semi topdecl semis1 {% ams $2 $3 >> return ($1 `snocOL` $2) } + | {- empty -} { nilOL } topdecl :: { LHsDecl RdrName } : cl_decl { sL1 $1 (TyClD (unLoc $1)) } @@ -2543,8 +2549,8 @@ cvtopbody :: { ([AddAnn],[LHsDecl RdrName]) } | vocurly cvtopdecls0 close { ([],$2) } cvtopdecls0 :: { [LHsDecl RdrName] } - : {- empty -} { [] } - | cvtopdecls { $1 } + : topdecls_semi { cvTopDecls $1 } + | topdecls { cvTopDecls $1 } ----------------------------------------------------------------------------- -- Tuple expressions From git at git.haskell.org Tue Jan 3 03:16:49 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 3 Jan 2017 03:16:49 +0000 (UTC) Subject: [commit: ghc] wip/all-inlinable: Don't use $ in the definition of (<**>) in GHC.Base (9a98745) Message-ID: <20170103031649.BA5983A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/all-inlinable Link : http://ghc.haskell.org/trac/ghc/changeset/9a9874502f57e43bde5af6de63b503301194277b/ghc >--------------------------------------------------------------- commit 9a9874502f57e43bde5af6de63b503301194277b Author: Matthew Pickering Date: Tue Jan 3 03:07:44 2017 +0000 Don't use $ in the definition of (<**>) in GHC.Base Summary: ($) is special as Richard explains in the note at the top of the page. However, when adding the note he didn't remove this usage. Normally it didn't cause any problems as the optimiser optimised it away. However if one had the propensity to stick one's fingers into the depths of the inliner, it caused horrible idInfo panics. Reviewers: austin, rwbarton, hvr, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2913 >--------------------------------------------------------------- 9a9874502f57e43bde5af6de63b503301194277b libraries/base/GHC/Base.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/libraries/base/GHC/Base.hs b/libraries/base/GHC/Base.hs index 2edce60..5d62ff2 100644 --- a/libraries/base/GHC/Base.hs +++ b/libraries/base/GHC/Base.hs @@ -410,7 +410,8 @@ class Functor f => Applicative f where -- | A variant of '<*>' with the arguments reversed. (<**>) :: Applicative f => f a -> f (a -> b) -> f b -(<**>) = liftA2 (flip ($)) +(<**>) = liftA2 (\a f -> f a) +-- Don't use $ here, see the note at the top of the page -- | Lift a function to actions. -- This function may be used as a value for `fmap` in a `Functor` instance. From git at git.haskell.org Tue Jan 3 05:52:23 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 3 Jan 2017 05:52:23 +0000 (UTC) Subject: [commit: ghc] master: Add specialization rules for realToFrac on Complex (5800b02) Message-ID: <20170103055223.EB7633A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5800b02a1910a468485b272a2063377e8b06ee1d/ghc >--------------------------------------------------------------- commit 5800b02a1910a468485b272a2063377e8b06ee1d Author: Takano Akio Date: Tue Jan 3 00:20:24 2017 -0500 Add specialization rules for realToFrac on Complex This patch implements RULES that specialize realToFrac at these 2 types: `(Real a) => a -> Complex Double` `(Real a) => a -> Complex Float` Test Plan: ./validate Reviewers: austin, hvr, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2901 GHC Trac Issues: #13040 >--------------------------------------------------------------- 5800b02a1910a468485b272a2063377e8b06ee1d libraries/base/Data/Complex.hs | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/libraries/base/Data/Complex.hs b/libraries/base/Data/Complex.hs index 17ef805..efdc1c5 100644 --- a/libraries/base/Data/Complex.hs +++ b/libraries/base/Data/Complex.hs @@ -235,3 +235,16 @@ instance Applicative Complex where -- | @since 4.9.0.0 instance Monad Complex where a :+ b >>= f = realPart (f a) :+ imagPart (f b) + +-- ----------------------------------------------------------------------------- +-- Rules on Complex + +{-# RULES + +"realToFrac/a->Complex Double" + realToFrac = \x -> realToFrac x :+ (0 :: Double) + +"realToFrac/a->Complex Float" + realToFrac = \x -> realToFrac x :+ (0 :: Float) + + #-} From git at git.haskell.org Tue Jan 3 05:52:26 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 3 Jan 2017 05:52:26 +0000 (UTC) Subject: [commit: ghc] master: Don't use $ in the definition of (<**>) in GHC.Base (683ed47) Message-ID: <20170103055226.A834A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/683ed475964bbd90030deb8f738370ae90b48a22/ghc >--------------------------------------------------------------- commit 683ed475964bbd90030deb8f738370ae90b48a22 Author: Matthew Pickering Date: Tue Jan 3 00:22:03 2017 -0500 Don't use $ in the definition of (<**>) in GHC.Base ($) is special as Richard explains in the note at the top of the page. However, when adding the note he didn't remove this usage. Normally it didn't cause any problems as the optimiser optimised it away. However if one had the propensity to stick one's fingers into the depths of the inliner, it caused horrible idInfo panics. Reviewers: rwbarton, hvr, austin, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2913 GHC Trac Issues: #13055 >--------------------------------------------------------------- 683ed475964bbd90030deb8f738370ae90b48a22 libraries/base/GHC/Base.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/libraries/base/GHC/Base.hs b/libraries/base/GHC/Base.hs index 34a038d..490596e 100644 --- a/libraries/base/GHC/Base.hs +++ b/libraries/base/GHC/Base.hs @@ -423,7 +423,8 @@ class Functor f => Applicative f where -- | A variant of '<*>' with the arguments reversed. (<**>) :: Applicative f => f a -> f (a -> b) -> f b -(<**>) = liftA2 (flip ($)) +(<**>) = liftA2 (\a f -> f a) +-- Don't use $ here, see the note at the top of the page -- | Lift a function to actions. -- This function may be used as a value for `fmap` in a `Functor` instance. From git at git.haskell.org Tue Jan 3 16:47:07 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 3 Jan 2017 16:47:07 +0000 (UTC) Subject: [commit: ghc] master: Typo in manual [ci skip] (6b3c039) Message-ID: <20170103164707.A57BC3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6b3c039117d3af575e44e0c4577b94db76eaf560/ghc >--------------------------------------------------------------- commit 6b3c039117d3af575e44e0c4577b94db76eaf560 Author: Gabor Greif Date: Tue Jan 3 17:45:19 2017 +0100 Typo in manual [ci skip] >--------------------------------------------------------------- 6b3c039117d3af575e44e0c4577b94db76eaf560 docs/users_guide/ghci.rst | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/docs/users_guide/ghci.rst b/docs/users_guide/ghci.rst index 468f39e..1e53b6c 100644 --- a/docs/users_guide/ghci.rst +++ b/docs/users_guide/ghci.rst @@ -1017,7 +1017,7 @@ is given, the following additional differences apply: - Rule 2 above is relaxed thus: *All* of the classes ``Ci`` are single-parameter type classes. -- Rule 3 above is relaxed this: At least one of the classes ``Ci`` is +- Rule 3 above is relaxed thus: At least one of the classes ``Ci`` is an *interactive class* (defined below). - The unit type ``()`` and the list type ``[]`` are added to the start of From git at git.haskell.org Tue Jan 3 17:45:55 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 3 Jan 2017 17:45:55 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Revert "nativeGen: Allow -fregs-graph to be used" (55dfd21) Message-ID: <20170103174555.AC0593A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/55dfd21e1969b4b8e40196ecf29e4c9c73273966/ghc >--------------------------------------------------------------- commit 55dfd21e1969b4b8e40196ecf29e4c9c73273966 Author: Ben Gamari Date: Fri Dec 23 17:34:49 2016 -0500 Revert "nativeGen: Allow -fregs-graph to be used" This reverts commit 6a5d13c4ade5bbb84873970065a1acd1546f6c31 due to breakage on PPC AIX while compiling unordered-containers. See #13033. >--------------------------------------------------------------- 55dfd21e1969b4b8e40196ecf29e4c9c73273966 compiler/nativeGen/AsmCodeGen.hs | 6 ++++-- docs/users_guide/using-optimisation.rst | 28 +++++++++++----------------- 2 files changed, 15 insertions(+), 19 deletions(-) diff --git a/compiler/nativeGen/AsmCodeGen.hs b/compiler/nativeGen/AsmCodeGen.hs index 9e90c43..2285d94 100644 --- a/compiler/nativeGen/AsmCodeGen.hs +++ b/compiler/nativeGen/AsmCodeGen.hs @@ -538,8 +538,10 @@ cmmNativeGen dflags this_mod modLoc ncgImpl us fileIds dbgMap cmm count -- allocate registers (alloced, usAlloc, ppr_raStatsColor, ppr_raStatsLinear) <- - if ( gopt Opt_RegsGraph dflags - || gopt Opt_RegsIterative dflags ) + if False + -- Disabled, see #7679, #8657 + -- ( gopt Opt_RegsGraph dflags + -- || gopt Opt_RegsIterative dflags) then do -- the regs usable for allocation let (alloc_regs :: UniqFM (UniqSet RealReg)) diff --git a/docs/users_guide/using-optimisation.rst b/docs/users_guide/using-optimisation.rst index 7047f4c..5e4995d 100644 --- a/docs/users_guide/using-optimisation.rst +++ b/docs/users_guide/using-optimisation.rst @@ -412,26 +412,20 @@ list. .. ghc-flag:: -fregs-graph - :default: off due to a performance regression bug (:ghc-ticket:`7679`) - - *Only applies in combination with the native code generator.* Use the graph - colouring register allocator for register allocation in the native code - generator. By default, GHC uses a simpler, faster linear register allocator. - The downside being that the linear register allocator usually generates - worse code. - - Note that the graph colouring allocator is a bit experimental and may fail - when faced with code with high register pressure :ghc-ticket:`8657`. + *Off by default due to a performance regression bug. Only applies in + combination with the native code generator.* Use the graph colouring + register allocator for register allocation in the native code + generator. By default, GHC uses a simpler, faster linear register + allocator. The downside being that the linear register allocator + usually generates worse code. .. ghc-flag:: -fregs-iterative - :default: off - - *Only applies in combination with the native code generator.* Use the - iterative coalescing graph colouring register allocator for register - allocation in the native code generator. This is the same register allocator - as the :ghc-flag:`-fregs-graph` one but also enables iterative coalescing - during register allocation. + *Off by default, only applies in combination with the native code + generator.* Use the iterative coalescing graph colouring register + allocator for register allocation in the native code generator. This + is the same register allocator as the ``-fregs-graph`` one but also + enables iterative coalescing during register allocation. .. ghc-flag:: -fsimplifier-phases= From git at git.haskell.org Tue Jan 3 17:45:58 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 3 Jan 2017 17:45:58 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: UniqSupply: Use full range of machine word (b85dc18) Message-ID: <20170103174558.B18233A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/b85dc18f731d7cc4eb4deb973931ef93671292d6/ghc >--------------------------------------------------------------- commit b85dc18f731d7cc4eb4deb973931ef93671292d6 Author: Ben Gamari Date: Thu Dec 15 18:57:26 2016 -0500 UniqSupply: Use full range of machine word Currently uniques are 32-bits wide. 8 of these bits are for the unique class, leaving only 24 for the unique number itself. This seems dangerously small for a large project. Let's use the full range of the native machine word. We also add (now largely unnecessary) overflow check to ensure that the unique number doesn't overflow. Test Plan: Validate Reviewers: simonmar, austin, niteria Reviewed By: niteria Subscribers: mpickering, thomie Differential Revision: https://phabricator.haskell.org/D2844 GHC Trac Issues: #12944 (cherry picked from commit 0d213c18b6962bb65e2b3035a258dd3f5bf454dd) >--------------------------------------------------------------- b85dc18f731d7cc4eb4deb973931ef93671292d6 compiler/Unique.h | 3 +++ compiler/basicTypes/UniqSupply.hs | 6 ++++-- compiler/basicTypes/Unique.hs | 15 +++++++++++---- compiler/cbits/genSym.c | 25 +++++++++++++++++++++---- 4 files changed, 39 insertions(+), 10 deletions(-) diff --git a/compiler/Unique.h b/compiler/Unique.h new file mode 100644 index 0000000..a786d8f --- /dev/null +++ b/compiler/Unique.h @@ -0,0 +1,3 @@ +#include "../includes/MachDeps.h" + +#define UNIQUE_BITS (WORD_SIZE_IN_BITS - 8) diff --git a/compiler/basicTypes/UniqSupply.hs b/compiler/basicTypes/UniqSupply.hs index 16734bc..6a6734f 100644 --- a/compiler/basicTypes/UniqSupply.hs +++ b/compiler/basicTypes/UniqSupply.hs @@ -3,7 +3,7 @@ (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 -} -{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE CPP, UnboxedTuples #-} module UniqSupply ( -- * Main data type @@ -38,6 +38,8 @@ import Control.Monad import Data.Bits import Data.Char +#include "Unique.h" + {- ************************************************************************ * * @@ -73,7 +75,7 @@ takeUniqFromSupply :: UniqSupply -> (Unique, UniqSupply) -- ^ Obtain the 'Unique' from this particular 'UniqSupply', and a new supply mkSplitUniqSupply c - = case ord c `shiftL` 24 of + = case ord c `shiftL` UNIQUE_BITS of mask -> let -- here comes THE MAGIC: diff --git a/compiler/basicTypes/Unique.hs b/compiler/basicTypes/Unique.hs index eddf265..0a4d1bd 100644 --- a/compiler/basicTypes/Unique.hs +++ b/compiler/basicTypes/Unique.hs @@ -8,6 +8,7 @@ comparison key in the compiler. If there is any single operation that needs to be fast, it is @Unique@ + comparison. Unsurprisingly, there is quite a bit of huff-and-puff directed to that end. @@ -63,6 +64,7 @@ module Unique ( ) where #include "HsVersions.h" +#include "Unique.h" import BasicTypes import FastString @@ -124,6 +126,11 @@ deriveUnique (MkUnique i) delta = mkUnique 'X' (i + delta) -- newTagUnique changes the "domain" of a unique to a different char newTagUnique u c = mkUnique c i where (_,i) = unpkUnique u +-- | How many bits are devoted to the unique index (as opposed to the class +-- character). +uniqueMask :: Int +uniqueMask = (1 `shiftL` UNIQUE_BITS) - 1 + -- pop the Char in the top 8 bits of the Unique(Supply) -- No 64-bit bugs here, as long as we have at least 32 bits. --JSM @@ -136,15 +143,15 @@ mkUnique :: Char -> Int -> Unique -- Builds a unique from pieces mkUnique c i = MkUnique (tag .|. bits) where - tag = ord c `shiftL` 24 - bits = i .&. 16777215 {-``0x00ffffff''-} + tag = ord c `shiftL` UNIQUE_BITS + bits = i .&. uniqueMask unpkUnique (MkUnique u) = let -- as long as the Char may have its eighth bit set, we -- really do need the logical right-shift here! - tag = chr (u `shiftR` 24) - i = u .&. 16777215 {-``0x00ffffff''-} + tag = chr (u `shiftR` UNIQUE_BITS) + i = u .&. uniqueMask in (tag, i) diff --git a/compiler/cbits/genSym.c b/compiler/cbits/genSym.c index 70ea417..725a310 100644 --- a/compiler/cbits/genSym.c +++ b/compiler/cbits/genSym.c @@ -1,18 +1,35 @@ - +#include #include "Rts.h" +#include "Unique.h" static HsInt GenSymCounter = 0; static HsInt GenSymInc = 1; +#define UNIQUE_MASK ((1ULL << UNIQUE_BITS) - 1) + +STATIC_INLINE void checkUniqueRange(HsInt u STG_UNUSED) { +#if DEBUG + // Uh oh! We will overflow next time a unique is requested. + assert(h != UNIQUE_MASK); +#endif +} + HsInt genSym(void) { #if defined(THREADED_RTS) if (n_capabilities == 1) { - return GenSymCounter = (GenSymCounter + GenSymInc) & 0xFFFFFF; + GenSymCounter = (GenSymCounter + GenSymInc) & UNIQUE_MASK; + checkUniqueRange(GenSymCounter); + return GenSymCounter; } else { - return atomic_inc((StgWord *)&GenSymCounter, GenSymInc) & 0xFFFFFF; + HsInt n = atomic_inc((StgWord *)&GenSymCounter, GenSymInc) + & UNIQUE_MASK; + checkUniqueRange(n); + return n; } #else - return GenSymCounter = (GenSymCounter + GenSymInc) & 0xFFFFFF; + GenSymCounter = (GenSymCounter + GenSymInc) & UNIQUE_MASK; + checkUniqueRange(GenSymCounter); + return GenSymCounter; #endif } From git at git.haskell.org Wed Jan 4 13:45:45 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 4 Jan 2017 13:45:45 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: revert '-Wl' prefixing to *_LD_OPTS (f6e8d45) Message-ID: <20170104134545.ABF083A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/f6e8d45d6860996e7db9dcd4b440eabac710fa5e/ghc >--------------------------------------------------------------- commit f6e8d45d6860996e7db9dcd4b440eabac710fa5e Author: Sergei Trofimovich Date: Sat Dec 17 13:30:41 2016 +0000 revert '-Wl' prefixing to *_LD_OPTS This reverts f48f5a9ebf384e1e157b7b413e1d779f4289ddd2 The prefixing does not work as comma is stripped by $(addprefix) macro: The following call $$(addprefix -optl-Wl, $$($1_$2_$3_ALL_LD_OPTS)) prefixes options with "-optl-Wl" not with "-optl-Wl," The simplest breakage can be seen by adding SRC_LD_OPTS += -O1 to mk/build.mk: : error: Warning: Couldn't figure out linker information! Make sure you're using GNU ld, GNU gold or the built in OS X linker, etc. gcc: error: unrecognized command line option '-Wl-O1' Another problem with original change is loss of ability to pass options to gcc as a linker driver, for example: SRC_LD_OPTS += -flto Signed-off-by: Sergei Trofimovich (cherry picked from commit a6657bd0d6b9949098021d89ed3cd8a943bdd3b6) >--------------------------------------------------------------- f6e8d45d6860996e7db9dcd4b440eabac710fa5e rules/distdir-way-opts.mk | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/rules/distdir-way-opts.mk b/rules/distdir-way-opts.mk index 61e03ee..7ba6ebc 100644 --- a/rules/distdir-way-opts.mk +++ b/rules/distdir-way-opts.mk @@ -201,7 +201,7 @@ $1_$2_$3_ALL_LD_OPTS = \ # Options for passing to GHC when we use it for linking $1_$2_$3_GHC_LD_OPTS = \ - $$(addprefix -optl-Wl, $$($1_$2_$3_ALL_LD_OPTS)) \ + $$(addprefix -optl, $$($1_$2_$3_ALL_LD_OPTS)) \ $$($1_$2_$3_MOST_HC_OPTS) $1_$2_$3_ALL_AS_OPTS = \ From git at git.haskell.org Wed Jan 4 17:38:10 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 4 Jan 2017 17:38:10 +0000 (UTC) Subject: [commit: ghc] master: Typofixes in manual and comments [ci skip] (df72368) Message-ID: <20170104173810.172BE3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/df723689c415573fa6c7d83663758154fa7dc46f/ghc >--------------------------------------------------------------- commit df723689c415573fa6c7d83663758154fa7dc46f Author: Gabor Greif Date: Wed Jan 4 18:37:23 2017 +0100 Typofixes in manual and comments [ci skip] >--------------------------------------------------------------- df723689c415573fa6c7d83663758154fa7dc46f compiler/nativeGen/RegAlloc/Liveness.hs | 2 +- compiler/simplCore/Simplify.hs | 2 +- docs/users_guide/glasgow_exts.rst | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/compiler/nativeGen/RegAlloc/Liveness.hs b/compiler/nativeGen/RegAlloc/Liveness.hs index a904202..4b00ed6 100644 --- a/compiler/nativeGen/RegAlloc/Liveness.hs +++ b/compiler/nativeGen/RegAlloc/Liveness.hs @@ -801,7 +801,7 @@ computeLiveness -> [SCC (LiveBasicBlock instr)] -> ([SCC (LiveBasicBlock instr)], -- instructions annotated with list of registers -- which are "dead after this instruction". - BlockMap RegSet) -- blocks annontated with set of live registers + BlockMap RegSet) -- blocks annotated with set of live registers -- on entry to the block. computeLiveness platform sccs diff --git a/compiler/simplCore/Simplify.hs b/compiler/simplCore/Simplify.hs index e51ef05..0b9f5f0 100644 --- a/compiler/simplCore/Simplify.hs +++ b/compiler/simplCore/Simplify.hs @@ -1437,7 +1437,7 @@ rebuildCall env (ArgInfo { ai_fun = fun, ai_args = rev_args, ai_strs = [] }) con -- the continuation, leaving just the bottoming expression. But the -- type might not be right, so we may have to add a coerce. | not (contIsTrivial cont) -- Only do this if there is a non-trivial - = return (env, castBottomExpr res cont_ty) -- contination to discard, else we do it + = return (env, castBottomExpr res cont_ty) -- continuation to discard, else we do it where -- again and again! res = argInfoExpr fun rev_args cont_ty = contResultType cont diff --git a/docs/users_guide/glasgow_exts.rst b/docs/users_guide/glasgow_exts.rst index 919ec7d..e21a975 100644 --- a/docs/users_guide/glasgow_exts.rst +++ b/docs/users_guide/glasgow_exts.rst @@ -3872,7 +3872,7 @@ generates :: instance Num Dollars -One can think of this instance being implementated with the same code as the +One can think of this instance being implemented with the same code as the ``Num Int`` instance, but with ``Dollars`` and ``getDollars`` added wherever necessary in order to make it typecheck. (In practice, GHC uses a somewhat different approach to code generation. See the :ref:`precise-gnd-specification` From git at git.haskell.org Wed Jan 4 18:59:46 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 4 Jan 2017 18:59:46 +0000 (UTC) Subject: [commit: ghc] branch 'wip/T13056' created Message-ID: <20170104185946.D4D9D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/T13056 Referencing: 8aba3d4a3161ed93de04cd154774cdd016bee6ad From git at git.haskell.org Wed Jan 4 18:59:49 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 4 Jan 2017 18:59:49 +0000 (UTC) Subject: [commit: ghc] wip/T13056: Add performance test for #13056 (8aba3d4) Message-ID: <20170104185949.F27273A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T13056 Link : http://ghc.haskell.org/trac/ghc/changeset/8aba3d4a3161ed93de04cd154774cdd016bee6ad/ghc >--------------------------------------------------------------- commit 8aba3d4a3161ed93de04cd154774cdd016bee6ad Author: Ryan Scott Date: Wed Jan 4 13:57:25 2017 -0500 Add performance test for #13056 This performance regression was fixed by commit 517d03e41b4f5c144d1ad684539340421be2be2a (#12234). Let's add a performance test to ensure that it doesn't break again. >--------------------------------------------------------------- 8aba3d4a3161ed93de04cd154774cdd016bee6ad testsuite/tests/perf/compiler/T13056.hs | 26 ++++++++++++++++++++++++++ testsuite/tests/perf/compiler/all.T | 10 ++++++++++ 2 files changed, 36 insertions(+) diff --git a/testsuite/tests/perf/compiler/T13056.hs b/testsuite/tests/perf/compiler/T13056.hs new file mode 100644 index 0000000..046e1b0 --- /dev/null +++ b/testsuite/tests/perf/compiler/T13056.hs @@ -0,0 +1,26 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE DeriveFoldable #-} + +module Bug where +import Data.Typeable +import GHC.Generics +import Data.Data + +data Condition v = Condition + deriving (Functor, Foldable) + +data CondTree v c a = CondNode + { condTreeData :: a + , condTreeConstraints :: c + , condTreeComponents :: [CondBranch v c a] + } + deriving (Functor, Foldable) + +data CondBranch v c a = CondBranch + { condBranchCondition :: Condition v + , condBranchIfTrue :: CondTree v c a + , condBranchIfFalse :: Maybe (CondTree v c a) + } + deriving (Functor, Foldable) diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T index 2714e86..5d61ae3 100644 --- a/testsuite/tests/perf/compiler/all.T +++ b/testsuite/tests/perf/compiler/all.T @@ -898,3 +898,13 @@ test('T12234', ], compile, ['']) + +test('T13056', + [ only_ways(['optasm']), + compiler_stats_num_field('bytes allocated', + [(wordsize(64), 1, 5), + # 2017-01-04 1 initial + ]), + ], + compile, + ['-O1']) From git at git.haskell.org Wed Jan 4 21:27:25 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 4 Jan 2017 21:27:25 +0000 (UTC) Subject: [commit: ghc] tag 'ghc-8.0.2-release' created Message-ID: <20170104212725.1B0493A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New tag : ghc-8.0.2-release Referencing: 3755babf40db5db1286676771cad04f6eaafd0e4 From git at git.haskell.org Wed Jan 4 21:27:27 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 4 Jan 2017 21:27:27 +0000 (UTC) Subject: [commit: ghc] : Release 8.0.2 (8c72503) Message-ID: <20170104212727.CF9C53A2FF@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : Link : http://ghc.haskell.org/trac/ghc/changeset/8c7250379d0d2bad1d07dfd556812ff7aa2c42e8/ghc >--------------------------------------------------------------- commit 8c7250379d0d2bad1d07dfd556812ff7aa2c42e8 Author: Ben Gamari Date: Wed Jan 4 08:56:27 2017 -0500 Release 8.0.2 >--------------------------------------------------------------- 8c7250379d0d2bad1d07dfd556812ff7aa2c42e8 configure.ac | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/configure.ac b/configure.ac index bbb39eb..a434a39 100644 --- a/configure.ac +++ b/configure.ac @@ -13,10 +13,10 @@ dnl # see what flags are available. (Better yet, read the documentation!) # -AC_INIT([The Glorious Glasgow Haskell Compilation System], [8.0.1], [glasgow-haskell-bugs at haskell.org], [ghc-AC_PACKAGE_VERSION]) +AC_INIT([The Glorious Glasgow Haskell Compilation System], [8.0.2], [glasgow-haskell-bugs at haskell.org], [ghc-AC_PACKAGE_VERSION]) # Set this to YES for a released version, otherwise NO -: ${RELEASE=NO} +: ${RELEASE=YES} # The primary version (e.g. 7.5, 7.4.1) is set in the AC_INIT line # above. If this is not a released version, then we will append the From git at git.haskell.org Wed Jan 4 21:27:30 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 4 Jan 2017 21:27:30 +0000 (UTC) Subject: [commit: ghc] : A few last-minute Changelog entries (2b746c8) Message-ID: <20170104212730.86EC53A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : Link : http://ghc.haskell.org/trac/ghc/changeset/2b746c819a73638ca47e0d4f639493a66726ea48/ghc >--------------------------------------------------------------- commit 2b746c819a73638ca47e0d4f639493a66726ea48 Author: Ben Gamari Date: Wed Jan 4 08:59:25 2017 -0500 A few last-minute Changelog entries >--------------------------------------------------------------- 2b746c819a73638ca47e0d4f639493a66726ea48 libraries/base/changelog.md | 8 ++++++++ libraries/ghc-boot/changelog.md | 4 ++++ libraries/ghci/changelog.md | 6 ++++++ libraries/template-haskell/changelog.md | 2 +- 4 files changed, 19 insertions(+), 1 deletion(-) diff --git a/libraries/base/changelog.md b/libraries/base/changelog.md index 4205efb..db3a69a 100644 --- a/libraries/base/changelog.md +++ b/libraries/base/changelog.md @@ -1,5 +1,13 @@ # Changelog for [`base` package](http://hackage.haskell.org/package/base) +## 4.9.1.0 *Jan 2017* + + * Bundled with GHC 8.0.2 + + * Performance improvements in `Read` implementation + + * Teach event manager to use poll instead of select (#12912) + ## 4.9.0.0 *May 2016* * Bundled with GHC 8.0 diff --git a/libraries/ghc-boot/changelog.md b/libraries/ghc-boot/changelog.md index 3ed5bbb..ae364e5 100644 --- a/libraries/ghc-boot/changelog.md +++ b/libraries/ghc-boot/changelog.md @@ -1,3 +1,7 @@ +## 8.0.2 *Jan 2017* + + * Bundled with GHC 8.0.2 + ## 8.0.1 *May 2016* * Bundled with GHC 8.0.1 diff --git a/libraries/ghci/changelog.md b/libraries/ghci/changelog.md index 3775eda..fa47b92 100644 --- a/libraries/ghci/changelog.md +++ b/libraries/ghci/changelog.md @@ -1,3 +1,9 @@ +## 8.0.2 *Jan 2017* + + * Bundled with GHC 8.0.2 + + * Tag pointers in interpreted constructors (#12523) + ## 8.0.1 *Feb 2016* * Bundled with GHC 8.0.1 diff --git a/libraries/template-haskell/changelog.md b/libraries/template-haskell/changelog.md index 09ecacd..ce3ed5b 100644 --- a/libraries/template-haskell/changelog.md +++ b/libraries/template-haskell/changelog.md @@ -1,6 +1,6 @@ # Changelog for [`template-haskell` package](http://hackage.haskell.org/package/template-haskell) -## 2.11.1.0 Nov 2016 +## 2.11.1.0 Jan 2017 * Bundled with GHC 8.0.2 From git at git.haskell.org Wed Jan 4 21:37:41 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 4 Jan 2017 21:37:41 +0000 (UTC) Subject: [commit: ghc] ghc-8.0's head updated: Release 8.0.2 (8c72503) Message-ID: <20170104213741.F3BEC3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'ghc-8.0' now includes: 2b746c8 A few last-minute Changelog entries 8c72503 Release 8.0.2 From git at git.haskell.org Thu Jan 5 08:52:33 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 5 Jan 2017 08:52:33 +0000 (UTC) Subject: [commit: ghc] master: Remove a redundant test (2664641) Message-ID: <20170105085233.CED953A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/266464186cfd1c575dd3ffa188589eceb12dc66b/ghc >--------------------------------------------------------------- commit 266464186cfd1c575dd3ffa188589eceb12dc66b Author: Simon Peyton Jones Date: Wed Jan 4 13:09:54 2017 +0000 Remove a redundant test postInlineUnconditionally was testing for isExportedId, but it was /also/ testing for top-level-ness, which is redundant. This patch just removes the redundant test, and documents it. >--------------------------------------------------------------- 266464186cfd1c575dd3ffa188589eceb12dc66b compiler/simplCore/SimplUtils.hs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/compiler/simplCore/SimplUtils.hs b/compiler/simplCore/SimplUtils.hs index 03adfe0..5f60042 100644 --- a/compiler/simplCore/SimplUtils.hs +++ b/compiler/simplCore/SimplUtils.hs @@ -1155,7 +1155,6 @@ postInlineUnconditionally dflags env top_lvl bndr occ_info rhs unfolding | not active = False | isWeakLoopBreaker occ_info = False -- If it's a loop-breaker of any kind, don't inline -- because it might be referred to "earlier" - | isExportedId bndr = False | isStableUnfolding unfolding = False -- Note [Stable unfoldings and postInlineUnconditionally] | isTopLevel top_lvl = False -- Note [Top level and postInlineUnconditionally] | exprIsTrivial rhs = True @@ -1249,6 +1248,10 @@ ones that are trivial): * The inliner should inline trivial things at call sites anyway. + * The Id might be exported. We could check for that separately, + but since we aren't going to postInlineUnconditinoally /any/ + top-level bindings, we don't need to test. + Note [Stable unfoldings and postInlineUnconditionally] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Do not do postInlineUnconditionally if the Id has an stable unfolding, From git at git.haskell.org Thu Jan 5 08:52:31 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 5 Jan 2017 08:52:31 +0000 (UTC) Subject: [commit: ghc] master: Minor refactoring in CSE (c909e6e) Message-ID: <20170105085231.1F0813A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c909e6ec333667878b17f127f75204a14256340f/ghc >--------------------------------------------------------------- commit c909e6ec333667878b17f127f75204a14256340f Author: Simon Peyton Jones Date: Wed Jan 4 13:14:30 2017 +0000 Minor refactoring in CSE I noticed that CSE.addBinding was always returning one of its own inputs, so I refactored to avoid doing so. No change in behaviour. >--------------------------------------------------------------- c909e6ec333667878b17f127f75204a14256340f compiler/simplCore/CSE.hs | 80 +++++++++++++++++++++++++++-------------------- 1 file changed, 46 insertions(+), 34 deletions(-) diff --git a/compiler/simplCore/CSE.hs b/compiler/simplCore/CSE.hs index 42a2d28..a8d0404 100644 --- a/compiler/simplCore/CSE.hs +++ b/compiler/simplCore/CSE.hs @@ -22,8 +22,7 @@ import CoreSyn import Outputable import BasicTypes ( isAlwaysActive ) import TrieMap - -import Data.List +import Data.List ( mapAccumL ) {- Simple common sub-expression @@ -63,7 +62,7 @@ We can simply add clones to the substitution already described. Note [CSE for bindings] ~~~~~~~~~~~~~~~~~~~~~~~ -Let-bindings have two cases, implemnted by cseRhs. +Let-bindings have two cases, implemnted by addBinding. * Trivial RHS: let x = y in ...(h x).... @@ -95,8 +94,18 @@ Let-bindings have two cases, implemnted by cseRhs. we CSE the (h y) call to x. Notice that - - the trivial-RHS situation extends the substitution (cs_subst) - - the non-trivial-RHS situation extends the reverse mapping (cs_map) + - The trivial-RHS situation extends the substitution (cs_subst) + - The non-trivial-RHS situation extends the reverse mapping (cs_map) + +Notice also that in the trivial-RHS case we leave behind a binding + x = y +even though we /also/ carry a substitution x -> y. Can we just drop +the binding instead? Well, not at top level! See SimplUtils +Note [Top level and postInlineUnconditionally]; and in any case CSE +applies only to the /bindings/ of the program, and we leave it to the +simplifier to propate effects to the RULES. Finally, it doesn't seem +worth the effort to discard the nested bindings because the simplifier +will do it next. Note [CSE for case expressions] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -104,7 +113,7 @@ Consider case scrut_expr of x { ...alts... } This is very like a strict let-binding let !x = scrut_expr in ... -So we use (cseRhs x scrut_expr) to process scrut_expr and x, and as a +So we use (addBinding x scrut_expr) to process scrut_expr and x, and as a result all the stuff under Note [CSE for bindings] applies directly. For example: @@ -119,7 +128,7 @@ For example: want to keep it as (wild1:as), but for CSE purpose that's a bad idea. - By using cseRhs we add the binding (wild1 -> a) to the substitution, + By using addBinding we add the binding (wild1 -> a) to the substitution, which does exactly the right thing. (Notice this is exactly backwards to what the simplifier does, which @@ -130,7 +139,7 @@ For example: * Non-trivial scrutinee case (f x) of y { pat -> ...let y = f x in ... } - By using cseRhs we'll add (f x :-> y) to the cs_map, and + By using addBinding we'll add (f x :-> y) to the cs_map, and thereby CSE the inner (f x) to y. Note [CSE for INLINE and NOINLINE] @@ -223,7 +232,7 @@ a case where we had This is a vanishingly strange corner case, but we still have to check. -We do the check in cseRhs, but it can't fire when cseRhs is called +We do the check in addBinding, but it can't fire when addBinding is called from a let-binding, because they are always ok-for-speculation. Never mind! @@ -240,11 +249,11 @@ cseProgram binds = snd (mapAccumL cseBind emptyCSEnv binds) cseBind :: CSEnv -> CoreBind -> (CSEnv, CoreBind) cseBind env (NonRec b e) - = (env2, NonRec b2 e2) + = (env2, NonRec b2 e1) where - e1 = tryForCSE env e - (env1, b1) = addBinder env b - (env2, (b2, e2)) = addBinding env1 b b1 e1 + e1 = tryForCSE env e + (env1, b1) = addBinder env b + (env2, b2) = addBinding env1 b b1 e1 cseBind env (Rec pairs) = (env2, Rec pairs') @@ -253,19 +262,22 @@ cseBind env (Rec pairs) (env1, bndrs1) = addRecBinders env bndrs rhss1 = map (tryForCSE env1) rhss -- Process rhss in extended env1 - (env2, pairs') = mapAccumL cse_rhs env1 (zip3 bndrs bndrs1 rhss1) - cse_rhs env (b, b1, e1) = addBinding env b b1 e1 + (env2, pairs') = foldl do_one (env1, []) (zip3 bndrs bndrs1 rhss1) + do_one (env, pairs) (b, b1, e1) + = (env1, (b2, e1) : pairs) + where + (env1, b2) = addBinding env b b1 e1 addBinding :: CSEnv -- Includes InId->OutId cloning -> InId -> OutId -> OutExpr -- Processed binding - -> (CSEnv, (OutId, OutExpr)) -- Final env and binding + -> (CSEnv, OutId) -- Final env, final bndr -- Extend the CSE env with a mapping [rhs -> out-id] -- unless we can instead just substitute [in-id -> rhs] addBinding env in_id out_id rhs' - | no_cse = (env, (out_id, rhs')) - | ok_to_subst = (extendCSSubst env in_id rhs', (out_id, rhs')) - | otherwise = (extendCSEnv env rhs' id_expr', (zapped_id, rhs')) + | no_cse = (env, out_id) + | ok_to_subst = (extendCSSubst env in_id rhs', out_id) + | otherwise = (extendCSEnv env rhs' id_expr', zapped_id) where id_expr' = varToCoreExpr out_id zapped_id = zapIdUsageInfo out_id @@ -309,22 +321,22 @@ tryForCSE env expr -- useful in practice, but upholds our semantics. cseExpr :: CSEnv -> InExpr -> OutExpr -cseExpr env (Type t) = Type (substTy (csEnvSubst env) t) -cseExpr env (Coercion c) = Coercion (substCo (csEnvSubst env) c) -cseExpr _ (Lit lit) = Lit lit -cseExpr env (Var v) = lookupSubst env v -cseExpr env (App f a) = App (cseExpr env f) (tryForCSE env a) -cseExpr env (Tick t e) = Tick t (cseExpr env e) -cseExpr env (Cast e co) = Cast (cseExpr env e) (substCo (csEnvSubst env) co) -cseExpr env (Lam b e) = let (env', b') = addBinder env b - in Lam b' (cseExpr env' e) -cseExpr env (Let bind e) = let (env', bind') = cseBind env bind - in Let bind' (cseExpr env' e) -cseExpr env (Case e bndr ty alts) = cseCase env e bndr ty alts +cseExpr env (Type t) = Type (substTy (csEnvSubst env) t) +cseExpr env (Coercion c) = Coercion (substCo (csEnvSubst env) c) +cseExpr _ (Lit lit) = Lit lit +cseExpr env (Var v) = lookupSubst env v +cseExpr env (App f a) = App (cseExpr env f) (tryForCSE env a) +cseExpr env (Tick t e) = Tick t (cseExpr env e) +cseExpr env (Cast e co) = Cast (cseExpr env e) (substCo (csEnvSubst env) co) +cseExpr env (Lam b e) = let (env', b') = addBinder env b + in Lam b' (cseExpr env' e) +cseExpr env (Let bind e) = let (env', bind') = cseBind env bind + in Let bind' (cseExpr env' e) +cseExpr env (Case e bndr ty alts) = cseCase env e bndr ty alts cseCase :: CSEnv -> InExpr -> InId -> InType -> [InAlt] -> OutExpr cseCase env scrut bndr ty alts - = Case scrut2 bndr3 ty (map cse_alt alts) + = Case scrut1 bndr3 ty (map cse_alt alts) where scrut1 = tryForCSE env scrut @@ -332,8 +344,8 @@ cseCase env scrut bndr ty alts -- Zapping the OccInfo is needed because the extendCSEnv -- in cse_alt may mean that a dead case binder -- becomes alive, and Lint rejects that - (env1, bndr2) = addBinder env bndr1 - (alt_env, (bndr3, scrut2)) = addBinding env1 bndr bndr2 scrut1 + (env1, bndr2) = addBinder env bndr1 + (alt_env, bndr3) = addBinding env1 bndr bndr2 scrut1 -- addBinding: see Note [CSE for case expressions] con_target :: OutExpr From git at git.haskell.org Thu Jan 5 08:52:37 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 5 Jan 2017 08:52:37 +0000 (UTC) Subject: [commit: ghc] master: Ensure nested binders have Internal Names (baf9ebe) Message-ID: <20170105085237.1F8573A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/baf9ebe55a51827c0511b3a670e60b9bb3617ab5/ghc >--------------------------------------------------------------- commit baf9ebe55a51827c0511b3a670e60b9bb3617ab5 Author: Simon Peyton Jones Date: Wed Jan 4 17:47:13 2017 +0000 Ensure nested binders have Internal Names This is a long-standing bug. A nested (non-top-level) binder in Core should not have an External Name, like M.x. But - Lint was not checking this invariant - The desugarer could generate programs that failed the invariant. An example is in tests/deSugar/should_compile/T13043, which had let !_ = M.scState in ... This desugared to let ds = case M.scSate of M.scState { DEFAULT -> () } in case ds of () -> ... We were wrongly re-using that scrutinee as a case binder. And Trac #13043 showed that could ultimately lead to two top-level bindings with the same closure name. Alas! - The desugarer had one other place (in DsUtils.mkCoreAppDs) that could generate bogus code This patch fixes all three bugs, and adds a regression test. >--------------------------------------------------------------- baf9ebe55a51827c0511b3a670e60b9bb3617ab5 compiler/coreSyn/CoreLint.hs | 61 ++++++++++++------------ compiler/deSugar/DsUtils.hs | 11 +++-- compiler/deSugar/Match.hs | 44 +++++++++++------ testsuite/tests/deSugar/should_compile/T13043.hs | 28 +++++++++++ testsuite/tests/deSugar/should_compile/all.T | 1 + 5 files changed, 94 insertions(+), 51 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc baf9ebe55a51827c0511b3a670e60b9bb3617ab5 From git at git.haskell.org Thu Jan 5 14:14:33 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 5 Jan 2017 14:14:33 +0000 (UTC) Subject: [commit: ghc] branch 'wip/T9291' deleted Message-ID: <20170105141433.C741F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Deleted branch: wip/T9291 From git at git.haskell.org Thu Jan 5 14:14:38 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 5 Jan 2017 14:14:38 +0000 (UTC) Subject: [commit: ghc] master: Add a CSE pass to Stg (#9291) (19d5c73) Message-ID: <20170105141438.2235B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/19d5c7312bf0ad9ae764168132aecf3696d5410b/ghc >--------------------------------------------------------------- commit 19d5c7312bf0ad9ae764168132aecf3696d5410b Author: Joachim Breitner Date: Thu Dec 15 10:57:43 2016 -0800 Add a CSE pass to Stg (#9291) This CSE pass only targets data constructor applications. This is probably the best we can do, as function calls and primitive operations might have side-effects. Introduces the flag -fstg-cse, enabled by default with -O for now. It might also be a good candiate for -O2. Differential Revision: https://phabricator.haskell.org/D2871 >--------------------------------------------------------------- 19d5c7312bf0ad9ae764168132aecf3696d5410b compiler/basicTypes/Id.hs | 6 + compiler/basicTypes/Var.hs | 19 + compiler/coreSyn/CoreSyn.hs | 8 - compiler/coreSyn/TrieMap.hs | 6 +- compiler/ghc.cabal.in | 1 + compiler/main/DynFlags.hs | 3 + compiler/simplStg/SimplStg.hs | 30 +- compiler/simplStg/StgCse.hs | 427 +++++++++++++++++++++ compiler/simplStg/UnariseStg.hs | 5 - compiler/stgSyn/StgSyn.hs | 24 +- docs/users_guide/using-optimisation.rst | 8 + testsuite/tests/{ado => simplStg}/Makefile | 0 .../should_run}/Makefile | 0 testsuite/tests/simplStg/should_run/T9291.hs | 58 +++ .../should_run/T9291.stdout} | 1 + testsuite/tests/simplStg/should_run/all.T | 12 + 16 files changed, 578 insertions(+), 30 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 19d5c7312bf0ad9ae764168132aecf3696d5410b From git at git.haskell.org Thu Jan 5 22:01:47 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 5 Jan 2017 22:01:47 +0000 (UTC) Subject: [commit: ghc] master: Remove single top-level section in Foldable docs (5797784) Message-ID: <20170105220147.4BBCF3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5797784c78397b9bf407b0d4c0757791f0b552ce/ghc >--------------------------------------------------------------- commit 5797784c78397b9bf407b0d4c0757791f0b552ce Author: Chris Martin Date: Thu Jan 5 16:25:17 2017 -0500 Remove single top-level section in Foldable docs This fixes a mild annoyance in the haddock output for Data.Foldable. The section outline had a single top-level heading, which doesn't serve any purpose as far as I can tell. Reviewers: austin, hvr, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2922 >--------------------------------------------------------------- 5797784c78397b9bf407b0d4c0757791f0b552ce libraries/base/Data/Foldable.hs | 13 ++++++------- 1 file changed, 6 insertions(+), 7 deletions(-) diff --git a/libraries/base/Data/Foldable.hs b/libraries/base/Data/Foldable.hs index 6ad549f..ce097df 100644 --- a/libraries/base/Data/Foldable.hs +++ b/libraries/base/Data/Foldable.hs @@ -21,23 +21,22 @@ ----------------------------------------------------------------------------- module Data.Foldable ( - -- * Folds Foldable(..), - -- ** Special biased folds + -- * Special biased folds foldrM, foldlM, - -- ** Folding actions - -- *** Applicative actions + -- * Folding actions + -- ** Applicative actions traverse_, for_, sequenceA_, asum, - -- *** Monadic actions + -- ** Monadic actions mapM_, forM_, sequence_, msum, - -- ** Specialized folds + -- * Specialized folds concat, concatMap, and, @@ -46,7 +45,7 @@ module Data.Foldable ( all, maximumBy, minimumBy, - -- ** Searches + -- * Searches notElem, find ) where From git at git.haskell.org Thu Jan 5 22:01:44 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 5 Jan 2017 22:01:44 +0000 (UTC) Subject: [commit: ghc] master: Fix doctests in Data.Functor (5ef956e) Message-ID: <20170105220144.86E073A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5ef956e137b35cd53dba3db2f475e97d442b1ba9/ghc >--------------------------------------------------------------- commit 5ef956e137b35cd53dba3db2f475e97d442b1ba9 Author: Oleg Grenrus Date: Thu Jan 5 16:25:29 2017 -0500 Fix doctests in Data.Functor Reviewers: austin, hvr, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2920 GHC Trac Issues: #11551 >--------------------------------------------------------------- 5ef956e137b35cd53dba3db2f475e97d442b1ba9 libraries/base/Data/Functor.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/base/Data/Functor.hs b/libraries/base/Data/Functor.hs index 8eba29e..62bb709 100644 --- a/libraries/base/Data/Functor.hs +++ b/libraries/base/Data/Functor.hs @@ -27,7 +27,7 @@ import GHC.Base ( Functor(..), flip ) -- $setup -- Allow the use of Prelude in doctests. --- >>> import Prelude +-- >>> import Prelude hiding ((<$>)) infixl 4 <$> From git at git.haskell.org Thu Jan 5 22:01:50 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 5 Jan 2017 22:01:50 +0000 (UTC) Subject: [commit: ghc] master: Coerce for fmapDefault and foldMapDefault (5f91ac8) Message-ID: <20170105220150.064AA3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5f91ac89a38eb128d374a04c741bbd81c41fed37/ghc >--------------------------------------------------------------- commit 5f91ac89a38eb128d374a04c741bbd81c41fed37 Author: David Feuer Date: Thu Jan 5 16:25:37 2017 -0500 Coerce for fmapDefault and foldMapDefault Define `fmapDefault = coerce traverse` and `foldMapDefault = coerce traverse`. This ensures that we won't get unnecessary allocation and indirection when the arguments don't inline. Fixes #13058 Reviewers: ekmett, RyanGlScott, austin, hvr, bgamari Reviewed By: RyanGlScott Subscribers: simonpj, RyanGlScott, thomie Differential Revision: https://phabricator.haskell.org/D2916 GHC Trac Issues: #13058 >--------------------------------------------------------------- 5f91ac89a38eb128d374a04c741bbd81c41fed37 libraries/base/Data/Bitraversable.hs | 27 ++++++++++++++++++++++----- libraries/base/Data/Traversable.hs | 23 +++++++++++++++++++---- 2 files changed, 41 insertions(+), 9 deletions(-) diff --git a/libraries/base/Data/Bitraversable.hs b/libraries/base/Data/Bitraversable.hs index 19d4ba2..adabc6a 100644 --- a/libraries/base/Data/Bitraversable.hs +++ b/libraries/base/Data/Bitraversable.hs @@ -1,4 +1,5 @@ -{-# LANGUAGE Safe #-} +{-# LANGUAGE Trustworthy #-} +{-# LANGUAGE ScopedTypeVariables #-} ----------------------------------------------------------------------------- -- | @@ -28,6 +29,7 @@ module Data.Bitraversable import Control.Applicative import Data.Bifunctor import Data.Bifoldable +import Data.Coerce import Data.Functor.Identity (Identity(..)) import Data.Functor.Utils (StateL(..), StateR(..)) import GHC.Generics (K1(..)) @@ -217,14 +219,29 @@ bimapAccumR f g s t -- | A default definition of 'bimap' in terms of the 'Bitraversable' -- operations. -- +-- @'bimapDefault' f g ≡ +-- 'runIdentity' . 'bitraverse' ('Identity' . f) ('Identity' . g)@ +-- -- @since 4.10.0.0 -bimapDefault :: Bitraversable t => (a -> b) -> (c -> d) -> t a c -> t b d -bimapDefault f g = runIdentity . bitraverse (Identity . f) (Identity . g) +bimapDefault :: forall t a b c d . Bitraversable t + => (a -> b) -> (c -> d) -> t a c -> t b d +-- See Note [Function coercion] in Data.Functor.Utils. +bimapDefault = coerce + (bitraverse :: (a -> Identity b) + -> (c -> Identity d) -> t a c -> Identity (t b d)) +{-# INLINE bimapDefault #-} -- | A default definition of 'bifoldMap' in terms of the 'Bitraversable' -- operations. -- +-- @'bifoldMapDefault' f g ≡ +-- 'getConst' . 'bitraverse' ('Const' . f) ('Const' . g)@ +-- -- @since 4.10.0.0 -bifoldMapDefault :: (Bitraversable t, Monoid m) +bifoldMapDefault :: forall t m a b . (Bitraversable t, Monoid m) => (a -> m) -> (b -> m) -> t a b -> m -bifoldMapDefault f g = getConst . bitraverse (Const . f) (Const . g) +-- See Note [Function coercion] in Data.Functor.Utils. +bifoldMapDefault = coerce + (bitraverse :: (a -> Const m ()) + -> (b -> Const m ()) -> t a b -> Const m (t () ())) +{-# INLINE bifoldMapDefault #-} diff --git a/libraries/base/Data/Traversable.hs b/libraries/base/Data/Traversable.hs index 635fcde..c166db5 100644 --- a/libraries/base/Data/Traversable.hs +++ b/libraries/base/Data/Traversable.hs @@ -1,6 +1,7 @@ {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE Trustworthy #-} {-# LANGUAGE TypeOperators #-} @@ -53,6 +54,7 @@ module Data.Traversable ( -- It is convenient to use 'Const' here but this means we must -- define a few instances here which really belong in Control.Applicative import Control.Applicative ( Const(..), ZipList(..) ) +import Data.Coerce import Data.Either ( Either(..) ) import Data.Foldable ( Foldable ) import Data.Functor @@ -348,11 +350,24 @@ mapAccumR f s t = runStateR (traverse (StateR . flip f) t) s -- instance, provided that 'traverse' is defined. (Using -- `fmapDefault` with a `Traversable` instance defined only by -- 'sequenceA' will result in infinite recursion.) -fmapDefault :: Traversable t => (a -> b) -> t a -> t b +-- +-- @ +-- 'fmapDefault' f ≡ 'runIdentity' . 'traverse' ('Identity' . f) +-- @ +fmapDefault :: forall t a b . Traversable t + => (a -> b) -> t a -> t b {-# INLINE fmapDefault #-} -fmapDefault f = runIdentity . traverse (Identity . f) +-- See Note [Function coercion] in Data.Functor.Utils. +fmapDefault = coerce (traverse :: (a -> Identity b) -> t a -> Identity (t b)) -- | This function may be used as a value for `Data.Foldable.foldMap` -- in a `Foldable` instance. -foldMapDefault :: (Traversable t, Monoid m) => (a -> m) -> t a -> m -foldMapDefault f = getConst . traverse (Const . f) +-- +-- @ +-- 'foldMapDefault' f ≡ 'getConst' . 'traverse' ('Const' . f) +-- @ +foldMapDefault :: forall t m a . (Traversable t, Monoid m) + => (a -> m) -> t a -> m +{-# INLINE foldMapDefault #-} +-- See Note [Function coercion] in Data.Functor.Utils. +foldMapDefault = coerce (traverse :: (a -> Const m ()) -> t a -> Const m (t ())) From git at git.haskell.org Thu Jan 5 22:01:41 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 5 Jan 2017 22:01:41 +0000 (UTC) Subject: [commit: ghc] master: Use atomic counter for GHC.Event.Unique (5d2a92a) Message-ID: <20170105220141.CF1463A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5d2a92a1455349011568f18526b0d5d4ce51f692/ghc >--------------------------------------------------------------- commit 5d2a92a1455349011568f18526b0d5d4ce51f692 Author: alexbiehl Date: Tue Jan 3 10:59:39 2017 -0500 Use atomic counter for GHC.Event.Unique Reviewers: hvr, austin, bgamari Reviewed By: bgamari Subscribers: mpickering, thomie Differential Revision: https://phabricator.haskell.org/D2905 >--------------------------------------------------------------- 5d2a92a1455349011568f18526b0d5d4ce51f692 libraries/base/GHC/Event/PSQ.hs | 1 + libraries/base/GHC/Event/Unique.hs | 37 ++++++++++++++++--------------------- 2 files changed, 17 insertions(+), 21 deletions(-) diff --git a/libraries/base/GHC/Event/PSQ.hs b/libraries/base/GHC/Event/PSQ.hs index a4c0ccc..311265f 100644 --- a/libraries/base/GHC/Event/PSQ.hs +++ b/libraries/base/GHC/Event/PSQ.hs @@ -89,6 +89,7 @@ module GHC.Event.PSQ ) where import GHC.Base hiding (empty) +import GHC.Float () -- for Show Double instasnce import GHC.Num (Num(..)) import GHC.Show (Show(showsPrec)) import GHC.Event.Unique (Unique) diff --git a/libraries/base/GHC/Event/Unique.hs b/libraries/base/GHC/Event/Unique.hs index abdd3fe..0363af2 100644 --- a/libraries/base/GHC/Event/Unique.hs +++ b/libraries/base/GHC/Event/Unique.hs @@ -1,5 +1,6 @@ {-# LANGUAGE Trustworthy #-} -{-# LANGUAGE BangPatterns, GeneralizedNewtypeDeriving, NoImplicitPrelude #-} +{-# LANGUAGE BangPatterns, CPP, GeneralizedNewtypeDeriving, MagicHash, + NoImplicitPrelude, UnboxedTuples #-} module GHC.Event.Unique ( @@ -9,36 +10,30 @@ module GHC.Event.Unique , newUnique ) where -import Data.Int (Int64) import GHC.Base -import GHC.Conc.Sync (TVar, atomically, newTVarIO, readTVar, writeTVar) -import GHC.Num (Num(..)) -import GHC.Show (Show(..)) +import GHC.Num(Num) +import GHC.Show(Show(..)) --- We used to use IORefs here, but Simon switched us to STM when we --- found that our use of atomicModifyIORef was subject to a severe RTS --- performance problem when used in a tight loop from multiple --- threads: http://ghc.haskell.org/trac/ghc/ticket/3838 --- --- There seems to be no performance cost to using a TVar instead. +#include "MachDeps.h" -newtype UniqueSource = US (TVar Int64) +data UniqueSource = US (MutableByteArray# RealWorld) -newtype Unique = Unique { asInt64 :: Int64 } +newtype Unique = Unique { asInt :: Int } deriving (Eq, Ord, Num) -- | @since 4.3.1.0 instance Show Unique where - show = show . asInt64 + show = show . asInt newSource :: IO UniqueSource -newSource = US `fmap` newTVarIO 0 +newSource = IO $ \s -> + case newByteArray# size s of + (# s', mba #) -> (# s', US mba #) + where + !(I# size) = SIZEOF_HSINT newUnique :: UniqueSource -> IO Unique -newUnique (US ref) = atomically $ do - u <- readTVar ref - let !u' = u+1 - writeTVar ref u' - return $ Unique u' +newUnique (US mba) = IO $ \s -> + case fetchAddIntArray# mba 0# 1# s of + (# s', a #) -> (# s', Unique (I# a) #) {-# INLINE newUnique #-} - From git at git.haskell.org Fri Jan 6 10:52:50 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 6 Jan 2017 10:52:50 +0000 (UTC) Subject: [commit: ghc] master: Avoid exponential blowup in FamInstEnv.normaliseType (3540d1e) Message-ID: <20170106105250.7BC433A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3540d1e1a23926ce0a8a6ae83a36f5f6b2497ccf/ghc >--------------------------------------------------------------- commit 3540d1e1a23926ce0a8a6ae83a36f5f6b2497ccf Author: Simon Peyton Jones Date: Thu Jan 5 17:40:49 2017 +0000 Avoid exponential blowup in FamInstEnv.normaliseType Trac #13035 showed up a nasty case where we took exponentially long to normalise a (actually rather simple) type. Fortunately it was easy to fix: see Note [Normalisation and type synonyms]. >--------------------------------------------------------------- 3540d1e1a23926ce0a8a6ae83a36f5f6b2497ccf compiler/types/FamInstEnv.hs | 48 +++++-- testsuite/tests/perf/compiler/T13035.hs | 143 +++++++++++++++++++++ .../T5472.stdout => perf/compiler/T13035.stderr} | 0 testsuite/tests/perf/compiler/all.T | 11 ++ 4 files changed, 189 insertions(+), 13 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 3540d1e1a23926ce0a8a6ae83a36f5f6b2497ccf From git at git.haskell.org Fri Jan 6 10:52:53 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 6 Jan 2017 10:52:53 +0000 (UTC) Subject: [commit: ghc] master: Fix the implementation of the "push rules" (b4f2afe) Message-ID: <20170106105253.3F9A13A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b4f2afe70ddbd0576b4eba3f82ba1ddc52e9b3bd/ghc >--------------------------------------------------------------- commit b4f2afe70ddbd0576b4eba3f82ba1ddc52e9b3bd Author: Simon Peyton Jones Date: Fri Jan 6 09:35:37 2017 +0000 Fix the implementation of the "push rules" Richard pointed out (comment:12 of Trac #13025) that my implementation of the coercion "push rules", newly added in exprIsConAppMaybe by commit b4c3a66, wasn't quite right. But in fact that means that the implementation of those same rules in Simplify.simplCast was wrong too. Hence this commit: * Refactor the push rules so they are implemented in just one place (CoreSubst.pushCoArgs, pushCoTyArg, pushCoValArg) The code in Simplify gets simpler, which is nice. * Fix the bug that Richard pointed out (to do with hetero-kinded coercions) Then compiler performance worsened, which led mt do discover two performance bugs: * The smart constructor Coercion.mkNthCo didn't have a case for ForAllCos, which meant we stupidly build a complicated coercion where a simple one would do * In OptCoercion there was one place where we used CoherenceCo (the data constructor) rather than mkCoherenceCo (the smart constructor), which meant that the the stupid complicated coercion wasn't optimised away For reasons I don't fully understand, T5321Fun did 2% less compiler allocation after all this, which is good. >--------------------------------------------------------------- b4f2afe70ddbd0576b4eba3f82ba1ddc52e9b3bd compiler/coreSyn/CoreSubst.hs | 259 +++++++++++++++++++++++------------- compiler/simplCore/Simplify.hs | 84 ++++-------- compiler/types/Coercion.hs | 5 +- compiler/types/OptCoercion.hs | 2 +- testsuite/tests/perf/compiler/all.T | 5 +- 5 files changed, 202 insertions(+), 153 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc b4f2afe70ddbd0576b4eba3f82ba1ddc52e9b3bd From git at git.haskell.org Fri Jan 6 10:52:47 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 6 Jan 2017 10:52:47 +0000 (UTC) Subject: [commit: ghc] master: Use the right in-scope set (e6aefd6) Message-ID: <20170106105247.557083A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e6aefd6e07ef04d068d727490c640c68c82e4954/ghc >--------------------------------------------------------------- commit e6aefd6e07ef04d068d727490c640c68c82e4954 Author: Simon Peyton Jones Date: Thu Jan 5 17:39:08 2017 +0000 Use the right in-scope set I tripped over these calls to substTyWith that didn't obey the precondition about in-scope variables. Easily fixed, happily. >--------------------------------------------------------------- e6aefd6e07ef04d068d727490c640c68c82e4954 compiler/coreSyn/CoreLint.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/compiler/coreSyn/CoreLint.hs b/compiler/coreSyn/CoreLint.hs index 79e577a..1eacd73 100644 --- a/compiler/coreSyn/CoreLint.hs +++ b/compiler/coreSyn/CoreLint.hs @@ -1488,13 +1488,14 @@ lintCoercion (InstCo co arg) = do { (k3, k4, t1',t2', r) <- lintCoercion co ; (k1',k2',s1,s2, r') <- lintCoercion arg ; lintRole arg Nominal r' + ; in_scope <- getInScope ; case (splitForAllTy_maybe t1', splitForAllTy_maybe t2') of (Just (tv1,t1), Just (tv2,t2)) | k1' `eqType` tyVarKind tv1 , k2' `eqType` tyVarKind tv2 -> return (k3, k4, - substTyWith [tv1] [s1] t1, - substTyWith [tv2] [s2] t2, r) + substTyWithInScope in_scope [tv1] [s1] t1, + substTyWithInScope in_scope [tv2] [s2] t2, r) | otherwise -> failWithL (text "Kind mis-match in inst coercion") _ -> failWithL (text "Bad argument of inst") } From git at git.haskell.org Fri Jan 6 14:37:07 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 6 Jan 2017 14:37:07 +0000 (UTC) Subject: [commit: ghc] master: Add performance test for #13056 (5088110) Message-ID: <20170106143707.AFF8A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/508811004d1806b28a91c3ff4a5c2247e2ad4655/ghc >--------------------------------------------------------------- commit 508811004d1806b28a91c3ff4a5c2247e2ad4655 Author: Ryan Scott Date: Wed Jan 4 13:57:25 2017 -0500 Add performance test for #13056 This performance regression was fixed by commit 517d03e41b4f5c144d1ad684539340421be2be2a (#12234). Let's add a performance test to ensure that it doesn't break again. >--------------------------------------------------------------- 508811004d1806b28a91c3ff4a5c2247e2ad4655 testsuite/tests/perf/compiler/T13056.hs | 26 ++++++++++++++++++++++++++ testsuite/tests/perf/compiler/all.T | 11 ++++++++++- 2 files changed, 36 insertions(+), 1 deletion(-) diff --git a/testsuite/tests/perf/compiler/T13056.hs b/testsuite/tests/perf/compiler/T13056.hs new file mode 100644 index 0000000..046e1b0 --- /dev/null +++ b/testsuite/tests/perf/compiler/T13056.hs @@ -0,0 +1,26 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE DeriveFoldable #-} + +module Bug where +import Data.Typeable +import GHC.Generics +import Data.Data + +data Condition v = Condition + deriving (Functor, Foldable) + +data CondTree v c a = CondNode + { condTreeData :: a + , condTreeConstraints :: c + , condTreeComponents :: [CondBranch v c a] + } + deriving (Functor, Foldable) + +data CondBranch v c a = CondBranch + { condBranchCondition :: Condition v + , condBranchIfTrue :: CondTree v c a + , condBranchIfFalse :: Maybe (CondTree v c a) + } + deriving (Functor, Foldable) diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T index c9ed905..3b5e5bf 100644 --- a/testsuite/tests/perf/compiler/all.T +++ b/testsuite/tests/perf/compiler/all.T @@ -902,7 +902,6 @@ test('T12234', compile, ['']) - test('T13035', [ only_ways(['normal']), compiler_stats_num_field('bytes allocated', @@ -912,3 +911,13 @@ test('T13035', ], compile, [''] ) + +test('T13056', + [ only_ways(['optasm']), + compiler_stats_num_field('bytes allocated', + [(wordsize(64), 520166912, 5), + # 2017-01-06 520166912 initial + ]), + ], + compile, + ['-O1']) From git at git.haskell.org Fri Jan 6 14:41:10 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 6 Jan 2017 14:41:10 +0000 (UTC) Subject: [commit: ghc] branch 'wip/T13056' deleted Message-ID: <20170106144110.73FE83A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Deleted branch: wip/T13056 From git at git.haskell.org Fri Jan 6 14:41:29 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 6 Jan 2017 14:41:29 +0000 (UTC) Subject: [commit: ghc] branch 'wip/T5642' deleted Message-ID: <20170106144129.3E8E03A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Deleted branch: wip/T5642 From git at git.haskell.org Fri Jan 6 15:53:57 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 6 Jan 2017 15:53:57 +0000 (UTC) Subject: [commit: ghc] master: More fixes for #5654 (3a18baf) Message-ID: <20170106155357.4CE073A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3a18baff06abc193569b1b76358da26375b3c8d6/ghc >--------------------------------------------------------------- commit 3a18baff06abc193569b1b76358da26375b3c8d6 Author: Simon Marlow Date: Tue Dec 20 14:32:11 2016 +0000 More fixes for #5654 * In stg_ap_0_fast, if we're evaluating a thunk, the thunk might evaluate to a function in which case we may have to adjust its CCS. * The interpreter has its own implementation of stg_ap_0_fast, so we have to do the same shenanigans with creating empty PAPs and copying PAPs there. * GHCi creates Cost Centres as children of CCS_MAIN, which enterFunCCS() wrongly assumed to imply that they were CAFs. Now we use the is_caf flag for this, which we have to correctly initialise when we create a Cost Centre in GHCi. >--------------------------------------------------------------- 3a18baff06abc193569b1b76358da26375b3c8d6 includes/stg/MiscClosures.h | 1 + rts/Apply.cmm | 27 ++++++++ rts/Interpreter.c | 72 ++++++++++++++++++++-- rts/Printer.c | 5 ++ rts/Profiling.c | 6 +- rts/StgMiscClosures.cmm | 10 +++ testsuite/tests/codeGen/should_run/cgrun057.stderr | 2 +- .../tests/profiling/should_run/T680.prof.sample | 65 ++++++++++--------- testsuite/tests/profiling/should_run/all.T | 3 +- .../should_run/toplevel_scc_1.prof.sample | 41 ++++++------ 10 files changed, 170 insertions(+), 62 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 3a18baff06abc193569b1b76358da26375b3c8d6 From git at git.haskell.org Fri Jan 6 16:25:48 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 6 Jan 2017 16:25:48 +0000 (UTC) Subject: [commit: ghc] branch 'wip/rwbarton-large-tuple' created Message-ID: <20170106162548.EECAF3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/rwbarton-large-tuple Referencing: 83003dea51dabee93a27afad95d5aacf57dbd351 From git at git.haskell.org Fri Jan 6 16:25:52 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 6 Jan 2017 16:25:52 +0000 (UTC) Subject: [commit: ghc] wip/rwbarton-large-tuple: WIP: Move large tuples to a new module GHC.LargeTuple (83003de) Message-ID: <20170106162552.8177E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rwbarton-large-tuple Link : http://ghc.haskell.org/trac/ghc/changeset/83003dea51dabee93a27afad95d5aacf57dbd351/ghc >--------------------------------------------------------------- commit 83003dea51dabee93a27afad95d5aacf57dbd351 Author: Reid Barton Date: Fri Jan 6 11:23:37 2017 -0500 WIP: Move large tuples to a new module GHC.LargeTuple Goal is to avoid reading its interface file for programs that don't use large tuples, so we can add instances for large tuples without affecting compiler performance in the common case. >--------------------------------------------------------------- 83003dea51dabee93a27afad95d5aacf57dbd351 compiler/main/Constants.hs | 3 + compiler/prelude/PrelNames.hs | 3 +- compiler/prelude/TysWiredIn.hs | 7 +- .../GHC/Tuple.hs => base/GHC/LargeTuple.hs} | 100 ++++++----- libraries/base/base.cabal | 1 + libraries/ghc-prim/GHC/Tuple.hs | 200 +-------------------- 6 files changed, 70 insertions(+), 244 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 83003dea51dabee93a27afad95d5aacf57dbd351 From git at git.haskell.org Fri Jan 6 16:34:37 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 6 Jan 2017 16:34:37 +0000 (UTC) Subject: [commit: ghc] wip/all-inlinable: Inline work start (4e3fc82) Message-ID: <20170106163437.ABAEE3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/all-inlinable Link : http://ghc.haskell.org/trac/ghc/changeset/4e3fc8264c40c312595d664e47b81aa9066cb58b/ghc >--------------------------------------------------------------- commit 4e3fc8264c40c312595d664e47b81aa9066cb58b Author: Matthew Pickering Date: Sat Aug 6 22:17:09 2016 +0100 Inline work start >--------------------------------------------------------------- 4e3fc8264c40c312595d664e47b81aa9066cb58b compiler/deSugar/DsBinds.hs | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/compiler/deSugar/DsBinds.hs b/compiler/deSugar/DsBinds.hs index bb1dc50..bb15c95 100644 --- a/compiler/deSugar/DsBinds.hs +++ b/compiler/deSugar/DsBinds.hs @@ -361,7 +361,11 @@ makeCorePair :: DynFlags -> Id -> Bool -> Arity -> CoreExpr -> (Id, CoreExpr) makeCorePair dflags gbl_id is_default_method dict_arity rhs | is_default_method -- Default methods are *always* inlined = (gbl_id `setIdUnfolding` mkCompulsoryUnfolding rhs, rhs) - + | (isId gbl_id) && + (isEmptyInlineSpec inline_spec) && + (isOverloadedTy (idType gbl_id)) + = (gbl_id `setIdUnfolding` inlinable_unf, rhs) + -- Expose unfolding of overloaded function if we know no better | otherwise = case inlinePragmaSpec inline_prag of EmptyInlineSpec -> (gbl_id, rhs) @@ -371,6 +375,7 @@ makeCorePair dflags gbl_id is_default_method dict_arity rhs where inline_prag = idInlinePragma gbl_id + inline_spec = inlinePragmaSpec inline_prag inlinable_unf = mkInlinableUnfolding dflags rhs inline_pair | Just arity <- inlinePragmaSat inline_prag From git at git.haskell.org Fri Jan 6 16:34:43 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 6 Jan 2017 16:34:43 +0000 (UTC) Subject: [commit: ghc] wip/all-inlinable: tidy (95dcb8b) Message-ID: <20170106163443.07CCD3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/all-inlinable Link : http://ghc.haskell.org/trac/ghc/changeset/95dcb8bfedbd6fef7e0cbf71777f3b483d574969/ghc >--------------------------------------------------------------- commit 95dcb8bfedbd6fef7e0cbf71777f3b483d574969 Author: Matthew Pickering Date: Fri Jan 6 13:04:34 2017 +0000 tidy >--------------------------------------------------------------- 95dcb8bfedbd6fef7e0cbf71777f3b483d574969 compiler/deSugar/DsBinds.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/deSugar/DsBinds.hs b/compiler/deSugar/DsBinds.hs index 6ebfc59..bb1dc50 100644 --- a/compiler/deSugar/DsBinds.hs +++ b/compiler/deSugar/DsBinds.hs @@ -361,6 +361,7 @@ makeCorePair :: DynFlags -> Id -> Bool -> Arity -> CoreExpr -> (Id, CoreExpr) makeCorePair dflags gbl_id is_default_method dict_arity rhs | is_default_method -- Default methods are *always* inlined = (gbl_id `setIdUnfolding` mkCompulsoryUnfolding rhs, rhs) + | otherwise = case inlinePragmaSpec inline_prag of EmptyInlineSpec -> (gbl_id, rhs) @@ -370,7 +371,6 @@ makeCorePair dflags gbl_id is_default_method dict_arity rhs where inline_prag = idInlinePragma gbl_id - inline_spec = inlinePragmaSpec inline_prag inlinable_unf = mkInlinableUnfolding dflags rhs inline_pair | Just arity <- inlinePragmaSat inline_prag From git at git.haskell.org Fri Jan 6 16:34:45 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 6 Jan 2017 16:34:45 +0000 (UTC) Subject: [commit: ghc] wip/all-inlinable: missing import (ea6a686) Message-ID: <20170106163445.B0AAA3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/all-inlinable Link : http://ghc.haskell.org/trac/ghc/changeset/ea6a6863438e61b2c39194a8916f0fc3948ed33d/ghc >--------------------------------------------------------------- commit ea6a6863438e61b2c39194a8916f0fc3948ed33d Author: Matthew Pickering Date: Fri Jan 6 13:08:39 2017 +0000 missing import >--------------------------------------------------------------- ea6a6863438e61b2c39194a8916f0fc3948ed33d compiler/main/TidyPgm.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/compiler/main/TidyPgm.hs b/compiler/main/TidyPgm.hs index 5896bb0..fbce726 100644 --- a/compiler/main/TidyPgm.hs +++ b/compiler/main/TidyPgm.hs @@ -61,6 +61,7 @@ import Outputable import UniqDFM import SrcLoc import qualified ErrUtils as Err +import TcType ( isOverloadedTy ) import Control.Monad import Data.Function From git at git.haskell.org Fri Jan 6 16:34:40 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 6 Jan 2017 16:34:40 +0000 (UTC) Subject: [commit: ghc] wip/all-inlinable: Always expose unfoldings for overloaded functions. (e408eab) Message-ID: <20170106163440.5A0C63A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/all-inlinable Link : http://ghc.haskell.org/trac/ghc/changeset/e408eab02db3592f04397714ef8bf44a6a2ace50/ghc >--------------------------------------------------------------- commit e408eab02db3592f04397714ef8bf44a6a2ace50 Author: Matthew Pickering Date: Fri Jan 6 12:55:07 2017 +0000 Always expose unfoldings for overloaded functions. Summary: Users expect their overloaded functions to be specialised at call sites, however, this is only the case if they are either lucky and GHC chooses to include the unfolding or they mark their definition with an INLINABLE pragma. This leads to library authors marking all their functions with `INLINABLE` (or more accurately `INLINE`) so they ensure that downstream consumers pay no cost for their abstraction. A more sensible default is to do this job for the library author and give more predictable guarantees about specialisation. Empirically, I compiled a selection of 1150 packages with (a similar) patch applied. The total size of the interface files before the patch was 519mb and after 634mb. On modern machines, I think this increase is justified for the result. Reviewers: simonpj, austin, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2929 >--------------------------------------------------------------- e408eab02db3592f04397714ef8bf44a6a2ace50 compiler/deSugar/DsBinds.hs | 5 ----- compiler/main/TidyPgm.hs | 4 +++- 2 files changed, 3 insertions(+), 6 deletions(-) diff --git a/compiler/deSugar/DsBinds.hs b/compiler/deSugar/DsBinds.hs index bb15c95..6ebfc59 100644 --- a/compiler/deSugar/DsBinds.hs +++ b/compiler/deSugar/DsBinds.hs @@ -361,11 +361,6 @@ makeCorePair :: DynFlags -> Id -> Bool -> Arity -> CoreExpr -> (Id, CoreExpr) makeCorePair dflags gbl_id is_default_method dict_arity rhs | is_default_method -- Default methods are *always* inlined = (gbl_id `setIdUnfolding` mkCompulsoryUnfolding rhs, rhs) - | (isId gbl_id) && - (isEmptyInlineSpec inline_spec) && - (isOverloadedTy (idType gbl_id)) - = (gbl_id `setIdUnfolding` inlinable_unf, rhs) - -- Expose unfolding of overloaded function if we know no better | otherwise = case inlinePragmaSpec inline_prag of EmptyInlineSpec -> (gbl_id, rhs) diff --git a/compiler/main/TidyPgm.hs b/compiler/main/TidyPgm.hs index 52137a4..5896bb0 100644 --- a/compiler/main/TidyPgm.hs +++ b/compiler/main/TidyPgm.hs @@ -738,6 +738,7 @@ addExternal expose_all id = (new_needed_ids, show_unfold) never_active = isNeverActive (inlinePragmaActivation (inlinePragInfo idinfo)) loop_breaker = isStrongLoopBreaker (occInfo idinfo) bottoming_fn = isBottomingSig (strictnessInfo idinfo) + is_overloaded = isOverloadedTy (idType id) -- Stuff to do with the Id's unfolding -- We leave the unfolding there even if there is a worker @@ -749,7 +750,8 @@ addExternal expose_all id = (new_needed_ids, show_unfold) || isStableSource src -- Always expose things whose -- source is an inline rule - + || is_overloaded -- Always expose overloaded things so that + -- they can be specialised at call sites. || not (bottoming_fn -- No need to inline bottom functions || never_active -- Or ones that say not to || loop_breaker -- Or that are loop breakers From git at git.haskell.org Fri Jan 6 16:34:58 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 6 Jan 2017 16:34:58 +0000 (UTC) Subject: [commit: ghc] wip/all-inlinable's head updated: missing import (ea6a686) Message-ID: <20170106163458.985983A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/all-inlinable' now includes: 947c8a5 Bump GHC HEAD's Version from 7.11 to 8.1 bb7f2e3 Address #11245: Ensure the non-matched list is always non-empty 25e4556 Various API Annotations fixes 75851bf fix ghci build on ArchUnknown targets 0579fe9 Improve exprIsBottom 5ba3caa Comments only 70eefbc Test Trac #11245 351dea4 Drop redundant `-D__GLASGOW_HASKELL__=...` flag eae40e1 Use 0/1 instead of YES/NO as `__GLASGOW_HASKELL_TH__` macro value 0d20737 Drop redundant/explicit `=1` in `-DFOO=1` flags 2f923ce Drop pre-AMP compatibility CPP conditionals 3c8cb7f Remove some redundant definitions/constraints 12ee511 Remove ghc-7.8 `-package-name`-compat handling 37945c1 Simplify -fcmm-sink handling for Parser.hs 6a010b9 Update haskeline submodule to latest snapshot 8afeaad travis: use GHC 7.10.3 dafeb51 Canonicalise `MonadPlus` instances b469b30 Minor fix of MonadFail instance for `ReadPrec` ab0d733 Update Cabal submodule, Fixes #11326 f3cc345 Add strictness for runRW# 0b8dc7d API Annotations: AnnTilde missing 78daabc mk/config.mk.in: drop unused CONF_CC_OPTS for ia64 f5ad1f0 AnnDotDot missing for Pattern Synonym export 256c2cf Test Trac #11336 0490fed Linker: ARM: Ensure that cache flush covers all symbol extras d159a51 Linker: ARM: Refactor relocation handling 48e0f9c Linker: Make debugging output a bit more readable 07d127a Linker: Use contiguous mmapping on ARM d935d20 Omit TEST=T10697_decided_3 WAY=ghci 1dbc8d9 Add test for #10379 04f3524 Linker: ARM: Don't change to BLX if jump needed veneer c7d84d2 Update .mailmap [skip ci] 7e599f5 Linker: Move helpers to #ifdef da0f043 Rewrite Haddocks for GHC.Base.const 5c10f5c users_guide: Add ghci-cmd directive 4c56ad3 Build system: delete ghc-pwd 0acdcf2 Avoid generating guards for CoPats if possible (Addresses #11276) 1a8b752 Add (failing) test case for #11347 1f526d2 Release notes: Mention remote GHCi cdeefa4 ghc.mk: Add reference to Trac #5987 77494fa Remove -Wtoo-many-guards from default flags (fixes #11316) e32a6e1 Add Cabal synopses and descriptions bbee3e1 StgCmmForeign: Push local register creation into code generation bd702f4 StgCmmForeign: Break up long line aa699b9 Extend ghc environment file features 4dc4b84 relnotes: Note dropped support for Windows XP and earlier 852b603 Restore old GHC generics behavior vis-à-vis Fixity cac0795 Change Template Haskell representation of GADTs. 89ba83d Bump Cabal and Haddock to fix #11308 7861a22 Add a note describing the protocol for adding a language extension f01eb54 Fall back on ghc-stage2 when using Windows' GHCi driver 568736d users guide: Add documentation for custom compile-time errors 5040686 users guide: Add links to release notes 47367e0 Rewrite announce file 0a04837 users guide: Tweak wording of RTS -Nmax description 0839a66 Remove unused export 3f98045 Tiny refactor 97c49e9 Spelling in a comment 290a553 Tidy up tidySkolemInfo 4dda4ed Comment wibble 29b4632 Inline solveTopConstraints dc97096 Refactor simpl_top 02c1c57 Use an Implication in 'deriving' error a5cea73 Turn AThing into ATcTyCon, in TcTyThing 9915b65 Make demand analysis understand catch 1ee9229 Test Trac #10625 c78fedd Typos in docs and comments 6be09e8 Enable stack traces with ghci -fexternal-interpreter -prof 09425cb Support for qRecover in TH with -fexternal-interpreter 6f2e722 User's Guide: injective type families section 0163427 Fix Template Haskell's handling of infix GADT constructors 1abb700 Improve GHC.Event.IntTable performance c33e7c2 Fix +RTS -h when compiling without -prof 10769a1 Rename the test-way prof_h to normal_h 47ccf4d Add a pointer to the relevant paper for InScopeSet 2bd05b8 Docs for stack traces in GHCi f7b45c3 Build system: fix `pwd` issues on Windows 1cdf12c Fix test for T9367 (Windows) a6c3289 users_guide: Use semantic directive/role for command line options 86d0657 users-guide: A few fixes 8f60fd4 docs: Fix DeriveAnyClass reference in release notes and ANNOUNCE 67b5cec user-guide: More semantic markup 0dc2308 user-guide/safe_haskell: Fix typos a84c21e Reject import declaration with semicolon in GHCi 831102f Parser: delete rule numbers + validate shift/reduce conlicts 4405f9d Add failing testcase for #10603 5cb236d fix -ddump-splices to parenthesize ((\x -> x) a) correctly fbd6de2 Add InjectiveTypeFamilies language extension 4c9620f TrieMap: Minor documentation fix b1c063b ghc.mk: Use Windows_Target instead of Windows_Host 8e0c658 Linker: Define ELF_64BIT for aarch64_HOST_ARCH 00c8076 fix typo causing compilation failure on SPARC (ArchSparc -> ArchSPARC) 6cb860a Add -prof stack trace to assert 3e796e1 A little closer to supporting breakpoints with -fexternal-interpreter 88d6d5a Use implicit CallStacks for ASSERT when available d44bc5c TemplateHaskell: revive isStrict, notStrict and unpacked ac3cf68 Add missing type representations e782e88 Add test for Data.Typeable.typeOf c3f9246 Print a message when loading a .ghci file. 6ea24af Handle over-applied custom type errors too. c313327 Minor improvement in CoreDump outputs: c73333a Minor code refactoring 61011b4 users-guide: Wibbles 91dcc65 GHC.Generics: Fix documentation f0c4e46 Add tests for #11391 b0641ad INSTALL.md: Mention -j and other wibbles 78a4c72 Rename InjectiveTypeFamilies to TypeFamilyDependencies 4dbc31b users-guide: Update language extension implications b355b8f users-guide: Add since annotations for language extensions 83c13c2 user-guide: Use ghc-flag for dump formatting flags fd686c4 API Annotations: use AnnValue for (~) db371c1 T11300: Fix test on windows 49e414a Remove lookup of sections by name instead use the index numbers as offsets 91f1c60 Fix #11015 with a nice note. 8959b03 ANNOUNCE: Mention powerpc code generator b90cac6 user-guide: Note Cabal version limitation faf3f96 users-guide: Fix cabal version number c6a3e22 Link command line libs to temp so e7eec3a Use XZ compression by default 7cf16aa Don't output manpage in same directory as source 756b228 Refactor lookupFixityRn-related code following D1744 67fc3f3 configure.ac: Export MAKECMD to build system 443bf04 Allow pattern synonyms which have several clauses. 165ae44 Expand type/kind synonyms in TyVars before deriving-related typechecking e6ca930 Fix #11355. d4af57f Test #11252 in ghci/scripts/T11252 d459f55 Fix #10872. 6c07f14 Fix #11311 3a7f204 Clarify topological sorting of spec vars in manual 39ea4b4 Fix #11254. bafbde7 Constrained types have kind * in validity check. 072191f Fix #11404 33950aa Tiny refactoring in TcUnify 80b4c71 Fix typo in error message (#11409) 3c6635e Fix #11405. 148a50b Fix some typos 3a1babd Work SourceText in for all integer literals 9308c73 Fix a number of subtle solver bugs 3b6a490 Add missing T11408.hs ae1c48c rts/posix: Fail with HEAPOVERFLOW when out of memory during mmap d1ce1aa users-guide: Clean manpage build artifacts and fix usage of clean-target b3eb8fa Complete operators properly 65b810b Show TYPE 'Lifted/TYPE 'Unlifted as */# in Show TypeRep instance f3a867e Add testcase for #11414 2fd407c validate: Use gz compression during bindist check a7b751d un-wire-in error, undefined, CallStack, and IP 5a62b6a Simplify API to tcMatchTys f02200f Layout only cb24e68 Fix typecheck of default associated type decls b7e5c30 White space only 6e0c0fd Improve debug printing/warnings ec8a188 Refactoring on IdInfo and system derived names 8e6a68d Add Trac #11427 to Note [Recursive superclasses] e2c7b7e Implement scoped type variables in pattern synonyms 8e50301 Test Trac #11379 5412899 Typo in comment 817dd92 Fixes to "make clean" for the iserv dir b8abd85 Replace calls to `ptext . sLit` with `text` 240ddd7 Switch from -this-package-key to -this-unit-id. cbc03f1 ghci: Kill global macros list d2ea7f9 Hide derived OccNames from user 38666bd user-guide: Delete errant fragment aff51af users-guide: Begin documenting --frontend 80265c4 Typos in comments 9d33adb Check InScopeSet in substTy and provide substTyUnchecked 713aa90 Re-export ghc-boot:GHC.Serialized as Serialized 952eda2 Fix IfaceType generation for TyCons without TyVars 975bdac T11266: Improve the test by adding more of the other problematic modules 514bac2 Fix combineIdenticalAlts 0373a84 Oops. Add missing close-comment 5cce095 Use (&&) instead of `if` in Ix derivation 84b0ebe Rework derivation of type representations for wired-in things 225afc4 Add test T9407 (Windows) 6ddc991 Update submodule stm + random 48d4bc5 substTy to substTyUnchecked to fix Travis build 1ce1371 MkId: Update OpenKind reference 2e65aae Add comments about tyCoVarsOfType e604e91 Comments only c572430 Re-add missing kind generalisation 6f95e23 Comments only b3ee37c Improve pretty-printing of UnivCo 07afe44 Remove the check_lifted check in TcValidity b2e6350 Strip casts in checkValidInstHead 395ec41 Allow implicit parameters in constraint synonyms ede055e TyCoRep: Restore compatibility with 7.10.1 f23b578 user-guide:: Improve -D description 928484d user-guide: Refer to MIN_VERSION_GLASGOW_HASKELL from intro 3883f99 rel-notes: Note the return of -Wmonomorphism-restriction 7cb893f Update and improve documentation in Data.Foldable 96303db Add a missing .gitignore entry in annotations tests 2ffc260 Add -ignore-dot-ghci to tests that use --interactive 4c4a0a5 Fix docstring GHC.IO.Handle.FD.openFileBLocking 4c11db6 sphinx-build: fix python stack overflow (Trac #10950) b617e9f Improve comments in CmmSwitch 85e147e Always run test T9407 36b174d Add expected stderr for #11466 test case adb721b Make a constraint synonym for repeated BinaryStringRep and use it. 835a2a2 Default non-canonical CallStack constraints 2df4221 Add tests for #11465 and the kind invariant 9048c3d Don't print "Loaded GHCi configuration" message in ghc -e (#11478) 65881c0 Mark some ghci tests as req_interp 6e5f828 Fix a formatting error in the user's guide 4d51bfc Do not count void arguments when considering a function for loopification. b01288d rts: Disable tick timer unless really needed 4e04043 Add test for Trac #11056 f42db15 Remove unused IND_PERM 06c2547 Small doc fix 7cd37c5 Give a more verbose error message when desugaring a HsTypeOut 8e9a870 Remove -Wredundant-superclasses from standard warnings 1be8491 mkUserGuidePart: Better flag cross-referencing 6f96109 user-guide: Reformat warning lists b5e52bf user-guide: Fix typos ec87788 Don't add ticks around type applications (#11329) 923d215 user-guide: Document -L RTS flag 89bdac7 Add test for #11473 8b5ea7c User's guide: fix singular/plural typo in flagnames 98d6a29 Docs: delete section on Hierarchical Modules edc68b2 Remove `replaceDynFlags` from `ContainsDynFlags` 2c6fe5b Add -fwarn-redundant-constrains to test for #9708 fd6dd41 Implement `-Wnoncanonical-monadfail-instances` warning ff21795 Special-case implicit params in superclass expansion 746764c Refactor validity checking for type/data instances 42c6263 Avoid recursive use of immSuperClasses f7e0e5f Improve tracing in checkValidInstance 3c060f3 Fix exprIsHNF (Trac #11248) 5c82333 Show error message for unknown symbol on Elf_Rel platforms edb30fd Comments only: more alternate names for ARM registers [skip ci] bc1e085 HscTypes: Fix typo in comment 132c208 Rename -Wmissing-monadfail-instance to plural-form 6e2658f Better document behavior of -Wmissed-specialisations 128b678 user-guide: Note order-dependence of flags f0f63b3 Implement -Wunrecognised-warning-flag 9fe7d20 Ensure that we don't produce code for pre-ARMv7 without barriers 632f020 Less verbose output for the in-scope set cf788a5 White space only 47b3f58 Add "ticks-exhausted" comment 1c6d70c Kill off zipTopTCvSubst in favour of zipOpenTCvSubst 016a0bd Fix two cloning-related bugs 34c9a4e Missed plural renaming in user's guide 5f5dc86 Minor users-guide markup fixup [skip ci] 9b71695 Update transformers submodule to 0.5.1.0 release f1885df Update process submodule to 1.4.2.0 release 3798b2a Fix three broken tests involving exceptions 01809bc Pass InScopeSet to substTy in lintTyApp e24a9b5 Nicer error on +RTS -hc without -rtsopts or -prof 6d2bdfd Fix segmentation fault when .prof file not writeable 6817703 Split off -Wunused-type-variables from -Wunused-matches 144ddb4 Construct in_scope set in mkTopTCvSubst eeb67c9 Testsuite: fixup req_profiling tests (#11496) e2bdf03 Build profiling libraries on `validate --slow` (#11496) 44a5d51 Enable RemoteGHCi on Windows 45fd83b Fix a typo in the note name in comments 448ea97 Typos in comments 1f6d142 ghci: fix trac issue #11481 1c6130d rts/Timer: Actually fix #9105 0dc7b36 Restore original alignment for info tables 0d92d9c Use stage1 build variables when building the RTS d50609e Test for undef bugs in the LLVM backend when validating 45c6fbc Document -fllvm-fill-undef-with-garbage 4faa1a6 s/unLifted/unlifted for consistency 2899aa5 Fix some substitution InScopeSets 00cbbab Refactor the typechecker to use ExpTypes. 5dcae88 Rename "open" subst functions 85daac5 Fix cost-centre-stack bug when creating new PAP (#5654) a496f82 Remote GHCi: create cost centre stacks in batches 71b1183 Update profiling test output 0d5ddad fix validate breakage 63700a1 Use the in_scope set in lint_app 1b72534 Fixup test for #10728 61e4d6b Mark dynamic-paper as expect_fail_for optasm and optllvm (#11330) d3b7db0 Fix the Windows build 0dd663b Add closing parenthesis in comment for eqString (#11507) bc83c73 Add release note about flexible RebindableSyntax bb956eb Add asserts to other substitution functions 6c7760b Define CTYPE for more Posix types 2fbf370 Update unix submodule to latest snapshot b61f5f7 Put docs in /usr/share/doc/ghc- 4d0e4fe Add type signatures. 90f688e Code formatting cleanup. 6544f8d Properly track live registers when saving the CCCS. 669cbef Fix Trac issue #11487. 34519f0 When encountering a duplicate symbol, show source of the first symbol f8e2b7e Minor doc fixes to GHC.Generics a883c1b Missing @since annotations in GHC.Generics e5a0a89 Suppress substitution assertions to fix tests 0d60165 Simplify ghc-boot database representation with new type class. 94048f9 Hide the CallStack implicit parameter 86897e1 Implement basic uniform warning set tower ba88aab Fix LOOKS_LIKE_PTR for 64-bit platforms 2ad46a8 Add some Outputable instances 02e3ce0 Typo in docs 7329310 Fix runtime linker error message when old symbol had no owner dd0b7c7 Avoid mangled/derived names in GHCi autocomplete (fixes #11328) ddd38e7 Update unix submodule to latest snapshot af8fdb9 TyCoRep: Implement some helpers for dropping/checking Levity arguments 2fb6a8c Remote GHCi: Optimize the serialization/deserialization of byte code 7cb1fae Remote GHCi: batch the creation of strings c996db5 Remote GHCi: parallelise BCO serialization 01c587c Fix Windows build after D1874 07ed241 Use a correct substitution in tcCheckPatSynDecl a7ad0b9 Make TypeError a newtype, add changelog entry db97ed9 Add (failing) test for #11247 871c96f TcMType: Add some elementary notes 92c46a4 Update cabal_macros_boot.h 483858e Update binary submodule to 0.8.2.0 release db121b2 Allow all RTS options to iserv 28f951e Overhaul the Overhauled Pattern Match Checker bbc0ec5 Fix a few loose ends from D1795 4f9967a Remove unused LiveVars and SRT fields of StgCase and StgLetNoEscape 91a56e9 Use default xz compression level 70980b1 GHCi: Fix Windows build (again) 8aa9f35 Fix @since annotations for renamed pretty{CallStack,SrcLoc} 38af3d1 Add a derived `Show SrcLoc` instance b49d509 Add test for #11516 5d73fb6 Revert "Remove unused LiveVars and SRT fields of StgCase and StgLetNoEscape" f1f5837 unlit: mark local functions as 'static' 72545c7 hp2ps: mark local functions as 'static' f3923d5 testsuite: ignore *.prof.normalised files 1060301 mkDocs: Update for xz c96acf3 mkDocs: Fix fallout from c5f4f95c64006a9f 66fa0ed validate: enable -DDEBUG in stage 1 by default 7362809 rts: drop unused calcLiveBlocks, calcLiveWords 9e43c7f rts: mark scavenge_mutable_list as static 4f283a6 rts: mark 'copied' as static 256c1b3 rts: drop unused getThreadCPUTime 3dbd836 rts: mark 'wakeBlockingQueue' as static 8abc7e7 rts: drop unused mut_user_time_during_heap_census 39cba20 rts: mark 'removeFromRunQueue' as static 7a48865 rts: mark 'setProgName' as static a49c9d4 rts: drop unused 'traverseAllRetainerSet' c358567 rts: mark 'blockedThrowTo' as static e1ca583 rts: mark 'ccs_mutex' and 'prof_arena' as static 0e51109 rts: drop unused 'traceEventThreadRunnable' 0a2bd9c rts: mark 'shutdownCapability' as static c0a0ee3 Fix haddocks for TypeError b3e9452 Bump haddock submodule 8263d09 Remove unused export from TcUnify 2cf3cac Allow foralls in instance decls 20f90ea Fix SimpleFail12 error output e2b66a0 user-guide: Add cross-reference for -XUnicodeSyntax 4e65301 Add Edward Kmett's example as a test case 6036cb6 Comments only, on the invariants of GlobalRdrEnv a96c4e7 Add comments to TcCoercibleFail ee11a84 White space and comments only 8871737 Document and improve superclass expansion e72665b Comment out some traceFlat calls 7212968 Improve tracing in TcInteract d6b68be Improve error messages for recursive superclasses f79b9ec Use runTcSDeriveds for simplifyDefault 6252b70 A small, local refactoring of TcSimplify.usefulToFloat 43e02d1 Fix a nasty superclass expansion bug 5a58634 release notes: Note new two-step allocator 96d4514 Some tiding up in TcGenDeriv fac0efc Define mkTvSubst, and use it c9ac9de Test Trac #11552 489a9a3 Define tyConRolesRepresentational and use it 023fc92 Remove unused LiveVars and SRT fields of StgCase da19c13 Print * has Unicode star with -fprint-unicode-syntax 16cf460 testsuite: Un-break T5642 4ec6141 Fix the removal of unnecessary stack checks 04fb781 Early error when crosscompiling + haddock/docs bfec4a6 Unset GREP_OPTIONS in build system 1f894f2 Restore derived Eq instance for SrcLoc c8702e3 TcErrors: Fix plural form of "instance" error 99cb627 TcPatSyn: Fix spelling of "pattern" in error message 7953b27 DynFlags: drop tracking of '-#include' flags 2f9931e add Template Haskell regression test for #9022. 93e2c8f Expand users' guide TH declaration groups section (#9813) d80caca Error early when you register with too old a version of Cabal. c57d019 docs: add newline after '.. ghc-flag::' a824972 mkUserGuide: fix option wrapping in a table b565830 Wrap solveEqualities in checkNoErrs d27da53 Replace mkTvSubstPrs (a `zip` b) with zipTvSubst a b 8500855 Always do eta-reduction 62d1888 Comments about ru_auto 023bf8d Ignore untracked in nofib 51a3392 sizeExpr: fix a bug in the size calculation 46af683 compiler: Do not suggest nor complete deprecated flags fix trac issue #11454 efba41e Another batch of typo fixes in non-code dbf72db Build the substitution correctly in piResultTy b7dfbb4 Add test for #11319 8da6a16 Revert "sizeExpr: fix a bug in the size calculation" be3d7f6 Add IsList instance for CallStack, restore Show instance for CallStack f3b9db3 Revert "Build the substitution correctly in piResultTy" c6485d5 Simplify AbsBinds wrapping 1251518 Beef up tc124 d084624 Improve pretty-printing of HsWrappers 24305be Minor refactoring to tauifyMultipleMatches 6cf9b06 User manual improvments f37bb54 testsuite: tweak error messages for new Show instance cd4a7d0 renamer discards name location for HsRecField 4bba19a Update directory submodule to v1.2.5.1 release 18cd712 Improve error message suppression bb7f230 Comments only 160765f Document -dynamic-too (#11488) f6b98ea Tiny refactor; use guards instead of 'if' 0057125 Comments and white space e2f7d77 A tiny, outright bug in tcDataFamInstDecl 023742e Add a testcase for #11362 426a25c Make T11361 actually run with reversed uniques 3c39bec Rename missing-pat-syn-sigs to missing-pat-syn-signatures ed69b21 Add missing newlines at end of file [skip ci] d066e68 Testsuite: delete only_compiler_types, assume ghc c8df3f1 Bump haddock submodule 525a304 Make bootstrapping more robust 693a54e Improved error message about exported type operators. af5a0e5 Fix two wrong uses of "data constructor" in error msgs 3116003 PowerPC: Improve float register assignment. 49c5cb4 Fix typos 5fc06b9 Suggest candidate instances in error message ad30c76 Remove documentation for -Wlazy-unlifted-bindings 2b906af DynFlags: Don't panic on incompatible Safe Haskell flags 6f25fb3 Testsuite: delete compiler_lt/le/gt/ge setup functions 34c9523 Comments only 21b4228 Simplify the defn of coreViewOneStarKind 4c6e95e Small refactor and comments b962bcc Make exactTyCoVarsOfTypes closed over kinds. 90f3561 Existentials should be specified. aff5bb4 Add missing kind cast to pure unifier. 7d8031b Remove extraneous fundeps on (~) 6f952f5 Use CoercionN and friends in TyCoRep 43468fe Fix #11241. 489e6ab Fix #11246. a615215 Fix #11313. 67d2226 Derive Eq and Ord instance for SrcLoc and RealSrcLoc a82956d Remove superfluous code when deriving Foldable/Traversable 525b54c users-guide: Fix typos 0c420cb Comments only (#11513) 27842ec Fix thinko that crept into D1908 01449eb Fix desugaring of bang-pattern let-bindings b529255 (Another) minor refactoring of substitutions 4d031cf Improve piResultTys and friends a008ead Take type-function arity into account 206a8bf Unwire Typeable representation types 0b68cbe Bump haddock submodule 8b073f6 A few more typos in non-code 2f733b3 Delete support for deprecated "-- # ..."-style haddock options d738e66 Modifier letter in middle of identifier is ok c6007fe Pass -haddock to tests in should_compile_*flag*_nohaddock a8653c8 Docs: no space in `-i⟨dir1⟩:⟨dir2⟩` [skip ci] 6cec905 Refactoring only: use ExprLStmt 3259bf6 Fix a bug in ApplicativeDo (#11612) 2340485 Fix a double-free bug in -fexternal-interpreter 80d35be Use a better test for profiling 1ef7add Add test (only) to assure that #11535 is fixed 9634e24 unexport MAKEFLAGS when running tests (#11569) 0b00add Add test for #6132: hash bang + CPP 6e691ca Testsuite: pass '-s --no-print-directory' to MAKE f451039 Build system: fix sed expression (#11537) bb9cd45 Fix GHC.Stats documentation markup (#11619) ed11909 Docs: -keep-llvm-file(s)/-ddump-llvm imply -fllvm d3cf2a9 Add missing files 31c312e Testsuite: delete Windows line endings [skip ci] (#11631) 8626ac9 Testsuite: delete Windows line endings [skip ci] (#11631) 754a2f2 Testsuite: delete Windows line endings [skip ci] (#11631) 6074c10 Testsuite: delete Windows line endings [skip ci] (#11631) d5e8b39 Testsuite: delete Windows line endings [skip ci] (#11631) 978c3ea Testsuite: accept output without Windows line endings (#11631) 42f06f6 Testsuite: accept output without Windows line endings (#11631) 28620ba Testsuite: delete Windows line endings [skip ci] (#11631) 6d0aa9f Testsuite: delete Windows line endings [skip ci] (#11631) 73e4095 Testsuite: cleanup profiling/should_run/all.T (#11521) 176be87 Filter out -prof callstacks from test output (#11521) 661aa07 Testsuite: failing profiling tests (#10037) 2aee419 Allow combining characters in identifiers (#7650) a3e0e93 Testsuite: MAKEFLAGS is magic, do not unexport it 32a9a7f Extend `-Wunrecognised-warning-flag` to cover `-f(no-)warn-*` ce36115 Follow-up to 32a9a7f514bdd33ff72a673ade d8c64e8 Address #11471 by putting RuntimeRep in kinds. a9dc62a Remove "use mask" from StgAlt syntax 009a999 TyCoRep: Add haddock sections c1efdcc Overload the static form to reduce verbosity. feb19ea testsuite: mark tests broken on powerpc64 8e19d3a base: A selection of fixes to the comments in GHC.Stats 0c7db61 ApplicativeDo: Handle terminal `pure` statements 6319a8c HscMain: Delete some unused code 673efcc Add more type class instances for GHC.Generics 6658491 Make warning names more consistent 52879d1 Reconstruct record expression in bidir pattern synonym ebaa638 Bump haddock.base allocations 073e20e cmpTypeX: Avoid kind comparison when possible 6739397 (Alternative way to) address #8710 6350eb1 Handle multiline named haddock comments properly e38c07b Improve accuracy of suggestion to use TypeApplications 20ab2ad Note new GHC.Generics instances in release notes 116528c Improve pattern synonym error messages (add `PatSynOrigin`) 8e6e022 Testsuite: Introduce config.plugin_way_flags. e02b8c8 Testsuite: for tests that use TH, omit *all* prof_ways 90fa8cf Mark tests for #11643, #11644, #11645 and #9406 expect_broken 9b49c65 Testsuite: delete empty files [skip ci] 1badf15 Testsuite: do not write empty files on 'make accept' bb5afd3 Print which warning-flag controls an emitted warning bbfff22 Unconditionally handle TH known key names. a026112 Typos in comments, etc. e3f341f Fix and refactor strict pattern bindings a81e9d5 Special case for desugaring AbsBinds 4ddfe13 Get the right in-scope set in specUnfolding 7496be5 Exclude TyVars from the constraint solver 253ccdf Comments and white space only b4dfe04 Fix kind generalisation for pattern synonyms e193f66 Filter out BuiltinRules in occurrence analysis ef7b1d5 Test Trac #11611 eee040c Update transformer submodule to v0.5.2.0 release 890e2bb GHC.Generics: Ensure some, many for U1 don't bottom 3ee4fc0 rts: drop unused global 'blackhole_queue' b9c697e Print which flag controls emitted desugaring warnings 869d9c6 Print which flag controls emitted lexer warnings 82f200b Annotate `[-Wredundant-constraints]` in warnings (re #10752) b6c61e3 Print which flag controls emitted SafeHaskell warnings 3cd4c9c Annotate `[-Wdeferred-type-errors]` in warnings (re #10752) 46f3775 Default to -fno-show-warning-groups (re #10752) 171d95d Missing Proxy instances, make U1 instance more Proxy-like ad4428d base: Mark Data.Type.Equality as Trustworthy 2535c82 Fix bug where reexports of wired-in packages don't work. f72bdbd Refactor `warnMissingSignatures` in `RnNames.hs` 16e97c1 Build system: Correctly pass `TARGETPLATFORM` as host 2e49a31 DynFlags: Add -Wredundant-constraints to -Wall e3b9dbf Testsuite: check actual_prof_file only when needed de01de7 Remove some more Windows line endings [skip ci] f8a5dd0 Only add -fshow-warning-groups for ghc >= 7.11 (#10752) 49c55e6 Skip TEST=TcCoercibleFail when compiler_debugged 3c29c77 Do not check synonym RHS for ambiguity 243e2ab Comments only 2d52c3a A bit more tracing in TcHsType.tcTyVar a0899b2 Remove unnecessary isTyVar tests in TcType 57b4c55 Don't complain about unused Rule binders 286dc02 Fix an outright bug in expandTypeSynonyms aea1e5d Use tyConArity rather than (length tvs) 91a6a9c Add Monoid instance for FastString 15517f3 SimplEnv: Add Haddock headings to export list 1f3d953 users-guide: Mention #11558 in release notes 120b9cd rts/timer: use timerfd_* on Linux instead of alarm signals 6ca9b15 GHCi: Fix load/reload space leaks (#4029) 3801262 Fix printing of an `IfacePatSyn` 1d6177b Using unsafe foreign import for rtsSupportsBoundThreads (part of #9696) bd681bc Drop module qualifier from punned record fields (#11662) ade1a46 Fix minimum alignment for StgClosure (Trac #11395) 5e2605e GhcMake: Clang/ASSERT fix 13a801a Revert "Mark tests for #11643, #11644, #11645 and #9406 expect_broken" 82e36ed Reduce fragmentation from m32_allocator 90e1e16 Split external symbol prototypes (EF_) (Trac #11395) 1a9734a template-haskell: Drop use of Rank2Types/PolymorphicComponents 941b8f5 template-haskell: remove redundant CPP use 1c76e16 template-haskell: define `MonadFail Q` instance 4c3a0a4 Fix the implementation of lazyId 5a494d8 Refactoring around TcPatSyn.tcPatToExpr 374f919 Update Cabal submodule to latest HEAD snapshot c42cdb7 fix Float/Double unreg cross-compilation fc16690 Fix #11624, cannot declare hs-boot if already one in scope. c937f42 Add regression test for #11555 a1c4230 Use catchException in a few more places 30ee910 Make `catch` lazy in the action f3def76 add regression test for #11145. 767ff7c Document Quasi-quotes/list comprehension ambiguity a74a384 Include version in AC_PACKAGE_TARNAME f8056fc Make integer-gmp operations more strict d48220e Add Note [Running splices in the Renamer] 90b8af0 Fix readme link to FixingBugs wiki page 06b70ff Add doc to (<$>) explaining its relationship to ($) 8626d76 rtx/posix/Itimer.c: Handle return value of `read` 6a2992d Add MonadUnique instance for LlvmM e764ede Add ghc-flag directory for -XPatternGuards 2908ae8 Handle unset HOME environment variable more gracefully 3ea11eb Move getOccFS to Name 7ba817c Bump allocations for T6048 2f45cf3 Add -foptimal-applicative-do e46742f rts: fix threadStackUnderflow type in cmm 4d791b4 Simplify: Make generated names more useful 41051dd ghci: add message when reusing compiled code #9887 92821ec LlvmCodeGen: Fix generation of malformed LLVM blocks 9ee51da users_guide: Break up -fprint-* description d12166a Fix the name of the Word16ElemRep wired-in datacon 3f60ce8 Add regression test for #11702 18fbfa3 Move and expand (slightly) TypeApplications docs e9bf7bb Fix #11407. 84c773e Fix #11334. 35d37ff Fix #11401. 972730c Refactor visible type application. 6c768fc Expand Note [Non-trivial definitional equality] 693b38c Test case for #11699 in typecheck/should_compile e7a8cb1 Document TypeInType (#11614) 55577a9 Fix #11648. 3f5d1a1 Allow eager unification with type families. de4df6b Testsuite wibbles from previous commits. 19be538 Remove redundant anonymiseTyBinders (#11648) 857e9b0 Incorporate bgamari's suggestions for #11614. 1eefedf Fix #11357. aade111 Fix #11473. f602f4a Fix printing of "kind" vs. "type" 5d98b8b Clean up some pretty-printing in errors. 46f9a47 DriverPipeline: Fix 'unused arguments' warnings from Clang b5565f1 Fix #11711. c5ed41c typechecker: fix trac issue #11708 3fe87aa Fix #11716. f4f315a Fix #11512 by getting visibility right for methods 220a0b9 Add test for #9646 3ddfcc9 PrelRules: Fix constant folding for WordRemOp 2841cca Mark GHC.Real.even and odd as INLINEABLE c095ec5 Ensure T11702 always runs with optasm c0f628d Revert "Add test for #11473" cb7ecda Fix duplicate T11334 test 08d254b Fix T9646 7186a01 Dwarf: Add support for labels in unwind expressions ba95f22 prof: Fix heap census for large ARR_WORDS (#11627) b735e99 DsExpr: Don't build/foldr huge lists 289d57a Add test for incompatible flags (issue #11580) cb3456d base: Rework System.CPUTime e6a44f2 T11145: Fix expected output 286c65f base: Fix CPUTime on Windows 3ade8bc Delete a misleading comment in TyCon 2cb5577 Remove unnecessary Ord instance for ConLike c37a583 Remove unused substTyWithBinders functions af2f7f9 Fix exponential algorithm in pure unifier. 01b29eb TypeApplications does not imply AllowAmbiguousTypes 0706a10 Add two small optimizations. (#11196) 1701255 Fix #11635 / #11719. 0b89064 Make equality print better. (#11712) f8ab575 Rename test for #11334 to 11334b, fixing conflict 3e1b882 Prevent eager unification with type families. 9477093 Comment a suspicious zonk in TcFlatten. 35e9379 Track specified/invisible more carefully. 5c0c751 Zonk before calling splitDepVarsOfType. d978c5e Fix #11723 and #11724. e19e58c Improve panicking output 1934f7f stgMallocBytes: Tolerate malloc(0) returning a NULL ptr 2d6d907 Comments (only) in TcFlatten 6f0e41d PPC NCG: Emit more portable `fcmpu 0, ...` instead of `fcmpu cr0, ...` 685398e Use the correct in-scope set in coercionKind 0beb82c Avoid running afoul of the zipTvSubst check. 7e74079 Comment fix 7d5ff3d Move applyTysX near piResultTys db9e4eb Move DFunUnfolding generation to TcInstDcls e57b9ff Fix regression test for #11145. 2ddfb75 base: Fix ClockGetTime on OS X da3b29b Ensure T9646 dump-simpl output is cleaned 8048d51 ErrUtils: Add timings to compiler phases 997312b Add `PatSynSigSkol` and modify `PatSynCtxt` 2708c22 Close ticky profiling file stream after printing (#9405) 03a1bb4 Add unicode syntax for banana brackets 6c2c853 Various ticky-related work 9f9345e Create empty dump files (fixes #10320) 0db0594 DsExpr: Rip out static/dynamic check in list desugaring 8335cc7 Add expected output for T9405 ef653f1 Revert "Various ticky-related work" 1448f8a Show: Restore redundant parentheses around records 371608f Default RuntimeRep variables unless -fprint-explicit-runtime-reps 0bd0c31 Defer inlining of Eq for primitive types 2b5929c Comments only cb08f8d Tidy up handling of coercion variables 343349d Avoid local label syntax for assembler on AIX 2cebbe6 users_guide: Fix various issues 8ff6518 users-guide: Add -Wredundant-constraints to flags reference 173a5d8 users_guide: small improvements on pattern synonyms. 2414952 Add option `no-keep-hi-files` and `no-keep-o-files` (fixes #4114) df26b95 Add NCG support for AIX/ppc32 4dc8835 Remove code-duplication in the PPC NCG 26f86f3 base: Fix GHC.Word and GHC.Int on 32-bit platforms 84dd9d0 An extra traceTc in tcExpr for ExprWithSig 356e5e0 Do not eta-reduce across Ticks in CorePrep 12372ba CorePrep: refactoring to reduce duplication 067335a A raft of comments about TyBinders b416630f Test Trac #11728 da4bc0c Document implicit quantification better 454585c More clarification in docs for implicit quantification 4e98b4f DynFlags: Initialize unsafeGlobalDynFlags enough to be useful e8d3567 Panic: Try outputting SDocs d0787a2 testsuite: Identify framework failures in testsuite summary 1b4d120 DWARF: Add debugging information chapter to users guide 882179d RTS: Fix & refactor "portable inline" macros 4da8e73 Fix #11754 by adding an additional check. 12a76be Check for rep poly on wildcard binders. 9f73e46 Clarify Note [Kind coercions in Unify] 06cd26b Remove now obsolete LD_STAGE0 hack c7b32ad Remove now pointless INLINE_ME macro 61df7f8 Fix AIX/ppc codegen in `-prof` compilation mode 0bca3f3 Scrap IRIX support f911358 Scrap DEC OSF/1 support ffc802e Drop Xcode 4.1 hack and fix ignored CC var issue afc48f8 Autoconf: detect and set CFLAGS/CPPFLAGS needed for C99 mode 49b9d80 Do not test for existence of the executable eb25381 Update bytestring submodule to latest snapshot cd3fbff Remove obsolete --with-hc flag from ./configure 91b96e1 fix compilation failure on Solaris 11 a658ad9 Reenable external-json linters 0f0c138 base: Document caveats about Control.Concurrent.Chan 415b706 users-guide: Provide more depth in table-of-contents eb8bc4d users-guide: Wibbles aa61174 users-guide: Add references to various issues in bugs section 7393532 Use a correct substitution in tcInstType a49228e Build correct substitution in instDFunType 4a93e4f Use the correct substitution in lintCoercion 5097f38 Add Data.Functor.Classes instances for Proxy (trac issue #11756) b0ab8db base: Add comment noting import loop be2a7ba cleanup POSIX/XOPEN defines for switch to C99 85e6997 Remove all mentions of IND_OLDGEN outside of docs/rts 30b9061 Be more explicit about closure types in ticky-ticky-report 38c7714 Ticky: Do not count every entry twice 8af1d08 Typo in Note name 80d4fdf SpecConstr: Transport strictness data to specialization’s argument’s binders e6e17a0 Rename isNopSig to isTopSig c8138c8 Do not print DmdType in Core output cf768ec Tes suite output updates d5d6804 rename: Disallow type signatures in patterns in plain Haskell ae6a56e users-guide/rel-notes: Note broken-ness of ImpredicativeTypes eb6b709 base: Fix haddock typo cb9a1e6 Add testcase for #11770 a76e6f5 Typos in non-code 1757dd8 Don't recompute some free vars in lintCoercion 3d245bf Do not claim that -O2 does not do better than -O 973633a Comments only in Unify.hs 7aa4c52 rts/posix/Itimer.c: Handle EINTR when reading timerfd d1179c4 ghc-prim: Delay inlining of {gt,ge,lt,le}Int to phase 1 c0e3e63 Defer inlining of Ord methods 58bbb40 ghc-prim: Mark unpackCStringUtf8# and unpackNBytes# as NOINLINE e9c2555 Don't require -hide-all-packages for MIN_VERSION_* macros bc953fc Add -f(no-)version-macro to explicitly control macros. 24d7615 Kill the magic of Any 8f66bac Comments only 1f68da1 Minor refactoring in mkExport 2e5e822 Comments only bdd9042 Refactor in TcMatches 174d3a5 Small refactor of TcMType.tauifyExpType 0ad2021 Make SigSkol take TcType not ExpType 9fc65bb Refactor error generation for pattern synonyms 28fe0ee Demand Analyzer: Do not set OneShot information da260a5 Revert accidental change to collectTyAndValBinders 6ea42c7 Revert "Demand Analyzer: Do not set OneShot information" 3806891 Make the example for -M work 72bd7f7 Improve printing of pattern synonym types f2a2b79 Deeply instantiate in :type 90d7d60 rts: Make StablePtr derefs thread-safe (#10296) b3ecd04 Elaborate test for #11376 9b6820c Bump binary submodule 7407a66 Don't infer CallStacks 2f3b803 Use exprCtOrigin in tcRnExpr 1e6ec12 Fix misattribution of `-Wunused-local-binds` warnings 351f976 T10272, T4340: Add 32-bit output 726cbc2 T10870: Skip on 32-bit architectures 1a8d61c testsuite: Update 32-bit performance numbers 2265c84 Core pretty printer: Omit wild case binders 5b986a4 CSE code cleanup and improvement 0f58d34 Demand Analyzer: Do not set OneShot information (second try) c9e8f80 Set tct_closed to TopLevel for closed bindings. eda273b runtime: replace hw.ncpu with hw.logicalcpu for Mac OS X 27528b3 Adjust performance numbers 06b7ce2 testsuite: One more 32-bit performance slip 6b6beba Fix installation of static sphinx assets 535896e rts: Fix parsing of profiler selectors 2bcf0c3 Revert "testsuite: One more 32-bit performance slip" eca8648 GHC.Base: Use thenIO in instance Applicative IO f0af351 Remove obsolete comment about the implementation of foldl f9d26e5 Fix a comment: triple -> tuple 485608d Refactor comments about shutdown c4a7520 Provide an optimized replicateM_ implementation #11795 90d66de Add doc to (<=<) comparing its type to (.) f3beed3 Remove left-over shell-tools.c 6d7fda5 Remove spurious STG_UNUSED annotation 2f82da7 Fix Template Haskell bug reported in #11809. d2e05c6 Reduce default for -fmax-pmcheck-iterations from 1e7 to 2e6 5a1add1 Export zonkEvBinds from TcHsSyn. 470d4d5 Fix suggestions for unbound variables (#11680) cf5ff08 Bump haddock submodule ad532de base: Fix "since" annotation on GHC.ExecutionStack 7443e5c Remove the instantiation check when deriving Generic(1) 378091c RtsFlags: Un-constify temporary buffer 8987ce0 Typos in Note 90538d8 Change runtime linker to perform lazy loading of symbols/sections 46e8f19 Fix a closed type family error message 02a5c58 Filter out invisible kind arguments during TH reification 8b57cac Added (more) missing instances for Identity and Const aadde2b Deriving Functor-like classes should unify kind variables 2ef35d8 Use `@since` annotation in GHC.ExecutionStack c6e579b Add linker notes 83eb4fd Small simplification (#11777) 5c4cd0e Cache the size of part_list/scavd_list (#11783) f4446c5 Allocate blocks in the GC in batches b1084fd Fix #11811. dd99f2e Fix #11797. 0b6dcf6 Fix #11814 by throwing more stuff into InScopeSets d81cdc2 Teach lookupLocalRdrEnv about Exacts. (#11813) 49560ba Fix commented out debugging code in ByteCodeGen 227a29d Fix typos: tyars -> tyvars 20f9056 Remove some old commented out code in StgLint 3a34b5c Add a test case for #11731. f4fd98c Add a final demand analyzer run right before TidyCore 928d747 Kill some unnecessary varSetElems 2acfaae Comments only e24b3b1 Adjust error check for class method types 31e4974 Remove some gratitious varSetElemsWellScoped 8d66765 Increase an InScopeSet for a substitution aaaa61c users-guide: Note change in LLVM support policy 10c6df0 utils: Provide CallStack to expectJust 116088d testsuite: Add T11824 cb0d29b testsuite: Add test for #11827 9d063b6 Linker: Fix signedness mismatch 933abfa rel-notes: Add note about UndecidableSuperClasses and #11762 54e67c1 Remove dead function SimplUtils.countValArgs f0e331b Comments only, on Type.topSortTyVars a7ee2d4 Improve TcFlatten.flattenTyVar e9ad489 libdw: More precise version check d77981e rts/RetainerProfile: Remove unused local bf17fd0 deriveConstants: Verify sanity of nm f4e6591 Bump haddock submodule 865602e Rework CC/CC_STAGE0 handling in `configure.ac` 3f3ad75 Update `directory` submodule to v1.2.6.0 release 4cbae1b Update array submodule to v0.5.1.1 release tag 97f2b16 Add Windows import library support to the Runtime Linker 04b70cd Add TemplateHaskell support for Overlapping pragmas 89b6674 TH: Tweak Haddock language 7a1c073 users-guide: Fix typo 07dc330 validate: Note existence of config_args variable 7005b9f Add flag to control number of missing patterns in warnings 36a0b6d Check CCS tree for pointers into shared object during checkUnload 177aec6 Linker: Clean up #if USE_MMAP usage a392208 Resolve symlinks when attempting to find GHC's lib folder on Windows 93d85af Update `directory` submodule to v1.2.6.1 release dd920e4 Silence unused-import warning introduced by 93d85af9fec968b 8a75bb5 Update haskeline submodule to 0.7.2.3 release 3dac53f Make it easy to get hyperlinked sources 10d808c relnotes: Add note about #11744 and workaround 87114ae Use stdint types to define SIZEOF and ALIGNMENT of INTx/WORDx 32ddd96 Remove obsolete/redundant FLEXIBLE_ARRAY macro 350ffc3 rts: Limit maximum backtrace depth d1ce35d rts: Don't use strndup 8556f56 Update `directory` submodule to v1.2.6.2 release a3c37c3 Remove unused import of emptyNameEnv d59939a Define TyCoRep.ppSuggestExplicitKinds, and use it 17eb241 Refactor computing dependent type vars 8136a5c Tighten checking for associated type instances 9de405d Kill dead TauTvFlavour, and move code around 81e2279 Update hsc2hs submodule 91ee509 Mark GHC.Stack.Types Trustworthy 96e1bb4 Update deepseq submodule to latest 1.4.2.0 snapshot ff290b8 Update binary submodule to 0.8.3.0 release 15b7e87 Update `pretty` submodule to v1.1.3.3 release 81b14c1 Update unix submodule to v2.7.2.0 release 7f71dbe Bump haddock submodule 81aa3d1 Reduce use of instances in hs-boot files 871f684 Define NameSet.intersectFVs 7319b80 Tighten up imports, white space 353d8ae SCC analysis for instances as well as types/classes 61191de Fix two buglets in 17eb241 noticed by Richard cdcf014 Tighten up imports on TcTyClsDecls 687c778 Kill unnecessary varSetElemsWellScoped in deriveTyData 62943d2 Build a correct substitution in dataConInstPat 55b1b85 Accept tcrun045 output 2e33320 Rename FV related functions 98a14ff Point to note about FV eta-expansion performance 7c6585a Remove mysterious varSetElemsWellScoped in tidyFreeTyCoVars 8c33cd4 testsuite: Bump max bytes used of T4029 f02af79 Improve the behaviour of warnIf edf54d7 Do not use defaulting in ambiguity check 9421b0c Warn about simplifiable class constraints 251a376 Test Trac #3990 26a1804 wibble to simplifiable 24d3276 A little more debug tracing c2b7a3d Avoid double error on out-of-scope identifier 970ff58 Simplify defaultKindVar and friends 6ad2b42 Refactor free tyvars on LHS of rules ed4a228 Fix typos: alpah -> alpha 4221cc2 Typo: veraibles -> variables a9076fc Remove unused tyCoVarsOfTelescope 0f96686 Make benign non-determinism in pretty-printing more obvious 03006f5 Get rid of varSetElemsWellScoped in abstractFloats 28503fe deriveConstants: Fix nm-classic error message e8c04d4 Testsuite: Delete test for deprecated "packedstring" dadf82d Testsuite: fixup lots of tests 2a83713 Testsuite: delete Roles9.stderr fd5212f Testsuite: delete unused concurrent/prog002/FileIO.hs c9bcaf3 Kill varSetElemsWellScoped in quantifyTyVars e68195a RTS: Add setInCallCapability() 95f9334 GHCi: use real time instead of CPU time for :set -s d396996 Doc improvement for ApplicativeDo 24864ba Use __builtin_clz() to implement log_2() 0712f55 Just comments & reformatting 2dc5b92 Kill varSetElems in TcErrors 94320e1 Kill varSetElems try_tyvar_defaulting f13a8d2 Kill varSetElems in markNominal a48ebcc Implement the state hack without modifiyng OneShotInfo 5adf8f3 Document -fmax-pmcheck-iterations a bit better a0e1051 Recommend more reliable recourse for broken nm 57c636f Update nofib submodule to nofib master fa3ba06 Expand the comment on pprVarSet 82538f6 Kill varSetElems in injImproveEqns af6dced Comments only a2abcf6 Minor improvement to error message 1e86cab Comments only 9ed57d6 Remove unused unifyType_ 4c746cb Add missing solveEqualities 3dce4f2 Refactor RecordPatSynField, FieldLabel c4dd4ae Better documentation of -XConstrainedClassMethods c5b1014 Fix debug-only check in CoreLint 546f24e Revert "Use __builtin_clz() to implement log_2()" 3a53380 Kill unused foldOccSet 196ce62 Testsuite: delete accidentally committed .stderr.normalised file 89c6d07 Testsuite: add -ignore-dot-ghci to some ghci tests [skip ci] 9dc34d3 Testsuite: fix T11223_simple_(unused_)duplicate_lib b0569e8 Testsuite: benign test fixes 3c426b0 Add uniqSetAny and uniqSetAll and use them 7312923 Kill mapUniqSet 32c0aba Testsuite: delete -fesc tests e20b3ed Testsuite: delete T5054 and T5054_2 (#5054) bcfee21 rts/LdvProfile.c: Fix NULL dereference on shutdown f255f80 Linker: Fix implicit function declaration warning on OS X 6e195f4 Remove unused foldFsEnv 031de8b Remove unused foldNameEnv f99db38 Fix path to the new build system, now called Hadrian. 0fa1d07 testsuite: fix up T11223's Makefile a2970f8 RTS: delete BlockedOnGA* + dead code c5919f7 Remove the incredibly hairy splitTelescopeTvs. 7242582 Test #11484 in th/T11484 00053ee Fix typo: Superclases -> Superclasses b725fe0 PPC NCG: Improve pointer de-tagging code c4259ff Testsuite: make CLEANUP=1 the default (#9758) 2ae39ac Testsuite: accept new output for 2 partial-sigs tests 2fe7a0a Fix reference to Note in TcCanonical cb05860 Comment typos: Mkae -> Make, Hsakell -> Haskell 49bae46 Comment typo: unambigious -> unambiguous f69e707 Typos in DmdAnal e6627d1 Fix aggressive cleanup of T1407 868d2c4 rts: Remove deprecated C type `lnat` eac6967 users-guide: Add index entry for "environment file" 18676a4 Bump haddock submodule 533037c Greater customization of GHCi prompt 16a51a6 rts: Close livelock window due to rapid ticker enable/disable 65e13f6 rts: Split up Itimer.c df9b772 Catch errors from timerfd_settime 55f4009 Kill Itimer.h 999c464 rts/itimer/pthread: Stop timer when ticker is stopped 116d3fe Remove unused getScopedTyVarBinds 1161932 Add T11747 as a test ecc0603 deriveConstants: Fix nm advice one last time a28611b Export constructors for IntPtr and WordPtr ea34f56 Remove unused equivClassesByUniq cd85dc8 Make sure record pattern synonym selectors are in scope in GHCi. db2bfe0 added docstring for '-fhistory-size' flag 81d8a23 glasgow_exts.rst: fix quoting c5be5e2 docs/users_guide/glasgow_exts.rst: fix merge conflict fa86ac7 Make validDerivPred ignore non-visible arguments to a class type constructor 36d29f7 StaticPointers: Allow closed vars in the static form. 5f8c0b8 Revert "Revert "Use __builtin_clz() to implement log_1()"" ef44606 Cleanups related to MAX_FREE_LIST 0051ac1 Update libraries/hpc submodule to v0.6.0.3 release tag 4466ae6 Update bytestring submodule to 0.10.8.0 release tag 50e7055 Export oneShot from GHC.Exts f9d9375 Adjust testsuite output to bytestring-0.10.8.0 76ee260 Allow limiting the number of GC threads (+RTS -qn) f703fd6 Add +RTS -AL 1fa92ca schedulePushWork: avoid unnecessary wakeups dbcaa8c Don't STATIC_INLINE giveCapabilityToTask aa5e2dd Make 'make fast' work for the User Guide b75d194 Be more aggressive when checking constraints for custom type errors. 4f2afe1 testsuite: Add test for #11959 763610e base: Export runRW# from GHC.Exts ad4392c Kill non-deterministic foldUFM in TrieMap and TcAppMap db9de7e rts: Replace `nat` with `uint32_t` e340520 Comments only explaining export list parsing. 94f2ee1 Explain linter optimization for StaticPtr checks. 990ce8c Use tcExtendGlobalValEnv for default methods ecc1d58 Update Win32 submodule to v2.3.1.1 release tag 018487e Fix pretty printing of IEThingWith fe190ae Remove trailing whitespace from 'testsuite/tests/module/all.T' 633b099 Update time submodule to 1.6.0.1 release tag 8e5776b rts/ProfHeap.c: Use `ssize_t` instead of `long`. dd3e847 Documentation for simplifyDeriv. 260a564 Use stdint types for Stg{Word,Int}{8,16,32,64} 2593e20 White space only 76d9156 Emit wild-card constraints in the right place cc75a5d Comments only e1ff2b4 Fix partial sigs and pattern bindings interaction 9dbf5f5 Tidy up partial-sig quantification bb296bf Error message wibbles, re partial type sigs 0597493 Re-do the invariant for TcDepVars 3ca7806 stg/Types.h: Fix comment and #include 53f26f5 Forbid variables to be parents in import lists. e996e85 RdrHsSyn: Only suggest `type` qualification when appropriate ea3d1ef Fix a crash in requestSync() bff6e1b Comments only 4ac0e81 Kill unnecessary cmpType in lhs_cmp_type b58b0e1 Make simplifyInstanceContexts deterministic a4717f5 Comments about static forms b21e8cc Comments only e7e5939 Add Outputable ShowHowMuch e24b50c Use partial-sig constraints as givens 1a43783 Record that EqualityConstraint now works f6e58be Test Trac #11640 7e28e47 Get rid of Traversable UniqFM and Foldable UniqFM 402f201 Fix typos ab91b85 make accept for Make simplifyInstanceContexts deterministic e207198 Kill foldUFM in classifyTyCon 8669c48 Document why closeOverKind is OK for determinism 584ade6 RtsFlags: Make `mallocFailHook` const correct 0efbf18 rts: Fix C compiler warnings on Windows 9363f04 Handle promotion failures when scavenging a WEAK (#11108) 0e71988 Remove some varSetElems in dsCmdStmt 3edbd09 Document SCC determinism cfc5df4 Fix ASSERT failure and re-enable setnumcapabilities001 2a0d00d Make random an "extra" package 86a1f20 Remove a copy of System.Random and use reqlib('random') b5f85ce Remove stale comment. da105ca Don't prematurely force TyThing thunks with -ddump-if-trace. 925b0ae Make absentError not depend on uniques eae3362 docs: add skeleton 8.2.1 release notes e217287 Bump haddock submodule c079de3 Add TH support for pattern synonyms (fixes #8761) e53f218 Fix deriveTyData's kind unification when two kind variables are unified b8e2565 Make Generic1 poly-kinded 6971430 Allow putting Haddocks on derived instances 01bc109 Document zonkTyCoVarsAndFV determinism 6bf0eef Kill varEnvElts in specImports 69c974f Use StgHalfWord instead of a CPP #if 995cf0f rts: Make function pointer parameters `const` where possible 0c0129b RtsUtils: Use `size_t` instead of `int` where appropriate 7c0b595 Fix comments about scavenging WEAK objects 5416fad Refactor some ppr functions to use pprUFM bd01bbb Test Trac #12039 8e48d24 Bump haddock submodule e4834ed Fix a performance issue with -fprint-expanded-synonyms c974927 Update bytestring submodule to 0.10.8.1 release tag bf669a0 Bump haddock submodule 2dbdc79 PPC NCG: Fix pretty printing of st[wd]ux instr. 563a485 PPC: Implement SMP primitives using gcc built-ins d78faa1 testsuite/ImpSafe03: Normalize version of bytestring eed820b Move Extension type to ghc-boot-th 21fe4ff Kill varSetElems in tcInferPatSynDecl d20d843 Another bump of haddock submodule 7814420 Remove html_theme requirement of haddock docs 4a037a9 Set `USE_MMAP` at configure time 770d708 Add ghc-boot-th to rules/foreachLibrary dc94914 Document determinism in shortOutIndirections 3f3dc23 Testsuite: run tests in /tmp after copying required files 1a9ae4b Testsuite: delete old cleanup code (#11980) a9dd9b7 Testsuite: delete unused file [skip ci] c92cfbc Testsuite: don't skip concio001 and concio001_thr 931b3c7 Delete libraries/ghci/GNUmakefile [skip ci] a54d87a rules: Fix name of ghc-boot-th library 5d80d14 rules/build-prog: Ensure programs depend upon their transitive deps 33c029d rts: More const correct-ness fixes b088c02 Testsuite: T10052 requires interpreter (#11730) 3251743 Testsuite: don't warn when mk/ghcconfig_* hasn't been created yet 77ee3a9 Update .mailmap [skip ci] fffe3a2 Make inert_model and inert_eqs deterministic sets f0f0ac8 Fix histograms for ticky code ba3e1fd Add a test for #11108 39a2faa Rework parser to allow use with DynFlags 310371f rts: Add isPinnedByteArray# primop f091218 CLabel: Catch #11155 during C-- pretty-printing 9dd0481 Add (broken) test for #12063. 5f1557e Failing test case for #12076. f18e8d8 rts: Add missing `const` from HashTable API 6282bc3 Kill varSetElems in tidyFreeTyCoVars 13e40f9 Kill varEnvElts in tcPragExpr 72b677d Fix Trac #12051 ad7f122 Improve pretty-printing of equalities f9e90bc Improve documentation for type wildcards 0bfcfd0 Comments only d1efe86 Comments only 358567a testsuite: Add expected output for T11108 470def9 Testsuite: fix T11827 (#11827) 296b8f1 Add libraries/ghci/GNUmakefile to .gitignore [skip ci] f0f3517 Remove use of caddr_t 8abc193 Get types in osFreeMBlocks in sync with osGetMBlocks 464b6f8 {,M}BLOCK_SIZE_W * sizeof(W_) -> {,M}BLOCK_SIZE 2e6433a testsuite: Add a TypeRep test a88bb1b Give lifted primitive types a representation 1ee47c1 Use the correct return type for Windows' send()/recv() (Fix #12010) 3910306 Add -XStaticPointers to the flag reference. 08e47ca FunDep printer: Fix unicode arrow 43589f5 testsuite: add CmmSwitchTest for 32-bit platforms ae7e9cb Fix Windows build after Ticky changes 8e92974 Testsuite: mark T8761 expect_broken #12077 a1f3bb8 Fix failing T12010 d9cb7a8 compiler/iface: compress .hi files e44a6f9 users-guide: Vector version of Thomson-Wheeler logo 6d6d6e4 rules/sphinx: Add missing dependency on conf.py for pdf rule cf1efc7 users-guide: Fix index in PDF output da3c1eb Enable checkProddableBlock on x86_64 527ed72 Fix deriving Ord when RebindableSyntax is enabled c81e7b2 Build system: temp solution for parallelisation bug (#11960) f669764 Use `setSession` instead of `modifySession` when setting `HscEnv` a70a6da rts/Linker.c: Fix compile error on Arm fa58710 Update format specifiers for Tickey.c 2230c88 Testsuite: fix T12010 for real 8c9b8a3 Allow unlifted types in pattern synonym result type d835ee6 Fix build by removing unused import. 785b38f testsuite: Update max_bytes_used for T4029 9bb2772 Revert "compiler/iface: compress .hi files" 4f5b335 Suppress the warning about __sync_fetch_and_nand (#9678) 03d8960 Don't split the arg types in a PatSyn signature eb8eb02 Spelling in comment 839b424 Remove unused Type.splitFunTysN 9c3e55b Comments only 35053eb Testsuite: delete check_files_written 1bf5c12 Spelling 8f7d016 Add support for unicode TH quotes (#11743) 4c6e69d Document some benign nondeterminism 9d06ef1 Make Arrow desugaring deterministic 95dfdce Remove 'deriving Typeable' statements fe8a4e5 Runtime linker: Break m32 allocator out into its own file 1956cbf Fix: #12084 deprecate old profiling flags 31f1804 Testsuite: delete drvfail015.stderr-7.0 [skip ci] 1319363 Always use native-Haskell de/encoders for ASCII and latin1 ac38c02 Update submodule vector [skip ci] 961ed26 Fix broken links to mdo papers eec88ee RTS: simplify read_heap_profiling_flag bdc5558 Testsuite: introduce TEST_HC_OPTS_INTERACTIVE (#11468) 8408d84 Spelling in comments 6a5bce1 Testsuite: also normalise platform-dependent .stdout/stderr f07bf19 Testsuite: fix enum01/02/03 on Windows (#9399) 5020bc8 Testsuite: add a test for #5522 (-fliberate-case -fspec-constr) 0f1e315 Fix bytecode gen to deal with rep-polymorphism e9e61f1 Reduce special-casing for nullary unboxed tuple 5b8bec2 StgCmmExpr: Fix a duplication 5b145c9 Coverage.hs: Fix a duplication cd50d23 StgCmmCon: Do not generate moves from unused fields to local variables b43a793 More fixes for unboxed tuples 72fd407 Comments and white space only 59250dc StgCmmExpr: Remove a redundant list 3a00ff9 Do not init record accessors as exported 3f20da1 Typos in comments d0dd572 Clarify users' guide section on GeneralizedNewtypeDeriving d40682e Testsuite: don't use --interactive in Makefiles 1e67010 RtsFlags.c: Const correct fixes 7e4f3dc StgCmmUtils.emitMultiAssign: Make assertion msg more helpful 0ffa23d Remove unused FAST_STRING_NOT_NEEDED macro defs 930e74f Update a Cmm note 0676e68 Fix detection and use of `USE_LIBDW` cb2c042 Use nameSetAny in findUses f2b3be0 Improve failed knot-tying error message. 99ace83 Kill nameSetElems in getInfo 36d254a Testsuite: run tests in /tmp/ghctest-xxx instead of /tmp/ghctest/xxx 940229c Travis: llvm's apt repository is offline cb9f635 Localize orphan-related nondeterminism d348acd Serialize vParallelTyCons in a stable order 3eac3a0 Add nameSetElemsStable and fix the build dad39ff Remove dead generics-related code from OccName d753ea2 Use UniqDSet for finding free names in the Linker e2446c0 Kill nameSetElems in findImportUsage be47085 Kill nameSetElems in rnCmdTop 060c176 Whitespace only 1d1987e HscMain: Minor simplification 9cc6fac Make FieldLabelEnv a deterministic set 2046297 Document putSymbolTable determinism 4842a80 Derive instances in Data.Data 1dadd9a testsuite: Mark broken tests on powerpc64le 3747372 Refactored SymbolInfo to lower memory usage in RTS 079c1b8 Use useful names for Symbol Addr and Names in Linker.c 02f893e integer-gmp: Make minusInteger more efficient 4aa299d PrelInfo: Ensure that tuple promoted datacon names are in knownKeyNames eda73a3 RTS SMP: Use compiler built-ins on all platforms. 4dbacbc Rename isPinnedByteArray# to isByteArrayPinned# b948a1d Refactor the SymbolName and SymbolAddr types to be pointers 5965117 Replace hand-written Bounded instances with derived ones 0d963ca Add relocation type R_X86_64_REX_GOTPCRELX 4848ab9 Testsuite: fixup comments for T9872d [skip ci] 886f4c1 Better comment for orIfNotFound. f91d87d Failing test-case for #12135. 3042a9d Use UniqDFM for HomePackageTable 48e9a1f Implement deterministic CallInfoSet a90085b Add @since annotations to base instances e684f54 Desugar ApplicativeDo and RecDo deterministically 31ba8d6 Kill nameSetElems 46d2da0 Document putDictionary determinism 3e7a876 Kill foldUniqSet 1937ef1 Make UnitIdMap a deterministic map a13cb27 Merge MatchFixity and HsMatchContext 77ccdf3 Kill occSetElts 7fea712 Use a deterministic map for imp_dep_mods d05dee3 CoreToStg: Remove hand-written Eq instances of HowBound and LetInfo 4426c5f Kill two instances of uniqSetToList 0d6f428 Fix build by removing unused import c148212 Kill varSetElems in checkValidInferredKinds ad8e203 Use DVarSet in Vectorise.Exp 3b698e8 Document determinism in pprintClosureCommand 5db93d2 Make vectInfoParallelVars a DVarSet 7008515 Kill varSetElems 7d58a97 Use pprUFM in pprStgLVs 00e3a5d Typofix. 4d5b2f6 Testsuite driver: always quote opts.testdir f5f5a8a Testsuite Windows: mark T8308 expect_broken (#8308) d4b548e Add some determinism tests dd33245 Desugar: Display resulting program stats with -v2 44a3c18 Revert "Desugar: Display resulting program stats with -v2" c2bbc8b Report term sizes with -v3 even when -ddump is enabled 80cf4cf Literal: Remove unused hashLiteral function d7933cb Show sources of cost centers in .prof 8f6d292 Fix #12064 by making IfaceClass typechecking more lazy. acb9e85 Minor performance note about IdInfo. 11ff1df Fix #12076 by inlining trivial expressions in CorePrep. 48385cb Remove special casing of Windows in generic files ceaf7f1 Implement Eq TyCon directly 68c1c29 Remove Ord (CoAxiom br) 9dbf354 Testsuite: delete dead code [skip ci] e703a23 Docs: fix links to ghc-flags 70e0a56 Remove Ord Class b2624ee Remove Ord PatSyn 77b8c29 Remove Ord AltCon c22ab1a Docs: delete PatternGuards documentation b020db2 Fix Ticky histogram on Windows e9dfb6e Improve the error messages for static forms. b0a7664 prettyPrintClosure(): Untag the closure before accessing fields 47d8173 Remove Printer.c:prettyPrintClosure() bcb419a Fix #12099: Remove bogus flags 6adff01 Comments only 6905ce2 Refine imports slightly 0f0b002 Comments only 3ae18df Minor refactoring b9fa72a Small refactor to mkRuntimErrorId 9e5ea67 NUMA support c88f31a Rts flags cleanup 5990016 ModuleSet: Use an actual set instead of map to units 6ace660 rts: Fix build when USE_LARGE_ADDRESS_SPACE is undefined 9130867 Skip retc001 on OSX b40e1b4 Fix incorrect calculated relocations on Windows x86_64 29e1464 Disable T12031 on linux 2bb6ba6 rts: Fix NUMA when cross compiling d25cb61 Kill off redundant SigTv check in occurCheckExpand 15b9bf4 Improve typechecking of let-bindings c28dde3 Tidy up zonkQuantifiedTyVar 7afb7ad Get in-scope set right in top_instantiate 35c9de7 Move the constraint-kind validity check 1f66128 Beef up mkNakedCastTy 15fc528 Fix the in-scope set for extendTvSubstWithClone 599d912 Beef up isPredTy 8104f7c Remove some traceTc calls e064f50 Add to .gitignore 921ebc9 Test Trac #12055 1dcb32d A second test for Trac #12055 5cee88d Add thin library support to Windows too 7de776c Kill unused foldModuleEnv 586d558 Use UniqFM for SigOf 0497ee5 Make the Ord Module independent of Unique order d55a9b4 Update Haddock to follow change in LHsSigWcType 4f35646 Adjust error message slightly 8dfd4ae Build system: mention ghc version in bindist's `configure --help` docdir a2deee0 Testsuite: enable ghci.prog010 (#2542) 23b73c9 Don't GC sparks for CAFs 9d22fbe Rename cmpType to nonDetCmpType 753c5b2 Simplify readProcessEnvWithExitCode + set LANGUAGE=C 70a4589 Revert "Make the Ord Module independent of Unique order" e33ca0e Fix testsuite wibble 77bb092 Re-add FunTy (big patch) e368f32 Major patch to introduce TyConBinder c56f8bd CoreMonad: Update error msg function docs 930a525 Abort the build when a Core plugin pass is specified in stage1 compiler a7f65b8 Remove dead code: countOnce, countMany 498ed26 NUMA cleanups 8d33af9 CoreLint: Slightly improve case type annotation error msgs 3e8c495 CmmNode: Make CmmTickScope's Unique strict 2396d9b llvmGen: Make metadata ids a newtype 85e09b1 llvmGen: Consolidate MetaExpr pretty-printing 9bb0578 Revert accidental submodule updates e02beb1 Driver: `ghc ../Test` (without file extension) should work f72f23f Testsuite: run tests in .run instead of /tmp 6f6f515 Testsuite: write "\n" instead of "\r\n" when using mingw Python d94c405 Testsuite: validate the tests/stage1 directory with the stage1 compiler a4c8532 Validate: use `rm -f` instead of `rm` 6354991 VarEnv: Comment only 270d545 Add Bifoldable and Bitraversable to base 9649fc0 Refactor derived Generic instances to reduce allocations 4d71cc8 Avoid find_tycon panic if datacon is not in scope f12fb8a Fix trac #10647: Notice about lack of SIMD support 2897be7 PPC NCG: Fix float parameter passing on 64-bit. f4b0488 PPC NCG: Fix and refactor TOC handling. 0be38a2 llvmGen: Add strictness to metadata fields 0e92af9 Remove use of KProxy in GHC.Generics 0ba34b6 ApplicativeDo: allow "return $ e" e7e42c8 Fix double-free in T5644 (#12208) cdc14b4 Testsuite: remove Windows CR again.. [skip ci] 9cdde38 Testsuite: remove Windows CR [skip ci] cf6e656 Testsuite: remove Windows CR [skip ci] 3dc1202 Testsuite: tabs -> spaces [skip ci] 7e7094f Testsuite: tabs -> spaces [skip ci] 46ff80f Testsuite: tabs -> spaces [skip ci] 915e07c Testsuite: tabs -> spaces [skip ci] 5b03dc6 Testsuite: tabs -> spaces [skip ci] a7160fa Testsuite: tabs -> spaces [skip ci] 4a4bdda Testsuite: recover from utf8 decoding errors 6d0a4fc Testsuite: fix WAY=ghci when LOCAL=0 1ddc10b Testsuite: *do* replace backslashes in config.libdir 1d938aa Testsuite: mark tests expect broken 3b49f8f Testsuite: remove `-fforce-recomp` from default flags (#11980) 82f7f18 Testsuite: delete TEST_HC_OPTS_NO_RECOMP 135fc86 Testsuite: remove `-Wno-warn-tabs` from default flags ebaf26b Testsuite: delete dead code + cleanup e170d19 Testsuite: assume timeout_prog always exists ee3bde7 Expand and clarify the docs for ApplicativeDo (#11835) 7301404 Typos in comments d09e982 Don't quantify over Refl in a RULE 97a50f8 Delete commented-out code 1230629 Make checkFamInstConsistency less expensive a47b62c Second attempt to fix sizeExpr c0583a9 Fix build breakage due to rebase 9d62d09 Hopefully fix all the rebase-induced breakage 4e7d835 Typos in comments [skip ci] 6199588 More typos in comments [skip ci] 93f40cb Don't error on GCC inlining warning in rts 348f2db Make the Ord Module independent of Unique order (2nd try) 15641b0 Accept new (lower) allocations for T7257 7e7aeab Comments only cc92a44 Improve error message in deriving( Functor ) a1b3359 Remove unused arg to tcSuperClasses ce97b72 Expand given superclasses more eagerly 210a2e1 Test Trac #12163 3e0af46 Give lookupGRE_Name a better API e556f76 Remove unused import 643706e Narrow the warning for simplifiable constraints 2f8cd14 Narrow the use of record wildcards slightly 7fc20b0 Have Core linter accept programs using StaticPointers and -fhpc. 35d1564 Provide Uniquable version of SCC bb74021 Remove Ord TyCon 7f5d560 Very confusing typo in error message. 9a34bf1 Fix #11974 by adding a more smarts to TcDefaults. 8035d1a Fix #10963 and #11975 by adding new cmds to GHCi. 4ae950f Release notes for #11975 and #10963 df9611e Testsuite: do not copy .hi/.o files to testdir (#12112) d2958bd Improve typechecking of instance defaults c871ce4 Comments around invisibility 393928d Fix renamer panic f86a337 Remove bogus comment on ForAllTy bb84ee4 Improve pretty-printing of Avail 12c4449 Implement ReifyConStrictness for -fexternal-interpreter (#12219) d2006d0 Run all TH tests with -fexternal-interpreter (#12219) bdb0d24 Remote GHCi: separate out message types eb73219 Remote GHCi: comments only 0bab375 Fix T8761 (#12219, #12077) dadd8b8 Test Trac #12229 9bc2233 Fix typo in Data.Bitraverse Haddocks 31b5806 Clean up outdated comments in template-haskell changelog a33b498 Add template-haskell changelog note for #8761 5fdb854 s/Invisible/Inferred/g s/Visible/Required/g 4cc5a39 Refactor tcInferArgs and add comments. 8c1cedd Allow building static libs. da60e3e rts/Linker.c: Improve ugly C pre-processor hack 7843c71 Make T8761 deterministic, I hope ff1cc26 Don't run the run_command tests with ext-interp 82282e8 Remove some `undefined`s 60c24b2 Typos in user manual and code: recurisve -> recursive afa6e83 rts/Linker.c: Rename ONLY_USED_x86_64_HOST_ARCH macro bbf0aa2 Testsuite: never pick up .T files in .run directories 7593c2f Testsuite: report duplicate testnames when `make TEST=` 1f45bce Testsuite: remove one level of indentation [skip ci] 206b4a1 Testsuite: simplify extra_file handling bafd615 Testsuite: do not print timeout message 58f0086 Testsuite: open/close stdin/stdout/stderr explicitly d8e9b87 Testsuite: cleanup printing of summary 782cacf Testsuite: framework failure improvements (#11165) 6b3b631 Testsuite: run all indexed-types ways on ./validate --slow 0eb0378 Testsuite: do not add -debug explicitly in .T file 3fb9837 Testsuite: mark tests expect_broken af21e38 Don't omit any evidence bindings 23b80ac Deal correctly with unused imports for 'coerce' dc62a22 Wibble error message for #11471 dd92c67 Stop the simplifier from removing StaticPtr binds. 2e9079f Test Trac #12185 848e3ce Testsuite: fixes for python2.6 support 9a645a1 Refactor match to not use Unique order 8f7194f Double the file descriptor limit for openFile008 1084d37 Testsuite: use ignore_stderr/stdout instead of ignore_output 24194a6 Fix pretty-printer for IfaceCo e8d6271 Testsuite: do not depend on sys.stdout.encoding fb6e2c7 Delete Ord Unique 9854f14 Add a new determinism test b6b20a5 Reorganize some determinism tests 480e066 Remove ufmToList b8b3e30 Axe RecFlag on TyCons. 0701db1 Updates to handle new Cabal 430f5c8 Trac #11554 fix loopy GADTs 6a5d13c nativeGen: Allow -fregs-graph to be used f68d40c ghc-pkg: Drop trailing slashes in computing db paths f1e16e9 CmmExpr: remove unused `vgcFlag` function b65363d Fix check_uniques in non-unicode locale 0afc41b Testsuite: be less strict about topHandler03's stderr c27ce26 users-guide: Fix markup in release notes 81b437b Add NamedThing (GenLocated l e) instance b412d82 Allow one type signature for multiple pattern synonyms 6ba4197 rules/sphinx.mk: stop xelatex on error ee8d1fa Remove unused oc->isImportLib (#12230) 6377757 Linker: some extra debugging / logging cbfeff4 Remove uniqSetToList 0d522b8 Document some benign nondeterminism 0ab63cf Kill varEnvElts in seqDmdEnv 01f449f Fix 32-bit build failures 9031382 MkCore: Fix some note names a6819a0 base: Add release date to changelog bf7cbe7 users-guide: Note multiple pattern signature change in relnotes afec447 testsuite: Add testcase for #12355 2a3af15 Treat duplicate pattern synonym signatures as an error 3b2deca users-guide: Remove static field type from rts-flag 331febf CallArity: Use not . null instead of length > 0 0bd7c4b Enum: Ensure that operations on Word fuse 18e71e4 Revert "Fix 32-bit build failures" 890ec98 Revert "Linker: some extra debugging / logging" e10497b Kill some varEnvElts 85aa6ef Check generic-default method for ambiguity 1267048 Extra ASSERTs for nameModule 55e43a6 Use DVarEnv for vectInfoVar 5f79394 Delete out-of-date comment 895eefa Make unique auxiliary function names in deriving cbe30fd Tidy up tidying f2d36ea White space only 6cedef0 Test Trac #12133 27fc75b Document codegen nondeterminism 18b782e Kill varEnvElts in zonkEnvIds 1b058d4 Remove varEnvElts b7b130c Fix GetTime.c on Darwin with clock_gettime f560a03 Adds x86_64-apple-darwin14 target. 567dbd9 Have addModFinalizer expose the local type environment. 56f47d4 Mention addModFinalizer changes in release notes. 672314c Switch to LLVM version 3.8 b9cea81 Show testcase where demand analysis abortion code fails 979baec --without-libcharset disables the use of libcharset bedd620 Style changes for UniqFM 6ed7c47 Document some codegen nondeterminism 9858552 Use deterministic maps for FamInstEnv 34085b5 Correct the message displayed for syntax error (#12146) 64bce8c Add Note [FamInstEnv determinism] 6e280c2 Utils: Fix `lengthIs` and `lengthExceeds` for negative args 0481324 Use UniqDFM for InstEnv b8cd94d GHC.Stack.CCS: Fix typo in Haddocks 91fd87e FastString: Reduce allocations of concatFS 15751f2 FastString: Add IsString instance c4a9dca FastString: Supply mconcat implementation fc53d36 OccName: Implement startsWithUnderscore in terms of headFS eb3d659 OccName: Avoid re-encoding derived OccNames 4f21a51 Kill eltsUFM in classifyTyCons 6c7c193 DsExpr: Remove usage of concatFS in fingerprintName 0177c85 Testsuite: expose TEST_CC (path to gcc) f53d761 TysWiredIn: Use UniqFM lookup for built-in OccNames 9a3df1f check-api-annotations utility loads by filename 17d0b84 Add -package-env to the flags reference 372dbc4 Pretty: delete really old changelog 45d8f4e Demand analyser: Implement LetUp rule (#12370) 18ac80f tidyType: Rename variables of nested forall at once cd0750e tidyOccNames: Rename variables fairly 37aeff6 Added type family dependency to Data.Type.Bool.Not b35e01c Bring comments in TcGenGenerics up to date a9bc547 Log heap profiler samples to event log ffe4660 IfaceEnv: Only check for built-in OccNames if mod is GHC.Types 24f5f36 Binary: Use ByteString's copy in getBS 0f0cdb6 Bugfix for bug 11632: `readLitChar` should consume null characters 1ba79fa CodeGen: Way to dump cmm only once (#11717) 89a8be7 Pretty: remove a harmful $! (#12227) 5df92f6 hp2ps: fix invalid PostScript for names with parentheses d213ab3 Fix misspellings of the word "instance" in comments 3fa3fe8 Make DeriveFunctor work with unboxed tuples 514c4a4 Fix Template Haskell reification of unboxed tuple types 1fc41d3 Make okConIdOcc recognize unboxed tuples 0df3f4c Fix PDF build for the User's Guide. 98b2c50 Support SCC pragmas in declaration context e46b768 Make Data.{Bifoldable,Bitraversable} -XSafe 908f8e2 TcInteract: Add braces to matchClassInst trace output 8de6e13 Fix bytecode generator panic cac3fb0 Cleanup PosixSource.h a0f83a6 Data.Either: Add fromLeft and fromRight (#12402) 627c767 Update docs for partial type signatures (#12365) ed48098 InstEnv: Ensure that instance visibility check is lazy 9513fe6 Clean up interaction between name cache and built-in syntax a4f2b76 testsuite: Add regression test for #12381 93acc02 Add another testcase for #12082 cf989ff Compact Regions 83e4f49 Revert "Clean up interaction between name cache and built-in syntax" 714bebf Implement unboxed sum primitive type a09c0e3 Comments only 9c54185 Comments + tiny refactor of isNullarySrcDataCon 8d4760f Comments re ApThunks + small refactor in mkRhsClosure 6a4dc89 Bump Haddock submodule 8265c78 Fix and document Unique generation for sum TyCon and DataCons e710f8f Correct a few mistyped words in prose/comments bbf36f8 More typos in comments fb34b27 Revert "Cleanup PosixSource.h" 86b1522 Unboxed sums: More unit tests bfef2eb StgCmmBind: Some minor simplifications c4f3d91 Add deepseq dependency and a few NFData instances 648fd73 Squash space leaks in the result of byteCodeGen 7f0f1d7 -fprof-auto-top 1fe5c89 UNPACK the size field of SizedSeq d068220 Fix the non-Linux build 4036c1f Testsuite: fix T10482a 1967d74 Some typos in comments a9251c6 MonadUtils: Typos in comments 1783011 Fix productivity calculation (#12424) 9d62f0d Accept better stats for T9675 8f63ba3 Compute boot-defined TyCon names from ModIface. b0a5144 Add mblocks_allocated to GC stats API e98edbd Move stat_startGCSync d3feb16 Make Unique a newtype c06e3f4 Add atomic operations to package.conf.in 89ae1e8 Relevant Bindings no longer reports shadowed bindings (fixes #12176) 750553a Use MO_Cmpxchg in Primops.cmm instead of ccall cas(..) 2078909 Typo in comment 36565a9 ForeignCall.hs: Remove DrIFT directives 55f5aed Track the lengths of the thread queues 988ad8b Fix to thread migration d1fe08e Only trace cap/capset events if we're tracing anything else 4dcbbd1 Remove the DEBUG_ variables, use RtsFlags directly 9df9490 StgSyn: Remove unused StgLiveVars types 2f79e79 Add comment about lexing of INLINE and INLINABLE pragma 0c37aef Update old comment InlinePragma b1e6415 More comments about InlinePragmas 7a06b22 Typo in comment [skip ci] 7a8ef01 Remove `setUnfoldingInfoLazily` a13fda7 Clarify comment on makeCorePair d85b26d CmmLive: Remove some redundant exports 8ecac25 CmmLayoutStack: Minor simplification fc66415 Replace an unsafeCoerce with coerce db5a226 Fix omission in haddock instance head 1101045 Trim all spaces after 'version:' fe4008f Remove identity update of field componentsConfigs f09d654 check that the number of parallel build is greater than 0 e3e2e49 codeGen: Remove binutils<2.17 hack, fixes T11758 ca7e1ad Expanded abbreviations in Haddock documentation ce13a9a Fix an assertion that could randomly fail 89fa4e9 Another try to get thread migration right 8fe1672 Bump `hoopl` submodule, mostly cosmetics 253fc38 Temporarily mark T1969 perf test as broken (#12437) 7354f93 StgCmm: Remove unused Bool field of Return sequel 02614fd Replace some `length . filter` with `count` 9aa5d87 Util.count: Implement as a left-fold instead of a right-fold affcec7 rts/Printer.h: fix constness of argument declaration 03af399 AsmCodeGen: Give linear-scan and coloring reg. allocators different cc names 3bfe6a5 RegAlloc: Remove duplicate seqList (use seqList from Util) bd51064 RegAlloc: Use IntSet/IntMaps instead of generic Set/Maps 7a2e933 Use Data.Functor.Const to implement Data.Data internals 6fe2355 configure.ac: Remove checks for bug 9439 773e3aa T1969: Enable it again but bump the max residency temporarily 4d9c22d Fix typo in Data.Bitraversable Haddocks fe19be2 Cabal submodule update. dd23a4c Actually update haddock.Cabal stats. e79bb2c Fix a bug in unboxed sum layout generation 9684dbb Remove StgRubbishArg and CmmArg ac0e112 Improve missing-sig warning bd0c310 Fix GHCi perf-llvm build on x86_64 37a7bcb Update `nofib` submodule to newest commit 7ad3b49 Misspellings in comments [skip ci] 18f0687 Fix configure detection. ffd4029 fix compilation failure on OpenBSD with system supplied GNU C 4.2.1 fc1432a Update hoopl submodule (extra .gitignore entry) 3551e62 refactor test for __builtin_unreachable into Rts.h macro RTS_UNREACHABLE da99a7f Darwin: Detect broken NM program at configure time f9a11a2 When in sanity mode, un-zero malloc'd memory; fix uninitialized memory bugs. d331ace Minor typofix. b222ef7 Typofix in System.Environment docs. 34da8e5 Typo in comment efc0372 Not-in-scope variables are always errors f352e5c Keep the bindings local during defaultCallStacks 58e7316 Refactor nestImplicTcS d610274 Revert "T1969: Enable it again but bump the max residency temporarily" 113d50b Add gcoerceWith to Data.Type.Coercion b2c5e4c Revert "codeGen: Remove binutils<2.17 hack, fixes T11758" 896d216 Annotate initIfaceCheck with usage information. e907e1f Axe initIfaceTc, tie the knot through HPT (or if_rec_types). 704913c Support for noinline magic function. 1f1bd92 Introduce BootUnfolding, set when unfolding is absent due to hs-boot file. 5a8fa2e When a value Id comes from hi-boot, insert noinline. Fixes #10083. 8fd1848 Retypecheck both before and after finishing hs-boot loops in --make. e528061 We also need to retypecheck before when we do parallel make. 0d3bf62 Fix #12472 by looking for noinline/lazy inside oversaturated applications. f9aa996 pass -z wxneeded or -Wl,-zwxneeded for linking on OpenBSD fb0d87f Splice singleton unboxed tuples correctly with Template Haskell 1f75440 Extra comments, as per SPJ in #12035. acdbd16 Move #12403, #12513 users guide notes to 8.2.1 release notes 89facad Add T12520 as a test 1766bb3 RtClosureInspect: Fix off-by-one error in cvReconstructType 613d745 Template Haskell support for unboxed sums 7a86f58 Comments only: Refer to actually existing Notes 8d92b88 DmdAnal: Add a final, safe iteration d6fd2e3 DmdAnal: Testcase about splitFVs and dmdFix abortion ec7fcfd Degrade "case scrutinee not known to diverge for sure" Lint error to warning faaf313 WwLib: Add strictness signature to "let x = absentError …" 1083f45 Fix doc build inconsistency ae66f35 Allow typed holes to be levity-polymorphic a60ea70 Move import to avoid warning 0050aff Fix scoping of type variables in instances ca8c0e2 Typofix in docs. 983f660 Template Haskell support for TypeApplications 822af41 Fix broken Haddock comment f4384ef Remove unused DerivInst constructor for DerivStuff 21c2ebf Missing stderr for T12531. 9d17560 GhcMake: limit Capability count to CPU count in parallel mode a5d26f2 rts: enable parallel GC scan of large (32M+) allocation area 044e81b OccName: Remove unused DrIFT directive ff1931e TcGenDeriv: Typofix d168c41 Fix and complete runghc documentation 6781f37 Clarify pkg selection when multiple versions are available 83b326c Fix binary-trees regression from unnecessary floating in CorePrep. a25bf26 Tag pointers in interpreted constructors ef784c5 Fix handling of package-db entries in .ghc.environment files, etc. 2ee1db6 Fixes #12504: Double-escape paths used to build call to hsc_line 28b71c5 users_guide: More capabilities than processors considered harmful 0e74925 GHC: Expose installSignalHandlers, withCleanupSession 3005fa5 iserv: Show usage message on argument parse failure d790cb9 Bump the default allocation area size to 1MB d40d6df StgCmmPrim: Add missing MO_WriteBarrier d1f2239 Clarify scope of `getQ`/`putQ` state. 22259c1 testsuite: Failing testcase for #12091 2d22026 ErrUtils: Expose accessors of ErrDoc and ErrMsg a07a3ff A failing testcase for T12485 9306db0 TysWiredIn: Use dataConWorkerUnique instead of incrUnique 9cfef16 Add Read1/Read2 methods defined in terms of ReadPrec 1ad770f Add -flocal-ghci-history flag (#9089). 010b07a PPC NCG: Implement minimal stack frame header. ca6d0eb testsuite: Update bytes allocated of parsing001 75321ff Add -fdefer-out-of-scope-variables flag (#12170). e9b0bf4 Remove redundant-constraints from -Wall (#10635) 043604c RnExpr: Fix ApplicativeDo desugaring with RebindableSyntax dad6a88 LoadIFace: Show known names on inconsistent interface file 3fb8f48 Revert "testsuite: Update bytes allocated of parsing001" a69371c users_guide: Document removal of -Wredundant-constraints from -Wall ad1e072 users_guide: Move addModFinalizer mention to 8.0.2 release notes 1f5d4a3 users_guide: Move -fdefer-out-of-scope-variables note to 8.0.2 relnotes da920f6 users_guide: Move initGhcMonad note to 8.0.2 relnotes a48de37 restore -fmax-worker-args handling (Trac #11565) 1e39c29 Kill vestiages of DEFAULT_TMPDIR 8d35e18 Fix startsVarSym and refactor operator predicates (fixes #4239) b946cf3 Revert "Fix startsVarSym and refactor operator predicates (fixes #4239)" f233f00 Fix startsVarSym and refactor operator predicates (fixes #4239) e5ecb20 Added support for deprecated POSIX functions on Windows. 0cc3931 configure.ac: fix --host= handling 818760d Fix #10923 by fingerprinting optimization level. 36bba47 Typos in notes 33d3527 Protect StablPtr dereference with the StaticPtr table lock. 133a5cc ghc-cabal: accept EXTRA_HC_OPTS make variable f93c363 extend '-fmax-worker-args' limit to specialiser (Trac #11565) ac2ded3 Typo in comment 57aa6bb Fix comment about result f8b139f test #12567: add new testcase with expected plugin behaviour 1805754 accept current (problematic) output cdbb9da cleanup: drop 11 years old performance hack 71dd6e4 Don't ignore addTopDecls in module finalizers. 6ea6242 Turn divInt# and modInt# into bitwise operations when possible 8d00175 Less scary arity mismatch error message when deriving 4ff4929 Make generated Ord instances smaller (per #10858). 34010db Derive the Generic instance in perf/compiler/T5642 05b497e distrib: Fix libdw bindist check a7a960e Make the test for #11108 less fragile dcc4904 Add failing testcase for #12433 feaa31f Remove references to -XRelaxedPolyRec 5eab6a0 Document meaning of order of --package-db flags, fixes #12485. a8238a4 Update unix submodule to latest HEAD. 65d9597 Add hook for creating ghci external interpreter 1b5f920 Make start address of `osReserveHeapMemory` tunable via command line -xb 7b4bb40 Remove -flocal-ghci-history from default flags 710f21c Add platform warning to Foreign.C.Types 158288b Generalise type of mkMatchGroup to unify with mkMatchGroupName 04184a2 Remove uses of mkMatchGroupName 7b7ea8f Fix derived Ix instances for one-constructor GADTs 0e7ccf6 Fix TH ppr output for list comprehensions with only one Stmt 454033b Add hs_try_putmvar() 03541cb Be less picky about reporing inaccessible code 21d0bfe Remove unused exports 35086d4 users_guide: Fix Docbook remnant b451fef users_guide: #8761 is now fixed c6ac1e5 users_guide: TH now partially supports typed holes 6555c6b rts: Disable -hb with multiple capabilities 5eeabe2 Test wibbles for commit 03541cba ec3edd5 Testsuite wibbles, to the same files 505a518 Comments and white space only 8074e03 Comments and white space only 876b00b Comments and white space 86836a2 Fix codegen bug in PIC version of genSwitch (#12433) 9123845 tryGrabCapability should be using TRY_ACQUIRE_LOCK 626db8f Unify CallStack handling in ghc a001299 Comments only a72d798 Comments in TH.Syntax (Trac #12596) 97b47d2 Add test case for #7611 ea310f9 Remove directories from include paths 14c2e8e Codegen for case: Remove redundant void id checks 6886bba Bump Haddock submodule to fix rendering of class methods 8bd3d41 Fix failing test T12504 9cbcdb4 shutdownHaskellAndExit: just do a normal hs_exit() (#5402) 74c4ca0 Expose hs_exit_(rtsFalse) as hs_exit_nowait() 3a17916 Improved documentation for Foreign.Concurrent (#12547) 9766b0c Fix #12442. d122935 Mark mapUnionFV as INLINABLE rather than INLINE 68f72f1 Replace INLINEABLE by INLINABLE (#12613) 55d92cc Update test output bc7c730 Pattern Synonyms documentation update 796f0f2 Print foralls in user format b0ae0dd Remove #ifdef with never fulfilled condition c36904d Fix layout of MultiWayIf expressions (#10807) f897b74 TH: Use atomicModifyIORef' for fresh names 0b6024c Comments and manual only: spelling 13d3b53 Test Trac #12634 f21eedb Check.hs: Use actual import lists instead of comments 0b533a2 A bit of tracing about flattening 2fbfbca Fix desugaring of pattern bindings (again) 66a8c19 Fix a bug in occurs checking 3012c43 Add Outputable Report in TcErrors b612da6 Fix impredicativity (again) fc4ef66 Comments only 5d473cd Add missing stderr file 3f27237 Make tcrun042 fail 28a00ea Correct spelling in note references b3d55e2 Document Safe Haskell restrictions on Generic instances 9e86276 Implement deriving strategies b61b7c2 CodeGen X86: fix unsafe foreign calls wrt inlining 59d7ee5 GHCi: Don't remove shadowed bindings from typechecker scope. 3c17905 Support more than 64 logical processors on Windows 151edd8 Recognise US spelling for specialisation flags. f869b23 Move -dno-debug-output to the end of the test flags d1b4fec Mark T11978a as broken due to #12019 1e795a0 Use check stacking on Windows. c93813d Add NUMA support for Windows 2d6642b Fix interaction of record pattern synonyms and record wildcards 1851349 Don't warn about name shadowing when renaming the patten in a PatSyn decl ce3370e PPC/CodeGen: fix lwa instruction generation 48ff084 Do not warn about unused underscore-prefixed fields (fixes Trac #12609) 0014fa5 ghc-pkg: Allow unregistering multiple packages in one call b0d53a8 Turn `__GLASGOW_HASKELL_LLVM__` into an integer again f547b44 Eliminate some unsafeCoerce#s with deriving strategies 23cf32d Disallow standalone deriving declarations involving unboxed tuples or sums 4d2b15d validate: Add --build-only 42f1d86 runghc: use executeFile to run ghc process on POSIX 3630ad3 Mark #6132 as broken on OS X 8cab9bd Ignore output from derefnull and divbyzero on Darwin e9104d4 DynFlags: Fix absolute import path to generated header eda5a4a testsuite: Mark test for #12355 as unbroken on Darwin. 22c6b7f Update Cabal submodule to latest version. 8952cc3 runghc: Fix import of System.Process on Windows 7a6731c genapply: update source file in autogenerated text c5d6288 Mark zipWithAndUnzipM as INLINABLE rather than INLINE e4cf962 Bring Note in TcDeriv up to date 465c6c5 Improve error handling in TcRnMonad 58ecdf8 Remove unused T12124.srderr 4a03012 Refactor TcDeriv and TcGenDeriv a2bedb5 RegAlloc: Make some pattern matched complete 57a207c Remove dead code “mkHsConApp” cbe11d5 Add compact to packages so it gets cleaned on make clean. e41b9c6 Fix memory leak from #12664 f3be304 Don't suggest deprecated flags in error messages 76aaa6e Simplify implementation of wWarningFlags 082991a Tc267, tests what happens if you forgot to knot-tie. 3b9e45e Note about external interface changes. 940ded8 Remove reexports from ghc-boot, help bootstrap with GHC 8. 887485a Exclude Cabal PackageTests from gen_contents_index. 00b530d The Backpack patch. 4e8a060 Distinguish between UnitId and InstalledUnitId. 5bd8e8d Make InstalledUnitId be ONLY a FastString. 027a086 Update haddock.Cabal perf for Cabal update. 61b143a Report that we support Backpack in --info. 46b78e6 Cabal submodule update. e660f4b Rework renaming of children in export lists. f2d80de Add trailing comma to fix the build. 21647bc Fix build 7b060e1 Generate a unique symbol for signature object stub files, fixes #12673 bcd3445 Do not segfault if no common root can be found 8dc72f3 Cleanup PosixSource.h 6c47f2e Default +RTS -qn to the number of cores 85e81a8 Turn on -n4m with -A16m or greater 1a9705c Escape lambda. b255ae7 Orient improvement constraints better b5c8963 Rename a parameter; trivial refactor 88eb773 Delete orphan where clause 76a5477 Move zonking out of tcFamTyPats cc5ca21 Improved stats for Trac #1969 a6111b8 More tests for Trac #12522 b5be2ec Add test case for #12689 f8d2c20 Add a broken test case for #12689 8fa5f5b Add derived shadows only for Wanted constraints d2959df Comments and equation ordering only bce9908 RnExpr: Actually fail if patterns found in expression 577effd testsuite: Bump T1969 allocations 184d7cb Add test for #12411 042c593 Add test for #12589 fef1df4 Add test for #12456 57f7a37 Add missing @since annotations 2fdf21b Further improve error handling in TcRn monad 015e9e3 Cabal submodule update. 1cccb64 Unique: Simplify encoding of sum uniques 34d933d Clean up handling of known-key Names in interface files 3991da4 MkIface: Turn a foldr into a foldl' aa06883 Improve find_lbl panic message 90df91a PrelInfo: Fix style 8c6a3d6 Add missing Semigroup instances for Monoidal datatypes in base d5a4e49 Make error when deriving an instance for a typeclass less misleading 3ce0e0b Build ghc-iserv with --export-dynamic 6c73932 Check for empty entity string in "prim" foreign imports 0d9524a Disable T-signals-child test on single-threaded runtime e39589e Fix Windows build following D2588 b501709 Fix Show derivation in the presence of RebindableSyntax/OverloadedStrings 512541b Add a forward reference for a Note afdde48 Correct name of makeStableName in haddock 3174beb Comments about -Wredundant-constraints 82b54fc Fix comment typo 692c8df Fix shadowing in mkWwBodies 609d2c8 Typo in comment a693d1c Correct order of existentials in pattern synonyms f7278a9 Fix wrapping order in matchExpectedConTy 1790762 Test Trac #12681 db71d97 Reduce trace output slightly 156db6b Add more variants of T3064 (in comments) a391a38 Comments only f43db14 Typos in comments 3adaacd Re-add accidentally-deleted line 9cb4459 testsuite: Work around #12554 deed418 testsuite: Mark break011 as broken 8b84b4f testsuite: Mark T10858 as broken on Windows 3325435 testsuite: Mark T9405 as broken on Windows 8bb960e testsuite/driver: Never symlink on Windows c6ee773 testsuite/timeout: Ensure that processes are cleaned up on Windows 17d696f validate: Allow user to override Python interpreter 7d2df32 testsuite/driver: More Unicode awareness 5b55e4b testsuite: Eliminate unnecessary compile_timeout_multiplier 2864ad7 testsuite/driver: Allow threading on Windows c5c6d80 testsuite: Mark T7037 as broken on Windows cf5eec3 Bump parallel submodule 8fa2cdb Track dep_finsts in exports hash, as it affects downstream deps. f148513 Add option to not retain CAFs to the linker API 1275994 remove unnecessary ifdef 46f5f02 fixup! Add option to not retain CAFs to the linker API 7129861 DynamicLoading: Replace map + zip with zipWith 161f463 ghc/Main.hs: Add import list to DynamicLoading fa8940e fix build failure on Solaris caused by usage of --export-dynamic a3bc93e Add some missing RTS symbols 3866481 Compute export hash based on ALL transitive orphan modules. 02f2f21 cmm/Hoopl/Dataflow: remove unused code 1f09c16 Test for newtype with unboxed argument 2cb8cc2 StgCmmPrim: Add missing write barrier. a6094fa configure.ac: Report Unregisterised setting 518f289 New story for abstract data types in hsig files. 7e77c4b Support constraint synonym implementations of abstract classes. 9df4ce4 Only delete instances when merging when there is an exact match. 01490b4 Mark previously failing backpack tests as passing, with correct output. c2142ca Fix Mac OS X build by removing space after ASSERT. c23dc61 check-cpp: Make it more robust ff225b4 Typos in comments 45bfd1a Refactor typechecking of pattern bindings 82efad7 Comments and trivial refactoring cdbc73a Test Trac #12507 d61c7e8 Make TcLevel increase by 1 not 2 3f5673f A collection of type-inference refactorings. 1f09b24 Accept 20% dedgradation in Trac #5030 compile time 9417e57 Refactor occurrence-check logic e1fc5a3 Define emitNewWantedEq, and use it 6ddba64 Improve TcCanonical.unifyWanted and unifyDerived f41a8a3 Add and use a new dynamic-library-dirs field in the ghc-pkg info acc9851 Fix failure in setnumcapabilities001 (#12728) 1050e46 rts: configure.ac should populate HAVE_LIBNUMA instead of USE_LIBNUMA a662f46 Skip T5611 on OSX as it fails non-deterministically. 3cb32d8 Add -Wcpp-undef warning flag 6e9a51c Refactoring: Delete copied function in backpack/NameShape b76cf04 cmm/Hoopl/Dataflow: minor cleanup aaede1e rts/package.conf.in: Fix CPP usage a6bcf87 Refactoring: Replace when (not ...) with unless in ErrUtils f084e68 rts: Move path utilities to separate source file 1c4a39d Prioritise class-level equality costraints 1221f81 Don't instantaite when typechecking a pattern synonym 08ba691 Take account of kinds in promoteTcType 03b0b8e Test Trac #12174 853cdae Test Trac #12081 a182c0e testsuite: Bump peak_megabytes_allocated for T3064 801c263 Fundeps work even for unary type classes 9f814b2 Delete extraneous backtick in users' guide 925d178 Make traceRn behave more like traceTc 488a9ed rts/linker: Move loadArchive to new source file 23143f6 Refine ASSERT in buildPatSyn for the nullary case. 48876ae Remove -dtrace-level b8effa7 CmmUtils: remove the last dataflow functions 3562727 Simple refactor to remove misleading comment f9308c2 Collect coercion variables, not type variables eefe86d Allow levity-polymorpic arrows 0eb8934 Fix typo in comment cc29eb5 Revert "rts/linker: Move loadArchive to new source file" 815b837 Minor doc addition as requested in #12774. 7187ded Clarify comments on kinds (Trac #12536) aae2b3d Make it possible to use +RTS -qn without -N 60343a4 Add test for #12732 5ebcb3a Document unpackClosure# primop 4b300a3 Minor refactoring in stg_unpackClosurezh 4e088b4 Fix a bug in parallel GC synchronisation 7ddbdfd Zap redundant imports 80d4a03 Typos in comments 795be0e Align GHCi's library search order more closely with LDs 0b70ec0 Have static pointers work with -fno-full-laziness. 19ce8a5 Sparc*: Prevent GHC from doing unaligned accesses 79fb6e6 Tiny refactor 9968949 Get rid of TcTyVars more assiduously 7a50966 Simplify the API for TcHsType.kcHsTyVarBndrs f4a14d6 Use substTyUnchecked in TcMType.new_meta_tv_x 13508ba Fix Trac #12797: approximateWC 623b8e4 Renaming and comments in CorePrep 8a5960a Uninstall signal handlers cc4710a testsuite: Simplify kernel32 glue logic f4fb3bc linker: Split out CacheFlush logic abfa319 linker: Shuffle configuration into LinkerInternals.h 43c8c1c linker: Move mmapForLinker declaration into LinkerInternals.h 3f05126 linker: Split symbol extras logic into new source file c3446c6 Shuffle declarations into LinkerInternals.h 6ea0b4f linker: Split PEi386 implementation into new source file f6c47df linker: Split MachO implementation into new source file bdc262c linker: Split ELF implementation into separate source file 6fecb7e linker: Move ARM interworking note to SymbolExtras.c dc4d596 Hoopl/Dataflow: make the module more self-contained 80076fa Add notes describing SRT concepts b5460dd Add testcase for #12757 967dd5c Merge cpe_ExprIsTrivial and exprIsTrivial eaa3482 testsuite: Update T10858 allocations ec22bac Add test for #12788 f46bfeb API Annotations: make all ModuleName Located a977c96 Omit unnecessary linker flags e43f05b Add comments from Trac #12768 7b0ae41 Remove a debug trace 2cdd9bd Take account of injectivity when doing fundeps b012120 Handle types w/ type variables in signatures inside patterns (DsMeta) 1cab42d Update release notes for type sigs in TH patterns patch 1c886ea Stop -dno-debug-output suppressing -ddump-tc-trace 25c8e80 Add tracing infrastructure to pattern match checker 630d881 Allow GeneralizedNewtypeDeriving for classes with associated type families ead83db Describe symptoms of (and the cure for) #12768 in 8.0.2 release notes 1964d86 Some minor linker cleanups. 7d988dd Fix broken validate build. 91f9e13 Fix hs_try_putmvar003 (#12800) 2e8463b Update 8.0.2 release notes for #12784 2325afe Fix comment about pointer tagging 7fe7163 Adapt the (commented out) pprTrace in OccurAnal f05d685 Refactoring of mkNewTypeEqn 317236d Refactor CallStack defaulting slightly 500d90d ghc-cabal: Use correct name of linker flags env variable 816d2e4 build system: Include CONF_LD_LINKER_OPTS in ALL_LD_OPTS 9030d8e configure: Pass HC_OPTS_STAGEx to build system bae4a55 Pass -no-pie to GCC 0a122a4 testsuite: Update allocation numbers for T5631 e06e21a Add Richard Eisenberg's new email to mailmap bef7e78 Read parentheses better 122d826 rts: Add api to pin a thread to a numa node but without fixing a capability aa10c67 rts/linker: Move loadArchive to new source file e8ae4dc Update user's guide after D2490 03e8d26 Prevent GND from inferring an instance context for method-less classes 60bb9d1 Revert "Pass -no-pie to GCC" 7a7bb5d Revert "Refactor CallStack defaulting slightly" ec0bf81 rts: Fix LoadArchive on OS X d421a7e Pass -no-pie to GCC 46e2bef testsuite: Lower allocations for T876 7eae862 ghc-pkg: Munge dynamic library directories 2cfbee8 rts: Fix build when linked with gold 4e0b8f4 rts: Fix #include of 587dccc Make default output less verbose (source/object paths) 568e003 template-haskell: Version bump ca1b986 ghc: Fix ghc's template-haskell bound 8cb7bc5 rts: Fix references to UChar 6c0f10f Kill Type pretty-printer 55d535d Remove CONSTR_STATIC 034e01e Accept output for scc003 e0ca7ff Fix numa001 failure with "too many NUMA nodes" cb16890 testsuite: Fix creep of T4029 011af2b configure: Verify that GCC recognizes -no-pie flag 1b336d9 Skip 64-bit symbol tables 98f9759 Hopefully fix build on OS X 642adec Mark T12041 as expect_broken with -DDEBUG (#12826) 017d11e Typos in comments, notes and manual 31d5b6e fixup! Stop the simplifier from removing StaticPtr binds. 0e58652 Test for unnecessary register spills 4a835f0 Update xhtml submodule a637eeb Don't use mmap symbols when !RTS_LINKER_USE_MMAP 0135188 Storage.c: Pass a size to sys_icache_invalidate fa70b1e Fix -fobject-code with -fexternal-interpreter 7acee06 Avoid calling newDynFlags when there are no changes d3542fa Generalise the implicit prelude import 8dfca69 Inline compiler/NOTES into X86/Ppr.hs b769586 Fix windows validate 31398fb Test for type synonym loops on TyCon. 2878604 Correct spelling of command-line option in comment cede770 Correct name of Note in comment 07e40e9 Add Data instance for Const 18eb57b Revert "Add Data instance for Const" 9a4983d Pass autoconf triplets to sub-project configures 20fb781 LLVM generate llvm.expect for conditional branches 4d4f353 testsuite: Rip out hack for #12554 04b024a GHCi: Unconditionally import System.Directory 231a3ae Have reify work for local variables with functional dependencies. 9c39e09 Switch to LLVM version 3.9 94d1221 Add missing SMP symbols to RT linker. d328abc Spelling in comment only 3bd1dd4 Add Data instance for Const 4b72f85 Optimise whole module exports 6ad94d8 Updated code comment regarding EquationInfo. Trac #12856 ea37b83 A few typos in comments 5bce207 testsuite: Add test for #12855 926469f testsuite: Add test for #12024 b98dbdf testsuite: Add (still broken) testcase for #12447 e7ec521 testsuite: Add (still failing) testcase for #12550 ea76a21 add ieee754 next* functions to math_funs 514acfe Implement fine-grained `-Werror=...` facility 4c0dc76 Ignore Hadrian build products. 7e4b611 Make transformers upstream repository location consistent with others 1399c8b ghc/hschooks.c: Fix include path of Rts.h f430253 Allow to unregister threadWaitReadSTM action. 14ac372 Collect wildcards in sum types during renaming (#12711) d081fcf Make quoting and reification return the same types 9a431e5 Make a panic into an ASSERT 0476a64 Fix a bug in mk_superclasses_of f04f118 Comments only in TcType 0123efd Add elemDVarEnv 1eec1f2 Another major constraint-solver refactoring 18d0bdd Allow TyVars in TcTypes 4431e48 Remove redundant kind check 90a65ad Perf improvements in T6048, T10547 e319466 Typos in comments c1b4b76 Fix a name-space problem with promotion f0f4682 Test Trac #12867 83a952d Test Trac #12845 a5a3926 Kill off ifaceTyVarsOfType bc35c3f Use 'v' instead of 'tpl' for template vars edbe831 Use TyVars in a DFunUnfolding 12eff23 Use TyVars in PatSyns 5f349fe Improve pretty-printing of types eb55ec2 Refactor functional dependencies a bit 1bfff60 Fix inference of partial signatures 086b483 A tiny bit more tc tracing f8c966c Be a bit more selective about improvement 6ec2304 Fix an long-standing bug in OccurAnal 5238842 Typos in comments only [ci skip] 605af54 Test Trac #12776 27a6bdf Test Trac #12885 3aa9368 Comments only (related to #12789) abd4a4c Make note of #12881 in 8.0.2 release notes f8c8de8 Zonk the free tvs of a RULE lhs to TyVars e755930 Typos in comments 36e3622 Store string as parsed in SourceText for CImport 1732d7a Define thread primitives if they're supported. 30cecae users_guide: Bring 8.0.2 release notes up-to-date with ghc-8.0 branch f1fc8cb Make diagnostics slightly more colorful 52222f9b Detect color support da5a61e Minor cleanup of foldRegs{Used,Defd} 2d99da0 testsuite: Mention CLEANUP option in README 3ec8563 Replace -fshow-source-paths with -fhide-source-paths c2268ba Refactor Pattern Match Checker to use ListT 6845087 Purge GHC of literate Perl 4d4e7a5 Use newBlockId instead of newLabelC 7753273 AsmCodeGen: Refactor worker in cmmNativeGens 6d5c2e7 NCGMonad: Add MonadUnique NatM instance eaed140 OrdList: Add Foldable, Traversable instances fe3748b testsuite: Bump haddock.compiler allocations 795f8bd hschooks.c: Ensure correct header file is included 6f7ed1e Make globals use sharedCAF 56d7451 Fix type of GarbageCollect declaration 428e152 Use C99's bool 758b81d rts: Add missing #include 23dc6c4 Remove most functions from cmm/BlockId b92f8e3 Added Eq1, Ord1, Read1 and Show1 instances for NonEmpty 679ccd1 Hoopl/Dataflow: use block-oriented interface 0ce59be Fix testsuite threading, timeout, encoding and performance issues on Windows dd9ba50 Update test output for Windows 605bb9b testsuite: Use python3 by default 20c0614 Update Mingw-w64 bindist for Windows ef37580 Fix windows validate. be8a47f Tweaks to grammar and such. 03766cd Rename RuntimeRepPolymorphism to LevityPolymorphism e2330b6 Revert "Make globals use sharedCAF" c2a2911 Revert "Fix windows validate." 6c54fa5 testsuite: Add another testcase for #11821 0200ded Fix typo in functional dependencies doc f48f5a9e Ensure flags destined for ld are properly passed 514c01e Levity polymorphic expressions mustn't be floated-out in let-bindings. a452c6e Make note of #12907 in 8.0.2 release notes 0ac5e0c rts: Fix type of bool literal 7214e92 testsuite: Remove Unicode literals from driver 6576bf8 rts: Ensure we always give MADV_DONTNEED a chance in osDecommitMemory 0f37550 Typos in comments a934e25 testsuite: Actually update haddock.compiler allocations 7fafb84 testsuite/conc059: Don't attempt to use stdcall where it isn't supported 747e77c Fix naming of the native latin1 encodings ddc271e Travis: Add dependency on python3 27731f1 Note Trac #12141 in mk/build.mk.sample f46369b fdReady: use poll() instead of select() 895a131 Install toplevel handler inside fork. 2350906 Maintain in-scope set in deeply_instantiate (fixes #12549). eb6f673 8.2.1-notes.rst: tweak binutils version 90c5af4 core-spec: Fix S_MatchData 517d03e Fix an asymptotic bug in the occurrence analyser 6305674 Fix used-variable calculation (Trac #12548) e912310 Use isFamFreeTyCon now we have it 3e3f7c2 Test Trac #12925 847d229 Color output is wreaking havoc on test results b82f71b Fix x86 Windows build and testsuite eec02ab Give concrete example for #12784 in 8.0.2 release notes 24e6594 Overhaul GC stats 19ae142 Mark rn017 and T7672 as expect_broken(#12930) with -DDEBUG 6e4188a Fix unsafe usage of `is_iloc` selector in Ord instance for ImportSpec eafa06d Revert "Mark rn017 and T7672 as expect_broken(#12930) with -DDEBUG" b7e88ee Reduce the size of string literals in binaries. 41ec722d Test Trac #12919 39143a4 Mark T9577 as broken on Darwin due to #12937 4dd6b37 Really mark T9577 as broken 7036fde Overhaul of Compact Regions (#12455) c02aeb5 Ignore output for compact_gc: sizes change when profiling 5aa9c75 Fix the test with -O 9043a40 Fix crashes in hash table scanning with THREADED_RTS d70d452 rts: Use pthread itimer implementation on Darwin 83d69dc Don't barf() on failures in loadArchive() 499e438 Add HsSyn prettyprinter tests 58d78dc Fix pretty printer test to nog generate stdout 9bcc4e3 Remove stray commented out line in all.T c5fbbac Ignore stderr of all printer tests 62332f3 Setup tcg_imports earlier during signature matching, so orphans are visible. 617d57d Reduce qualification in error messages from signature matching. 58c290a hschooks.c: Fix long line 5063edb arclint: Lint cabal files c766d53 rts/linker: Fix LoadArchive build on Windows 6889400 testsuite: Add test for #10249 1e5b7d7 Update Windows GCC driver. 55361b3 nativeGen: Fix string merging on Windows 2bb099e BlockId: remove BlockMap and BlockSet synonyms 6da6253 rts/PosixSource.h: Define __USE_MINGW_ANSI_STDIO on Windows f65ff2c Disambiguate reified closed type family kinds in TH 61932cd Bump haddock submodule d3b546b Scrutinee Constant Folding cee72d5 Disable colors unless printing to stderr 1c296c0c Export `warningGroups' and `warningHierarchies' 62418b8 Mark T12903 as broken on OS X 90fae01 Fix LLVM TBAA metadata 2823492 NCG: Implement trivColorable for PowerPC 64-bit ca593c7 testsuite: make tests respond to SIGINT properly d1df8d1 Ensure each test inherits the TEST_HC_OPTS 5349d64 Rename TH constructors for deriving strategies 24a4fe2 testsuite: Mark prog003 as broken on Windows 2618090 testsuite: Fix syntax error in rts/all.T 17ac9b1 rts: Provide _lock_file in symbol table on Windows 0ac5a00 Add `_unlock_file` to RTS symbols 490b942 Automate GCC driver wrapper c3c7024 Make globals use sharedCAF 818e027 Refactor pruning of implication constraints f1036ad Make dropDerivedSimples restore [WD] constraints 6720376 Disable T12903 due to flakiness d03dd23 Fix a long-standing bug in CSE bc3d37d Float unboxed expressions by boxing 8f6d241 Add infix flag for class and data declarations 24f6bec Sanity check if we pick up an hsig file without -instantiated-with. db23ccf Fix recompilation detection when set of signatures to merge changes. f723ba2 Revert "Float unboxed expressions by boxing" cc2e3ec base: Make raw buffer IO operations more strict cb582b6 Don't have CPP macros expanding to 'defined'. 9cb4a13 Fix Win32 x86 build validation after D2756 aa123f4 Fix testcase T12903 on OS X 7031704 print * in unicode correctly (fixes #12550) 8ec864d Fix pretty printing of top level SCC pragmas 9c9a222 Load orphan interfaces before checking if module implements signature 26ce99c Fix typo in users' guide 52c5e55 mk/config.mk.in: enable SMP on ARMv7+ (Trac #12981) 0c3341b Show constraints when reporting typed holes 6f7d827 Reset FPU precision back to MSVCRT defaults 8b2e588 Adds llvm-prof flavour 6370a56 Build terminfo on iOS. 3c7cf18 Fix pprCLabel on platforms without native codegen. be5384c testsuite: Mark T9577 as broken due to #12965 27287c8 procPointAnalysis doesn't need UniqSM fe5d68a Add entry to .gitignore to for __.SYMDEF_SORTED 9550b8d Make unboxedTuple{Type,Data}Name support 0- and 1-tuples 2940a61 testsuite: Specify expected allocations of T12877 for Windows 5c76f83 check-ppr: Add a --dump flag to aid in debugging 394231b Fix cost-centre-stacks bug (#5654) 1ec632f Fix pretty printing of MINIMAL signatures 503219e Warn about missing instance methods that start with an underscore d398162 testsuite: Separate out Windows results for T5205 4d683fa base: Bump version to 4.10.0.0 8f0546b testsuite: Add test for #12971 0cad52d testsuite: Mark T10294 as fixed 81c4956 testsuite: Add test for #12966 cd4b202 array: Check for integer overflow during allocation 0d213c1 UniqSupply: Use full range of machine word ffc2327 base: Add more POSIX types (fixes #12795) 6fecb2a Verify that known-key uniques fit in interface file ed4cf03 Typos in comments 13c1fc4 DynFlags: Rip out remnants of WarnContextQuantification c889df8 Packages: Kill unused UnitId argument to isDllName 5bf344b CLabel: Kill redundant UnitId argument from labelDynamic 222e99d Make up a module name for c-- files 4026b45 Fix string merging with -split-sections 8f71d95 Enable split sections by default where possible c8ed1bd testsuite: Add test for #12993 2fa00f5 UNREG: include CCS_OVERHEAD to STG a6657bd revert '-Wl' prefixing to *_LD_OPTS c480860 rts/Compact.cmm: fix UNREG build failure d88efb7 Fix Pretty printer tests on Windows 0af959b Revert "Do not init record accessors as exported" 87c3b1d fix OpenBSD linkage (wxneeded) 6c816c5 utils/genargs: delete unused tool 8906e7b Reshuffle levity polymorphism checks. 3dbd2b0 Windows: Improve terminal detection mechanism 2d1beb1 rts/win32/IOManager: Fix integer types 343b147 Reexport Language.Haskell.TH.Lib from Language.Haskell.TH 2a02040 Fix bug in previous fix for #5654 90cfa84 Run some tests with -fexternal-interpreter -prof 21dde81 Improve StringBuffer and FastString docs e0fe7c3 Docs: Delete duplicate paragraph in user guide 52ba947 Allow use of the external interpreter in stage1. 25b70a2 Check family instance consistency of hs-boot families later, fixes #11062. 630cfc3 Fix Haddock comment typo. b5d788a Introduce unboxedSum{Data,Type}Name to template-haskell 513eb6a Fix #12998 by removing CTimer 88e8194 T12035j: disable on NOSMP targets 4704d65 T8209: disable on NOSMP targets 7f5be7e T10296a: disable on NOSMP targets d327ebd regalloc_unit_tests: disable on UNREG targets bb74bc7 T8242: disable on NOSMP targets f1dfce1 Revert "Allow use of the external interpreter in stage1." 6263e10 Fix timeout's timeout on Windows c0c1f80 Mark T8089 as unbroken since #7325 is now resolved 27f7925 Allow use of the external interpreter in stage1. 4535fa2 Test Trac #12996 8fdb937 Make CompactionFailed a newtype 574abb7 Rewrite Note [Api annotations] for clarity. 9a29b65 Suppress duplicate .T files 1771da2 Fix typos (not test relevant) f97d489 Test Trac #12968, plus some comments c73a982 Add note for rebindable syntax of [a..b] c66dd05 Move typeSize/coercionSize into TyCoRep d250d49 Add INLINE pragamas on Traversable default methods e07ad4d Don't eta-expand in stable unfoldings 0a18231 Lint DFunUnfoldings 05d233e Move InId/OutId to CoreSyn c48595e Never apply worker/wrapper to DFuns 1a4c04b Fix 'SPECIALISE instance' c469db4 Test Trac #12950 74033c4 Improved perf for T12227 ccc918c Fix a forward reference to a Note 2189239 Disambiguate two Notes with identical names ee4e165 Support for abi-depends for computing shadowing. 99db12f Update ghc-cabal command line usage text. 46f7f31 Notes on parsing lists in Parser.y 41ade95 Fix another forward reference to a Note b7a6e62 Revert "Suppress duplicate .T files" efc4a16 Allow timeout to kill entire process tree. 7a13f1f Alpha-renaming and white space only f06b71a Fix a bug in ABot handling in CoreArity ea8f91d White space only 9a4af2c Comments only 11306d6 Ensure that even bottoming functions have an unfolding 432f952 Float unboxed expressions by boxing 793ddb6 Tiny refactor in CoreTidy 75e8c30 Propagate evaluated-ness a bit more faithfully ee872d3 Removed dead code in DsCCall.mk_alt b4c3a66 Push coercions in exprIsConApp_maybe 8712148 testsuite: Split out Windows allocations numbers for T12234 f95e669 users-guide: Kill extraneous link 8f89e76 rename: Don't require 'fail' in non-monadic contexts 158530a Add caret diagnostics 46a195f Use python3 for linters 1b06231 Fix test for T12877 94d2cce base: Override Foldable.{toList,length} for NonEmpty 2689a16 Define MAP_ANONYMOUS on systems that only provide MAP_ANON 48a5da9 rename: Add note describing #11216 9331e33 check-ppr: Make --dump the default behavior 3c9fbba Remove redudant import from check-ppr 815099c CallArity: Use exprIsCheap to detect thunks d2788ab Expand I/O CP in comments 88f5add testsuite: Fix T13025 4dec7d1 Testsuite: Skip failing tests on PowerPC 64-bit f3b99c7 Bump array submodule a370440 Fix various issues with testsuite code on Windows bab4ae8 Fix incorrect statement about plugin packages. 9ff0738 Remove documentation about non-existent flag. c560957 Disallow users to write instances of KnownNat and KnownSym cc0abfa Update .mailmap b28ca38 Don't suggest enabling TypeApplications when it's already enabled 8d63ca9 Refactor importdecls/topdecls parsing. 5800b02 Add specialization rules for realToFrac on Complex 683ed47 Don't use $ in the definition of (<**>) in GHC.Base 6b3c039 Typo in manual [ci skip] df72368 Typofixes in manual and comments [ci skip] 2664641 Remove a redundant test c909e6e Minor refactoring in CSE baf9ebe Ensure nested binders have Internal Names 19d5c73 Add a CSE pass to Stg (#9291) 5d2a92a Use atomic counter for GHC.Event.Unique 5797784 Remove single top-level section in Foldable docs 5ef956e Fix doctests in Data.Functor 5f91ac8 Coerce for fmapDefault and foldMapDefault e6aefd6 Use the right in-scope set 3540d1e Avoid exponential blowup in FamInstEnv.normaliseType b4f2afe Fix the implementation of the "push rules" 4e3fc82 Inline work start e408eab Always expose unfoldings for overloaded functions. 95dcb8b tidy ea6a686 missing import From git at git.haskell.org Fri Jan 6 17:15:01 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 6 Jan 2017 17:15:01 +0000 (UTC) Subject: [commit: ghc] master: Add missing stderr file for T13035 (f3c7cf9) Message-ID: <20170106171501.C132E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f3c7cf9b89cad7f326682b23d9f3908ebf0f8f9d/ghc >--------------------------------------------------------------- commit f3c7cf9b89cad7f326682b23d9f3908ebf0f8f9d Author: Matthew Pickering Date: Fri Jan 6 17:14:30 2017 +0000 Add missing stderr file for T13035 >--------------------------------------------------------------- f3c7cf9b89cad7f326682b23d9f3908ebf0f8f9d testsuite/tests/perf/compiler/T13035.stderr | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/testsuite/tests/perf/compiler/T13035.stderr b/testsuite/tests/perf/compiler/T13035.stderr index 0519ecb..ae02c1f 100644 --- a/testsuite/tests/perf/compiler/T13035.stderr +++ b/testsuite/tests/perf/compiler/T13035.stderr @@ -1 +1 @@ - \ No newline at end of file +compilation IS NOT required From git at git.haskell.org Fri Jan 6 17:15:40 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 6 Jan 2017 17:15:40 +0000 (UTC) Subject: [commit: ghc] master: Have addModFinalizer expose the local type environment. (e5d1ed9) Message-ID: <20170106171540.9F43B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e5d1ed9c8910839e109da59820ca793642961284/ghc >--------------------------------------------------------------- commit e5d1ed9c8910839e109da59820ca793642961284 Author: Facundo Domínguez Date: Mon Jan 2 19:42:20 2017 -0300 Have addModFinalizer expose the local type environment. Summary: Kind inference in ghci was interfered when renaming of type splices introduced the HsSpliced data constructor. This patch has kind inference skip over it. Test Plan: ./validate Reviewers: simonpj, rrnewton, austin, goldfire, bgamari Reviewed By: goldfire, bgamari Subscribers: thomie, mboes Differential Revision: https://phabricator.haskell.org/D2886 GHC Trac Issues: #12985 >--------------------------------------------------------------- e5d1ed9c8910839e109da59820ca793642961284 compiler/coreSyn/CoreLint.hs | 100 ++++++------ compiler/coreSyn/CoreUtils.hs | 25 ++- compiler/deSugar/DsExpr.hs | 58 +------ compiler/main/StaticPtrTable.hs | 175 ++++++++++++++------- compiler/main/TidyPgm.hs | 32 ++-- compiler/prelude/PrelNames.hs | 11 ++ compiler/simplCore/SetLevels.hs | 4 +- compiler/simplCore/SimplCore.hs | 45 ++++-- libraries/base/GHC/StaticPtr/Internal.hs | 24 +++ libraries/base/base.cabal | 1 + testsuite/tests/codeGen/should_run/T12622.hs | 19 +++ .../tests/codeGen/should_run/T12622.stdout | 0 testsuite/tests/codeGen/should_run/T12622_A.hs | 15 ++ testsuite/tests/codeGen/should_run/all.T | 1 + 14 files changed, 304 insertions(+), 206 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc e5d1ed9c8910839e109da59820ca793642961284 From git at git.haskell.org Fri Jan 6 17:17:32 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 6 Jan 2017 17:17:32 +0000 (UTC) Subject: [commit: ghc] master: Actually add the right file for T13035 stderr (54227a4) Message-ID: <20170106171732.67D7C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/54227a45352903e951b81153f798162264f02ad9/ghc >--------------------------------------------------------------- commit 54227a45352903e951b81153f798162264f02ad9 Author: Matthew Pickering Date: Fri Jan 6 17:15:35 2017 +0000 Actually add the right file for T13035 stderr >--------------------------------------------------------------- 54227a45352903e951b81153f798162264f02ad9 testsuite/tests/perf/compiler/T13035.stderr | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/testsuite/tests/perf/compiler/T13035.stderr b/testsuite/tests/perf/compiler/T13035.stderr index ae02c1f..52836d7 100644 --- a/testsuite/tests/perf/compiler/T13035.stderr +++ b/testsuite/tests/perf/compiler/T13035.stderr @@ -1 +1,4 @@ -compilation IS NOT required + +T13035.hs:141:28: warning: [-Wpartial-type-signatures (in -Wdefault)] + • Found type wildcard ‘_’ standing for ‘'['Author]’ + • In the type signature: g :: MyRec RecipeFormatter _ From git at git.haskell.org Fri Jan 6 18:12:23 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 6 Jan 2017 18:12:23 +0000 (UTC) Subject: [commit: ghc] master: Revert "Have addModFinalizer expose the local type environment." (c5452cc) Message-ID: <20170106181223.D6E413A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c5452cc1a67e344ea694851d83e2534a6d829e45/ghc >--------------------------------------------------------------- commit c5452cc1a67e344ea694851d83e2534a6d829e45 Author: Facundo Domínguez Date: Fri Jan 6 15:08:47 2017 -0300 Revert "Have addModFinalizer expose the local type environment." This reverts commit e5d1ed9c8910839e109da59820ca793642961284. >--------------------------------------------------------------- c5452cc1a67e344ea694851d83e2534a6d829e45 compiler/coreSyn/CoreLint.hs | 100 ++++++------- compiler/coreSyn/CoreUtils.hs | 25 ++-- compiler/deSugar/DsExpr.hs | 58 ++++++-- compiler/main/StaticPtrTable.hs | 175 +++++++---------------- compiler/main/TidyPgm.hs | 32 +++-- compiler/prelude/PrelNames.hs | 11 -- compiler/simplCore/SetLevels.hs | 4 +- compiler/simplCore/SimplCore.hs | 45 +++--- libraries/base/GHC/StaticPtr/Internal.hs | 24 ---- libraries/base/base.cabal | 1 - testsuite/tests/codeGen/should_run/T12622.hs | 19 --- testsuite/tests/codeGen/should_run/T12622.stdout | 1 - testsuite/tests/codeGen/should_run/T12622_A.hs | 15 -- testsuite/tests/codeGen/should_run/all.T | 1 - 14 files changed, 206 insertions(+), 305 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc c5452cc1a67e344ea694851d83e2534a6d829e45 From git at git.haskell.org Fri Jan 6 18:19:21 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 6 Jan 2017 18:19:21 +0000 (UTC) Subject: [commit: ghc] master: Have addModFinalizer expose the local type environment. (c1ed955) Message-ID: <20170106181921.1E74D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c1ed9557ad4e40caa72b27693527e02887ddd896/ghc >--------------------------------------------------------------- commit c1ed9557ad4e40caa72b27693527e02887ddd896 Author: Facundo Domínguez Date: Tue Dec 20 08:39:10 2016 -0300 Have addModFinalizer expose the local type environment. Kind inference in ghci was interfered when renaming of type splices introduced the HsSpliced data constructor. This patch has kind inference skip over it. Test Plan: ./validate Reviewers: simonpj, rrnewton, bgamari, goldfire, austin Subscribers: thomie, mboes Differential Revision: https://phabricator.haskell.org/D2886 GHC Trac Issues: #12985 >--------------------------------------------------------------- c1ed9557ad4e40caa72b27693527e02887ddd896 compiler/typecheck/TcHsType.hs | 8 ++++++++ testsuite/tests/ghci/scripts/GhciKinds.script | 7 +++++++ testsuite/tests/ghci/scripts/GhciKinds.stdout | 2 ++ 3 files changed, 17 insertions(+) diff --git a/compiler/typecheck/TcHsType.hs b/compiler/typecheck/TcHsType.hs index d96e74e..3fa6077 100644 --- a/compiler/typecheck/TcHsType.hs +++ b/compiler/typecheck/TcHsType.hs @@ -446,6 +446,14 @@ tc_infer_hs_type mode (HsKindSig ty sig) = do { sig' <- tc_lhs_kind (kindLevel mode) sig ; ty' <- tc_lhs_type mode ty sig' ; return (ty', sig') } +-- HsSpliced is an annotation produced by 'RnSplice.rnSpliceType' to communicate +-- the splice location to the typechecker. Here we skip over it in order to have +-- the same kind inferred for a given expression whether it was produced from +-- splices or not. +-- +-- See Note [Delaying modFinalizers in untyped splices]. +tc_infer_hs_type mode (HsSpliceTy (HsSpliced _ (HsSplicedTy ty)) _) + = tc_infer_hs_type mode ty tc_infer_hs_type mode (HsDocTy ty _) = tc_infer_lhs_type mode ty tc_infer_hs_type _ (HsCoreTy ty) = return (ty, typeKind ty) tc_infer_hs_type mode other_ty diff --git a/testsuite/tests/ghci/scripts/GhciKinds.script b/testsuite/tests/ghci/scripts/GhciKinds.script index fa94015..a7220fe 100644 --- a/testsuite/tests/ghci/scripts/GhciKinds.script +++ b/testsuite/tests/ghci/scripts/GhciKinds.script @@ -8,3 +8,10 @@ :seti -XRankNTypes :kind! forall a. F (Maybe a) + +:set -XUnboxedTuples -XTemplateHaskell -XMagicHash +:set -fprint-explicit-runtime-reps -fprint-explicit-kinds +:set -fprint-explicit-foralls +:m + GHC.Exts Language.Haskell.TH Language.Haskell.TH.Lib +:m + Language.Haskell.TH.Syntax +:k $(unboxedTupleT 2) diff --git a/testsuite/tests/ghci/scripts/GhciKinds.stdout b/testsuite/tests/ghci/scripts/GhciKinds.stdout index e34b84a..3556e62 100644 --- a/testsuite/tests/ghci/scripts/GhciKinds.stdout +++ b/testsuite/tests/ghci/scripts/GhciKinds.stdout @@ -9,3 +9,5 @@ F (Maybe Bool) :: * = Char forall a. F (Maybe a) :: * = Char +$(unboxedTupleT 2) :: forall (k0 :: RuntimeRep) (k1 :: RuntimeRep). + TYPE k0 -> TYPE k1 -> TYPE 'UnboxedTupleRep From git at git.haskell.org Sun Jan 8 00:17:25 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 8 Jan 2017 00:17:25 +0000 (UTC) Subject: [commit: ghc] master: TH: Add Trustworthy language pragma (7b317ef) Message-ID: <20170108001725.74CC63A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7b317effd59f56bc8450ea8efbb1ef5954f09e5d/ghc >--------------------------------------------------------------- commit 7b317effd59f56bc8450ea8efbb1ef5954f09e5d Author: Erik de Castro Lopo Date: Sun Jan 8 08:34:30 2017 +1100 TH: Add Trustworthy language pragma Test Plan: validate Reviewers: goldfire, bgamari, austin, RyanGlScott Reviewed By: RyanGlScott Subscribers: RyanGlScott, simonpj, thomie, goldfire Differential Revision: https://phabricator.haskell.org/D2546 GHC Trac Issues: #12511 >--------------------------------------------------------------- 7b317effd59f56bc8450ea8efbb1ef5954f09e5d libraries/template-haskell/Language/Haskell/TH/Syntax.hs | 3 ++- testsuite/tests/safeHaskell/safeLanguage/SafeLang12.hs | 2 -- testsuite/tests/safeHaskell/safeLanguage/SafeLang12.stderr | 7 ++++--- 3 files changed, 6 insertions(+), 6 deletions(-) diff --git a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs index 9de531a..92e48ad 100644 --- a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs +++ b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs @@ -1,6 +1,7 @@ {-# LANGUAGE CPP, DeriveDataTypeable, DeriveGeneric, FlexibleInstances, DefaultSignatures, - RankNTypes, RoleAnnotations, ScopedTypeVariables #-} + RankNTypes, RoleAnnotations, ScopedTypeVariables, + Trustworthy #-} {-# OPTIONS_GHC -fno-warn-inline-rule-shadowing #-} diff --git a/testsuite/tests/safeHaskell/safeLanguage/SafeLang12.hs b/testsuite/tests/safeHaskell/safeLanguage/SafeLang12.hs index 5f1e51c..ba5766b 100644 --- a/testsuite/tests/safeHaskell/safeLanguage/SafeLang12.hs +++ b/testsuite/tests/safeHaskell/safeLanguage/SafeLang12.hs @@ -10,5 +10,3 @@ $(mkSimpleClass ''A) main = do let b = c :: A putStrLn $ "I have a value of A :: " ++ show b - - diff --git a/testsuite/tests/safeHaskell/safeLanguage/SafeLang12.stderr b/testsuite/tests/safeHaskell/safeLanguage/SafeLang12.stderr index b23875b..55aa3a5 100644 --- a/testsuite/tests/safeHaskell/safeLanguage/SafeLang12.stderr +++ b/testsuite/tests/safeHaskell/safeLanguage/SafeLang12.stderr @@ -6,7 +6,8 @@ SafeLang12_B.hs:2:14: warning: -XTemplateHaskell is not allowed in Safe Haskell; ignoring -XTemplateHaskell [1 of 3] Compiling SafeLang12_A ( SafeLang12_A.hs, SafeLang12_A.o ) [2 of 3] Compiling SafeLang12_B ( SafeLang12_B.hs, SafeLang12_B.o ) +[3 of 3] Compiling Main ( SafeLang12.hs, SafeLang12.o ) -SafeLang12_B.hs:5:1: error: - Language.Haskell.TH: Can't be safely imported! - The module itself isn't safe. +SafeLang12.hs:8:1: error: + parse error on input ‘$’ + Perhaps you intended to use TemplateHaskell From git at git.haskell.org Sun Jan 8 04:53:47 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 8 Jan 2017 04:53:47 +0000 (UTC) Subject: [commit: ghc] master: Parse holes as infix operators (6c869f9) Message-ID: <20170108045347.B7AEE3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6c869f906b879bc746ea1aa3e79e02f146d85093/ghc >--------------------------------------------------------------- commit 6c869f906b879bc746ea1aa3e79e02f146d85093 Author: Ömer Sinan Ağacan Date: Sun Jan 8 07:52:53 2017 +0300 Parse holes as infix operators Reported as #13050. Since holes are expressions but not identifiers, holes were not allowed in infix operator position. This patch introduces a new production in infix operator parser to allow this. Reviewers: simonpj, austin, bgamari Reviewed By: simonpj Subscribers: simonpj, RyanGlScott, thomie, mpickering Differential Revision: https://phabricator.haskell.org/D2910 GHC Trac Issues: #13050 >--------------------------------------------------------------- 6c869f906b879bc746ea1aa3e79e02f146d85093 compiler/hsSyn/HsExpr.hs | 1 + compiler/parser/Parser.y | 3 +++ testsuite/tests/typecheck/should_compile/T13050.hs | 6 +++++ .../tests/typecheck/should_compile/T13050.stderr | 31 ++++++++++++++++++++++ testsuite/tests/typecheck/should_compile/all.T | 1 + 5 files changed, 42 insertions(+) diff --git a/compiler/hsSyn/HsExpr.hs b/compiler/hsSyn/HsExpr.hs index 1b6ccdc..18bf54a 100644 --- a/compiler/hsSyn/HsExpr.hs +++ b/compiler/hsSyn/HsExpr.hs @@ -823,6 +823,7 @@ ppr_expr (OpApp e1 op _ e2) = case unLoc op of HsVar (L _ v) -> pp_infixly v HsRecFld f -> pp_infixly f + HsUnboundVar h at TrueExprHole{} -> pp_infixly (unboundVarOcc h) _ -> pp_prefixly where pp_e1 = pprDebugParendExpr e1 -- In debug mode, add parens diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y index 3fc20a1..dfb6755 100644 --- a/compiler/parser/Parser.y +++ b/compiler/parser/Parser.y @@ -3132,6 +3132,9 @@ varop :: { Located RdrName } qop :: { LHsExpr RdrName } -- used in sections : qvarop { sL1 $1 $ HsVar $1 } | qconop { sL1 $1 $ HsVar $1 } + | '`' '_' '`' {% ams (sLL $1 $> EWildPat) + [mj AnnBackquote $1,mj AnnVal $2 + ,mj AnnBackquote $3] } qopm :: { LHsExpr RdrName } -- used in sections : qvaropm { sL1 $1 $ HsVar $1 } diff --git a/testsuite/tests/typecheck/should_compile/T13050.hs b/testsuite/tests/typecheck/should_compile/T13050.hs new file mode 100644 index 0000000..d40c476 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T13050.hs @@ -0,0 +1,6 @@ +module HolesInfix where + +f, g, q :: Int -> Int -> Int +f x y = _ x y +g x y = x `_` y +q x y = x `_a` y diff --git a/testsuite/tests/typecheck/should_compile/T13050.stderr b/testsuite/tests/typecheck/should_compile/T13050.stderr new file mode 100644 index 0000000..b8ccd76 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T13050.stderr @@ -0,0 +1,31 @@ + +T13050.hs:4:9: warning: [-Wtyped-holes (in -Wdefault)] + • Found hole: _ :: Int -> Int -> Int + • In the expression: _ + In the expression: _ x y + In an equation for ‘f’: f x y = _ x y + • Relevant bindings include + y :: Int (bound at T13050.hs:4:5) + x :: Int (bound at T13050.hs:4:3) + f :: Int -> Int -> Int (bound at T13050.hs:4:1) + +T13050.hs:5:11: warning: [-Wtyped-holes (in -Wdefault)] + • Found hole: _ :: Int -> Int -> Int + • In the expression: _ + In the expression: x `_` y + In an equation for ‘g’: g x y = x `_` y + • Relevant bindings include + y :: Int (bound at T13050.hs:5:5) + x :: Int (bound at T13050.hs:5:3) + g :: Int -> Int -> Int (bound at T13050.hs:5:1) + +T13050.hs:6:11: warning: [-Wtyped-holes (in -Wdefault)] + • Found hole: _a :: Int -> Int -> Int + Or perhaps ‘_a’ is mis-spelled, or not in scope + • In the expression: _a + In the expression: x `_a` y + In an equation for ‘q’: q x y = x `_a` y + • Relevant bindings include + y :: Int (bound at T13050.hs:6:5) + x :: Int (bound at T13050.hs:6:3) + q :: Int -> Int -> Int (bound at T13050.hs:6:1) diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index d628366..40d31bb 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -563,3 +563,4 @@ test('T12911', normal, compile, ['']) test('T12925', normal, compile, ['']) test('T12919', expect_broken(12919), compile, ['']) test('T12936', normal, compile, ['']) +test('T13050', normal, compile, ['-fdefer-type-errors']) From git at git.haskell.org Mon Jan 9 04:43:50 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 9 Jan 2017 04:43:50 +0000 (UTC) Subject: [commit: ghc] branch 'wip/ghci-staticptrs' created Message-ID: <20170109044350.968B83A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/ghci-staticptrs Referencing: 98ed207472febdc3b2a144267f8af9b29b44934c From git at git.haskell.org Mon Jan 9 04:43:57 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 9 Jan 2017 04:43:57 +0000 (UTC) Subject: [commit: ghc] wip/ghci-staticptrs: FloatOut: Allow floating through breakpoint ticks (326931d) Message-ID: <20170109044357.0E5953A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ghci-staticptrs Link : http://ghc.haskell.org/trac/ghc/changeset/326931db9cdc26f2d47657c1f084b9903fd46246/ghc >--------------------------------------------------------------- commit 326931db9cdc26f2d47657c1f084b9903fd46246 Author: Ben Gamari Date: Mon Sep 5 22:50:42 2016 -0400 FloatOut: Allow floating through breakpoint ticks I suspect this is actually a completely valid thing to do, despite the arguments put forth in #10052. >--------------------------------------------------------------- 326931db9cdc26f2d47657c1f084b9903fd46246 compiler/simplCore/FloatOut.hs | 27 +++++++++++++-------------- 1 file changed, 13 insertions(+), 14 deletions(-) diff --git a/compiler/simplCore/FloatOut.hs b/compiler/simplCore/FloatOut.hs index 3c220fe..028b87b 100644 --- a/compiler/simplCore/FloatOut.hs +++ b/compiler/simplCore/FloatOut.hs @@ -260,26 +260,21 @@ floatBody lvl arg -- Used rec rhss, and case-alternative rhss {- Note [Floating past breakpoints] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Notes from Peter Wortmann (re: #10052) +We used to disallow floating out of breakpoint ticks (see #10052). However, I +think this is too restrictive. -"This case clearly means we're trying to float past a breakpoint..." +Consider the case of an expression scoped over by a breakpoint tick, -Further: + tick<...> (let x = ... in f x) -"Breakpoints as they currently exist are the only Tikish that is not -scoped, counting, and not splittable. +In this case it is completely legal to float out x, despite the fact that +breakpoint ticks are scoped, -This means that we can't: - - Simply float code out of it, because the payload must still be covered (scoped) - - Copy the tick, because it would change entry counts (here: duplicate breakpoints)" + let x = ... in (tick<...> f x) -While this seems like an odd case, it can apparently occur in real -life: through the combination of optimizations + GHCi usage. For an -example, see #10052 as mentioned above. So not only does the -interpreter not like some compiler-generated things (like unboxed -tuples), the compiler doesn't like interpreter-introduced things! +The reason here is that we know that the breakpoint will still be hit when the +expression is entered since the tick still scopes over the RHS. -Also see Note [GHCi and -O] in GHC.hs. -} floatExpr :: LevelledExpr @@ -318,6 +313,10 @@ floatExpr (Tick tickish expr) (fs, annotated_defns, Tick tickish expr') } -- Note [Floating past breakpoints] + | Breakpoint{} <- tickish + = case (floatExpr expr) of { (fs, floating_defns, expr') -> + (fs, floating_defns, Tick tickish expr') } + | otherwise = pprPanic "floatExpr tick" (ppr tickish) From git at git.haskell.org Mon Jan 9 04:43:54 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 9 Jan 2017 04:43:54 +0000 (UTC) Subject: [commit: ghc] wip/ghci-staticptrs: Add support for StaticPointers in GHCi (98ed207) Message-ID: <20170109044354.564883A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ghci-staticptrs Link : http://ghc.haskell.org/trac/ghc/changeset/98ed207472febdc3b2a144267f8af9b29b44934c/ghc >--------------------------------------------------------------- commit 98ed207472febdc3b2a144267f8af9b29b44934c Author: Ben Gamari Date: Wed Aug 31 19:39:54 2016 -0400 Add support for StaticPointers in GHCi Here we add support to GHCi for StaticPointers. This process begins by adding remote GHCi messages for adding entries to the static pointer table. We then collect binders needing SPT entries after linking and send the interpreter a message adding entries with the appropriate fingerprints. >--------------------------------------------------------------- 98ed207472febdc3b2a144267f8af9b29b44934c compiler/ghci/GHCi.hsc | 7 ++++ compiler/main/HscMain.hs | 11 +++++++ compiler/main/StaticPtrTable.hs | 46 ++++++++++++++++----------- compiler/main/TidyPgm.hs | 10 ++++-- compiler/rename/RnExpr.hs | 9 ------ includes/rts/StaticPtrTable.h | 8 +++++ libraries/ghci/GHCi/Message.hs | 8 ++++- libraries/ghci/GHCi/RemoteTypes.hs | 3 +- libraries/ghci/GHCi/Run.hs | 2 ++ libraries/ghci/GHCi/StaticPtrTable.hs | 21 ++++++++++++ libraries/ghci/ghci.cabal.in | 1 + rts/RtsSymbols.c | 1 + rts/StaticPtrTable.c | 12 ++++--- testsuite/tests/ghci/scripts/StaticPtr.hs | 20 ++++++++++++ testsuite/tests/ghci/scripts/StaticPtr.script | 23 ++++++++++++++ testsuite/tests/ghci/scripts/StaticPtr.stdout | 3 ++ testsuite/tests/ghci/scripts/all.T | 1 + 17 files changed, 151 insertions(+), 35 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 98ed207472febdc3b2a144267f8af9b29b44934c From git at git.haskell.org Mon Jan 9 10:44:44 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 9 Jan 2017 10:44:44 +0000 (UTC) Subject: [commit: ghc] wip/all-inlinable: Always expose unfoldings for overloaded functions. (4d0fc4e) Message-ID: <20170109104444.C526B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/all-inlinable Link : http://ghc.haskell.org/trac/ghc/changeset/4d0fc4e79d3a182a5d4f3f973ea174ece01ca95b/ghc >--------------------------------------------------------------- commit 4d0fc4e79d3a182a5d4f3f973ea174ece01ca95b Author: Matthew Pickering Date: Sat Aug 6 22:17:09 2016 +0100 Always expose unfoldings for overloaded functions. Summary: Users expect their overloaded functions to be specialised at call sites, however, this is only the case if they are either lucky and GHC chooses to include the unfolding or they mark their definition with an INLINABLE pragma. This leads to library authors marking all their functions with `INLINABLE` (or more accurately `INLINE`) so they ensure that downstream consumers pay no cost for their abstraction. A more sensible default is to do this job for the library author and give more predictable guarantees about specialisation. Empirically, I compiled a selection of 1150 packages with (a similar) patch applied. The total size of the interface files before the patch was 519mb and after 634mb. On modern machines, I think this increase is justified for the result. Reviewers: simonpj, austin, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2929 >--------------------------------------------------------------- 4d0fc4e79d3a182a5d4f3f973ea174ece01ca95b compiler/main/TidyPgm.hs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/compiler/main/TidyPgm.hs b/compiler/main/TidyPgm.hs index 8f2e334..82dd71c 100644 --- a/compiler/main/TidyPgm.hs +++ b/compiler/main/TidyPgm.hs @@ -58,6 +58,7 @@ import ErrUtils (Severity(..)) import Outputable import SrcLoc import qualified ErrUtils as Err +import TcType ( isOverloadedTy ) import Control.Monad import Data.Function @@ -726,6 +727,7 @@ addExternal expose_all id = (new_needed_ids, show_unfold) never_active = isNeverActive (inlinePragmaActivation (inlinePragInfo idinfo)) loop_breaker = isStrongLoopBreaker (occInfo idinfo) bottoming_fn = isBottomingSig (strictnessInfo idinfo) + is_overloaded = isOverloadedTy (idType id) -- Stuff to do with the Id's unfolding -- We leave the unfolding there even if there is a worker @@ -737,7 +739,8 @@ addExternal expose_all id = (new_needed_ids, show_unfold) || isStableSource src -- Always expose things whose -- source is an inline rule - + || is_overloaded -- Always expose overloaded things so that + -- they can be specialised at call sites. || not (bottoming_fn -- No need to inline bottom functions || never_active -- Or ones that say not to || loop_breaker -- Or that are loop breakers From git at git.haskell.org Mon Jan 9 10:44:47 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 9 Jan 2017 10:44:47 +0000 (UTC) Subject: [commit: ghc] wip/all-inlinable: Add trace statement to see what is being included (9f63416) Message-ID: <20170109104447.7254D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/all-inlinable Link : http://ghc.haskell.org/trac/ghc/changeset/9f63416aae812a3efa31e17da89c05e9e42cfd2d/ghc >--------------------------------------------------------------- commit 9f63416aae812a3efa31e17da89c05e9e42cfd2d Author: Matthew Pickering Date: Mon Jan 9 10:44:06 2017 +0000 Add trace statement to see what is being included >--------------------------------------------------------------- 9f63416aae812a3efa31e17da89c05e9e42cfd2d compiler/main/TidyPgm.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/compiler/main/TidyPgm.hs b/compiler/main/TidyPgm.hs index 82dd71c..2f41b7a 100644 --- a/compiler/main/TidyPgm.hs +++ b/compiler/main/TidyPgm.hs @@ -739,7 +739,9 @@ addExternal expose_all id = (new_needed_ids, show_unfold) || isStableSource src -- Always expose things whose -- source is an inline rule - || is_overloaded -- Always expose overloaded things so that + || (if is_overloaded + then pprTrace "ADDITION UNFOLDING" (ppr id) True + else False) -- Always expose overloaded things so that -- they can be specialised at call sites. || not (bottoming_fn -- No need to inline bottom functions || never_active -- Or ones that say not to From git at git.haskell.org Mon Jan 9 10:44:54 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 9 Jan 2017 10:44:54 +0000 (UTC) Subject: [commit: ghc] wip/all-inlinable's head updated: Add trace statement to see what is being included (9f63416) Message-ID: <20170109104454.6469C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/all-inlinable' now includes: 0675f79 configure.ac: Bump version to 8.0 69a25d6 Bump GHC version to 8.0.0 9418ee7 Declare that ghc:ghc-8.0 is tracking haddock:master 95fdf59 Address #11245: Ensure the non-matched list is always non-empty 39237c1 Use 0/1 instead of YES/NO as `__GLASGOW_HASKELL_TH__` macro value ae2c4d8 Add strictness for runRW# b24fcb5 Various API Annotations fixes 8775e4c fix ghci build on ArchUnknown targets 28b0693 Improve exprIsBottom b482745 Update Cabal submodule, Fixes #11326 0392a23 API Annotations: AnnTilde missing 8de4775 AnnDotDot missing for Pattern Synonym export 7d2f41c Linker: ARM: Ensure that cache flush covers all symbol extras e042582 Linker: ARM: Refactor relocation handling e32765b Linker: Make debugging output a bit more readable 266bc33 Linker: Use contiguous mmapping on ARM 7210976 Linker: ARM: Don't change to BLX if jump needed veneer 9c09d9a Linker: Move helpers to #ifdef e8b482c Rewrite Haddocks for GHC.Base.const a096e2f users_guide: Add ghci-cmd directive c1acc2a Avoid generating guards for CoPats if possible (Addresses #11276) 1cff3ca relnotes: Remove redundant entry 8270536 Add Cabal synopses and descriptions 57fa4c5 Extend ghc environment file features 5e92a08 relnotes: Note dropped support for Windows XP and earlier 138e501 Restore old GHC generics behavior vis-à-vis Fixity 907cfd4 Bump haskeline submodule ff1ce4c Bump Cabal and Haddock to fix #11308 e1c6a19 Change Template Haskell representation of GADTs. 5716c0d Remove -Wtoo-many-guards from default flags (fixes #11316) c6190c7 Add a note describing the protocol for adding a language extension 595eb24 Fall back on ghc-stage2 when using Windows' GHCi driver 91eddc1 users guide: Add documentation for custom compile-time errors 7319008 users guide: Add links to release notes d191ca7 Rewrite announce file b37472b users guide: Tweak wording of RTS -Nmax description 9578cb2 Fix Template Haskell's handling of infix GADT constructors 91bd13c Improve GHC.Event.IntTable performance 4eba0c5 Enable stack traces with ghci -fexternal-interpreter -prof 4d5caf1 Support for qRecover in TH with -fexternal-interpreter f66dbdd User's Guide: injective type families section 50658d2 Docs for stack traces in GHCi cd9f37c users_guide: Use semantic directive/role for command line options eaf8d53 Fix test for T9367 (Windows) d699446 Fix +RTS -h when compiling without -prof 313e1b3 Rename the test-way prof_h to normal_h c4e7c1d Add a pointer to the relevant paper for InScopeSet 29bce35 users-guide: A few fixes 2840bc1 docs: Fix DeriveAnyClass reference in release notes and ANNOUNCE fa114f7 user-guide: More semantic markup a8ab34a user-guide/safe_haskell: Fix typos 4c8e203 Reject import declaration with semicolon in GHCi 3deb446 Add (failing) test case for #11347 6c956b6 Use an Implication in 'deriving' error d60b89b Turn AThing into ATcTyCon, in TcTyThing 279f080 Add failing testcase for #10603 707b2be fix -ddump-splices to parenthesize ((\x -> x) a) correctly 62ce23f Add InjectiveTypeFamilies language extension a8568e0 configure.ac: Bump version to 8.0.1 497454f configure.ac: Bump down version number 0f2cb66 ghc.mk: Use Windows_Target instead of Windows_Host 9705d54 Linker: Define ELF_64BIT for aarch64_HOST_ARCH 3cf940b fix typo causing compilation failure on SPARC (ArchSparc -> ArchSPARC) b54ea29 Add -prof stack trace to assert 74b06cf A little closer to supporting breakpoints with -fexternal-interpreter ec85e1e Use implicit CallStacks for ASSERT when available b8d32e2 TemplateHaskell: revive isStrict, notStrict and unpacked 45c4cc1 Print a message when loading a .ghci file. e6a6d29 Handle over-applied custom type errors too. 5878aa0 Minor improvement in CoreDump outputs: 2f78d98 Minor code refactoring 5daf176 users-guide: Wibbles 20b0416 GHC.Generics: Fix documentation 59f58ea Add tests for #11391 35751ec INSTALL.md: Mention -j and other wibbles 76cfbc0 Rename InjectiveTypeFamilies to TypeFamilyDependencies 62fa1cc users-guide: Update language extension implications eb13ce9 users-guide: Add since annotations for language extensions 84f1841 user-guide: Use ghc-flag for dump formatting flags b018abe API Annotations: use AnnValue for (~) c95bb5e T11300: Fix test on windows ca473b7 Remove lookup of sections by name instead use the index numbers as offsets 0812e32 Fix #11015 with a nice note. 465267d ANNOUNCE: Mention powerpc code generator d38daab user-guide: Note Cabal version limitation e81043d users-guide: Fix cabal version number e4c8659 Link command line libs to temp so 68a0452 Use XZ compression by default 50d3b7f Don't output manpage in same directory as source 3e1f49f Refactor lookupFixityRn-related code following D1744 cdfceac configure.ac: Export MAKECMD to build system e2c7397 Allow pattern synonyms which have several clauses. 20f848b Expand type/kind synonyms in TyVars before deriving-related typechecking d4661c1 Fix #11355. b41586b Test #11252 in ghci/scripts/T11252 a1a054b Fix #10872. 7e58aa0 Fix #11311 eb09b29 Clarify topological sorting of spec vars in manual 4c53ab2 Fix #11254. e7ae7cc Constrained types have kind * in validity check. a5bb480 Fix #11404 c24f868 Tiny refactoring in TcUnify b7af30f Fix typo in error message (#11409) 018f866 Fix #11405. b212af5 Fix some typos 953bbd3 Work SourceText in for all integer literals 9f466c8 Fix a number of subtle solver bugs 0fb7d4a Add missing T11408.hs 30caafe rts/posix: Fail with HEAPOVERFLOW when out of memory during mmap 288afc9 Add missing type representations e7bea17 users-guide: Clean manpage build artifacts and fix usage of clean-target a501fa4 Complete operators properly 4b01ce3 Show TYPE 'Lifted/TYPE 'Unlifted as */# in Show TypeRep instance 1f1a6aa Add testcase for #11414 526df12 validate: Use gz compression during bindist check 6135de3 Make demand analysis understand catch 500ddd3 Test Trac #11379 b31aafb un-wire-in error, undefined, CallStack, and IP c94ef29 users-guide: Begin documenting --frontend 3b1dae2 Fix typecheck of default associated type decls 8e6ec66 Simplify API to tcMatchTys 4d85c62 Layout only ff333a4 White space only 00b64a5 Improve debug printing/warnings b8fcf05 Refactoring on IdInfo and system derived names cfaeaf4 Add Trac #11427 to Note [Recursive superclasses] 8c10ee3 Implement scoped type variables in pattern synonyms 30d0313 Typo in comment 467f94f Fixes to "make clean" for the iserv dir f02fefd Replace calls to `ptext . sLit` with `text` 9cebc24 Switch from -this-package-key to -this-unit-id. 9053716 ghci: Kill global macros list 4a8b2ca Hide derived OccNames from user 614adc3 user-guide: Delete errant fragment f7ca52a Re-export ghc-boot:GHC.Serialized as Serialized 36e1fea Fix bootstrapping with GHC 7.8. 8cc82bc Typos in comments 6722f8d Fix IfaceType generation for TyCons without TyVars 910b7ee T11266: Improve the test by adding more of the other problematic modules fc5f857 Fix combineIdenticalAlts 82efc3e Use (&&) instead of `if` in Ix derivation 19dc3cb Rework derivation of type representations for wired-in things 5497ee4 Add test for Data.Typeable.typeOf 481ff7a Check InScopeSet in substTy and provide substTyUnchecked 1018345 substTy to substTyUnchecked to fix Travis build e7e2ac8 Re-add missing kind generalisation ff6783d Comments only 91c3424 Improve pretty-printing of UnivCo 76d8549 Strip casts in checkValidInstHead f3354fc Allow implicit parameters in constraint synonyms 56a9f93 TyCoRep: Restore compatibility with 7.10.1 47b84b6 user-guide:: Improve -D description dcf4b4c user-guide: Refer to MIN_VERSION_GLASGOW_HASKELL from intro 83c393f rel-notes: Note the return of -Wmonomorphism-restriction 00fc0d7 Update and improve documentation in Data.Foldable 31d8718 Add -ignore-dot-ghci to tests that use --interactive ede37fd Fix docstring GHC.IO.Handle.FD.openFileBLocking e6bbaef sphinx-build: fix python stack overflow (Trac #10950) 4504243 Improve comments in CmmSwitch c698f1f Make a constraint synonym for repeated BinaryStringRep and use it. 38dc961 Default non-canonical CallStack constraints a11e9a6 User's guide: fix singular/plural typo in flagnames e4c96ca Implement `-Wnoncanonical-monadfail-instances` warning d6adfaa TyCoRep: Restore compatibility with GHC 7.8 4eed412 Add test for #11473 70f01d0 Don't print "Loaded GHCi configuration" message in ghc -e (#11478) 5627ff4 Mark some ghci tests as req_interp 0ace13a Fix a formatting error in the user's guide 4b4d4c3 Do not count void arguments when considering a function for loopification. 46d7840 Add test for Trac #11056 07dc7fc Small doc fix ddbb711 Give a more verbose error message when desugaring a HsTypeOut 57bce48 Remove -Wredundant-superclasses from standard warnings 56d0867 mkUserGuidePart: Better flag cross-referencing 1a0e993 user-guide: Reformat warning lists d14465b user-guide: Fix typos d56d11f Don't add ticks around type applications (#11329) e1b7490 user-guide: Document -L RTS flag 523e1e5 Docs: delete section on Hierarchical Modules 9d30644 Remove `replaceDynFlags` from `ContainsDynFlags` 529e7c2 Add -fwarn-redundant-constrains to test for #9708 6217147 Special-case implicit params in superclass expansion 1e6bdbc Fix exprIsHNF (Trac #11248) f48fdee Show error message for unknown symbol on Elf_Rel platforms b53c643 HscTypes: Fix typo in comment b9fd059 Rename -Wmissing-monadfail-instance to plural-form f31372c Better document behavior of -Wmissed-specialisations bf22ede user-guide: Note order-dependence of flags e37b571 Avoid recursive use of immSuperClasses bbd9356 Implement -Wunrecognised-warning-flag 761d423 Ensure that we don't produce code for pre-ARMv7 without barriers 26a9f13 rts: Disable tick timer unless really needed 835b3ba White space only e035680 Add "ticks-exhausted" comment f47feda Kill off zipTopTCvSubst in favour of zipOpenTCvSubst c4e94cd Fix two cloning-related bugs 6d797c7 Missed plural renaming in user's guide 06bfee3 Minor users-guide markup fixup [skip ci] 251ec58 Update transformers submodule to 0.5.1.0 release f37e98e Update process submodule to 1.4.2.0 release 940aa47 Fix three broken tests involving exceptions 1524945 Pass InScopeSet to substTy in lintTyApp fb6e876 Nicer error on +RTS -hc without -rtsopts or -prof 8efe964 Fix segmentation fault when .prof file not writeable 2d3f277 Split off -Wunused-type-variables from -Wunused-matches c325baf Construct in_scope set in mkTopTCvSubst f5ccb52 Testsuite: fixup req_profiling tests (#11496) 7c6215b Build profiling libraries on `validate --slow` (#11496) 0e90d3b Enable RemoteGHCi on Windows 4f383ee Fix a typo in the note name in comments 4459a61 Typos in comments e17a1d5 ghci: fix trac issue #11481 7d123cc rts/Timer: Actually fix #9105 7a70f98 Restore original alignment for info tables ac90950 Hide the CallStack implicit parameter 49637f8 Implement basic uniform warning set tower 63de06a Fix LOOKS_LIKE_PTR for 64-bit platforms 555825c Typo in docs c5f4f95 Put docs in /usr/share/doc/ghc- bb2f21d Tidy up tidySkolemInfo 278e1fa Refactor the typechecker to use ExpTypes. 2c48f1c Remote GHCi: create cost centre stacks in batches 6704660 Avoid mangled/derived names in GHCi autocomplete (fixes #11328) 5553041 Update unix submodule to latest snapshot 738234a Remote GHCi: Optimize the serialization/deserialization of byte code 2cd828e Remote GHCi: batch the creation of strings e2715ce Remote GHCi: parallelise BCO serialization 8f37073 fix validate breakage 12288de Update cabal_macros_boot.h a90faf3 Update binary submodule to 0.8.2.0 release b8c8d4c Add type signatures. 28ee6ca Code formatting cleanup. 31c11d0 Properly track live registers when saving the CCCS. bd811e6 Use a correct substitution in tcCheckPatSynDecl 9e477d5 Define CTYPE for more Posix types fc5ed86 Make TypeError a newtype, add changelog entry fdd7ac3 Rename "open" subst functions 35d9486 Fix some substitution InScopeSets 865e746 Use the in_scope set in lint_app ac11de6 Allow all RTS options to iserv 6e23b68 Overhaul the Overhauled Pattern Match Checker e971c03 Fix a few loose ends from D1795 e223022 Bump Cabal submodule 53dfaf7 Fix the Windows build 5b35c55 GHCi: Fix Windows build (again) bffb7af Add a derived `Show SrcLoc` instance 82cb529 Fix @since annotations for renamed pretty{CallStack,SrcLoc} ddb3dc7 Use default xz compression level d041dad mkDocs: Update for xz 9d1ebfb mkDocs: Fix fallout from c5f4f95c64006a9f 25eb907 Fix haddocks for TypeError 4206af6 Bump haddock submodule b3086e6 user-guide: Add cross-reference for -XUnicodeSyntax 2c44209 Add test for #11516 194820d Remove unused export from TcUnify e02a57d Document and improve superclass expansion 4916993 Improve error messages for recursive superclasses aa830b1 Fix a nasty superclass expansion bug 2bda32e release notes: Note new two-step allocator 3b3be92 Print * has Unicode star with -fprint-unicode-syntax a29dc1d testsuite: Un-break T5642 16c5445 Early error when crosscompiling + haddock/docs ac0732f Unset GREP_OPTIONS in build system b11b357 Restore derived Eq instance for SrcLoc 503acfa TcErrors: Fix plural form of "instance" error 7346013 TcPatSyn: Fix spelling of "pattern" in error message 63e7d45 DynFlags: drop tracking of '-#include' flags a67c8d5 Expand users' guide TH declaration groups section (#9813) 7fc4300 Error early when you register with too old a version of Cabal. 9b0ffd4 compiler: Do not suggest nor complete deprecated flags fix trac issue #11454 d0b4ead Fix the removal of unnecessary stack checks d0010d7 Wrap solveEqualities in checkNoErrs 23ee5ce Bump haddock submodule d977fb8 Update directory submodule to v1.2.5.1 release 80beb40 Add IsList instance for CallStack, restore Show instance for CallStack c4e51c8 Simplify AbsBinds wrapping 9edad91 Beef up tc124 9ea96d5 Improve pretty-printing of HsWrappers 4825afe Minor refactoring to tauifyMultipleMatches 8a66958 s/unLifted/unlifted for consistency 28c26d9 Allow foralls in instance decls c0e380f User manual improvments 62ed152 renamer discards name location for HsRecField 0e2b99a Improve error message suppression acefdeb Document -dynamic-too (#11488) a885f48 A tiny, outright bug in tcDataFamInstDecl c64c1e4 Rename missing-pat-syn-sigs to missing-pat-syn-signatures 8655068 Add missing newlines at end of file [skip ci] 287d083 Make bootstrapping more robust d2744a3 Improved error message about exported type operators. f3fe3c5 Fix two wrong uses of "data constructor" in error msgs e091062 Fix typos a938c7a Suggest candidate instances in error message 2a9fce0 Remove documentation for -Wlazy-unlifted-bindings ad6a7a3 DynFlags: Don't panic on incompatible Safe Haskell flags 01d0079 Make exactTyCoVarsOfTypes closed over kinds. 31ab4b6 Existentials should be specified. c88cd45 Add missing kind cast to pure unifier. e1631b3 Remove extraneous fundeps on (~) 3b80156 Use CoercionN and friends in TyCoRep 314e148 Fix #11241. 6133d58 Fix #11246. b2db13a Fix #11313. 004dc1c users-guide: Fix typos 77de825 Add a testcase for #11362 98df0e3 Fix bug where reexports of wired-in packages don't work. d6ea90a Fix desugaring of bang-pattern let-bindings 6013321 Unwire Typeable representation types 23baff7 Bump haddock submodule 892de05 Fix a double-free bug in -fexternal-interpreter 881b6cc Revert "Remove extraneous fundeps on (~)" 3d345e8 Extend `-Wunrecognised-warning-flag` to cover `-f(no-)warn-*` 05e83aa Fix GHC.Stats documentation markup (#11619) ec701bc Testsuite: delete Windows line endings [skip ci] (#11631) e2defb8 Testsuite: delete Windows line endings [skip ci] (#11631) c5bf4c0 Testsuite: delete Windows line endings [skip ci] (#11631) 6bd1d97 Testsuite: delete Windows line endings [skip ci] (#11631) 461f804 Testsuite: delete Windows line endings [skip ci] (#11631) 908973b Testsuite: accept output without Windows line endings (#11631) 6a2e22b Testsuite: accept output without Windows line endings (#11631) 3d6f24d Testsuite: delete Windows line endings [skip ci] (#11631) 18a921b Testsuite: delete Windows line endings [skip ci] (#11631) 2b79025 base: A selection of fixes to the comments in GHC.Stats 649cb34 Fix and refactor strict pattern bindings 70287bc Overload the static form to reduce verbosity. 5eb31d2 Fix cost-centre-stack bug when creating new PAP (#5654) 2c6d4fa Testsuite: cleanup profiling/should_run/all.T (#11521) dd55ce4 Filter out -prof callstacks from test output (#11521) f6c8ce9 Refactoring only: use ExprLStmt e3020f2 Fix a bug in ApplicativeDo (#11612) 32e2d58 ApplicativeDo: Handle terminal `pure` statements e61e290 Make warning names more consistent a69542b Handle multiline named haddock comments properly 934022c Filter out BuiltinRules in occurrence analysis 7f15c2b Exclude TyVars from the constraint solver c7d83f8 Get the right in-scope set in specUnfolding 6f7baa0 cmpTypeX: Avoid kind comparison when possible c980640 Docs: -keep-llvm-file(s)/-ddump-llvm imply -fllvm 680557c (Alternative way to) address #8710 6fd8cf4 Fix kind generalisation for pattern synonyms 66029cc Reconstruct record expression in bidir pattern synonym 9d7f890 Remove superfluous code when deriving Foldable/Traversable 1fcddf8 Add more type class instances for GHC.Generics 4e7a46f Note new GHC.Generics instances in release notes b89747e GHC.Generics: Ensure some, many for U1 don't bottom ab4f1c5 Update transformer submodule to v0.5.2.0 release 4f5b7ad Print which warning-flag controls an emitted warning 2091439 Print which flag controls emitted desugaring warnings 02e91ac Print which flag controls emitted lexer warnings 94b2681 Annotate `[-Wredundant-constraints]` in warnings (re #10752) 2ffd9b1 Print which flag controls emitted SafeHaskell warnings 966cc28 Annotate `[-Wdeferred-type-errors]` in warnings (re #10752) 975353b Default to -fno-show-warning-groups (re #10752) b213a84 Test Trac #11611 0fb2d54 rts: drop unused global 'blackhole_queue' 18e5edc Missing Proxy instances, make U1 instance more Proxy-like 90d2cd7 base: Mark Data.Type.Equality as Trustworthy 8c04585 Build system: Correctly pass `TARGETPLATFORM` as host 0af2be8 DynFlags: Add -Wredundant-constraints to -Wall b7a2d22 HsPat: Restore compatibility with ghc-7.8 b0f5a2a Update submodule to Cabal-1.24 branch dedff08 Define mkTvSubst, and use it 3fc2336 Fix an outright bug in expandTypeSynonyms ff3f7d0 testsuite: Bump haddock.base allocations af7a35f users-guide: Mention #11558 in release notes 6ae616f GHCi: Fix load/reload space leaks (#4029) 37310ef Fix printing of an `IfacePatSyn` 40d08b6 Drop module qualifier from punned record fields (#11662) 125f68a template-haskell: Drop use of Rank2Types/PolymorphicComponents 35b747f template-haskell: define `MonadFail Q` instance 62f3dc1 Update submodule to latest Cabal-1.24 snapshot 43163e3 Do not check synonym RHS for ambiguity 57cfb47 Document Quasi-quotes/list comprehension ambiguity cabe462 Include version in AC_PACKAGE_TARNAME 74bb198 Add ghc-flag directory for -XPatternGuards 6e524eb Handle unset HOME environment variable more gracefully 15acd42 Bump allocations for T6048 8e8b6df Make integer-gmp operations more strict bbdc52f rts/timer: use timerfd_* on Linux instead of alarm signals fd3e581 rtx/posix/Itimer.c: Handle return value of `read` 051765f Fix the implementation of lazyId 2e0ef45 Make `catch` lazy in the action caef285 Use catchException in a few more places a90c51f Add regression test for #11555 88a86f1 Fix #11624, cannot declare hs-boot if already one in scope. 745bdd8 Unconditionally handle TH known key names. 7d5bdea GhcMake: Clang/ASSERT fix 5f66ae5 Add MonadUnique instance for LlvmM 1e7764c LlvmCodeGen: Fix generation of malformed LLVM blocks 89bec2c ghci: add message when reusing compiled code #9887 bd45497 rts: fix threadStackUnderflow type in cmm 8358be7 Add doc to (<$>) explaining its relationship to ($) 8be75ec Fix readme link to FixingBugs wiki page 79737db Fix minimum alignment for StgClosure (Trac #11395) c769188 Split external symbol prototypes (EF_) (Trac #11395) f996692 fix Float/Double unreg cross-compilation 0f606fa Add asserts to other substitution functions 3162121 Suppress substitution assertions to fix tests 5da67ba (Another) minor refactoring of substitutions 6ccb004 Improve piResultTys and friends 223ef8d Address #11471 by putting RuntimeRep in kinds. 5830ffd LlvmCodeGen: Make it compile with ghc-7.8 6960d52 Fix the name of the Word16ElemRep wired-in datacon cd585d6 Add regression test for #11702 b9093a5 Move and expand (slightly) TypeApplications docs d23e9ef Fix #11407. 44a95c6 Fix #11334. e0ca94e Fix #11401. 7293209 Refactor visible type application. 4aef864 Expand Note [Non-trivial definitional equality] 397362e Test case for #11699 in typecheck/should_compile 0c64467 users_guide: Break up -fprint-* description ace3dd9 Document TypeInType (#11614) eda74a7 Fix #11648. d3991f3 Allow eager unification with type families. 7ce1ef0 Testsuite wibbles from previous commits. a969330 Incorporate bgamari's suggestions for #11614. 0560ca6 stgMallocBytes: Tolerate malloc(0) returning a NULL ptr fd139fc PPC NCG: Emit more portable `fcmpu 0, ...` instead of `fcmpu cr0, ...` ad5ee57 Remove redundant anonymiseTyBinders (#11648) 6247d27 Fix printing of "kind" vs. "type" 496c210 Clean up some pretty-printing in errors. 6a670e2 Fix #11716. fefbd6c typechecker: fix trac issue #11708 4c64da0 Fix #11512 by getting visibility right for methods e3cf12a Fix #11711. 6e99d03 Fix #11473. a31bc44 Revert "Add test for #11473" b1f26af Fix #11357. 19ab525 DsExpr: Don't build/foldr huge lists eaa07ba Remove the check_lifted check in TcValidity 630d079 PrelRules: Fix constant folding for WordRemOp 9a2c0d8 T9357: Fix expected output 4bc13dd Fix duplicate T11334 test 6babb89 DriverPipeline: Fix 'unused arguments' warnings from Clang 8dff211 Add test for #9646 9246525 Mark GHC.Real.even and odd as INLINEABLE 573716f Fix T9646 8c61f12 prof: Fix heap census for large ARR_WORDS (#11627) c948a30 Delete a misleading comment in TyCon 919e5c1 Fix exponential algorithm in pure unifier. fcf36a9 TypeApplications does not imply AllowAmbiguousTypes 4183976 Add two small optimizations. (#11196) 74f760a Fix #11635 / #11719. 1d74e4d Improve pattern synonym error messages (add `PatSynOrigin`) 1938568 Comment a suspicious zonk in TcFlatten. 9bb204a Refactoring around TcPatSyn.tcPatToExpr fefaba9 Track specified/invisible more carefully. f840006 Zonk before calling splitDepVarsOfType. 54bacdd Fix #11723 and #11724. c60141f Improve panicking output 1c586cf Comments (only) in TcFlatten 65dc975 Use the correct in-scope set in coercionKind 09b872d Make equality print better. (#11712) f6d2748 Rename test for #11334 to 11334b, fixing conflict 84ca17f Prevent eager unification with type families. aeafaf6 Replace mkTvSubstPrs (a `zip` b) with zipTvSubst a b 4bcec82 Avoid running afoul of the zipTvSubst check. ade015c Avoid local label syntax for assembler on AIX 0d87eb5 Move getOccFS to Name 17f8814 Simplify: Make generated names more useful 1d87402 add regression test for #11145. cf38cec Fix regression test for #11145. 4e5a0b0 Ensure T9646 dump-simpl output is cleaned 11d5727 ErrUtils: Add timings to compiler phases 13a54bc Add `PatSynSigSkol` and modify `PatSynCtxt` 803cbd8 Close ticky profiling file stream after printing (#9405) f733608 DsExpr: Rip out static/dynamic check in list desugaring 1624fd9 Create empty dump files (fixes #10320) 457d15f ErrUtils: Emulate getAllocationCounter on GHC 7.8 0616691 Show: Restore redundant parentheses around records f0dcd55 Default RuntimeRep variables unless -fprint-explicit-runtime-reps ed3398d Defer inlining of Eq for primitive types 1b75e1d Define tyConRolesRepresentational and use it 9f8e1d9 Add test for incompatible flags (issue #11580) 4aadd5f users_guide: Fix various issues abca151 users-guide: Add -Wredundant-constraints to flags reference 86d63d6 users_guide: small improvements on pattern synonyms. c12ae2f Tidy up handling of coercion variables b200051 Add NCG support for AIX/ppc32 bf6e208 base: Fix GHC.Word and GHC.Int on 32-bit platforms 7f2d6f5 Do not eta-reduce across Ticks in CorePrep eeb2ba1 CorePrep: refactoring to reduce duplication 590b84b Document implicit quantification better 8c62c66 More clarification in docs for implicit quantification 0a13e0c Make it compile with ghc-7.8 92ec7e0 Remove now obsolete LD_STAGE0 hack 91a8e92 Fix #11754 by adding an additional check. c4f7363 Check for rep poly on wildcard binders. f260738 Clarify Note [Kind coercions in Unify] 2b5f736 DWARF: Add debugging information chapter to users guide aa4349d Fix AIX/ppc codegen in `-prof` compilation mode 0f289b9 DynFlags: Initialize unsafeGlobalDynFlags enough to be useful 0a0e113 Panic: Try outputting SDocs 5f32cf1d Update bytestring submodule to latest snapshot 50a2b6a base: Document caveats about Control.Concurrent.Chan 6e33081 users-guide: Provide more depth in table-of-contents 74cf491 users-guide: Wibbles 86d40d9 users-guide: Add references to various issues in bugs section 1ca01bb Use a correct substitution in tcInstType 6b3927f Build correct substitution in instDFunType b7ee635 Use the correct substitution in lintCoercion dc81cca Add Data.Functor.Classes instances for Proxy (trac issue #11756) 802042e base: Add comment noting import loop 0178633 rename: Disallow type signatures in patterns in plain Haskell b855259 users-guide/rel-notes: Note broken-ness of ImpredicativeTypes 13bef02 base: Fix haddock typo 0e95953 RTS: Fix & refactor "portable inline" macros c816395 ghc-prim: Delay inlining of {gt,ge,lt,le}Int to phase 1 007bb34 Defer inlining of Ord methods c261a15 ghc-prim: Mark unpackCStringUtf8# and unpackNBytes# as NOINLINE 56eaed1 Drop Xcode 4.1 hack and fix ignored CC var issue d332df3 Do not claim that -O2 does not do better than -O 1547b9c Don't recompute some free vars in lintCoercion 37936e2 rts/posix/Itimer.c: Handle EINTR when reading timerfd b6be8a1 Don't require -hide-all-packages for MIN_VERSION_* macros eb2c0ed Add -f(no-)version-macro to explicitly control macros. 392b9d7 Always do eta-reduction 036bda3 Revert accidental change to collectTyAndValBinders 9749b8c Make the example for -M work f75e098 Improve printing of pattern synonym types 0ecd69b Bump binary submodule 773e81b Don't infer CallStacks fb290f9 rts: Make StablePtr derefs thread-safe (#10296) 0c93bc3 Fix misattribution of `-Wunused-local-binds` warnings 992e675 Deeply instantiate in :type 7b18551 Skip TEST=TcCoercibleFail when compiler_debugged b9f26ca T10272, T4340: Add 32-bit output 2aadf81 T10870: Skip on 32-bit architectures fbc147e testsuite: Update 32-bit performance numbers 6d36d8e testsuite: One more 32-bit performance slip 32f2154 Bump parallel submodule 7f6a281 Bump Cabal submodule fc88685 Update pretty submodule 1b381b5 Elaborate test for #11376 88e9816 Fix installation of static sphinx assets 8735569 rts: Fix parsing of profiler selectors 7c6bc78 Provide an optimized replicateM_ implementation #11795 a7cb9cf Add doc to (<=<) comparing its type to (.) e465093 Fix Template Haskell bug reported in #11809. f96ef25 Reduce default for -fmax-pmcheck-iterations from 1e7 to 2e6 ea17363 Export zonkEvBinds from TcHsSyn. f93c951 Fix suggestions for unbound variables (#11680) 7f27f7a base: Fix "since" annotation on GHC.ExecutionStack a2b9c53 Remove the instantiation check when deriving Generic(1) b18d17d RtsFlags: Un-constify temporary buffer 1321c62 Bump haddock submodule 02f3c8f When encountering a duplicate symbol, show source of the first symbol 38230e2 Fix runtime linker error message when old symbol had no owner 88a370d Fix Windows build after D1874 5a361d8 Reduce fragmentation from m32_allocator 068d927 Change runtime linker to perform lazy loading of symbols/sections a4dcdfa Omit TEST=T10697_decided_3 WAY=ghci cd35e86 Fix a closed type family error message a1fa34c Filter out invisible kind arguments during TH reification 7b8beba Added (more) missing instances for Identity and Const 9c48d8a Deriving Functor-like classes should unify kind variables ef7160c Use `@since` annotation in GHC.ExecutionStack 05aab19 Add linker notes b1d92b5 Fix #11811. 3f7832b Fix #11797. 6d1d979 Fix #11814 by throwing more stuff into InScopeSets e9e100f users-guide: Note change in LLVM support policy 92f598b rel-notes: Add note about UndecidableSuperClasses and #11762 7364105 Linker: Fix signedness mismatch 73bd0a3 testsuite: Add T11824 d56bb43 testsuite: Add test for #11827 c66f756 Bump haddock submodule ead6998 Teach lookupLocalRdrEnv about Exacts. (#11813) b3321ca Increase an InScopeSet for a substitution 6554dc6 libdw: More precise version check 3be02f4 Update `directory` submodule to v1.2.6.0 release 26561f2 Update array submodule to v0.5.1.1 release tag 6810de7 deriveConstants: Verify sanity of nm c3dafd9 Add TemplateHaskell support for Overlapping pragmas 1c3b1cb TH: Tweak Haddock language 89d5f45 users-guide: Fix typo fcbc21b validate: Note existence of config_args variable da6d720 Check CCS tree for pointers into shared object during checkUnload 6c840d9 Resolve symlinks when attempting to find GHC's lib folder on Windows 80894f2 Update `directory` submodule to v1.2.6.1 release 08b3e5a Silence unused-import warning introduced by 93d85af9fec968b c1a6b98 Update haskeline submodule to 0.7.2.3 release bcff328 relnotes: Add note about #11744 and workaround efafad0 Make it easy to get hyperlinked sources b963f07 rts: Limit maximum backtrace depth 7f19aed rts: Don't use strndup 23f83b5 Update `directory` submodule to v1.2.6.2 release d070ac4 Update hsc2hs submodule d3fd3fe Mark GHC.Stack.Types Trustworthy 6af2366 Update deepseq submodule to latest 1.4.2.0 snapshot 2c8b5df Update binary submodule to 0.8.3.0 release dbd9de3 Update unix submodule to v2.7.2.0 release d4980e5 Bump haddock submodule 09665a7 Ensure Typeable declarations end up in boot interface files 4b43a96 Bump Cabal submodule 5f29b77 Move DFunUnfolding generation to TcInstDcls aabd44c Revert "rts/posix/Itimer.c: Handle EINTR when reading timerfd" eed126e Revert "rtx/posix/Itimer.c: Handle return value of `read`" dcece19 Revert "rts/timer: use timerfd_* on Linux instead of alarm signals" f8b467d Bump bytestring submodule aab9241 Adjust error check for class method types ec5ddb6 deriveConstants: Fix nm-classic error message d90a177 Document -fmax-pmcheck-iterations a bit better 91eeb12 Recommend more reliable recourse for broken nm 72ab618 users-guide: Add index entry for "environment file" 11444b8 Bump haddock submodule 628262b deriveConstants: Fix nm advice one last time 11a76c7 Update Cabal submodule to v1.24.0.0 releas tag c7d21b1 Update libraries/hpc submodule to v0.6.0.3 release tag 0ab1a6a Update bytestring submodule to 0.10.8.0 release tag f4c272e Bump time submodule c47af0e Bump Win32 submodule to 2.3.1.1 aa55caf Update time submodule to 1.6.0.1 release tag cc6900e ghc-boot: Bump version number in changelog 23df0d5 users-guide: Clean up version numbers and TODOs 9cb4ce6 users-guide: Document 0e11297 users-guide/relnotes: Document -Weverything and -Wdefault 3d4fa5b base: Add release date to changelog 89a0be3 relnotes: Note portability improvements 91222fc rel-notes: Group together warning-related items, add 638c1d4 Forbid variables to be parents in import lists. d7cd313 RdrHsSyn: Only suggest `type` qualification when appropriate 8b75571 Bump haddock submodule d7c5ddc users-guide: Note #11995 in release notes fc30ebc users-guide: Add -Wnoncanonical-semigroup-instances to relnotes 86f9e0c users-guide: Fix former base version number f5837cd relnotes: Update submodule versions 5beb03b relnotes: Fix typo in ticket number 046f3a0 relnotes: Fix ticket number yet again 0e12124 Handle promotion failures when scavenging a WEAK (#11108) e99c1e2 configure.ac: Prepare for 8.0.1 release 412e22c Bump haddock submodule b594f81 Bump haddock submodule 7eb2ad9 Another haddock submodule bump e7cb1ca Bump bytestring submodule to 0.8.10.1 87a3ea5 PPC NCG: Fix pretty printing of st[wd]ux instr. f4e6b32 PPC: Implement SMP primitives using gcc built-ins b0f027c testsuite/ImpSafe03: Normalize version of bytestring c014794 Move Extension type to ghc-boot-th e303d93 ghc-boot: Don't use reexported-modules 38cecbd Describe ghc-boot-th in the release notes b105b0a Bump haddock submodule 9649973 Cache the size of part_list/scavd_list (#11783) 7617793 One more update to haddock submodule e705ef1 Add ghc-boot-th to rules/foreachLibrary 7879001 testsuite: Bump expected 32-bit perf numbers for haddock.base a5b3a6a rules: Fix name of ghc-boot-th library 4986837 rules/build-prog: Ensure programs depend upon their transitive deps 564af9f Set RELEASE=NO f3114cf testsuite: Add a TypeRep test 2c5a5fc Give lifted primitive types a representation 8405c2e Avoid double error on out-of-scope identifier 00aa3e6 ghc-boot(-th): Fix incorrect 'expose'-property and relax cabal-version 62137e2 users-guide: Vector version of Thomson-Wheeler logo 0438321 rules/sphinx: Add missing dependency on conf.py for pdf rule 528fb33 users-guide: Fix index in PDF output b2c661c Rework ANNOUNCE 4a55457 rel-notes: Fix Trac reference f7b6adc PrelInfo: Ensure that tuple promoted datacon names are in knownKeyNames b819d44 rules/sphinx.mk: stop xelatex on error 454542f Fix check_uniques in non-unicode locale f3bca8f ghc-pkg: Drop trailing slashes in computing db paths 3ae474d nativeGen: Allow -fregs-graph to be used 7bfc8c0 Kill some unnecessary varSetElems a082cd3 Remove some gratitious varSetElemsWellScoped b874bc9 Kill unnecessary varSetElemsWellScoped in deriveTyData 28c4a84 Rename FV related functions 3a6888e Remove mysterious varSetElemsWellScoped in tidyFreeTyCoVars 085f449 Get rid of varSetElemsWellScoped in abstractFloats 9f00629 Refactor computing dependent type vars 7c216d2 Fix two buglets in 17eb241 noticed by Richard cc02156 Make benign non-determinism in pretty-printing more obvious f775c44 Kill varSetElemsWellScoped in quantifyTyVars d0f95cf Kill varSetElems in TcErrors e41984c Kill varSetElems try_tyvar_defaulting cc36fe3 Kill varSetElems in markNominal 8a6f976 Kill varSetElems in injImproveEqns 64e4b88 Kill non-deterministic foldUFM in TrieMap and TcAppMap c8188d8 Make simplifyInstanceContexts deterministic 0234bfa Remove some varSetElems in dsCmdStmt 29c0807 Make absentError not depend on uniques f38fe3f Kill varEnvElts in specImports 233b1ab Kill varSetElems in tcInferPatSynDecl ae94a31 Refactor free tyvars on LHS of rules 1c59d37 Make accept fbccc0b Make inert_model and inert_eqs deterministic sets 2b3de32 Refactor validity checking for type/data instances bcc1cf4 Kill varSetElems in tidyFreeTyCoVars 5ba488f Make Arrow desugaring deterministic 3b745a1 Serialize vParallelTyCons in a stable order 2d3e064 Add nameSetElemsStable and fix the build d563710 Implement deterministic CallInfoSet 77a9f01 Add -foptimal-applicative-do a448c03 Desugar ApplicativeDo and RecDo deterministically 9b6fa58 Make UnitIdMap a deterministic map 65225c7 Use DVarSet in Vectorise.Exp 87f886c Make vectInfoParallelVars a DVarSet 560b7af Use UniqFM for SigOf bab927c Make checkFamInstConsistency less expensive daa058e Make the Ord Module independent of Unique order (2nd try) 6fc97cd Refactor match to not use Unique order 7952f10 Add a new determinism test 7dd591c Make accept a0f1809 Fix GetTime.c on Darwin with clock_gettime cd9c4a5 Don't quantify over Refl in a RULE 151f193 Abort the build when a Core plugin pass is specified in stage1 compiler a8d4759 Fix bytecode gen to deal with rep-polymorphism 66d70fd Allow unlifted types in pattern synonym result type 2a09e6e Trac #11554 fix loopy GADTs 8736625 Fix renamer panic 694e0f3 Avoid find_tycon panic if datacon is not in scope b4bdbe4 Don't omit any evidence bindings f0eb4f7 Fix histograms for ticky code b2796aa Fix Ticky histogram on Windows c650949 Fix trac #10647: Notice about lack of SIMD support 10b69f6 ApplicativeDo: allow "return $ e" ba41416 Expand and clarify the docs for ApplicativeDo (#11835) a064fa3 Fix deriving Ord when RebindableSyntax is enabled b0fd23b Add tests for #11465 and the kind invariant 738b199 Accept more test wibbles bc939b8 rts: mark 'ccs_mutex' and 'prof_arena' as static 7fc7538 Show sources of cost centers in .prof 2c44744 Add deepseq dependency and a few NFData instances 7a21ffc Squash space leaks in the result of byteCodeGen 864053f UNPACK the size field of SizedSeq 11200a0 hp2ps: fix invalid PostScript for names with parentheses df1cac9 Failing test case for #12076. 2a9767e Fix #12076 by inlining trivial expressions in CorePrep. 8540c65 Check generic-default method for ambiguity 2930a5b Widen deepseq lower bound b5ec09d rts/Profiling: Fix C99-ism 0241540 Improve accuracy of suggestion to use TypeApplications 4f6960b Add Windows import library support to the Runtime Linker 6f6287a Do not use defaulting in ambiguity check 7a69acc Add missing solveEqualities 6a4326e Add Edward Kmett's example as a test case ced7cc0 Remove the incredibly hairy splitTelescopeTvs. 9994285 Test #11484 in th/T11484 9cf69d3 Make validDerivPred ignore non-visible arguments to a class type constructor 1d46fd5 Fix pretty printing of IEThingWith ee4c583 Fix deriveTyData's kind unification when two kind variables are unified e9f2900 Improve pretty-printing of equalities 38036f0 FunDep printer: Fix unicode arrow 13ae3e4 Build system: temp solution for parallelisation bug (#11960) d552896 Testsuite: check actual_prof_file only when needed 43eef43 Testsuite: also normalise platform-dependent .stdout/stderr 9ddb933 Reduce special-casing for nullary unboxed tuple e9c5ca8 More fixes for unboxed tuples efc7ef6 Add relocation type R_X86_64_REX_GOTPCRELX 9038a3f Improve failed knot-tying error message. 8cd76a4 Kill varEnvElts in tcPragExpr 479e0bc Fix #12064 by making IfaceClass typechecking more lazy. 381d451 Don't GC sparks for CAFs 1c31013 Refactor derived Generic instances to reduce allocations 7f373fb PPC NCG: Fix float parameter passing on 64-bit. 929c5c5 PPC NCG: Fix and refactor TOC handling. 498009a Second attempt to fix sizeExpr 37bfc6c Fix #11974 by adding a more smarts to TcDefaults. 6c28f24 Deal correctly with unused imports for 'coerce' ba9dd63 Fix pretty-printer for IfaceCo f26e58b Enum: Ensure that operations on Word fuse f4c7d37 Pretty: delete really old changelog 1c53ac1 Bugfix for bug 11632: `readLitChar` should consume null characters 2756af8 Pretty: remove a harmful $! (#12227) 1f862ac Make DeriveFunctor work with unboxed tuples 3470f82 Fix Template Haskell reification of unboxed tuple types a0c9685 Fix bytecode generator panic 6b58374 Improve documentation for type wildcards e59121a Update docs for partial type signatures (#12365) 7885a51 Fix productivity calculation (#12424) d0c419c testsuite: Update performance numbers a1a7359 testsuite: Remove spurious change from last commit 3219220 Revert "Fix Template Haskell reification of unboxed tuple types" 29f610d Allow limiting the number of GC threads (+RTS -qn) ce60147 schedulePushWork: avoid unnecessary wakeups 8a0485d Fix a crash in requestSync() 2f31960 Fix ASSERT failure and re-enable setnumcapabilities001 eb40deb Fix double-free in T5644 (#12208) efcd302 Move stat_startGCSync 4d14d71 Track the lengths of the thread queues 9f1b6de Fix to thread migration 13ff342 Another try to get thread migration right 6f804c2 check that the number of parallel build is greater than 0 ca58946 Improve missing-sig warning 6071ecf Not-in-scope variables are always errors 829b968 Keep the bindings local during defaultCallStacks 0766668 Expand given superclasses more eagerly 9d9eaec Do not init record accessors as exported 38497a2 Fix incorrect calculated relocations on Windows x86_64 422ed83 Make okConIdOcc recognize unboxed tuples 57e7078 rts/LdvProfile.c: Fix NULL dereference on shutdown 5c6e25f Fix a performance issue with -fprint-expanded-synonyms 88b7812 Relevant Bindings no longer reports shadowed bindings (fixes #12176) 54413fd RtClosureInspect: Fix off-by-one error in cvReconstructType f4ac734 Allow typed holes to be levity-polymorphic 5370f3c pass -z wxneeded or -Wl,-zwxneeded for linking on OpenBSD a8d0d3e Testsuite: for tests that use TH, omit *all* prof_ways 8d63419 Have addModFinalizer expose the local type environment. c7c4e71 Fix T12177 72bec52 Missing stderr for T12531. 5af7f19 users_guide: Add 8.0.2 release notes b688f00 Fix handling of package-db entries in .ghc.environment files, etc. 10ba4f0 users_guide: More capabilities than processors considered harmful aa6da11 iserv: Show usage message on argument parse failure 7053019 StgCmmPrim: Add missing MO_WriteBarrier 730809f Clarify scope of `getQ`/`putQ` state. 3308b30 Fix failures of T12031 af14774 Disable T12031 on linux 99bb8ff ErrUtils: Expose accessors of ErrDoc and ErrMsg 644f68c Fix Windows build after Ticky changes 5a6f4ac Fix aggressive cleanup of T1407 76286af Fixes #12504: Double-escape paths used to build call to hsc_line d2e14e6 HsExpr: Ensure Type is derived on ThModFinalizers 0e68d98 user_guide: Move addModFinalizer mention to 8.0.2 release notes 7364a1d PPC NCG: Implement minimal stack frame header. 688354f Docs: fix links to ghc-flags 661d140 Add -fdefer-out-of-scope-variables flag (#12170). 4967265 Remove redundant-constraints from -Wall (#10635) f476386 users_guide: Document removal of -Wredundant-constraints from -Wall 4cda36d users_guide: A few miscellaneous notes in relnotes 0412525 users_guide: Move -fdefer-out-of-scope-variables note to 8.0.2 relnotes 062b462 Tag pointers in interpreted constructors aedb412 GHC: Expose installSignalHandlers, withCleanupSession bd3506c Linker: Fix Windows codepath 44755a0 RnExpr: Fix ApplicativeDo desugaring with RebindableSyntax 2df0d75 Fix and complete runghc documentation a8199e8 Fix #12472 by looking for noinline/lazy inside oversaturated applications. 47d589e Fix binary-trees regression from unnecessary floating in CorePrep. 07a3404 testsuite: Add test for #11959 2a6ac3f Use the correct return type for Windows' send()/recv() (Fix #12010) a81801f Fix failing T12010 2557d25 Testsuite: fix T12010 for real 714779c Added support for deprecated POSIX functions on Windows. 52c7430 Less scary arity mismatch error message when deriving 23d60a5 distrib: Fix libdw bindist check 23be8c9 Be more aggressive when checking constraints for custom type errors. 291b439 InstEnv: Ensure that instance visibility check is lazy 676efb9 Fix GHCi perf-llvm build on x86_64 02f0941 Remove references to -XRelaxedPolyRec 11cf0c6 Clarify pkg selection when multiple versions are available 44e823d Document meaning of order of --package-db flags, fixes #12485. daa4de5 Add hook for creating ghci external interpreter 61be194 users_guide: Add release note for createIservProcessHook 14fb8ef Add platform warning to Foreign.C.Types 96850ef Update unix submodule to latest HEAD. 706a730 Fix derived Ix instances for one-constructor GADTs 43149ea Fix TH ppr output for list comprehensions with only one Stmt 658f035 Make start address of `osReserveHeapMemory` tunable via command line -xb c51caaf rts: Disable -hb with multiple capabilities 094f3c6 Add failing testcase for #12433 a0472f8 Fix codegen bug in PIC version of genSwitch (#12433) 54b887b Improve typechecking of instance defaults 21c2020 Fix T12504 5c01763 Get in-scope set right in top_instantiate 0e4e03a Be less picky about reporing inaccessible code e284872 Test wibbles for commit 03541cba d3ac6ce More testsuite wibbles 129845018 rts: Fix reference to NUMA-specific field e134a5b Fix scoping of type variables in instances ec6526e Trim all spaces after 'version:' 682518d Fix configure detection. b205029 configure.ac: fix --host= handling 46dc885 Bump Haddock submodule aec4a51 CodeGen X86: fix unsafe foreign calls wrt inlining e7201e8 PPC/CodeGen: fix lwa instruction generation 0c2b766 Don't warn about name shadowing when renaming the patten in a PatSyn decl 63ce9ba Do not warn about unused underscore-prefixed fields (fixes Trac #12609) 50e7157 Fix interaction of record pattern synonyms and record wildcards d2695b8 Fix desugaring of pattern bindings (again) cb03d1c Fix layout of MultiWayIf expressions (#10807) 906ea04 Print foralls in user format c448d55 Disallow standalone deriving declarations involving unboxed tuples or sums 11f9bff Kill off redundant SigTv check in occurCheckExpand 836f0e2 Fix a bug in occurs checking 15df517 Fix T12512 4557d94 Fix T12593 3b13a04 Turn `__GLASGOW_HASKELL_LLVM__` into an integer again a24092f Fix expected output for T7786 c904258 runghc: use executeFile to run ghc process on POSIX 9cc5a8f runghc: Fix import of System.Process on Windows bdfa8a1 Escape lambda. 5662cea Improve error handling in TcRnMonad 12cfcbe Orient improvement constraints better 801cbb4 More tests for Trac #12522 7643c14 Add missing test from D2545 b08ffec Fix memory leak from #12664 ec05551 Do not segfault if no common root can be found bdfb901 Remove reexports from ghc-boot, help bootstrap with GHC 8. a77bbb8 Don't ignore addTopDecls in module finalizers. f168a61 Fix test output 47ae01b RnExpr: Actually fail if patterns found in expression fefc530 Add derived shadows only for Wanted constraints cec5066 Some tiding up in TcGenDeriv c93ad55 Fix impredicativity (again) 5230fa0 validate: Add --build-only b7d6e20 Fix an assertion that could randomly fail 59741e4 testsuite: Bump T1969 expected bytes allocated 243994c Add test for #12456 1ef2742 Further improve error handling in TcRn monad 1aaa6f6 Disable T-signals-child test on single-threaded runtime 0f9a8a9 testsuite: Add testcase for #12355 5eab189 Check for empty entity string in "prim" foreign imports 5c02b84 Correct order of existentials in pattern synonyms bfaa770 Fix wrapping order in matchExpectedConTy be94aeb Don't omit any evidence bindings 9467dfa Add test for #12589 8ab454d Fix shadowing in mkWwBodies d7a1f68 Fix Show derivation in the presence of RebindableSyntax/OverloadedStrings d84a824 Add test for #12411 4c8aab8 Test for newtype with unboxed argument 9448e62 Add and use a new dynamic-library-dirs field in the ghc-pkg info c310f1a Bump filepath submodule 2722cd5 Fix failure in setnumcapabilities001 (#12728) 5c91d07 Omit unnecessary linker flags c33aad1 Refine ASSERT in buildPatSyn for the nullary case. cc3a950 Fix the in-scope set for extendTvSubstWithClone 4227f3e Add test for #12732 28c62bb Fix Trac #12797: approximateWC 2591a4b Update 8.0.2 release notes for #12784 8719d87 Fundeps work even for unary type classes 411bd2d Describe symptoms of (and the cure for) #12768 in 8.0.2 release notes 95b6aff Align GHCi's library search order more closely with LDs 3a0532a ghc-cabal: Use correct name of linker flags env variable 7bd5dd0 build system: Include CONF_LD_LINKER_OPTS in ALL_LD_OPTS 891ffe9 configure: Pass HC_OPTS_STAGEx to build system b72b7c8 Add test for #12788 60c299a Pass --no-pie to GCC 3da461d Revert "Pass --no-pie to GCC" fefe02c Pass -no-pie to GCC d5518f7 testsuite: Accept T12227 allocations 6060964 testsuite: Fix framework failure in T12771 cca8cee Read parentheses better e7017ca ghc-pkg: Munge dynamic library directories a23e976 Bump hsc2hs submodule to v0.68.1 6e38992 Bump Cabal submodule to 1.24.1.0 4b8202e Update unix submodule to 2.7.2.1 6bee864 rts: Fix build when linked with gold 4639ce6 template-haskell: Version bump and update changelog cc0d5d3 configure: Verify that GCC recognizes -no-pie flag 8008d27 StgCmmPrim: Add missing write barrier. ce66c24 Skip 64-bit symbol tables ee3ff0d Bump filepath submodule to 1.4.1.1 1da19e4 Bump base library version 18d04a8 testsuite: Kill redundant test definitions e7c12cd Have reify work for local variables with functional dependencies. b5b9cf3 Remove fancy shadowing logic; always override in package database order. 83bee7b Mark T11978a as broken due to #12019 83fc125 Clean up 8.0.2 release notes 4f7cd81 Add testcase for #12757 58d9f9b Merge cpe_ExprIsTrivial and exprIsTrivial 80c26da Make note of #12881 in 8.0.2 release notes 4212674 Fix inference of partial signatures 812d9f7 Store string as parsed in SourceText for CImport cc84fd4 Tweaks to grammar and such. 706d708 Make note of #12907 in 8.0.2 release notes d9e7a69 fdReady: use poll() instead of select() fb0f4cf Install toplevel handler inside fork. 9ac7335 testsuite: Bump down allocations of T3064 6c6f9c1 Bump directory submodule to 1.3.0.0 and Cabal to 1.24.2.0 d864200 Revert "Install toplevel handler inside fork." dae7690 Give concrete example for #12784 in 8.0.2 release notes 7b4ab5b mk/config.mk.in: enable SMP on ARMv7+ (Trac #12981) 1181bb5 testsuite: Add test for #12993 d3c18b2 Ensure flags destined for ld are properly passed de122b0 Revert "Do not init record accessors as exported" c5f375c fix OpenBSD linkage (wxneeded) 55dfd21 Revert "nativeGen: Allow -fregs-graph to be used" b85dc18 UniqSupply: Use full range of machine word f6e8d45 revert '-Wl' prefixing to *_LD_OPTS 2b746c8 A few last-minute Changelog entries 8c72503 Release 8.0.2 4d0fc4e Always expose unfoldings for overloaded functions. 9f63416 Add trace statement to see what is being included From git at git.haskell.org Mon Jan 9 10:51:24 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 9 Jan 2017 10:51:24 +0000 (UTC) Subject: [commit: ghc] wip/all-inlinable: Move test to the end to only fire on uncovered cases (497aa52) Message-ID: <20170109105124.53F833A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/all-inlinable Link : http://ghc.haskell.org/trac/ghc/changeset/497aa52a867021495360e7f21ac6e1f73753166e/ghc >--------------------------------------------------------------- commit 497aa52a867021495360e7f21ac6e1f73753166e Author: Matthew Pickering Date: Mon Jan 9 10:51:05 2017 +0000 Move test to the end to only fire on uncovered cases >--------------------------------------------------------------- 497aa52a867021495360e7f21ac6e1f73753166e compiler/main/TidyPgm.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/compiler/main/TidyPgm.hs b/compiler/main/TidyPgm.hs index 2f41b7a..6bbd556 100644 --- a/compiler/main/TidyPgm.hs +++ b/compiler/main/TidyPgm.hs @@ -739,14 +739,14 @@ addExternal expose_all id = (new_needed_ids, show_unfold) || isStableSource src -- Always expose things whose -- source is an inline rule - || (if is_overloaded - then pprTrace "ADDITION UNFOLDING" (ppr id) True - else False) -- Always expose overloaded things so that - -- they can be specialised at call sites. || not (bottoming_fn -- No need to inline bottom functions || never_active -- Or ones that say not to || loop_breaker -- Or that are loop breakers || neverUnfoldGuidance guidance) + || (if is_overloaded + then pprTrace "ADDITIONAL UNFOLDING:" (ppr id) True + else False) -- Always expose overloaded things so that + -- they can be specialised at call sites. show_unfolding (DFunUnfolding {}) = True show_unfolding _ = False From git at git.haskell.org Mon Jan 9 14:59:07 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 9 Jan 2017 14:59:07 +0000 (UTC) Subject: [commit: ghc] master: Fix zonk_eq_types in TcCanonical (7d2e5da) Message-ID: <20170109145907.38AD13A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7d2e5da61714025142f0085d5ae150a61e637a5e/ghc >--------------------------------------------------------------- commit 7d2e5da61714025142f0085d5ae150a61e637a5e Author: Simon Peyton Jones Date: Mon Jan 9 14:58:02 2017 +0000 Fix zonk_eq_types in TcCanonical This fixes Trac #13083. An egregious bug. Merge to the 8.0 branch >--------------------------------------------------------------- 7d2e5da61714025142f0085d5ae150a61e637a5e compiler/typecheck/TcCanonical.hs | 19 +++-- testsuite/tests/typecheck/should_compile/T13083.hs | 80 ++++++++++++++++++++++ testsuite/tests/typecheck/should_compile/all.T | 1 + testsuite/tests/typecheck/should_fail/T3950.stderr | 2 +- 4 files changed, 96 insertions(+), 6 deletions(-) diff --git a/compiler/typecheck/TcCanonical.hs b/compiler/typecheck/TcCanonical.hs index 5aeeeb8..7f5ea9a 100644 --- a/compiler/typecheck/TcCanonical.hs +++ b/compiler/typecheck/TcCanonical.hs @@ -700,8 +700,15 @@ zonk_eq_types = go go ty1 ty2 | Just (tc1, tys1) <- tcRepSplitTyConApp_maybe ty1 , Just (tc2, tys2) <- tcRepSplitTyConApp_maybe ty2 - , tc1 == tc2 - = tycon tc1 tys1 tys2 + = if tc1 == tc2 && tys1 `equalLength` tys2 + -- Crucial to check for equal-length args, because + -- we cannot assume that the two args to 'go' have + -- the same kind. E.g go (Proxy * (Maybe Int)) + -- (Proxy (*->*) Maybe) + -- We'll call (go (Maybe Int) Maybe) + -- See Trac #13083 + then tycon tc1 tys1 tys2 + else bale_out ty1 ty2 go ty1 ty2 | Just (ty1a, ty1b) <- tcRepSplitAppTy_maybe ty1 @@ -714,12 +721,14 @@ zonk_eq_types = go | lit1 == lit2 = return (Right ty1) - go ty1 ty2 = return $ Left (Pair ty1 ty2) - -- we don't handle more complex forms here + go ty1 ty2 = bale_out ty1 ty2 + -- We don't handle more complex forms here + + bale_out ty1 ty2 = return $ Left (Pair ty1 ty2) tyvar :: SwapFlag -> TcTyVar -> TcType -> TcS (Either (Pair TcType) TcType) - -- try to do as little as possible, as anything we do here is redundant + -- Try to do as little as possible, as anything we do here is redundant -- with flattening. In particular, no need to zonk kinds. That's why -- we don't use the already-defined zonking functions tyvar swapped tv ty diff --git a/testsuite/tests/typecheck/should_compile/T13083.hs b/testsuite/tests/typecheck/should_compile/T13083.hs new file mode 100644 index 0000000..220da08 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T13083.hs @@ -0,0 +1,80 @@ +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} + +{-# OPTIONS_GHC -Wall #-} + +-- | Bug(?) in Coercible constraint solving + +module T13083 where + +import GHC.Generics (Par1(..),(:*:)(..)) +import GHC.Exts (coerce) + +-- Representation as free vector space +type family V (a :: *) :: * -> * + +type instance V R = Par1 +type instance V (a,b) = V a :*: V b + +type instance V (Par1 a) = V a + +data R = R + +-- Linear map in row-major order +newtype L a b = L (V b (V a R)) + +-- Use coerce to drop newtype wrapper +bar :: L a b -> V b (V a R) +bar = coerce + +{- +[W] L a b ~R V b (V a R) +--> + V b (V a R) ~R V b (V a R) +-} + +{-------------------------------------------------------------------- + Bug demo +--------------------------------------------------------------------} + +-- A rejected type specialization of bar with a ~ (R,R), b ~ (Par1 R,R) +foo :: L (R,R) (Par1 R,R) -> V (Par1 R,R) (V (R,R) R) +-- foo :: L (a1,R) (Par1 b1,b2) -> V (Par1 b1,b2) (V (a1,R) R) +foo = coerce + +{- +[W] L (a1,R) (Par1 b1, b2) ~R V (Par1 b1,b2) (V (a1,R) R) +--> + V (Par1 b1, b2) (V (a1,R) R) ~R same + + -> (V (Par1 b1) :*: V b2) ((V a1 :*: V R) R) + -> (:*:) (V b1) (V b2) (:*: (V a1) Par1 R) + +--> + L (a1,R) (Par1 b1, b2) ~R (:*:) (V b1) (V b2) (:*: (V a1) Par1 R) +-} + +-- • Couldn't match representation of type ‘V Par1’ +-- with that of ‘Par1’ +-- arising from a use of ‘coerce’ + +-- Note that Par1 has the wrong kind (* -> *) for V Par1 + +-- Same error: +-- +-- foo :: (a ~ (R,R), b ~ (Par1 R,R)) => L a b -> V b (V a R) + +-- The following similar signatures work: + +-- foo :: L (R,R) (R,Par1 R) -> V (R,Par1 R) (V (R,R) R) +-- foo :: L (Par1 R,R) (R,R) -> V (R,R) (V (Par1 R,R) R) + +-- Same error: + +-- -- Linear map in column-major order +-- newtype L a b = L (V a (V b s)) + +-- foo :: L (R,R) (Par1 R,R) -> V (R,R) (V (Par1 R,R) R) +-- foo = coerce + diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index 40d31bb..b70ab83 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -564,3 +564,4 @@ test('T12925', normal, compile, ['']) test('T12919', expect_broken(12919), compile, ['']) test('T12936', normal, compile, ['']) test('T13050', normal, compile, ['-fdefer-type-errors']) +test('T13083', normal, compile, ['']) diff --git a/testsuite/tests/typecheck/should_fail/T3950.stderr b/testsuite/tests/typecheck/should_fail/T3950.stderr index ae50a74..60da6c0 100644 --- a/testsuite/tests/typecheck/should_fail/T3950.stderr +++ b/testsuite/tests/typecheck/should_fail/T3950.stderr @@ -5,7 +5,7 @@ T3950.hs:15:8: error: w :: (* -> * -> *) -> * Sealed :: (* -> *) -> * Expected type: Maybe (w (Id p)) - Actual type: Maybe (Sealed (Id p x0)) + Actual type: Maybe (Sealed (Id p0 x0)) • In the expression: Just rp' In an equation for ‘rp’: rp _ From git at git.haskell.org Mon Jan 9 15:29:53 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 9 Jan 2017 15:29:53 +0000 (UTC) Subject: [commit: ghc] master: Typos in comments (and in a test) (a8a714e) Message-ID: <20170109152953.6C9163A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a8a714ea6787f5717ca3ddf0f81ebba8d7ccca4d/ghc >--------------------------------------------------------------- commit a8a714ea6787f5717ca3ddf0f81ebba8d7ccca4d Author: Gabor Greif Date: Thu Jan 5 11:41:44 2017 +0100 Typos in comments (and in a test) >--------------------------------------------------------------- a8a714ea6787f5717ca3ddf0f81ebba8d7ccca4d compiler/coreSyn/CorePrep.hs | 2 +- compiler/simplCore/CallArity.hs | 6 +++--- compiler/simplCore/SimplUtils.hs | 2 +- compiler/simplStg/StgCse.hs | 2 +- compiler/typecheck/TcGenDeriv.hs | 2 +- compiler/utils/Digraph.hs | 6 +++--- libraries/base/Data/Traversable.hs | 2 +- libraries/base/GHC/Event/PSQ.hs | 2 +- libraries/compact/Data/Compact.hs | 2 +- testsuite/tests/programs/andy_cherry/andy_cherry.stdout | 2 +- testsuite/tests/programs/andy_cherry/mygames.pgn | 2 +- testsuite/tests/simplCore/should_compile/spec-inline.hs | 2 +- testsuite/tests/stranal/sigs/StrAnalExample.hs | 2 +- testsuite/tests/typecheck/should_compile/T12734a.hs | 2 +- 14 files changed, 18 insertions(+), 18 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc a8a714ea6787f5717ca3ddf0f81ebba8d7ccca4d From git at git.haskell.org Mon Jan 9 16:37:09 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 9 Jan 2017 16:37:09 +0000 (UTC) Subject: [commit: ghc] wip/all-inlinable: Always expose unfoldings for overloaded functions. (75cba70) Message-ID: <20170109163709.3BD473A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/all-inlinable Link : http://ghc.haskell.org/trac/ghc/changeset/75cba70113e47fa4f3e60ab6d18594f7a6dfb1bc/ghc >--------------------------------------------------------------- commit 75cba70113e47fa4f3e60ab6d18594f7a6dfb1bc Author: Matthew Pickering Date: Sat Aug 6 22:17:09 2016 +0100 Always expose unfoldings for overloaded functions. Summary: Users expect their overloaded functions to be specialised at call sites, however, this is only the case if they are either lucky and GHC chooses to include the unfolding or they mark their definition with an INLINABLE pragma. This leads to library authors marking all their functions with `INLINABLE` (or more accurately `INLINE`) so they ensure that downstream consumers pay no cost for their abstraction. A more sensible default is to do this job for the library author and give more predictable guarantees about specialisation. Empirically, I compiled a selection of 1150 packages with (a similar) patch applied. The total size of the interface files before the patch was 519mb and after 634mb. On modern machines, I think this increase is justified for the result. Reviewers: simonpj, austin, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2929 Conflicts: compiler/specialise/Specialise.hs >--------------------------------------------------------------- 75cba70113e47fa4f3e60ab6d18594f7a6dfb1bc compiler/main/TidyPgm.hs | 7 ++++++- compiler/specialise/Specialise.hs | 6 +++++- 2 files changed, 11 insertions(+), 2 deletions(-) diff --git a/compiler/main/TidyPgm.hs b/compiler/main/TidyPgm.hs index 8f2e334..6bbd556 100644 --- a/compiler/main/TidyPgm.hs +++ b/compiler/main/TidyPgm.hs @@ -58,6 +58,7 @@ import ErrUtils (Severity(..)) import Outputable import SrcLoc import qualified ErrUtils as Err +import TcType ( isOverloadedTy ) import Control.Monad import Data.Function @@ -726,6 +727,7 @@ addExternal expose_all id = (new_needed_ids, show_unfold) never_active = isNeverActive (inlinePragmaActivation (inlinePragInfo idinfo)) loop_breaker = isStrongLoopBreaker (occInfo idinfo) bottoming_fn = isBottomingSig (strictnessInfo idinfo) + is_overloaded = isOverloadedTy (idType id) -- Stuff to do with the Id's unfolding -- We leave the unfolding there even if there is a worker @@ -737,11 +739,14 @@ addExternal expose_all id = (new_needed_ids, show_unfold) || isStableSource src -- Always expose things whose -- source is an inline rule - || not (bottoming_fn -- No need to inline bottom functions || never_active -- Or ones that say not to || loop_breaker -- Or that are loop breakers || neverUnfoldGuidance guidance) + || (if is_overloaded + then pprTrace "ADDITIONAL UNFOLDING:" (ppr id) True + else False) -- Always expose overloaded things so that + -- they can be specialised at call sites. show_unfolding (DFunUnfolding {}) = True show_unfolding _ = False diff --git a/compiler/specialise/Specialise.hs b/compiler/specialise/Specialise.hs index 33ce1ac..159fbf7 100644 --- a/compiler/specialise/Specialise.hs +++ b/compiler/specialise/Specialise.hs @@ -753,13 +753,17 @@ wantSpecImport dflags unf NoUnfolding -> False OtherCon {} -> False DFunUnfolding {} -> True - CoreUnfolding { uf_src = src, uf_guidance = _guidance } + CoreUnfolding { uf_src = src, uf_guidance = _guidance } -> True + +{- | gopt Opt_SpecialiseAggressively dflags -> True | isStableSource src -> True -- Specialise even INLINE things; it hasn't inlined yet, -- so perhaps it never will. Moreover it may have calls -- inside it that we want to specialise | otherwise -> False -- Stable, not INLINE, hence INLINEABLE + | otherwise -> False -- Stable, not INLINE, hence INLINABLE +-} {- Note [Warning about missed specialisations] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ From git at git.haskell.org Mon Jan 9 18:28:59 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 9 Jan 2017 18:28:59 +0000 (UTC) Subject: [commit: ghc] branch 'wip/all-inlinable-head' created Message-ID: <20170109182859.1A0FB3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/all-inlinable-head Referencing: 9dec87ea33e7b398db7d86a30756d1d655895e8b From git at git.haskell.org Mon Jan 9 18:29:04 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 9 Jan 2017 18:29:04 +0000 (UTC) Subject: [commit: ghc] wip/all-inlinable-head: Unused identifiers (9dec87e) Message-ID: <20170109182904.8AB683A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/all-inlinable-head Link : http://ghc.haskell.org/trac/ghc/changeset/9dec87ea33e7b398db7d86a30756d1d655895e8b/ghc >--------------------------------------------------------------- commit 9dec87ea33e7b398db7d86a30756d1d655895e8b Author: Matthew Pickering Date: Mon Jan 9 18:24:28 2017 +0000 Unused identifiers >--------------------------------------------------------------- 9dec87ea33e7b398db7d86a30756d1d655895e8b compiler/specialise/Specialise.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/compiler/specialise/Specialise.hs b/compiler/specialise/Specialise.hs index 9158c2b..222c585 100644 --- a/compiler/specialise/Specialise.hs +++ b/compiler/specialise/Specialise.hs @@ -745,13 +745,13 @@ warnMissingSpecs dflags callers wantSpecImport :: DynFlags -> Unfolding -> Bool -- See Note [Specialise imported INLINABLE things] -wantSpecImport dflags unf +wantSpecImport _dflags unf = case unf of NoUnfolding -> False BootUnfolding -> False OtherCon {} -> False DFunUnfolding {} -> True - CoreUnfolding { uf_src = src, uf_guidance = _guidance } -> True + CoreUnfolding { uf_src = _src, uf_guidance = _guidance } -> True {- | gopt Opt_SpecialiseAggressively dflags -> True From git at git.haskell.org Mon Jan 9 18:29:01 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 9 Jan 2017 18:29:01 +0000 (UTC) Subject: [commit: ghc] wip/all-inlinable-head: Always expose unfoldings for overloaded functions. (54cee8f) Message-ID: <20170109182901.D49B73A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/all-inlinable-head Link : http://ghc.haskell.org/trac/ghc/changeset/54cee8fbc3d9c1b4b563965ce6d991535ca92815/ghc >--------------------------------------------------------------- commit 54cee8fbc3d9c1b4b563965ce6d991535ca92815 Author: Matthew Pickering Date: Sat Aug 6 22:17:09 2016 +0100 Always expose unfoldings for overloaded functions. Summary: Users expect their overloaded functions to be specialised at call sites, however, this is only the case if they are either lucky and GHC chooses to include the unfolding or they mark their definition with an INLINABLE pragma. This leads to library authors marking all their functions with `INLINABLE` (or more accurately `INLINE`) so they ensure that downstream consumers pay no cost for their abstraction. A more sensible default is to do this job for the library author and give more predictable guarantees about specialisation. Empirically, I compiled a selection of 1150 packages with (a similar) patch applied. The total size of the interface files before the patch was 519mb and after 634mb. On modern machines, I think this increase is justified for the result. Reviewers: simonpj, austin, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2929 >--------------------------------------------------------------- 54cee8fbc3d9c1b4b563965ce6d991535ca92815 compiler/main/TidyPgm.hs | 7 ++++++- compiler/specialise/Specialise.hs | 5 ++++- 2 files changed, 10 insertions(+), 2 deletions(-) diff --git a/compiler/main/TidyPgm.hs b/compiler/main/TidyPgm.hs index 52137a4..9b941d6 100644 --- a/compiler/main/TidyPgm.hs +++ b/compiler/main/TidyPgm.hs @@ -61,6 +61,7 @@ import Outputable import UniqDFM import SrcLoc import qualified ErrUtils as Err +import TcType ( isOverloadedTy ) import Control.Monad import Data.Function @@ -738,6 +739,7 @@ addExternal expose_all id = (new_needed_ids, show_unfold) never_active = isNeverActive (inlinePragmaActivation (inlinePragInfo idinfo)) loop_breaker = isStrongLoopBreaker (occInfo idinfo) bottoming_fn = isBottomingSig (strictnessInfo idinfo) + is_overloaded = isOverloadedTy (idType id) -- Stuff to do with the Id's unfolding -- We leave the unfolding there even if there is a worker @@ -749,11 +751,14 @@ addExternal expose_all id = (new_needed_ids, show_unfold) || isStableSource src -- Always expose things whose -- source is an inline rule - || not (bottoming_fn -- No need to inline bottom functions || never_active -- Or ones that say not to || loop_breaker -- Or that are loop breakers || neverUnfoldGuidance guidance) + || (if is_overloaded + then pprTrace "ADDITIONAL UNFOLDING:" (ppr id) True + else False) -- Always expose overloaded things so that + -- they can be specialised at call sites. show_unfolding (DFunUnfolding {}) = True show_unfolding _ = False diff --git a/compiler/specialise/Specialise.hs b/compiler/specialise/Specialise.hs index 257d076..9158c2b 100644 --- a/compiler/specialise/Specialise.hs +++ b/compiler/specialise/Specialise.hs @@ -751,13 +751,16 @@ wantSpecImport dflags unf BootUnfolding -> False OtherCon {} -> False DFunUnfolding {} -> True - CoreUnfolding { uf_src = src, uf_guidance = _guidance } + CoreUnfolding { uf_src = src, uf_guidance = _guidance } -> True + +{- | gopt Opt_SpecialiseAggressively dflags -> True | isStableSource src -> True -- Specialise even INLINE things; it hasn't inlined yet, -- so perhaps it never will. Moreover it may have calls -- inside it that we want to specialise | otherwise -> False -- Stable, not INLINE, hence INLINABLE +-} {- Note [Warning about missed specialisations] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ From git at git.haskell.org Mon Jan 9 20:44:08 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 9 Jan 2017 20:44:08 +0000 (UTC) Subject: [commit: ghc] branch 'wip/rwbarton-dep-finsts' created Message-ID: <20170109204408.E9C013A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/rwbarton-dep-finsts Referencing: ab037eee89364e31ad99ee470bf13c16fb04fb59 From git at git.haskell.org Mon Jan 9 20:44:11 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 9 Jan 2017 20:44:11 +0000 (UTC) Subject: [commit: ghc] wip/rwbarton-dep-finsts: WIP (untested): FamInst: Don't need to check imports against their dep_finsts (ab037ee) Message-ID: <20170109204411.A79AD3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rwbarton-dep-finsts Link : http://ghc.haskell.org/trac/ghc/changeset/ab037eee89364e31ad99ee470bf13c16fb04fb59/ghc >--------------------------------------------------------------- commit ab037eee89364e31ad99ee470bf13c16fb04fb59 Author: Reid Barton Date: Mon Jan 9 13:43:36 2017 -0500 WIP (untested): FamInst: Don't need to check imports against their dep_finsts Test Plan: harbormaster Reviewers: austin, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2947 >--------------------------------------------------------------- ab037eee89364e31ad99ee470bf13c16fb04fb59 compiler/typecheck/FamInst.hs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/compiler/typecheck/FamInst.hs b/compiler/typecheck/FamInst.hs index 0c1bdef..0dd385d 100644 --- a/compiler/typecheck/FamInst.hs +++ b/compiler/typecheck/FamInst.hs @@ -120,6 +120,9 @@ modules where both modules occur in the `HscTypes.dep_finsts' set (of the already been checked. Everything else, we check now. (So that we can be certain that the modules in our `HscTypes.dep_finsts' are consistent.) +XXX Presumably, each of our imports has itself already been checked against +its dep_finsts, as well. + There is some fancy footwork regarding hs-boot module loops, see Note [Don't check hs-boot type family instances too early] -} @@ -211,7 +214,7 @@ checkFamInstConsistency famInstMods directlyImpMods . md_fam_insts . hm_details ; hpt_fam_insts = mkModuleEnv [ (hmiModule hmi, hmiFamInstEnv hmi) | hmi <- eltsHpt hpt] - ; groups = map (dep_finsts . mi_deps . modIface) + ; groups = map (\mod -> mod : (dep_finsts . mi_deps . modIface $ mod)) directlyImpMods ; okPairs = listToSet $ concatMap allPairs groups -- instances of okPairs are consistent From git at git.haskell.org Mon Jan 9 20:46:42 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 9 Jan 2017 20:46:42 +0000 (UTC) Subject: [commit: ghc] wip/rwbarton-dep-finsts: WIP: FamInst: Don't need to check imports against their dep_finsts (12d1c70) Message-ID: <20170109204642.6B23A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rwbarton-dep-finsts Link : http://ghc.haskell.org/trac/ghc/changeset/12d1c70c8c40dd0f40a3cbe036073a3fc15348fc/ghc >--------------------------------------------------------------- commit 12d1c70c8c40dd0f40a3cbe036073a3fc15348fc Author: Reid Barton Date: Mon Jan 9 13:43:36 2017 -0500 WIP: FamInst: Don't need to check imports against their dep_finsts Test Plan: harbormaster Reviewers: austin, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2947 >--------------------------------------------------------------- 12d1c70c8c40dd0f40a3cbe036073a3fc15348fc compiler/typecheck/FamInst.hs | 5 ++++- testsuite/tests/ghci/scripts/T4175.stdout | 2 +- 2 files changed, 5 insertions(+), 2 deletions(-) diff --git a/compiler/typecheck/FamInst.hs b/compiler/typecheck/FamInst.hs index 0c1bdef..0dd385d 100644 --- a/compiler/typecheck/FamInst.hs +++ b/compiler/typecheck/FamInst.hs @@ -120,6 +120,9 @@ modules where both modules occur in the `HscTypes.dep_finsts' set (of the already been checked. Everything else, we check now. (So that we can be certain that the modules in our `HscTypes.dep_finsts' are consistent.) +XXX Presumably, each of our imports has itself already been checked against +its dep_finsts, as well. + There is some fancy footwork regarding hs-boot module loops, see Note [Don't check hs-boot type family instances too early] -} @@ -211,7 +214,7 @@ checkFamInstConsistency famInstMods directlyImpMods . md_fam_insts . hm_details ; hpt_fam_insts = mkModuleEnv [ (hmiModule hmi, hmiFamInstEnv hmi) | hmi <- eltsHpt hpt] - ; groups = map (dep_finsts . mi_deps . modIface) + ; groups = map (\mod -> mod : (dep_finsts . mi_deps . modIface $ mod)) directlyImpMods ; okPairs = listToSet $ concatMap allPairs groups -- instances of okPairs are consistent diff --git a/testsuite/tests/ghci/scripts/T4175.stdout b/testsuite/tests/ghci/scripts/T4175.stdout index d96a2ef..994886c 100644 --- a/testsuite/tests/ghci/scripts/T4175.stdout +++ b/testsuite/tests/ghci/scripts/T4175.stdout @@ -28,9 +28,9 @@ instance Show () -- Defined in ‘GHC.Show’ type instance D () a = Bool -- Defined at T4175.hs:22:10 data instance B () = MkB -- Defined at T4175.hs:13:15 data Maybe a = Nothing | Just a -- Defined in ‘GHC.Base’ -instance Foldable Maybe -- Defined in ‘Data.Foldable’ instance Traversable Maybe -- Defined in ‘Data.Traversable’ instance Monoid a => Monoid (Maybe a) -- Defined in ‘GHC.Base’ +instance Foldable Maybe -- Defined in ‘Data.Foldable’ instance Read a => Read (Maybe a) -- Defined in ‘GHC.Read’ instance Applicative Maybe -- Defined in ‘GHC.Base’ instance Functor Maybe -- Defined in ‘GHC.Base’ From git at git.haskell.org Tue Jan 10 13:52:42 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 10 Jan 2017 13:52:42 +0000 (UTC) Subject: [commit: ghc] wip/rwbarton-dep-finsts: Check local family instances against all family instance module dependencies (608cad5) Message-ID: <20170110135242.D91713A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rwbarton-dep-finsts Link : http://ghc.haskell.org/trac/ghc/changeset/608cad595c033ba89e757c8f61a9b791a7085367/ghc >--------------------------------------------------------------- commit 608cad595c033ba89e757c8f61a9b791a7085367 Author: Reid Barton Date: Tue Jan 10 08:32:57 2017 -0500 Check local family instances against all family instance module dependencies >--------------------------------------------------------------- 608cad595c033ba89e757c8f61a9b791a7085367 compiler/typecheck/FamInst.hs | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/compiler/typecheck/FamInst.hs b/compiler/typecheck/FamInst.hs index 0dd385d..98adbce 100644 --- a/compiler/typecheck/FamInst.hs +++ b/compiler/typecheck/FamInst.hs @@ -415,8 +415,14 @@ tcTopNormaliseNewTypeTF_maybe faminsts rdr_env ty -- Add new locally-defined family instances tcExtendLocalFamInstEnv :: [FamInst] -> TcM a -> TcM a +tcExtendLocalFamInstEnv [] thing_inside = thing_inside tcExtendLocalFamInstEnv fam_insts thing_inside - = do { env <- getGblEnv + = do { env0 <- getGblEnv + ; let this_mod = tcg_mod env0 + imports = tcg_imports env0 + ; loadModuleInterfaces (text "Loading family-instance modules") + (filter (/= this_mod) (imp_finsts imports)) + ; env <- getGblEnv ; (inst_env', fam_insts') <- foldlM addLocalFamInst (tcg_fam_inst_env env, tcg_fam_insts env) fam_insts From git at git.haskell.org Tue Jan 10 15:05:04 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 10 Jan 2017 15:05:04 +0000 (UTC) Subject: [commit: ghc] master: Make HsIParamTy have a Located HsIPName (1a6bdca) Message-ID: <20170110150504.C78CD3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1a6bdca01b7ac214d8aca52927e14547395697e8/ghc >--------------------------------------------------------------- commit 1a6bdca01b7ac214d8aca52927e14547395697e8 Author: Alan Zimmerman Date: Tue Jan 10 17:01:50 2017 +0200 Make HsIParamTy have a Located HsIPName To simplify API Annotations. Updates haddock submodule >--------------------------------------------------------------- 1a6bdca01b7ac214d8aca52927e14547395697e8 compiler/hsSyn/HsTypes.hs | 2 +- compiler/parser/Parser.y | 8 ++++---- compiler/typecheck/TcHsType.hs | 2 +- testsuite/tests/ghc-api/annotations/T10399.stdout | 1 - utils/haddock | 2 +- 5 files changed, 7 insertions(+), 8 deletions(-) diff --git a/compiler/hsSyn/HsTypes.hs b/compiler/hsSyn/HsTypes.hs index 53f200f..7dc3d12 100644 --- a/compiler/hsSyn/HsTypes.hs +++ b/compiler/hsSyn/HsTypes.hs @@ -497,7 +497,7 @@ data HsType name -- For details on above see note [Api annotations] in ApiAnnotation - | HsIParamTy HsIPName -- (?x :: ty) + | HsIParamTy (Located HsIPName) -- (?x :: ty) (LHsType name) -- Implicit parameters as they occur in contexts -- ^ -- > (?x :: ty) diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y index dfb6755..fadb8e7 100644 --- a/compiler/parser/Parser.y +++ b/compiler/parser/Parser.y @@ -1716,8 +1716,8 @@ ctype :: { LHsType RdrName } >> return (sLL $1 $> $ HsQualTy { hst_ctxt = $1 , hst_body = $3 }) } - | ipvar '::' type {% ams (sLL $1 $> (HsIParamTy (unLoc $1) $3)) - [mj AnnVal $1,mu AnnDcolon $2] } + | ipvar '::' type {% ams (sLL $1 $> (HsIParamTy $1 $3)) + [mu AnnDcolon $2] } | type { $1 } ---------------------- @@ -1741,8 +1741,8 @@ ctypedoc :: { LHsType RdrName } >> return (sLL $1 $> $ HsQualTy { hst_ctxt = $1 , hst_body = $3 }) } - | ipvar '::' type {% ams (sLL $1 $> (HsIParamTy (unLoc $1) $3)) - [mj AnnVal $1,mu AnnDcolon $2] } + | ipvar '::' type {% ams (sLL $1 $> (HsIParamTy $1 $3)) + [mu AnnDcolon $2] } | typedoc { $1 } ---------------------- diff --git a/compiler/typecheck/TcHsType.hs b/compiler/typecheck/TcHsType.hs index 3fa6077..c69de3a 100644 --- a/compiler/typecheck/TcHsType.hs +++ b/compiler/typecheck/TcHsType.hs @@ -632,7 +632,7 @@ tc_hs_type mode (HsExplicitTupleTy _ tys) exp_kind arity = length tys --------- Constraint types -tc_hs_type mode (HsIParamTy n ty) exp_kind +tc_hs_type mode (HsIParamTy (L _ n) ty) exp_kind = do { MASSERT( isTypeLevel (mode_level mode) ) ; ty' <- tc_lhs_type mode ty liftedTypeKind ; let n' = mkStrLitTy $ hsIPNameFS n diff --git a/testsuite/tests/ghc-api/annotations/T10399.stdout b/testsuite/tests/ghc-api/annotations/T10399.stdout index 612ecfd..0b37983 100644 --- a/testsuite/tests/ghc-api/annotations/T10399.stdout +++ b/testsuite/tests/ghc-api/annotations/T10399.stdout @@ -10,7 +10,6 @@ ((Test10399.hs:10:1-35,AnnSemi), [Test10399.hs:12:1]), ((Test10399.hs:10:1-35,AnnType), [Test10399.hs:10:1-4]), ((Test10399.hs:10:12-35,AnnDcolon), [Test10399.hs:10:24-25]), -((Test10399.hs:10:12-35,AnnVal), [Test10399.hs:10:12-22]), ((Test10399.hs:12:1-66,AnnEqual), [Test10399.hs:12:8]), ((Test10399.hs:12:1-66,AnnFunId), [Test10399.hs:12:1-6]), ((Test10399.hs:12:1-66,AnnSemi), [Test10399.hs:14:1]), diff --git a/utils/haddock b/utils/haddock index b34497c..b19ea3a 160000 --- a/utils/haddock +++ b/utils/haddock @@ -1 +1 @@ -Subproject commit b34497c36cd01a9c8a08ec3133ec94783642e43d +Subproject commit b19ea3ababeb231157c4a067c43003e09b1f0185 From git at git.haskell.org Tue Jan 10 19:21:47 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 10 Jan 2017 19:21:47 +0000 (UTC) Subject: [commit: ghc] master: CmmCommonBlockElim: Ignore CmmUnwind nodes (e94b07d) Message-ID: <20170110192147.019083A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e94b07dc791960439df18cfa600a2f42fc945336/ghc >--------------------------------------------------------------- commit e94b07dc791960439df18cfa600a2f42fc945336 Author: Ben Gamari Date: Thu Jan 5 17:02:00 2017 -0500 CmmCommonBlockElim: Ignore CmmUnwind nodes We don't want unwind information to affect the code we produce. Consequently we need to ensure that CBE ignores unwind nodes for the purposes of equality. Test Plan: Validate Reviewers: scpmw, simonmar, austin Reviewed By: simonmar Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2739 >--------------------------------------------------------------- e94b07dc791960439df18cfa600a2f42fc945336 compiler/cmm/CmmCommonBlockElim.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/cmm/CmmCommonBlockElim.hs b/compiler/cmm/CmmCommonBlockElim.hs index 989eb2f..3dc8202 100644 --- a/compiler/cmm/CmmCommonBlockElim.hs +++ b/compiler/cmm/CmmCommonBlockElim.hs @@ -134,7 +134,6 @@ hash_block block = hash_node :: CmmNode O x -> Word32 hash_node n | dont_care n = 0 -- don't care - hash_node (CmmUnwind _ e) = hash_e e hash_node (CmmAssign r e) = hash_reg r + hash_e e hash_node (CmmStore e e') = hash_e e + hash_e e' hash_node (CmmUnsafeForeignCall t _ as) = hash_tgt t + hash_list hash_e as @@ -181,6 +180,7 @@ hash_block block = dont_care :: CmmNode O x -> Bool dont_care CmmComment {} = True dont_care CmmTick {} = True +dont_care CmmUnwind {} = True dont_care _other = False -- Utilities: equality and substitution on the graph. From git at git.haskell.org Tue Jan 10 19:21:49 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 10 Jan 2017 19:21:49 +0000 (UTC) Subject: [commit: ghc] master: -dead_strip is now the default on Darwin (0a6c257) Message-ID: <20170110192149.A6F273A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/0a6c257de5c217436ec61fdf4b06bca059181f83/ghc >--------------------------------------------------------------- commit 0a6c257de5c217436ec61fdf4b06bca059181f83 Author: Demi Obenour Date: Thu Jan 5 17:06:26 2017 -0500 -dead_strip is now the default on Darwin This enables subsections-via-symbols (-dead_strip) by default on Darwin. The Static Reference Table (SRT) needs to be split in order for -dead_strip to be helpful, so this commit always splits it on Darwin systems. Test Plan: GHC CI on Darwin Reviewers: erikd, austin, bgamari Reviewed By: erikd, bgamari Subscribers: erikd, thomie Differential Revision: https://phabricator.haskell.org/D2911 GHC Trac Issues: #11040, #13049 >--------------------------------------------------------------- 0a6c257de5c217436ec61fdf4b06bca059181f83 compiler/main/DriverPipeline.hs | 24 ++++++++++++++---------- compiler/main/HscMain.hs | 4 +++- 2 files changed, 17 insertions(+), 11 deletions(-) diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs index 133bdde..a62233d 100644 --- a/compiler/main/DriverPipeline.hs +++ b/compiler/main/DriverPipeline.hs @@ -1794,6 +1794,9 @@ linkBinary' staticLink dflags o_files dep_packages = do in ["-L" ++ l] ++ ["-Wl,-rpath", "-Wl," ++ libpath] | otherwise = ["-L" ++ l] + let dead_strip = if osMachOTarget (platformOS platform) + then ["-Wl,-dead_strip"] + else [] let lib_paths = libraryPaths dflags let lib_path_opts = map ("-L"++) lib_paths @@ -1808,16 +1811,17 @@ linkBinary' staticLink dflags o_files dep_packages = do -- HS packages, because libtool doesn't accept other options. -- In the case of iOS these need to be added by hand to the -- final link in Xcode. - else other_flags ++ package_hs_libs ++ extra_libs -- -Wl,-u, contained in other_flags - -- needs to be put before -l, - -- otherwise Solaris linker fails linking - -- a binary with unresolved symbols in RTS - -- which are defined in base package - -- the reason for this is a note in ld(1) about - -- '-u' option: "The placement of this option - -- on the command line is significant. - -- This option must be placed before the library - -- that defines the symbol." + else other_flags ++ dead_strip ++ package_hs_libs ++ extra_libs + -- -Wl,-u, contained in other_flags + -- needs to be put before -l, + -- otherwise Solaris linker fails linking + -- a binary with unresolved symbols in RTS + -- which are defined in base package + -- the reason for this is a note in ld(1) about + -- '-u' option: "The placement of this option + -- on the command line is significant. + -- This option must be placed before the library + -- that defines the symbol." -- frameworks pkg_framework_opts <- getPkgFrameworkOpts dflags platform dep_packages diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs index 7d80912..12e8a1d 100644 --- a/compiler/main/HscMain.hs +++ b/compiler/main/HscMain.hs @@ -137,6 +137,7 @@ import Maybes import DynFlags import ErrUtils +import Platform ( platformOS, OS(OSDarwin) ) import Outputable import NameEnv @@ -1392,7 +1393,8 @@ doCodeGen hsc_env this_mod data_tycons -- we generate one SRT for the whole module. let pipeline_stream - | gopt Opt_SplitObjs dflags || gopt Opt_SplitSections dflags + | gopt Opt_SplitObjs dflags || gopt Opt_SplitSections dflags || + platformOS (targetPlatform dflags) == OSDarwin = {-# SCC "cmmPipeline" #-} let run_pipeline us cmmgroup = do let (topSRT', us') = initUs us emptySRT From git at git.haskell.org Tue Jan 10 19:21:53 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 10 Jan 2017 19:21:53 +0000 (UTC) Subject: [commit: ghc] master: Properly detect MinTTY when running GHCi on Windows (6fe9b05) Message-ID: <20170110192153.10DBB3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6fe9b057396b4ace73106dc9c3c7fcb72a216bfa/ghc >--------------------------------------------------------------- commit 6fe9b057396b4ace73106dc9c3c7fcb72a216bfa Author: Ryan Scott Date: Thu Jan 5 17:03:19 2017 -0500 Properly detect MinTTY when running GHCi on Windows Before, we detecting the presence of MinTTY on Windows in a very imprecise way: by checking if the `_` environment variable was set. Not only is this easy to circumvent, but it also yields false positives on terminals like ConEmu. This changes the test to use the `GetFileInformationByHandleEx` function instead, which provides a far more accurate check for MinTTY's presence. I've tested this on PowerShell, MSYS2, Cygwin, ConEmu, and Git Bash, and it does the right thing on each one. Fixes #12958. Test Plan: Run GHCi on many different Windows and MinTTY consoles Reviewers: erikd, Phyx, austin, bgamari Reviewed By: Phyx, bgamari Subscribers: thomie, #ghc_windows_task_force Differential Revision: https://phabricator.haskell.org/D2878 GHC Trac Issues: #12958 >--------------------------------------------------------------- 6fe9b057396b4ace73106dc9c3c7fcb72a216bfa driver/ghci/ghc.mk | 2 +- driver/ghci/ghci.c | 5 +++-- driver/utils/isMinTTY.c | 33 +++++++++++++++++++++++++++++++++ driver/utils/isMinTTY.h | 8 ++++++++ 4 files changed, 45 insertions(+), 3 deletions(-) diff --git a/driver/ghci/ghc.mk b/driver/ghci/ghc.mk index 240e16f..41d1f15 100644 --- a/driver/ghci/ghc.mk +++ b/driver/ghci/ghc.mk @@ -29,7 +29,7 @@ install_driver_ghci: else # Windows_Host... -driver/ghci_dist_C_SRCS = ghci.c ../utils/cwrapper.c ../utils/getLocation.c +driver/ghci_dist_C_SRCS = ghci.c ../utils/cwrapper.c ../utils/getLocation.c ../utils/isMinTTY.c driver/ghci_dist_CC_OPTS += -I driver/utils driver/ghci_dist_PROGNAME = ghci driver/ghci_dist_INSTALL = YES diff --git a/driver/ghci/ghci.c b/driver/ghci/ghci.c index f358d96..ebf13d8 100644 --- a/driver/ghci/ghci.c +++ b/driver/ghci/ghci.c @@ -1,6 +1,7 @@ #include "cwrapper.h" #include "getLocation.h" +#include "isMinTTY.h" #include #include #include @@ -15,8 +16,8 @@ int main(int argc, char** argv) { char *exePath; char *preArgv[1]; - if (getenv("_")) { - printf("WARNING: GHCi invoked via 'ghci.exe' in *nix-like shells (cygwin-bash, in particular)\n"); + if (isMinTTY()) { + printf("WARNING: GHCi invoked via 'ghci.exe' in MinTTY consoles (e.g., Cygwin or MSYS)\n"); printf(" doesn't handle Ctrl-C well; use the 'ghcii.sh' shell wrapper instead\n"); fflush(stdout); } diff --git a/driver/utils/isMinTTY.c b/driver/utils/isMinTTY.c new file mode 100644 index 0000000..3b3ae27 --- /dev/null +++ b/driver/utils/isMinTTY.c @@ -0,0 +1,33 @@ +/* + * We need Vista headers to use the GetFileInformationByHandleEx function and + * the FILE_NAME_INFO struct. + */ +#define WINVER 0x0600 +#define _WIN32_WINNT 0x0600 + +#include +#include +#include "isMINTTY.h" + +bool isMinTTY() { + const HANDLE h = GetStdHandle(STD_ERROR_HANDLE); + if (h == NULL || h == INVALID_HANDLE_VALUE) { + return false; + } else if (GetFileType(h) != FILE_TYPE_PIPE) { + return false; + } + + const unsigned long bufSize = sizeof(DWORD) + MAX_PATH * sizeof(WCHAR); + BYTE buf[bufSize]; + PFILE_NAME_INFO pfni = (PFILE_NAME_INFO) buf; + + if (!GetFileInformationByHandleEx(h, FileNameInfo, buf, bufSize)) { + return false; + } + + PWSTR fn = pfni->FileName; + fn[pfni->FileNameLength] = L'\0'; + + return ((wcsstr(fn, L"\\cygwin-") || wcsstr(fn, L"\\msys-")) && + wcsstr(fn, L"-pty") && wcsstr(fn, L"-master")); +} diff --git a/driver/utils/isMinTTY.h b/driver/utils/isMinTTY.h new file mode 100644 index 0000000..22e9a47 --- /dev/null +++ b/driver/utils/isMinTTY.h @@ -0,0 +1,8 @@ +#ifndef ISMINTTY_H +#define ISMINTTY_H + +#include + +bool isMinTTY(); + +#endif /* ISMINTTY_H */ From git at git.haskell.org Tue Jan 10 19:21:56 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 10 Jan 2017 19:21:56 +0000 (UTC) Subject: [commit: ghc] master: Ensure mkUserGuidePart is compiled with current GHC version (fe75d2d) Message-ID: <20170110192156.0CFE53A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/fe75d2d4db44cee72d505bba24bd44c1a2a75613/ghc >--------------------------------------------------------------- commit fe75d2d4db44cee72d505bba24bd44c1a2a75613 Author: Ben Gamari Date: Sat Jan 7 09:59:56 2017 -0500 Ensure mkUserGuidePart is compiled with current GHC version >--------------------------------------------------------------- fe75d2d4db44cee72d505bba24bd44c1a2a75613 configure.ac | 2 +- .../{mkUserGuidePart.cabal => mkUserGuidePart.cabal.in} | 8 ++++++-- 2 files changed, 7 insertions(+), 3 deletions(-) diff --git a/configure.ac b/configure.ac index 3ccaf1e..7dcde09 100644 --- a/configure.ac +++ b/configure.ac @@ -1157,7 +1157,7 @@ checkMake380() { checkMake380 make checkMake380 gmake -AC_CONFIG_FILES([mk/config.mk mk/install.mk mk/project.mk compiler/ghc.cabal ghc/ghc-bin.cabal utils/runghc/runghc.cabal libraries/ghc-boot/ghc-boot.cabal libraries/ghc-boot-th/ghc-boot-th.cabal libraries/ghci/ghci.cabal settings docs/users_guide/ghc_config.py docs/index.html libraries/prologue.txt distrib/configure.ac]) +AC_CONFIG_FILES([mk/config.mk mk/install.mk mk/project.mk compiler/ghc.cabal ghc/ghc-bin.cabal utils/runghc/runghc.cabal libraries/ghc-boot/ghc-boot.cabal libraries/ghc-boot-th/ghc-boot-th.cabal libraries/ghci/ghci.cabal settings docs/users_guide/ghc_config.py docs/index.html libraries/prologue.txt utils/mkUserGuidePart/mkUserGuidePart.cabal distrib/configure.ac]) AC_OUTPUT if test "$print_make_warning" = "true"; then diff --git a/utils/mkUserGuidePart/mkUserGuidePart.cabal b/utils/mkUserGuidePart/mkUserGuidePart.cabal.in similarity index 78% rename from utils/mkUserGuidePart/mkUserGuidePart.cabal rename to utils/mkUserGuidePart/mkUserGuidePart.cabal.in index 93dc1cf..e07033c 100644 --- a/utils/mkUserGuidePart/mkUserGuidePart.cabal +++ b/utils/mkUserGuidePart/mkUserGuidePart.cabal.in @@ -1,5 +1,5 @@ Name: mkUserGuidePart -Version: 0.1 +Version: @ProjectVersionMunged@ Copyright: XXX License: BSD3 -- XXX License-File: LICENSE @@ -47,5 +47,9 @@ Executable mkUserGuidePart Options.Verbosity Options.Warnings Build-Depends: base >= 3 && < 5, - ghc + -- mkUserGuidePart uses the compiler's DynFlags to determine + -- a few options-related properties of the compiler. + -- Consequently we should make sure we are building against + -- the right compiler. + ghc == @ProjectVersionMunged@ From git at git.haskell.org Tue Jan 10 19:21:59 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 10 Jan 2017 19:21:59 +0000 (UTC) Subject: [commit: ghc] master: testsuite: Add performance testcase from #12707 (e8d7432) Message-ID: <20170110192159.0D3173A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e8d74321b5b24afcb4230510fd6e4c4ecf6f3e19/ghc >--------------------------------------------------------------- commit e8d74321b5b24afcb4230510fd6e4c4ecf6f3e19 Author: Ben Gamari Date: Thu Jan 5 14:32:57 2017 -0500 testsuite: Add performance testcase from #12707 >--------------------------------------------------------------- e8d74321b5b24afcb4230510fd6e4c4ecf6f3e19 testsuite/tests/perf/compiler/T12707.hs | 195 ++++++++++++++++++++++++++++++++ testsuite/tests/perf/compiler/all.T | 9 ++ 2 files changed, 204 insertions(+) diff --git a/testsuite/tests/perf/compiler/T12707.hs b/testsuite/tests/perf/compiler/T12707.hs new file mode 100644 index 0000000..6b0665e --- /dev/null +++ b/testsuite/tests/perf/compiler/T12707.hs @@ -0,0 +1,195 @@ +{-# LANGUAGE DeriveGeneric, DeriveDataTypeable, DefaultSignatures, FlexibleContexts, TypeOperators #-} +module SpeedTest (Bar (..), Foo0 (..), Foo1 (..), Foo2 (..), Foo3 (..)) where + +import GHC.Generics +import Data.Typeable (Typeable) + +------------------------------------------------------------------------------- +-- Generic class +------------------------------------------------------------------------------- + +class Bar a where + bar :: a -> [String] + bar x = bar' x [] + + bar' :: a -> [String] -> [String] + default bar' :: (Generic a, GBar (Rep a)) => a -> [String] -> [String] + bar' x = gbar (from x) + +class GBar f where + gbar :: f a -> [String] -> [String] + +instance (GBar a, GBar b) => GBar (a :*: b) where + gbar (a :*: b) = gbar a . gbar b + +instance GBar a => GBar (M1 i c a) where + gbar (M1 x) = gbar x + +instance Bar a => GBar (K1 i a) where + gbar (K1 x) = bar' x + +instance Bar a => Bar [a] where + bar' = foldr (.) id . map bar' + +instance Bar a => Bar (Maybe a) where + bar' = maybe id bar' + +instance Bar Bool where + bar' = (:) . show + +instance Bar Char where + bar' = (:) . show + +instance Bar Int where + bar' = (:) . show + +------------------------------------------------------------------------------- +-- Another generic class +------------------------------------------------------------------------------- + +class Quu a where + quu :: a -> [String] + quu x = quu' x [] + + quu' :: a -> [String] -> [String] + default quu' :: (Generic a, GQuu (Rep a)) => a -> [String] -> [String] + quu' x = gquu (from x) + +class GQuu f where + gquu :: f a -> [String] -> [String] + +instance (GQuu a, GQuu b) => GQuu (a :*: b) where + gquu (a :*: b) = gquu a . gquu b + +instance GQuu a => GQuu (M1 i c a) where + gquu (M1 x) = gquu x + +instance Quu a => GQuu (K1 i a) where + gquu (K1 x) = quu' x + +instance Quu a => Quu [a] where + quu' = foldr (.) id . map quu' + +instance Quu a => Quu (Maybe a) where + quu' = maybe id quu' + +instance Quu Bool where + quu' = (:) . show + +instance Quu Char where + quu' = (:) . show + +instance Quu Int where + quu' = (:) . show + +------------------------------------------------------------------------------- +-- Data +------------------------------------------------------------------------------- + +data Foo0 = Foo0 + { foo0Field00 :: !String -- Should really have Text + , foo0Field01 :: !Int + , foo0Field02 :: ![Int] + , foo0Field03 :: !(Maybe Bool) + , foo0Field04 :: !Bool + , foo0Field05 :: !String + , foo0Field06 :: !Int + , foo0Field07 :: ![Int] + , foo0Field08 :: !(Maybe Bool) + , foo0Field09 :: !Bool + , foo0Field10 :: !String + , foo0Field11 :: !Int + , foo0Field12 :: ![Int] + , foo0Field13 :: !(Maybe Bool) + , foo0Field14 :: !Bool + , foo0Field15 :: !String + , foo0Field16 :: !Int + , foo0Field17 :: ![Int] + , foo0Field18 :: !(Maybe Bool) + , foo0Field19 :: !Bool + } + deriving (Eq, Ord, Show, Typeable, Generic) + +instance Bar Foo0 +instance Quu Foo0 + +data Foo1 = Foo1 + { foo1Field00 :: !String -- Should really have Text + , foo1Field01 :: !Int + , foo1Field02 :: ![Int] + , foo1Field03 :: !(Maybe Bool) + , foo1Field04 :: !Bool + , foo1Field05 :: !String + , foo1Field06 :: !Int + , foo1Field07 :: ![Int] + , foo1Field08 :: !(Maybe Bool) + , foo1Field09 :: !Bool + , foo1Field10 :: !String + , foo1Field11 :: !Int + , foo1Field12 :: ![Int] + , foo1Field13 :: !(Maybe Bool) + , foo1Field14 :: !Bool + , foo1Field15 :: !String + , foo1Field16 :: !Int + , foo1Field17 :: ![Int] + , foo1Field18 :: !(Maybe Bool) + , foo1Field19 :: !Bool + } + deriving (Eq, Ord, Show, Typeable, Generic) + +instance Bar Foo1 +instance Quu Foo1 + +data Foo2 = Foo2 + { foo2Field00 :: !String -- Should really have Text + , foo2Field01 :: !Int + , foo2Field02 :: ![Int] + , foo2Field03 :: !(Maybe Bool) + , foo2Field04 :: !Bool + , foo2Field05 :: !String + , foo2Field06 :: !Int + , foo2Field07 :: ![Int] + , foo2Field08 :: !(Maybe Bool) + , foo2Field09 :: !Bool + , foo2Field10 :: !String + , foo2Field11 :: !Int + , foo2Field12 :: ![Int] + , foo2Field13 :: !(Maybe Bool) + , foo2Field14 :: !Bool + , foo2Field15 :: !String + , foo2Field16 :: !Int + , foo2Field17 :: ![Int] + , foo2Field18 :: !(Maybe Bool) + , foo2Field19 :: !Bool + } + deriving (Eq, Ord, Show, Typeable, Generic) + +instance Bar Foo2 +instance Quu Foo2 + +data Foo3 = Foo3 + { foo3Field00 :: !String -- Should really have Text + , foo3Field01 :: !Int + , foo3Field02 :: ![Int] + , foo3Field03 :: !(Maybe Bool) + , foo3Field04 :: !Bool + , foo3Field05 :: !String + , foo3Field06 :: !Int + , foo3Field07 :: ![Int] + , foo3Field08 :: !(Maybe Bool) + , foo3Field09 :: !Bool + , foo3Field10 :: !String + , foo3Field11 :: !Int + , foo3Field12 :: ![Int] + , foo3Field13 :: !(Maybe Bool) + , foo3Field14 :: !Bool + , foo3Field15 :: !String + , foo3Field16 :: !Int + , foo3Field17 :: ![Int] + , foo3Field18 :: !(Maybe Bool) + , foo3Field19 :: !Bool + } + deriving (Eq, Ord, Show, Typeable, Generic) + +instance Bar Foo3 +instance Quu Foo3 diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T index 3b5e5bf..e2c037f 100644 --- a/testsuite/tests/perf/compiler/all.T +++ b/testsuite/tests/perf/compiler/all.T @@ -921,3 +921,12 @@ test('T13056', ], compile, ['-O1']) + +test('T12707', + [ compiler_stats_num_field('bytes allocated', + [(wordsize(64), 1271577192, 5), + # initial: 1271577192 + ]), + ], + compile, + ['']) From git at git.haskell.org Tue Jan 10 19:22:03 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 10 Jan 2017 19:22:03 +0000 (UTC) Subject: [commit: ghc] master: Throw an exception on heap overflow (12ad4d4) Message-ID: <20170110192203.560AE3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/12ad4d417b89462ba8e19a3c7772a931b3a93f0e/ghc >--------------------------------------------------------------- commit 12ad4d417b89462ba8e19a3c7772a931b3a93f0e Author: Demi Obenour Date: Tue Jan 10 13:33:31 2017 -0500 Throw an exception on heap overflow This changes heap overflow to throw a HeapOverflow exception instead of killing the process. Test Plan: GHC CI Reviewers: simonmar, austin, hvr, erikd, bgamari Reviewed By: simonmar, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2790 GHC Trac Issues: #1791 >--------------------------------------------------------------- 12ad4d417b89462ba8e19a3c7772a931b3a93f0e docs/users_guide/8.2.1-notes.rst | 7 +++ docs/users_guide/runtime_control.rst | 14 +++++ includes/rts/Flags.h | 10 ++++ libraries/base/GHC/IO/Exception.hs | 9 ++- libraries/base/GHC/TopHandler.hs | 31 +++++++++- rts/RtsFlags.c | 23 ++++++-- rts/RtsStartup.c | 7 +++ rts/RtsSymbols.c | 2 + rts/Schedule.c | 68 ++++++++++++++++------ rts/TopHandler.c | 62 ++++++++++++++++++++ rts/TopHandler.h | 27 +++++++++ .../tests/{cabal/pkg02 => rts/T1791}/Makefile | 2 + testsuite/tests/rts/T1791/T1791.hs | 20 +++++++ testsuite/tests/rts/T1791/T1791.stderr | 3 + testsuite/tests/rts/T1791/T1791.stdout | 1 + testsuite/tests/rts/T1791/all.T | 4 ++ testsuite/tests/rts/T5644/T5644.stdout | 2 + 17 files changed, 265 insertions(+), 27 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 12ad4d417b89462ba8e19a3c7772a931b3a93f0e From git at git.haskell.org Tue Jan 10 19:22:06 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 10 Jan 2017 19:22:06 +0000 (UTC) Subject: [commit: ghc] master: base: Add Foreign.ForeignPtr.plusForeignPtr. (226c535) Message-ID: <20170110192206.0872B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/226c5352bb63ab53b11a23484c8ec8f20a57d538/ghc >--------------------------------------------------------------- commit 226c5352bb63ab53b11a23484c8ec8f20a57d538 Author: Shea Levy Date: Tue Jan 10 13:33:58 2017 -0500 base: Add Foreign.ForeignPtr.plusForeignPtr. Reviewers: simonmar, austin, hvr, bgamari Reviewed By: bgamari Subscribers: RyanGlScott, thomie Differential Revision: https://phabricator.haskell.org/D2900 >--------------------------------------------------------------- 226c5352bb63ab53b11a23484c8ec8f20a57d538 libraries/base/Foreign/ForeignPtr.hs | 1 + libraries/base/Foreign/ForeignPtr/Imp.hs | 1 + libraries/base/GHC/ForeignPtr.hs | 7 +++++++ libraries/base/changelog.md | 2 ++ 4 files changed, 11 insertions(+) diff --git a/libraries/base/Foreign/ForeignPtr.hs b/libraries/base/Foreign/ForeignPtr.hs index cedfba7..a684a8d 100644 --- a/libraries/base/Foreign/ForeignPtr.hs +++ b/libraries/base/Foreign/ForeignPtr.hs @@ -35,6 +35,7 @@ module Foreign.ForeignPtr ( -- ** Low-level operations , touchForeignPtr , castForeignPtr + , plusForeignPtr -- ** Allocating managed memory , mallocForeignPtr diff --git a/libraries/base/Foreign/ForeignPtr/Imp.hs b/libraries/base/Foreign/ForeignPtr/Imp.hs index 2c3f393..4824c30 100644 --- a/libraries/base/Foreign/ForeignPtr/Imp.hs +++ b/libraries/base/Foreign/ForeignPtr/Imp.hs @@ -38,6 +38,7 @@ module Foreign.ForeignPtr.Imp , unsafeForeignPtrToPtr , touchForeignPtr , castForeignPtr + , plusForeignPtr -- ** Allocating managed memory , mallocForeignPtr diff --git a/libraries/base/GHC/ForeignPtr.hs b/libraries/base/GHC/ForeignPtr.hs index b9b29ea..6088084 100644 --- a/libraries/base/GHC/ForeignPtr.hs +++ b/libraries/base/GHC/ForeignPtr.hs @@ -39,6 +39,7 @@ module GHC.ForeignPtr touchForeignPtr, unsafeForeignPtrToPtr, castForeignPtr, + plusForeignPtr, newConcForeignPtr, addForeignPtrConcFinalizer, finalizeForeignPtr @@ -434,6 +435,12 @@ castForeignPtr :: ForeignPtr a -> ForeignPtr b -- parameterised by one type into another type. castForeignPtr = coerce +plusForeignPtr :: ForeignPtr a -> Int -> ForeignPtr b +-- ^Advances the given address by the given offset in bytes. +-- +-- @since 4.10.0.0 +plusForeignPtr (ForeignPtr addr c) (I# d) = ForeignPtr (plusAddr# addr d) c + -- | Causes the finalizers associated with a foreign pointer to be run -- immediately. finalizeForeignPtr :: ForeignPtr a -> IO () diff --git a/libraries/base/changelog.md b/libraries/base/changelog.md index e0cd384..b73e01e 100644 --- a/libraries/base/changelog.md +++ b/libraries/base/changelog.md @@ -35,6 +35,8 @@ * Raw buffer operations in `GHC.IO.FD` are now strict in the buffer, offset, and length operations (#9696) + * Add `plusForeignPtr` to `Foreign.ForeignPtr`. + ## 4.9.0.0 *May 2016* * Bundled with GHC 8.0 From git at git.haskell.org Tue Jan 10 19:22:09 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 10 Jan 2017 19:22:09 +0000 (UTC) Subject: [commit: ghc] master: Check that type variable does not reference itself in its kind signature (8a76d32) Message-ID: <20170110192209.78BE73A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8a76d32e4fbdafe787a0f5b2a492c0d0ea1ed980/ghc >--------------------------------------------------------------- commit 8a76d32e4fbdafe787a0f5b2a492c0d0ea1ed980 Author: John Leo Date: Tue Jan 10 13:36:17 2017 -0500 Check that type variable does not reference itself in its kind signature This fixes #11592. Test Plan: validate Reviewers: simonpj, austin, bgamari, goldfire Reviewed By: goldfire Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2914 GHC Trac Issues: #11592 >--------------------------------------------------------------- 8a76d32e4fbdafe787a0f5b2a492c0d0ea1ed980 compiler/rename/RnTypes.hs | 22 ++++++++++++++++------ testsuite/tests/rename/should_fail/T11592.hs | 10 ++++++++++ testsuite/tests/rename/should_fail/T11592.stderr | 19 +++++++++++++++++++ testsuite/tests/rename/should_fail/all.T | 1 + 4 files changed, 46 insertions(+), 6 deletions(-) diff --git a/compiler/rename/RnTypes.hs b/compiler/rename/RnTypes.hs index f3fcf88..ec00511 100644 --- a/compiler/rename/RnTypes.hs +++ b/compiler/rename/RnTypes.hs @@ -918,19 +918,19 @@ bindLHsTyVarBndr :: HsDocContext bindLHsTyVarBndr doc mb_assoc kv_names tv_names hs_tv_bndr thing_inside = case hs_tv_bndr of L loc (UserTyVar lrdr@(L lv rdr)) -> - do { check_dup loc rdr + do { check_dup loc rdr [] ; nm <- newTyVarNameRn mb_assoc lrdr ; bindLocalNamesFV [nm] $ thing_inside [] emptyNameSet (L loc (UserTyVar (L lv nm))) } L loc (KindedTyVar lrdr@(L lv rdr) kind) -> - do { check_dup lv rdr + do { free_kvs <- freeKiTyVarsAllVars <$> extractHsTyRdrTyVars kind + ; check_dup lv rdr (map unLoc free_kvs) -- check for -XKindSignatures ; sig_ok <- xoptM LangExt.KindSignatures ; unless sig_ok (badKindSigErr doc kind) -- deal with kind vars in the user-written kind - ; free_kvs <- freeKiTyVarsAllVars <$> extractHsTyRdrTyVars kind ; bindImplicitKvs doc mb_assoc free_kvs tv_names $ \ new_kv_nms other_kv_nms -> do { (kind', fvs1) <- rnLHsKind doc kind @@ -943,9 +943,15 @@ bindLHsTyVarBndr doc mb_assoc kv_names tv_names hs_tv_bndr thing_inside -- make sure that the RdrName isn't in the sets of -- names. We can't just check that it's not in scope at all -- because we might be inside an associated class. - check_dup :: SrcSpan -> RdrName -> RnM () - check_dup loc rdr - = do { m_name <- lookupLocalOccRn_maybe rdr + check_dup :: SrcSpan -> RdrName -> [RdrName] -> RnM () + check_dup loc rdr kindFreeVars + = do { -- Disallow use of a type variable name in its + -- kind signature (#11592). + when (rdr `elem` kindFreeVars) $ + addErrAt loc (vcat [ ki_ty_self_err rdr + , pprHsDocContext doc ]) + + ; m_name <- lookupLocalOccRn_maybe rdr ; whenIsJust m_name $ \name -> do { when (name `elemNameSet` kv_names) $ addErrAt loc (vcat [ ki_ty_err_msg name @@ -957,6 +963,10 @@ bindLHsTyVarBndr doc mb_assoc kv_names tv_names hs_tv_bndr thing_inside text "used as a kind variable before being bound" $$ text "as a type variable. Perhaps reorder your variables?" + ki_ty_self_err n = text "Variable" <+> quotes (ppr n) <+> + text "is used in the kind signature of its" $$ + text "declaration as a type variable." + bindImplicitKvs :: HsDocContext -> Maybe a diff --git a/testsuite/tests/rename/should_fail/T11592.hs b/testsuite/tests/rename/should_fail/T11592.hs new file mode 100644 index 0000000..b963cdf --- /dev/null +++ b/testsuite/tests/rename/should_fail/T11592.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE TypeInType #-} + +module Bug11592 where + +data A (a :: a) = MkA String + +data B b (a :: a b) = MkB String +data C b (a :: b a) = MkC String + +data D b c (a :: c a b) = MkD String diff --git a/testsuite/tests/rename/should_fail/T11592.stderr b/testsuite/tests/rename/should_fail/T11592.stderr new file mode 100644 index 0000000..bffea1c --- /dev/null +++ b/testsuite/tests/rename/should_fail/T11592.stderr @@ -0,0 +1,19 @@ +T11592.hs:5:9: + Variable ‘a’ is used in the kind signature of its + declaration as a type variable. + the data type declaration for ‘A’ + +T11592.hs:7:11: + Variable ‘a’ is used in the kind signature of its + declaration as a type variable. + the data type declaration for ‘B’ + +T11592.hs:8:11: + Variable ‘a’ is used in the kind signature of its + declaration as a type variable. + the data type declaration for ‘C’ + +T11592.hs:10:13: + Variable ‘a’ is used in the kind signature of its + declaration as a type variable. + the data type declaration for ‘D’ diff --git a/testsuite/tests/rename/should_fail/all.T b/testsuite/tests/rename/should_fail/all.T index d42ca56..05fc5e4 100644 --- a/testsuite/tests/rename/should_fail/all.T +++ b/testsuite/tests/rename/should_fail/all.T @@ -142,4 +142,5 @@ test('T11663', normal, compile_fail, ['']) test('T12229', normal, compile, ['']) test('T12681', normal, multimod_compile_fail, ['T12681','-v0']) test('T12686', normal, compile_fail, ['']) +test('T11592', normal, compile_fail, ['']) test('T12879', normal, compile_fail, ['']) From git at git.haskell.org Tue Jan 10 19:22:12 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 10 Jan 2017 19:22:12 +0000 (UTC) Subject: [commit: ghc] master: Enable subsections via symbols on iOS (58e68b3) Message-ID: <20170110192212.2AA1B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/58e68b37e74fd226ef6be1d59785cb899e01dbd5/ghc >--------------------------------------------------------------- commit 58e68b37e74fd226ef6be1d59785cb899e01dbd5 Author: Demi Obenour Date: Tue Jan 10 13:37:47 2017 -0500 Enable subsections via symbols on iOS Test Plan: GHC CI Reviewers: austin, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2915 GHC Trac Issues: #11040, #13049 >--------------------------------------------------------------- 58e68b37e74fd226ef6be1d59785cb899e01dbd5 compiler/main/DriverPipeline.hs | 2 +- compiler/main/HscMain.hs | 4 ++-- compiler/utils/Platform.hs | 6 ++++++ 3 files changed, 9 insertions(+), 3 deletions(-) diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs index a62233d..a54e05c 100644 --- a/compiler/main/DriverPipeline.hs +++ b/compiler/main/DriverPipeline.hs @@ -1794,7 +1794,7 @@ linkBinary' staticLink dflags o_files dep_packages = do in ["-L" ++ l] ++ ["-Wl,-rpath", "-Wl," ++ libpath] | otherwise = ["-L" ++ l] - let dead_strip = if osMachOTarget (platformOS platform) + let dead_strip = if osSubsectionsViaSymbols (platformOS platform) then ["-Wl,-dead_strip"] else [] let lib_paths = libraryPaths dflags diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs index 12e8a1d..2fc7341 100644 --- a/compiler/main/HscMain.hs +++ b/compiler/main/HscMain.hs @@ -137,7 +137,7 @@ import Maybes import DynFlags import ErrUtils -import Platform ( platformOS, OS(OSDarwin) ) +import Platform ( platformOS, osSubsectionsViaSymbols ) import Outputable import NameEnv @@ -1394,7 +1394,7 @@ doCodeGen hsc_env this_mod data_tycons let pipeline_stream | gopt Opt_SplitObjs dflags || gopt Opt_SplitSections dflags || - platformOS (targetPlatform dflags) == OSDarwin + osSubsectionsViaSymbols (platformOS (targetPlatform dflags)) = {-# SCC "cmmPipeline" #-} let run_pipeline us cmmgroup = do let (topSRT', us') = initUs us emptySRT diff --git a/compiler/utils/Platform.hs b/compiler/utils/Platform.hs index 600ed80..86c70a9 100644 --- a/compiler/utils/Platform.hs +++ b/compiler/utils/Platform.hs @@ -14,6 +14,7 @@ module Platform ( isARM, osElfTarget, osMachOTarget, + osSubsectionsViaSymbols, platformUsesFrameworks, platformBinariesAreStaticLibs, ) @@ -161,6 +162,11 @@ osBinariesAreStaticLibs :: OS -> Bool osBinariesAreStaticLibs OSiOS = True osBinariesAreStaticLibs _ = False +osSubsectionsViaSymbols :: OS -> Bool +osSubsectionsViaSymbols OSDarwin = True +osSubsectionsViaSymbols OSiOS = True +osSubsectionsViaSymbols _ = False + platformBinariesAreStaticLibs :: Platform -> Bool platformBinariesAreStaticLibs = osBinariesAreStaticLibs . platformOS From git at git.haskell.org Tue Jan 10 19:22:14 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 10 Jan 2017 19:22:14 +0000 (UTC) Subject: [commit: ghc] master: users-guide: Produce OpenSearch description (89d4d26) Message-ID: <20170110192214.CFBAF3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/89d4d2618861b7d37d9e2bd696eda88a37bc4455/ghc >--------------------------------------------------------------- commit 89d4d2618861b7d37d9e2bd696eda88a37bc4455 Author: Ben Gamari Date: Tue Jan 10 13:38:15 2017 -0500 users-guide: Produce OpenSearch description Reviewers: austin, hsyl20 Reviewed By: hsyl20 Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2921 >--------------------------------------------------------------- 89d4d2618861b7d37d9e2bd696eda88a37bc4455 docs/users_guide/conf.py | 1 + 1 file changed, 1 insertion(+) diff --git a/docs/users_guide/conf.py b/docs/users_guide/conf.py index 042ff6d..781b267 100644 --- a/docs/users_guide/conf.py +++ b/docs/users_guide/conf.py @@ -45,6 +45,7 @@ html_logo = None html_static_path = ['images'] # Convert quotes and dashes to typographically correct entities html_use_smartypants = True +html_use_opensearch = 'https://downloads.haskell.org/~ghc/master/users-guide' html_show_copyright = True # If true, an OpenSearch description file will be output, and all pages will From git at git.haskell.org Tue Jan 10 19:22:17 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 10 Jan 2017 19:22:17 +0000 (UTC) Subject: [commit: ghc] master: Add doc header to Dynamic's re-export of Typeable (fe8bc14) Message-ID: <20170110192217.859323A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/fe8bc14fdaf1596cef008148cc9ff40cbce5e994/ghc >--------------------------------------------------------------- commit fe8bc14fdaf1596cef008148cc9ff40cbce5e994 Author: Chris Martin Date: Tue Jan 10 13:38:33 2017 -0500 Add doc header to Dynamic's re-export of Typeable Data.Data and Data.Dynamic both re-export Data.Typeable with the same comment, though in the Data module the comment is a haddock header, and in Typeable it is not. I assume the inconsistency was a mistake. Reviewers: austin, hvr, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2923 >--------------------------------------------------------------- fe8bc14fdaf1596cef008148cc9ff40cbce5e994 libraries/base/Data/Dynamic.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/base/Data/Dynamic.hs b/libraries/base/Data/Dynamic.hs index 4cdde43..218bdc1 100644 --- a/libraries/base/Data/Dynamic.hs +++ b/libraries/base/Data/Dynamic.hs @@ -24,7 +24,7 @@ module Data.Dynamic ( - -- Module Data.Typeable re-exported for convenience + -- * Module Data.Typeable re-exported for convenience module Data.Typeable, -- * The @Dynamic@ type From git at git.haskell.org Tue Jan 10 19:22:20 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 10 Jan 2017 19:22:20 +0000 (UTC) Subject: [commit: ghc] master: event manager: Don't worry if attempt to wake dead manager fails (6de7613) Message-ID: <20170110192220.357A63A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6de7613604216f65fae92d8066a078bf9cd3c088/ghc >--------------------------------------------------------------- commit 6de7613604216f65fae92d8066a078bf9cd3c088 Author: Ben Gamari Date: Tue Jan 10 13:38:50 2017 -0500 event manager: Don't worry if attempt to wake dead manager fails This fixes #12038, where the TimerManager would attempt to wake up a manager that was already dead, resulting in setnumcapabilities001 occassionally failing during shutdown with unexpected output on stderr. I'm frankly still not entirely confident in this solution but perhaps it will help to get a few more eyes on this. My hypothesis is that the TimerManager is racing: thread TimerManager worker ------- -------------------- requests that thread manager shuts down begins to clean up, closing eventfd calls wakeManager, which tries to write to closed eventfd To prevent this `wakeManager` will need to synchronize with the TimerManger worker to ensure that the worker doesn't clean up the `Control` while another thread is trying to send a wakeup. However, this would add a bit of overhead on every timer interaction, which feels rather costly for what is really a problem only at shutdown. Moreover, it seems that the event manager (e.g. `GHC.Event.Manager`) is also afflicted by a similar race. This patch instead simply tries to catch the write failure after it has happened and silence it in the case that the fd has vanished. It feels rather hacky but it seems to work. Test Plan: Run `setnumcapabilities001` repeatedly Reviewers: austin, hvr, simonmar Reviewed By: simonmar Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2926 GHC Trac Issues: #12038 >--------------------------------------------------------------- 6de7613604216f65fae92d8066a078bf9cd3c088 libraries/base/GHC/Event/Control.hs | 28 +++++++++++++++++++++++----- 1 file changed, 23 insertions(+), 5 deletions(-) diff --git a/libraries/base/GHC/Event/Control.hs b/libraries/base/GHC/Event/Control.hs index 0b0f558..83950c2 100644 --- a/libraries/base/GHC/Event/Control.hs +++ b/libraries/base/GHC/Event/Control.hs @@ -30,11 +30,12 @@ module GHC.Event.Control import Foreign.ForeignPtr (ForeignPtr) import GHC.Base +import GHC.IORef import GHC.Conc.Signal (Signal) import GHC.Real (fromIntegral) import GHC.Show (Show) import GHC.Word (Word8) -import Foreign.C.Error (throwErrnoIfMinus1_) +import Foreign.C.Error (throwErrnoIfMinus1_, throwErrno, getErrno, eBADF) import Foreign.C.Types (CInt(..), CSize(..)) import Foreign.ForeignPtr (mallocForeignPtrBytes, withForeignPtr) import Foreign.Marshal (alloca, allocaBytes) @@ -69,7 +70,9 @@ data Control = W { , wakeupWriteFd :: {-# UNPACK #-} !Fd #endif , didRegisterWakeupFd :: !Bool - } deriving (Show) + -- | Have this Control's fds been cleaned up? + , controlIsDead :: !(IORef Bool) + } #if defined(HAVE_EVENTFD) wakeupReadFd :: Control -> Fd @@ -101,6 +104,7 @@ newControl shouldRegister = allocaArray 2 $ \fds -> do (wake_rd, wake_wr) <- createPipe when shouldRegister $ c_setIOManagerWakeupFd wake_wr #endif + isDead <- newIORef False return W { controlReadFd = fromIntegral ctrl_rd , controlWriteFd = fromIntegral ctrl_wr #if defined(HAVE_EVENTFD) @@ -110,6 +114,7 @@ newControl shouldRegister = allocaArray 2 $ \fds -> do , wakeupWriteFd = fromIntegral wake_wr #endif , didRegisterWakeupFd = shouldRegister + , controlIsDead = isDead } -- | Close the control structure used by the IO manager thread. @@ -119,6 +124,7 @@ newControl shouldRegister = allocaArray 2 $ \fds -> do -- file after it has been closed. closeControl :: Control -> IO () closeControl w = do + atomicModifyIORef (controlIsDead w) (\_ -> (True, ())) _ <- c_close . fromIntegral . controlReadFd $ w _ <- c_close . fromIntegral . controlWriteFd $ w when (didRegisterWakeupFd w) $ c_setIOManagerWakeupFd (-1) @@ -172,9 +178,21 @@ readControlMessage ctrl fd sendWakeup :: Control -> IO () #if defined(HAVE_EVENTFD) -sendWakeup c = - throwErrnoIfMinus1_ "sendWakeup" $ - c_eventfd_write (fromIntegral (controlEventFd c)) 1 +sendWakeup c = do + n <- c_eventfd_write (fromIntegral (controlEventFd c)) 1 + case n of + 0 -> return () + _ -> do errno <- getErrno + -- Check that Control is still alive if we failed, since it's + -- possible that someone cleaned up the fds behind our backs and + -- consequently eventfd_write failed with EBADF. If it is dead + -- then just swallow the error since we are shutting down + -- anyways. Otherwise we will see failures during shutdown from + -- setnumcapabilities001 (#12038) + isDead <- readIORef (controlIsDead c) + if isDead && errno == eBADF + then return () + else throwErrno "sendWakeup" #else sendWakeup c = do n <- sendMessage (wakeupWriteFd c) CMsgWakeup From git at git.haskell.org Tue Jan 10 19:22:22 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 10 Jan 2017 19:22:22 +0000 (UTC) Subject: [commit: ghc] master: Remove deprecated InteractiveEval API (eee8199) Message-ID: <20170110192222.DF7CC3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/eee819943a0ea05af369fe3c728b865094e8fe33/ghc >--------------------------------------------------------------- commit eee819943a0ea05af369fe3c728b865094e8fe33 Author: David Feuer Date: Tue Jan 10 13:40:51 2017 -0500 Remove deprecated InteractiveEval API Remove `RunResult(..)`, `runStmt`, and `runStmtWithLocation`. These were all deprecated and documented as slated for removal in GHC 7.14, which I figure means 8.2. See cf7573b8207bbb17c58612f3345e0b17d74cfb58 for an explanation of why this change was made. Reviewers: simonpj, hvr, austin, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2949 GHC Trac Issues: #13095 >--------------------------------------------------------------- eee819943a0ea05af369fe3c728b865094e8fe33 compiler/main/GHC.hs | 5 ----- compiler/main/InteractiveEval.hs | 41 +--------------------------------------- 2 files changed, 1 insertion(+), 45 deletions(-) diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs index 59e42f9..031bd15 100644 --- a/compiler/main/GHC.hs +++ b/compiler/main/GHC.hs @@ -147,11 +147,6 @@ module GHC ( InteractiveEval.back, InteractiveEval.forward, - -- ** Deprecated API - RunResult(..), - runStmt, runStmtWithLocation, - resume, - -- * Abstract syntax elements -- ** Packages diff --git a/compiler/main/InteractiveEval.hs b/compiler/main/InteractiveEval.hs index 3cb1856..3c2973d 100644 --- a/compiler/main/InteractiveEval.hs +++ b/compiler/main/InteractiveEval.hs @@ -15,7 +15,6 @@ module InteractiveEval ( runDecls, runDeclsWithLocation, isStmt, hasImport, isImport, isDecl, parseImportDecl, SingleStep(..), - resume, abandon, abandonAll, getResumeContext, getHistorySpan, @@ -36,9 +35,7 @@ module InteractiveEval ( parseExpr, compileParsedExpr, compileExpr, dynCompileExpr, compileExprRemote, compileParsedExprRemote, - Term(..), obtainTermFromId, obtainTermFromVal, reconstructType, - -- * Depcreated API (remove in GHC 7.14) - RunResult(..), runStmt, runStmtWithLocation, + Term(..), obtainTermFromId, obtainTermFromVal, reconstructType ) where #include "HsVersions.h" @@ -97,7 +94,6 @@ import Control.Monad import GHC.Exts import Data.Array import Exception -import Control.Concurrent -- ----------------------------------------------------------------------------- -- running a statement interactively @@ -195,38 +191,6 @@ execStmt stmt ExecOptions{..} = do handleRunStatus execSingleStep stmt bindings ids status (emptyHistory size) --- | The type returned by the deprecated 'runStmt' and --- 'runStmtWithLocation' API -data RunResult - = RunOk [Name] -- ^ names bound by this evaluation - | RunException SomeException -- ^ statement raised an exception - | RunBreak ThreadId [Name] (Maybe BreakInfo) - --- | Conver the old result type to the new result type -execResultToRunResult :: ExecResult -> RunResult -execResultToRunResult r = - case r of - ExecComplete{ execResult = Left ex } -> RunException ex - ExecComplete{ execResult = Right names } -> RunOk names - ExecBreak{..} -> RunBreak (error "no breakThreadId") breakNames breakInfo - --- Remove in GHC 7.14 -{-# DEPRECATED runStmt "use execStmt" #-} --- | Run a statement in the current interactive context. Statement --- may bind multple values. -runStmt :: GhcMonad m => String -> SingleStep -> m RunResult -runStmt stmt step = - execResultToRunResult <$> execStmt stmt execOptions { execSingleStep = step } - --- Remove in GHC 7.14 -{-# DEPRECATED runStmtWithLocation "use execStmtWithLocation" #-} -runStmtWithLocation :: GhcMonad m => String -> Int -> - String -> SingleStep -> m RunResult -runStmtWithLocation source linenumber expr step = do - execResultToRunResult <$> - execStmt expr execOptions { execSingleStep = step - , execSourceFile = source - , execLineNumber = linenumber } runDecls :: GhcMonad m => String -> m [Name] runDecls = runDeclsWithLocation "" 1 @@ -375,9 +339,6 @@ handleRunStatus step expr bindings final_ids status history = panic "not_tracing" -- actually exhaustive, but GHC can't tell -resume :: GhcMonad m => (SrcSpan->Bool) -> SingleStep -> m RunResult -resume canLogSpan step = execResultToRunResult <$> resumeExec canLogSpan step - resumeExec :: GhcMonad m => (SrcSpan->Bool) -> SingleStep -> m ExecResult resumeExec canLogSpan step = do From git at git.haskell.org Tue Jan 10 19:22:25 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 10 Jan 2017 19:22:25 +0000 (UTC) Subject: [commit: ghc] master: Remove tyConString (5857dfb) Message-ID: <20170110192225.93FBE3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5857dfb8873eac6e682802524e2c2d9b96bb42f4/ghc >--------------------------------------------------------------- commit 5857dfb8873eac6e682802524e2c2d9b96bb42f4 Author: David Feuer Date: Tue Jan 10 13:41:31 2017 -0500 Remove tyConString `tyConString` has been deprecated since GHC 7.4. It's time for it to go. Reviewers: austin, hvr, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2950 GHC Trac Issues: #13096 >--------------------------------------------------------------- 5857dfb8873eac6e682802524e2c2d9b96bb42f4 libraries/base/Data/Typeable.hs | 1 - libraries/base/Data/Typeable/Internal.hs | 8 +------- 2 files changed, 1 insertion(+), 8 deletions(-) diff --git a/libraries/base/Data/Typeable.hs b/libraries/base/Data/Typeable.hs index 1afc6a9..d722519 100644 --- a/libraries/base/Data/Typeable.hs +++ b/libraries/base/Data/Typeable.hs @@ -68,7 +68,6 @@ module Data.Typeable TyCon, -- abstract, instance of: Eq, Show, Typeable -- For now don't export Module, to avoid name clashes tyConFingerprint, - tyConString, tyConPackage, tyConModule, tyConName, diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs index e19854c..80b1717 100644 --- a/libraries/base/Data/Typeable/Internal.hs +++ b/libraries/base/Data/Typeable/Internal.hs @@ -38,7 +38,7 @@ module Data.Typeable.Internal ( -- * TyCon TyCon, -- Abstract - tyConPackage, tyConModule, tyConName, tyConString, tyConFingerprint, + tyConPackage, tyConModule, tyConName, tyConFingerprint, mkTyCon3, mkTyCon3#, rnfTyCon, @@ -103,12 +103,6 @@ trNameString :: TrName -> String trNameString (TrNameS s) = unpackCString# s trNameString (TrNameD s) = s --- | Observe string encoding of a type representation -{-# DEPRECATED tyConString "renamed to 'tyConName'; 'tyConModule' and 'tyConPackage' are also available." #-} --- deprecated in 7.4 -tyConString :: TyCon -> String -tyConString = tyConName - tyConFingerprint :: TyCon -> Fingerprint tyConFingerprint (TyCon hi lo _ _) = Fingerprint (W64# hi) (W64# lo) From git at git.haskell.org Tue Jan 10 19:22:28 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 10 Jan 2017 19:22:28 +0000 (UTC) Subject: [commit: ghc] master: Fix typo in comment (b1923ed) Message-ID: <20170110192228.461B93A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b1923ed55d64876d94206d40403ed833abb5533c/ghc >--------------------------------------------------------------- commit b1923ed55d64876d94206d40403ed833abb5533c Author: Steffen Forkmann Date: Sat Jan 7 10:39:09 2017 +0100 Fix typo in comment >--------------------------------------------------------------- b1923ed55d64876d94206d40403ed833abb5533c compiler/utils/Util.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/utils/Util.hs b/compiler/utils/Util.hs index 88b5090..d5c6e2a 100644 --- a/compiler/utils/Util.hs +++ b/compiler/utils/Util.hs @@ -905,7 +905,7 @@ fuzzyLookup user_entered possibilites where -- Work out an approriate match threshold: -- We report a candidate if its edit distance is <= the threshold, - -- The threshhold is set to about a quarter of the # of characters the user entered + -- The threshold is set to about a quarter of the # of characters the user entered -- Length Threshold -- 1 0 -- Don't suggest *any* candidates -- 2 1 -- for single-char identifiers From git at git.haskell.org Tue Jan 10 20:28:03 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 10 Jan 2017 20:28:03 +0000 (UTC) Subject: [commit: ghc] master: Expose purgeObj in ObjLink (c2bd62e) Message-ID: <20170110202803.2C26A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c2bd62ed62d2fae126819136d428989a7b4ddc79/ghc >--------------------------------------------------------------- commit c2bd62ed62d2fae126819136d428989a7b4ddc79 Author: Jon Coens Date: Tue Jan 10 14:28:54 2017 -0500 Expose purgeObj in ObjLink Test Plan: Rebuild GHC under 7.10.2. Reviewers: niteria, simonmar, austin, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2948 >--------------------------------------------------------------- c2bd62ed62d2fae126819136d428989a7b4ddc79 libraries/ghci/GHCi/ObjLink.hs | 21 ++++++++++++++++++--- 1 file changed, 18 insertions(+), 3 deletions(-) diff --git a/libraries/ghci/GHCi/ObjLink.hs b/libraries/ghci/GHCi/ObjLink.hs index 05a0a16..d7dbdd3 100644 --- a/libraries/ghci/GHCi/ObjLink.hs +++ b/libraries/ghci/GHCi/ObjLink.hs @@ -16,6 +16,7 @@ module GHCi.ObjLink , loadArchive , loadObj , unloadObj + , purgeObj , lookupSymbol , lookupClosure , resolveObjs @@ -25,6 +26,7 @@ module GHCi.ObjLink ) where import GHCi.RemoteTypes +import Control.Exception (throwIO, ErrorCall(..)) import Control.Monad ( when ) import Foreign.C import Foreign.Marshal.Alloc ( free ) @@ -109,19 +111,31 @@ loadArchive :: String -> IO () loadArchive str = do withFilePath str $ \c_str -> do r <- c_loadArchive c_str - when (r == 0) (error ("loadArchive " ++ show str ++ ": failed")) + when (r == 0) (throwIO (ErrorCall ("loadArchive " ++ show str ++ ": failed"))) loadObj :: String -> IO () loadObj str = do withFilePath str $ \c_str -> do r <- c_loadObj c_str - when (r == 0) (error ("loadObj " ++ show str ++ ": failed")) + when (r == 0) (throwIO (ErrorCall ("loadObj " ++ show str ++ ": failed"))) +-- | @unloadObj@ drops the given dynamic library from the symbol table +-- as well as enables the library to be removed from memory during +-- a future major GC. unloadObj :: String -> IO () unloadObj str = withFilePath str $ \c_str -> do r <- c_unloadObj c_str - when (r == 0) (error ("unloadObj " ++ show str ++ ": failed")) + when (r == 0) (throwIO (ErrorCall ("unloadObj " ++ show str ++ ": failed"))) + +-- | @purgeObj@ drops the symbols for the dynamic library from the symbol +-- table. Unlike 'unloadObj', the library will not be dropped memory during +-- a future major GC. +purgeObj :: String -> IO () +purgeObj str = + withFilePath str $ \c_str -> do + r <- c_purgeObj c_str + when (r == 0) (throwIO (ErrorCall ("purgeObj " ++ show str ++ ": failed"))) addLibrarySearchPath :: String -> IO (Ptr ()) addLibrarySearchPath str = @@ -153,6 +167,7 @@ foreign import ccall unsafe "initLinker_" c_initLinker_ foreign import ccall unsafe "lookupSymbol" c_lookupSymbol :: CString -> IO (Ptr a) foreign import ccall unsafe "loadArchive" c_loadArchive :: CFilePath -> IO Int foreign import ccall unsafe "loadObj" c_loadObj :: CFilePath -> IO Int +foreign import ccall unsafe "purgeObj" c_purgeObj :: CFilePath -> IO Int foreign import ccall unsafe "unloadObj" c_unloadObj :: CFilePath -> IO Int foreign import ccall unsafe "resolveObjs" c_resolveObjs :: IO Int foreign import ccall unsafe "addLibrarySearchPath" c_addLibrarySearchPath :: CFilePath -> IO (Ptr ()) From git at git.haskell.org Tue Jan 10 20:28:05 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 10 Jan 2017 20:28:05 +0000 (UTC) Subject: [commit: ghc] master: testsuite driver: don't append to existing output files (35a5b60) Message-ID: <20170110202805.D9CA93A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/35a5b60390f2a400d06a2209eb03b7fd6ccffdab/ghc >--------------------------------------------------------------- commit 35a5b60390f2a400d06a2209eb03b7fd6ccffdab Author: Reid Barton Date: Tue Jan 10 14:29:11 2017 -0500 testsuite driver: don't append to existing output files If you happen to have a T1234.run.stdout file lying aroud (probably from before the move to running tests in temporary subdirectories) it gets symlinked into the T1234.run directory since its name starts with T1234; and then program output gets appended to the existing file (through the symlink). We should open the file for writing instead, to replace the symlink with a new file. Test Plan: tested locally, + harbormaster Reviewers: austin, Phyx, bgamari Reviewed By: Phyx, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2946 >--------------------------------------------------------------- 35a5b60390f2a400d06a2209eb03b7fd6ccffdab testsuite/driver/testlib.py | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/testsuite/driver/testlib.py b/testsuite/driver/testlib.py index f6729ac..c0135f0 100644 --- a/testsuite/driver/testlib.py +++ b/testsuite/driver/testlib.py @@ -1801,11 +1801,11 @@ def runCmd(cmd, stdin=None, stdout=None, stderr=None, timeout_multiplier=1.0, pr sys.stderr.buffer.write(stderr_buffer) if stdout: - with io.open(stdout, 'ab') as f: + with io.open(stdout, 'wb') as f: f.write(stdout_buffer) if stderr: if stderr is not subprocess.STDOUT: - with io.open(stderr, 'ab') as f: + with io.open(stderr, 'wb') as f: f.write(stderr_buffer) if r.returncode == 98: From git at git.haskell.org Tue Jan 10 20:28:08 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 10 Jan 2017 20:28:08 +0000 (UTC) Subject: [commit: ghc] master: Fix terminal corruption bug and clean up SDoc interface. (22845ad) Message-ID: <20170110202808.9A8F33A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/22845adcc51b40040b9d526c36d2d36edbb11dd7/ghc >--------------------------------------------------------------- commit 22845adcc51b40040b9d526c36d2d36edbb11dd7 Author: Phil Ruffwind Date: Tue Jan 10 14:31:55 2017 -0500 Fix terminal corruption bug and clean up SDoc interface. - Fix #13076 by wrapping `printDoc_` so that the terminal color is reset even if an exception occurs. - Add `printSDoc`, `printSDocLn`, and `bufLeftRenderSDoc` to keep `SDoc` values abstract (they are wrappers of `printDoc_`, `printDoc`, and `bufLeftRender` respectively). - Remove unused function: `printForAsm` Test Plan: manual Reviewers: RyanGlScott, austin, dfeuer, bgamari Reviewed By: dfeuer, bgamari Subscribers: dfeuer, mpickering, thomie Differential Revision: https://phabricator.haskell.org/D2932 GHC Trac Issues: #13076 >--------------------------------------------------------------- 22845adcc51b40040b9d526c36d2d36edbb11dd7 compiler/llvmGen/LlvmCodeGen/Base.hs | 5 ++-- compiler/main/DynFlags.hs | 15 +++++------ compiler/nativeGen/AsmCodeGen.hs | 7 +++-- compiler/utils/Outputable.hs | 51 +++++++++++++++++++++++++++--------- 4 files changed, 51 insertions(+), 27 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 22845adcc51b40040b9d526c36d2d36edbb11dd7 From git at git.haskell.org Tue Jan 10 20:28:14 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 10 Jan 2017 20:28:14 +0000 (UTC) Subject: [commit: ghc] master: Mark *FB functions INLINE[0] (Fixes #13001) (09bce7a) Message-ID: <20170110202814.BE1DF3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/09bce7accd330e99b1667f8b4eda7def722d6f0c/ghc >--------------------------------------------------------------- commit 09bce7accd330e99b1667f8b4eda7def722d6f0c Author: Takano Akio Date: Tue Jan 10 14:36:00 2017 -0500 Mark *FB functions INLINE[0] (Fixes #13001) When fusion rules successfully fire, we are left with calls to *FB functions. They are higher-order functions, and therefore they often benefit from inlining. This is particularly important when then final consumer is a strict fold (foldl', length, etc.), because not inlining these functions means allocating a function closure for each element in the list, which often is more costly than what fusion eliminates. Nofib shows a slight increase in the binary size: ------------------------------------------------------------------------ Program Size Allocs Runtime Elapsed TotalMem ------------------------------------------------------------------------ gen_regexps -0.3% 0.0% 0.000 0.000 0.0% puzzle +0.8% 0.0% 0.089 0.090 0.0% reptile +0.8% -0.0% 0.008 0.008 0.0% ------------------------------------------------------------------------ Min -0.3% -0.0% -7.3% -7.1% 0.0% Max +0.8% +0.0% +7.8% +7.7% +1.8% Geometric Mean +0.0% -0.0% +0.2% +0.2% +0.0% ------------------------------------------------------------------------ Reviewers: simonpj, austin, hvr, bgamari Reviewed By: simonpj Subscribers: simonpj, thomie Differential Revision: https://phabricator.haskell.org/D2951 GHC Trac Issues: #13001 >--------------------------------------------------------------- 09bce7accd330e99b1667f8b4eda7def722d6f0c libraries/base/Data/Maybe.hs | 2 +- libraries/base/Data/OldList.hs | 2 +- libraries/base/GHC/Base.hs | 2 +- libraries/base/GHC/Enum.hs | 27 ++++++++++------- libraries/base/GHC/Exts.hs | 1 + libraries/base/GHC/List.hs | 42 ++++++++++++++++++++------- testsuite/tests/perf/should_run/T13001.hs | 7 +++++ testsuite/tests/perf/should_run/T13001.stdout | 1 + testsuite/tests/perf/should_run/all.T | 8 +++++ 9 files changed, 69 insertions(+), 23 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 09bce7accd330e99b1667f8b4eda7def722d6f0c From git at git.haskell.org Tue Jan 10 20:28:11 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 10 Jan 2017 20:28:11 +0000 (UTC) Subject: [commit: ghc] master: Don't use the splitter on Darwin (266a9dc) Message-ID: <20170110202811.65ECD3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/266a9dc4cd34008f1162eb276032c85ef8371842/ghc >--------------------------------------------------------------- commit 266a9dc4cd34008f1162eb276032c85ef8371842 Author: Demi Obenour Date: Tue Jan 10 14:32:46 2017 -0500 Don't use the splitter on Darwin Test Plan: GHC CI Reviewers: austin, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2879 >--------------------------------------------------------------- 266a9dc4cd34008f1162eb276032c85ef8371842 driver/split/ghc-split.pl | 177 +++------------------------------------------- mk/config.mk.in | 33 +++++---- 2 files changed, 26 insertions(+), 184 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 266a9dc4cd34008f1162eb276032c85ef8371842 From git at git.haskell.org Tue Jan 10 21:18:02 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 10 Jan 2017 21:18:02 +0000 (UTC) Subject: [commit: ghc] master: Fix references in let/app invariant note (8b15fc4) Message-ID: <20170110211802.AF0FB3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8b15fc42847b3ba4a161158995564b1986907776/ghc >--------------------------------------------------------------- commit 8b15fc42847b3ba4a161158995564b1986907776 Author: David Feuer Date: Tue Jan 10 15:45:40 2017 -0500 Fix references in let/app invariant note `mkCoreApp` and `mkCoreLet` have moved since the let/app invariant note was written. Update the note to reflect that change. [skip ci] Test Plan: Read Reviewers: austin, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2953 >--------------------------------------------------------------- 8b15fc42847b3ba4a161158995564b1986907776 compiler/coreSyn/CoreSyn.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/compiler/coreSyn/CoreSyn.hs b/compiler/coreSyn/CoreSyn.hs index 17b546b..e24ad8d 100644 --- a/compiler/coreSyn/CoreSyn.hs +++ b/compiler/coreSyn/CoreSyn.hs @@ -384,7 +384,8 @@ In this situation you should use @case@ rather than a @let at . The function alternatively use 'MkCore.mkCoreLet' rather than this constructor directly, which will generate a @case@ if necessary -Th let/app invariant is initially enforced by DsUtils.mkCoreLet and mkCoreApp +The let/app invariant is initially enforced by mkCoreLet and mkCoreApp in +coreSyn/MkCore. Note [CoreSyn case invariants] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ From git at git.haskell.org Tue Jan 10 22:10:02 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 10 Jan 2017 22:10:02 +0000 (UTC) Subject: [commit: ghc] master: Inline partially-applied wrappers (2be364a) Message-ID: <20170110221002.EEE6C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2be364ac8cf2f5cd3b50503e8b26f51eb46101e5/ghc >--------------------------------------------------------------- commit 2be364ac8cf2f5cd3b50503e8b26f51eb46101e5 Author: David Feuer Date: Tue Jan 10 16:33:20 2017 -0500 Inline partially-applied wrappers Suppose we have ``` data Node a = Node2 !Int a a | Node3 !Int a a a instance Traversable Node where traverse f (Node2 s x y) = Node2 s <$> f x <*> f y ... ``` Since `Node2` is partially applied, we wouldn't inline its wrapper. The result was that we'd box up the `Int#` to put the box in the closure passed to `fmap`. We now allow the wrapper to inline when partially applied, so GHC stores the `Int#` directly in the closure. Reviewers: rwbarton, mpickering, simonpj, austin, bgamari Reviewed By: simonpj, bgamari Subscribers: mpickering, thomie Differential Revision: https://phabricator.haskell.org/D2891 GHC Trac Issues: #12990 >--------------------------------------------------------------- 2be364ac8cf2f5cd3b50503e8b26f51eb46101e5 compiler/basicTypes/MkId.hs | 46 +++++++++++++++++----- .../tests/deSugar/should_compile/T2431.stderr | 2 +- testsuite/tests/perf/should_run/T12990.hs | 28 +++++++++++++ testsuite/tests/perf/should_run/all.T | 10 +++++ .../tests/simplCore/should_compile/T7360.stderr | 2 +- 5 files changed, 76 insertions(+), 12 deletions(-) diff --git a/compiler/basicTypes/MkId.hs b/compiler/basicTypes/MkId.hs index dc8b4d0..7c8ffed 100644 --- a/compiler/basicTypes/MkId.hs +++ b/compiler/basicTypes/MkId.hs @@ -466,6 +466,32 @@ newtype DataConBoxer = DCB ([Type] -> [Var] -> UniqSM ([Var], [CoreBind])) -- Bind these src-level vars, returning the -- rep-level vars to bind in the pattern +{- +Note [Inline partially-applied constructor wrappers] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +We allow the wrapper to inline when partially applied to avoid +boxing values unnecessarily. For example, consider + + data Foo a = Foo !Int a + + instance Traversable Foo where + traverse f (Foo i a) = Foo i <$> f a + +This desugars to + + traverse f foo = case foo of + Foo i# a -> let i = I# i# + in map ($WFoo i) (f a) + +If the wrapper `$WFoo` is not inlined, we get a fruitless reboxing of `i`. +But if we inline the wrapper, we get + + map (\a. case i of I# i# a -> Foo i# a) (f a) + +and now case-of-known-constructor eliminates the redundant allocation. +-} + mkDataConRep :: DynFlags -> FamInstEnvs -> Name @@ -498,16 +524,16 @@ mkDataConRep dflags fam_envs wrap_name mb_bangs data_con wrap_arg_dmds = map mk_dmd arg_ibangs mk_dmd str | isBanged str = evalDmd | otherwise = topDmd - -- The Cpr info can be important inside INLINE rhss, where the - -- wrapper constructor isn't inlined. - -- And the argument strictness can be important too; we - -- may not inline a constructor when it is partially applied. - -- For example: - -- data W = C !Int !Int !Int - -- ...(let w = C x in ...(w p q)...)... - -- we want to see that w is strict in its two arguments - - wrap_unf = mkInlineUnfolding (Just wrap_arity) wrap_rhs + + -- The wrapper will usually be inlined (see wrap_unf), so its + -- strictness and CPR info is usually irrelevant. But this is + -- not always the case; GHC may choose not to inline it. In + -- particular, the wrapper constructor is not inlined inside + -- an INLINE rhs or when it is not applied to any arguments. + -- See Note [Inline partially-applied constructor wrappers] + -- Passing Nothing here allows the wrapper to inline when + -- unsaturated. + wrap_unf = mkInlineUnfolding Nothing wrap_rhs wrap_tvs = (univ_tvs `minusList` map eqSpecTyVar eq_spec) ++ ex_tvs wrap_rhs = mkLams wrap_tvs $ mkLams wrap_args $ diff --git a/testsuite/tests/deSugar/should_compile/T2431.stderr b/testsuite/tests/deSugar/should_compile/T2431.stderr index ff1047d..797c6c7 100644 --- a/testsuite/tests/deSugar/should_compile/T2431.stderr +++ b/testsuite/tests/deSugar/should_compile/T2431.stderr @@ -9,7 +9,7 @@ T2431.$WRefl [InlPrag=INLINE] :: forall a. a :~: a Str=m, Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=ALWAYS_IF(arity=0,unsat_ok=False,boring_ok=False) + Guidance=ALWAYS_IF(arity=0,unsat_ok=True,boring_ok=False) Tmpl= \ (@ a) -> T2431.Refl @ a @ a @~ (_N :: (a :: *) GHC.Prim.~# (a :: *))}] T2431.$WRefl = diff --git a/testsuite/tests/perf/should_run/T12990.hs b/testsuite/tests/perf/should_run/T12990.hs new file mode 100644 index 0000000..f7655ac --- /dev/null +++ b/testsuite/tests/perf/should_run/T12990.hs @@ -0,0 +1,28 @@ +-- We used to inline constructor wrapper functions only when fully applied. +-- This led to unnecessary boxing when partially applying to unpacked fields. + +module Main where +import Control.DeepSeq +import Data.Functor.Identity +import Control.Exception (evaluate) + +data AList = Cons !Int !Int !Int !Int !Int !Int !Int !Int !Int AList | Nil + +-- We need to write this instance manually because the Generic-derived +-- instance allocates a ton of intermediate junk, obscuring the interesting +-- differences. +instance NFData AList where + rnf Nil = () + rnf (Cons _1 _2 _3 _4 _5 _6 _7 _8 _9 xs) = rnf xs + +-- If GHC is allowed to specialize it to Identity, the partial application of +-- Cons will become a fully saturated one, defeating the test. So we NOINLINE +-- it. +buildalist :: Applicative f => Int -> f AList +buildalist n + | n <= 0 = pure Nil + | otherwise = Cons n (n+1) (n+2) (n+3) (n+4) (n+5) (n+6) (n+7) (n+8) <$> + buildalist (n - 1) +{-# NOINLINE buildalist #-} + +main = evaluate . rnf . runIdentity $ buildalist 100000 diff --git a/testsuite/tests/perf/should_run/all.T b/testsuite/tests/perf/should_run/all.T index 89ae3ec..333970c 100644 --- a/testsuite/tests/perf/should_run/all.T +++ b/testsuite/tests/perf/should_run/all.T @@ -460,3 +460,13 @@ test('T13001', only_ways(['normal'])], compile_and_run, ['-O2']) + +test('T12990', + [stats_num_field('bytes allocated', + [ (wordsize(64), 21640904, 5) ]), + # 2017-01-03 34440936 w/o inlining unsaturated + # constructor wrappers + # 2017-01-03 21640904 inline wrappers + only_ways(['normal'])], + compile_and_run, + ['-O2']) diff --git a/testsuite/tests/simplCore/should_compile/T7360.stderr b/testsuite/tests/simplCore/should_compile/T7360.stderr index 4598b3e..2b0984c 100644 --- a/testsuite/tests/simplCore/should_compile/T7360.stderr +++ b/testsuite/tests/simplCore/should_compile/T7360.stderr @@ -10,7 +10,7 @@ T7360.$WFoo3 [InlPrag=INLINE] :: Int -> Foo Str=m3, Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=ALWAYS_IF(arity=1,unsat_ok=False,boring_ok=False) + Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) Tmpl= \ (dt [Occ=Once!] :: Int) -> case dt of { GHC.Types.I# dt [Occ=Once] -> T7360.Foo3 dt }}] T7360.$WFoo3 = From git at git.haskell.org Wed Jan 11 03:24:28 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 11 Jan 2017 03:24:28 +0000 (UTC) Subject: [commit: ghc] branch 'foldr-to-foldl' created Message-ID: <20170111032428.602213A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : foldr-to-foldl Referencing: 82ce5f38defd4ccce8e813731978891df499496a From git at git.haskell.org Wed Jan 11 03:24:31 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 11 Jan 2017 03:24:31 +0000 (UTC) Subject: [commit: ghc] foldr-to-foldl: base: Reexport types in GHC.Tuple from Data.Tuple (630605e) Message-ID: <20170111032431.18E763A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : foldr-to-foldl Link : http://ghc.haskell.org/trac/ghc/changeset/630605eaa8af7b1249e23ed376523b4fd6f79803/ghc >--------------------------------------------------------------- commit 630605eaa8af7b1249e23ed376523b4fd6f79803 Author: Ben Gamari Date: Tue Jan 10 16:28:41 2017 -0500 base: Reexport types in GHC.Tuple from Data.Tuple >--------------------------------------------------------------- 630605eaa8af7b1249e23ed376523b4fd6f79803 libraries/base/Data/Tuple.hs | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/libraries/base/Data/Tuple.hs b/libraries/base/Data/Tuple.hs index d8bccf3..0b211a2 100644 --- a/libraries/base/Data/Tuple.hs +++ b/libraries/base/Data/Tuple.hs @@ -16,14 +16,18 @@ ----------------------------------------------------------------------------- module Data.Tuple - ( fst + ( -- * Utilities + fst , snd , curry , uncurry , swap + -- * Tuple types + , module GHC.Tuple ) where import GHC.Base () -- Note [Depend on GHC.Tuple] +import GHC.Tuple -- So we can re-export it default () -- Double isn't available yet From git at git.haskell.org Wed Jan 11 03:24:33 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 11 Jan 2017 03:24:33 +0000 (UTC) Subject: [commit: ghc] foldr-to-foldl: Fix warnings on OS X (4c8f073) Message-ID: <20170111032433.C50C73A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : foldr-to-foldl Link : http://ghc.haskell.org/trac/ghc/changeset/4c8f0737d77fcdc007ffa4241372ce199a532e2f/ghc >--------------------------------------------------------------- commit 4c8f0737d77fcdc007ffa4241372ce199a532e2f Author: Ben Gamari Date: Tue Jan 10 16:58:15 2017 -0500 Fix warnings on OS X >--------------------------------------------------------------- 4c8f0737d77fcdc007ffa4241372ce199a532e2f libraries/base/GHC/Event/Control.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/libraries/base/GHC/Event/Control.hs b/libraries/base/GHC/Event/Control.hs index 83950c2..9e3940a 100644 --- a/libraries/base/GHC/Event/Control.hs +++ b/libraries/base/GHC/Event/Control.hs @@ -35,7 +35,7 @@ import GHC.Conc.Signal (Signal) import GHC.Real (fromIntegral) import GHC.Show (Show) import GHC.Word (Word8) -import Foreign.C.Error (throwErrnoIfMinus1_, throwErrno, getErrno, eBADF) +import Foreign.C.Error (throwErrnoIfMinus1_, throwErrno, getErrno) import Foreign.C.Types (CInt(..), CSize(..)) import Foreign.ForeignPtr (mallocForeignPtrBytes, withForeignPtr) import Foreign.Marshal (alloca, allocaBytes) @@ -47,10 +47,10 @@ import System.Posix.Internals (c_close, c_pipe, c_read, c_write, import System.Posix.Types (Fd) #if defined(HAVE_EVENTFD) -import Foreign.C.Error (throwErrnoIfMinus1) +import Foreign.C.Error (throwErrnoIfMinus1, eBADF) import Foreign.C.Types (CULLong(..)) #else -import Foreign.C.Error (eAGAIN, eWOULDBLOCK, getErrno, throwErrno) +import Foreign.C.Error (eAGAIN, eWOULDBLOCK) #endif data ControlMessage = CMsgWakeup From git at git.haskell.org Wed Jan 11 03:24:36 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 11 Jan 2017 03:24:36 +0000 (UTC) Subject: [commit: ghc] foldr-to-foldl: Bitmap: Use foldl' instead of foldr (eaa79df) Message-ID: <20170111032436.74CA33A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : foldr-to-foldl Link : http://ghc.haskell.org/trac/ghc/changeset/eaa79df7aeacb9f19930c93e2a1a60f6d5ecf74e/ghc >--------------------------------------------------------------- commit eaa79df7aeacb9f19930c93e2a1a60f6d5ecf74e Author: Ben Gamari Date: Tue Jan 10 19:27:20 2017 -0500 Bitmap: Use foldl' instead of foldr These are producing StgWords so foldl' is the natural choice. >--------------------------------------------------------------- eaa79df7aeacb9f19930c93e2a1a60f6d5ecf74e compiler/cmm/Bitmap.hs | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/compiler/cmm/Bitmap.hs b/compiler/cmm/Bitmap.hs index 22ec6ee..a5cff38 100644 --- a/compiler/cmm/Bitmap.hs +++ b/compiler/cmm/Bitmap.hs @@ -22,6 +22,7 @@ import SMRep import DynFlags import Util +import Data.Foldable (foldl') import Data.Bits {-| @@ -39,7 +40,10 @@ mkBitmap dflags stuff = chunkToBitmap dflags chunk : mkBitmap dflags rest chunkToBitmap :: DynFlags -> [Bool] -> StgWord chunkToBitmap dflags chunk = - foldr (.|.) (toStgWord dflags 0) [ toStgWord dflags 1 `shiftL` n | (True,n) <- zip chunk [0..] ] + foldl' (.|.) (toStgWord dflags 0) [ oneAt n | (True,n) <- zip chunk [0..] ] + where + oneAt :: Int -> StgWord + oneAt i = toStgWord dflags 1 `shiftL` i -- | Make a bitmap where the slots specified are the /ones/ in the bitmap. -- eg. @[0,1,3], size 4 ==> 0xb at . @@ -61,7 +65,7 @@ intsToBitmap dflags size = go 0 go !pos slots | size <= pos = [] | otherwise = - (foldr (.|.) (toStgWord dflags 0) (map (\i->oneAt (i - pos)) these)) : + (foldl' (.|.) (toStgWord dflags 0) (map (\i->oneAt (i - pos)) these)) : go (pos + word_sz) rest where (these,rest) = span (< (pos + word_sz)) slots @@ -87,7 +91,7 @@ intsToReverseBitmap dflags size = go 0 go !pos slots | size <= pos = [] | otherwise = - (foldr xor (toStgWord dflags init) (map (\i->oneAt (i - pos)) these)) : + (foldl' xor (toStgWord dflags init) (map (\i->oneAt (i - pos)) these)) : go (pos + word_sz) rest where (these,rest) = span (< (pos + word_sz)) slots From git at git.haskell.org Wed Jan 11 03:24:39 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 11 Jan 2017 03:24:39 +0000 (UTC) Subject: [commit: ghc] foldr-to-foldl: Replace a number of foldrs with foldl's (7d76421) Message-ID: <20170111032439.3AED43A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : foldr-to-foldl Link : http://ghc.haskell.org/trac/ghc/changeset/7d764215a9a17f4dc26784b66c4c2508c9d19e33/ghc >--------------------------------------------------------------- commit 7d764215a9a17f4dc26784b66c4c2508c9d19e33 Author: Ben Gamari Date: Tue Jan 10 21:32:49 2017 -0500 Replace a number of foldrs with foldl's >--------------------------------------------------------------- 7d764215a9a17f4dc26784b66c4c2508c9d19e33 compiler/cmm/CmmContFlowOpt.hs | 11 ++++++----- compiler/cmm/CmmSink.hs | 4 ++-- compiler/cmm/CmmUtils.hs | 3 ++- compiler/cmm/MkGraph.hs | 5 +++-- compiler/coreSyn/CoreFVs.hs | 8 +++++--- compiler/coreSyn/CoreStats.hs | 17 ++++++++++------- compiler/hsSyn/HsUtils.hs | 6 +++--- compiler/main/HscTypes.hs | 9 +++++---- compiler/nativeGen/AsmCodeGen.hs | 2 +- compiler/nativeGen/RegAlloc/Linear/JoinToTargets.hs | 3 ++- compiler/nativeGen/RegAlloc/Linear/Main.hs | 5 +++-- compiler/nativeGen/RegAlloc/Linear/PPC/FreeRegs.hs | 4 ++-- compiler/nativeGen/RegAlloc/Linear/SPARC/FreeRegs.hs | 4 ++-- compiler/nativeGen/RegAlloc/Linear/X86/FreeRegs.hs | 3 ++- compiler/nativeGen/RegAlloc/Linear/X86_64/FreeRegs.hs | 3 ++- compiler/nativeGen/RegAlloc/Liveness.hs | 2 +- compiler/rename/RnSource.hs | 6 +++--- compiler/specialise/SpecConstr.hs | 4 +++- compiler/specialise/Specialise.hs | 5 +++-- compiler/stgSyn/CoreToStg.hs | 5 +++-- compiler/typecheck/TcBinds.hs | 9 +++++---- compiler/typecheck/TcRnTypes.hs | 4 ++-- compiler/typecheck/TcTyClsDecls.hs | 10 +++++----- compiler/typecheck/TcTyDecls.hs | 5 +++-- compiler/types/Type.hs | 5 +++-- compiler/utils/Bag.hs | 3 ++- compiler/utils/UnVarGraph.hs | 2 +- compiler/utils/UniqSet.hs | 4 ++-- 28 files changed, 86 insertions(+), 65 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 7d764215a9a17f4dc26784b66c4c2508c9d19e33 From git at git.haskell.org Wed Jan 11 03:24:41 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 11 Jan 2017 03:24:41 +0000 (UTC) Subject: [commit: ghc] foldr-to-foldl: testsuite (82ce5f3) Message-ID: <20170111032441.EA4E63A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : foldr-to-foldl Link : http://ghc.haskell.org/trac/ghc/changeset/82ce5f38defd4ccce8e813731978891df499496a/ghc >--------------------------------------------------------------- commit 82ce5f38defd4ccce8e813731978891df499496a Author: Ben Gamari Date: Tue Jan 10 22:23:27 2017 -0500 testsuite >--------------------------------------------------------------- 82ce5f38defd4ccce8e813731978891df499496a testsuite/tests/boxy/Base1.stderr | 6 +- .../tests/deSugar/should_compile/T2431.stderr | 38 ++--- testsuite/tests/driver/T2182.stderr | 8 +- testsuite/tests/ghci/scripts/Defer02.stderr | 14 +- .../tests/indexed-types/should_fail/T2544.stderr | 12 +- .../tests/indexed-types/should_fail/T2693.stderr | 24 ++-- .../tests/indexed-types/should_fail/T4099.stderr | 8 +- .../should_fail/overloadedlabelsfail01.stderr | 4 +- .../tests/partial-sigs/should_fail/T10615.stderr | 28 ++-- .../tests/partial-sigs/should_fail/T10999.stderr | 8 +- testsuite/tests/roles/should_compile/Roles1.stderr | 6 +- .../tests/roles/should_compile/Roles13.stderr | 80 +++++------ .../tests/roles/should_compile/Roles14.stderr | 6 +- testsuite/tests/roles/should_compile/Roles2.stderr | 6 +- testsuite/tests/roles/should_compile/Roles3.stderr | 6 +- testsuite/tests/roles/should_compile/Roles4.stderr | 6 +- testsuite/tests/roles/should_compile/T8958.stderr | 40 +++--- .../tests/simplCore/should_compile/T7360.stderr | 156 ++++++++++----------- .../tests/simplCore/should_compile/T8274.stdout | 16 +-- .../simplCore/should_compile/noinline01.stderr | 24 ++-- .../tests/simplCore/should_compile/par01.stderr | 22 +-- .../tests/stranal/should_compile/T10694.stderr | 72 +++++----- testsuite/tests/th/TH_Roles2.stderr | 10 +- .../tests/typecheck/should_compile/tc211.stderr | 20 +-- .../tests/typecheck/should_fail/T10971b.stderr | 30 ++-- .../tests/typecheck/should_fail/T10971d.stderr | 4 +- testsuite/tests/typecheck/should_fail/T4921.stderr | 12 +- testsuite/tests/typecheck/should_fail/T5684.stderr | 12 +- testsuite/tests/typecheck/should_fail/T6069.stderr | 12 +- testsuite/tests/typecheck/should_fail/T8603.stderr | 8 +- .../tests/typecheck/should_fail/tcfail207.stderr | 24 ++-- 31 files changed, 361 insertions(+), 361 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 82ce5f38defd4ccce8e813731978891df499496a From git at git.haskell.org Wed Jan 11 04:41:23 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 11 Jan 2017 04:41:23 +0000 (UTC) Subject: [commit: ghc] master: Revert "event manager: Don't worry if attempt to wake dead manager fails" (436aa7a) Message-ID: <20170111044123.051DF3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/436aa7aaf1b30f19ece6c610e357cb678612de8a/ghc >--------------------------------------------------------------- commit 436aa7aaf1b30f19ece6c610e357cb678612de8a Author: Ben Gamari Date: Tue Jan 10 23:40:33 2017 -0500 Revert "event manager: Don't worry if attempt to wake dead manager fails" This broke the OS X build. This reverts commit 6de7613604216f65fae92d8066a078bf9cd3c088. >--------------------------------------------------------------- 436aa7aaf1b30f19ece6c610e357cb678612de8a libraries/base/GHC/Event/Control.hs | 28 +++++----------------------- 1 file changed, 5 insertions(+), 23 deletions(-) diff --git a/libraries/base/GHC/Event/Control.hs b/libraries/base/GHC/Event/Control.hs index 83950c2..0b0f558 100644 --- a/libraries/base/GHC/Event/Control.hs +++ b/libraries/base/GHC/Event/Control.hs @@ -30,12 +30,11 @@ module GHC.Event.Control import Foreign.ForeignPtr (ForeignPtr) import GHC.Base -import GHC.IORef import GHC.Conc.Signal (Signal) import GHC.Real (fromIntegral) import GHC.Show (Show) import GHC.Word (Word8) -import Foreign.C.Error (throwErrnoIfMinus1_, throwErrno, getErrno, eBADF) +import Foreign.C.Error (throwErrnoIfMinus1_) import Foreign.C.Types (CInt(..), CSize(..)) import Foreign.ForeignPtr (mallocForeignPtrBytes, withForeignPtr) import Foreign.Marshal (alloca, allocaBytes) @@ -70,9 +69,7 @@ data Control = W { , wakeupWriteFd :: {-# UNPACK #-} !Fd #endif , didRegisterWakeupFd :: !Bool - -- | Have this Control's fds been cleaned up? - , controlIsDead :: !(IORef Bool) - } + } deriving (Show) #if defined(HAVE_EVENTFD) wakeupReadFd :: Control -> Fd @@ -104,7 +101,6 @@ newControl shouldRegister = allocaArray 2 $ \fds -> do (wake_rd, wake_wr) <- createPipe when shouldRegister $ c_setIOManagerWakeupFd wake_wr #endif - isDead <- newIORef False return W { controlReadFd = fromIntegral ctrl_rd , controlWriteFd = fromIntegral ctrl_wr #if defined(HAVE_EVENTFD) @@ -114,7 +110,6 @@ newControl shouldRegister = allocaArray 2 $ \fds -> do , wakeupWriteFd = fromIntegral wake_wr #endif , didRegisterWakeupFd = shouldRegister - , controlIsDead = isDead } -- | Close the control structure used by the IO manager thread. @@ -124,7 +119,6 @@ newControl shouldRegister = allocaArray 2 $ \fds -> do -- file after it has been closed. closeControl :: Control -> IO () closeControl w = do - atomicModifyIORef (controlIsDead w) (\_ -> (True, ())) _ <- c_close . fromIntegral . controlReadFd $ w _ <- c_close . fromIntegral . controlWriteFd $ w when (didRegisterWakeupFd w) $ c_setIOManagerWakeupFd (-1) @@ -178,21 +172,9 @@ readControlMessage ctrl fd sendWakeup :: Control -> IO () #if defined(HAVE_EVENTFD) -sendWakeup c = do - n <- c_eventfd_write (fromIntegral (controlEventFd c)) 1 - case n of - 0 -> return () - _ -> do errno <- getErrno - -- Check that Control is still alive if we failed, since it's - -- possible that someone cleaned up the fds behind our backs and - -- consequently eventfd_write failed with EBADF. If it is dead - -- then just swallow the error since we are shutting down - -- anyways. Otherwise we will see failures during shutdown from - -- setnumcapabilities001 (#12038) - isDead <- readIORef (controlIsDead c) - if isDead && errno == eBADF - then return () - else throwErrno "sendWakeup" +sendWakeup c = + throwErrnoIfMinus1_ "sendWakeup" $ + c_eventfd_write (fromIntegral (controlEventFd c)) 1 #else sendWakeup c = do n <- sendMessage (wakeupWriteFd c) CMsgWakeup From git at git.haskell.org Wed Jan 11 12:21:39 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 11 Jan 2017 12:21:39 +0000 (UTC) Subject: [commit: ghc] wip/rwbarton-dep-finsts: Mostly comments (d6fd792) Message-ID: <20170111122139.DFFF83A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rwbarton-dep-finsts Link : http://ghc.haskell.org/trac/ghc/changeset/d6fd7922332a16fb958d3bf2c21ed792d12c98a7/ghc >--------------------------------------------------------------- commit d6fd7922332a16fb958d3bf2c21ed792d12c98a7 Author: Reid Barton Date: Wed Jan 11 07:21:25 2017 -0500 Mostly comments >--------------------------------------------------------------- d6fd7922332a16fb958d3bf2c21ed792d12c98a7 compiler/iface/MkIface.hs | 2 +- compiler/main/HscTypes.hs | 7 ++-- compiler/typecheck/FamInst.hs | 78 ++++++++++++++++++++++++++++++++++++---- compiler/typecheck/TcRnDriver.hs | 16 ++++++--- 4 files changed, 88 insertions(+), 15 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc d6fd7922332a16fb958d3bf2c21ed792d12c98a7 From git at git.haskell.org Wed Jan 11 14:54:27 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 11 Jan 2017 14:54:27 +0000 (UTC) Subject: [commit: ghc] master: Warn if you explicitly export an identifier with warning attached. (0bbcf76) Message-ID: <20170111145427.826AF3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/0bbcf76a349ed2c1d03907f2f74e5436859d59b0/ghc >--------------------------------------------------------------- commit 0bbcf76a349ed2c1d03907f2f74e5436859d59b0 Author: Edward Z. Yang Date: Thu Dec 29 21:39:27 2016 -0800 Warn if you explicitly export an identifier with warning attached. Summary: This won't stop people from attempting to use this identifier (since it is still always going to be in the export list), but having an explicit reference to something people shouldn't use is a smell, so warn about it. Signed-off-by: Edward Z. Yang Test Plan: validate Reviewers: simonpj, austin, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2907 >--------------------------------------------------------------- 0bbcf76a349ed2c1d03907f2f74e5436859d59b0 compiler/typecheck/TcBackpack.hs | 15 ++++++++++++++- testsuite/tests/backpack/should_fail/bkpfail35.stderr | 4 ++++ 2 files changed, 18 insertions(+), 1 deletion(-) diff --git a/compiler/typecheck/TcBackpack.hs b/compiler/typecheck/TcBackpack.hs index 9cc2997..76cb88d 100644 --- a/compiler/typecheck/TcBackpack.hs +++ b/compiler/typecheck/TcBackpack.hs @@ -459,9 +459,22 @@ mergeSignatures hsmod lcl_iface0 = do tcg_env <- getGblEnv -- Make sure we didn't refer to anything that doesn't actually exist - _ <- exports_from_avail mb_exports rdr_env + (mb_lies, _) <- exports_from_avail mb_exports rdr_env (tcg_imports tcg_env) (tcg_semantic_mod tcg_env) + -- If you tried to explicitly export an identifier that has a warning + -- attached to it, that's probably a mistake. Warn about it. + case mb_lies of + Nothing -> return () + Just lies -> + forM_ (concatMap (\(L loc x) -> map (L loc) (ieNames x)) lies) $ \(L loc n) -> + setSrcSpan loc $ + unless (nameOccName n `elemOccSet` ok_to_use) $ + addWarn NoReason $ vcat [ + text "Exported identifier" <+> quotes (ppr n) <+> text "will cause warnings if used.", + parens (text "To suppress this warning, remove" <+> quotes (ppr n) <+> text "from the export list of this signature.") + ] + failIfErrsM -- STEP 4: Rename the interfaces diff --git a/testsuite/tests/backpack/should_fail/bkpfail35.stderr b/testsuite/tests/backpack/should_fail/bkpfail35.stderr index f90d0e2..e371488 100644 --- a/testsuite/tests/backpack/should_fail/bkpfail35.stderr +++ b/testsuite/tests/backpack/should_fail/bkpfail35.stderr @@ -3,6 +3,10 @@ [2 of 2] Compiling B ( p/B.hs, nothing ) [2 of 4] Processing q [1 of 1] Compiling A[sig] ( q/A.hsig, nothing ) + +bkpfail35.bkp:8:18: warning: + Exported identifier ‘x’ will cause warnings if used. + (To suppress this warning, remove ‘x’ from the export list of this signature.) [3 of 4] Processing aimpl Instantiating aimpl [1 of 1] Compiling A ( aimpl/A.hs, bkpfail35.out/aimpl/A.o ) From git at git.haskell.org Wed Jan 11 14:54:24 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 11 Jan 2017 14:54:24 +0000 (UTC) Subject: [commit: ghc] master: Attach warnings to non-PVP compatible uses of signatures. (9f169bc) Message-ID: <20170111145424.D07193A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9f169bcd951c5d946698d5f33a0cdb625d725490/ghc >--------------------------------------------------------------- commit 9f169bcd951c5d946698d5f33a0cdb625d725490 Author: Edward Z. Yang Date: Thu Dec 29 18:58:22 2016 -0800 Attach warnings to non-PVP compatible uses of signatures. Summary: If you use an inherited signature from another package in your own code, the only valid PVP bound you can specify for this package is an *exact* version bound. This is because the signature is used both covariantly (it provides declarations for import) and contravariantly (it specifies what is required). However, this is a bit distressing if you want to use a PVP-style bound that allows for upgrading a package. So there is a dichotomy: 1. Any signatures that come from packages with exact bounds (this includes, in particular, signature packages, who are included solely to make declarations available), can be used without problem by modules, but 2. Any signatures that come from packages that are version bounded (i.e., any package that also provides modules) must NOT be used, because if they were used, they could break under a PVP policy that allows relaxations in the needed requirements. To help users avoid situation (2), I've added a warning to all signature declarations that come solely from (2). This is not perfect; you might still end up relying on some type identity specified by a signature in a version-bounded package, but it should help catch major errors. Signed-off-by: Edward Z. Yang Test Plan: validate Reviewers: simonpj, austin, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2906 >--------------------------------------------------------------- 9f169bcd951c5d946698d5f33a0cdb625d725490 compiler/typecheck/TcBackpack.hs | 51 +++++++++++++++++++--- .../tests/backpack/should_compile/bkp10.stderr | 4 ++ .../tests/backpack/should_compile/bkp11.stderr | 8 ++++ .../tests/backpack/should_compile/bkp24.stderr | 4 ++ .../tests/backpack/should_compile/bkp36.stderr | 4 ++ 5 files changed, 64 insertions(+), 7 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 9f169bcd951c5d946698d5f33a0cdb625d725490 From git at git.haskell.org Wed Jan 11 14:54:22 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 11 Jan 2017 14:54:22 +0000 (UTC) Subject: [commit: ghc] master: Support for using only partial pieces of included signatures. (5f9c6d2) Message-ID: <20170111145422.076F53A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5f9c6d2a91ac710e7b75cfe50a7a8e84cc9ae796/ghc >--------------------------------------------------------------- commit 5f9c6d2a91ac710e7b75cfe50a7a8e84cc9ae796 Author: Edward Z. Yang Date: Mon Dec 26 18:39:01 2016 -0800 Support for using only partial pieces of included signatures. Summary: Generally speaking, it's not possible to "hide" a requirement from a package you include, because if there is some module relying on that requirement, well, you can't just wish it out of existence. However, some packages don't have any modules. For these, we can validly thin out requirements; indeed, this is very convenient if someone has published a large signature package but you only want some of the definitions. This patchset tweaks the interpretation of export lists in signatures: in particular, they no longer need to refer to entities that are defined locally; they range over both the current signature as well as any signatures that were inherited from signature packages (defined by having zero exposed modules.) In the process of doing this, I cleaned up a number of other things: * rnModIface and rnModExports now report errors that occurred during renaming and can propagate these to the TcM monad. This is important because in the current semantics, you can thin out a type which is referenced by a value you keep; in this situation, we need to error (to ensure that all types in signatures are rooted, so that we can determine their identities). * I ended up introducing a new construct 'dependency signature; to bkp files, to make it easier to tell if we were depending on a signature package. It's not difficult for Cabal to figure this out (I already have a patch for it.) Signed-off-by: Edward Z. Yang Test Plan: validate Reviewers: simonpj, austin, bgamari Subscribers: thomie, mpickering Differential Revision: https://phabricator.haskell.org/D2904 GHC Trac Issues: #12994 >--------------------------------------------------------------- 5f9c6d2a91ac710e7b75cfe50a7a8e84cc9ae796 compiler/backpack/BkpSyn.hs | 7 +- compiler/backpack/DriverBkp.hs | 50 ++++++++---- compiler/backpack/NameShape.hs | 10 +++ compiler/backpack/RnModIface.hs | 93 +++++++++++++++++---- compiler/iface/LoadIface.hs | 9 ++- compiler/main/HeaderInfo.hs | 4 +- compiler/main/HscMain.hs | 2 +- compiler/parser/Parser.y | 7 +- compiler/typecheck/TcBackpack.hs | 94 +++++++++++++++++----- compiler/typecheck/TcRnExports.hs | 15 +++- testsuite/tests/backpack/reexport/bkpreex01.bkp | 4 +- testsuite/tests/backpack/reexport/bkpreex02.bkp | 2 +- testsuite/tests/backpack/reexport/bkpreex03.bkp | 4 +- testsuite/tests/backpack/reexport/bkpreex04.bkp | 2 +- testsuite/tests/backpack/reexport/bkpreex06.bkp | 2 +- testsuite/tests/backpack/should_compile/all.T | 2 + testsuite/tests/backpack/should_compile/bkp15.bkp | 21 ++--- .../tests/backpack/should_compile/bkp15.stderr | 18 +++++ testsuite/tests/backpack/should_compile/bkp25.bkp | 8 +- testsuite/tests/backpack/should_compile/bkp28.bkp | 2 +- testsuite/tests/backpack/should_compile/bkp43.bkp | 20 +++++ .../tests/backpack/should_compile/bkp43.stderr | 14 ++++ testsuite/tests/backpack/should_compile/bkp44.bkp | 23 ++++++ .../tests/backpack/should_compile/bkp44.stderr | 18 +++++ testsuite/tests/backpack/should_fail/all.T | 7 ++ testsuite/tests/backpack/should_fail/bkpfail03.bkp | 2 +- testsuite/tests/backpack/should_fail/bkpfail05.bkp | 2 +- testsuite/tests/backpack/should_fail/bkpfail19.bkp | 2 +- testsuite/tests/backpack/should_fail/bkpfail20.bkp | 4 +- testsuite/tests/backpack/should_fail/bkpfail21.bkp | 4 +- .../tests/backpack/should_fail/bkpfail29.stderr | 4 +- testsuite/tests/backpack/should_fail/bkpfail30.bkp | 9 +++ .../tests/backpack/should_fail/bkpfail30.stderr | 6 ++ testsuite/tests/backpack/should_fail/bkpfail31.bkp | 16 ++++ .../tests/backpack/should_fail/bkpfail31.stderr | 8 ++ testsuite/tests/backpack/should_fail/bkpfail32.bkp | 2 + .../tests/backpack/should_fail/bkpfail32.stderr | 5 ++ testsuite/tests/backpack/should_fail/bkpfail33.bkp | 5 ++ .../tests/backpack/should_fail/bkpfail33.stderr | 7 ++ testsuite/tests/backpack/should_fail/bkpfail34.bkp | 7 ++ .../tests/backpack/should_fail/bkpfail34.stderr | 8 ++ testsuite/tests/backpack/should_fail/bkpfail35.bkp | 13 +++ .../tests/backpack/should_fail/bkpfail35.stderr | 16 ++++ testsuite/tests/backpack/should_fail/bkpfail36.bkp | 10 +++ .../tests/backpack/should_fail/bkpfail36.stderr | 10 +++ 45 files changed, 487 insertions(+), 91 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 5f9c6d2a91ac710e7b75cfe50a7a8e84cc9ae796 From git at git.haskell.org Wed Jan 11 14:54:31 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 11 Jan 2017 14:54:31 +0000 (UTC) Subject: [commit: ghc] master: Improve Backpack support for fixities. (e41c61f) Message-ID: <20170111145431.431DD3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e41c61fa7792d12ac7ffbacda7a5b3ba6ef2a267/ghc >--------------------------------------------------------------- commit e41c61fa7792d12ac7ffbacda7a5b3ba6ef2a267 Author: Edward Z. Yang Date: Thu Jan 5 01:09:29 2017 -0800 Improve Backpack support for fixities. Summary: Two major bug-fixes: - Check that fixities match between hsig and implementation - Merge and preserve fixities when merging signatures Signed-off-by: Edward Z. Yang Test Plan: validate Reviewers: bgamari, simonpj, austin Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2919 GHC Trac Issues: #13066 >--------------------------------------------------------------- e41c61fa7792d12ac7ffbacda7a5b3ba6ef2a267 compiler/typecheck/TcBackpack.hs | 57 +++++++++++++++++++--- testsuite/tests/backpack/should_compile/all.T | 1 + testsuite/tests/backpack/should_compile/bkp39.bkp | 1 + testsuite/tests/backpack/should_compile/bkp45.bkp | 17 +++++++ .../should_compile/{bkp35.stderr => bkp45.stderr} | 2 +- testsuite/tests/backpack/should_fail/all.T | 2 + testsuite/tests/backpack/should_fail/bkpfail37.bkp | 11 +++++ .../tests/backpack/should_fail/bkpfail37.stderr | 16 ++++++ testsuite/tests/backpack/should_fail/bkpfail38.bkp | 11 +++++ .../tests/backpack/should_fail/bkpfail38.stderr | 12 +++++ 10 files changed, 121 insertions(+), 9 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc e41c61fa7792d12ac7ffbacda7a5b3ba6ef2a267 From git at git.haskell.org Wed Jan 11 14:54:35 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 11 Jan 2017 14:54:35 +0000 (UTC) Subject: [commit: ghc] master: Revamp Backpack/hs-boot handling of type class signatures. (5def07f) Message-ID: <20170111145435.72E163A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5def07fadd386a7a7c3a12963c0736529e377a74/ghc >--------------------------------------------------------------- commit 5def07fadd386a7a7c3a12963c0736529e377a74 Author: Edward Z. Yang Date: Thu Jan 5 13:52:12 2017 -0800 Revamp Backpack/hs-boot handling of type class signatures. Summary: A basket of fixes and improvements: - The permissible things that one can write in a type class definition in an hsig file has been reduced to encompass the following things: - Methods - Default method signatures (but NOT implementation) - MINIMAL pragma It is no longer necessary nor encouraged to specify that a method has a default if it is mentioned in a MINIMAL pragma; the MINIMAL pragma is assumed to provide the base truth as to what methods need to be implemented when writing instances of a type class. - Handling of default method signatures in hsig was previously buggy, as these identifiers were not exported, so we now treat them similarly to DFuns. - Default methods are merged, where methods with defaults override those without. - MINIMAL pragmas are merged by ORing together pragmas. - Matching has been relaxed: a method with a default can be used to fill a signature which did not declare the method as having a default, and a more relaxed MINIMAL pragma can be used (we check if the signature pragma implies the final implementation pragma, on the way fixing a bug with BooleanFormula.implies, see #13073) Signed-off-by: Edward Z. Yang Test Plan: validate Reviewers: simonpj, bgamari, austin Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2925 GHC Trac Issues: #13041 >--------------------------------------------------------------- 5def07fadd386a7a7c3a12963c0736529e377a74 compiler/backpack/RnModIface.hs | 17 ++++++---- compiler/basicTypes/OccName.hs | 8 ++++- compiler/iface/TcIface.hs | 14 ++++++++ compiler/typecheck/TcClassDcl.hs | 29 ++++++++++++++--- compiler/typecheck/TcRnDriver.hs | 35 +++++++++++++++++--- compiler/utils/BooleanFormula.hs | 37 +++++++++++++++++++--- testsuite/tests/backpack/should_compile/all.T | 2 ++ testsuite/tests/backpack/should_compile/bkp15.bkp | 19 ++++------- .../tests/backpack/should_compile/bkp15.stderr | 18 ----------- testsuite/tests/backpack/should_compile/bkp46.bkp | 32 +++++++++++++++++++ .../tests/backpack/should_compile/bkp46.stderr | 12 +++++++ testsuite/tests/backpack/should_compile/bkp47.bkp | 20 ++++++++++++ .../should_compile/{bkp45.stderr => bkp47.stderr} | 5 +++ testsuite/tests/backpack/should_fail/all.T | 3 ++ testsuite/tests/backpack/should_fail/bkpfail39.bkp | 6 ++++ testsuite/tests/backpack/should_fail/bkpfail40.bkp | 5 +++ .../tests/backpack/should_fail/bkpfail40.stderr | 6 ++++ testsuite/tests/backpack/should_fail/bkpfail41.bkp | 13 ++++++++ .../tests/backpack/should_fail/bkpfail41.stderr | 22 +++++++++++++ .../tests/rename/should_fail/rnfail055.stderr | 1 + 20 files changed, 252 insertions(+), 52 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 5def07fadd386a7a7c3a12963c0736529e377a74 From git at git.haskell.org Wed Jan 11 14:54:38 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 11 Jan 2017 14:54:38 +0000 (UTC) Subject: [commit: ghc] master: Rewrite module signature documentation. (8744869) Message-ID: <20170111145438.303303A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8744869e3cb4a82b88e595c55f1fcc9ea1e6d0b7/ghc >--------------------------------------------------------------- commit 8744869e3cb4a82b88e595c55f1fcc9ea1e6d0b7 Author: Edward Z. Yang Date: Wed Jan 4 23:33:13 2017 -0500 Rewrite module signature documentation. Signed-off-by: Edward Z. Yang Test Plan: none Reviewers: bgamari, simonpj, austin, goldfire Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2918 GHC Trac Issues: #10262 >--------------------------------------------------------------- 8744869e3cb4a82b88e595c55f1fcc9ea1e6d0b7 docs/users_guide/separate_compilation.rst | 348 ++++++++++++++++++++++++------ 1 file changed, 282 insertions(+), 66 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 8744869e3cb4a82b88e595c55f1fcc9ea1e6d0b7 From git at git.haskell.org Wed Jan 11 14:54:42 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 11 Jan 2017 14:54:42 +0000 (UTC) Subject: [commit: ghc] master: Fix handling of closed type families in Backpack. (f59aad6) Message-ID: <20170111145442.3FBC13A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f59aad6823359caf8d43730c9bc1a8b7e98719b6/ghc >--------------------------------------------------------------- commit f59aad6823359caf8d43730c9bc1a8b7e98719b6 Author: Edward Z. Yang Date: Thu Jan 5 20:33:02 2017 -0800 Fix handling of closed type families in Backpack. Summary: A few related problems: - CoAxioms, like DFuns, are implicit and never exported, so we have to make sure we treat them the same way as DFuns: in RnModIface we need to rename references to them with rnIfaceImplicit and in mergeSignatures we need to NOT check them directly for compatibility (the test on the type family will do this check for us.) - But actually, we weren't checking if the axioms WERE consistent. This is because we were forwarding all embedded CoAxiom references in the type family TyThing to the merged version, but that reference was what checkBootDeclM was using as a comparison point. This is similar to a problem we saw with DFuns. To fix this, I refactored the handling of implicit entities in TcIface for Backpack. See Note [The implicit TypeEnv] for the gory details. Instead of passing the TypeEnv around explicitly, we stuffed it in IfLclEnv. Signed-off-by: Edward Z. Yang Test Plan: validate Reviewers: bgamari, simonpj, austin Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2928 >--------------------------------------------------------------- f59aad6823359caf8d43730c9bc1a8b7e98719b6 compiler/backpack/RnModIface.hs | 4 +- compiler/iface/TcIface.hs | 86 ++++++++++++++-------- compiler/typecheck/TcBackpack.hs | 34 +++++---- compiler/typecheck/TcRnDriver.hs | 9 ++- compiler/typecheck/TcRnMonad.hs | 5 ++ compiler/typecheck/TcRnTypes.hs | 7 ++ compiler/types/TyCon.hs | 8 ++ testsuite/tests/backpack/should_compile/all.T | 2 + testsuite/tests/backpack/should_compile/bkp48.bkp | 23 ++++++ .../tests/backpack/should_compile/bkp48.stderr | 22 ++++++ .../bkpfail33.bkp => should_compile/bkp49.bkp} | 4 +- .../bkp49.stderr} | 3 - testsuite/tests/backpack/should_fail/all.T | 1 + testsuite/tests/backpack/should_fail/bkpfail42.bkp | 10 +++ .../tests/backpack/should_fail/bkpfail42.stderr | 12 +++ 15 files changed, 177 insertions(+), 53 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc f59aad6823359caf8d43730c9bc1a8b7e98719b6 From git at git.haskell.org Wed Jan 11 14:54:44 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 11 Jan 2017 14:54:44 +0000 (UTC) Subject: [commit: ghc] master: Improve coment in typecheckIfacesForMerging. (501de26) Message-ID: <20170111145444.EF1103A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/501de268392ee2d8e5c3fae7f15ad197b9e1caaf/ghc >--------------------------------------------------------------- commit 501de268392ee2d8e5c3fae7f15ad197b9e1caaf Author: Edward Z. Yang Date: Tue Jan 10 14:16:28 2017 -0800 Improve coment in typecheckIfacesForMerging. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- 501de268392ee2d8e5c3fae7f15ad197b9e1caaf compiler/iface/TcIface.hs | 57 ++++++++++++++++++++++++++++++----------------- 1 file changed, 36 insertions(+), 21 deletions(-) diff --git a/compiler/iface/TcIface.hs b/compiler/iface/TcIface.hs index feb4ecb..9625e36 100644 --- a/compiler/iface/TcIface.hs +++ b/compiler/iface/TcIface.hs @@ -243,34 +243,49 @@ mergeIfaceDecls = plusOccEnv_C mergeIfaceDecl -- merge them together. So in particular, we have to take a different -- strategy for knot-tying: we first speculatively merge the declarations -- to get the "base" truth for what we believe the types will be --- (this is "type computation.") Then we read everything in and check --- for compatibility. +-- (this is "type computation.") Then we read everything in relative +-- to this truth and check for compatibility. -- --- Consider this example: +-- During the merge process, we may need to nondeterministically +-- pick a particular declaration to use, if multiple signatures define +-- the declaration ('mergeIfaceDecl'). If, for all choices, there +-- are no type synonym cycles in the resulting merged graph, then +-- we can show that our choice cannot matter. Consider the +-- set of entities which the declarations depend on: by assumption +-- of acyclicity, we can assume that these have already been shown to be equal +-- to each other (otherwise merging will fail). Then it must +-- be the case that all candidate declarations here are type-equal +-- (the choice doesn't matter) or there is an inequality (in which +-- case merging will fail.) -- --- H :: [ data A; type B = A ] --- H :: [ type A = C; data C ] --- H :: [ type A = (); data B; type C = B; ] +-- Unfortunately, the choice can matter if there is a cycle. Consider the +-- following merge: -- --- We attempt to make a type synonym cycle, which is solved if we --- take the hint that @type A = ()@. But actually we can and should --- reject this: the 'Name's of C and () are different, so the declarations --- of A are incompatible. (Thus there's no problem if we pick a --- particular declaration of 'A' over another.) +-- signature H where { type A = C; type B = A; data C } +-- signature H where { type A = (); data B; type C = B } -- --- Here's another one: +-- If we pick @type A = C@ as our representative, there will be +-- a cycle and merging will fail. But if we pick @type A = ()@ as +-- our representative, no cycle occurs, and we instead conclude +-- that all of the types are unit. So it seems that we either +-- (a) need a stronger acyclicity check which considers *all* +-- possible choices from a merge, or (b) we must find a selection +-- of declarations which is acyclic, and show that this is always +-- the "best" choice we could have made (ezyang conjecture's this +-- is the case but does not have a proof). For now this is +-- not implemented. -- --- H :: [ data Int; type B = Int; ] --- H :: [ type Int=C; data C ] --- H :: [ export Int; data B; type C = B; ] +-- It's worth noting that at the moment, a data constructor and a +-- type synonym are never compatible. Consider: -- --- We'll properly reject this too: a reexport of Int is a data --- constructor, whereas type Int=C is a type synonym: incompatible --- types. +-- signature H where { type Int=C; type B = Int; data C = Int} +-- signature H where { export Prelude.Int; data B; type C = B; } -- --- Perhaps the renamer is too fussy when it comes to ambiguity (requiring --- original names to match, rather than just the types after type synonym --- expansion) to match, but that's what we have for Haskell today. +-- This will be rejected, because the reexported Int in the second +-- signature (a proper data type) is never considered equal to a +-- type synonym. Perhaps this should be relaxed, where a type synonym +-- in a signature is considered implemented by a data type declaration +-- which matches the reference of the type synonym. typecheckIfacesForMerging :: Module -> [ModIface] -> IORef TypeEnv -> IfM lcl (TypeEnv, [ModDetails]) typecheckIfacesForMerging mod ifaces tc_env_var = -- cannot be boot (False) From git at git.haskell.org Wed Jan 11 16:29:14 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 11 Jan 2017 16:29:14 +0000 (UTC) Subject: [commit: ghc] wip/rwbarton-dep-finsts: Only check for conflicts with the actual dependencies (5748518) Message-ID: <20170111162914.B951B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rwbarton-dep-finsts Link : http://ghc.haskell.org/trac/ghc/changeset/5748518bf003b5d8cfc5af0f483fe82e691596c6/ghc >--------------------------------------------------------------- commit 5748518bf003b5d8cfc5af0f483fe82e691596c6 Author: Reid Barton Date: Wed Jan 11 11:28:32 2017 -0500 Only check for conflicts with the actual dependencies >--------------------------------------------------------------- 5748518bf003b5d8cfc5af0f483fe82e691596c6 compiler/typecheck/FamInst.hs | 59 ++++++++++++++++++++++++++++--------------- compiler/types/FamInstEnv.hs | 12 ++++----- 2 files changed, 44 insertions(+), 27 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 5748518bf003b5d8cfc5af0f483fe82e691596c6 From git at git.haskell.org Wed Jan 11 17:57:18 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 11 Jan 2017 17:57:18 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: SysTools: Revert linker flags change (b0dccac) Message-ID: <20170111175718.A4FCF3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/b0dccaccb304541e7f56d702bfbf65e18b98c05d/ghc >--------------------------------------------------------------- commit b0dccaccb304541e7f56d702bfbf65e18b98c05d Author: Ben Gamari Date: Tue Jan 10 16:05:31 2017 -0600 SysTools: Revert linker flags change fefe02c0324a25a52455a61f7f6e48be6d82d1ab inadvertently removed a linker flag needed to ensure that stack allocations don't fail (see #8870 and #12186 for original motivation). Undo this change. Fixes #13100. >--------------------------------------------------------------- b0dccaccb304541e7f56d702bfbf65e18b98c05d compiler/main/SysTools.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/main/SysTools.hs b/compiler/main/SysTools.hs index 1ab5b13..e5ee54d 100644 --- a/compiler/main/SysTools.hs +++ b/compiler/main/SysTools.hs @@ -860,7 +860,7 @@ getLinkerInfo' dflags = do -- Note [Windows stack usage] -- Force static linking of libGCC -- Note [Windows static libGCC] - , "-static-libgcc" ] + , "-Xlinker", "--stack=0x800000,0x800000", "-static-libgcc" ] _ -> do -- In practice, we use the compiler as the linker here. Pass -- -Wl,--version to get linker version info. From git at git.haskell.org Wed Jan 11 19:02:53 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 11 Jan 2017 19:02:53 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: configure: Revert RELEASE to NO (7984dc3) Message-ID: <20170111190253.5328A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/7984dc394e3136ef35e885e7c9a415294c72df0d/ghc >--------------------------------------------------------------- commit 7984dc394e3136ef35e885e7c9a415294c72df0d Author: Ben Gamari Date: Wed Jan 11 13:58:58 2017 -0500 configure: Revert RELEASE to NO >--------------------------------------------------------------- 7984dc394e3136ef35e885e7c9a415294c72df0d configure.ac | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/configure.ac b/configure.ac index a434a39..e61355d 100644 --- a/configure.ac +++ b/configure.ac @@ -16,7 +16,7 @@ dnl AC_INIT([The Glorious Glasgow Haskell Compilation System], [8.0.2], [glasgow-haskell-bugs at haskell.org], [ghc-AC_PACKAGE_VERSION]) # Set this to YES for a released version, otherwise NO -: ${RELEASE=YES} +: ${RELEASE=NO} # The primary version (e.g. 7.5, 7.4.1) is set in the AC_INIT line # above. If this is not a released version, then we will append the From git at git.haskell.org Wed Jan 11 19:02:56 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 11 Jan 2017 19:02:56 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Update ANNOUNCE (a81bf1b) Message-ID: <20170111190256.025173A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/a81bf1b4abdee8295984b726d99717d6ef71da49/ghc >--------------------------------------------------------------- commit a81bf1b4abdee8295984b726d99717d6ef71da49 Author: Ben Gamari Date: Wed Jan 11 14:00:06 2017 -0500 Update ANNOUNCE >--------------------------------------------------------------- a81bf1b4abdee8295984b726d99717d6ef71da49 ANNOUNCE | 102 ++++++++++++++++++++++++++++++--------------------------------- 1 file changed, 49 insertions(+), 53 deletions(-) diff --git a/ANNOUNCE b/ANNOUNCE index 5946b9f..14f28d9 100644 --- a/ANNOUNCE +++ b/ANNOUNCE @@ -1,78 +1,78 @@ =============================================== - The Glasgow Haskell Compiler -- version 8.0.1 + The Glasgow Haskell Compiler -- version 8.0.2 =============================================== -The GHC developers are very pleased to announce the release of the first -new super-major version of our Haskell compiler in six years, GHC 8.0.1. +The GHC team is happy to at last announce the 8.0.2 release of the +Glasgow Haskell Compiler. Source and binary distributions are available +at -This release features dozens of exciting developments including, + http://downloads.haskell.org/~ghc/8.0.2/ - * A more refined interface for implicit call-stacks, allowing libraries to - provide more helpful runtime error messages to users +This is the second release of the 8.0 series and fixes nearly +two-hundred bugs. These include, - * The introduction of the DuplicateRecordFields language extension, allowing - multiple record types to declare fields of the same name + * Interface file build determinism (#4012). - * Significant improvements in error message readability and content, including - facilities for libraries to provide custom error messages, more aggressive - warnings for fragile rewrite rules, and more helpful errors for missing - imports + * Compatibility with macOS Sierra and GCC compilers which compile + position-independent executables by default - * A rewritten and substantially more thorough pattern match checker, providing - more precise exhaustiveness checking in GADT pattern matches + * Compatibility with systems which use the gold linker - * More reliable debugging information including experimental backtrace support, - allowing better integration with traditional debugging tools + * Runtime linker fixes on Windows (see #12797) - * Support for desugaring do-notation to use Applicative combinators, allowing - the intuitive do notation to be used in settings which previously required - the direct use of Applicative combinators + * A compiler bug which resulted in undefined reference errors while + compiling some packages (see #12076) - * The introduction of Strict and StrictData language extensions, allowing - modules to be compiled with strict-by-default evaluation of bindings + * A number of memory consistency bugs in the runtime system - * Great improvements in portability, including more reliable linking on - Windows, a new PPC64 code generator, support for the AIX operating system, - unregisterised m68k support, and significant stabilization on ARM targets + * A number of efficiency issues in the threaded runtime which manifest + on larger core counts and large numbers of bound threads. - * A greatly improved user's guide, with beautiful and modern PDF and HTML - output + * A typechecker bug which caused some programs using + -XDefaultSignatures to be incorrectly accepted. - * Introduction of type application syntax, reducing the need for proxies + * More than two-hundred other bugs. See Trac [1] for a complete + listing. - * More complete support for pattern synonyms, including record pattern synonyms - and the ability to export patterns "bundled" with a type, as you would a data - constructor + * #12757, which lead to broken runtime behavior and even crashes in + the presence of primitive strings. - * Support for injective type families and recursive superclass relationships + * #12844, a type inference issue affecting partial type signatures. - * An improved generics representation leveraging GHC's support for type-level - literals + * A bump of the `directory` library, fixing buggy path + canonicalization behavior (#12894). Unfortunately this required a + major version bump in `directory` and minor bumps in several other + libraries. - * The TypeInType extension, which unifies types and kinds, allowing GHC to - reason about kind equality and enabling promotion of more constructs to the - type level + * #12912, where use of the `select` system call would lead to runtime + system failures with large numbers of open file handles. - * ...and more! + * #10635, wherein -Wredundant-constraints was included in the -Wall + warning set -A more thorough list of the changes included in this release can be found in the -release notes, +A more detailed list of the changes included in this release can be +found in the release notes, - https://downloads.haskell.org/~ghc/8.0.1/docs/html/users_guide/8.0.1-notes.html + https://downloads.haskell.org/~ghc/8.0.2/docs/html/users_guide/8.0.2-notes.html -As always, we have collected various points of interest for users of previous -GHC releases on the GHC 8.0 migration page, +Please note that this release breaks with our usual tendency to avoid +major version bumps of core libraries in minor GHC releases by including +an upgrade of the `directory` library to 1.3.0.0. - https://ghc.haskell.org/trac/ghc/wiki/Migration/8.0 +Also note that, due to a rather serious bug (#13100) affecting Windows +noticed late in the release cycle, the Windows binary distributions were +produced using a slightly patched [2] source tree. Users compiling from +source for Windows should be certain to include this patch in their +build. -Please let us know if you encounter anything missing or unclear on this page. - -This release is the culmination of nearly eighteen months of effort by over one -hundred contributors. We'd like to thank everyone who has contributed code, bug -reports, and feedback over the past year. It's only because of their efforts -that GHC continues to evolve. +This release is the result of six months of effort by the GHC +development community. We'd like to thank everyone who has contributed +code, bug reports, and feedback to this release. It's only due to +their efforts that GHC remains a vibrant and exciting project. +[1] https://ghc.haskell.org/trac/ghc/query?status=closed&milestone=8.0.2&col=id&col=summary&col=status&col=type&col=priority&col=milestone&col=component&order=priority +[2] http://downloads.haskell.org/~ghc/8.0.2/0001-SysTools-Revert-linker-flags-change.patch How to get it ~~~~~~~~~~~~~ @@ -82,7 +82,6 @@ are available at, http://www.haskell.org/ghc/ - Background ~~~~~~~~~~ @@ -96,7 +95,6 @@ large collection of libraries, and support for various language extensions, including concurrency, exceptions, and foreign language interfaces. GHC is distributed under a BSD-style open source license. - Supported Platforms ~~~~~~~~~~~~~~~~~~~ @@ -110,7 +108,6 @@ Building Guide describes how to go about porting to a new platform: http://ghc.haskell.org/trac/ghc/wiki/Building - Developers ~~~~~~~~~~ @@ -119,7 +116,6 @@ are available from GHC's developer site, http://ghc.haskell.org/trac/ghc/ - Community Resources ~~~~~~~~~~~~~~~~~~~ From git at git.haskell.org Wed Jan 11 23:20:10 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 11 Jan 2017 23:20:10 +0000 (UTC) Subject: [commit: ghc] master: Add mkUserGuidePart.cabal to .gitignore (f9df77e) Message-ID: <20170111232010.10D463A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f9df77e4abb2a5d83040ad5dd2dc19df6e055c5c/ghc >--------------------------------------------------------------- commit f9df77e4abb2a5d83040ad5dd2dc19df6e055c5c Author: Ryan Scott Date: Wed Jan 11 18:17:25 2017 -0500 Add mkUserGuidePart.cabal to .gitignore Following fe75d2d4db44cee72d505bba24bd44c1a2a75613. >--------------------------------------------------------------- f9df77e4abb2a5d83040ad5dd2dc19df6e055c5c .gitignore | 1 + 1 file changed, 1 insertion(+) diff --git a/.gitignore b/.gitignore index 270fd37..7d64a12 100644 --- a/.gitignore +++ b/.gitignore @@ -173,6 +173,7 @@ _darcs/ /stage3.package.conf /testsuite_summary*.txt /testlog* +/utils/mkUserGuidePart/mkUserGuidePart.cabal /utils/runghc/runghc.cabal /extra-gcc-opts From git at git.haskell.org Thu Jan 12 12:35:24 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 12 Jan 2017 12:35:24 +0000 (UTC) Subject: [commit: ghc] master: Typos in manual, comments and tests (c6b0486) Message-ID: <20170112123524.5D0CD3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c6b0486578c0df2b4ee7c440a95b515293e5b3e6/ghc >--------------------------------------------------------------- commit c6b0486578c0df2b4ee7c440a95b515293e5b3e6 Author: Gabor Greif Date: Wed Jan 11 17:52:20 2017 +0100 Typos in manual, comments and tests >--------------------------------------------------------------- c6b0486578c0df2b4ee7c440a95b515293e5b3e6 compiler/coreSyn/CorePrep.hs | 2 +- compiler/coreSyn/CoreSyn.hs | 2 +- compiler/coreSyn/CoreUtils.hs | 2 +- compiler/iface/TcIface.hs | 2 +- compiler/llvmGen/Llvm/PpLlvm.hs | 2 +- compiler/rename/RnTypes.hs | 8 ++++---- compiler/simplCore/SimplUtils.hs | 2 +- compiler/typecheck/TcRnExports.hs | 4 ++-- compiler/typecheck/TcType.hs | 6 +++--- docs/users_guide/separate_compilation.rst | 6 +++--- libraries/base/Data/List/NonEmpty.hs | 2 +- testsuite/tests/perf/compiler/all.T | 2 +- testsuite/tests/safeHaskell/safeInfered/UnsafeInfered08_A.hs | 2 +- testsuite/tests/typecheck/should_compile/tc186.hs | 2 +- testsuite/tests/typecheck/should_compile/tc201.hs | 2 +- testsuite/tests/typecheck/should_fail/T10715.hs | 2 +- testsuite/tests/typecheck/should_fail/tcfail135.hs | 2 +- 17 files changed, 25 insertions(+), 25 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc c6b0486578c0df2b4ee7c440a95b515293e5b3e6 From git at git.haskell.org Thu Jan 12 12:58:18 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 12 Jan 2017 12:58:18 +0000 (UTC) Subject: [commit: ghc] master: Fix top-level constraint handling (Trac #12921) (f5f6d42) Message-ID: <20170112125818.7B94B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f5f6d4237b87f5d0e3e0a05e4cfc52bb3c0e4ad9/ghc >--------------------------------------------------------------- commit f5f6d4237b87f5d0e3e0a05e4cfc52bb3c0e4ad9 Author: Simon Peyton Jones Date: Thu Jan 12 10:59:08 2017 +0000 Fix top-level constraint handling (Trac #12921) Some out-of-scope errors were not being reported if anyone throws an un-caught exception in the TcM monad. That led to ghc: panic! (the 'impossible' happened) initTc: unsolved constraints I fixed this * Splitting captureConstraints to use an auxilliary tryCaptureConstraints (which never fails) * Define a new TcSimplify.captureTopConstraints (replacing the old TcRnMonad.captureTopConstraints), which reports any unsolved out-of-scope constraints before propagating the exception That in turn allowed me to do some tidying up of the static-constraint machinery, reducing duplication. Also solves #13106. >--------------------------------------------------------------- f5f6d4237b87f5d0e3e0a05e4cfc52bb3c0e4ad9 compiler/typecheck/TcExpr.hs | 4 +- compiler/typecheck/TcRnDriver.hs | 27 ++-- compiler/typecheck/TcRnMonad.hs | 148 +++++++++++---------- compiler/typecheck/TcRnTypes.hs | 6 +- compiler/typecheck/TcSimplify.hs | 26 +++- testsuite/tests/typecheck/should_fail/T12921.hs | 9 ++ .../should_fail/T12921.stderr} | 26 ++-- testsuite/tests/typecheck/should_fail/all.T | 1 + 8 files changed, 149 insertions(+), 98 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc f5f6d4237b87f5d0e3e0a05e4cfc52bb3c0e4ad9 From git at git.haskell.org Thu Jan 12 12:58:21 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 12 Jan 2017 12:58:21 +0000 (UTC) Subject: [commit: ghc] master: Small refactoring in TcErrors (89ce9cd) Message-ID: <20170112125821.53C643A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/89ce9cd3e011982eb0bcd7e11ec70ef8457b02be/ghc >--------------------------------------------------------------- commit 89ce9cd3e011982eb0bcd7e11ec70ef8457b02be Author: Simon Peyton Jones Date: Thu Jan 12 10:57:25 2017 +0000 Small refactoring in TcErrors No change in behaviour >--------------------------------------------------------------- 89ce9cd3e011982eb0bcd7e11ec70ef8457b02be compiler/typecheck/TcErrors.hs | 30 ++++++++++++++++-------------- 1 file changed, 16 insertions(+), 14 deletions(-) diff --git a/compiler/typecheck/TcErrors.hs b/compiler/typecheck/TcErrors.hs index 1720e4d..639134e 100644 --- a/compiler/typecheck/TcErrors.hs +++ b/compiler/typecheck/TcErrors.hs @@ -1067,9 +1067,8 @@ mkHoleError ctxt ct@(CHoleCan { cc_hole = hole }) loc_msg tv | isTyVar tv = case tcTyVarDetails tv of - SkolemTv {} -> pprSkol (cec_encl ctxt) tv - MetaTv {} -> quotes (ppr tv) <+> text "is an ambiguous type variable" - det -> pprTcTyVarDetails det + MetaTv {} -> quotes (ppr tv) <+> text "is an ambiguous type variable" + _ -> extraTyVarInfo ctxt tv | otherwise = sdocWithDynFlags $ \dflags -> if gopt Opt_PrintExplicitCoercions dflags @@ -1449,7 +1448,7 @@ mkTyVarEqErr dflags ctxt report ct oriented tv1 ty2 -- the cases below don't really apply to ReprEq (except occurs check) = mkErrorMsgFromCt ctxt ct $ mconcat [ important $ misMatchOrCND ctxt ct oriented ty1 ty2 - , important $ extraTyVarInfo ctxt tv1 ty2 + , important $ extraTyVarEqInfo ctxt tv1 ty2 , report ] @@ -1497,7 +1496,7 @@ mkTyVarEqErr dflags ctxt report ct oriented tv1 ty2 , tv1 `elem` skols = mkErrorMsgFromCt ctxt ct $ mconcat [ important $ misMatchMsg ct oriented ty1 ty2 - , important $ extraTyVarInfo ctxt tv1 ty2 + , important $ extraTyVarEqInfo ctxt tv1 ty2 , report ] @@ -1538,7 +1537,7 @@ mkTyVarEqErr dflags ctxt report ct oriented tv1 ty2 , nest 2 $ text "inside the constraints:" <+> pprEvVarTheta given , nest 2 $ text "bound by" <+> ppr skol_info , nest 2 $ text "at" <+> ppr (tcl_loc env) ] - tv_extra = important $ extraTyVarInfo ctxt tv1 ty2 + tv_extra = important $ extraTyVarEqInfo ctxt tv1 ty2 add_sig = important $ suggestAddSig ctxt ty1 ty2 ; mkErrorMsgFromCt ctxt ct $ mconcat [msg, tclvl_extra, tv_extra, add_sig, report] } @@ -1641,24 +1640,27 @@ pp_givens givens 2 (sep [ text "bound by" <+> ppr skol_info , text "at" <+> ppr (tcl_loc env) ]) -extraTyVarInfo :: ReportErrCtxt -> TcTyVar -> TcType -> SDoc +extraTyVarEqInfo :: ReportErrCtxt -> TcTyVar -> TcType -> SDoc -- Add on extra info about skolem constants -- NB: The types themselves are already tidied -extraTyVarInfo ctxt tv1 ty2 - = tv_extra tv1 $$ ty_extra ty2 +extraTyVarEqInfo ctxt tv1 ty2 + = extraTyVarInfo ctxt tv1 $$ ty_extra ty2 where - implics = cec_encl ctxt ty_extra ty = case tcGetTyVar_maybe ty of - Just tv -> tv_extra tv + Just tv -> extraTyVarInfo ctxt tv Nothing -> empty - tv_extra tv - | let pp_tv = quotes (ppr tv) - = case tcTyVarDetails tv of +extraTyVarInfo :: ReportErrCtxt -> TcTyVar -> SDoc +extraTyVarInfo ctxt tv + = ASSERT2( isTyVar tv, ppr tv ) + case tcTyVarDetails tv of SkolemTv {} -> pprSkol implics tv FlatSkol {} -> pp_tv <+> text "is a flattening type variable" RuntimeUnk {} -> pp_tv <+> text "is an interactive-debugger skolem" MetaTv {} -> empty + where + implics = cec_encl ctxt + pp_tv = quotes (ppr tv) suggestAddSig :: ReportErrCtxt -> TcType -> TcType -> SDoc -- See Note [Suggest adding a type signature] From git at git.haskell.org Fri Jan 13 09:03:00 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 13 Jan 2017 09:03:00 +0000 (UTC) Subject: [commit: ghc] master: Record evaluated-ness on workers and wrappers (6b976eb) Message-ID: <20170113090300.B4B083A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6b976eb89fe72827f226506d16d3721ba4e28bab/ghc >--------------------------------------------------------------- commit 6b976eb89fe72827f226506d16d3721ba4e28bab Author: Simon Peyton Jones Date: Fri Jan 13 08:56:53 2017 +0000 Record evaluated-ness on workers and wrappers In Trac #13027, comment:20, I noticed that wrappers created after demand analysis weren't recording the evaluated-ness of strict constructor arguments. In the ticket that led to a (debatable) Lint error but in general the more we know about evaluated-ness the better we can optimise. This commit adds that info both in the worker (on args) and in the wrapper (on CPR result patterns). See Note [Record evaluated-ness in worker/wrapper] in WwLib On the way I defined Id.setCaseBndrEvald, and used it to shorten the code in a few other places >--------------------------------------------------------------- 6b976eb89fe72827f226506d16d3721ba4e28bab compiler/basicTypes/Id.hs | 13 ++++- compiler/coreSyn/CoreUtils.hs | 6 +-- compiler/simplCore/Simplify.hs | 12 ++--- compiler/stranal/WwLib.hs | 107 ++++++++++++++++++++++++++++++++--------- 4 files changed, 101 insertions(+), 37 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 6b976eb89fe72827f226506d16d3721ba4e28bab From git at git.haskell.org Fri Jan 13 17:14:51 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 13 Jan 2017 17:14:51 +0000 (UTC) Subject: [commit: ghc] master: Typos in comments (d3ad013) Message-ID: <20170113171451.88BD93A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d3ad013526b2f42b4e93ee294883e93ae988b7d8/ghc >--------------------------------------------------------------- commit d3ad013526b2f42b4e93ee294883e93ae988b7d8 Author: Gabor Greif Date: Thu Jan 12 15:10:48 2017 +0100 Typos in comments >--------------------------------------------------------------- d3ad013526b2f42b4e93ee294883e93ae988b7d8 compiler/vectorise/Vectorise/Builtins/Initialise.hs | 2 +- libraries/base/Foreign/Marshal/Alloc.hs | 2 +- libraries/base/Foreign/Marshal/Utils.hs | 2 +- rts/linker/Elf.c | 2 +- testsuite/tests/concurrent/prog003/CASList.hs | 2 +- testsuite/tests/concurrent/prog003/MVarListLockCoupling.hs | 2 +- 6 files changed, 6 insertions(+), 6 deletions(-) diff --git a/compiler/vectorise/Vectorise/Builtins/Initialise.hs b/compiler/vectorise/Vectorise/Builtins/Initialise.hs index 69e00a0..73cedc4 100644 --- a/compiler/vectorise/Vectorise/Builtins/Initialise.hs +++ b/compiler/vectorise/Vectorise/Builtins/Initialise.hs @@ -195,7 +195,7 @@ initBuiltinVars (Builtins { }) mk_tup n name = (tupleDataCon Boxed n, name) --- Auxilliary look up functions ----------------------------------------------- +-- Auxiliary look up functions ----------------------------------------------- -- |Lookup a variable given its name and the module that contains it. externalVar :: FastString -> DsM Var diff --git a/libraries/base/Foreign/Marshal/Alloc.hs b/libraries/base/Foreign/Marshal/Alloc.hs index 264c10c..2a3c756 100644 --- a/libraries/base/Foreign/Marshal/Alloc.hs +++ b/libraries/base/Foreign/Marshal/Alloc.hs @@ -198,7 +198,7 @@ free :: Ptr a -> IO () free = _free --- auxilliary routines +-- auxiliary routines -- ------------------- -- asserts that the pointer returned from the action in the second argument is diff --git a/libraries/base/Foreign/Marshal/Utils.hs b/libraries/base/Foreign/Marshal/Utils.hs index 6f24346..30e8003 100644 --- a/libraries/base/Foreign/Marshal/Utils.hs +++ b/libraries/base/Foreign/Marshal/Utils.hs @@ -177,7 +177,7 @@ fillBytes dest char size = do _ <- memset dest (fromIntegral char) (fromIntegral size) return () --- auxilliary routines +-- auxiliary routines -- ------------------- -- |Basic C routines needed for memory copying diff --git a/rts/linker/Elf.c b/rts/linker/Elf.c index f836912..604c3dc 100644 --- a/rts/linker/Elf.c +++ b/rts/linker/Elf.c @@ -290,7 +290,7 @@ PLTSize(void) stashed into unused fields in the first section header. For symbols, there seems to have been no place in the actual symbol table - for the extra bits, so the indexes have been moved into an auxilliary + for the extra bits, so the indexes have been moved into an auxiliary section instead. For symbols in sections beyond 0xff00, the symbol's st_shndx will be an escape value (SHN_XINDEX), and the actual 32-bit section number for symbol N diff --git a/testsuite/tests/concurrent/prog003/CASList.hs b/testsuite/tests/concurrent/prog003/CASList.hs index 445af79..0c4c7a0 100644 --- a/testsuite/tests/concurrent/prog003/CASList.hs +++ b/testsuite/tests/concurrent/prog003/CASList.hs @@ -45,7 +45,7 @@ type Iterator a = IORef (IORef (List a)) ------------------------------------------- --- auxilliary functions +-- auxiliary functions diff --git a/testsuite/tests/concurrent/prog003/MVarListLockCoupling.hs b/testsuite/tests/concurrent/prog003/MVarListLockCoupling.hs index 0820ccd..642529c 100644 --- a/testsuite/tests/concurrent/prog003/MVarListLockCoupling.hs +++ b/testsuite/tests/concurrent/prog003/MVarListLockCoupling.hs @@ -44,7 +44,7 @@ type Iterator a = IORef (MVar (List a)) -- iterators are private ------------------------------------------- --- auxilliary functions +-- auxiliary functions From git at git.haskell.org Fri Jan 13 17:14:54 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 13 Jan 2017 17:14:54 +0000 (UTC) Subject: [commit: ghc] master: Simplify CPP logic as we now need v7.10 for bootstrapping (a62701f) Message-ID: <20170113171454.3CD913A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a62701f26e191d2e21c543e702ff1f3c795033c7/ghc >--------------------------------------------------------------- commit a62701f26e191d2e21c543e702ff1f3c795033c7 Author: Gabor Greif Date: Thu Jan 12 17:44:38 2017 +0100 Simplify CPP logic as we now need v7.10 for bootstrapping >--------------------------------------------------------------- a62701f26e191d2e21c543e702ff1f3c795033c7 compiler/ghci/Linker.hs | 6 +----- compiler/main/DynFlags.hs | 7 +------ compiler/main/StaticFlags.hs | 7 +------ 3 files changed, 3 insertions(+), 17 deletions(-) diff --git a/compiler/ghci/Linker.hs b/compiler/ghci/Linker.hs index 6a0483c..b50edca 100644 --- a/compiler/ghci/Linker.hs +++ b/compiler/ghci/Linker.hs @@ -62,11 +62,7 @@ import System.Directory import Exception -#if __GLASGOW_HASKELL__ >= 709 -import Foreign -#else -import Foreign.Safe -#endif +import Foreign (Ptr) -- needed for 2nd stage {- ********************************************************************** diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 8d50e01..c8f6e1e 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -214,12 +214,7 @@ import qualified Data.IntSet as IntSet import GHC.Foreign (withCString, peekCString) import qualified GHC.LanguageExtensions as LangExt -#if __GLASGOW_HASKELL__ >= 709 -import Foreign -#else -import Foreign.Safe -#endif - +import Foreign (Ptr) -- needed for 2nd stage -- Note [Updating flag description in the User's Guide] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ diff --git a/compiler/main/StaticFlags.hs b/compiler/main/StaticFlags.hs index af8f4e6..b5be9ba 100644 --- a/compiler/main/StaticFlags.hs +++ b/compiler/main/StaticFlags.hs @@ -48,12 +48,7 @@ import Control.Monad import Data.IORef import System.IO.Unsafe ( unsafePerformIO ) -#if __GLASGOW_HASKELL__ >= 709 -import Foreign -#else -import Foreign.Safe -#endif - +import Foreign (Ptr) -- needed for 2nd stage ----------------------------------------------------------------------------- -- Static flags From git at git.haskell.org Fri Jan 13 17:14:56 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 13 Jan 2017 17:14:56 +0000 (UTC) Subject: [commit: ghc] master: Spelling fixes in non-exported data type (8b6fa4f) Message-ID: <20170113171456.DE3153A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8b6fa4f14f4d4f4a584e2d3d603271057f76e25a/ghc >--------------------------------------------------------------- commit 8b6fa4f14f4d4f4a584e2d3d603271057f76e25a Author: Gabor Greif Date: Thu Jan 12 17:42:30 2017 +0100 Spelling fixes in non-exported data type >--------------------------------------------------------------- 8b6fa4f14f4d4f4a584e2d3d603271057f76e25a compiler/typecheck/TcRnExports.hs | 52 +++++++++++++++++++-------------------- 1 file changed, 26 insertions(+), 26 deletions(-) diff --git a/compiler/typecheck/TcRnExports.hs b/compiler/typecheck/TcRnExports.hs index 29f308e..7e47901 100644 --- a/compiler/typecheck/TcRnExports.hs +++ b/compiler/typecheck/TcRnExports.hs @@ -476,13 +476,13 @@ lookupExportChild parent rdr_name -- `checkPatSynParent`. traceRn "lookupExportChild original_gres:" (ppr original_gres) case picked_gres original_gres of - NoOccurence -> + NoOccurrence -> noMatchingParentErr original_gres - UniqueOccurence g -> + UniqueOccurrence g -> checkPatSynParent parent (gre_name g) - DisambiguatedOccurence g -> + DisambiguatedOccurrence g -> checkFld g - AmbiguousOccurence gres -> + AmbiguousOccurrence gres -> mkNameClashErr gres where -- Convert into FieldLabel if necessary @@ -547,42 +547,42 @@ lookupExportChild parent rdr_name right_parent p | Just cur_parent <- getParent p = if parent == cur_parent - then DisambiguatedOccurence p - else NoOccurence + then DisambiguatedOccurrence p + else NoOccurrence | otherwise - = UniqueOccurence p + = UniqueOccurrence p -- This domain specific datatype is used to record why we decided it was -- possible that a GRE could be exported with a parent. data DisambigInfo - = NoOccurence + = NoOccurrence -- The GRE could never be exported. It has the wrong parent. - | UniqueOccurence GlobalRdrElt + | UniqueOccurrence GlobalRdrElt -- The GRE has no parent. It could be a pattern synonym. - | DisambiguatedOccurence GlobalRdrElt + | DisambiguatedOccurrence GlobalRdrElt -- The parent of the GRE is the correct parent - | AmbiguousOccurence [GlobalRdrElt] + | AmbiguousOccurrence [GlobalRdrElt] -- For example, two normal identifiers with the same name are in - -- scope. They will both be resolved to "UniqueOccurence" and the + -- scope. They will both be resolved to "UniqueOccurrence" and the -- monoid will combine them to this failing case. instance Monoid DisambigInfo where - mempty = NoOccurence + mempty = NoOccurrence -- This is the key line: We prefer disambiguated occurrences to other -- names. - UniqueOccurence _ `mappend` DisambiguatedOccurence g' = DisambiguatedOccurence g' - DisambiguatedOccurence g' `mappend` UniqueOccurence _ = DisambiguatedOccurence g' - - - NoOccurence `mappend` m = m - m `mappend` NoOccurence = m - UniqueOccurence g `mappend` UniqueOccurence g' = AmbiguousOccurence [g, g'] - UniqueOccurence g `mappend` AmbiguousOccurence gs = AmbiguousOccurence (g:gs) - DisambiguatedOccurence g `mappend` DisambiguatedOccurence g' = AmbiguousOccurence [g, g'] - DisambiguatedOccurence g `mappend` AmbiguousOccurence gs = AmbiguousOccurence (g:gs) - AmbiguousOccurence gs `mappend` UniqueOccurence g' = AmbiguousOccurence (g':gs) - AmbiguousOccurence gs `mappend` DisambiguatedOccurence g' = AmbiguousOccurence (g':gs) - AmbiguousOccurence gs `mappend` AmbiguousOccurence gs' = AmbiguousOccurence (gs ++ gs') + UniqueOccurrence _ `mappend` DisambiguatedOccurrence g' = DisambiguatedOccurrence g' + DisambiguatedOccurrence g' `mappend` UniqueOccurrence _ = DisambiguatedOccurrence g' + + + NoOccurrence `mappend` m = m + m `mappend` NoOccurrence = m + UniqueOccurrence g `mappend` UniqueOccurrence g' = AmbiguousOccurrence [g, g'] + UniqueOccurrence g `mappend` AmbiguousOccurrence gs = AmbiguousOccurrence (g:gs) + DisambiguatedOccurrence g `mappend` DisambiguatedOccurrence g' = AmbiguousOccurrence [g, g'] + DisambiguatedOccurrence g `mappend` AmbiguousOccurrence gs = AmbiguousOccurrence (g:gs) + AmbiguousOccurrence gs `mappend` UniqueOccurrence g' = AmbiguousOccurrence (g':gs) + AmbiguousOccurrence gs `mappend` DisambiguatedOccurrence g' = AmbiguousOccurrence (g':gs) + AmbiguousOccurrence gs `mappend` AmbiguousOccurrence gs' = AmbiguousOccurrence (gs ++ gs') From git at git.haskell.org Fri Jan 13 17:14:59 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 13 Jan 2017 17:14:59 +0000 (UTC) Subject: [commit: ghc] master: Require python3 like everywhere else too (dde63e0) Message-ID: <20170113171459.8F9A73A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/dde63e00fcfd6baba6d06b8be80a8cd34cc86377/ghc >--------------------------------------------------------------- commit dde63e00fcfd6baba6d06b8be80a8cd34cc86377 Author: Gabor Greif Date: Fri Jan 13 16:37:28 2017 +0100 Require python3 like everywhere else too >--------------------------------------------------------------- dde63e00fcfd6baba6d06b8be80a8cd34cc86377 utils/checkUniques/check-uniques.py | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/utils/checkUniques/check-uniques.py b/utils/checkUniques/check-uniques.py index 67322c2..de71e72 100755 --- a/utils/checkUniques/check-uniques.py +++ b/utils/checkUniques/check-uniques.py @@ -1,4 +1,4 @@ -#!/usr/bin/env python +#!/usr/bin/env python3 from __future__ import print_function import os.path From git at git.haskell.org Fri Jan 13 20:37:40 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 13 Jan 2017 20:37:40 +0000 (UTC) Subject: [commit: ghc] master: Desugar static forms to makeStatic calls. (13a8521) Message-ID: <20170113203740.3B5233A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/13a85211040f67977d2a2371f4087d1d2ebf4de4/ghc >--------------------------------------------------------------- commit 13a85211040f67977d2a2371f4087d1d2ebf4de4 Author: Facundo Domínguez Date: Mon Jan 9 14:29:32 2017 -0300 Desugar static forms to makeStatic calls. Summary: Using makeStatic instead of applications of the StaticPtr data constructor makes possible linting core when unboxing strict fields. Test Plan: ./validate Reviewers: simonpj, goldfire, austin, bgamari, hvr Reviewed By: simonpj Subscribers: RyanGlScott, mboes, thomie Differential Revision: https://phabricator.haskell.org/D2930 GHC Trac Issues: #12622 >--------------------------------------------------------------- 13a85211040f67977d2a2371f4087d1d2ebf4de4 compiler/coreSyn/CoreLint.hs | 102 ++++---- compiler/coreSyn/CoreUtils.hs | 25 +- compiler/coreSyn/MkCore.hs | 11 +- compiler/deSugar/DsExpr.hs | 63 +---- compiler/main/StaticPtrTable.hs | 275 ++++++++++++++++----- compiler/main/TidyPgm.hs | 32 +-- compiler/prelude/PrelNames.hs | 11 + compiler/simplCore/SetLevels.hs | 6 +- compiler/simplCore/SimplCore.hs | 59 +---- compiler/typecheck/TcExpr.hs | 1 + libraries/base/GHC/StaticPtr/Internal.hs | 27 ++ libraries/base/base.cabal | 1 + testsuite/tests/codeGen/should_run/T12622.hs | 19 ++ .../tests/codeGen/should_run/T12622.stdout | 0 testsuite/tests/codeGen/should_run/T12622_A.hs | 15 ++ testsuite/tests/codeGen/should_run/all.T | 1 + 16 files changed, 386 insertions(+), 262 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 13a85211040f67977d2a2371f4087d1d2ebf4de4 From git at git.haskell.org Sun Jan 15 13:00:27 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 15 Jan 2017 13:00:27 +0000 (UTC) Subject: [commit: ghc] master: Use latin1 code page on Windows for response files. (f63c8ef) Message-ID: <20170115130027.2A2C33A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f63c8ef33ec9666688163abe4ccf2d6c0428a7e7/ghc >--------------------------------------------------------------- commit f63c8ef33ec9666688163abe4ccf2d6c0428a7e7 Author: Tamar Christina Date: Sun Jan 15 12:52:14 2017 +0000 Use latin1 code page on Windows for response files. Summary: D2917 added a change that will make paths on Windows response files use DOS 8.3 shortnames to get around the fact that `libiberty` assumes a one byte per character encoding. This is actually not the problem, the actual problem is that GCC on Windows doesn't seem to support Unicode at all. This comes down to how unicode characters are handled between POSIX and Windows. On Windows, Unicode is only supported using a multibyte character encoding such as `wchar_t` with calls to the appropriate wide version of APIs (name post-fixed with the `W` character). On Posix I believe the standard `char` is used and based on the value it is decoded to the correct string. GCC doesn't seem to make calls to the Wide version of the Windows APIs, and even if it did, it's character representation would be wrong. So I believe GCC just does not support utf-8 paths on Windows. So the hack in D2917 is the only way to get Unicode support. The problem is however that `GCC` is not the only tool with this issue and we don't use response files for every invocation of the tools. Most of the tools probably don't support it. Furthermore, DOS 8.1 shortnames only exist when the path or file physically exists on disk. We pass lots of paths to GCC that don't exist yet, like the output file. D2917 works around this by splitting the path from the file and try shortening that. But this may not always work. In short, even if we do Unicode correctly (which we don't atm, the GCC driver we build uses `char` instead of `wchar_t`) we won't be able to compile using unicode paths that need to be passed to `GCC`. So not sure about the point of D2917. What we can do is support the most common non-ascii characters by writing the response files out using the `latin1` code page. Test Plan: compile + make test TEST=T12971 Reviewers: austin, bgamari, erikd Reviewed By: bgamari Subscribers: thomie, #ghc_windows_task_force Differential Revision: https://phabricator.haskell.org/D2942 GHC Trac Issues: #12971 >--------------------------------------------------------------- f63c8ef33ec9666688163abe4ccf2d6c0428a7e7 compiler/main/SysTools.hs | 4 ++++ docs/users_guide/bugs.rst | 3 +++ testsuite/tests/driver/Makefile | 2 +- testsuite/tests/driver/all.T | 2 +- 4 files changed, 9 insertions(+), 2 deletions(-) diff --git a/compiler/main/SysTools.hs b/compiler/main/SysTools.hs index 38d866e..ea3c461 100644 --- a/compiler/main/SysTools.hs +++ b/compiler/main/SysTools.hs @@ -1240,7 +1240,11 @@ runSomethingResponseFile dflags filter_fn phase_name pgm args mb_env = getResponseFile args = do fp <- newTempName dflags "rsp" withFile fp WriteMode $ \h -> do +#if defined(mingw32_HOST_OS) + hSetEncoding h latin1 +#else hSetEncoding h utf8 +#endif hPutStr h $ unlines $ map escape args return fp diff --git a/docs/users_guide/bugs.rst b/docs/users_guide/bugs.rst index 875820b..c1527f1 100644 --- a/docs/users_guide/bugs.rst +++ b/docs/users_guide/bugs.rst @@ -540,6 +540,9 @@ Bugs in GHC in the compiler's internal representation and can be unified producing unexpected results. See :ghc-ticket:`11715` for one example. +- Because of a toolchain limitation we are unable to support full Unicode paths + on WIndows. On Windows we support up to Latin-1. See :ghc-ticket:`12971` for more. + .. _bugs-ghci: Bugs in GHCi (the interactive GHC) diff --git a/testsuite/tests/driver/Makefile b/testsuite/tests/driver/Makefile index d3f78ef..ffb924a 100644 --- a/testsuite/tests/driver/Makefile +++ b/testsuite/tests/driver/Makefile @@ -645,4 +645,4 @@ T12955: .PHONY: T12971 T12971: mkdir -p ä - ! TMP=ä "$(TEST_HC)" $(TEST_HC_OPTS) --make T12971 + TMP=ä "$(TEST_HC)" $(TEST_HC_OPTS) --make T12971 diff --git a/testsuite/tests/driver/all.T b/testsuite/tests/driver/all.T index d327ac5..380f288 100644 --- a/testsuite/tests/driver/all.T +++ b/testsuite/tests/driver/all.T @@ -502,4 +502,4 @@ test('T12752pass', normal, compile, ['-DSHOULD_PASS=1 -Wcpp-undef']) test('T12955', normal, run_command, ['$MAKE -s --no-print-directory T12955']) -test('T12971', expect_broken(12971), run_command, ['$MAKE -s --no-print-directory T12971']) \ No newline at end of file +test('T12971', ignore_stdout, run_command, ['$MAKE -s --no-print-directory T12971']) From git at git.haskell.org Sun Jan 15 13:08:04 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 15 Jan 2017 13:08:04 +0000 (UTC) Subject: [commit: ghc] master: Fix abort and import lib search on Windows (331f88d) Message-ID: <20170115130804.24AD63A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/331f88d0d878eae926b3c1c61a3ff344916b62ed/ghc >--------------------------------------------------------------- commit 331f88d0d878eae926b3c1c61a3ff344916b62ed Author: Tamar Christina Date: Sun Jan 15 13:07:36 2017 +0000 Fix abort and import lib search on Windows Summary: Apparently `sysErrorBelch` doesn't terminate the program anymore making previously unreachable code now execute. If a dll is not found the error message we return needs to be a heap value. Secondly also allow the pattern `lib` to be allowed for finding an import library with the name `lib.dll.a`. Test Plan: ./validate, new tests T13082_good and T13082_fail Reviewers: austin, RyanGlScott, hvr, erikd, simonmar, bgamari Reviewed By: RyanGlScott, bgamari Subscribers: thomie, #ghc_windows_task_force Differential Revision: https://phabricator.haskell.org/D2941 GHC Trac Issues: #13082 >--------------------------------------------------------------- 331f88d0d878eae926b3c1c61a3ff344916b62ed compiler/ghci/Linker.hs | 4 +++- rts/linker/PEi386.c | 5 +++-- testsuite/tests/rts/{T12771 => T13082}/Makefile | 9 +++++++-- testsuite/tests/rts/T13082/T13082_fail.stderr | 3 +++ .../bkprun02.stdout => rts/T13082/T13082_good.stdout} | 0 testsuite/tests/rts/T13082/all.T | 11 +++++++++++ testsuite/tests/rts/{T12771 => T13082}/main.hs | 0 7 files changed, 27 insertions(+), 5 deletions(-) diff --git a/compiler/ghci/Linker.hs b/compiler/ghci/Linker.hs index b50edca..9252489 100644 --- a/compiler/ghci/Linker.hs +++ b/compiler/ghci/Linker.hs @@ -1351,7 +1351,9 @@ locateLib hsc_env is_hs dirs lib loading_profiled_hs_libs = interpreterProfiled dflags loading_dynamic_hs_libs = interpreterDynamic dflags - import_libs = [lib <.> "lib", "lib" ++ lib <.> "lib", "lib" ++ lib <.> "dll.a"] + import_libs = [ lib <.> "lib" , "lib" ++ lib <.> "lib" + , "lib" ++ lib <.> "dll.a", lib <.> "dll.a" + ] hs_dyn_lib_name = lib ++ '-':programName dflags ++ projectVersion dflags hs_dyn_lib_file = mkHsSOName platform hs_dyn_lib_name diff --git a/rts/linker/PEi386.c b/rts/linker/PEi386.c index 6cd4861..1d0682b 100644 --- a/rts/linker/PEi386.c +++ b/rts/linker/PEi386.c @@ -240,10 +240,11 @@ addDLL_PEi386( pathchar *dll_name ) error: stgFree(buf); - sysErrorBelch("addDLL: %" PATH_FMT " (Win32 error %lu)", dll_name, GetLastError()); + char* errormsg = malloc(sizeof(char) * 80); + snprintf(errormsg, 80, "addDLL: %" PATH_FMT " or dependencies not loaded. (Win32 error %lu)", dll_name, GetLastError()); /* LoadLibrary failed; return a ptr to the error msg. */ - return "addDLL: could not load DLL"; + return errormsg; } pathchar* findSystemLibrary_PEi386( pathchar* dll_name ) diff --git a/testsuite/tests/rts/T12771/Makefile b/testsuite/tests/rts/T13082/Makefile similarity index 62% copy from testsuite/tests/rts/T12771/Makefile copy to testsuite/tests/rts/T13082/Makefile index d6960a0..1f023b0 100644 --- a/testsuite/tests/rts/T12771/Makefile +++ b/testsuite/tests/rts/T13082/Makefile @@ -2,9 +2,14 @@ TOP=../../.. include $(TOP)/mk/boilerplate.mk include $(TOP)/mk/test.mk -T12771: +.PHONY: T13082_good +T13082_good: '$(TEST_CC)' -c foo.c -o foo.o '$(AR)' rsc libfoo.a foo.o '$(TEST_HC)' -shared foo_dll.c -o libfoo-1.dll mv libfoo-1.dll.a libfoo.dll.a - echo main | '$(TEST_HC)' $(TEST_HC_OPTS_INTERACTIVE) main.hs -lfoo -L"$(PWD)" + echo main | '$(TEST_HC)' $(TEST_HC_OPTS_INTERACTIVE) main.hs -llibfoo -L"$(PWD)" + +.PHONY: T13082_fail +T13082_fail: + ! echo main | '$(TEST_HC)' $(TEST_HC_OPTS_INTERACTIVE) main.hs -ldoesnotexist diff --git a/testsuite/tests/rts/T13082/T13082_fail.stderr b/testsuite/tests/rts/T13082/T13082_fail.stderr new file mode 100644 index 0000000..281e16a --- /dev/null +++ b/testsuite/tests/rts/T13082/T13082_fail.stderr @@ -0,0 +1,3 @@ +: user specified .o/.so/.DLL could not be loaded (addDLL: doesnotexist or dependencies not loaded. (Win32 error 126)) +Whilst trying to load: (dynamic) doesnotexist +Additional directories searched: (none) diff --git a/testsuite/tests/backpack/should_run/bkprun02.stdout b/testsuite/tests/rts/T13082/T13082_good.stdout similarity index 100% copy from testsuite/tests/backpack/should_run/bkprun02.stdout copy to testsuite/tests/rts/T13082/T13082_good.stdout diff --git a/testsuite/tests/rts/T13082/all.T b/testsuite/tests/rts/T13082/all.T new file mode 100644 index 0000000..dd94766 --- /dev/null +++ b/testsuite/tests/rts/T13082/all.T @@ -0,0 +1,11 @@ +test('T13082_good', [ extra_clean(['libfoo.a', 'libfoo-1.dll', 'foo.o', 'main.o']) + , extra_files(['foo.c', 'main.hs', 'foo_dll.c']) + , unless(opsys('mingw32'), skip) + ], + run_command, ['$MAKE -s --no-print-directory T13082_good']) + +test('T13082_fail', [ extra_clean(['main.o']) + , extra_files(['main.hs']) + , unless(opsys('mingw32'), skip) + ], + run_command, ['$MAKE -s --no-print-directory T13082_fail']) diff --git a/testsuite/tests/rts/T12771/main.hs b/testsuite/tests/rts/T13082/main.hs similarity index 100% copy from testsuite/tests/rts/T12771/main.hs copy to testsuite/tests/rts/T13082/main.hs From git at git.haskell.org Sun Jan 15 16:56:11 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 15 Jan 2017 16:56:11 +0000 (UTC) Subject: [commit: ghc] master: Properly introduce CTimer to System.Posix.Types (db91d17) Message-ID: <20170115165611.2CF053A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/db91d17edfbe7deecb62bbb89c804249f9c4a4bd/ghc >--------------------------------------------------------------- commit db91d17edfbe7deecb62bbb89c804249f9c4a4bd Author: Ryan Scott Date: Sun Jan 15 11:53:34 2017 -0500 Properly introduce CTimer to System.Posix.Types Summary: In ffc2327070dbb664bdb407a804121eacb2a7c734, an attempt was made at adding a Haskell wrapper around the C `timer_t` type. Unfortunately, GHC's autoconf macros weren't sophisticated enough at the time to properly detect that `timer_t` is represented by a `void *` (i.e., a pointer) on most OSes. This is a second attempt at `CTimer`, this time using `AC_COMPILE_IFELSE` to detect if a type is a pointer type by compiling the following program: ``` type val; *val; ``` This also only derives a small subset of class instances for `CTimer` that are known to be compatible with `Ptr` using a new `OPAQUE_TYPE_WITH_CTYPE` macro. Test Plan: ./validate Reviewers: erikd, hvr, austin, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2952 GHC Trac Issues: #12795, #12998 >--------------------------------------------------------------- db91d17edfbe7deecb62bbb89c804249f9c4a4bd libraries/base/System/Posix/Types.hs | 14 +++++----- libraries/base/aclocal.m4 | 53 ++++++++++++++++++++++++------------ libraries/base/changelog.md | 2 +- libraries/base/configure.ac | 1 + libraries/base/include/CTypes.h | 6 ++++ 5 files changed, 50 insertions(+), 26 deletions(-) diff --git a/libraries/base/System/Posix/Types.hs b/libraries/base/System/Posix/Types.hs index da4fc60..a02a5b9 100644 --- a/libraries/base/System/Posix/Types.hs +++ b/libraries/base/System/Posix/Types.hs @@ -92,13 +92,9 @@ module System.Posix.Types ( #if defined(HTYPE_KEY_T) CKey(..), #endif --- We can't support CTimer (timer_t) yet, as FPTOOLS_CHECK_HTYPE doesn't have --- the ability to discern pointer types (like void*, which timer_t usually is) --- from non-pointer types. See GHC Trac #12998. --- --- #if defined(HTYPE_TIMER_T) --- CTimer(..), --- #endif +#if defined(HTYPE_TIMER_T) + CTimer(..), +#endif Fd(..), @@ -213,6 +209,10 @@ INTEGRAL_TYPE_WITH_CTYPE(CId,id_t,HTYPE_ID_T) -- | @since 4.10.0.0 INTEGRAL_TYPE_WITH_CTYPE(CKey,key_t,HTYPE_KEY_T) #endif +#if defined(HTYPE_TIMER_T) +-- | @since 4.10.0.0 +OPAQUE_TYPE_WITH_CTYPE(CTimer,timer_t,HTYPE_TIMER_T) +#endif -- Make an Fd type rather than using CInt everywhere INTEGRAL_TYPE(Fd,CInt) diff --git a/libraries/base/aclocal.m4 b/libraries/base/aclocal.m4 index 50d8168..17b8bca 100644 --- a/libraries/base/aclocal.m4 +++ b/libraries/base/aclocal.m4 @@ -131,26 +131,43 @@ AC_DEFUN([FPTOOLS_CHECK_HTYPE_ELSE],[ if test "$HTYPE_IS_INTEGRAL" -eq 0 then - FP_COMPUTE_INT([HTYPE_IS_FLOAT],[sizeof($1) == sizeof(float)], - [FPTOOLS_HTYPE_INCLUDES], - [AC_CV_NAME_supported=no]) - FP_COMPUTE_INT([HTYPE_IS_DOUBLE],[sizeof($1) == sizeof(double)], - [FPTOOLS_HTYPE_INCLUDES], - [AC_CV_NAME_supported=no]) - FP_COMPUTE_INT([HTYPE_IS_LDOUBLE],[sizeof($1) == sizeof(long double)], - [FPTOOLS_HTYPE_INCLUDES], - [AC_CV_NAME_supported=no]) - if test "$HTYPE_IS_FLOAT" -eq 1 - then - AC_CV_NAME=Float - elif test "$HTYPE_IS_DOUBLE" -eq 1 - then - AC_CV_NAME=Double - elif test "$HTYPE_IS_LDOUBLE" -eq 1 + dnl If the C type isn't an integer, we check if it's a pointer type + dnl by trying to dereference one of its values. If that fails to + dnl compile, it's not a pointer, so we check to see if it's a + dnl floating-point type. + AC_COMPILE_IFELSE( + [AC_LANG_PROGRAM( + [FPTOOLS_HTYPE_INCLUDES], + [$1 val; *val;] + )], + [HTYPE_IS_POINTER=yes], + [HTYPE_IS_POINTER=no]) + + if test "$HTYPE_IS_POINTER" = yes then - AC_CV_NAME=LDouble + AC_CV_NAME="Ptr ()" else - AC_CV_NAME_supported=no + FP_COMPUTE_INT([HTYPE_IS_FLOAT],[sizeof($1) == sizeof(float)], + [FPTOOLS_HTYPE_INCLUDES], + [AC_CV_NAME_supported=no]) + FP_COMPUTE_INT([HTYPE_IS_DOUBLE],[sizeof($1) == sizeof(double)], + [FPTOOLS_HTYPE_INCLUDES], + [AC_CV_NAME_supported=no]) + FP_COMPUTE_INT([HTYPE_IS_LDOUBLE],[sizeof($1) == sizeof(long double)], + [FPTOOLS_HTYPE_INCLUDES], + [AC_CV_NAME_supported=no]) + if test "$HTYPE_IS_FLOAT" -eq 1 + then + AC_CV_NAME=Float + elif test "$HTYPE_IS_DOUBLE" -eq 1 + then + AC_CV_NAME=Double + elif test "$HTYPE_IS_LDOUBLE" -eq 1 + then + AC_CV_NAME=LDouble + else + AC_CV_NAME_supported=no + fi fi else FP_COMPUTE_INT([HTYPE_IS_SIGNED],[(($1)(-1)) < (($1)0)], diff --git a/libraries/base/changelog.md b/libraries/base/changelog.md index b73e01e..d687e07 100644 --- a/libraries/base/changelog.md +++ b/libraries/base/changelog.md @@ -31,7 +31,7 @@ * Added `Eq1`, `Ord1`, `Read1` and `Show1` instances for `NonEmpty`. * Add wrappers for `blksize_t`, `blkcnt_t`, `clockid_t`, `fsblkcnt_t`, - `fsfilcnt_t`, `id_t`, and `key_t` to System.Posix.Types (#12795) + `fsfilcnt_t`, `id_t`, `key_t`, and `timer_t` to System.Posix.Types (#12795) * Raw buffer operations in `GHC.IO.FD` are now strict in the buffer, offset, and length operations (#9696) diff --git a/libraries/base/configure.ac b/libraries/base/configure.ac index c99c284..e6c8a9b 100644 --- a/libraries/base/configure.ac +++ b/libraries/base/configure.ac @@ -155,6 +155,7 @@ FPTOOLS_CHECK_HTYPE(fsblkcnt_t) FPTOOLS_CHECK_HTYPE(fsfilcnt_t) FPTOOLS_CHECK_HTYPE(id_t) FPTOOLS_CHECK_HTYPE(key_t) +FPTOOLS_CHECK_HTYPE(timer_t) FPTOOLS_CHECK_HTYPE(intptr_t) FPTOOLS_CHECK_HTYPE(uintptr_t) diff --git a/libraries/base/include/CTypes.h b/libraries/base/include/CTypes.h index 9fa1e4a..e9d19a8 100644 --- a/libraries/base/include/CTypes.h +++ b/libraries/base/include/CTypes.h @@ -19,6 +19,7 @@ #define ARITHMETIC_CLASSES Eq,Ord,Num,Enum,Storable,Real #define INTEGRAL_CLASSES Bounded,Integral,Bits,FiniteBits #define FLOATING_CLASSES Fractional,Floating,RealFrac,RealFloat +#define OPAQUE_CLASSES Eq,Ord,Storable #define ARITHMETIC_TYPE(T,B) \ newtype T = T B deriving (ARITHMETIC_CLASSES) \ @@ -42,4 +43,9 @@ newtype {-# CTYPE "THE_CTYPE" #-} T = T B \ deriving (ARITHMETIC_CLASSES, FLOATING_CLASSES) \ deriving newtype (Read, Show); +#define OPAQUE_TYPE_WITH_CTYPE(T,THE_CTYPE,B) \ +newtype {-# CTYPE "THE_CTYPE" #-} T = T (B) \ + deriving (OPAQUE_CLASSES) \ + deriving newtype Show; + #endif From git at git.haskell.org Sun Jan 15 16:56:13 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 15 Jan 2017 16:56:13 +0000 (UTC) Subject: [commit: ghc] master: Improve access violation reporting on Windows (c13151e) Message-ID: <20170115165613.D5AA43A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c13151e5ac774d38d7c5a807692851022c18fe6b/ghc >--------------------------------------------------------------- commit c13151e5ac774d38d7c5a807692851022c18fe6b Author: Ryan Scott Date: Sun Jan 15 11:54:41 2017 -0500 Improve access violation reporting on Windows Summary: This patch is courtesy of @awson. Currently, whenever GHC catches a segfault on Windows, it simply reports the somewhat uninformative message `Segmentation fault/access violation in generated code`. This patch adds to the message the type of violation (read/write/dep) and location information, which should help debugging segfaults in the future. Fixes #13108. Test Plan: Build on Windows Reviewers: austin, erikd, bgamari, simonmar, Phyx Reviewed By: bgamari, Phyx Subscribers: awson, thomie, #ghc_windows_task_force Differential Revision: https://phabricator.haskell.org/D2969 GHC Trac Issues: #13108 >--------------------------------------------------------------- c13151e5ac774d38d7c5a807692851022c18fe6b rts/win32/veh_excn.c | 8 +++++++- testsuite/tests/rts/all.T | 8 +++++++- testsuite/tests/rts/derefnull.stdout-i386-unknown-mingw32 | 2 +- testsuite/tests/rts/derefnull.stdout-x86_64-unknown-mingw32 | 2 +- 4 files changed, 16 insertions(+), 4 deletions(-) diff --git a/rts/win32/veh_excn.c b/rts/win32/veh_excn.c index bf2151a..c94dc5a 100644 --- a/rts/win32/veh_excn.c +++ b/rts/win32/veh_excn.c @@ -32,6 +32,7 @@ PVOID __hs_handle = NULL; long WINAPI __hs_exception_handler(struct _EXCEPTION_POINTERS *exception_data) { long action = EXCEPTION_CONTINUE_SEARCH; + ULONG_PTR what; // When the system unwinds the VEH stack after having handled an excn, // return immediately. @@ -49,7 +50,12 @@ long WINAPI __hs_exception_handler(struct _EXCEPTION_POINTERS *exception_data) action = EXCEPTION_CONTINUE_EXECUTION; break; case EXCEPTION_ACCESS_VIOLATION: - fprintf(stdout, "Segmentation fault/access violation in generated code\n"); + what = exception_data->ExceptionRecord->ExceptionInformation[0]; + fprintf(stdout, "Access violation in generated code" + " when %s %p\n" + , what == 0 ? "reading" : what == 1 ? "writing" : what == 8 ? "executing data at" : "?" + , (void*) exception_data->ExceptionRecord->ExceptionInformation[1] + ); action = EXCEPTION_CONTINUE_EXECUTION; break; default:; diff --git a/testsuite/tests/rts/all.T b/testsuite/tests/rts/all.T index cf8e904..14f0cec 100644 --- a/testsuite/tests/rts/all.T +++ b/testsuite/tests/rts/all.T @@ -13,6 +13,12 @@ test('testmblockalloc', # See bug #101, test requires +RTS -c (or equivalently +RTS -M) # only GHCi triggers the bug, but we run the test all ways for completeness. test('bug1010', normal, compile_and_run, ['+RTS -c -RTS']) + +def normalise_address(str): + return re.sub('Access violation in generated code when reading [0]+', + 'Access violation in generated code when reading ADDRESS', + str) + test('derefnull', [# LLVM Optimiser considers dereference of a null pointer # undefined and marks the code as unreachable which means @@ -29,7 +35,7 @@ test('derefnull', when(platform('i386-apple-darwin'), [ignore_stderr, exit_code(139)]), when(platform('x86_64-apple-darwin'), [ignore_stderr, exit_code(139)]), when(platform('powerpc-apple-darwin'), [ignore_stderr, exit_code(139)]), - when(opsys('mingw32'), exit_code(1)), + when(opsys('mingw32'), [exit_code(1), normalise_fun(normalise_address)]), # since these test are supposed to crash the # profile report will be empty always. # so disable the check for profiling diff --git a/testsuite/tests/rts/derefnull.stdout-i386-unknown-mingw32 b/testsuite/tests/rts/derefnull.stdout-i386-unknown-mingw32 index 5f2034d..4541b7f 100644 --- a/testsuite/tests/rts/derefnull.stdout-i386-unknown-mingw32 +++ b/testsuite/tests/rts/derefnull.stdout-i386-unknown-mingw32 @@ -1 +1 @@ -Segmentation fault/access violation in generated code +Access violation in generated code when reading ADDRESS diff --git a/testsuite/tests/rts/derefnull.stdout-x86_64-unknown-mingw32 b/testsuite/tests/rts/derefnull.stdout-x86_64-unknown-mingw32 index 5f2034d..4541b7f 100644 --- a/testsuite/tests/rts/derefnull.stdout-x86_64-unknown-mingw32 +++ b/testsuite/tests/rts/derefnull.stdout-x86_64-unknown-mingw32 @@ -1 +1 @@ -Segmentation fault/access violation in generated code +Access violation in generated code when reading ADDRESS From git at git.haskell.org Sun Jan 15 17:34:36 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 15 Jan 2017 17:34:36 +0000 (UTC) Subject: [commit: ghc] master: Revert "Record evaluated-ness on workers and wrappers" (1f48fbc) Message-ID: <20170115173436.DAE9C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1f48fbc9cda8c61ff0c032b683377dc23697079d/ghc >--------------------------------------------------------------- commit 1f48fbc9cda8c61ff0c032b683377dc23697079d Author: Matthew Pickering Date: Sun Jan 15 17:33:30 2017 +0000 Revert "Record evaluated-ness on workers and wrappers" This reverts commit 6b976eb89fe72827f226506d16d3721ba4e28bab. Ben, Ryan and I decided to revert this for now due to T12234 failing and causing all harbormaster builds to fail. >--------------------------------------------------------------- 1f48fbc9cda8c61ff0c032b683377dc23697079d compiler/basicTypes/Id.hs | 13 +---- compiler/coreSyn/CoreUtils.hs | 6 ++- compiler/simplCore/Simplify.hs | 12 +++-- compiler/stranal/WwLib.hs | 107 +++++++++-------------------------------- 4 files changed, 37 insertions(+), 101 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 1f48fbc9cda8c61ff0c032b683377dc23697079d From git at git.haskell.org Sun Jan 15 19:18:38 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 15 Jan 2017 19:18:38 +0000 (UTC) Subject: [commit: ghc] master: LLVM: Tweak TBAA metadata codegen (9d67f04) Message-ID: <20170115191838.C9D2F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9d67f04d4892ea399631fd67ce91782b821a127e/ghc >--------------------------------------------------------------- commit 9d67f04d4892ea399631fd67ce91782b821a127e Author: Erik de Castro Lopo Date: Mon Jan 16 06:17:17 2017 +1100 LLVM: Tweak TBAA metadata codegen This change is requred for llvm 4.0. GHC doesn't use that version yet, but this change is just as valid for versions eariler than 4.0. Two changes needed: * Previously, GHC defined a `topN` node in the TBAA heiarchy and some IR instructions referenced that node. With LLVM 4.0 the root node can no longer be referenced by IR instructions, so we introduce a new element `rootN` and make `topN` a child of that. * Previously the root TBAA node was rendered as "!0 = !{!"root", null}". With LLVM 4.0 that needs to be "!0 = !{!"root"}" which is also accepted by earlier versions. Test Plan: Build with quick-llvm BuildFlavor and run tests Reviewers: bgamari, drbo, austin, angerman, michalt, DemiMarie Reviewed By: DemiMarie Subscribers: mpickering, DemiMarie, thomie Differential Revision: https://phabricator.haskell.org/D2975 >--------------------------------------------------------------- 9d67f04d4892ea399631fd67ce91782b821a127e compiler/llvmGen/LlvmCodeGen.hs | 13 +++++++------ compiler/llvmGen/LlvmCodeGen/Regs.hs | 9 +++++++-- 2 files changed, 14 insertions(+), 8 deletions(-) diff --git a/compiler/llvmGen/LlvmCodeGen.hs b/compiler/llvmGen/LlvmCodeGen.hs index c240d09..5596d59 100644 --- a/compiler/llvmGen/LlvmCodeGen.hs +++ b/compiler/llvmGen/LlvmCodeGen.hs @@ -188,12 +188,13 @@ cmmMetaLlvmPrelude = do setUniqMeta uniq tbaaId parentId <- maybe (return Nothing) getUniqMeta parent -- Build definition - return $ MetaUnnamed tbaaId $ MetaStruct - [ MetaStr name - , case parentId of - Just p -> MetaNode p - Nothing -> MetaVar $ LMLitVar $ LMNullLit i8Ptr - ] + return $ MetaUnnamed tbaaId $ MetaStruct $ + case parentId of + Just p -> [ MetaStr name, MetaNode p ] + -- As of LLVM 4.0, a node without parents should be rendered as + -- just a name on its own. Previously `null` was accepted as the + -- name. + Nothing -> [ MetaStr name ] renderLlvm $ ppLlvmMetas metas -- ----------------------------------------------------------------------------- diff --git a/compiler/llvmGen/LlvmCodeGen/Regs.hs b/compiler/llvmGen/LlvmCodeGen/Regs.hs index 186eda3..e09ab80 100644 --- a/compiler/llvmGen/LlvmCodeGen/Regs.hs +++ b/compiler/llvmGen/LlvmCodeGen/Regs.hs @@ -97,7 +97,8 @@ alwaysLive = [BaseReg, Sp, Hp, SpLim, HpLim, node] -- | STG Type Based Alias Analysis hierarchy stgTBAA :: [(Unique, LMString, Maybe Unique)] stgTBAA - = [ (topN, fsLit "top", Nothing) + = [ (rootN, fsLit "root", Nothing) + , (topN, fsLit "top", Just rootN) , (stackN, fsLit "stack", Just topN) , (heapN, fsLit "heap", Just topN) , (rxN, fsLit "rx", Just heapN) @@ -109,7 +110,11 @@ stgTBAA ] -- | Id values -topN, stackN, heapN, rxN, baseN :: Unique +-- The `rootN` node is the root (there can be more than one) of the TBAA +-- hierarchy and as of LLVM 4.0 should *only* be referenced by other nodes. It +-- should never occur in any LLVM instruction statement. +rootN, topN, stackN, heapN, rxN, baseN :: Unique +rootN = getUnique (fsLit "LlvmCodeGen.Regs.rootN") topN = getUnique (fsLit "LlvmCodeGen.Regs.topN") stackN = getUnique (fsLit "LlvmCodeGen.Regs.stackN") heapN = getUnique (fsLit "LlvmCodeGen.Regs.heapN") From git at git.haskell.org Sun Jan 15 19:38:20 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 15 Jan 2017 19:38:20 +0000 (UTC) Subject: [commit: ghc] master: Add dump-parsed-ast flag and functionality (1ff3c58) Message-ID: <20170115193820.918863A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1ff3c5882427d704538250e6fdadd6f48bb08989/ghc >--------------------------------------------------------------- commit 1ff3c5882427d704538250e6fdadd6f48bb08989 Author: Alan Zimmerman Date: Wed Jan 11 11:57:35 2017 +0200 Add dump-parsed-ast flag and functionality Summary: This flag causes a dump of the ParsedSource as an AST in textual form, similar to the ghc-dump-tree on hackage. Test Plan: ./validate Reviewers: mpickering, bgamari, austin Reviewed By: mpickering Subscribers: nominolo, thomie Differential Revision: https://phabricator.haskell.org/D2958 GHC Trac Issues: #11140 >--------------------------------------------------------------- 1ff3c5882427d704538250e6fdadd6f48bb08989 compiler/ghc.cabal.in | 1 + compiler/hsSyn/HsDumpAst.hs | 192 ++++++++++++ compiler/main/DynFlags.hs | 3 + compiler/main/HscMain.hs | 11 +- docs/users_guide/debugging.rst | 4 + .../should_compile/{T10188.hs => DumpParsedAst.hs} | 2 +- .../parser/should_compile/DumpParsedAst.stderr | 329 +++++++++++++++++++++ testsuite/tests/parser/should_compile/all.T | 1 + utils/check-ppr/Main.hs | 138 +-------- 9 files changed, 543 insertions(+), 138 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 1ff3c5882427d704538250e6fdadd6f48bb08989 From git at git.haskell.org Mon Jan 16 08:12:21 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 16 Jan 2017 08:12:21 +0000 (UTC) Subject: [commit: ghc] master: Add missing test files for T13082. (4bfe3d4) Message-ID: <20170116081221.5C4B13A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4bfe3d4d13806202be7fc4a90106b200171588e6/ghc >--------------------------------------------------------------- commit 4bfe3d4d13806202be7fc4a90106b200171588e6 Author: Tamar Christina Date: Mon Jan 16 03:11:44 2017 +0000 Add missing test files for T13082. Summary: Add two missing test files for T13082. The reason they were missing is because the .gitignore contains a very harmful and broad wildcard `foo*`. Why? Test Plan: make test TEST="T13082_good T13082_fail" Reviewers: austin, bgamari, simonmar, erikd Reviewed By: erikd Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2981 GHC Trac Issues: #13082 >--------------------------------------------------------------- 4bfe3d4d13806202be7fc4a90106b200171588e6 testsuite/tests/rts/{T12771 => T13082}/foo.c | 0 testsuite/tests/rts/{T12771 => T13082}/foo_dll.c | 0 2 files changed, 0 insertions(+), 0 deletions(-) diff --git a/testsuite/tests/rts/T12771/foo.c b/testsuite/tests/rts/T13082/foo.c similarity index 100% copy from testsuite/tests/rts/T12771/foo.c copy to testsuite/tests/rts/T13082/foo.c diff --git a/testsuite/tests/rts/T12771/foo_dll.c b/testsuite/tests/rts/T13082/foo_dll.c similarity index 100% copy from testsuite/tests/rts/T12771/foo_dll.c copy to testsuite/tests/rts/T13082/foo_dll.c From git at git.haskell.org Mon Jan 16 08:14:58 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 16 Jan 2017 08:14:58 +0000 (UTC) Subject: [commit: ghc] master: Unbreak libGHCi by adding missing symbol. (be79289) Message-ID: <20170116081458.074173A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/be79289037138d4f6447c21f65e80adf2acd65f7/ghc >--------------------------------------------------------------- commit be79289037138d4f6447c21f65e80adf2acd65f7 Author: Tamar Christina Date: Mon Jan 16 08:14:28 2017 +0000 Unbreak libGHCi by adding missing symbol. Summary: Someone committed a new public symbol `purgeObj` again without adding it to the symbols table. Test Plan: ./validate Reviewers: austin, bgamari, simonmar, erikd Reviewed By: erikd Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2980 >--------------------------------------------------------------- be79289037138d4f6447c21f65e80adf2acd65f7 rts/RtsSymbols.c | 1 + 1 file changed, 1 insertion(+) diff --git a/rts/RtsSymbols.c b/rts/RtsSymbols.c index 4c21c2a..be61388 100644 --- a/rts/RtsSymbols.c +++ b/rts/RtsSymbols.c @@ -637,6 +637,7 @@ SymI_HasProto(stg_killThreadzh) \ SymI_HasProto(loadArchive) \ SymI_HasProto(loadObj) \ + SymI_HasProto(purgeObj) \ SymI_HasProto(insertSymbol) \ SymI_HasProto(lookupSymbol) \ SymI_HasProto(stg_makeStablePtrzh) \ From git at git.haskell.org Mon Jan 16 16:03:27 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 16 Jan 2017 16:03:27 +0000 (UTC) Subject: [commit: ghc] master: Refine exprOkForSpeculation (5a9a173) Message-ID: <20170116160327.605533A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5a9a1738023aeb742e537fb4a59c4aa8fecc1f8a/ghc >--------------------------------------------------------------- commit 5a9a1738023aeb742e537fb4a59c4aa8fecc1f8a Author: Simon Peyton Jones Date: Fri Jan 13 14:20:15 2017 +0000 Refine exprOkForSpeculation This patch implements two related changes, both inspired by the discussion on Trac #13027, comment:23: * exprOkForSpeculation (op# a1 .. an), where op# is a primop, now skips over arguments ai of lifted type. See the comments at Note [Primops with lifted arguments] in CoreUtils. There is no need to treat dataToTag# specially any more. * dataToTag# is now treated as a can-fail primop. See Note [dataToTag#] in primops.txt.pp I don't expect this to have a visible effect on anything, but it's much more solid than before. >--------------------------------------------------------------- 5a9a1738023aeb742e537fb4a59c4aa8fecc1f8a compiler/coreSyn/CoreUtils.hs | 75 +++++++++++++++++++++++++---------------- compiler/prelude/primops.txt.pp | 30 +++++++++++++++-- 2 files changed, 73 insertions(+), 32 deletions(-) diff --git a/compiler/coreSyn/CoreUtils.hs b/compiler/coreSyn/CoreUtils.hs index 60024c5..bad322d 100644 --- a/compiler/coreSyn/CoreUtils.hs +++ b/compiler/coreSyn/CoreUtils.hs @@ -68,6 +68,7 @@ import PrimOp import Id import IdInfo import Type +import TyCoRep( TyBinder(..) ) import Coercion import TyCon import Unique @@ -1286,18 +1287,19 @@ app_ok primop_ok fun args -- to take the arguments into account PrimOpId op - | isDivOp op -- Special case for dividing operations that fail - , [arg1, Lit lit] <- args -- only if the divisor is zero + | isDivOp op + , [arg1, Lit lit] <- args -> not (isZeroLit lit) && expr_ok primop_ok arg1 - -- Often there is a literal divisor, and this - -- can get rid of a thunk in an inner looop - - | DataToTagOp <- op -- See Note [dataToTag speculation] - -> True + -- Special case for dividing operations that fail + -- In general they are NOT ok-for-speculation + -- (which primop_ok will catch), but they ARE OK + -- if the divisor is definitely non-zero. + -- Often there is a literal divisor, and this + -- can get rid of a thunk in an inner looop | otherwise - -> primop_ok op -- A bit conservative: we don't really need - && all (expr_ok primop_ok) args -- to care about lazy arguments, but this is easy + -> primop_ok op -- Check the primop itself + && and (zipWith arg_ok arg_tys args) -- Check the arguments _other -> isUnliftedType (idType fun) -- c.f. the Var case of exprIsHNF || idArity fun > n_val_args -- Partial apps @@ -1305,6 +1307,14 @@ app_ok primop_ok fun args isEvaldUnfolding (idUnfolding fun)) -- Let-bound values where n_val_args = valArgCount args + where + (arg_tys, _) = splitPiTys (idType fun) + + arg_ok :: TyBinder -> Expr b -> Bool + arg_ok (Named _) _ = True -- A type argument + arg_ok (Anon ty) arg -- A term argument + | isUnliftedType ty = expr_ok primop_ok arg + | otherwise = True -- See Note [Primops with lifted arguments] ----------------------------- altsAreExhaustive :: [Alt b] -> Bool @@ -1386,26 +1396,33 @@ One could try to be clever, but the easy fix is simpy to regard a non-exhaustive case as *not* okForSpeculation. -Note [dataToTag speculation] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Is this OK? - f x = let v::Int# = dataToTag# x - in ... -We say "yes", even though 'x' may not be evaluated. Reasons - - * dataToTag#'s strictness means that its argument often will be - evaluated, but FloatOut makes that temporarily untrue - case x of y -> let v = dataToTag# y in ... - --> - case x of y -> let v = dataToTag# x in ... - Note that we look at 'x' instead of 'y' (this is to improve - floating in FloatOut). So Lint complains. - - Moreover, it really *might* improve floating to let the - v-binding float out - - * CorePrep makes sure dataToTag#'s argument is evaluated, just - before code gen. Until then, it's not guaranteed +Note [Primops with lifted arguments] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Is this ok-for-speculation (see Trac #13027)? + reallyUnsafePtrEq# a b +Well, yes. The primop accepts lifted arguments and does not +evaluate them. Indeed, in general primops are, well, primitive +and do not perform evaluation. + +There is one primop, dataToTag#, which does /require/ a lifted +argument to be evaluted. To ensure this, CorePrep adds an +eval if it can't see the the argument is definitely evaluated +(see [dataToTag magic] in CorePrep). + +We make no attempt to guarantee that dataToTag#'s argument is +evaluated here. Main reason: it's very fragile to test for the +evaluatedness of a lifted argument. Consider + case x of y -> let v = dataToTag# y in ... + +where x/y have type Int, say. 'y' looks evaluated (by the enclosing +case) so all is well. Now the FloatOut pass does a binder-swap (for +very good reasons), changing to + case x of y -> let v = dataToTag# x in ... + +See also Note [dataToTag#] in primops.txt.pp. + +Bottom line: + * in exprOkForSpeculation we simply ignore all lifted arguments. ************************************************************************ diff --git a/compiler/prelude/primops.txt.pp b/compiler/prelude/primops.txt.pp index 15fb785..a69ba97 100644 --- a/compiler/prelude/primops.txt.pp +++ b/compiler/prelude/primops.txt.pp @@ -2592,13 +2592,37 @@ section "Tag to enum stuff" primop DataToTagOp "dataToTag#" GenPrimOp a -> Int# with - strictness = { \ _arity -> mkClosedStrictSig [evalDmd] topRes } - - -- dataToTag# must have an evaluated argument + can_fail = True -- See Note [dataToTag#] + strictness = { \ _arity -> mkClosedStrictSig [evalDmd] topRes } + -- dataToTag# must have an evaluated argument primop TagToEnumOp "tagToEnum#" GenPrimOp Int# -> a +{- Note [dataToTag#] +~~~~~~~~~~~~~~~~~~~~ +The dataToTag# primop should always be applied to an evaluated argument. +The way to ensure this is to invoke it via the 'getTag' wrapper in GHC.Base: + getTag :: a -> Int# + getTag !x = dataToTag# x + +But now consider + \z. case x of y -> let v = dataToTag# y in ... + +To improve floating, the FloatOut pass (deliberately) does a +binder-swap on the case, to give + \z. case x of y -> let v = dataToTag# x in ... + +Now FloatOut might float that v-binding outside the \z. But that is +bad because that might mean x gest evaluated much too early! (CorePrep +adds an eval to a dataToTag# call, to ensure that the agument really is +evaluated; see CorePrep Note [dataToTag magic].) + +Solution: make DataToTag into a can_fail primop. That will stop it floating +(see Note [PrimOp can_fail and has_side_effects] in PrimOp). It's a bit of +a hack but never mind. +-} + ------------------------------------------------------------------------ section "Bytecode operations" {Support for manipulating bytecode objects used by the interpreter and From git at git.haskell.org Mon Jan 16 16:03:30 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 16 Jan 2017 16:03:30 +0000 (UTC) Subject: [commit: ghc] master: Comments about TyBinders (only) (563d64f) Message-ID: <20170116160330.128163A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/563d64fd067219a0e42c5f1c83830d2847243f6f/ghc >--------------------------------------------------------------- commit 563d64fd067219a0e42c5f1c83830d2847243f6f Author: Simon Peyton Jones Date: Fri Jan 13 15:58:06 2017 +0000 Comments about TyBinders (only) >--------------------------------------------------------------- 563d64fd067219a0e42c5f1c83830d2847243f6f compiler/types/TyCoRep.hs | 13 +++++-------- 1 file changed, 5 insertions(+), 8 deletions(-) diff --git a/compiler/types/TyCoRep.hs b/compiler/types/TyCoRep.hs index 63aba3c..ef6917a 100644 --- a/compiler/types/TyCoRep.hs +++ b/compiler/types/TyCoRep.hs @@ -409,8 +409,9 @@ same kinds. -- ('Named') or nondependent ('Anon'). They may also be visible or not. -- See Note [TyBinders] data TyBinder - = Named TyVarBinder - | Anon Type -- Visibility is determined by the type (Constraint vs. *) + = Named TyVarBinder -- A type-lambda binder + | Anon Type -- A term-lambda binder + -- Visibility is determined by the type (Constraint vs. *) deriving Data.Data -- | Remove the binder's variable from the set, if the binder has @@ -437,7 +438,7 @@ A TyBinder represents the type of binders -- that is, the type of an argument to a Pi-type. GHC Core currently supports two different Pi-types: - * A non-dependent function, + * A non-dependent function type, written with ->, e.g. ty1 -> ty2 represented as FunTy ty1 ty2 @@ -447,12 +448,8 @@ Pi-types: Both Pi-types classify terms/types that take an argument. In other words, if `x` is either a function or a polytype, `x arg` makes sense -(for an appropriate `arg`). It is thus often convenient to group -Pi-types together. This is ForAllTy. +(for an appropriate `arg`). -The two constructors for TyBinder sort out the two different possibilities. -`Named` builds a polytype, while `Anon` builds an ordinary function. -(ForAllTy (Anon arg) res used to be called FunTy arg res.) Note [TyBinders and ArgFlags] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ From git at git.haskell.org Tue Jan 17 10:28:11 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 17 Jan 2017 10:28:11 +0000 (UTC) Subject: [commit: ghc] master: Typos in manual and comments [ci skip] (715be01) Message-ID: <20170117102811.2F8353A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/715be013d40511771bb760647e4aff1b165ddd21/ghc >--------------------------------------------------------------- commit 715be013d40511771bb760647e4aff1b165ddd21 Author: Gabor Greif Date: Tue Jan 17 11:25:49 2017 +0100 Typos in manual and comments [ci skip] >--------------------------------------------------------------- 715be013d40511771bb760647e4aff1b165ddd21 compiler/codeGen/StgCmmClosure.hs | 2 +- compiler/simplCore/CallArity.hs | 2 +- compiler/specialise/Specialise.hs | 4 ++-- docs/users_guide/bugs.rst | 4 ++-- docs/users_guide/glasgow_exts.rst | 2 +- 5 files changed, 7 insertions(+), 7 deletions(-) diff --git a/compiler/codeGen/StgCmmClosure.hs b/compiler/codeGen/StgCmmClosure.hs index 1943dc4..7b9813a 100644 --- a/compiler/codeGen/StgCmmClosure.hs +++ b/compiler/codeGen/StgCmmClosure.hs @@ -828,7 +828,7 @@ we run into issues like Trac #10414. Specifically: * It is dangerous to black-hole a non-updatable thunk because - is not updated (of course) - - hence, if it is black-holed and another thread tries to evalute + - hence, if it is black-holed and another thread tries to evaluate it, that thread will block forever This actually happened in Trac #10414. So we do not black-hole non-updatable thunks. diff --git a/compiler/simplCore/CallArity.hs b/compiler/simplCore/CallArity.hs index ffdd4b5..c051dae 100644 --- a/compiler/simplCore/CallArity.hs +++ b/compiler/simplCore/CallArity.hs @@ -115,7 +115,7 @@ Note [Analysis II: The Co-Called analysis] ------------------------------------------ The second part is more sophisticated. For reasons explained below, it is not -sufficient to simply know how often an expression evalutes a variable. Instead +sufficient to simply know how often an expression evaluates a variable. Instead we need to know which variables are possibly called together. The data structure here is an undirected graph of variables, which is provided diff --git a/compiler/specialise/Specialise.hs b/compiler/specialise/Specialise.hs index 257d076..a2b1604 100644 --- a/compiler/specialise/Specialise.hs +++ b/compiler/specialise/Specialise.hs @@ -1784,8 +1784,8 @@ This makes b), c), d) trivial and pushes a) towards the end. The deduplication is done by using a TrieMap for membership tests on CallKey. This lets us delete the nondeterministic Ord CallKey instance. -An alternative approach would be to augument the Map the same way that UniqDFM -is augumented, by keeping track of insertion order and using it to order the +An alternative approach would be to augment the Map the same way that UniqDFM +is augmented, by keeping track of insertion order and using it to order the resulting lists. It would mean keeping the nondeterministic Ord CallKey instance making it easy to reintroduce nondeterminism in the future. -} diff --git a/docs/users_guide/bugs.rst b/docs/users_guide/bugs.rst index c1527f1..9b60e54 100644 --- a/docs/users_guide/bugs.rst +++ b/docs/users_guide/bugs.rst @@ -472,7 +472,7 @@ Bugs in GHC .. code-block:: none ghc: panic! (the 'impossible' happened) - (GHC version 7.10.1 for x86_64-unknown-linux): + (GHC version 8.2.1 for x86_64-unknown-linux): Simplifier ticks exhausted When trying UnfoldingDone x_alB To increase the limit, use -fsimpl-tick-factor=N (default 100) @@ -541,7 +541,7 @@ Bugs in GHC unexpected results. See :ghc-ticket:`11715` for one example. - Because of a toolchain limitation we are unable to support full Unicode paths - on WIndows. On Windows we support up to Latin-1. See :ghc-ticket:`12971` for more. + on Windows. On Windows we support up to Latin-1. See :ghc-ticket:`12971` for more. .. _bugs-ghci: diff --git a/docs/users_guide/glasgow_exts.rst b/docs/users_guide/glasgow_exts.rst index e21a975..103d6ac 100644 --- a/docs/users_guide/glasgow_exts.rst +++ b/docs/users_guide/glasgow_exts.rst @@ -11564,7 +11564,7 @@ optionally had by adding ``!`` in front of a variable. case x of !y -> rhs - which evalutes ``x``. Similarly, if ``newtype Age = MkAge Int``, then :: + which evaluates ``x``. Similarly, if ``newtype Age = MkAge Int``, then :: case x of MkAge i -> rhs From git at git.haskell.org Tue Jan 17 18:15:32 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 17 Jan 2017 18:15:32 +0000 (UTC) Subject: [commit: ghc] master: Fix API Annotations for unboxed sums (38f289f) Message-ID: <20170117181532.67A1E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/38f289fa2a8715d2d5869e144b764c35cba16c6a/ghc >--------------------------------------------------------------- commit 38f289fa2a8715d2d5869e144b764c35cba16c6a Author: Alan Zimmerman Date: Tue Jan 10 20:16:34 2017 +0200 Fix API Annotations for unboxed sums An unboxed tuple such as (# | b | | | | | #) Ends up in the parser via `tup_exprs` as Sum 2 7 lexp where `lexp` is a `LHsExpr` From an API annotation perspective, the 5 `AnnVbar`s after the `b` were attached to `lexp`, but the leading `AnnVbar`s did not have a home. This patch attaches them all to the the parent tuple expression. The first (alt - 1) of them come before `lexp`, and the remaining (arity - alt) come after. Test Plan: ./validate Reviewers: osa1, austin, bgamari Subscribers: thomie, mpickering Differential Revision: https://phabricator.haskell.org/D2968 GHC Trac Issues: #12417 >--------------------------------------------------------------- 38f289fa2a8715d2d5869e144b764c35cba16c6a compiler/hsSyn/HsExpr.hs | 11 +++- compiler/parser/Parser.y | 27 ++++----- testsuite/driver/extra_files.py | 1 + testsuite/tests/ghc-api/annotations/Makefile | 4 ++ testsuite/tests/ghc-api/annotations/T12417.stdout | 68 +++++++++++++++++++++++ testsuite/tests/ghc-api/annotations/Test12417.hs | 19 +++++++ testsuite/tests/ghc-api/annotations/all.T | 1 + 7 files changed, 116 insertions(+), 15 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 38f289fa2a8715d2d5869e144b764c35cba16c6a From git at git.haskell.org Tue Jan 17 21:37:39 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 17 Jan 2017 21:37:39 +0000 (UTC) Subject: [commit: ghc] master: Some 8.2.1 release notes for my stuff (e7e5f7a) Message-ID: <20170117213739.177FD3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e7e5f7accbb7d9a12aee5d1468371a8ba09b598d/ghc >--------------------------------------------------------------- commit e7e5f7accbb7d9a12aee5d1468371a8ba09b598d Author: Simon Marlow Date: Tue Jan 17 15:48:37 2017 -0500 Some 8.2.1 release notes for my stuff Test Plan: Built it and looked at it Reviewers: niteria, erikd, dfeuer, austin, hvr, bgamari Reviewed By: bgamari Subscribers: dfeuer, thomie, erikd Differential Revision: https://phabricator.haskell.org/D2959 >--------------------------------------------------------------- e7e5f7accbb7d9a12aee5d1468371a8ba09b598d configure.ac | 1 + docs/users_guide/8.2.1-notes.rst | 23 +++++++++++++++++++++-- docs/users_guide/ghc_config.py.in | 1 + docs/users_guide/sooner.rst | 10 +++++----- 4 files changed, 28 insertions(+), 7 deletions(-) diff --git a/configure.ac b/configure.ac index 7dcde09..b3d2e17 100644 --- a/configure.ac +++ b/configure.ac @@ -1122,6 +1122,7 @@ AC_SUBST(BUILD_SPHINX_PDF) LIBRARY_VERSION(base) LIBRARY_VERSION(Cabal, Cabal/Cabal) LIBRARY_VERSION(ghc-prim) +LIBRARY_VERSION(compact) LIBRARY_ghc_VERSION="$ProjectVersion" AC_SUBST(LIBRARY_ghc_VERSION) diff --git a/docs/users_guide/8.2.1-notes.rst b/docs/users_guide/8.2.1-notes.rst index 2c237db..c5e3cb6 100644 --- a/docs/users_guide/8.2.1-notes.rst +++ b/docs/users_guide/8.2.1-notes.rst @@ -151,13 +151,32 @@ Template Haskell Runtime system ~~~~~~~~~~~~~~ -- TODO FIXME. +- TODO FIXME. + +- Added support for *Compact Regions*, which offer a way to manually + move long-lived data outside of the heap so that the garbage + collector does not have to trace it repeatedly. Compacted data can + also be serialized, stored, and deserialized again later by the same + program. For more details see the :compact-ref:`Data.Compact + ` module. + +- There is new support for improving performance on machines with a + Non-Uniform Memory Architecture (NUMA). See :rts-flag:`--numa`. + This is supported on Linux and Windows systems. + +- The garbage collector can be told to use fewer threads than the + global number of capabilities set by :rts-flag:`-N`. See + :rts-flag:`-qn`, and a `blog post + `_ + that describes this. - The :ref:`heap profiler ` can now emit heap census data to the GHC event log, allowing heap profiles to be correlated with other tracing events (see :ghc-ticket:`11094`). -- Added NUMA support to Windows. +- Some bugs have been fixed in the stack-trace implementation in the + profiler that sometimes resulted in incorrect stack traces and + costs attributed to the wrong cost centre stack (see :ghc-ticket:`5654`). - Added processor group support for Windows. This allows the runtime to allocate threads to all cores in systems which have multiple processor groups. diff --git a/docs/users_guide/ghc_config.py.in b/docs/users_guide/ghc_config.py.in index 41aee8d..e2783e4 100644 --- a/docs/users_guide/ghc_config.py.in +++ b/docs/users_guide/ghc_config.py.in @@ -1,6 +1,7 @@ extlinks = { 'base-ref': ('../libraries/base- at LIBRARY_base_VERSION@/%s', ''), 'cabal-ref': ('../libraries/Cabal- at LIBRARY_Cabal_VERSION@/%s', ''), + 'compact-ref': ('../libraries/compact- at LIBRARY_compact_VERSION@/%s', ''), 'ghc-prim-ref': ('../libraries/ghc-prim- at LIBRARY_ghc_prim_VERSION@/%s', ''), 'ghc-ticket': ('http://ghc.haskell.org/trac/ghc/ticket/%s', 'Trac #'), 'ghc-wiki': ('http://ghc.haskell.org/trac/ghc/wiki/%s', 'Trac #'), diff --git a/docs/users_guide/sooner.rst b/docs/users_guide/sooner.rst index 8b7a985..702648f 100644 --- a/docs/users_guide/sooner.rst +++ b/docs/users_guide/sooner.rst @@ -312,11 +312,11 @@ Use a bigger heap! calculate a value based on the amount of live data. Compact your data: - The ``Data.Compact`` library (in the ``compact`` package) provides - a way to make garbage collection more efficient for long-lived - data structures. Compacting a data structure collects the objects - together in memory, where they are treated as a single object by - the garbage collector and not traversed individually. + The :compact-ref:`Data.Compact ` module + provides a way to make garbage collection more efficient for + long-lived data structures. Compacting a data structure collects + the objects together in memory, where they are treated as a single + object by the garbage collector and not traversed individually. .. _smaller: From git at git.haskell.org Tue Jan 17 21:37:41 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 17 Jan 2017 21:37:41 +0000 (UTC) Subject: [commit: ghc] master: Bitmap: Use foldl' instead of foldr (b1726c1) Message-ID: <20170117213741.C35D93A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b1726c1194f1ed35dffc83304260b3b29abd0c53/ghc >--------------------------------------------------------------- commit b1726c1194f1ed35dffc83304260b3b29abd0c53 Author: Ben Gamari Date: Wed Jan 11 16:33:40 2017 -0500 Bitmap: Use foldl' instead of foldr These are producing StgWords so foldl' is the natural choice. I'm not sure how I didn't notice this when I wrote D1041. Test Plan: Validate Reviewers: austin, simonmar Reviewed By: simonmar Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2955 GHC Trac Issues: #7450 >--------------------------------------------------------------- b1726c1194f1ed35dffc83304260b3b29abd0c53 compiler/cmm/Bitmap.hs | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/compiler/cmm/Bitmap.hs b/compiler/cmm/Bitmap.hs index 22ec6ee..a5cff38 100644 --- a/compiler/cmm/Bitmap.hs +++ b/compiler/cmm/Bitmap.hs @@ -22,6 +22,7 @@ import SMRep import DynFlags import Util +import Data.Foldable (foldl') import Data.Bits {-| @@ -39,7 +40,10 @@ mkBitmap dflags stuff = chunkToBitmap dflags chunk : mkBitmap dflags rest chunkToBitmap :: DynFlags -> [Bool] -> StgWord chunkToBitmap dflags chunk = - foldr (.|.) (toStgWord dflags 0) [ toStgWord dflags 1 `shiftL` n | (True,n) <- zip chunk [0..] ] + foldl' (.|.) (toStgWord dflags 0) [ oneAt n | (True,n) <- zip chunk [0..] ] + where + oneAt :: Int -> StgWord + oneAt i = toStgWord dflags 1 `shiftL` i -- | Make a bitmap where the slots specified are the /ones/ in the bitmap. -- eg. @[0,1,3], size 4 ==> 0xb at . @@ -61,7 +65,7 @@ intsToBitmap dflags size = go 0 go !pos slots | size <= pos = [] | otherwise = - (foldr (.|.) (toStgWord dflags 0) (map (\i->oneAt (i - pos)) these)) : + (foldl' (.|.) (toStgWord dflags 0) (map (\i->oneAt (i - pos)) these)) : go (pos + word_sz) rest where (these,rest) = span (< (pos + word_sz)) slots @@ -87,7 +91,7 @@ intsToReverseBitmap dflags size = go 0 go !pos slots | size <= pos = [] | otherwise = - (foldr xor (toStgWord dflags init) (map (\i->oneAt (i - pos)) these)) : + (foldl' xor (toStgWord dflags init) (map (\i->oneAt (i - pos)) these)) : go (pos + word_sz) rest where (these,rest) = span (< (pos + word_sz)) slots From git at git.haskell.org Tue Jan 17 21:37:44 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 17 Jan 2017 21:37:44 +0000 (UTC) Subject: [commit: ghc] master: event manager: Don't worry if attempt to wake dead manager fails (d5cd505) Message-ID: <20170117213744.723FC3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d5cd505bc484edee3dbd5d41fb7a27c2e18d528d/ghc >--------------------------------------------------------------- commit d5cd505bc484edee3dbd5d41fb7a27c2e18d528d Author: Ben Gamari Date: Tue Jan 17 15:52:37 2017 -0500 event manager: Don't worry if attempt to wake dead manager fails This fixes #12038, where the TimerManager would attempt to wake up a manager that was already dead, resulting in setnumcapabilities001 occassionally failing during shutdown with unexpected output on stderr. I'm frankly still not entirely confident in this solution but perhaps it will help to get a few more eyes on this. My hypothesis is that the TimerManager is racing: thread TimerManager worker ------- -------------------- requests that thread manager shuts down begins to clean up, closing eventfd calls wakeManager, which tries to write to closed eventfd To prevent this `wakeManager` will need to synchronize with the TimerManger worker to ensure that the worker doesn't clean up the `Control` while another thread is trying to send a wakeup. However, this would add a bit of overhead on every timer interaction, which feels rather costly for what is really a problem only at shutdown. Moreover, it seems that the event manager (e.g. `GHC.Event.Manager`) is also afflicted by a similar race. This patch instead simply tries to catch the write failure after it has happened and silence it in the case that the fd has vanished. It feels rather hacky but it seems to work. Test Plan: Run `setnumcapabilities001` repeatedly Reviewers: hvr, austin, simonmar Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2957 GHC Trac Issues: #12038 >--------------------------------------------------------------- d5cd505bc484edee3dbd5d41fb7a27c2e18d528d libraries/base/GHC/Event/Control.hs | 32 +++++++++++++++++++++++++------- 1 file changed, 25 insertions(+), 7 deletions(-) diff --git a/libraries/base/GHC/Event/Control.hs b/libraries/base/GHC/Event/Control.hs index 0b0f558..9e3940a 100644 --- a/libraries/base/GHC/Event/Control.hs +++ b/libraries/base/GHC/Event/Control.hs @@ -30,11 +30,12 @@ module GHC.Event.Control import Foreign.ForeignPtr (ForeignPtr) import GHC.Base +import GHC.IORef import GHC.Conc.Signal (Signal) import GHC.Real (fromIntegral) import GHC.Show (Show) import GHC.Word (Word8) -import Foreign.C.Error (throwErrnoIfMinus1_) +import Foreign.C.Error (throwErrnoIfMinus1_, throwErrno, getErrno) import Foreign.C.Types (CInt(..), CSize(..)) import Foreign.ForeignPtr (mallocForeignPtrBytes, withForeignPtr) import Foreign.Marshal (alloca, allocaBytes) @@ -46,10 +47,10 @@ import System.Posix.Internals (c_close, c_pipe, c_read, c_write, import System.Posix.Types (Fd) #if defined(HAVE_EVENTFD) -import Foreign.C.Error (throwErrnoIfMinus1) +import Foreign.C.Error (throwErrnoIfMinus1, eBADF) import Foreign.C.Types (CULLong(..)) #else -import Foreign.C.Error (eAGAIN, eWOULDBLOCK, getErrno, throwErrno) +import Foreign.C.Error (eAGAIN, eWOULDBLOCK) #endif data ControlMessage = CMsgWakeup @@ -69,7 +70,9 @@ data Control = W { , wakeupWriteFd :: {-# UNPACK #-} !Fd #endif , didRegisterWakeupFd :: !Bool - } deriving (Show) + -- | Have this Control's fds been cleaned up? + , controlIsDead :: !(IORef Bool) + } #if defined(HAVE_EVENTFD) wakeupReadFd :: Control -> Fd @@ -101,6 +104,7 @@ newControl shouldRegister = allocaArray 2 $ \fds -> do (wake_rd, wake_wr) <- createPipe when shouldRegister $ c_setIOManagerWakeupFd wake_wr #endif + isDead <- newIORef False return W { controlReadFd = fromIntegral ctrl_rd , controlWriteFd = fromIntegral ctrl_wr #if defined(HAVE_EVENTFD) @@ -110,6 +114,7 @@ newControl shouldRegister = allocaArray 2 $ \fds -> do , wakeupWriteFd = fromIntegral wake_wr #endif , didRegisterWakeupFd = shouldRegister + , controlIsDead = isDead } -- | Close the control structure used by the IO manager thread. @@ -119,6 +124,7 @@ newControl shouldRegister = allocaArray 2 $ \fds -> do -- file after it has been closed. closeControl :: Control -> IO () closeControl w = do + atomicModifyIORef (controlIsDead w) (\_ -> (True, ())) _ <- c_close . fromIntegral . controlReadFd $ w _ <- c_close . fromIntegral . controlWriteFd $ w when (didRegisterWakeupFd w) $ c_setIOManagerWakeupFd (-1) @@ -172,9 +178,21 @@ readControlMessage ctrl fd sendWakeup :: Control -> IO () #if defined(HAVE_EVENTFD) -sendWakeup c = - throwErrnoIfMinus1_ "sendWakeup" $ - c_eventfd_write (fromIntegral (controlEventFd c)) 1 +sendWakeup c = do + n <- c_eventfd_write (fromIntegral (controlEventFd c)) 1 + case n of + 0 -> return () + _ -> do errno <- getErrno + -- Check that Control is still alive if we failed, since it's + -- possible that someone cleaned up the fds behind our backs and + -- consequently eventfd_write failed with EBADF. If it is dead + -- then just swallow the error since we are shutting down + -- anyways. Otherwise we will see failures during shutdown from + -- setnumcapabilities001 (#12038) + isDead <- readIORef (controlIsDead c) + if isDead && errno == eBADF + then return () + else throwErrno "sendWakeup" #else sendWakeup c = do n <- sendMessage (wakeupWriteFd c) CMsgWakeup From git at git.haskell.org Tue Jan 17 21:37:47 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 17 Jan 2017 21:37:47 +0000 (UTC) Subject: [commit: ghc] master: testsuite: Bump allocations for T12234 (19cc007) Message-ID: <20170117213747.223E13A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/19cc0071656523aa64b8c24b2cab0964ab8a3f40/ghc >--------------------------------------------------------------- commit 19cc0071656523aa64b8c24b2cab0964ab8a3f40 Author: Ben Gamari Date: Tue Jan 17 09:49:22 2017 -0500 testsuite: Bump allocations for T12234 Unfortunately it's not clear why but this has been failing on Harbormaster. >--------------------------------------------------------------- 19cc0071656523aa64b8c24b2cab0964ab8a3f40 testsuite/tests/perf/compiler/all.T | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T index c8254be..499650b 100644 --- a/testsuite/tests/perf/compiler/all.T +++ b/testsuite/tests/perf/compiler/all.T @@ -894,9 +894,10 @@ test('T12234', [ only_ways(['optasm']), compiler_stats_num_field('bytes allocated', [(platform('x86_64-unknown-mingw32'), 77949232, 5), - # initial: 77949232 - (wordsize(64), 72958288, 5), - # initial: 72958288 + # initial: 77949232 + (wordsize(64), 76848856, 5), + # initial: 72958288 + # 2016-01-17: 76848856 (x86-64, Linux. drift?) ]), ], compile, From git at git.haskell.org Tue Jan 17 21:37:49 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 17 Jan 2017 21:37:49 +0000 (UTC) Subject: [commit: ghc] master: testsuite/recomp001: Sleep to ensure that GHC notices file change (769e3ee) Message-ID: <20170117213749.CA2F43A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/769e3ee7671f0a038558b591c58ba340c8c09952/ghc >--------------------------------------------------------------- commit 769e3ee7671f0a038558b591c58ba340c8c09952 Author: Ben Gamari Date: Tue Jan 17 15:48:09 2017 -0500 testsuite/recomp001: Sleep to ensure that GHC notices file change Some operating systems (e.g. Darwin) have very poor file timestamp resolution. On these systems GHC often fails to notice that B.hs changes in this testsuite, leading to sporatic test failures. Add a sleep to ensure the change is noticed. Test Plan: Validate Reviewers: ezyang, austin Subscribers: mpickering, gracjan, thomie Differential Revision: https://phabricator.haskell.org/D2964 >--------------------------------------------------------------- 769e3ee7671f0a038558b591c58ba340c8c09952 testsuite/tests/driver/recomp001/Makefile | 3 +++ 1 file changed, 3 insertions(+) diff --git a/testsuite/tests/driver/recomp001/Makefile b/testsuite/tests/driver/recomp001/Makefile index de4f981..a592534 100644 --- a/testsuite/tests/driver/recomp001/Makefile +++ b/testsuite/tests/driver/recomp001/Makefile @@ -15,4 +15,7 @@ recomp001: clean cp B1.hs B.hs '$(TEST_HC)' $(TEST_HC_OPTS) --make -v0 C.hs cp B2.hs B.hs + # Operating systems with poor timer resolution (e.g. Darwin) need a bit + # of time here, lest GHC not realize that the file changed. + sleep 1 -'$(TEST_HC)' $(TEST_HC_OPTS) --make -v0 C.hs From git at git.haskell.org Tue Jan 17 21:37:55 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 17 Jan 2017 21:37:55 +0000 (UTC) Subject: [commit: ghc] master: Unquote ‘import’ in bad import error message (e195add) Message-ID: <20170117213755.3BE343A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e195add1f203a0e169a2ea6e58be8d7989e9e0a4/ghc >--------------------------------------------------------------- commit e195add1f203a0e169a2ea6e58be8d7989e9e0a4 Author: Phil Ruffwind Date: Tue Jan 17 15:55:28 2017 -0500 Unquote ‘import’ in bad import error message In module ‘Prelude’: ‘True’ is a data constructor of ‘Bool’ To import it use ‘import’ Prelude( Bool( True ) ) The quotes around `import` don't make any sense. Test Plan: manual Reviewers: austin, mpickering, bgamari Reviewed By: mpickering, bgamari Subscribers: dfeuer, thomie Differential Revision: https://phabricator.haskell.org/D2935 >--------------------------------------------------------------- e195add1f203a0e169a2ea6e58be8d7989e9e0a4 compiler/rename/RnNames.hs | 4 ++-- testsuite/tests/module/mod90.stderr | 6 +++--- testsuite/tests/rename/should_fail/T10668.stderr | 4 ++-- testsuite/tests/rename/should_fail/T5385.stderr | 6 +++--- 4 files changed, 10 insertions(+), 10 deletions(-) diff --git a/compiler/rename/RnNames.hs b/compiler/rename/RnNames.hs index 8a7529d..9d2de74 100644 --- a/compiler/rename/RnNames.hs +++ b/compiler/rename/RnNames.hs @@ -1488,11 +1488,11 @@ badImportItemErrDataCon dataType_occ iface decl_spec ie <+> text "is a data constructor of" <+> quotes dataType , text "To import it use" - , nest 2 $ quotes (text "import") + , nest 2 $ text "import" <+> ppr (is_mod decl_spec) <> parens_sp (dataType <> parens_sp datacon) , text "or" - , nest 2 $ quotes (text "import") + , nest 2 $ text "import" <+> ppr (is_mod decl_spec) <> parens_sp (dataType <> text "(..)") ] diff --git a/testsuite/tests/module/mod90.stderr b/testsuite/tests/module/mod90.stderr index 9febfe3..78a0040 100644 --- a/testsuite/tests/module/mod90.stderr +++ b/testsuite/tests/module/mod90.stderr @@ -1,8 +1,8 @@ -mod90.hs:3:16: +mod90.hs:3:16: error: In module ‘Prelude’: ‘Left’ is a data constructor of ‘Either’ To import it use - ‘import’ Prelude( Either( Left ) ) + import Prelude( Either( Left ) ) or - ‘import’ Prelude( Either(..) ) + import Prelude( Either(..) ) diff --git a/testsuite/tests/rename/should_fail/T10668.stderr b/testsuite/tests/rename/should_fail/T10668.stderr index 8c96fad..4e602b2 100644 --- a/testsuite/tests/rename/should_fail/T10668.stderr +++ b/testsuite/tests/rename/should_fail/T10668.stderr @@ -3,6 +3,6 @@ T10668.hs:3:27: error: In module ‘Data.Type.Equality’: ‘Refl’ is a data constructor of ‘(:~:)’ To import it use - ‘import’ Data.Type.Equality( (:~:)( Refl ) ) + import Data.Type.Equality( (:~:)( Refl ) ) or - ‘import’ Data.Type.Equality( (:~:)(..) ) + import Data.Type.Equality( (:~:)(..) ) diff --git a/testsuite/tests/rename/should_fail/T5385.stderr b/testsuite/tests/rename/should_fail/T5385.stderr index 677c31f..dd825c6 100644 --- a/testsuite/tests/rename/should_fail/T5385.stderr +++ b/testsuite/tests/rename/should_fail/T5385.stderr @@ -1,8 +1,8 @@ -T5385.hs:3:16: +T5385.hs:3:16: error: In module ‘T5385a’: ‘(:::)’ is a data constructor of ‘T’ To import it use - ‘import’ T5385a( T( (:::) ) ) + import T5385a( T( (:::) ) ) or - ‘import’ T5385a( T(..) ) + import T5385a( T(..) ) From git at git.haskell.org Tue Jan 17 21:37:52 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 17 Jan 2017 21:37:52 +0000 (UTC) Subject: [commit: ghc] master: Split mkInlineUnfolding into two functions (d360ec3) Message-ID: <20170117213752.88CD43A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d360ec39bc9c1ba354c2254d4c4de505e3e10183/ghc >--------------------------------------------------------------- commit d360ec39bc9c1ba354c2254d4c4de505e3e10183 Author: David Feuer Date: Tue Jan 17 15:55:39 2017 -0500 Split mkInlineUnfolding into two functions Previously, `mkInlineUnfolding` took a `Maybe` argument indicating whether the caller requested a specific arity. This was not self-documenting at call sites. Now we distinguish between `mkInlineUnfolding` and `mkInlineUnfoldingWithArity`. Reviewers: simonpj, austin, bgamari Reviewed By: simonpj, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2933 >--------------------------------------------------------------- d360ec39bc9c1ba354c2254d4c4de505e3e10183 compiler/basicTypes/MkId.hs | 7 +++--- compiler/coreSyn/CoreUnfold.hs | 35 ++++++++++++++++++-------- compiler/deSugar/DsBinds.hs | 4 +-- compiler/deSugar/DsForeign.hs | 3 ++- compiler/simplCore/Simplify.hs | 2 +- compiler/typecheck/TcInstDcls.hs | 4 +-- compiler/vectorise/Vectorise.hs | 4 +-- compiler/vectorise/Vectorise/Generic/PADict.hs | 3 ++- compiler/vectorise/Vectorise/Type/Env.hs | 2 +- compiler/vectorise/Vectorise/Utils/Hoisting.hs | 2 +- 10 files changed, 42 insertions(+), 24 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc d360ec39bc9c1ba354c2254d4c4de505e3e10183 From git at git.haskell.org Tue Jan 17 21:37:57 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 17 Jan 2017 21:37:57 +0000 (UTC) Subject: [commit: ghc] master: Unbreak build with ghc-7.10.1 (2b61f52) Message-ID: <20170117213757.E5F4F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2b61f52a0d0d636fb468756728c3ee0f5def8304/ghc >--------------------------------------------------------------- commit 2b61f52a0d0d636fb468756728c3ee0f5def8304 Author: Yuras Shumovich Date: Tue Jan 17 15:55:59 2017 -0500 Unbreak build with ghc-7.10.1 Test Plan: build with ghc-7.10.1 Reviewers: austin, bgamari, dfeuer Reviewed By: dfeuer Subscribers: dfeuer, thomie Differential Revision: https://phabricator.haskell.org/D2976 GHC Trac Issues: #13120 >--------------------------------------------------------------- 2b61f52a0d0d636fb468756728c3ee0f5def8304 compiler/utils/Util.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/compiler/utils/Util.hs b/compiler/utils/Util.hs index d5c6e2a..5c09959 100644 --- a/compiler/utils/Util.hs +++ b/compiler/utils/Util.hs @@ -123,7 +123,9 @@ module Util ( hashString, -- * Call stacks +#if MIN_VERSION_GLASGOW_HASKELL(7,10,2,0) GHC.Stack.CallStack, +#endif HasCallStack, HasDebugCallStack, prettyCurrentCallStack, From git at git.haskell.org Wed Jan 18 10:09:21 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 18 Jan 2017 10:09:21 +0000 (UTC) Subject: [commit: ghc] master: Typos in comments only [ci skip] (e324e31) Message-ID: <20170118100921.57A1E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e324e317caab06fda232636c32e8a60d9e888a9c/ghc >--------------------------------------------------------------- commit e324e317caab06fda232636c32e8a60d9e888a9c Author: Gabor Greif Date: Tue Jan 17 17:39:33 2017 +0100 Typos in comments only [ci skip] >--------------------------------------------------------------- e324e317caab06fda232636c32e8a60d9e888a9c compiler/basicTypes/Demand.hs | 2 +- compiler/coreSyn/CoreUtils.hs | 2 +- compiler/coreSyn/MkCore.hs | 2 +- compiler/deSugar/DsExpr.hs | 2 +- compiler/prelude/primops.txt.pp | 2 +- compiler/simplCore/OccurAnal.hs | 2 +- compiler/specialise/SpecConstr.hs | 2 +- compiler/stgSyn/CoreToStg.hs | 2 +- compiler/stranal/DmdAnal.hs | 2 +- compiler/typecheck/TcRules.hs | 2 +- compiler/typecheck/TcSMonad.hs | 2 +- docs/core-spec/core-spec.mng | 2 +- testsuite/tests/typecheck/should_run/tcrun042.hs | 6 +++--- 13 files changed, 15 insertions(+), 15 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc e324e317caab06fda232636c32e8a60d9e888a9c From git at git.haskell.org Wed Jan 18 17:00:46 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 18 Jan 2017 17:00:46 +0000 (UTC) Subject: [commit: ghc] master: Spelling fixes in comments [ci skip] (70472bf) Message-ID: <20170118170046.627DA3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/70472bf2d862f976790f73e9dc7a0f3f7519ae1d/ghc >--------------------------------------------------------------- commit 70472bf2d862f976790f73e9dc7a0f3f7519ae1d Author: Gabor Greif Date: Wed Jan 18 17:07:40 2017 +0100 Spelling fixes in comments [ci skip] >--------------------------------------------------------------- 70472bf2d862f976790f73e9dc7a0f3f7519ae1d compiler/basicTypes/BasicTypes.hs | 2 +- compiler/basicTypes/RdrName.hs | 2 +- compiler/coreSyn/CoreSyn.hs | 2 +- compiler/coreSyn/CoreUnfold.hs | 2 +- compiler/deSugar/PmExpr.hs | 2 +- compiler/iface/TcIface.hs | 2 +- compiler/llvmGen/Llvm/AbsSyn.hs | 2 +- compiler/llvmGen/Llvm/MetaData.hs | 2 +- compiler/rename/RnTypes.hs | 2 +- compiler/simplCore/Simplify.hs | 2 +- compiler/stranal/WwLib.hs | 4 ++-- compiler/typecheck/TcHsType.hs | 2 +- compiler/typecheck/TcRnTypes.hs | 4 ++-- compiler/typecheck/TcSMonad.hs | 2 +- compiler/typecheck/TcSimplify.hs | 2 +- compiler/typecheck/TcTyDecls.hs | 2 +- compiler/types/TyCon.hs | 2 +- compiler/utils/Pretty.hs | 2 +- compiler/vectorise/Vectorise/Vect.hs | 2 +- includes/RtsAPI.h | 2 +- includes/stg/MachRegs.h | 4 ++-- libraries/base/GHC/Stats.hsc | 2 +- rts/linker/MachO.c | 2 +- testsuite/tests/gadt/Makefile | 2 +- testsuite/tests/safeHaskell/safeLanguage/Makefile | 2 +- 25 files changed, 28 insertions(+), 28 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 70472bf2d862f976790f73e9dc7a0f3f7519ae1d From git at git.haskell.org Wed Jan 18 22:40:00 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 18 Jan 2017 22:40:00 +0000 (UTC) Subject: [commit: ghc] master: Modify ForeignPtr documentation in light of plusForeignPtr (852c6a0) Message-ID: <20170118224000.6E8B83A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/852c6a09f8ac21c3e843e64dfa7c6382073eb5ce/ghc >--------------------------------------------------------------- commit 852c6a09f8ac21c3e843e64dfa7c6382073eb5ce Author: Shea Levy Date: Wed Jan 18 16:22:18 2017 -0500 Modify ForeignPtr documentation in light of plusForeignPtr Reviewers: austin, rwbarton, simonmar, hvr, bgamari Reviewed By: rwbarton, simonmar Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2970 >--------------------------------------------------------------- 852c6a09f8ac21c3e843e64dfa7c6382073eb5ce libraries/base/GHC/ForeignPtr.hs | 22 ++++++++++++++++------ 1 file changed, 16 insertions(+), 6 deletions(-) diff --git a/libraries/base/GHC/ForeignPtr.hs b/libraries/base/GHC/ForeignPtr.hs index 6088084..28b33e0 100644 --- a/libraries/base/GHC/ForeignPtr.hs +++ b/libraries/base/GHC/ForeignPtr.hs @@ -71,12 +71,14 @@ import GHC.Ptr ( Ptr(..), FunPtr(..) ) -- class 'Storable'. -- data ForeignPtr a = ForeignPtr Addr# ForeignPtrContents - -- we cache the Addr# in the ForeignPtr object, but attach - -- the finalizer to the IORef (or the MutableByteArray# in - -- the case of a MallocPtr). The aim of the representation - -- is to make withForeignPtr efficient; in fact, withForeignPtr - -- should be just as efficient as unpacking a Ptr, and multiple - -- withForeignPtrs can share an unpacked ForeignPtr. Note + -- The Addr# in the ForeignPtr object is intentionally stored + -- separately from the finalizer. The primay aim of the + -- representation is to make withForeignPtr efficient; in fact, + -- withForeignPtr should be just as efficient as unpacking a + -- Ptr, and multiple withForeignPtrs can share an unpacked + -- ForeignPtr. As a secondary benefit, this representation + -- allows pointers to subregions within the same overall block + -- to share the same finalizer (see 'plusForeignPtr'). Note -- that touchForeignPtr only has to touch the ForeignPtrContents -- object, because that ensures that whatever the finalizer is -- attached to is kept alive. @@ -438,6 +440,14 @@ castForeignPtr = coerce plusForeignPtr :: ForeignPtr a -> Int -> ForeignPtr b -- ^Advances the given address by the given offset in bytes. -- +-- The new 'ForeignPtr' shares the finalizer of the original, +-- equivalent from a finalization standpoint to just creating another +-- reference to the original. That is, the finalizer will not be +-- called before the new 'ForeignPtr' is unreachable, nor will it be +-- called an additional time due to this call, and the finalizer will +-- be called with the same address that it would have had this call +-- not happened, *not* the new address. +-- -- @since 4.10.0.0 plusForeignPtr (ForeignPtr addr c) (I# d) = ForeignPtr (plusAddr# addr d) c From git at git.haskell.org Wed Jan 18 22:40:03 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 18 Jan 2017 22:40:03 +0000 (UTC) Subject: [commit: ghc] master: Improve suggestion for misspelled flag including '=' (fixes #11789) (181688a) Message-ID: <20170118224003.C26043A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/181688abae5c0b32237a5bd783dfc9667641cce2/ghc >--------------------------------------------------------------- commit 181688abae5c0b32237a5bd783dfc9667641cce2 Author: Daishi Nakajima Date: Wed Jan 18 16:23:55 2017 -0500 Improve suggestion for misspelled flag including '=' (fixes #11789) Test Plan: Added 2 test cases, verified that ghc can suggest in the following cases: - for misspelled flag containing '=', ghc suggests flags that doesn't contain '=' - for misspelled flag containing '=', ghc suggests flags that contains '=' Reviewers: austin, dfeuer, bgamari Reviewed By: dfeuer, bgamari Subscribers: dfeuer, mpickering, thomie Differential Revision: https://phabricator.haskell.org/D2978 GHC Trac Issues: #11789 >--------------------------------------------------------------- 181688abae5c0b32237a5bd783dfc9667641cce2 ghc/Main.hs | 11 ++++++++++- testsuite/tests/driver/should_fail/T11789a.hs | 1 + testsuite/tests/driver/should_fail/T11789a.stderr | 5 +++++ testsuite/tests/driver/should_fail/T11789b.hs | 1 + testsuite/tests/driver/should_fail/T11789b.stderr | 7 +++++++ testsuite/tests/driver/should_fail/all.T | 3 +++ 6 files changed, 27 insertions(+), 1 deletion(-) diff --git a/ghc/Main.hs b/ghc/Main.hs index 83d5238..a650d35 100644 --- a/ghc/Main.hs +++ b/ghc/Main.hs @@ -915,9 +915,18 @@ unknownFlagsErr fs = throwGhcException $ UsageError $ concatMap oneError fs where oneError f = "unrecognised flag: " ++ f ++ "\n" ++ - (case fuzzyMatch f (nub allNonDeprecatedFlags) of + (case match f (nubSort allNonDeprecatedFlags) of [] -> "" suggs -> "did you mean one of:\n" ++ unlines (map (" " ++) suggs)) + -- fixes #11789 + -- If the flag contains '=', + -- this uses both the whole and the left side of '=' for comparing. + match f allFlags + | elem '=' f = + let (flagsWithEq, flagsWithoutEq) = partition (elem '=') allFlags + fName = takeWhile (/= '=') f + in (fuzzyMatch f flagsWithEq) ++ (fuzzyMatch fName flagsWithoutEq) + | otherwise = fuzzyMatch f allFlags {- Note [-Bsymbolic and hooks] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ diff --git a/testsuite/tests/driver/should_fail/T11789a.hs b/testsuite/tests/driver/should_fail/T11789a.hs new file mode 100644 index 0000000..78595d6 --- /dev/null +++ b/testsuite/tests/driver/should_fail/T11789a.hs @@ -0,0 +1 @@ +module MisspelledFlagA where diff --git a/testsuite/tests/driver/should_fail/T11789a.stderr b/testsuite/tests/driver/should_fail/T11789a.stderr new file mode 100644 index 0000000..3e2b780 --- /dev/null +++ b/testsuite/tests/driver/should_fail/T11789a.stderr @@ -0,0 +1,5 @@ +ghc: unrecognised flag: -fppr-cols=1000 +did you mean one of: + -dppr-cols + +Usage: For basic information, try the `--help' option. diff --git a/testsuite/tests/driver/should_fail/T11789b.hs b/testsuite/tests/driver/should_fail/T11789b.hs new file mode 100644 index 0000000..87ac7b8 --- /dev/null +++ b/testsuite/tests/driver/should_fail/T11789b.hs @@ -0,0 +1 @@ +module MisspelledFlagB where diff --git a/testsuite/tests/driver/should_fail/T11789b.stderr b/testsuite/tests/driver/should_fail/T11789b.stderr new file mode 100644 index 0000000..4c4e0c6 --- /dev/null +++ b/testsuite/tests/driver/should_fail/T11789b.stderr @@ -0,0 +1,7 @@ +ghc: unrecognised flag: -rtsopts=somw +did you mean one of: + -rtsopts=some + -rtsopts=none + -rtsopts + +Usage: For basic information, try the `--help' option. diff --git a/testsuite/tests/driver/should_fail/all.T b/testsuite/tests/driver/should_fail/all.T index 3d0708b..22c8375 100644 --- a/testsuite/tests/driver/should_fail/all.T +++ b/testsuite/tests/driver/should_fail/all.T @@ -2,3 +2,6 @@ test('T10895', normal, multimod_compile_fail, ['T10895.hs', '-v0 -o dummy']) test('T12752', expect_fail, compile, ['-Wcpp-undef -Werror']) + +test('T11789a', normal, compile_fail, ['-fppr-cols=1000']) +test('T11789b', normal, compile_fail, ['-rtsopts=somw']) From git at git.haskell.org Wed Jan 18 22:40:06 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 18 Jan 2017 22:40:06 +0000 (UTC) Subject: [commit: ghc] master: Fix get_op in the case of an unambiguous record selector (#13132) (38374ca) Message-ID: <20170118224006.E70983A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/38374caa9d6e1373d1b9d335d0f99f3664931fd9/ghc >--------------------------------------------------------------- commit 38374caa9d6e1373d1b9d335d0f99f3664931fd9 Author: Reid Barton Date: Wed Jan 18 16:24:28 2017 -0500 Fix get_op in the case of an unambiguous record selector (#13132) Test Plan: validate Reviewers: simonpj, austin, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2985 GHC Trac Issues: #13132 >--------------------------------------------------------------- 38374caa9d6e1373d1b9d335d0f99f3664931fd9 compiler/rename/RnTypes.hs | 1 + testsuite/tests/rename/should_compile/T13132.hs | 5 +++++ testsuite/tests/rename/should_compile/all.T | 1 + 3 files changed, 7 insertions(+) diff --git a/compiler/rename/RnTypes.hs b/compiler/rename/RnTypes.hs index 6cd6ea8..421fba5 100644 --- a/compiler/rename/RnTypes.hs +++ b/compiler/rename/RnTypes.hs @@ -1227,6 +1227,7 @@ get_op :: LHsExpr Name -> Name -- See RnExpr.rnUnboundVar get_op (L _ (HsVar (L _ n))) = n get_op (L _ (HsUnboundVar uv)) = mkUnboundName (unboundVarOcc uv) +get_op (L _ (HsRecFld (Unambiguous _ n))) = n get_op other = pprPanic "get_op" (ppr other) -- Parser left-associates everything, but diff --git a/testsuite/tests/rename/should_compile/T13132.hs b/testsuite/tests/rename/should_compile/T13132.hs new file mode 100644 index 0000000..7070607 --- /dev/null +++ b/testsuite/tests/rename/should_compile/T13132.hs @@ -0,0 +1,5 @@ +module Bug where + +newtype ContT r m a = ContT { runContT :: (a -> m r) -> m r } + +foo bar baz = (`runContT` bar.baz) diff --git a/testsuite/tests/rename/should_compile/all.T b/testsuite/tests/rename/should_compile/all.T index 90d955b..2963905 100644 --- a/testsuite/tests/rename/should_compile/all.T +++ b/testsuite/tests/rename/should_compile/all.T @@ -245,3 +245,4 @@ test('T12127', test('T12533', normal, compile, ['']) test('T12597', normal, compile, ['']) test('T12548', normal, compile, ['']) +test('T13132', normal, compile, ['']) From git at git.haskell.org Wed Jan 18 22:40:09 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 18 Jan 2017 22:40:09 +0000 (UTC) Subject: [commit: ghc] master: testsuite: Really fix recomp001 (3046dbb) Message-ID: <20170118224009.A09293A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3046dbb35890a680a4f36d6ae77833db9ccc12bf/ghc >--------------------------------------------------------------- commit 3046dbb35890a680a4f36d6ae77833db9ccc12bf Author: Ben Gamari Date: Wed Jan 18 15:42:00 2017 -0500 testsuite: Really fix recomp001 The fix in D2964 wasn't quite right; the sleep was in the wrong place, as pointed out by @gracjan. >--------------------------------------------------------------- 3046dbb35890a680a4f36d6ae77833db9ccc12bf testsuite/tests/driver/recomp001/Makefile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/testsuite/tests/driver/recomp001/Makefile b/testsuite/tests/driver/recomp001/Makefile index a592534..d99ab89 100644 --- a/testsuite/tests/driver/recomp001/Makefile +++ b/testsuite/tests/driver/recomp001/Makefile @@ -14,8 +14,8 @@ clean: recomp001: clean cp B1.hs B.hs '$(TEST_HC)' $(TEST_HC_OPTS) --make -v0 C.hs + sleep 1 cp B2.hs B.hs # Operating systems with poor timer resolution (e.g. Darwin) need a bit # of time here, lest GHC not realize that the file changed. - sleep 1 -'$(TEST_HC)' $(TEST_HC_OPTS) --make -v0 C.hs From git at git.haskell.org Wed Jan 18 22:40:15 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 18 Jan 2017 22:40:15 +0000 (UTC) Subject: [commit: ghc] master: Clean up RTS Linker Windows. (0b7cd65) Message-ID: <20170118224015.3E3583A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/0b7cd65ec4878386d1d3dcf72b599e2b9de93e65/ghc >--------------------------------------------------------------- commit 0b7cd65ec4878386d1d3dcf72b599e2b9de93e65 Author: Tamar Christina Date: Wed Jan 18 16:21:40 2017 -0500 Clean up RTS Linker Windows. Clean up the linker code for PE. 1. Stop copying structures from the windows header and use those that are in the headers. There's no point in copying them and we got a few types wrong. 2. Replace custom typedef with C99 types. If we're not going to use the Windows type aliases, at least use standard ones. Test Plan: ./validate Reviewers: simonmar, austin, erikd, bgamari Reviewed By: simonmar, bgamari Subscribers: dfeuer, thomie, #ghc_windows_task_force Differential Revision: https://phabricator.haskell.org/D2944 >--------------------------------------------------------------- 0b7cd65ec4878386d1d3dcf72b599e2b9de93e65 rts/linker/PEi386.c | 441 ++++++++++++++++++++++++---------------------------- rts/linker/PEi386.h | 178 ++++++++------------- 2 files changed, 263 insertions(+), 356 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 0b7cd65ec4878386d1d3dcf72b599e2b9de93e65 From git at git.haskell.org Wed Jan 18 22:40:12 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 18 Jan 2017 22:40:12 +0000 (UTC) Subject: [commit: ghc] master: Add CBool to Foreign.C.Types (0d769d5) Message-ID: <20170118224012.76E3D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/0d769d5b96232ee0fe5a44f2ce5717bdb0e7eaa3/ghc >--------------------------------------------------------------- commit 0d769d5b96232ee0fe5a44f2ce5717bdb0e7eaa3 Author: Ryan Scott Date: Wed Jan 18 16:24:17 2017 -0500 Add CBool to Foreign.C.Types This adds a `CBool` type wrapping C99's `bool`, i.e., an `unsigned char`. Fixes #13136. Test Plan: ./validate on Tier-1 platforms Reviewers: austin, hvr, simonmar, bgamari Reviewed By: simonmar, bgamari Subscribers: thomie, erikd Differential Revision: https://phabricator.haskell.org/D2982 GHC Trac Issues: #13136 >--------------------------------------------------------------- 0d769d5b96232ee0fe5a44f2ce5717bdb0e7eaa3 libraries/base/Foreign/C/Types.hs | 8 +++++++- libraries/base/aclocal.m4 | 1 + libraries/base/changelog.md | 3 +++ libraries/base/configure.ac | 1 + 4 files changed, 12 insertions(+), 1 deletion(-) diff --git a/libraries/base/Foreign/C/Types.hs b/libraries/base/Foreign/C/Types.hs index f76ff1c..b2e723f 100644 --- a/libraries/base/Foreign/C/Types.hs +++ b/libraries/base/Foreign/C/Types.hs @@ -44,7 +44,7 @@ module Foreign.C.Types , CShort(..), CUShort(..), CInt(..), CUInt(..) , CLong(..), CULong(..) , CPtrdiff(..), CSize(..), CWchar(..), CSigAtomic(..) - , CLLong(..), CULLong(..) + , CLLong(..), CULLong(..), CBool(..) , CIntPtr(..), CUIntPtr(..), CIntMax(..), CUIntMax(..) -- ** Numeric types @@ -126,6 +126,11 @@ INTEGRAL_TYPE(CLLong,HTYPE_LONG_LONG) -- | Haskell type representing the C @unsigned long long@ type. INTEGRAL_TYPE(CULLong,HTYPE_UNSIGNED_LONG_LONG) +-- | Haskell type representing the C @bool@ type. +-- +-- @since 4.10.0.0 +INTEGRAL_TYPE_WITH_CTYPE(CBool,bool,HTYPE_BOOL) + {-# RULES "fromIntegral/a->CChar" fromIntegral = \x -> CChar (fromIntegral x) "fromIntegral/a->CSChar" fromIntegral = \x -> CSChar (fromIntegral x) @@ -150,6 +155,7 @@ INTEGRAL_TYPE(CULLong,HTYPE_UNSIGNED_LONG_LONG) "fromIntegral/CULong->a" fromIntegral = \(CULong x) -> fromIntegral x "fromIntegral/CLLong->a" fromIntegral = \(CLLong x) -> fromIntegral x "fromIntegral/CULLong->a" fromIntegral = \(CULLong x) -> fromIntegral x +"fromIntegral/CBool->a" fromIntegral = \(CBool x) -> fromIntegral x #-} -- | Haskell type representing the C @float@ type. diff --git a/libraries/base/aclocal.m4 b/libraries/base/aclocal.m4 index 17b8bca..ece0c6f 100644 --- a/libraries/base/aclocal.m4 +++ b/libraries/base/aclocal.m4 @@ -54,6 +54,7 @@ done dnl FPTOOLS_HTYPE_INCLUDES AC_DEFUN([FPTOOLS_HTYPE_INCLUDES], [ +#include #include #include diff --git a/libraries/base/changelog.md b/libraries/base/changelog.md index d687e07..f1a93ee 100644 --- a/libraries/base/changelog.md +++ b/libraries/base/changelog.md @@ -33,6 +33,9 @@ * Add wrappers for `blksize_t`, `blkcnt_t`, `clockid_t`, `fsblkcnt_t`, `fsfilcnt_t`, `id_t`, `key_t`, and `timer_t` to System.Posix.Types (#12795) + * Add `CBool`, a wrapper around C's `bool` type, to `Foreign.C.Types` + (#13136) + * Raw buffer operations in `GHC.IO.FD` are now strict in the buffer, offset, and length operations (#9696) * Add `plusForeignPtr` to `Foreign.ForeignPtr`. diff --git a/libraries/base/configure.ac b/libraries/base/configure.ac index e6c8a9b..f6816e7 100644 --- a/libraries/base/configure.ac +++ b/libraries/base/configure.ac @@ -118,6 +118,7 @@ if test "$ac_cv_type_long_long" = yes; then FPTOOLS_CHECK_HTYPE(long long) FPTOOLS_CHECK_HTYPE(unsigned long long) fi +FPTOOLS_CHECK_HTYPE(bool) FPTOOLS_CHECK_HTYPE(float) FPTOOLS_CHECK_HTYPE(double) FPTOOLS_CHECK_HTYPE(ptrdiff_t) From git at git.haskell.org Thu Jan 19 15:37:53 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 19 Jan 2017 15:37:53 +0000 (UTC) Subject: [commit: ghc] master: Update levity polymorphism (e7985ed) Message-ID: <20170119153753.93EAB3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e7985ed23ddc68b6a2e4af753578dc1d9e8ab4c9/ghc >--------------------------------------------------------------- commit e7985ed23ddc68b6a2e4af753578dc1d9e8ab4c9 Author: Richard Eisenberg Date: Wed Dec 14 21:37:43 2016 -0500 Update levity polymorphism This commit implements the proposal in https://github.com/ghc-proposals/ghc-proposals/pull/29 and https://github.com/ghc-proposals/ghc-proposals/pull/35. Here are some of the pieces of that proposal: * Some of RuntimeRep's constructors have been shortened. * TupleRep and SumRep are now parameterized over a list of RuntimeReps. * This means that two types with the same kind surely have the same representation. Previously, all unboxed tuples had the same kind, and thus the fact above was false. * RepType.typePrimRep and friends now return a *list* of PrimReps. These functions can now work successfully on unboxed tuples. This change is necessary because we allow abstraction over unboxed tuple types and so cannot always handle unboxed tuples specially as we did before. * We sometimes have to create an Id from a PrimRep. I thus split PtrRep * into LiftedRep and UnliftedRep, so that the created Ids have the right strictness. * The RepType.RepType type was removed, as it didn't seem to help with * much. * The RepType.repType function is also removed, in favor of typePrimRep. * I have waffled a good deal on whether or not to keep VoidRep in TyCon.PrimRep. In the end, I decided to keep it there. PrimRep is *not* represented in RuntimeRep, and typePrimRep will never return a list including VoidRep. But it's handy to have in, e.g., ByteCodeGen and friends. I can imagine another design choice where we have a PrimRepV type that is PrimRep with an extra constructor. That seemed to be a heavier design, though, and I'm not sure what the benefit would be. * The last, unused vestiges of # (unliftedTypeKind) have been removed. * There were several pretty-printing bugs that this change exposed; * these are fixed. * We previously checked for levity polymorphism in the types of binders. * But we also must exclude levity polymorphism in function arguments. This is hard to check for, requiring a good deal of care in the desugarer. See Note [Levity polymorphism checking] in DsMonad. * In order to efficiently check for levity polymorphism in functions, it * was necessary to add a new bit of IdInfo. See Note [Levity info] in IdInfo. * It is now safe for unlifted types to be unsaturated in Core. Core Lint * is updated accordingly. * We can only know strictness after zonking, so several checks around * strictness in the type-checker (checkStrictBinds, the check for unlifted variables under a ~ pattern) have been moved to the desugarer. * Along the way, I improved the treatment of unlifted vs. banged * bindings. See Note [Strict binds checks] in DsBinds and #13075. * Now that we print type-checked source, we must be careful to print * ConLikes correctly. This is facilitated by a new HsConLikeOut constructor to HsExpr. Particularly troublesome are unlifted pattern synonyms that get an extra void# argument. * Includes a submodule update for haddock, getting rid of #. * New testcases: typecheck/should_fail/StrictBinds typecheck/should_fail/T12973 typecheck/should_run/StrictPats typecheck/should_run/T12809 typecheck/should_fail/T13105 patsyn/should_fail/UnliftedPSBind typecheck/should_fail/LevPolyBounded typecheck/should_compile/T12987 typecheck/should_compile/T11736 * Fixed tickets: #12809 #12973 #11736 #13075 #12987 * This also adds a test case for #13105. This test case is * "compile_fail" and succeeds, because I want the testsuite to monitor the error message. When #13105 is fixed, the test case will compile cleanly. >--------------------------------------------------------------- e7985ed23ddc68b6a2e4af753578dc1d9e8ab4c9 compiler/basicTypes/BasicTypes.hs | 2 +- compiler/basicTypes/Id.hs | 10 +- compiler/basicTypes/IdInfo.hs | 94 +++++- compiler/basicTypes/MkId.hs | 58 ++-- compiler/cmm/CmmUtils.hs | 14 +- compiler/codeGen/StgCmm.hs | 6 +- compiler/codeGen/StgCmmArgRep.hs | 3 +- compiler/codeGen/StgCmmClosure.hs | 10 +- compiler/codeGen/StgCmmEnv.hs | 5 +- compiler/codeGen/StgCmmExpr.hs | 18 +- compiler/codeGen/StgCmmForeign.hs | 11 +- compiler/codeGen/StgCmmUtils.hs | 6 +- compiler/coreSyn/CoreArity.hs | 8 +- compiler/coreSyn/CoreLint.hs | 35 ++- compiler/coreSyn/CoreSubst.hs | 11 +- compiler/coreSyn/CoreSyn.hs | 3 + compiler/coreSyn/CoreUtils.hs | 42 ++- compiler/coreSyn/MkCore.hs | 3 +- compiler/coreSyn/PprCore.hs | 1 + compiler/deSugar/Coverage.hs | 3 + compiler/deSugar/DsArrows.hs | 103 +++++-- compiler/deSugar/DsBinds.hs | 91 +++++- compiler/deSugar/DsCCall.hs | 5 +- compiler/deSugar/DsExpr.hs | 177 +++++++---- compiler/deSugar/DsExpr.hs-boot | 6 +- compiler/deSugar/DsForeign.hs | 11 +- compiler/deSugar/DsGRHSs.hs | 5 +- compiler/deSugar/DsListComp.hs | 39 ++- compiler/deSugar/DsMonad.hs | 138 ++++++++- compiler/deSugar/DsUtils.hs | 4 +- compiler/deSugar/Match.hs | 18 +- compiler/deSugar/MatchCon.hs | 2 +- compiler/deSugar/PmExpr.hs | 2 + compiler/ghci/ByteCodeGen.hs | 64 ++-- compiler/ghci/ByteCodeItbls.hs | 6 +- compiler/ghci/Debugger.hs | 3 +- compiler/ghci/GHCi.hsc | 4 +- compiler/ghci/RtClosureInspect.hs | 49 ++- compiler/hsSyn/HsBinds.hs | 5 + compiler/hsSyn/HsExpr.hs | 77 +++-- compiler/hsSyn/HsPat.hs | 30 +- compiler/hsSyn/HsUtils.hs | 74 ++++- compiler/iface/IfaceSyn.hs | 6 +- compiler/iface/IfaceType.hs | 22 +- compiler/iface/TcIface.hs | 1 + compiler/iface/ToIface.hs | 6 +- compiler/main/DynFlags.hs | 9 +- compiler/main/HscTypes.hs | 1 - compiler/main/InteractiveEval.hs | 9 +- compiler/prelude/PrelNames.hs | 20 +- compiler/prelude/PrimOp.hs | 10 +- compiler/prelude/TysPrim.hs | 170 +++++----- compiler/prelude/TysWiredIn.hs | 185 +++++++---- compiler/prelude/TysWiredIn.hs-boot | 9 +- compiler/simplCore/SetLevels.hs | 4 +- compiler/simplCore/SimplEnv.hs | 2 +- compiler/simplCore/SimplUtils.hs | 25 +- compiler/simplCore/Simplify.hs | 4 + compiler/simplStg/RepType.hs | 341 ++++++++++----------- compiler/simplStg/UnariseStg.hs | 58 ++-- compiler/stgSyn/CoreToStg.hs | 33 +- compiler/stgSyn/StgLint.hs | 34 +- compiler/stgSyn/StgSyn.hs | 18 +- compiler/typecheck/TcBinds.hs | 132 +------- compiler/typecheck/TcCanonical.hs | 3 +- compiler/typecheck/TcEnv.hs | 4 +- compiler/typecheck/TcErrors.hs | 17 +- compiler/typecheck/TcEvidence.hs | 88 +++++- compiler/typecheck/TcExpr.hs | 19 +- compiler/typecheck/TcGenFunctor.hs | 12 +- compiler/typecheck/TcHsSyn.hs | 183 +++-------- compiler/typecheck/TcHsType.hs | 16 +- compiler/typecheck/TcInstDcls.hs | 6 +- compiler/typecheck/TcMType.hs | 60 +++- compiler/typecheck/TcPat.hs | 24 +- compiler/typecheck/TcPatSyn.hs | 15 +- compiler/typecheck/TcRnTypes.hs | 1 + compiler/typecheck/TcSigs.hs | 3 +- compiler/typecheck/TcSimplify.hs | 13 +- compiler/typecheck/TcTyClsDecls.hs | 9 +- compiler/typecheck/TcType.hs | 28 +- compiler/typecheck/TcTypeable.hs | 19 +- compiler/typecheck/TcUnify.hs | 19 +- compiler/types/FamInstEnv.hs | 2 - compiler/types/Kind.hs | 40 ++- compiler/types/TyCoRep.hs | 99 ++++-- compiler/types/TyCon.hs | 39 ++- compiler/types/Type.hs | 92 ++++-- compiler/utils/Bag.hs | 8 +- compiler/utils/Outputable.hs | 6 + docs/users_guide/glasgow_exts.rst | 79 +++-- docs/users_guide/using-warnings.rst | 7 + docs/users_guide/using.rst | 2 +- libraries/base/Data/Typeable/Internal.hs | 9 +- libraries/base/Unsafe/Coerce.hs | 6 +- libraries/base/tests/T11334a.hs | 4 +- libraries/base/tests/T11334a.stdout | 2 +- libraries/ghc-prim/GHC/Types.hs | 17 +- .../integer-gmp/src/GHC/Integer/Logarithms.hs | 3 +- libraries/integer-gmp/src/GHC/Integer/Type.hs | 32 +- .../tests/deSugar/should_compile/T10662.stderr | 2 +- .../tests/dependent/should_compile/RaeJobTalk.hs | 6 +- .../tests/dependent/should_fail/T11473.stderr | 2 +- testsuite/tests/deriving/should_fail/T12512.hs | 7 +- testsuite/tests/deriving/should_fail/T12512.stderr | 4 +- testsuite/tests/ghci/scripts/GhciKinds.stdout | 6 +- testsuite/tests/ghci/scripts/T9140.stdout | 10 +- .../tests/patsyn/should_fail/UnliftedPSBind.hs | 12 + .../tests/patsyn/should_fail/UnliftedPSBind.stderr | 8 + testsuite/tests/patsyn/should_fail/all.T | 1 + testsuite/tests/patsyn/should_fail/unboxed-bind.hs | 1 + .../tests/patsyn/should_fail/unboxed-bind.stderr | 10 +- testsuite/tests/quasiquotation/T7918.stdout | 8 - .../tests/simplCore/should_compile/T9400.stderr | 2 +- .../simplCore/should_compile/spec-inline.stderr | 2 +- testsuite/tests/th/T12403.stdout | 6 +- testsuite/tests/th/T12478_1.stdout | 2 +- testsuite/tests/th/T5358.stderr | 16 +- testsuite/tests/th/T5976.stderr | 4 +- testsuite/tests/th/T8987.stderr | 6 +- testsuite/tests/typecheck/should_compile/T11723.hs | 7 + testsuite/tests/typecheck/should_compile/T11736.hs | 8 + testsuite/tests/typecheck/should_compile/T12987.hs | 7 + testsuite/tests/typecheck/should_compile/all.T | 3 + .../tests/typecheck/should_fail/BadUnboxedTuple.hs | 10 - .../typecheck/should_fail/BadUnboxedTuple.stderr | 6 - .../tests/typecheck/should_fail/LevPolyBounded.hs | 11 + .../typecheck/should_fail/LevPolyBounded.stderr | 5 + .../tests/typecheck/should_fail/StrictBinds.hs | 9 + .../tests/typecheck/should_fail/StrictBinds.stderr | 5 + testsuite/tests/typecheck/should_fail/T11723.hs | 8 - .../tests/typecheck/should_fail/T11723.stderr | 7 - .../tests/typecheck/should_fail/T11724.stderr | 2 +- testsuite/tests/typecheck/should_fail/T12973.hs | 15 + .../tests/typecheck/should_fail/T12973.stderr | 12 + testsuite/tests/typecheck/should_fail/T13105.hs | 23 ++ .../tests/typecheck/should_fail/T13105.stderr | 6 + testsuite/tests/typecheck/should_fail/T2806.hs | 2 +- testsuite/tests/typecheck/should_fail/T2806.stderr | 10 +- testsuite/tests/typecheck/should_fail/T6078.stderr | 10 +- testsuite/tests/typecheck/should_fail/all.T | 10 +- testsuite/tests/typecheck/should_fail/tcfail203.hs | 1 + .../tests/typecheck/should_fail/tcfail203.stderr | 66 ++-- .../tests/typecheck/should_fail/tcfail203a.stderr | 9 +- .../tests/typecheck/should_run/EtaExpandLevPoly.hs | 32 ++ .../typecheck/should_run/EtaExpandLevPoly.stdout | 4 + .../typecheck/should_run/KindInvariant.stderr | 2 +- testsuite/tests/typecheck/should_run/StrictPats.hs | 122 ++++++++ .../tests/typecheck/should_run/StrictPats.stdout | 19 ++ testsuite/tests/typecheck/should_run/T12809.hs | 44 +++ testsuite/tests/typecheck/should_run/T12809.stdout | 4 + testsuite/tests/typecheck/should_run/TypeOf.hs | 4 +- testsuite/tests/typecheck/should_run/TypeOf.stdout | 2 +- testsuite/tests/typecheck/should_run/TypeRep.hs | 4 +- .../tests/typecheck/should_run/TypeRep.stdout | 2 +- testsuite/tests/typecheck/should_run/all.T | 3 + testsuite/tests/unboxedsums/T12711.stdout | 3 +- testsuite/tests/unboxedsums/UbxSumLevPoly.hs | 12 + testsuite/tests/unboxedsums/all.T | 4 +- testsuite/tests/unboxedsums/sum_rr.hs | 4 +- testsuite/tests/unboxedsums/sum_rr.stderr | 7 - .../tests/unboxedsums/unboxedsums_unit_tests.hs | 2 +- utils/haddock | 2 +- 163 files changed, 2522 insertions(+), 1462 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc e7985ed23ddc68b6a2e4af753578dc1d9e8ab4c9 From git at git.haskell.org Thu Jan 19 19:45:31 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 19 Jan 2017 19:45:31 +0000 (UTC) Subject: [commit: ghc] master: Fix the GHC 7.10 build (f5bea98) Message-ID: <20170119194531.04F163A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f5bea9820eb5d573718d9a5e82c3f5acd7dbb734/ghc >--------------------------------------------------------------- commit f5bea9820eb5d573718d9a5e82c3f5acd7dbb734 Author: Ryan Scott Date: Thu Jan 19 14:43:25 2017 -0500 Fix the GHC 7.10 build Following e7985ed23ddc68b6a2e4af753578dc1d9e8ab4c9. HasDebugCallStack now appears in IdInfo, which requires `FlexibleContexts` to be enabled when built with GHC 7.10. >--------------------------------------------------------------- f5bea9820eb5d573718d9a5e82c3f5acd7dbb734 compiler/basicTypes/IdInfo.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/compiler/basicTypes/IdInfo.hs b/compiler/basicTypes/IdInfo.hs index 3c6727c..b364326 100644 --- a/compiler/basicTypes/IdInfo.hs +++ b/compiler/basicTypes/IdInfo.hs @@ -9,6 +9,7 @@ Haskell. [WDP 94/11]) -} {-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleContexts #-} module IdInfo ( -- * The IdDetails type From git at git.haskell.org Thu Jan 19 21:22:25 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 19 Jan 2017 21:22:25 +0000 (UTC) Subject: [commit: ghc] master: Don't error on missing Perl, just warn and disable object splitting. (f07a6c1) Message-ID: <20170119212225.6B9CD3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f07a6c17a3d6b32cc64b0b8318a05177fc098630/ghc >--------------------------------------------------------------- commit f07a6c17a3d6b32cc64b0b8318a05177fc098630 Author: Demi Obenour Date: Thu Jan 19 16:18:30 2017 -0500 Don't error on missing Perl, just warn and disable object splitting. Summary: If Perl isn't needed, we don't need to error out. Since all Perl is used for is the splitter, we can just warn. Test Plan: GHC CI Reviewers: bgamari, hvr, austin Reviewed By: bgamari Subscribers: thomie, erikd Differential Revision: https://phabricator.haskell.org/D2986 GHC Trac Issues: #13141 >--------------------------------------------------------------- f07a6c17a3d6b32cc64b0b8318a05177fc098630 configure.ac | 32 ++++++++------------------------ 1 file changed, 8 insertions(+), 24 deletions(-) diff --git a/configure.ac b/configure.ac index b3d2e17..4502c53 100644 --- a/configure.ac +++ b/configure.ac @@ -399,24 +399,6 @@ FP_CURSES XCODE_VERSION() -SplitObjsBroken=NO -if test "$TargetOS_CPP" = "darwin" -then - # Split objects is broken (#4013) with XCode < 3.2 - if test "$XCodeVersion1" -lt 3 - then - SplitObjsBroken=YES - else - if test "$XCodeVersion1" -eq 3 - then - if test "$XCodeVersion2" -lt 2 - then - SplitObjsBroken=YES - fi - fi - fi -fi -AC_SUBST([SplitObjsBroken]) dnl ** Building a cross compiler? dnl -------------------------------------------------------------- @@ -600,23 +582,25 @@ AC_SUBST([GhcLibsWithUnix]) dnl ** does #! work? AC_SYS_INTERPRETER() +# Check for split-objs +SplitObjsBroken=NO dnl ** look for `perl' case $HostOS_CPP in cygwin32|mingw32) - PerlCmd=$hardtop/inplace/perl/perl - ;; + PerlCmd=$hardtop/inplace/perl/perl + ;; *) - AC_PATH_PROG(PerlCmd,perl) + AC_PATH_PROG([PerlCmd],[perl]) if test -z "$PerlCmd" then - echo "You must install perl before you can continue" - echo "Perhaps it is already installed, but not in your PATH?" - exit 1 + AC_MSG_WARN([No Perl on PATH, disabling split object support]) + SplitObjsBroken=YES else FPTOOLS_CHECK_PERL_VERSION fi ;; esac +AC_SUBST([SplitObjsBroken]) dnl ** look for GCC and find out which version dnl Figure out which C compiler to use. Gcc is preferred. From git at git.haskell.org Thu Jan 19 21:23:54 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 19 Jan 2017 21:23:54 +0000 (UTC) Subject: [commit: packages/hpc] master: Bump upper bound on time allow 1.9 (c23cad3) Message-ID: <20170119212354.2D3E53A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/hpc On branch : master Link : http://git.haskell.org/packages/hpc.git/commitdiff/c23cad32f408559ba95b880c04dc1a2c60ec3d01 >--------------------------------------------------------------- commit c23cad32f408559ba95b880c04dc1a2c60ec3d01 Author: Ben Gamari Date: Thu Jan 19 16:22:34 2017 -0500 Bump upper bound on time allow 1.9 >--------------------------------------------------------------- c23cad32f408559ba95b880c04dc1a2c60ec3d01 hpc.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/hpc.cabal b/hpc.cabal index 09e5c01..da0bbfe 100644 --- a/hpc.cabal +++ b/hpc.cabal @@ -39,5 +39,5 @@ Library containers >= 0.4.1 && < 0.6, directory >= 1.1 && < 1.4, filepath >= 1 && < 1.5, - time >= 1.2 && < 1.8 + time >= 1.2 && < 1.9 ghc-options: -Wall From git at git.haskell.org Thu Jan 19 21:43:16 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 19 Jan 2017 21:43:16 +0000 (UTC) Subject: [commit: ghc] master: Add explicit foldMap implementation for Maybe (bf1e1f3) Message-ID: <20170119214316.AB8233A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/bf1e1f3206f8b274c3ffa33cd7688a0b17eabd0b/ghc >--------------------------------------------------------------- commit bf1e1f3206f8b274c3ffa33cd7688a0b17eabd0b Author: David Feuer Date: Thu Jan 19 16:40:06 2017 -0500 Add explicit foldMap implementation for Maybe Eric Mertens pointed out that using the default `foldMap` implementation for `Maybe` led to an efficiency problem by implementing `foldMap f (Just x)` as `f x <> mempty` rather than as `f x`. This should solve the problem. Reviewers: hvr, austin, bgamari Reviewed By: bgamari Subscribers: glguy, thomie Differential Revision: https://phabricator.haskell.org/D2988 >--------------------------------------------------------------- bf1e1f3206f8b274c3ffa33cd7688a0b17eabd0b libraries/base/Data/Foldable.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/libraries/base/Data/Foldable.hs b/libraries/base/Data/Foldable.hs index ce097df..0a8b003 100644 --- a/libraries/base/Data/Foldable.hs +++ b/libraries/base/Data/Foldable.hs @@ -270,6 +270,8 @@ class Foldable t where -- | @since 2.01 instance Foldable Maybe where + foldMap = maybe mempty + foldr _ z Nothing = z foldr f z (Just x) = f x z From git at git.haskell.org Fri Jan 20 14:39:25 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 20 Jan 2017 14:39:25 +0000 (UTC) Subject: [commit: ghc] master: Fix a nasty bug in exprIsExpandable (9be18ea) Message-ID: <20170120143925.03E953A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9be18ea4e5cbc53ce7769a30275332d68a4ab6b9/ghc >--------------------------------------------------------------- commit 9be18ea4e5cbc53ce7769a30275332d68a4ab6b9 Author: Simon Peyton Jones Date: Fri Jan 20 11:02:36 2017 +0000 Fix a nasty bug in exprIsExpandable This bug has been lurking for ages: Trac #13155 The important semantic change is to ensure that exprIsExpandable returns False for primop calls. Previously exprIsExpandable used exprIsCheap' which always used primOpIsCheap. I took the opportunity to combine the code for exprIsCheap' (two variants: exprIsCheap and exprIsExpandable) with that for exprIsWorkFree. Result is simpler, tighter, easier to understand. And correct (at least wrt this bug)! >--------------------------------------------------------------- 9be18ea4e5cbc53ce7769a30275332d68a4ab6b9 compiler/coreSyn/CoreArity.hs | 4 +- compiler/coreSyn/CoreUtils.hs | 270 +++++++++++---------- testsuite/tests/simplCore/should_compile/Makefile | 4 + testsuite/tests/simplCore/should_compile/T13155.hs | 18 ++ .../should_compile/T13155.stdout} | 0 testsuite/tests/simplCore/should_compile/all.T | 1 + 6 files changed, 165 insertions(+), 132 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 9be18ea4e5cbc53ce7769a30275332d68a4ab6b9 From git at git.haskell.org Fri Jan 20 14:39:28 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 20 Jan 2017 14:39:28 +0000 (UTC) Subject: [commit: ghc] master: Simplify and improve CSE (b78fa75) Message-ID: <20170120143928.8E81E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b78fa759bfb405e3dc20d5e4bbb088989d17eb8b/ghc >--------------------------------------------------------------- commit b78fa759bfb405e3dc20d5e4bbb088989d17eb8b Author: Simon Peyton Jones Date: Fri Jan 20 12:05:16 2017 +0000 Simplify and improve CSE Trac #13156 showed a lost opportunity for CSE. I found that it was easy to fix, and it had the nice side effect of rendering a previous nasty case, described in Note [Corner case for case expressions], unnecessary. Simpler code, does more. Great. >--------------------------------------------------------------- b78fa759bfb405e3dc20d5e4bbb088989d17eb8b compiler/simplCore/CSE.hs | 70 ++++++++++++---------- testsuite/tests/simplCore/should_compile/Makefile | 5 ++ testsuite/tests/simplCore/should_compile/T13156.hs | 42 +++++++++++++ .../tests/simplCore/should_compile/T13156.stdout | 2 + testsuite/tests/simplCore/should_compile/all.T | 2 +- 5 files changed, 89 insertions(+), 32 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc b78fa759bfb405e3dc20d5e4bbb088989d17eb8b From git at git.haskell.org Fri Jan 20 14:39:31 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 20 Jan 2017 14:39:31 +0000 (UTC) Subject: [commit: ghc] master: Test Trac #11444 (b8f1b01) Message-ID: <20170120143931.D55E53A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b8f1b018312d83a4c7a760ef3a5cf2bb067bfbf0/ghc >--------------------------------------------------------------- commit b8f1b018312d83a4c7a760ef3a5cf2bb067bfbf0 Author: Simon Peyton Jones Date: Fri Jan 20 14:22:22 2017 +0000 Test Trac #11444 >--------------------------------------------------------------- b8f1b018312d83a4c7a760ef3a5cf2bb067bfbf0 testsuite/tests/simplCore/should_compile/T11444.hs | 9 +++++++++ testsuite/tests/simplCore/should_compile/all.T | 1 + 2 files changed, 10 insertions(+) diff --git a/testsuite/tests/simplCore/should_compile/T11444.hs b/testsuite/tests/simplCore/should_compile/T11444.hs new file mode 100644 index 0000000..0f79392 --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T11444.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE MagicHash, BangPatterns #-} + +-- Produces a Lint error in GHC 8.0 + +module T11444 where +import GHC.Exts (reallyUnsafePtrEquality#, Int (..)) + +ptrEq :: a -> a -> Bool +ptrEq !x !y = I# (reallyUnsafePtrEquality# x y) == 1 diff --git a/testsuite/tests/simplCore/should_compile/all.T b/testsuite/tests/simplCore/should_compile/all.T index 87d10e4..19e9f1d 100644 --- a/testsuite/tests/simplCore/should_compile/all.T +++ b/testsuite/tests/simplCore/should_compile/all.T @@ -262,3 +262,4 @@ test('T13025', run_command, ['$MAKE -s --no-print-directory T13025']) test('T13156', normal, run_command, ['$MAKE -s --no-print-directory T13156']) +test('T11444', normal, compile, ['']) From git at git.haskell.org Fri Jan 20 18:06:24 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 20 Jan 2017 18:06:24 +0000 (UTC) Subject: [commit: ghc] master: check-cpp.py: change rb'foo' to br'foo' for Python 3.2 compatibility (5ff812c) Message-ID: <20170120180624.F160B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5ff812c14594f507c48121f16be4752eee6e3c88/ghc >--------------------------------------------------------------- commit 5ff812c14594f507c48121f16be4752eee6e3c88 Author: Reid Barton Date: Fri Jan 20 13:04:58 2017 -0500 check-cpp.py: change rb'foo' to br'foo' for Python 3.2 compatibility >--------------------------------------------------------------- 5ff812c14594f507c48121f16be4752eee6e3c88 .arc-linters/check-cpp.py | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.arc-linters/check-cpp.py b/.arc-linters/check-cpp.py index 7abbc31..d81e58b 100755 --- a/.arc-linters/check-cpp.py +++ b/.arc-linters/check-cpp.py @@ -25,7 +25,7 @@ logger.debug(sys.argv) path = sys.argv[1] warnings = [] -r = re.compile(rb'ASSERT\s+\(') +r = re.compile(br'ASSERT\s+\(') if os.path.isfile(path): with open(path, 'rb') as f: for lineno, line in enumerate(f): From git at git.haskell.org Fri Jan 20 18:43:09 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 20 Jan 2017 18:43:09 +0000 (UTC) Subject: [commit: ghc] master: Add 'type family (m :: Symbol) <> (n :: Symbol)' (7026edc) Message-ID: <20170120184309.B5C773A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7026edc37331d067c47e4a3506590a39c22f82d3/ghc >--------------------------------------------------------------- commit 7026edc37331d067c47e4a3506590a39c22f82d3 Author: Oleg Grenrus Date: Thu Jan 19 15:19:25 2017 -0500 Add 'type family (m :: Symbol) <> (n :: Symbol)' Reviewers: dfeuer, austin, bgamari, hvr Subscribers: dfeuer, mpickering, RyanGlScott, ekmett, yav, lelf, simonpj, thomie Differential Revision: https://phabricator.haskell.org/D2632 GHC Trac Issues: #12162 >--------------------------------------------------------------- 7026edc37331d067c47e4a3506590a39c22f82d3 compiler/prelude/PrelNames.hs | 3 + compiler/typecheck/TcTypeNats.hs | 98 ++++++++++++++++++++-- docs/users_guide/8.2.1-notes.rst | 3 + libraries/base/GHC/TypeLits.hs | 5 ++ libraries/base/changelog.md | 3 + testsuite/tests/ghci/scripts/T9181.stdout | 3 + .../typecheck/should_compile/TcTypeSymbolSimple.hs | 28 +++++++ testsuite/tests/typecheck/should_compile/all.T | 1 + .../typecheck/should_run/TcTypeNatSimpleRun.hs | 12 ++- .../typecheck/should_run/TcTypeNatSimpleRun.stdout | 2 +- .../typecheck/should_run/TcTypeSymbolSimpleRun.hs | 22 +++++ .../should_run/TcTypeSymbolSimpleRun.stdout | 1 + testsuite/tests/typecheck/should_run/all.T | 1 + 13 files changed, 172 insertions(+), 10 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 7026edc37331d067c47e4a3506590a39c22f82d3 From git at git.haskell.org Fri Jan 20 18:43:12 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 20 Jan 2017 18:43:12 +0000 (UTC) Subject: [commit: ghc] master: Bump Cabal submodule (a2a67b7) Message-ID: <20170120184312.6F2913A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a2a67b77c3048713541d1ed96ec0b95fb2542f9a/ghc >--------------------------------------------------------------- commit a2a67b77c3048713541d1ed96ec0b95fb2542f9a Author: Ben Gamari Date: Fri Jan 20 10:30:04 2017 -0500 Bump Cabal submodule >--------------------------------------------------------------- a2a67b77c3048713541d1ed96ec0b95fb2542f9a libraries/Cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/Cabal b/libraries/Cabal index 09865f6..7502659 160000 --- a/libraries/Cabal +++ b/libraries/Cabal @@ -1 +1 @@ -Subproject commit 09865f60caa55a7b02880f2a779c9dd8e1be5ac0 +Subproject commit 7502659b7684e057047c68886df9c061645992c6 From git at git.haskell.org Fri Jan 20 19:53:00 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 20 Jan 2017 19:53:00 +0000 (UTC) Subject: [commit: ghc] master: Allow top-level string literals in Core (#8472) (d49b2bb) Message-ID: <20170120195300.ED68D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d49b2bb21691892ca6ac8f2403e31f2a5e53feb3/ghc >--------------------------------------------------------------- commit d49b2bb21691892ca6ac8f2403e31f2a5e53feb3 Author: Takano Akio Date: Wed Jan 18 18:26:47 2017 -0500 Allow top-level string literals in Core (#8472) This commits relaxes the invariants of the Core syntax so that a top-level variable can be bound to a primitive string literal of type Addr#. This commit: * Relaxes the invatiants of the Core, and allows top-level bindings whose type is Addr# as long as their RHS is either a primitive string literal or another variable. * Allows the simplifier and the full-laziness transformer to float out primitive string literals to the top leve. * Introduces the new StgGenTopBinding type to accomodate top-level Addr# bindings. * Introduces a new type of labels in the object code, with the suffix "_bytes", for exported top-level Addr# bindings. * Makes some built-in rules more robust. This was necessary to keep them functional after the above changes. This is a continuation of D2554. Rebasing notes: This had two slightly suspicious performance regressions: * T12425: bytes allocated regressed by roughly 5% * T4029: bytes allocated regressed by a bit over 1% * T13035: bytes allocated regressed by a bit over 5% These deserve additional investigation. Rebased by: bgamari. Test Plan: ./validate --slow Reviewers: goldfire, trofi, simonmar, simonpj, austin, hvr, bgamari Reviewed By: trofi, simonpj, bgamari Subscribers: trofi, simonpj, gridaphobe, thomie Differential Revision: https://phabricator.haskell.org/D2605 GHC Trac Issues: #8472 >--------------------------------------------------------------- d49b2bb21691892ca6ac8f2403e31f2a5e53feb3 compiler/cmm/CLabel.hs | 13 ++++ compiler/cmm/CmmInfo.hs | 2 +- compiler/cmm/CmmUtils.hs | 9 +-- compiler/codeGen/StgCmm.hs | 17 ++++- compiler/codeGen/StgCmmClosure.hs | 5 ++ compiler/codeGen/StgCmmEnv.hs | 14 +++- compiler/codeGen/StgCmmUtils.hs | 2 +- compiler/coreSyn/CoreLint.hs | 22 +++++- compiler/coreSyn/CorePrep.hs | 4 +- compiler/coreSyn/CoreSubst.hs | 2 +- compiler/coreSyn/CoreSyn.hs | 44 ++++++++++- compiler/coreSyn/CoreUtils.hs | 12 +++ compiler/ghci/ByteCodeAsm.hs | 7 +- compiler/ghci/ByteCodeGen.hs | 73 ++++++++++++++---- compiler/main/HscMain.hs | 4 +- compiler/prelude/PrelRules.hs | 41 ++++++----- compiler/profiling/SCCfinal.hs | 18 +++-- compiler/simplCore/CSE.hs | 57 ++++++++++---- compiler/simplCore/SetLevels.hs | 11 +-- compiler/simplCore/SimplEnv.hs | 6 +- compiler/simplCore/Simplify.hs | 18 +++-- compiler/simplStg/SimplStg.hs | 12 +-- compiler/simplStg/StgCse.hs | 13 ++-- compiler/simplStg/StgStats.hs | 12 +-- compiler/simplStg/UnariseStg.hs | 9 ++- compiler/stgSyn/CoreToStg.hs | 19 +++-- compiler/stgSyn/StgLint.hs | 17 +++-- compiler/stgSyn/StgSyn.hs | 67 ++++++++++++----- docs/core-spec/core-spec.mng | 4 +- .../tests/deSugar/should_compile/T2431.stderr | 44 ++++++++--- .../tests/numeric/should_compile/T7116.stdout | 30 ++++++-- testsuite/tests/perf/compiler/all.T | 17 +++-- testsuite/tests/perf/should_run/T8472.hs | 19 +++++ .../tests/perf/should_run/T8472.stdout | 0 testsuite/tests/perf/should_run/all.T | 8 ++ testsuite/tests/perf/space_leaks/all.T | 3 +- .../tests/roles/should_compile/Roles13.stderr | 66 ++++++++++++----- testsuite/tests/simplCore/should_compile/Makefile | 5 ++ .../tests/simplCore/should_compile/T3234.stderr | 9 ++- .../tests/simplCore/should_compile/T3717.stderr | 30 ++++++-- .../tests/simplCore/should_compile/T3772.stdout | 30 ++++++-- .../tests/simplCore/should_compile/T4908.stderr | 30 ++++++-- .../tests/simplCore/should_compile/T4930.stderr | 30 ++++++-- .../tests/simplCore/should_compile/T7360.stderr | 86 +++++++++++++++++----- .../tests/simplCore/should_compile/T8274.stdout | 18 +++-- .../tests/simplCore/should_compile/T9400.stderr | 22 ++++-- testsuite/tests/simplCore/should_compile/all.T | 4 + .../simplCore/should_compile/noinline01.stderr | 32 ++++++-- .../tests/simplCore/should_compile/par01.stderr | 20 +++-- .../tests/simplCore/should_compile/rule2.stderr | 4 +- .../simplCore/should_compile/spec-inline.stderr | 40 +++++++--- .../tests/simplCore/should_compile/str-rules.hs | 20 +++++ .../simplCore/should_compile/str-rules.stdout | 3 + 53 files changed, 829 insertions(+), 275 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc d49b2bb21691892ca6ac8f2403e31f2a5e53feb3 From git at git.haskell.org Fri Jan 20 21:45:28 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 20 Jan 2017 21:45:28 +0000 (UTC) Subject: [commit: ghc] master: Show explicit quantifiers in conflicting definitions error (33140f4) Message-ID: <20170120214528.330B23A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/33140f41b931fb81bf2e5aa28603fe757bb3779d/ghc >--------------------------------------------------------------- commit 33140f41b931fb81bf2e5aa28603fe757bb3779d Author: Phil de Joux Date: Fri Jan 20 14:59:44 2017 -0500 Show explicit quantifiers in conflicting definitions error This fixes #12441, where definitions in a Haskell module and its boot file which differed only in their quantifiers produced a confusing error message. Here we teach GHC to always show quantifiers for these errors. Reviewers: goldfire, simonmar, erikd, austin, hvr, bgamari Reviewed By: bgamari Subscribers: snowleopard, simonpj, mpickering, thomie Differential Revision: https://phabricator.haskell.org/D2734 GHC Trac Issues: #12441 >--------------------------------------------------------------- 33140f41b931fb81bf2e5aa28603fe757bb3779d compiler/ghci/Debugger.hs | 3 +- compiler/iface/IfaceSyn.hs | 146 +++++++++++++-------- compiler/iface/IfaceType.hs | 42 +++--- compiler/iface/IfaceType.hs-boot | 3 +- compiler/main/HscTypes.hs | 2 +- compiler/main/PprTyThing.hs | 69 +++++----- compiler/typecheck/TcRnDriver.hs | 45 +++++-- compiler/types/TyCoRep.hs | 2 +- ghc/GHCi/UI.hs | 9 +- testsuite/tests/codeGen/should_run/T12855.hs | 1 - testsuite/tests/ghci/scripts/T11051b.stdout | 2 +- testsuite/tests/ghci/scripts/ghci025.stdout | 52 +++----- .../tests/partial-sigs/should_compile/T12844.hs | 1 - testsuite/tests/typecheck/T12441/T12441.hs | 5 + testsuite/tests/typecheck/T12441/T12441.hs-boot | 3 + testsuite/tests/typecheck/T12441/T12441.stderr | 10 ++ testsuite/tests/typecheck/T12441/T12441A.hs | 2 + testsuite/tests/typecheck/T12441/all.T | 4 + .../tests/typecheck/should_compile/Improvement.hs | 2 - 19 files changed, 235 insertions(+), 168 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 33140f41b931fb81bf2e5aa28603fe757bb3779d From git at git.haskell.org Fri Jan 20 21:45:31 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 20 Jan 2017 21:45:31 +0000 (UTC) Subject: [commit: ghc] master: Add a failing test for #13099 (b476131) Message-ID: <20170120214531.CCAD23A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b47613178232f8e849ac58ebd4111a34ab9c140b/ghc >--------------------------------------------------------------- commit b47613178232f8e849ac58ebd4111a34ab9c140b Author: Reid Barton Date: Fri Jan 20 15:03:44 2017 -0500 Add a failing test for #13099 Reviewers: austin, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2990 GHC Trac Issues: #13099 >--------------------------------------------------------------- b47613178232f8e849ac58ebd4111a34ab9c140b .../T11062.hs-boot => driver/recomp017/A.hs} | 2 +- testsuite/tests/driver/recomp017/B.hs | 7 +++++++ testsuite/tests/driver/recomp017/C.hs | 5 +++++ testsuite/tests/driver/recomp017/C2.hs | 5 +++++ testsuite/tests/driver/recomp017/D.hs | 3 +++ testsuite/tests/driver/recomp017/E.hs | 10 ++++++++++ testsuite/tests/driver/recomp017/Makefile | 21 +++++++++++++++++++++ testsuite/tests/driver/recomp017/all.T | 11 +++++++++++ 8 files changed, 63 insertions(+), 1 deletion(-) diff --git a/testsuite/tests/typecheck/should_compile/T11062.hs-boot b/testsuite/tests/driver/recomp017/A.hs similarity index 69% copy from testsuite/tests/typecheck/should_compile/T11062.hs-boot copy to testsuite/tests/driver/recomp017/A.hs index fb56005..8f9d7c1 100644 --- a/testsuite/tests/typecheck/should_compile/T11062.hs-boot +++ b/testsuite/tests/driver/recomp017/A.hs @@ -1,3 +1,3 @@ {-# LANGUAGE TypeFamilies #-} -module T11062 where +module A where type family F a diff --git a/testsuite/tests/driver/recomp017/B.hs b/testsuite/tests/driver/recomp017/B.hs new file mode 100644 index 0000000..10f8423 --- /dev/null +++ b/testsuite/tests/driver/recomp017/B.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE TypeFamilies #-} +module B where +import A +data B +type instance F (B,b) = () +b :: () -> F (B,b) +b = id diff --git a/testsuite/tests/driver/recomp017/C.hs b/testsuite/tests/driver/recomp017/C.hs new file mode 100644 index 0000000..a6d1af0 --- /dev/null +++ b/testsuite/tests/driver/recomp017/C.hs @@ -0,0 +1,5 @@ +{-# LANGUAGE TypeFamilies #-} +module C where +import A +data C +type instance F (a,C) = () diff --git a/testsuite/tests/driver/recomp017/C2.hs b/testsuite/tests/driver/recomp017/C2.hs new file mode 100644 index 0000000..551de2b --- /dev/null +++ b/testsuite/tests/driver/recomp017/C2.hs @@ -0,0 +1,5 @@ +{-# LANGUAGE TypeFamilies #-} +module C where +import A +data C +type instance F (a,C) = Bool diff --git a/testsuite/tests/driver/recomp017/D.hs b/testsuite/tests/driver/recomp017/D.hs new file mode 100644 index 0000000..8ed80ad --- /dev/null +++ b/testsuite/tests/driver/recomp017/D.hs @@ -0,0 +1,3 @@ +module D (b) where +import B +import C diff --git a/testsuite/tests/driver/recomp017/E.hs b/testsuite/tests/driver/recomp017/E.hs new file mode 100644 index 0000000..326a03d --- /dev/null +++ b/testsuite/tests/driver/recomp017/E.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE TypeApplications #-} +module E where +import A +import B +import C +import D +c :: F (a, C) -> Bool +c = id +e :: () -> Bool +e = c . b @ C diff --git a/testsuite/tests/driver/recomp017/Makefile b/testsuite/tests/driver/recomp017/Makefile new file mode 100644 index 0000000..6a2f92a --- /dev/null +++ b/testsuite/tests/driver/recomp017/Makefile @@ -0,0 +1,21 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +# Recompilation tests + +clean: + rm -f *.o *.hi + +# bug #13099 + +recomp017: clean + echo 'first run' + '$(TEST_HC)' $(TEST_HC_OPTS) --make D.hs + sleep 1 + # A simple 'cp' would overwrite the original file, + # pointed to by the symlink + mv -f C2.hs C.hs + touch C.hs + echo 'second run' + ! '$(TEST_HC)' $(TEST_HC_OPTS) --make E.hs diff --git a/testsuite/tests/driver/recomp017/all.T b/testsuite/tests/driver/recomp017/all.T new file mode 100644 index 0000000..1ba5343 --- /dev/null +++ b/testsuite/tests/driver/recomp017/all.T @@ -0,0 +1,11 @@ +# Test for #13099, a recompilation bug involving type family instances + +test('recomp017', + [ clean_cmd('$MAKE -s clean'), + extra_files(['A.hs', 'B.hs', 'C.hs', 'C2.hs', + 'D.hs', 'E.hs']), + ignore_stdout, + expect_broken(13099) ], + run_command, + ['$MAKE -s --no-print-directory recomp017']) + From git at git.haskell.org Fri Jan 20 22:25:55 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 20 Jan 2017 22:25:55 +0000 (UTC) Subject: [commit: ghc] master: testsuite: Don't fail if "target has RTS linker" field is missing (b626a00) Message-ID: <20170120222555.42CCC3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b626a00113ecdb960ba642f0ce31e2ff71892b4d/ghc >--------------------------------------------------------------- commit b626a00113ecdb960ba642f0ce31e2ff71892b4d Author: Reid Barton Date: Fri Jan 20 16:49:37 2017 -0500 testsuite: Don't fail if "target has RTS linker" field is missing Test Plan: harbormaster Reviewers: austin, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2991 >--------------------------------------------------------------- b626a00113ecdb960ba642f0ce31e2ff71892b4d testsuite/config/ghc | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/testsuite/config/ghc b/testsuite/config/ghc index b126580..959422e 100644 --- a/testsuite/config/ghc +++ b/testsuite/config/ghc @@ -166,7 +166,10 @@ def get_compiler_info(): rtsInfoDict = dict(eval(s)) # external interpreter needs RTS linker support - config.have_ext_interp = compilerInfoDict["target has RTS linker"] == "YES" + # If the field is not present (GHC 8.0 and earlier), assume we don't + # have -fexternal-interpreter (though GHC 8.0 actually does) + # so we can still run most tests. + config.have_ext_interp = compilerInfoDict.get("target has RTS linker", "NO") == "YES" # See Note [Replacing backward slashes in config.libdir]. config.libdir = compilerInfoDict['LibDir'].replace('\\', '/') From git at git.haskell.org Fri Jan 20 22:26:01 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 20 Jan 2017 22:26:01 +0000 (UTC) Subject: [commit: ghc] master: Warn on missing home modules (15b9a85) Message-ID: <20170120222601.7283C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/15b9a85ef03e2729d487a6f8460be8880c797609/ghc >--------------------------------------------------------------- commit 15b9a85ef03e2729d487a6f8460be8880c797609 Author: Yuras Shumovich Date: Fri Jan 20 16:53:45 2017 -0500 Warn on missing home modules Introduce a warning, -Wmissing-home-modules, to warn about home modules, not listed in command line. It is usefull for cabal when user fails to list a module in `exposed-modules` and `other-modules`. Test Plan: make TEST=MissingMod Reviewers: mpickering, austin, bgamari Reviewed By: bgamari Subscribers: simonpj, mpickering, thomie Differential Revision: https://phabricator.haskell.org/D2977 GHC Trac Issues: #13129 >--------------------------------------------------------------- 15b9a85ef03e2729d487a6f8460be8880c797609 compiler/main/DynFlags.hs | 2 ++ compiler/main/GhcMake.hs | 39 ++++++++++++++++++++++ docs/users_guide/using-warnings.rst | 13 +++++++- .../tests/warnings/should_compile/MissingMod.hs | 4 +++ .../warnings/should_compile/MissingMod.stderr | 5 +++ .../tests/warnings/should_compile/MissingMod1.hs | 2 ++ testsuite/tests/warnings/should_compile/all.T | 2 ++ utils/mkUserGuidePart/Options/Warnings.hs | 9 +++++ 8 files changed, 75 insertions(+), 1 deletion(-) diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index bcd5a25..6dbd723 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -636,6 +636,7 @@ data WarningFlag = | Opt_WarnSimplifiableClassConstraints -- Since 8.2 | Opt_WarnCPPUndef -- Since 8.2 | Opt_WarnUnbangedStrictPatterns -- Since 8.2 + | Opt_WarnMissingHomeModules -- Since 8.2 deriving (Eq, Show, Enum) data Language = Haskell98 | Haskell2010 @@ -3443,6 +3444,7 @@ wWarningFlagsDeps = [ flagSpec "missing-pattern-synonym-signatures" Opt_WarnMissingPatternSynonymSignatures, flagSpec "simplifiable-class-constraints" Opt_WarnSimplifiableClassConstraints, + flagSpec "missing-home-modules" Opt_WarnMissingHomeModules, flagSpec "unrecognised-warning-flags" Opt_WarnUnrecognisedWarningFlags ] -- | These @-\@ flags can all be reversed with @-no-\@ diff --git a/compiler/main/GhcMake.hs b/compiler/main/GhcMake.hs index be6510b..f74d097 100644 --- a/compiler/main/GhcMake.hs +++ b/compiler/main/GhcMake.hs @@ -132,9 +132,48 @@ depanal excluded_mods allow_dup_roots = do mod_graphE <- liftIO $ downsweep hsc_env old_graph excluded_mods allow_dup_roots mod_graph <- reportImportErrors mod_graphE + + warnMissingHomeModules hsc_env mod_graph + setSession hsc_env { hsc_mod_graph = mod_graph } return mod_graph +-- Note [Missing home modules] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- Sometimes user doesn't want GHC to pick up modules, not explicitly listed +-- in a command line. For example, cabal may want to enable this warning +-- when building a library, so that GHC warns user about modules, not listed +-- neither in `exposed-modules`, nor in `other-modules`. +-- +-- Here "home module" means a module, that doesn't come from an other package. +-- +-- For example, if GHC is invoked with modules "A" and "B" as targets, +-- but "A" imports some other module "C", then GHC will issue a warning +-- about module "C" not being listed in a command line. +-- +-- The warning in enabled by `-Wmissing-home-modules`. See Trac #13129 +warnMissingHomeModules :: GhcMonad m => HscEnv -> ModuleGraph -> m () +warnMissingHomeModules hsc_env mod_graph = + when (wopt Opt_WarnMissingHomeModules dflags && not (null missing)) $ + logWarnings (listToBag [warn]) + where + dflags = hsc_dflags hsc_env + missing = filter (`notElem` targets) imports + imports = map (moduleName . ms_mod) mod_graph + targets = map (targetid_to_name . targetId) (hsc_targets hsc_env) + + msg = text "Modules are not listed in command line: " + <> sep (map ppr missing) + warn = makeIntoWarning + (Reason Opt_WarnMissingHomeModules) + (mkPlainErrMsg dflags noSrcSpan msg) + + targetid_to_name (TargetModule name) = name + targetid_to_name (TargetFile file _) = + -- We can get a file even if module name in specified in command line + -- because it can be converted in guessTarget. So lets convert it back. + mkModuleName (fst $ splitExtension file) + -- | Describes which modules of the module graph need to be loaded. data LoadHowMuch = LoadAllTargets diff --git a/docs/users_guide/using-warnings.rst b/docs/users_guide/using-warnings.rst index 21f00c4..de660ed 100644 --- a/docs/users_guide/using-warnings.rst +++ b/docs/users_guide/using-warnings.rst @@ -66,6 +66,7 @@ The following flags are simple ways to select standard "packages" of warnings: * :ghc-flag:`-Wmissing-local-signatures` * :ghc-flag:`-Wmissing-exported-signatures` * :ghc-flag:`-Wmissing-import-lists` + * :ghc-flag:`-Wmissing-home-modules` * :ghc-flag:`-Widentities` .. ghc-flag:: -Wcompat @@ -1035,7 +1036,17 @@ of ``-W(no-)*``. This flag warns whenever you write a pattern that binds a variable whose type is unlifted, and yet the pattern is not a bang pattern nor a bare variable. - See :ref:`glasgow-unboxed` for informatino about unlifted types. + See :ref:`glasgow-unboxed` for information about unlifted types. + +.. ghc-flag:: -Wmissing-home-modules + + :since: 8.2 + + When a module provided by the package currently being compiled + (i.e. the "home" package) is imported, but not explicitly listed in + command line as a target. Useful for Cabal to ensure GHC won't + pick up modules, not listed neither in ``exposed-modules``, nor in + ``other-modules``. If you're feeling really paranoid, the :ghc-flag:`-dcore-lint` option is a good choice. It turns on heavyweight intra-pass sanity-checking within GHC. (It checks GHC's diff --git a/testsuite/tests/warnings/should_compile/MissingMod.hs b/testsuite/tests/warnings/should_compile/MissingMod.hs new file mode 100644 index 0000000..eaf7983 --- /dev/null +++ b/testsuite/tests/warnings/should_compile/MissingMod.hs @@ -0,0 +1,4 @@ +module MissingMod +where + +import MissingMod1 diff --git a/testsuite/tests/warnings/should_compile/MissingMod.stderr b/testsuite/tests/warnings/should_compile/MissingMod.stderr new file mode 100644 index 0000000..0045092 --- /dev/null +++ b/testsuite/tests/warnings/should_compile/MissingMod.stderr @@ -0,0 +1,5 @@ + +: warning: [-Wmissing-home-modules] + Modules are not listed in command line: MissingMod1 +[1 of 2] Compiling MissingMod1 ( MissingMod1.hs, MissingMod1.o ) +[2 of 2] Compiling MissingMod ( MissingMod.hs, MissingMod.o ) diff --git a/testsuite/tests/warnings/should_compile/MissingMod1.hs b/testsuite/tests/warnings/should_compile/MissingMod1.hs new file mode 100644 index 0000000..2e78c23 --- /dev/null +++ b/testsuite/tests/warnings/should_compile/MissingMod1.hs @@ -0,0 +1,2 @@ +module MissingMod1 +where diff --git a/testsuite/tests/warnings/should_compile/all.T b/testsuite/tests/warnings/should_compile/all.T index bb347b0..f7f0194 100644 --- a/testsuite/tests/warnings/should_compile/all.T +++ b/testsuite/tests/warnings/should_compile/all.T @@ -24,3 +24,5 @@ test('DeprU', test('Werror01', normal, compile, ['']) test('Werror02', normal, compile, ['']) + +test('MissingMod', normal, multimod_compile, ['MissingMod', '-Wmissing-home-modules']) diff --git a/utils/mkUserGuidePart/Options/Warnings.hs b/utils/mkUserGuidePart/Options/Warnings.hs index f18222e..f242fb0 100644 --- a/utils/mkUserGuidePart/Options/Warnings.hs +++ b/utils/mkUserGuidePart/Options/Warnings.hs @@ -445,4 +445,13 @@ warningsOptions = , flagType = DynamicFlag , flagReverse = "-Wno-deriving-typeable" } + , flag { flagName = "-Wmissing-home-modules" + , flagDescription = + "warn when encountering a home module imported, but not listed "++ + "on the command line. Useful for cabal to ensure GHC won't pick "++ + "up modules, not listed neither in ``exposed-modules``, nor in "++ + "``other-modules``." + , flagType = DynamicFlag + , flagReverse = "-Wno-missing-home-modules" + } ] From git at git.haskell.org Fri Jan 20 22:25:57 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 20 Jan 2017 22:25:57 +0000 (UTC) Subject: [commit: ghc] master: Clean up some shell code and M4 quoting (c43011d) Message-ID: <20170120222557.EFC883A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c43011da283bfcef664378bb451d5f3bffcdbe92/ghc >--------------------------------------------------------------- commit c43011da283bfcef664378bb451d5f3bffcdbe92 Author: Demi Obenour Date: Fri Jan 20 16:49:53 2017 -0500 Clean up some shell code and M4 quoting Test Plan: GHC CI Reviewers: austin, hvr, bgamari Reviewed By: bgamari Subscribers: thomie, erikd Differential Revision: https://phabricator.haskell.org/D2993 >--------------------------------------------------------------- c43011da283bfcef664378bb451d5f3bffcdbe92 aclocal.m4 | 13 ++++++------- configure.ac | 32 ++++++++++++++++---------------- libraries/base/configure.ac | 6 +++--- 3 files changed, 25 insertions(+), 26 deletions(-) diff --git a/aclocal.m4 b/aclocal.m4 index 4673ac0..75f3e7d 100644 --- a/aclocal.m4 +++ b/aclocal.m4 @@ -1056,15 +1056,14 @@ AC_SUBST([LdHasBuildId]) # ----------------- # Sets the output variable LdIsGNULd to YES or NO, depending on whether it is # GNU ld or not. -AC_DEFUN([FP_PROG_LD_IS_GNU], -[ +AC_DEFUN([FP_PROG_LD_IS_GNU],[ AC_CACHE_CHECK([whether ld is GNU ld], [fp_cv_gnu_ld], -[if ${LdCmd} --version 2> /dev/null | grep "GNU" > /dev/null 2>&1; then - fp_cv_gnu_ld=yes +[[if ${LdCmd} --version 2> /dev/null | grep "GNU" > /dev/null 2>&1; then + fp_cv_gnu_ld=YES else - fp_cv_gnu_ld=no -fi]) -AC_SUBST([LdIsGNULd], [`echo $fp_cv_gnu_ld | sed 'y/yesno/YESNO/'`]) + fp_cv_gnu_ld=NO +fi]]) +AC_SUBST([LdIsGNULd],["$fp_cv_gnu_ld"]) ])# FP_PROG_LD_IS_GNU diff --git a/configure.ac b/configure.ac index 4502c53..a7100cc 100644 --- a/configure.ac +++ b/configure.ac @@ -120,7 +120,7 @@ AC_ARG_VAR(CC_STAGE0, [C compiler command (bootstrap)]) if test "$WithGhc" != ""; then FPTOOLS_GHC_VERSION([GhcVersion], [GhcMajVersion], [GhcMinVersion], [GhcPatchLevel])dnl - if test "$GhcMajVersion" = "unknown" -o "$GhcMinVersion" = "unknown"; then + if test "$GhcMajVersion" = "unknown" || test "$GhcMinVersion" = "unknown"; then AC_MSG_ERROR([Cannot determine the version of $WithGhc. Is it really GHC?]) fi @@ -1144,7 +1144,7 @@ checkMake380 gmake AC_CONFIG_FILES([mk/config.mk mk/install.mk mk/project.mk compiler/ghc.cabal ghc/ghc-bin.cabal utils/runghc/runghc.cabal libraries/ghc-boot/ghc-boot.cabal libraries/ghc-boot-th/ghc-boot-th.cabal libraries/ghci/ghci.cabal settings docs/users_guide/ghc_config.py docs/index.html libraries/prologue.txt utils/mkUserGuidePart/mkUserGuidePart.cabal distrib/configure.ac]) AC_OUTPUT - +[ if test "$print_make_warning" = "true"; then echo echo "WARNING: It looks like \"$MakeCmd\" is GNU make 3.80." @@ -1152,7 +1152,7 @@ if test "$print_make_warning" = "true"; then echo "Please use GNU make >= 3.81." fi -echo [" +echo " ---------------------------------------------------------------------- Configure completed successfully. @@ -1162,12 +1162,12 @@ Configure completed successfully. Build platform : $BuildPlatform Host platform : $HostPlatform Target platform : $TargetPlatform -"] +" -echo ["\ +echo "\ Bootstrapping using : $WithGhc which is version : $GhcVersion -"] +" if test "x$CC_LLVM_BACKEND" = "x1"; then if test "x$CC_CLANG_BACKEND" = "x1"; then @@ -1179,7 +1179,7 @@ else CompilerName="gcc " fi -echo ["\ +echo "\ Using (for bootstrapping) : $CC_STAGE0 Using $CompilerName : $CC which is version : $GccVersion @@ -1198,24 +1198,24 @@ echo ["\ Using LLVM tools llc : $LlcCmd - opt : $OptCmd"] + opt : $OptCmd" if test "$HSCOLOUR" = ""; then -echo [" +echo " HsColour was not found; documentation will not contain source links -"] +" else -echo ["\ +echo "\ HsColour : $HSCOLOUR -"] +" fi -echo ["\ +echo "\ Tools to build Sphinx HTML documentation available: $BUILD_SPHINX_HTML Tools to build Sphinx PDF documentation available: $BUILD_SPHINX_PDF"] -echo ["---------------------------------------------------------------------- -"] +echo "---------------------------------------------------------------------- +" echo "\ For a standard build of GHC (fully optimised with profiling), type (g)make. @@ -1225,4 +1225,4 @@ mk/build.mk.sample to mk/build.mk, and edit the settings in there. For more information on how to configure your GHC build, see http://ghc.haskell.org/trac/ghc/wiki/Building -" +"] diff --git a/libraries/base/configure.ac b/libraries/base/configure.ac index f6816e7..426e571 100644 --- a/libraries/base/configure.ac +++ b/libraries/base/configure.ac @@ -51,11 +51,11 @@ AC_CHECK_FUNCS([epoll_ctl eventfd kevent kevent64 kqueue poll]) # event-related fun -if test "$ac_cv_header_sys_epoll_h" = yes -a "$ac_cv_func_epoll_ctl" = yes; then +if test "$ac_cv_header_sys_epoll_h" = yes && test "$ac_cv_func_epoll_ctl" = yes; then AC_DEFINE([HAVE_EPOLL], [1], [Define if you have epoll support.]) fi -if test "$ac_cv_header_sys_event_h" = yes -a "$ac_cv_func_kqueue" = yes; then +if test "$ac_cv_header_sys_event_h" = yes && test "$ac_cv_func_kqueue" = yes; then AC_DEFINE([HAVE_KQUEUE], [1], [Define if you have kqueue support.]) AC_CHECK_SIZEOF([kev.filter], [], [#include @@ -65,7 +65,7 @@ struct kevent kev;]) struct kevent kev;]) fi -if test "$ac_cv_header_poll_h" = yes -a "$ac_cv_func_poll" = yes; then +if test "$ac_cv_header_poll_h" = yes && test "$ac_cv_func_poll" = yes; then AC_DEFINE([HAVE_POLL], [1], [Define if you have poll support.]) fi From git at git.haskell.org Sat Jan 21 18:00:35 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 21 Jan 2017 18:00:35 +0000 (UTC) Subject: [commit: ghc] master: Always use -Xlinker for -rpath (f9ccad2) Message-ID: <20170121180035.67E753A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f9ccad236fa6042a3abbb655129f47fe9dadceaf/ghc >--------------------------------------------------------------- commit f9ccad236fa6042a3abbb655129f47fe9dadceaf Author: Bartosz Nitka Date: Sat Jan 21 09:59:55 2017 -0800 Always use -Xlinker for -rpath Currently we use `-Wl` which takes a list of comma-separated options. Unfortunately that breaks when you use it with `-rpath` and a path that has commas in them. Buck, the build system, produces paths with commas in them. `-Xlinker` doesn't have this disadvantage and as far as I can tell is supported by both `gcc` and `clang`. Anecdotally `nvcc` supports `-Xlinker`, but not `-Wl`. Test Plan: ./validate, harbourmaster Reviewers: nomeata, simonmar, austin, bgamari, hvr Reviewed By: simonmar, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2971 >--------------------------------------------------------------- f9ccad236fa6042a3abbb655129f47fe9dadceaf compiler/ghci/Linker.hs | 13 ++++--- compiler/main/DriverPipeline.hs | 21 ++++++++++-- compiler/main/SysTools.hs | 3 +- testsuite/driver/extra_files.py | 1 + testsuite/tests/th/TH_linker/Dummy.hs | 1 + testsuite/tests/th/TH_linker/Main.hs | 7 ++++ testsuite/tests/th/TH_linker/Makefile | 40 ++++++++++++++++++++++ testsuite/tests/th/TH_linker/all.T | 4 +++ .../TH_linker/path_with_commas.stdout} | 5 ++- testsuite/tests/th/TH_linker/test.pkg | 7 ++++ 10 files changed, 91 insertions(+), 11 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc f9ccad236fa6042a3abbb655129f47fe9dadceaf From git at git.haskell.org Sun Jan 22 18:40:21 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 22 Jan 2017 18:40:21 +0000 (UTC) Subject: [commit: ghc] master: Revert "Remove unnecessary isTyVar tests in TcType" (560bc28) Message-ID: <20170122184021.8F7E43A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/560bc289fc6a5b308f985d4c84e0cdf1f88c55fd/ghc >--------------------------------------------------------------- commit 560bc289fc6a5b308f985d4c84e0cdf1f88c55fd Author: Ryan Scott Date: Sun Jan 22 12:57:08 2017 -0500 Revert "Remove unnecessary isTyVar tests in TcType" Summary: This reverts commit a0899b2f66a4102a7cf21569889381446ce63833. This is because removing these checks prompts panics in at least two different programs reported in #12785. Test Plan: ./validate Reviewers: simonpj, goldfire, bgamari, austin Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2931 GHC Trac Issues: #12785 >--------------------------------------------------------------- 560bc289fc6a5b308f985d4c84e0cdf1f88c55fd compiler/typecheck/TcType.hs | 24 ++++++++++++++ .../tests/typecheck/should_compile/T12785a.hs | 11 +++++++ testsuite/tests/typecheck/should_compile/all.T | 1 + testsuite/tests/typecheck/should_fail/T12785b.hs | 38 ++++++++++++++++++++++ .../tests/typecheck/should_fail/T12785b.stderr | 26 +++++++++++++++ testsuite/tests/typecheck/should_fail/all.T | 1 + 6 files changed, 101 insertions(+) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 560bc289fc6a5b308f985d4c84e0cdf1f88c55fd From git at git.haskell.org Sun Jan 22 19:44:15 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 22 Jan 2017 19:44:15 +0000 (UTC) Subject: [commit: ghc] master: testsuite: Bump allocations on T5321Fun and T12707 (3f1a21d) Message-ID: <20170122194415.D94283A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3f1a21d9725da96dc3cc5d51d97ee4fcc465db47/ghc >--------------------------------------------------------------- commit 3f1a21d9725da96dc3cc5d51d97ee4fcc465db47 Author: Ben Gamari Date: Sun Jan 22 13:21:47 2017 -0500 testsuite: Bump allocations on T5321Fun and T12707 These are only failing on Darwin, strangely enough, but do so quite reproducibly. >--------------------------------------------------------------- 3f1a21d9725da96dc3cc5d51d97ee4fcc465db47 testsuite/tests/perf/compiler/all.T | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T index 797cbd9..616720a 100644 --- a/testsuite/tests/perf/compiler/all.T +++ b/testsuite/tests/perf/compiler/all.T @@ -503,7 +503,7 @@ test('T5321Fun', # 2014-09-03: 299656164 (specialisation and inlining) # 10/12/2014: 206406188 # Improvements in constraint solver # 2016-04-06: 279922360 x86/Linux - (wordsize(64), 497356688, 5)]) + (wordsize(64), 525895608, 5)]) # prev: 585521080 # 29/08/2012: 713385808 # (increase due to new codegen) # 15/05/2013: 628341952 # (reason for decrease unknown) @@ -520,6 +520,12 @@ test('T5321Fun', # 06/01/2017: 497356688 # Small coercion optimisations # The actual decrease was only 2%; earlier # commits had drifted down + # 22/01/2017: 525895608 # Allow top-level string literals in Core. I'm not + # convinced that this patch is + # responsible for all of this + # change, however. Namely I am + # quite skeptical of the downward + # "drift" reported above ], compile,['']) @@ -932,8 +938,9 @@ test('T13056', test('T12707', [ compiler_stats_num_field('bytes allocated', - [(wordsize(64), 1271577192, 5), + [(wordsize(64), 1348865648, 5), # initial: 1271577192 + # 2017-01-22: 1348865648 Allow top-level strings in Core ]), ], compile, From git at git.haskell.org Sun Jan 22 19:44:13 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 22 Jan 2017 19:44:13 +0000 (UTC) Subject: [commit: ghc] master: Remove clean_cmd and extra_clean usage from .T files (5d38fb6) Message-ID: <20170122194413.078C63A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5d38fb69fd1e7a434ccc3147ae6a17fe0b5b0be3/ghc >--------------------------------------------------------------- commit 5d38fb69fd1e7a434ccc3147ae6a17fe0b5b0be3 Author: Thomas Miedema Date: Sun Jan 22 13:24:13 2017 -0500 Remove clean_cmd and extra_clean usage from .T files The `clean_cmd` and `extra_clean` setup functions don't do anything. Remove them from .T files. Created using https://github.com/thomie/refactor-ghc-testsuite. This diff is a test for the .T-file parser/processor/pretty-printer in that repository. find . -name '*.T' -exec ~/refactor-ghc-testsuite/Main "{}" \; Tests containing inline comments or multiline strings are not modified. Preparation for #12223. Test Plan: Harbormaster Reviewers: austin, hvr, simonmar, mpickering, bgamari Reviewed By: mpickering Subscribers: mpickering Differential Revision: https://phabricator.haskell.org/D3000 GHC Trac Issues: #12223 >--------------------------------------------------------------- 5d38fb69fd1e7a434ccc3147ae6a17fe0b5b0be3 libraries/base/tests/IO/all.T | 78 ++--- libraries/base/tests/all.T | 15 +- testsuite/tests/annotations/should_compile/all.T | 6 +- .../tests/annotations/should_compile/th/all.T | 16 +- testsuite/tests/annotations/should_fail/all.T | 18 +- testsuite/tests/annotations/should_run/all.T | 16 +- testsuite/tests/cabal/T12485/all.T | 5 +- testsuite/tests/cabal/all.T | 103 ++---- testsuite/tests/cabal/pkg02/all.T | 6 +- testsuite/tests/codeGen/should_compile/all.T | 11 +- testsuite/tests/codeGen/should_run/all.T | 3 +- testsuite/tests/concurrent/prog001/all.T | 14 +- testsuite/tests/concurrent/prog002/all.T | 14 +- testsuite/tests/concurrent/prog003/all.T | 25 +- testsuite/tests/concurrent/should_run/all.T | 19 +- testsuite/tests/cpranal/should_compile/all.T | 5 +- testsuite/tests/deSugar/should_compile/all.T | 21 +- testsuite/tests/deriving/should_compile/all.T | 15 +- testsuite/tests/deriving/should_fail/all.T | 9 +- testsuite/tests/deriving/should_run/all.T | 2 +- testsuite/tests/determinism/determ002/all.T | 5 +- testsuite/tests/determinism/determ003/all.T | 5 +- testsuite/tests/determinism/determ005/all.T | 5 +- testsuite/tests/determinism/determ006/all.T | 5 +- testsuite/tests/determinism/determ007/all.T | 5 +- testsuite/tests/determinism/determ008/all.T | 5 +- testsuite/tests/determinism/determ009/all.T | 5 +- testsuite/tests/determinism/determ010/all.T | 5 +- testsuite/tests/determinism/determ011/all.T | 5 +- testsuite/tests/determinism/determ012/all.T | 5 +- testsuite/tests/determinism/determ013/all.T | 5 +- testsuite/tests/determinism/determ014/all.T | 5 +- testsuite/tests/determinism/determ015/all.T | 5 +- testsuite/tests/determinism/determ016/all.T | 5 +- testsuite/tests/determinism/determ017/all.T | 5 +- testsuite/tests/determinism/determ018/all.T | 5 +- testsuite/tests/determinism/determ019/all.T | 5 +- testsuite/tests/determinism/determ021/all.T | 5 +- testsuite/tests/dph/classes/dph-classes.T | 14 +- testsuite/tests/dph/enumfromto/dph-enumfromto.T | 12 +- testsuite/tests/dph/modules/dph-modules.T | 12 +- testsuite/tests/driver/T12062/all.T | 3 +- testsuite/tests/driver/T1372/all.T | 6 +- testsuite/tests/driver/T1959/test.T | 6 +- testsuite/tests/driver/T3007/all.T | 6 +- testsuite/tests/driver/T437/all.T | 6 +- testsuite/tests/driver/T5147/all.T | 6 +- testsuite/tests/driver/T7373/all.T | 8 +- testsuite/tests/driver/T7835/all.T | 7 +- testsuite/tests/driver/T8526/T8526.T | 2 +- testsuite/tests/driver/T9562/all.T | 4 +- testsuite/tests/driver/all.T | 388 ++++----------------- testsuite/tests/driver/dynamicToo/all.T | 6 +- .../tests/driver/dynamicToo/dynamicToo001/test.T | 11 +- .../tests/driver/dynamicToo/dynamicToo002/test.T | 8 +- .../tests/driver/dynamicToo/dynamicToo005/test.T | 6 +- testsuite/tests/driver/dynamic_flags_001/all.T | 6 +- testsuite/tests/driver/recomp001/all.T | 6 +- testsuite/tests/driver/recomp002/all.T | 6 +- testsuite/tests/driver/recomp003/all.T | 7 +- testsuite/tests/driver/recomp004/all.T | 6 +- testsuite/tests/driver/recomp005/all.T | 7 +- testsuite/tests/driver/recomp006/all.T | 6 +- testsuite/tests/driver/recomp007/all.T | 5 +- testsuite/tests/driver/recomp008/all.T | 5 +- testsuite/tests/driver/recomp009/all.T | 6 +- testsuite/tests/driver/recomp010/all.T | 6 +- testsuite/tests/driver/recomp011/all.T | 7 +- testsuite/tests/driver/recomp012/all.T | 6 +- testsuite/tests/driver/recomp013/all.T | 6 +- testsuite/tests/driver/recomp016/all.T | 6 +- testsuite/tests/driver/recomp017/all.T | 11 +- testsuite/tests/driver/retc002/all.T | 6 +- testsuite/tests/driver/retc003/all.T | 7 +- testsuite/tests/dynlibs/all.T | 29 +- testsuite/tests/ffi/should_compile/all.T | 3 +- testsuite/tests/ffi/should_fail/all.T | 5 +- testsuite/tests/ffi/should_run/all.T | 94 ++--- testsuite/tests/gadt/all.T | 20 +- testsuite/tests/generics/GEq/test.T | 3 +- testsuite/tests/generics/GFunctor/test.T | 3 +- testsuite/tests/generics/GMap/test.T | 3 +- testsuite/tests/generics/GShow/test.T | 3 +- testsuite/tests/generics/Uniplate/test.T | 4 +- testsuite/tests/generics/all.T | 8 +- testsuite/tests/ghc-api/T4891/all.T | 4 +- testsuite/tests/ghc-api/T7478/all.T | 9 +- testsuite/tests/ghc-api/annotations-literals/all.T | 6 +- testsuite/tests/ghci.debugger/scripts/all.T | 3 +- .../tests/ghci.debugger/scripts/break022/all.T | 2 +- .../tests/ghci.debugger/scripts/break023/all.T | 2 +- testsuite/tests/ghci/T11827/all.T | 5 +- testsuite/tests/ghci/linking/all.T | 41 +-- testsuite/tests/ghci/linking/dyn/all.T | 38 +- testsuite/tests/ghci/prog001/prog001.T | 7 +- testsuite/tests/ghci/prog002/prog002.T | 5 +- testsuite/tests/ghci/prog003/prog003.T | 8 +- testsuite/tests/ghci/prog004/prog004.T | 4 +- testsuite/tests/ghci/prog005/prog005.T | 3 +- testsuite/tests/ghci/prog006/prog006.T | 2 +- testsuite/tests/ghci/prog009/ghci.prog009.T | 5 +- testsuite/tests/ghci/prog012/all.T | 3 +- testsuite/tests/ghci/prog014/prog014.T | 10 +- testsuite/tests/ghci/scripts/all.T | 56 +-- testsuite/tests/haddock/haddock_examples/test.T | 9 +- testsuite/tests/hsc2hs/all.T | 58 +-- testsuite/tests/indexed-types/should_compile/all.T | 38 +- testsuite/tests/indexed-types/should_fail/all.T | 20 +- testsuite/tests/layout/all.T | 58 +-- testsuite/tests/lib/integer/all.T | 12 +- .../llvm/should_run/subsections_via_symbols/all.T | 6 +- testsuite/tests/module/all.T | 178 +++------- testsuite/tests/module/base01/all.T | 6 +- testsuite/tests/module/mod175/all.T | 6 +- testsuite/tests/numeric/should_run/all.T | 5 +- .../tests/overloadedrecflds/should_compile/all.T | 2 +- .../tests/overloadedrecflds/should_fail/all.T | 33 +- testsuite/tests/overloadedrecflds/should_run/all.T | 15 +- testsuite/tests/parser/prog001/test.T | 5 +- testsuite/tests/parser/should_compile/T7476/all.T | 3 +- testsuite/tests/parser/should_compile/all.T | 6 +- testsuite/tests/parser/unicode/all.T | 2 +- testsuite/tests/partial-sigs/should_compile/all.T | 5 +- testsuite/tests/partial-sigs/should_fail/all.T | 7 +- testsuite/tests/patsyn/should_compile/all.T | 12 +- testsuite/tests/perf/should_run/all.T | 16 +- testsuite/tests/plugins/all.T | 67 ++-- testsuite/tests/polykinds/all.T | 5 +- testsuite/tests/profiling/should_run/all.T | 11 +- testsuite/tests/programs/10queens/test.T | 6 +- testsuite/tests/programs/Queens/test.T | 6 +- testsuite/tests/programs/andre_monad/test.T | 7 +- testsuite/tests/programs/andy_cherry/test.T | 15 +- testsuite/tests/programs/cholewo-eval/test.T | 5 +- testsuite/tests/programs/cvh_unboxing/test.T | 8 +- testsuite/tests/programs/fast2haskell/test.T | 7 +- testsuite/tests/programs/fun_insts/test.T | 6 +- testsuite/tests/programs/galois_raytrace/test.T | 21 +- testsuite/tests/programs/hs-boot/all.T | 7 +- testsuite/tests/programs/jl_defaults/test.T | 5 +- testsuite/tests/programs/jq_readsPrec/test.T | 5 +- testsuite/tests/programs/jtod_circint/test.T | 9 +- testsuite/tests/programs/jules_xref/test.T | 8 +- testsuite/tests/programs/jules_xref2/test.T | 5 +- testsuite/tests/programs/launchbury/test.T | 6 +- testsuite/tests/programs/lennart_range/test.T | 5 +- testsuite/tests/programs/lex/test.T | 6 +- testsuite/tests/programs/life_space_leak/test.T | 6 +- testsuite/tests/programs/north_array/test.T | 5 +- testsuite/tests/programs/okeefe_neural/test.T | 6 +- testsuite/tests/programs/record_upd/test.T | 6 +- testsuite/tests/programs/rittri/test.T | 6 +- testsuite/tests/programs/sanders_array/test.T | 5 +- testsuite/tests/programs/seward-space-leak/test.T | 5 +- testsuite/tests/programs/strict_anns/test.T | 5 +- .../tests/programs/thurston-modular-arith/test.T | 7 +- testsuite/tests/quasiquotation/all.T | 17 +- testsuite/tests/quasiquotation/qq006/test.T | 7 +- testsuite/tests/quasiquotation/qq007/test.T | 10 +- testsuite/tests/quasiquotation/qq008/test.T | 10 +- testsuite/tests/quasiquotation/qq009/test.T | 10 +- testsuite/tests/quotes/TH_spliceViewPat/test.T | 5 +- testsuite/tests/rename/prog001/test.T | 5 +- testsuite/tests/rename/prog002/test.T | 5 +- testsuite/tests/rename/prog003/test.T | 5 +- testsuite/tests/rename/prog004/test.T | 5 +- testsuite/tests/rename/prog005/test.T | 8 +- testsuite/tests/rename/prog006/all.T | 7 +- testsuite/tests/rename/should_compile/T3103/test.T | 15 +- testsuite/tests/rename/should_compile/all.T | 160 ++------- testsuite/tests/rename/should_fail/all.T | 33 +- testsuite/tests/roles/should_compile/all.T | 2 +- testsuite/tests/roles/should_fail/all.T | 7 +- testsuite/tests/rts/T10672/all.T | 16 +- testsuite/tests/rts/T12031/all.T | 9 +- testsuite/tests/rts/T12771/all.T | 9 +- testsuite/tests/rts/T13082/all.T | 16 +- testsuite/tests/rts/T7289/all.T | 10 +- testsuite/tests/rts/all.T | 77 ++-- testsuite/tests/safeHaskell/check/all.T | 16 +- testsuite/tests/safeHaskell/check/pkg01/all.T | 37 +- testsuite/tests/safeHaskell/overlapping/all.T | 73 ++-- testsuite/tests/safeHaskell/safeInfered/all.T | 57 +-- testsuite/tests/safeHaskell/safeLanguage/all.T | 30 +- testsuite/tests/simplCore/T9646/test.T | 11 +- testsuite/tests/simplCore/prog001/test.T | 6 +- testsuite/tests/simplCore/prog002/test.T | 6 +- testsuite/tests/simplCore/prog003/test.T | 7 +- testsuite/tests/simplCore/should_compile/all.T | 48 +-- testsuite/tests/simplCore/should_run/all.T | 13 +- testsuite/tests/stranal/should_compile/all.T | 2 +- testsuite/tests/th/T2014/all.T | 6 +- testsuite/tests/th/TH_import_loop/TH_import_loop.T | 7 +- testsuite/tests/th/all.T | 189 +++------- testsuite/tests/typecheck/bug1465/all.T | 5 +- testsuite/tests/typecheck/prog001/test.T | 6 +- testsuite/tests/typecheck/prog002/test.T | 6 +- testsuite/tests/typecheck/should_compile/all.T | 69 +--- testsuite/tests/typecheck/should_fail/all.T | 37 +- testsuite/tests/typecheck/should_run/all.T | 8 +- testsuite/tests/typecheck/testeq1/test.T | 8 +- testsuite/tests/unboxedsums/module/all.T | 6 +- .../tests/warnings/should_compile/T10637/all.T | 3 +- .../tests/warnings/should_compile/T10890/all.T | 14 +- testsuite/tests/warnings/should_compile/all.T | 10 +- 205 files changed, 840 insertions(+), 2566 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 5d38fb69fd1e7a434ccc3147ae6a17fe0b5b0be3 From git at git.haskell.org Sun Jan 22 19:44:18 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 22 Jan 2017 19:44:18 +0000 (UTC) Subject: [commit: ghc] master: configure.ac: Eliminate stray close bracket (238f31c) Message-ID: <20170122194418.B0EAF3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/238f31ccfd9707f979f491cd8b772cb0b1db2331/ghc >--------------------------------------------------------------- commit 238f31ccfd9707f979f491cd8b772cb0b1db2331 Author: Ben Gamari Date: Sat Jan 21 16:57:14 2017 -0500 configure.ac: Eliminate stray close bracket >--------------------------------------------------------------- 238f31ccfd9707f979f491cd8b772cb0b1db2331 configure.ac | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/configure.ac b/configure.ac index a7100cc..1bb06f8 100644 --- a/configure.ac +++ b/configure.ac @@ -1212,7 +1212,7 @@ fi echo "\ Tools to build Sphinx HTML documentation available: $BUILD_SPHINX_HTML - Tools to build Sphinx PDF documentation available: $BUILD_SPHINX_PDF"] + Tools to build Sphinx PDF documentation available: $BUILD_SPHINX_PDF" echo "---------------------------------------------------------------------- " From git at git.haskell.org Sun Jan 22 20:08:22 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 22 Jan 2017 20:08:22 +0000 (UTC) Subject: [commit: ghc] master: Preserve coercion axioms when thinning. (294f95d) Message-ID: <20170122200822.94E8B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/294f95dcc2ae4cd9fdcdfca90173d92ef39a4bea/ghc >--------------------------------------------------------------- commit 294f95dcc2ae4cd9fdcdfca90173d92ef39a4bea Author: Edward Z. Yang Date: Wed Jan 18 16:17:04 2017 -0800 Preserve coercion axioms when thinning. Forgot to handle these! In they go, plus a test case. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- 294f95dcc2ae4cd9fdcdfca90173d92ef39a4bea compiler/typecheck/TcBackpack.hs | 40 +++++++++++++++++----- testsuite/tests/backpack/should_compile/all.T | 1 + .../bkpfail42.bkp => should_compile/bkp50.bkp} | 6 ++-- .../should_compile/{bkp49.stderr => bkp50.stderr} | 0 4 files changed, 35 insertions(+), 12 deletions(-) diff --git a/compiler/typecheck/TcBackpack.hs b/compiler/typecheck/TcBackpack.hs index 5c61871..d74cf51 100644 --- a/compiler/typecheck/TcBackpack.hs +++ b/compiler/typecheck/TcBackpack.hs @@ -368,18 +368,42 @@ thinModIface avails iface = -- perhaps there might be two IfaceTopBndr that are the same -- OccName but different Name. Requires better understanding -- of invariants here. - mi_decls = filter (decl_pred . snd) (mi_decls iface) + mi_decls = exported_decls ++ non_exported_decls ++ dfun_decls -- mi_insts = ..., -- mi_fam_insts = ..., } where - occs = mkOccSet [ occName n - | a <- avails - , n <- availNames a ] - -- NB: Never drop DFuns - decl_pred IfaceId{ ifIdDetails = IfDFunId } = True - decl_pred decl = - nameOccName (ifName decl) `elemOccSet` occs + decl_pred occs decl = nameOccName (ifName decl) `elemOccSet` occs + filter_decls occs = filter (decl_pred occs . snd) (mi_decls iface) + + exported_occs = mkOccSet [ occName n + | a <- avails + , n <- availNames a ] + exported_decls = filter_decls exported_occs + + non_exported_occs = mkOccSet [ occName n + | (_, d) <- exported_decls + , n <- ifaceDeclNonExportedRefs d ] + non_exported_decls = filter_decls non_exported_occs + + dfun_pred IfaceId{ ifIdDetails = IfDFunId } = True + dfun_pred _ = False + dfun_decls = filter (dfun_pred . snd) (mi_decls iface) + +-- | The list of 'Name's of *non-exported* 'IfaceDecl's which this +-- 'IfaceDecl' may refer to. A non-exported 'IfaceDecl' should be kept +-- after thinning if an *exported* 'IfaceDecl' (or 'mi_insts', perhaps) +-- refers to it; we can't decide to keep it by looking at the exports +-- of a module after thinning. Keep this synchronized with +-- 'rnIfaceDecl'. +ifaceDeclNonExportedRefs :: IfaceDecl -> [Name] +ifaceDeclNonExportedRefs d at IfaceFamily{} = + case ifFamFlav d of + IfaceClosedSynFamilyTyCon (Just (n, _)) + -> [n] + _ -> [] +ifaceDeclNonExportedRefs _ = [] + -- Note [Blank hsigs for all requirements] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ diff --git a/testsuite/tests/backpack/should_compile/all.T b/testsuite/tests/backpack/should_compile/all.T index 33d0357..9897c03 100644 --- a/testsuite/tests/backpack/should_compile/all.T +++ b/testsuite/tests/backpack/should_compile/all.T @@ -41,3 +41,4 @@ test('bkp46', normal, backpack_compile, ['']) test('bkp47', normal, backpack_compile, ['']) test('bkp48', normal, backpack_compile, ['']) test('bkp49', normal, backpack_compile, ['']) +test('bkp50', normal, backpack_compile, ['']) diff --git a/testsuite/tests/backpack/should_fail/bkpfail42.bkp b/testsuite/tests/backpack/should_compile/bkp50.bkp similarity index 67% copy from testsuite/tests/backpack/should_fail/bkpfail42.bkp copy to testsuite/tests/backpack/should_compile/bkp50.bkp index 8face3f..2dcee80 100644 --- a/testsuite/tests/backpack/should_fail/bkpfail42.bkp +++ b/testsuite/tests/backpack/should_compile/bkp50.bkp @@ -2,9 +2,7 @@ unit p where signature A where type family F a where - F a = Bool + F a = Int unit q where dependency p[A=] - signature A where - type family F a where - F a = Int + signature A(F) where diff --git a/testsuite/tests/backpack/should_compile/bkp49.stderr b/testsuite/tests/backpack/should_compile/bkp50.stderr similarity index 100% copy from testsuite/tests/backpack/should_compile/bkp49.stderr copy to testsuite/tests/backpack/should_compile/bkp50.stderr From git at git.haskell.org Sun Jan 22 20:08:25 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 22 Jan 2017 20:08:25 +0000 (UTC) Subject: [commit: ghc] master: Rewrite Backpack comments on never-exported TyThings. (bbe8956) Message-ID: <20170122200825.8C4703A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/bbe8956f345d8b2e0d3c068cba9d24569458f704/ghc >--------------------------------------------------------------- commit bbe8956f345d8b2e0d3c068cba9d24569458f704 Author: Edward Z. Yang Date: Wed Jan 18 22:54:35 2017 -0800 Rewrite Backpack comments on never-exported TyThings. Summary: While thesing, I realized this part of the implementation didn't make very much sense, so I started working on some documentation updates to try to make things more explainable. The new docs are organized around the idea of a "never exported TyThing" (a non-implicit TyThing that never occurs in the export list of a module). I also removed some outdated information that predated the change of ModIface to store Names rather than OccNames. Signed-off-by: Edward Z. Yang Reviewers: simonpj, bgamari, austin Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2989 >--------------------------------------------------------------- bbe8956f345d8b2e0d3c068cba9d24569458f704 compiler/backpack/RnModIface.hs | 113 +++++++++++++++------------------------ compiler/iface/TcIface.hs | 50 +++++++++-------- compiler/typecheck/TcBackpack.hs | 63 +++++++++++++++++++--- compiler/typecheck/TcRnTypes.hs | 2 +- 4 files changed, 127 insertions(+), 101 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc bbe8956f345d8b2e0d3c068cba9d24569458f704 From git at git.haskell.org Sun Jan 22 20:11:17 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 22 Jan 2017 20:11:17 +0000 (UTC) Subject: [commit: ghc] master: Failing test for #13149. (9ef237b) Message-ID: <20170122201117.9D29D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9ef237b7ca816edb65126d3e2d0eea649f8c9db7/ghc >--------------------------------------------------------------- commit 9ef237b7ca816edb65126d3e2d0eea649f8c9db7 Author: Edward Z. Yang Date: Sun Jan 22 12:11:05 2017 -0800 Failing test for #13149. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- 9ef237b7ca816edb65126d3e2d0eea649f8c9db7 testsuite/tests/backpack/should_compile/T13149.bkp | 16 ++++++++++++++++ testsuite/tests/backpack/should_compile/all.T | 2 ++ 2 files changed, 18 insertions(+) diff --git a/testsuite/tests/backpack/should_compile/T13149.bkp b/testsuite/tests/backpack/should_compile/T13149.bkp new file mode 100644 index 0000000..cdaf767 --- /dev/null +++ b/testsuite/tests/backpack/should_compile/T13149.bkp @@ -0,0 +1,16 @@ +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE Rank2Types #-} +{-# LANGUAGE TypeInType #-} +unit p where + signature A where + import GHC.Types + type family F a where + F Bool = Type + module B where + import A + foo :: forall (a :: F Bool). a -> a + foo x = x +unit q where + dependency p[A=] + module C where + import B diff --git a/testsuite/tests/backpack/should_compile/all.T b/testsuite/tests/backpack/should_compile/all.T index 9897c03..e7834df 100644 --- a/testsuite/tests/backpack/should_compile/all.T +++ b/testsuite/tests/backpack/should_compile/all.T @@ -42,3 +42,5 @@ test('bkp47', normal, backpack_compile, ['']) test('bkp48', normal, backpack_compile, ['']) test('bkp49', normal, backpack_compile, ['']) test('bkp50', normal, backpack_compile, ['']) + +test('T13149', expect_broken(13149), backpack_compile, ['']) From git at git.haskell.org Mon Jan 23 08:28:44 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 23 Jan 2017 08:28:44 +0000 (UTC) Subject: [commit: ghc] master: Improve pretty-printing of IfaceCoercions (6850eb6) Message-ID: <20170123082844.7E7823A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6850eb64cc2312e53740edbd94ed2abd7d06f41e/ghc >--------------------------------------------------------------- commit 6850eb64cc2312e53740edbd94ed2abd7d06f41e Author: Simon Peyton Jones Date: Fri Jan 20 23:37:21 2017 +0000 Improve pretty-printing of IfaceCoercions For some reason, unless you have -fprint-explicit-coercions, when printing an explicit coercion we were then going to special trouble to suppress the unique of a hole (which only happens during debugging anyway). This is bizarre. So I deleted three lines of code -- hooray. >--------------------------------------------------------------- 6850eb64cc2312e53740edbd94ed2abd7d06f41e compiler/iface/IfaceType.hs | 8 ++------ 1 file changed, 2 insertions(+), 6 deletions(-) diff --git a/compiler/iface/IfaceType.hs b/compiler/iface/IfaceType.hs index 47f284e..0dded21 100644 --- a/compiler/iface/IfaceType.hs +++ b/compiler/iface/IfaceType.hs @@ -1135,12 +1135,8 @@ ppr_co ctxt_prec (IfaceUnivCo IfaceUnsafeCoerceProv r ty1 ty2) text "UnsafeCo" <+> ppr r <+> pprParendIfaceType ty1 <+> pprParendIfaceType ty2 -ppr_co ctxt_prec (IfaceUnivCo (IfaceHoleProv u) _ _ _) - = maybeParen ctxt_prec TyConPrec $ - sdocWithDynFlags $ \dflags -> - if gopt Opt_PrintExplicitCoercions dflags - then braces $ ppr u - else braces $ text "a hole" +ppr_co _ctxt_prec (IfaceUnivCo (IfaceHoleProv u) _ _ _) + = braces $ ppr u ppr_co _ (IfaceUnivCo _ _ ty1 ty2) = angleBrackets ( ppr ty1 <> comma <+> ppr ty2 ) From git at git.haskell.org Mon Jan 23 08:28:48 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 23 Jan 2017 08:28:48 +0000 (UTC) Subject: [commit: ghc] master: Apply the right substitution in ty-fam improvement (2b64e92) Message-ID: <20170123082848.40C053A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2b64e926a628fb2a3710b0360123ea73331166fe/ghc >--------------------------------------------------------------- commit 2b64e926a628fb2a3710b0360123ea73331166fe Author: Simon Peyton Jones Date: Fri Jan 20 23:47:28 2017 +0000 Apply the right substitution in ty-fam improvement Trac #13135 showed that we were failing to apply the correct substitution to the un-substituted tyvars during type-family improvement using injectivity. Specifically in TcInteractlinjImproveEqns we need to use instFlexiX. An outright bug, easy to fix. Slight refactoring along the way. The quantified tyars of the axiom are readily to hand; we don't need to take the free tyvars of the LHS >--------------------------------------------------------------- 2b64e926a628fb2a3710b0360123ea73331166fe compiler/typecheck/TcInteract.hs | 48 ++++---- compiler/typecheck/TcSMonad.hs | 26 ++--- testsuite/tests/dependent/should_fail/T13135.hs | 122 +++++++++++++++++++++ .../tests/dependent/should_fail/T13135.stderr | 10 ++ testsuite/tests/dependent/should_fail/all.T | 1 + 5 files changed, 171 insertions(+), 36 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 2b64e926a628fb2a3710b0360123ea73331166fe From git at git.haskell.org Mon Jan 23 12:37:57 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 23 Jan 2017 12:37:57 +0000 (UTC) Subject: [commit: ghc] master: Typos and grammar in manual/comments (80560e6) Message-ID: <20170123123757.A011B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/80560e69ca40abb2c94c4e9fa322365f558a6a8b/ghc >--------------------------------------------------------------- commit 80560e69ca40abb2c94c4e9fa322365f558a6a8b Author: Gabor Greif Date: Mon Jan 23 09:38:15 2017 +0100 Typos and grammar in manual/comments >--------------------------------------------------------------- 80560e69ca40abb2c94c4e9fa322365f558a6a8b aclocal.m4 | 2 +- compiler/basicTypes/BasicTypes.hs | 2 +- compiler/basicTypes/Demand.hs | 4 ++-- compiler/coreSyn/CorePrep.hs | 2 +- compiler/coreSyn/CoreUnfold.hs | 2 +- compiler/deSugar/DsBinds.hs | 4 ++-- compiler/ghci/GHCi.hsc | 2 +- compiler/hsSyn/HsTypes.hs | 6 +++--- compiler/main/GhcMake.hs | 2 +- compiler/main/HscTypes.hs | 2 +- compiler/main/TidyPgm.hs | 2 +- compiler/rename/RnTypes.hs | 2 +- compiler/simplCore/CSE.hs | 2 +- compiler/simplCore/OccurAnal.hs | 6 +++--- compiler/stranal/DmdAnal.hs | 2 +- compiler/stranal/WwLib.hs | 2 +- compiler/typecheck/TcPat.hs | 2 +- compiler/typecheck/TcRnTypes.hs | 2 +- compiler/typecheck/TcSigs.hs | 4 ++-- compiler/typecheck/TcSimplify.hs | 2 +- compiler/types/Coercion.hs | 2 +- compiler/types/Type.hs | 2 +- compiler/vectorise/Vectorise.hs | 2 +- compiler/vectorise/Vectorise/Utils/Base.hs | 2 +- docs/users_guide/safe_haskell.rst | 4 ++-- libraries/base/GHC/ForeignPtr.hs | 2 +- testsuite/tests/deriving/should_fail/drvfail-functor2.hs | 2 +- testsuite/tests/printer/Ppr006.hs | 2 +- testsuite/tests/safeHaskell/overlapping/SH_Overlap8.hs | 2 +- testsuite/tests/typecheck/should_compile/T4361.hs | 2 +- testsuite/tests/typecheck/should_fail/tcfail143.hs | 2 +- 31 files changed, 39 insertions(+), 39 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 80560e69ca40abb2c94c4e9fa322365f558a6a8b From git at git.haskell.org Mon Jan 23 12:56:46 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 23 Jan 2017 12:56:46 +0000 (UTC) Subject: [commit: ghc] master: Make checkFamInstConsistency faster (18ceb14) Message-ID: <20170123125646.09E3D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/18ceb14828b96a2d2f08e962111f41c46a962983/ghc >--------------------------------------------------------------- commit 18ceb14828b96a2d2f08e962111f41c46a962983 Author: Bartosz Nitka Date: Mon Jan 23 04:56:21 2017 -0800 Make checkFamInstConsistency faster We've noticed that `checkFamInstConsistency` takes 6% of overall build time on our codebase. I've poked around for a bit and most of type family instances are `Rep` from `Generics`. I think those are unavoidable, so I don't think we can have less of them. I also looked at the code and noticed a simple algorithmic improvement can be made. The algorithm is pretty simple: we take all the family instances from one module (`M1`) and test it against another module (`M2`). The cost of that is dominated by the size of `M1`, because for each instance in `M1` we look it up in the type family env from `M2`, and lookup is cheap. If `M1` is bigger than `M2`, that's suboptimal, so after my change we always iterate through the smaller set. This drives down the cost of `checkFamInstConsistency` to 2%. Test Plan: harbormaster Reviewers: simonmar, simonpj, goldfire, rwbarton, bgamari, ezyang, austin Reviewed By: rwbarton, ezyang Subscribers: ezyang, thomie Differential Revision: https://phabricator.haskell.org/D2833 >--------------------------------------------------------------- 18ceb14828b96a2d2f08e962111f41c46a962983 compiler/typecheck/FamInst.hs | 13 +++++++++++-- compiler/types/FamInstEnv.hs | 7 ++++++- testsuite/tests/typecheck/should_fail/T6018fail.stderr | 4 ++-- 3 files changed, 19 insertions(+), 5 deletions(-) diff --git a/compiler/typecheck/FamInst.hs b/compiler/typecheck/FamInst.hs index 0c1bdef..b9cf0af 100644 --- a/compiler/typecheck/FamInst.hs +++ b/compiler/typecheck/FamInst.hs @@ -233,8 +233,17 @@ checkFamInstConsistency famInstMods directlyImpMods allPairs (m:ms) = map (modulePair m) ms ++ allPairs ms check hpt_fam_insts (ModulePair m1 m2) - = do { env1 <- getFamInsts hpt_fam_insts m1 - ; env2 <- getFamInsts hpt_fam_insts m2 + = do { env1' <- getFamInsts hpt_fam_insts m1 + ; env2' <- getFamInsts hpt_fam_insts m2 + -- We're checking each element of env1 against env2. + -- The cost of that is dominated by the size of env1, because + -- for each instance in env1 we look it up in the type family + -- environment env2, and lookup is cheap. + -- The code below ensures that env1 is the smaller environment. + ; let sizeE1 = famInstEnvSize env1' + sizeE2 = famInstEnvSize env2' + (env1, env2) = if sizeE1 < sizeE2 then (env1', env2') + else (env2', env1') -- Note [Don't check hs-boot type family instances too early] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -- Family instance consistency checking involves checking that diff --git a/compiler/types/FamInstEnv.hs b/compiler/types/FamInstEnv.hs index 7abac11..40d2582 100644 --- a/compiler/types/FamInstEnv.hs +++ b/compiler/types/FamInstEnv.hs @@ -12,7 +12,7 @@ module FamInstEnv ( FamInstEnvs, FamInstEnv, emptyFamInstEnv, emptyFamInstEnvs, extendFamInstEnv, deleteFromFamInstEnv, extendFamInstEnvList, - identicalFamInstHead, famInstEnvElts, familyInstances, + identicalFamInstHead, famInstEnvElts, famInstEnvSize, familyInstances, -- * CoAxioms mkCoAxBranch, mkBranchedCoAxiom, mkUnbranchedCoAxiom, mkSingleCoAxiom, @@ -400,6 +400,11 @@ famInstEnvElts :: FamInstEnv -> [FamInst] famInstEnvElts fi = [elt | FamIE elts <- eltsUDFM fi, elt <- elts] -- See Note [FamInstEnv determinism] +famInstEnvSize :: FamInstEnv -> Int +famInstEnvSize = nonDetFoldUDFM (\(FamIE elt) sum -> sum + length elt) 0 + -- It's OK to use nonDetFoldUDFM here since we're just computing the + -- size. + familyInstances :: (FamInstEnv, FamInstEnv) -> TyCon -> [FamInst] familyInstances (pkg_fie, home_fie) fam = get home_fie ++ get pkg_fie diff --git a/testsuite/tests/typecheck/should_fail/T6018fail.stderr b/testsuite/tests/typecheck/should_fail/T6018fail.stderr index e40cb84..2525934 100644 --- a/testsuite/tests/typecheck/should_fail/T6018fail.stderr +++ b/testsuite/tests/typecheck/should_fail/T6018fail.stderr @@ -9,10 +9,10 @@ T6018Afail.hs:7:15: error: G Char Bool Int = Int -- Defined at T6018Afail.hs:7:15 G Bool Int Char = Int -- Defined at T6018fail.hs:15:15 -T6018Dfail.hs:7:15: error: +T6018Cfail.hs:8:15: error: Type family equations violate injectivity annotation: - T6018Bfail.H Bool Int Char = Int -- Defined at T6018Dfail.hs:7:15 T6018Bfail.H Char Bool Int = Int -- Defined at T6018Cfail.hs:8:15 + T6018Bfail.H Bool Int Char = Int -- Defined at T6018Dfail.hs:7:15 T6018fail.hs:13:15: error: Type family equations violate injectivity annotation: From git at git.haskell.org Mon Jan 23 14:16:57 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 23 Jan 2017 14:16:57 +0000 (UTC) Subject: [commit: ghc] master: Don't quantify implicit type variables when quoting type signatures in TH (729a5e4) Message-ID: <20170123141657.0715A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/729a5e452db530e8da8ca163fcd842faac6bd690/ghc >--------------------------------------------------------------- commit 729a5e452db530e8da8ca163fcd842faac6bd690 Author: Ryan Scott Date: Mon Jan 23 09:06:04 2017 -0500 Don't quantify implicit type variables when quoting type signatures in TH Summary: A bug was introduced in GHC 8.0 in which Template Haskell-quoted type signatures would quantify _all_ their type variables, even the implicit ones. This would cause splices like this: ``` $([d| idProxy :: forall proxy (a :: k). proxy a -> proxy a idProxy x = x |]) ``` To splice back in something that was slightly different: ``` idProxy :: forall k proxy (a :: k). proxy a -> proxy a idProxy x = x ``` Notice that the kind variable `k` is now explicitly quantified! What's worse, this now requires the `TypeInType` extension to be enabled. This changes the behavior of Template Haskell quoting to never explicitly quantify type variables which are implicitly quantified in the source. There are some other places where this behavior pops up too, including class methods, type ascriptions, `SPECIALIZE` pragmas, foreign imports, and pattern synonynms (#13018), so I fixed those too. Fixes #13018 and #13123. Test Plan: ./validate Reviewers: simonpj, goldfire, austin, bgamari Reviewed By: simonpj, goldfire Subscribers: simonpj, mpickering, thomie Differential Revision: https://phabricator.haskell.org/D2974 GHC Trac Issues: #13018, #13123 >--------------------------------------------------------------- 729a5e452db530e8da8ca163fcd842faac6bd690 compiler/deSugar/DsMeta.hs | 80 ++++++++++++++++++++---------- docs/users_guide/8.2.1-notes.rst | 36 ++++++++++++++ testsuite/tests/ghci/scripts/T11098.stdout | 2 +- testsuite/tests/th/T10828.stderr | 12 ++--- testsuite/tests/th/T11797.stderr | 2 +- testsuite/tests/th/T13018.hs | 11 ++++ testsuite/tests/th/T13123.hs | 30 +++++++++++ testsuite/tests/th/T5217.stderr | 6 +-- testsuite/tests/th/T7064.stdout | 2 +- testsuite/tests/th/T8625.stdout | 2 +- testsuite/tests/th/TH_RichKinds2.stderr | 7 ++- testsuite/tests/th/TH_pragma.stderr | 2 +- testsuite/tests/th/all.T | 2 + 13 files changed, 151 insertions(+), 43 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 729a5e452db530e8da8ca163fcd842faac6bd690 From git at git.haskell.org Mon Jan 23 17:42:00 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 23 Jan 2017 17:42:00 +0000 (UTC) Subject: [commit: ghc] master: Record evaluated-ness on workers and wrappers (596dece) Message-ID: <20170123174200.0E11A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/596dece7866006d699969f775fd97bd306aad85b/ghc >--------------------------------------------------------------- commit 596dece7866006d699969f775fd97bd306aad85b Author: Simon Peyton Jones Date: Fri Jan 13 08:56:53 2017 +0000 Record evaluated-ness on workers and wrappers Summary: This patch is a refinement of the original commit (which was reverted): commit 6b976eb89fe72827f226506d16d3721ba4e28bab Date: Fri Jan 13 08:56:53 2017 +0000 Record evaluated-ness on workers and wrappers In Trac #13027, comment:20, I noticed that wrappers created after demand analysis weren't recording the evaluated-ness of strict constructor arguments. In the ticket that led to a (debatable) Lint error but in general the more we know about evaluated-ness the better we can optimise. This commit adds that info * both in the worker (on args) * and in the wrapper (on CPR result patterns). See Note [Record evaluated-ness in worker/wrapper] in WwLib On the way I defined Id.setCaseBndrEvald, and used it to shorten the code in a few other places Then I added test T13077a to test the CPR aspect of this patch, but I found that Lint failed! Reason: simpleOptExpr was discarding evaluated-ness info on lambda binders because zapFragileIdInfo was discarding an Unfolding of (OtherCon _). But actually that's a robust unfolding; there is no need to discard it. To fix this: * zapFragileIdInfo only zaps fragile unfoldings * Replace isClosedUnfolding with isFragileUnfolding (the latter is just the negation of the former, but the nomenclature is more consistent). Better documentation too Note [Fragile unfoldings] * And Simplify.simplLamBndr can now look at isFragileUnfolding to decide whether to use the longer route of simplUnfolding. For some reason perf/compiler/T9233 improves in compile-time allocation by 10%. Hooray Nofib: essentially no change: -------------------------------------------------------------------------------- Program Size Allocs Runtime Elapsed TotalMem -------------------------------------------------------------------------------- cacheprof +0.0% -0.3% +0.9% +0.4% +0.0% -------------------------------------------------------------------------------- Min +0.0% -0.3% -2.4% -2.4% +0.0% Max +0.0% +0.0% +9.8% +11.4% +2.4% Geometric Mean +0.0% -0.0% +1.1% +1.0% +0.0% >--------------------------------------------------------------- 596dece7866006d699969f775fd97bd306aad85b compiler/basicTypes/Id.hs | 13 ++- compiler/basicTypes/IdInfo.hs | 18 +++- compiler/coreSyn/CoreSubst.hs | 12 ++- compiler/coreSyn/CoreSyn.hs | 36 ++++++-- compiler/coreSyn/CoreUtils.hs | 6 +- compiler/simplCore/Simplify.hs | 16 ++-- compiler/stranal/WwLib.hs | 108 +++++++++++++++++----- testsuite/tests/perf/compiler/all.T | 5 +- testsuite/tests/stranal/should_compile/T13077.hs | 15 +++ testsuite/tests/stranal/should_compile/T13077a.hs | 21 +++++ testsuite/tests/stranal/should_compile/all.T | 3 +- 11 files changed, 192 insertions(+), 61 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 596dece7866006d699969f775fd97bd306aad85b From git at git.haskell.org Mon Jan 23 19:17:54 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 23 Jan 2017 19:17:54 +0000 (UTC) Subject: [commit: ghc] master: Make tickishContains faster (532c6ad) Message-ID: <20170123191754.6829F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/532c6ade49e9e8e7e98c35451058ba7e4ee7bb9c/ghc >--------------------------------------------------------------- commit 532c6ade49e9e8e7e98c35451058ba7e4ee7bb9c Author: Bartosz Nitka Date: Mon Jan 23 09:51:31 2017 -0500 Make tickishContains faster This just reorders some inequality checks to make the common case cheaper. The results are quite dramatic for #11095, but that's probably because something else is causing it to do too much work. Before (full https://phabricator.haskell.org/P136): ``` 13,589,495,832 bytes allocated in the heap ``` After (full https://phabricator.haskell.org/P137): ``` 7,885,575,872 bytes allocated in the heap ``` This is with `BuildFlavour = devel2`, so take it with a a grain of salt. For reference, with no `-g` I get: ``` 155,703,112 bytes allocated in the heap ``` so we're still quite a way off. Test Plan: harbormaster I still have to test locally Reviewers: austin, bgamari Subscribers: thomie, simonmar Differential Revision: https://phabricator.haskell.org/D3001 GHC Trac Issues: #11095 >--------------------------------------------------------------- 532c6ade49e9e8e7e98c35451058ba7e4ee7bb9c compiler/basicTypes/SrcLoc.hs | 13 ++++++++----- compiler/coreSyn/CoreSyn.hs | 3 ++- 2 files changed, 10 insertions(+), 6 deletions(-) diff --git a/compiler/basicTypes/SrcLoc.hs b/compiler/basicTypes/SrcLoc.hs index 45d92d0..af757f5 100644 --- a/compiler/basicTypes/SrcLoc.hs +++ b/compiler/basicTypes/SrcLoc.hs @@ -344,11 +344,14 @@ isOneLineSpan (UnhelpfulSpan _) = False -- that it covers at least as much source code. True where spans are equal. containsSpan :: RealSrcSpan -> RealSrcSpan -> Bool containsSpan s1 s2 - = srcSpanFile s1 == srcSpanFile s2 - && (srcSpanStartLine s1, srcSpanStartCol s1) - <= (srcSpanStartLine s2, srcSpanStartCol s2) - && (srcSpanEndLine s1, srcSpanEndCol s1) - >= (srcSpanEndLine s2, srcSpanEndCol s2) + = srcSpanEndCol s1 >= srcSpanEndCol s2 + && srcSpanStartCol s1 <= srcSpanStartCol s2 + && srcSpanEndLine s1 >= srcSpanEndLine s2 + && srcSpanStartLine s1 <= srcSpanStartLine s2 + && srcSpanFile s1 == srcSpanFile s2 + -- ordered roughly by the likelihood of failing: + -- * we're more likely to be comparing source spans from the same file + -- * we're more likely to be comparing source spans on the same line {- %************************************************************************ diff --git a/compiler/coreSyn/CoreSyn.hs b/compiler/coreSyn/CoreSyn.hs index bcf9e6e..4ea913b 100644 --- a/compiler/coreSyn/CoreSyn.hs +++ b/compiler/coreSyn/CoreSyn.hs @@ -809,7 +809,8 @@ tickishPlace SourceNote{} = PlaceNonLam -- making the second tick redundant. tickishContains :: Eq b => Tickish b -> Tickish b -> Bool tickishContains (SourceNote sp1 n1) (SourceNote sp2 n2) - = n1 == n2 && containsSpan sp1 sp2 + = containsSpan sp1 sp2 && n1 == n2 + -- compare the String last tickishContains t1 t2 = t1 == t2 From git at git.haskell.org Tue Jan 24 03:45:02 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 24 Jan 2017 03:45:02 +0000 (UTC) Subject: [commit: ghc] master: typecheck: Fix note (368d547) Message-ID: <20170124034502.63D633A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/368d5470b21b9ba2845c3e162635252da1db2abb/ghc >--------------------------------------------------------------- commit 368d5470b21b9ba2845c3e162635252da1db2abb Author: Ben Gamari Date: Mon Jan 23 21:52:46 2017 -0500 typecheck: Fix note >--------------------------------------------------------------- 368d5470b21b9ba2845c3e162635252da1db2abb compiler/typecheck/TcMType.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/typecheck/TcMType.hs b/compiler/typecheck/TcMType.hs index 8f0a79c..d9105b3 100644 --- a/compiler/typecheck/TcMType.hs +++ b/compiler/typecheck/TcMType.hs @@ -1139,7 +1139,7 @@ variables (the MetaTv constructor of TcTyVarDetails) are represented by mutable variables (known as TcRefs). Zonking is the process of ripping out these mutable variables and replacing them -with a real TcType. This involves traversing the entire type expression, but the +with a real Type. This involves traversing the entire type expression, but the interesting part of replacing the mutable variables occurs in zonkTyVarOcc. There are two ways to zonk a Type: From git at git.haskell.org Tue Jan 24 03:45:05 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 24 Jan 2017 03:45:05 +0000 (UTC) Subject: [commit: ghc] master: users-guide: Document -dppr-ticks (1761bfa) Message-ID: <20170124034505.282A53A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1761bfacbce4fbd0b54481120316c565860222e5/ghc >--------------------------------------------------------------- commit 1761bfacbce4fbd0b54481120316c565860222e5 Author: Ben Gamari Date: Mon Jan 23 16:17:41 2017 -0500 users-guide: Document -dppr-ticks >--------------------------------------------------------------- 1761bfacbce4fbd0b54481120316c565860222e5 docs/users_guide/debugging.rst | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/docs/users_guide/debugging.rst b/docs/users_guide/debugging.rst index b4c20eb..9994ef9 100644 --- a/docs/users_guide/debugging.rst +++ b/docs/users_guide/debugging.rst @@ -251,6 +251,11 @@ Dumping out compiler intermediate structures aren't). This flag makes debugging output appear in the more verbose debug style. +.. ghc-flag:: -dppr-ticks + + Includes "ticks" in the pretty-printer output. + + .. _formatting dumps: Formatting dumps From git at git.haskell.org Tue Jan 24 03:45:07 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 24 Jan 2017 03:45:07 +0000 (UTC) Subject: [commit: ghc] master: Document -fspecialise-aggressively (a8c81f3) Message-ID: <20170124034507.D4B3E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a8c81f3c102988e0f4216b7cb5fec7958e60b4e4/ghc >--------------------------------------------------------------- commit a8c81f3c102988e0f4216b7cb5fec7958e60b4e4 Author: Matthew Pickering Date: Mon Jan 23 21:58:45 2017 -0500 Document -fspecialise-aggressively Reviewers: austin, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D3007 GHC Trac Issues: #12979 >--------------------------------------------------------------- a8c81f3c102988e0f4216b7cb5fec7958e60b4e4 docs/users_guide/using-optimisation.rst | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/docs/users_guide/using-optimisation.rst b/docs/users_guide/using-optimisation.rst index 1cad51b..48c1e6f 100644 --- a/docs/users_guide/using-optimisation.rst +++ b/docs/users_guide/using-optimisation.rst @@ -578,6 +578,18 @@ list. that have an INLINABLE pragma (:ref:`inlinable-pragma`) will be specialised as well. +.. ghc-flag:: -fspecialise-aggressively + + :default: off + + By default only type class methods and methods marked ``INLINABLE`` or + ``INLINE`` are specialised. This flag will specialise any overloaded function + regardless of size if its unfolding is available. This flag is not + included in any optimisation level as it can massively increase code + size. It can be used in conjunction with :ghc-flag:`-fexpose-all-unfoldings` + if you want to ensure all calls are specialised. + + .. ghc-flag:: -fcross-module-specialise :default: on From git at git.haskell.org Tue Jan 24 03:45:10 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 24 Jan 2017 03:45:10 +0000 (UTC) Subject: [commit: ghc] master: Remove unused LOCAL_GHC_PKG definition from a test Makefile (7726fd7) Message-ID: <20170124034510.9290F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7726fd79a3d61effb5a69ade77cfa5818740b9e0/ghc >--------------------------------------------------------------- commit 7726fd79a3d61effb5a69ade77cfa5818740b9e0 Author: Reid Barton Date: Mon Jan 23 22:00:11 2017 -0500 Remove unused LOCAL_GHC_PKG definition from a test Makefile Test Plan: harbormaster Reviewers: austin, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D3004 >--------------------------------------------------------------- 7726fd79a3d61effb5a69ade77cfa5818740b9e0 testsuite/tests/ghci/linking/Makefile | 2 -- 1 file changed, 2 deletions(-) diff --git a/testsuite/tests/ghci/linking/Makefile b/testsuite/tests/ghci/linking/Makefile index 0bbd848..f8c5e19 100644 --- a/testsuite/tests/ghci/linking/Makefile +++ b/testsuite/tests/ghci/linking/Makefile @@ -2,8 +2,6 @@ TOP=../../.. include $(TOP)/mk/boilerplate.mk include $(TOP)/mk/test.mk -LOCAL_GHC_PKG = '$(GHC_PKG)' --no-user-package-db -f $(LOCAL_PKGCONF) - # Test 1: ghci -Ldir -lfoo # with dir/libfoo.a From git at git.haskell.org Tue Jan 24 03:45:13 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 24 Jan 2017 03:45:13 +0000 (UTC) Subject: [commit: ghc] master: Re-sort case alternatives after scrutinee constant folding (#13170) (abaa681) Message-ID: <20170124034513.ACA0A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/abaa6815e6435ed29ad121b5e59fc017a1d3e836/ghc >--------------------------------------------------------------- commit abaa6815e6435ed29ad121b5e59fc017a1d3e836 Author: Reid Barton Date: Mon Jan 23 21:57:53 2017 -0500 Re-sort case alternatives after scrutinee constant folding (#13170) Commit d3b546b1a605 added a "scrutinee constant folding" pass that rewrites a case expression whose scrutinee is an expression like x +# 3#. But case expressions are supposed to have their alternatives in sorted order, so when the scrutinee is (for example) negateInt# x#, we need to re-sort the alternatives after mapping their values. This showed up as a core lint failure when compiling System.Process.Posix: isSigIntQuit n = sig == sigINT || sig == sigQUIT where sig = fromIntegral (-n) Data.List.sortBy is supposed to be linear-time on sorted or reverse-sorted input, so it is probably not worth doing anything more clever than this. Test Plan: Added a new test T13170 for the above case. Reviewers: austin, hsyl20, simonpj, bgamari Reviewed By: hsyl20, simonpj, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D3008 GHC Trac Issues: #13170 >--------------------------------------------------------------- abaa6815e6435ed29ad121b5e59fc017a1d3e836 compiler/simplCore/SimplUtils.hs | 6 +++++- testsuite/tests/simplCore/should_compile/T13170.hs | 4 ++++ testsuite/tests/simplCore/should_compile/all.T | 1 + 3 files changed, 10 insertions(+), 1 deletion(-) diff --git a/compiler/simplCore/SimplUtils.hs b/compiler/simplCore/SimplUtils.hs index 47c5be6..3b48924 100644 --- a/compiler/simplCore/SimplUtils.hs +++ b/compiler/simplCore/SimplUtils.hs @@ -64,6 +64,7 @@ import PrelRules import Literal import Control.Monad ( when ) +import Data.List ( sortBy ) {- ************************************************************************ @@ -1926,7 +1927,7 @@ mkCase1 dflags scrut bndr alts_ty alts = mkCase2 dflags scrut bndr alts_ty alts mkCase2 dflags scrut bndr alts_ty alts | gopt Opt_CaseFolding dflags , Just (scrut',f) <- caseRules dflags scrut - = mkCase3 dflags scrut' bndr alts_ty (map (mapAlt f) alts) + = mkCase3 dflags scrut' bndr alts_ty (new_alts f) | otherwise = mkCase3 dflags scrut bndr alts_ty alts where @@ -1946,6 +1947,9 @@ mkCase2 dflags scrut bndr alts_ty alts | isDeadBinder bndr = rhs | otherwise = Let (NonRec bndr l) rhs + -- We need to re-sort the alternatives to preserve the #case_invariants# + new_alts f = sortBy cmpAlt (map (mapAlt f) alts) + mapAlt f alt@(c,bs,e) = case c of DEFAULT -> (c, bs, wrap_rhs scrut e) LitAlt l diff --git a/testsuite/tests/simplCore/should_compile/T13170.hs b/testsuite/tests/simplCore/should_compile/T13170.hs new file mode 100644 index 0000000..06ea656 --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T13170.hs @@ -0,0 +1,4 @@ +module T13170 where +f :: Int -> Bool +f x = y == 2 || y == 3 + where y = -x diff --git a/testsuite/tests/simplCore/should_compile/all.T b/testsuite/tests/simplCore/should_compile/all.T index 8bd7cdd..d63d0d1 100644 --- a/testsuite/tests/simplCore/should_compile/all.T +++ b/testsuite/tests/simplCore/should_compile/all.T @@ -239,3 +239,4 @@ test('str-rules', normal, run_command, ['$MAKE -s --no-print-directory str-rules']) +test('T13170', only_ways(['optasm']), compile, ['-dcore-lint']) From git at git.haskell.org Tue Jan 24 03:45:17 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 24 Jan 2017 03:45:17 +0000 (UTC) Subject: [commit: ghc] master: Ensure that scrutinee constant folding wraps numbers (53e2e70) Message-ID: <20170124034517.553183A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/53e2e70a477896d57059b5f12147b69d22a2e2e0/ghc >--------------------------------------------------------------- commit 53e2e70a477896d57059b5f12147b69d22a2e2e0 Author: Sylvain Henry Date: Mon Jan 23 21:57:38 2017 -0500 Ensure that scrutinee constant folding wraps numbers Test Plan: T13172 Reviewers: rwbarton, simonpj, austin, bgamari Reviewed By: simonpj, bgamari Subscribers: simonpj, thomie Differential Revision: https://phabricator.haskell.org/D3009 GHC Trac Issues: #13172 >--------------------------------------------------------------- 53e2e70a477896d57059b5f12147b69d22a2e2e0 compiler/prelude/PrelRules.hs | 92 ++++++++++++++-------- compiler/simplCore/SimplUtils.hs | 2 +- testsuite/tests/simplCore/should_run/T13172.hs | 11 +++ testsuite/tests/simplCore/should_run/T13172.stdout | 2 + testsuite/tests/simplCore/should_run/all.T | 2 + 5 files changed, 77 insertions(+), 32 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 53e2e70a477896d57059b5f12147b69d22a2e2e0 From git at git.haskell.org Tue Jan 24 03:45:21 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 24 Jan 2017 03:45:21 +0000 (UTC) Subject: [commit: ghc] master: Add a failing test for #13102 (8f49f6d) Message-ID: <20170124034521.0A9A53A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8f49f6de2121541d3bf8254abb402b6e7bfee8fb/ghc >--------------------------------------------------------------- commit 8f49f6de2121541d3bf8254abb402b6e7bfee8fb Author: Reid Barton Date: Mon Jan 23 21:59:39 2017 -0500 Add a failing test for #13102 Test Plan: harbormaster Reviewers: austin, ezyang, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D3005 GHC Trac Issues: #13102 >--------------------------------------------------------------- 8f49f6de2121541d3bf8254abb402b6e7bfee8fb testsuite/tests/indexed-types/should_fail/T13102/A.hs | 6 ++++++ testsuite/tests/indexed-types/should_fail/T13102/B.hs | 6 ++++++ testsuite/tests/indexed-types/should_fail/T13102/Makefile | 13 +++++++++++++ .../tests/indexed-types/should_fail/T13102/T13102.stderr | 11 +++++++++++ testsuite/tests/indexed-types/should_fail/T13102/all.T | 5 +++++ .../tests/indexed-types/should_fail/T13102/orphan/F.hs | 5 +++++ .../A.hs => indexed-types/should_fail/T13102/orphan/O.hs} | 7 +++++-- .../should_fail/T13102/orphan}/Setup.hs | 0 .../should_fail/T13102/orphan/orphan.cabal} | 4 ++-- 9 files changed, 53 insertions(+), 4 deletions(-) diff --git a/testsuite/tests/indexed-types/should_fail/T13102/A.hs b/testsuite/tests/indexed-types/should_fail/T13102/A.hs new file mode 100644 index 0000000..7dd4348 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T13102/A.hs @@ -0,0 +1,6 @@ +module A where + +import O + +x _ = 1 -- Generate a silly warning, so we know A was really compiled +x _ = 2 -- (and thus the reason B fails is that the bug is fixed) diff --git a/testsuite/tests/indexed-types/should_fail/T13102/B.hs b/testsuite/tests/indexed-types/should_fail/T13102/B.hs new file mode 100644 index 0000000..ab8832b --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T13102/B.hs @@ -0,0 +1,6 @@ +module B where + +import F + +f :: F Int -> Bool +f = id diff --git a/testsuite/tests/indexed-types/should_fail/T13102/Makefile b/testsuite/tests/indexed-types/should_fail/T13102/Makefile new file mode 100644 index 0000000..b4cbff92 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T13102/Makefile @@ -0,0 +1,13 @@ +TOP=../../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +LOCAL_PKGCONF=local.package.conf + +T13102: + "$(GHC_PKG)" init $(LOCAL_PKGCONF) + cd orphan && "$(TEST_HC)" -v0 --make Setup.hs + cd orphan && ./Setup configure -v0 --with-compiler="$(TEST_HC)" --with-hc-pkg="$(GHC_PKG)" --package-db=../$(LOCAL_PKGCONF) + cd orphan && ./Setup build -v0 + cd orphan && ./Setup register -v0 --inplace + ! "$(TEST_HC)" $(TEST_HC_OPTS) -c A.hs B.hs -package-db $(LOCAL_PKGCONF) diff --git a/testsuite/tests/indexed-types/should_fail/T13102/T13102.stderr b/testsuite/tests/indexed-types/should_fail/T13102/T13102.stderr new file mode 100644 index 0000000..e884cba --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T13102/T13102.stderr @@ -0,0 +1,11 @@ + +A.hs:6:1: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match is redundant + In an equation for ‘x’: x _ = ... + +B.hs:6:5: error: + • Couldn't match type ‘F Int’ with ‘Bool’ + Expected type: F Int -> Bool + Actual type: Bool -> Bool + • In the expression: id + In an equation for ‘f’: f = id diff --git a/testsuite/tests/indexed-types/should_fail/T13102/all.T b/testsuite/tests/indexed-types/should_fail/T13102/all.T new file mode 100644 index 0000000..bdde354 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T13102/all.T @@ -0,0 +1,5 @@ +# Test that we don't use a family instance that we didn't import + +test('T13102', [expect_broken(13102), + extra_files(['A.hs', 'B.hs', 'orphan'])], + run_command, ['$MAKE -s --no-print-directory T13102']) diff --git a/testsuite/tests/indexed-types/should_fail/T13102/orphan/F.hs b/testsuite/tests/indexed-types/should_fail/T13102/orphan/F.hs new file mode 100644 index 0000000..7e1ecf4 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T13102/orphan/F.hs @@ -0,0 +1,5 @@ +{-# LANGUAGE TypeFamilies #-} + +module F where + +type family F a :: * diff --git a/testsuite/tests/driver/recomp016/A.hs b/testsuite/tests/indexed-types/should_fail/T13102/orphan/O.hs similarity index 64% copy from testsuite/tests/driver/recomp016/A.hs copy to testsuite/tests/indexed-types/should_fail/T13102/orphan/O.hs index 17a9dc0..b8608ec 100644 --- a/testsuite/tests/driver/recomp016/A.hs +++ b/testsuite/tests/indexed-types/should_fail/T13102/orphan/O.hs @@ -1,4 +1,7 @@ {-# LANGUAGE TypeFamilies #-} -module A where -type family F a + +module O where + +import F + type instance F Int = Bool diff --git a/testsuite/tests/backpack/cabal/bkpcabal01/Setup.hs b/testsuite/tests/indexed-types/should_fail/T13102/orphan/Setup.hs similarity index 100% copy from testsuite/tests/backpack/cabal/bkpcabal01/Setup.hs copy to testsuite/tests/indexed-types/should_fail/T13102/orphan/Setup.hs diff --git a/testsuite/tests/cabal/cabal03/p/p.cabal b/testsuite/tests/indexed-types/should_fail/T13102/orphan/orphan.cabal similarity index 59% copy from testsuite/tests/cabal/cabal03/p/p.cabal copy to testsuite/tests/indexed-types/should_fail/T13102/orphan/orphan.cabal index 5ef93a0..c6a6ea0 100644 --- a/testsuite/tests/cabal/cabal03/p/p.cabal +++ b/testsuite/tests/indexed-types/should_fail/T13102/orphan/orphan.cabal @@ -1,5 +1,5 @@ -name: p +name: orphan version: 1.0 -exposed-modules: P +exposed-modules: F, O build-depends: base build-type: Simple From git at git.haskell.org Tue Jan 24 14:46:22 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 24 Jan 2017 14:46:22 +0000 (UTC) Subject: [commit: ghc] master: Skip path_with_commas when dyn unavailable (90e83a7) Message-ID: <20170124144622.0381B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/90e83a7cbdccfeee86b02b7fe2f81b0485857f6e/ghc >--------------------------------------------------------------- commit 90e83a7cbdccfeee86b02b7fe2f81b0485857f6e Author: Bartosz Nitka Date: Tue Jan 24 06:45:54 2017 -0800 Skip path_with_commas when dyn unavailable RyanGlScott reported a failure: ``` Could not find module 'Prelude'; Perhaps you haven't installed the "dyn" libraries for package ‘base-4.10.0.0’? ``` This might fix it. Test Plan: harbormaster Reviewers: austin, bgamari, thomie, RyanGlScott Reviewed By: RyanGlScott Subscribers: thomie, simonmar Differential Revision: https://phabricator.haskell.org/D3013 >--------------------------------------------------------------- 90e83a7cbdccfeee86b02b7fe2f81b0485857f6e testsuite/tests/th/TH_linker/all.T | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/testsuite/tests/th/TH_linker/all.T b/testsuite/tests/th/TH_linker/all.T index 8feac99..9d3f1e3 100644 --- a/testsuite/tests/th/TH_linker/all.T +++ b/testsuite/tests/th/TH_linker/all.T @@ -1,4 +1,5 @@ test('path_with_commas', - ignore_stderr, + [ignore_stderr, + unless(have_dynamic(),skip)], run_command, ['$MAKE -s --no-print-directory path_with_commas']) From git at git.haskell.org Tue Jan 24 15:31:56 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 24 Jan 2017 15:31:56 +0000 (UTC) Subject: [commit: ghc] master: Don't put foralls in front of TH-spliced GADT constructors that don't need them (9fd87ef) Message-ID: <20170124153156.668D93A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9fd87ef8a16fbbce35205ae63d75d239bb575ccc/ghc >--------------------------------------------------------------- commit 9fd87ef8a16fbbce35205ae63d75d239bb575ccc Author: Ryan Scott Date: Tue Jan 24 10:16:38 2017 -0500 Don't put foralls in front of TH-spliced GADT constructors that don't need them Summary: It turns out that D2974 broke this program (see https://phabricator.haskell.org/rGHC729a5e452db5#58801): ```lang=haskell {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -ddump-splices #-} module Bug where import GHC.Exts (Constraint) $([d| data Dec13 :: (* -> Constraint) -> * where MkDec13 :: c a => a -> Dec13 c |]) ``` This was actually due to a long-standing bug in `hsSyn/Convert` that put unnecessary `forall`s in front of GADT constructors that didn't have any explicitly quantified type variables. This cargo-cults the code in `Convert` that handles `ForallT` and adapts it to `ForallC`. Fixes #13123 (for real this time). Test Plan: make test TEST=T13123 Reviewers: goldfire, austin, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D3002 GHC Trac Issues: #13123 >--------------------------------------------------------------- 9fd87ef8a16fbbce35205ae63d75d239bb575ccc compiler/hsSyn/Convert.hs | 15 +++++++++++---- testsuite/tests/th/T13123.hs | 7 +++++++ 2 files changed, 18 insertions(+), 4 deletions(-) diff --git a/compiler/hsSyn/Convert.hs b/compiler/hsSyn/Convert.hs index 7749265..3e0bf12 100644 --- a/compiler/hsSyn/Convert.hs +++ b/compiler/hsSyn/Convert.hs @@ -510,10 +510,17 @@ cvtConstr (ForallC tvs ctxt con) ; L _ con' <- cvtConstr con ; returnL $ case con' of ConDeclGADT { con_type = conT } -> - con' { con_type = - HsIB PlaceHolder - (noLoc $ HsForAllTy (hsq_explicit tvs') $ - (noLoc $ HsQualTy (L loc ctxt') (hsib_body conT))) } + let hs_ty + | null tvs = rho_ty + | otherwise = noLoc $ HsForAllTy + { hst_bndrs = hsq_explicit tvs' + , hst_body = rho_ty } + rho_ty + | null ctxt = hsib_body conT + | otherwise = noLoc $ HsQualTy + { hst_ctxt = L loc ctxt' + , hst_body = hsib_body conT } + in con' { con_type = HsIB PlaceHolder hs_ty } ConDeclH98 {} -> let qvars = case (tvs, con_qvars con') of ([], Nothing) -> Nothing diff --git a/testsuite/tests/th/T13123.hs b/testsuite/tests/th/T13123.hs index 987283b..d7e1006 100644 --- a/testsuite/tests/th/T13123.hs +++ b/testsuite/tests/th/T13123.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE PolyKinds #-} @@ -5,6 +6,8 @@ {-# LANGUAGE TemplateHaskell #-} module T13123 where +import GHC.Exts (Constraint) + $([d| idProxy :: forall proxy (a :: k). proxy a -> proxy a idProxy x = x |]) @@ -28,3 +31,7 @@ $([d| class Foo b where $([d| data GADT where MkGADT :: forall proxy (a :: k). proxy a -> GADT |]) + +$([d| data Dec13 :: (* -> Constraint) -> * where + MkDec13 :: c a => a -> Dec13 c + |]) From git at git.haskell.org Tue Jan 24 17:20:04 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 24 Jan 2017 17:20:04 +0000 (UTC) Subject: [commit: ghc] branch 'wip/discount-fv' created Message-ID: <20170124172004.D64293A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/discount-fv Referencing: e29f88b5d952f2f40f68e2bb49f051b6684d2686 From git at git.haskell.org Tue Jan 24 17:20:07 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 24 Jan 2017 17:20:07 +0000 (UTC) Subject: [commit: ghc] wip/discount-fv: Discount scrutinized free variables (fd9608e) Message-ID: <20170124172007.A50AC3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/discount-fv Link : http://ghc.haskell.org/trac/ghc/changeset/fd9608ea93fc2389907b82c3fe540805d986c28e/ghc >--------------------------------------------------------------- commit fd9608ea93fc2389907b82c3fe540805d986c28e Author: alexbiehl Date: Mon Jan 23 20:34:20 2017 +0100 Discount scrutinized free variables >--------------------------------------------------------------- fd9608ea93fc2389907b82c3fe540805d986c28e compiler/coreSyn/CoreUnfold.hs | 95 +++++++++++++++++++++++++----------------- 1 file changed, 56 insertions(+), 39 deletions(-) diff --git a/compiler/coreSyn/CoreUnfold.hs b/compiler/coreSyn/CoreUnfold.hs index 574d841..36ea382 100644 --- a/compiler/coreSyn/CoreUnfold.hs +++ b/compiler/coreSyn/CoreUnfold.hs @@ -62,8 +62,11 @@ import Bag import Util import Outputable import ForeignCall +import VarEnv +import Control.Applicative ((<|>)) import qualified Data.ByteString as BS +import Debug.Trace {- ************************************************************************ @@ -501,43 +504,51 @@ sizeExpr :: DynFlags -- Note [Computing the size of an expression] sizeExpr dflags bOMB_OUT_SIZE top_args expr - = size_up expr + = size_up emptyInScopeSet expr where - size_up (Cast e _) = size_up e - size_up (Tick _ e) = size_up e - size_up (Type _) = sizeZero -- Types cost nothing - size_up (Coercion _) = sizeZero - size_up (Lit lit) = sizeN (litSize lit) - size_up (Var f) | isRealWorldId f = sizeZero + size_up :: InScopeSet -> CoreExpr -> ExprSize + size_up is (Cast e _) = size_up is e + size_up is (Tick _ e) = size_up is e + size_up _ (Type _) = sizeZero -- Types cost nothing + size_up _ (Coercion _) = sizeZero + size_up _ (Lit lit) = sizeN (litSize lit) + size_up _ (Var f) | isRealWorldId f = sizeZero -- Make sure we get constructor discounts even -- on nullary constructors - | otherwise = size_up_call f [] 0 - - size_up (App fun arg) - | isTyCoArg arg = size_up fun - | otherwise = size_up arg `addSizeNSD` - size_up_app fun [arg] (if isRealWorldExpr arg then 1 else 0) - - size_up (Lam b e) - | isId b && not (isRealWorldId b) = lamScrutDiscount dflags (size_up e `addSizeN` 10) - | otherwise = size_up e - - size_up (Let (NonRec binder rhs) body) - = size_up rhs `addSizeNSD` - size_up body `addSizeN` + | otherwise = size_up_call f [] 0 + + size_up is (App fun arg) + | isTyCoArg arg = size_up is fun + | otherwise = size_up is arg `addSizeNSD` + size_up_app is fun [arg] (if isRealWorldExpr arg then 1 else 0) + + size_up is (Lam b e) + | isId b && not (isRealWorldId b) = lamScrutDiscount dflags (size_up is e `addSizeN` 10) + | otherwise = size_up is e + + size_up is (Let (NonRec binder rhs) body) + = let + is' = extendInScopeSet is binder + in + size_up is rhs `addSizeNSD` + size_up is' body `addSizeN` (if isUnliftedType (idType binder) then 0 else 10) -- For the allocation -- If the binder has an unlifted type there is no allocation - size_up (Let (Rec pairs) body) - = foldr (addSizeNSD . size_up . snd) - (size_up body `addSizeN` (10 * length pairs)) -- (length pairs) for the allocation + size_up is (Let (Rec pairs) body) + = let + is' = extendInScopeSetList is (map fst pairs) + in + foldr (addSizeNSD . size_up is' . snd) + (size_up is' body + `addSizeN` (10 * length pairs)) -- (length pairs) for the allocation pairs - size_up (Case e _ _ alts) - | Just v <- is_top_arg e -- We are scrutinising an argument variable + size_up is (Case e _ _ alts) + | Just v <- is_top_arg e <|> is_free_var e -- We are scrutinising an argument variable or a free variable = let - alt_sizes = map size_up_alt alts + alt_sizes = map (size_up_alt is) alts -- alts_size tries to compute a good discount for -- the case when we are scrutinising an argument variable @@ -569,9 +580,12 @@ sizeExpr dflags bOMB_OUT_SIZE top_args expr is_top_arg (Cast e _) = is_top_arg e is_top_arg _ = Nothing + is_free_var (Var v) | not (v `elemInScopeSet` is) = Just v + is_free_var (Cast e _) = is_free_var e + is_free_var _ = Nothing - size_up (Case e _ _ alts) = size_up e `addSizeNSD` - foldr (addAltSize . size_up_alt) case_size alts + size_up is (Case e _ _ alts) = size_up is e `addSizeNSD` + foldr (addAltSize . size_up_alt is) case_size alts where case_size | is_inline_scrut e, not (lengthExceeds alts 1) = sizeN (-10) @@ -608,15 +622,15 @@ sizeExpr dflags bOMB_OUT_SIZE top_args expr ------------ -- size_up_app is used when there's ONE OR MORE value args - size_up_app (App fun arg) args voids - | isTyCoArg arg = size_up_app fun args voids - | isRealWorldExpr arg = size_up_app fun (arg:args) (voids + 1) - | otherwise = size_up arg `addSizeNSD` - size_up_app fun (arg:args) voids - size_up_app (Var fun) args voids = size_up_call fun args voids - size_up_app (Tick _ expr) args voids = size_up_app expr args voids - size_up_app (Cast expr _) args voids = size_up_app expr args voids - size_up_app other args voids = size_up other `addSizeN` + size_up_app is (App fun arg) args voids + | isTyCoArg arg = size_up_app is fun args voids + | isRealWorldExpr arg = size_up_app is fun (arg:args) (voids + 1) + | otherwise = size_up is arg `addSizeNSD` + size_up_app is fun (arg:args) voids + size_up_app _ (Var fun) args voids = size_up_call fun args voids + size_up_app is (Tick _ expr) args voids = size_up_app is expr args voids + size_up_app is (Cast expr _) args voids = size_up_app is expr args voids + size_up_app is other args voids = size_up is other `addSizeN` callSize (length args) voids -- if the lhs is not an App or a Var, or an invisible thing like a -- Tick or Cast, then we should charge for a complete call plus the @@ -633,7 +647,10 @@ sizeExpr dflags bOMB_OUT_SIZE top_args expr _ -> funSize dflags top_args fun (length val_args) voids ------------ - size_up_alt (_con, _bndrs, rhs) = size_up rhs `addSizeN` 10 + size_up_alt :: InScopeSet -> Alt Var -> ExprSize + size_up_alt is (_con, bndrs, rhs) = size_up is' rhs `addSizeN` 10 + where is' = extendInScopeSetList is bndrs + -- Don't charge for args, so that wrappers look cheap -- (See comments about wrappers with Case) -- From git at git.haskell.org Tue Jan 24 17:20:10 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 24 Jan 2017 17:20:10 +0000 (UTC) Subject: [commit: ghc] wip/discount-fv: Include lambda binder in scope (e29f88b) Message-ID: <20170124172010.78FCB3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/discount-fv Link : http://ghc.haskell.org/trac/ghc/changeset/e29f88b5d952f2f40f68e2bb49f051b6684d2686/ghc >--------------------------------------------------------------- commit e29f88b5d952f2f40f68e2bb49f051b6684d2686 Author: alexbiehl Date: Mon Jan 23 21:30:35 2017 +0100 Include lambda binder in scope >--------------------------------------------------------------- e29f88b5d952f2f40f68e2bb49f051b6684d2686 compiler/coreSyn/CoreUnfold.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/compiler/coreSyn/CoreUnfold.hs b/compiler/coreSyn/CoreUnfold.hs index 36ea382..e72d95a 100644 --- a/compiler/coreSyn/CoreUnfold.hs +++ b/compiler/coreSyn/CoreUnfold.hs @@ -523,8 +523,9 @@ sizeExpr dflags bOMB_OUT_SIZE top_args expr size_up_app is fun [arg] (if isRealWorldExpr arg then 1 else 0) size_up is (Lam b e) - | isId b && not (isRealWorldId b) = lamScrutDiscount dflags (size_up is e `addSizeN` 10) - | otherwise = size_up is e + | isId b && not (isRealWorldId b) = lamScrutDiscount dflags (size_up is' e `addSizeN` 10) + | otherwise = size_up is' e + where is' = extendInScopeSet is b size_up is (Let (NonRec binder rhs) body) = let From git at git.haskell.org Tue Jan 24 21:01:13 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 24 Jan 2017 21:01:13 +0000 (UTC) Subject: [commit: ghc] master: Partially revert D3001 (99f8182) Message-ID: <20170124210113.936CC3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/99f818282673c9946a162c1727c4cecada76ddee/ghc >--------------------------------------------------------------- commit 99f818282673c9946a162c1727c4cecada76ddee Author: David Feuer Date: Tue Jan 24 15:59:39 2017 -0500 Partially revert D3001 D3001 accidentally changed the meaning of `containsSpan`. Revert that change. Reviewers: austin, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D3015 >--------------------------------------------------------------- 99f818282673c9946a162c1727c4cecada76ddee compiler/basicTypes/SrcLoc.hs | 16 +++++++--------- 1 file changed, 7 insertions(+), 9 deletions(-) diff --git a/compiler/basicTypes/SrcLoc.hs b/compiler/basicTypes/SrcLoc.hs index af757f5..06f42cc 100644 --- a/compiler/basicTypes/SrcLoc.hs +++ b/compiler/basicTypes/SrcLoc.hs @@ -344,15 +344,13 @@ isOneLineSpan (UnhelpfulSpan _) = False -- that it covers at least as much source code. True where spans are equal. containsSpan :: RealSrcSpan -> RealSrcSpan -> Bool containsSpan s1 s2 - = srcSpanEndCol s1 >= srcSpanEndCol s2 - && srcSpanStartCol s1 <= srcSpanStartCol s2 - && srcSpanEndLine s1 >= srcSpanEndLine s2 - && srcSpanStartLine s1 <= srcSpanStartLine s2 - && srcSpanFile s1 == srcSpanFile s2 - -- ordered roughly by the likelihood of failing: - -- * we're more likely to be comparing source spans from the same file - -- * we're more likely to be comparing source spans on the same line - + = (srcSpanStartLine s1, srcSpanStartCol s1) + <= (srcSpanStartLine s2, srcSpanStartCol s2) + && (srcSpanEndLine s1, srcSpanEndCol s1) + >= (srcSpanEndLine s2, srcSpanEndCol s2) + && (srcSpanFile s1 == srcSpanFile s2) + -- We check file equality last because it is (presumably?) least + -- likely to fail. {- %************************************************************************ %* * From git at git.haskell.org Tue Jan 24 21:07:53 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 24 Jan 2017 21:07:53 +0000 (UTC) Subject: [commit: ghc] master: nativeGen: Use `foldl'` instead of `foldr` in free register accumulation (efc8e3b) Message-ID: <20170124210753.7AD3C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/efc8e3b17bd374c5860081bd7350a1ce7c7cb92f/ghc >--------------------------------------------------------------- commit efc8e3b17bd374c5860081bd7350a1ce7c7cb92f Author: Ben Gamari Date: Tue Jan 24 12:51:26 2017 -0500 nativeGen: Use `foldl'` instead of `foldr` in free register accumulation Manipulations of `FreeRegs` values are all just bit-operations on a word. Turning these `foldr`s into `foldl'`s has a very small but consistent effect on compiler allocations, ``` -1 s.d. ----- -0.065% +1 s.d. ----- -0.018% Average ----- -0.042% ``` Test Plan: Validate Reviewers: austin Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2966 >--------------------------------------------------------------- efc8e3b17bd374c5860081bd7350a1ce7c7cb92f compiler/nativeGen/RegAlloc/Linear/JoinToTargets.hs | 3 ++- compiler/nativeGen/RegAlloc/Linear/Main.hs | 5 +++-- compiler/nativeGen/RegAlloc/Linear/PPC/FreeRegs.hs | 4 ++-- compiler/nativeGen/RegAlloc/Linear/SPARC/FreeRegs.hs | 4 ++-- compiler/nativeGen/RegAlloc/Linear/X86/FreeRegs.hs | 3 ++- compiler/nativeGen/RegAlloc/Linear/X86_64/FreeRegs.hs | 3 ++- 6 files changed, 13 insertions(+), 9 deletions(-) diff --git a/compiler/nativeGen/RegAlloc/Linear/JoinToTargets.hs b/compiler/nativeGen/RegAlloc/Linear/JoinToTargets.hs index 0b65537..186ff3f 100644 --- a/compiler/nativeGen/RegAlloc/Linear/JoinToTargets.hs +++ b/compiler/nativeGen/RegAlloc/Linear/JoinToTargets.hs @@ -25,6 +25,7 @@ import Unique import UniqFM import UniqSet +import Data.Foldable (foldl') -- | For a jump instruction at the end of a block, generate fixup code so its -- vregs are in the correct regs for its destination. @@ -128,7 +129,7 @@ joinToTargets_first block_live new_blocks block_id instr dest dests -- free up the regs that are not live on entry to this block. freeregs <- getFreeRegsR - let freeregs' = foldr (frReleaseReg platform) freeregs to_free + let freeregs' = foldl' (flip $ frReleaseReg platform) freeregs to_free -- remember the current assignment on entry to this block. setBlockAssigR (mapInsert dest (freeregs', src_assig) block_assig) diff --git a/compiler/nativeGen/RegAlloc/Linear/Main.hs b/compiler/nativeGen/RegAlloc/Linear/Main.hs index 4db02d6..0551297 100644 --- a/compiler/nativeGen/RegAlloc/Linear/Main.hs +++ b/compiler/nativeGen/RegAlloc/Linear/Main.hs @@ -351,7 +351,8 @@ initBlock id block_live Nothing -> setFreeRegsR (frInitFreeRegs platform) Just live -> - setFreeRegsR $ foldr (frAllocateReg platform) (frInitFreeRegs platform) [ r | RegReal r <- nonDetEltsUFM live ] + setFreeRegsR $ foldl' (flip $ frAllocateReg platform) (frInitFreeRegs platform) + [ r | RegReal r <- nonDetEltsUFM live ] -- See Note [Unique Determinism and code generation] setAssigR emptyRegMap @@ -685,7 +686,7 @@ clobberRegs clobbered let platform = targetPlatform dflags freeregs <- getFreeRegsR - setFreeRegsR $! foldr (frAllocateReg platform) freeregs clobbered + setFreeRegsR $! foldl' (flip $ frAllocateReg platform) freeregs clobbered assig <- getAssigR setAssigR $! clobber assig (nonDetUFMToList assig) diff --git a/compiler/nativeGen/RegAlloc/Linear/PPC/FreeRegs.hs b/compiler/nativeGen/RegAlloc/Linear/PPC/FreeRegs.hs index a2a6dac..5d36924 100644 --- a/compiler/nativeGen/RegAlloc/Linear/PPC/FreeRegs.hs +++ b/compiler/nativeGen/RegAlloc/Linear/PPC/FreeRegs.hs @@ -11,7 +11,7 @@ import Platform import Data.Word import Data.Bits --- import Data.List +import Data.Foldable (foldl') -- The PowerPC has 32 integer and 32 floating point registers. -- This is 32bit PowerPC, so Word64 is inefficient - two Word32s are much @@ -39,7 +39,7 @@ releaseReg _ _ = panic "RegAlloc.Linear.PPC.releaseReg: bad reg" initFreeRegs :: Platform -> FreeRegs -initFreeRegs platform = foldr releaseReg noFreeRegs (allocatableRegs platform) +initFreeRegs platform = foldl' (flip releaseReg) noFreeRegs (allocatableRegs platform) getFreeRegs :: RegClass -> FreeRegs -> [RealReg] -- lazily getFreeRegs cls (FreeRegs g f) diff --git a/compiler/nativeGen/RegAlloc/Linear/SPARC/FreeRegs.hs b/compiler/nativeGen/RegAlloc/Linear/SPARC/FreeRegs.hs index 89a9407..db4d6ba 100644 --- a/compiler/nativeGen/RegAlloc/Linear/SPARC/FreeRegs.hs +++ b/compiler/nativeGen/RegAlloc/Linear/SPARC/FreeRegs.hs @@ -13,7 +13,7 @@ import Platform import Data.Word import Data.Bits --- import Data.List +import Data.Foldable (foldl') -------------------------------------------------------------------------------- @@ -45,7 +45,7 @@ noFreeRegs = FreeRegs 0 0 0 -- | The initial set of free regs. initFreeRegs :: Platform -> FreeRegs initFreeRegs platform - = foldr (releaseReg platform) noFreeRegs allocatableRegs + = foldl' (flip $ releaseReg platform) noFreeRegs allocatableRegs -- | Get all the free registers of this class. diff --git a/compiler/nativeGen/RegAlloc/Linear/X86/FreeRegs.hs b/compiler/nativeGen/RegAlloc/Linear/X86/FreeRegs.hs index 0fcd658..ae4aa53 100644 --- a/compiler/nativeGen/RegAlloc/Linear/X86/FreeRegs.hs +++ b/compiler/nativeGen/RegAlloc/Linear/X86/FreeRegs.hs @@ -11,6 +11,7 @@ import Platform import Data.Word import Data.Bits +import Data.Foldable (foldl') newtype FreeRegs = FreeRegs Word32 deriving Show @@ -27,7 +28,7 @@ releaseReg _ _ initFreeRegs :: Platform -> FreeRegs initFreeRegs platform - = foldr releaseReg noFreeRegs (allocatableRegs platform) + = foldl' (flip releaseReg) noFreeRegs (allocatableRegs platform) getFreeRegs :: Platform -> RegClass -> FreeRegs -> [RealReg] -- lazily getFreeRegs platform cls (FreeRegs f) = go f 0 diff --git a/compiler/nativeGen/RegAlloc/Linear/X86_64/FreeRegs.hs b/compiler/nativeGen/RegAlloc/Linear/X86_64/FreeRegs.hs index c04fce9..5a7f71e 100644 --- a/compiler/nativeGen/RegAlloc/Linear/X86_64/FreeRegs.hs +++ b/compiler/nativeGen/RegAlloc/Linear/X86_64/FreeRegs.hs @@ -9,6 +9,7 @@ import Reg import Panic import Platform +import Data.Foldable (foldl') import Data.Word import Data.Bits @@ -27,7 +28,7 @@ releaseReg _ _ initFreeRegs :: Platform -> FreeRegs initFreeRegs platform - = foldr releaseReg noFreeRegs (allocatableRegs platform) + = foldl' (flip releaseReg) noFreeRegs (allocatableRegs platform) getFreeRegs :: Platform -> RegClass -> FreeRegs -> [RealReg] -- lazily getFreeRegs platform cls (FreeRegs f) = go f 0 From git at git.haskell.org Tue Jan 24 21:07:56 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 24 Jan 2017 21:07:56 +0000 (UTC) Subject: [commit: ghc] master: UniqSet: Implement unionManyUniqSets in terms of foldl' instead of foldr (deb75cb) Message-ID: <20170124210756.39D133A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/deb75cbf6741d84859eb256f1773807b099ca12f/ghc >--------------------------------------------------------------- commit deb75cbf6741d84859eb256f1773807b099ca12f Author: Ben Gamari Date: Tue Jan 24 12:50:00 2017 -0500 UniqSet: Implement unionManyUniqSets in terms of foldl' instead of foldr foldr generally isn't a good choice for folds where the result can't be consumed incrementally. This gives a very modest improvement in compiler allocations, ``` -1 s.d. ----- -0.182% +1 s.d. ----- -0.050% Average ----- -0.116% ``` This is clearly semantics-preserving since we are constructing a set. Test Plan: Validate Reviewers: austin Subscribers: dfeuer, thomie Differential Revision: https://phabricator.haskell.org/D2965 >--------------------------------------------------------------- deb75cbf6741d84859eb256f1773807b099ca12f compiler/utils/UniqSet.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/compiler/utils/UniqSet.hs b/compiler/utils/UniqSet.hs index f08fa86..6f58652 100644 --- a/compiler/utils/UniqSet.hs +++ b/compiler/utils/UniqSet.hs @@ -34,6 +34,7 @@ module UniqSet ( import UniqFM import Unique +import Data.Foldable (foldl') {- ************************************************************************ @@ -90,19 +91,18 @@ type UniqSet a = UniqFM a emptyUniqSet = emptyUFM unitUniqSet x = unitUFM x x -mkUniqSet = foldl addOneToUniqSet emptyUniqSet +mkUniqSet = foldl' addOneToUniqSet emptyUniqSet addOneToUniqSet set x = addToUFM set x x addOneToUniqSet_C f set x = addToUFM_C f set x x -addListToUniqSet = foldl addOneToUniqSet +addListToUniqSet = foldl' addOneToUniqSet delOneFromUniqSet = delFromUFM delOneFromUniqSet_Directly = delFromUFM_Directly delListFromUniqSet = delListFromUFM unionUniqSets = plusUFM -unionManyUniqSets [] = emptyUniqSet -unionManyUniqSets sets = foldr1 unionUniqSets sets +unionManyUniqSets = foldl' (flip unionUniqSets) emptyUniqSet minusUniqSet = minusUFM intersectUniqSets = intersectUFM From git at git.haskell.org Tue Jan 24 21:07:58 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 24 Jan 2017 21:07:58 +0000 (UTC) Subject: [commit: ghc] master: HscTypes: Use foldl' instead of foldr (2cc67ad) Message-ID: <20170124210758.E84F03A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2cc67adb29b33e15727c6463ed84e43cc159b3a2/ghc >--------------------------------------------------------------- commit 2cc67adb29b33e15727c6463ed84e43cc159b3a2 Author: Ben Gamari Date: Tue Jan 24 12:52:06 2017 -0500 HscTypes: Use foldl' instead of foldr In this case we are building a map, for which `foldl'` is much better suited. This has a small but consistent impact on compiler allocations, ``` -1 s.d. ----- -0.161% +1 s.d. ----- -0.011% Average ----- -0.086% ``` Test Plan: Validate Reviewers: austin Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2967 >--------------------------------------------------------------- 2cc67adb29b33e15727c6463ed84e43cc159b3a2 compiler/main/HscTypes.hs | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/compiler/main/HscTypes.hs b/compiler/main/HscTypes.hs index 8e6925f..51cec26 100644 --- a/compiler/main/HscTypes.hs +++ b/compiler/main/HscTypes.hs @@ -194,6 +194,7 @@ import GHC.Serialized ( Serialized ) import Foreign import Control.Monad ( guard, liftM, when, ap ) +import Data.Foldable ( foldl' ) import Data.IORef import Data.Time import Exception @@ -1124,10 +1125,10 @@ mkIfaceHashCache :: [(Fingerprint,IfaceDecl)] mkIfaceHashCache pairs = \occ -> lookupOccEnv env occ where - env = foldr add_decl emptyOccEnv pairs - add_decl (v,d) env0 = foldr add env0 (ifaceDeclFingerprints v d) + env = foldl' add_decl emptyOccEnv pairs + add_decl env0 (v,d) = foldl' add env0 (ifaceDeclFingerprints v d) where - add (occ,hash) env0 = extendOccEnv env0 occ (occ,hash) + add env0 (occ,hash) = extendOccEnv env0 occ (occ,hash) emptyIfaceHashCache :: OccName -> Maybe (OccName, Fingerprint) emptyIfaceHashCache _occ = Nothing From git at git.haskell.org Tue Jan 24 21:49:54 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 24 Jan 2017 21:49:54 +0000 (UTC) Subject: [commit: ghc] master: testsuite: Bump compiler allocations of T5837 (65cc762) Message-ID: <20170124214954.45E533A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/65cc7620517abec9b3e0d9bfe644accd5f649fe5/ghc >--------------------------------------------------------------- commit 65cc7620517abec9b3e0d9bfe644accd5f649fe5 Author: Ben Gamari Date: Tue Jan 24 16:48:18 2017 -0500 testsuite: Bump compiler allocations of T5837 Gipeda suggests that this is due to the recent top-level string literals in Core patch. >--------------------------------------------------------------- 65cc7620517abec9b3e0d9bfe644accd5f649fe5 testsuite/tests/perf/compiler/all.T | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T index b71c9d7..d9b0be5 100644 --- a/testsuite/tests/perf/compiler/all.T +++ b/testsuite/tests/perf/compiler/all.T @@ -605,7 +605,7 @@ test('T5837', # 2014-12-08: 115905208 Constraint solver perf improvements (esp kick-out) # 2016-04-06: 24199320 (x86/Linux, 64-bit machine) TypeInType - (wordsize(64), 52597024, 10)]) + (wordsize(64), 57861352, 10)]) # sample: 3926235424 (amd64/Linux, 15/2/2012) # 2012-10-02 81879216 # 2012-09-20 87254264 amd64/Linux @@ -629,6 +629,8 @@ test('T5837', # 2016-10-25 52597024 amd64/Linux, the test now passes (hooray), and so # allocates more because it goes right down the # compilation pipeline + # 2017-01-24 57861352 amd64/Linux, very likely due to the top-level strings + # in Core patch. ], compile, ['-freduction-depth=50']) From git at git.haskell.org Tue Jan 24 21:49:51 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 24 Jan 2017 21:49:51 +0000 (UTC) Subject: [commit: ghc] master: Bump Win32 version. (2aaafc8) Message-ID: <20170124214951.6CCB13A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2aaafc8b9788e4a3447a10740479e0e7c0622cda/ghc >--------------------------------------------------------------- commit 2aaafc8b9788e4a3447a10740479e0e7c0622cda Author: Ben Gamari Date: Mon Jan 23 14:52:36 2017 -0500 Bump Win32 version. Bump the version of `Win32` to `2.5.0.0` which is a major update and includes fixes for wrong alignments and wrong 64-bit types. Strangely enough this also seems to resolve #12713, where `T10858` was failing due to too-low allocations. The underlying type aliases have changed, so there is a potential for user programs not to compile anymore, but the types were incorrect. This also requires a bump in the `directory`, `Cabal`, and `process` submodules. Original author: Tamar Christina Test Plan: ./validate Reviewers: bgamari, RyanGlScott, austin Subscribers: hvr, RyanGlScott, thomie, #ghc_windows_task_force Differential Revision: https://phabricator.haskell.org/D2938 >--------------------------------------------------------------- 2aaafc8b9788e4a3447a10740479e0e7c0622cda compiler/ghc.cabal.in | 2 +- compiler/main/SysTools.hs | 8 ++++++-- ghc/ghc-bin.cabal.in | 2 +- libraries/Cabal | 2 +- libraries/Win32 | 2 +- libraries/directory | 2 +- libraries/process | 2 +- testsuite/tests/deriving/perf/all.T | 4 +--- testsuite/timeout/WinCBindings.hsc | 5 +++-- 9 files changed, 16 insertions(+), 13 deletions(-) diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in index 63276b3..dea0be5 100644 --- a/compiler/ghc.cabal.in +++ b/compiler/ghc.cabal.in @@ -68,7 +68,7 @@ Library hoopl >= 3.10.2 && < 3.11 if os(windows) - Build-Depends: Win32 == 2.3.* + Build-Depends: Win32 >= 2.3 && < 2.6 else if flag(terminfo) Build-Depends: terminfo == 0.4.* diff --git a/compiler/main/SysTools.hs b/compiler/main/SysTools.hs index 5bd9fd1..6777194 100644 --- a/compiler/main/SysTools.hs +++ b/compiler/main/SysTools.hs @@ -85,7 +85,11 @@ import qualified System.Posix.Internals #else /* Must be Win32 */ import Foreign import Foreign.C.String -import qualified System.Win32.Info as Info +#if MIN_VERSION_Win32(2,5,0) +import qualified System.Win32.Types as Win32 +#else +import qualified System.Win32.Info as Win32 +#endif import Control.Exception (finally) import Foreign.Ptr (FunPtr, castPtrToFunPtr) import System.Win32.Types (DWORD, LPTSTR, HANDLE) @@ -1514,7 +1518,7 @@ getFinalPath name = do (fILE_ATTRIBUTE_NORMAL .|. fILE_FLAG_BACKUP_SEMANTICS) Nothing let fnPtr = makeGetFinalPathNameByHandle $ castPtrToFunPtr addr - path <- Info.try "GetFinalPathName" + path <- Win32.try "GetFinalPathName" (\buf len -> fnPtr handle buf len 0) 512 `finally` closeHandle handle return $ Just path diff --git a/ghc/ghc-bin.cabal.in b/ghc/ghc-bin.cabal.in index dce6142..9c9ca0e 100644 --- a/ghc/ghc-bin.cabal.in +++ b/ghc/ghc-bin.cabal.in @@ -38,7 +38,7 @@ Executable ghc ghc == @ProjectVersionMunged@ if os(windows) - Build-Depends: Win32 == 2.3.* + Build-Depends: Win32 >= 2.3 && < 2.6 else Build-Depends: unix == 2.7.* diff --git a/libraries/Cabal b/libraries/Cabal index 7502659..824d0ba 160000 --- a/libraries/Cabal +++ b/libraries/Cabal @@ -1 +1 @@ -Subproject commit 7502659b7684e057047c68886df9c061645992c6 +Subproject commit 824d0bae1aee2a25cabdcef92e5e1dd470c7dac0 diff --git a/libraries/Win32 b/libraries/Win32 index bb9469e..8d3f144 160000 --- a/libraries/Win32 +++ b/libraries/Win32 @@ -1 +1 @@ -Subproject commit bb9469ece0b882017fa7f3b51e8db1d2985d6720 +Subproject commit 8d3f144a902bd13e1c6192e62ac1b2cf7cef595d diff --git a/libraries/directory b/libraries/directory index 65d1d85..4a4a19d 160000 --- a/libraries/directory +++ b/libraries/directory @@ -1 +1 @@ -Subproject commit 65d1d85a3fc3373a425a0298d572da9cd9ee3d86 +Subproject commit 4a4a19d1c46c70ffd9a3e1c4c283e2e16214258f diff --git a/libraries/process b/libraries/process index 85cc1d1..0524859 160000 --- a/libraries/process +++ b/libraries/process @@ -1 +1 @@ -Subproject commit 85cc1d17e9550a075003a764a2429d4acde65159 +Subproject commit 0524859137fc01bdb2a4833fd0aa6b23a48c6b15 diff --git a/testsuite/tests/deriving/perf/all.T b/testsuite/tests/deriving/perf/all.T index a6f9cc9..0c3e9a4 100644 --- a/testsuite/tests/deriving/perf/all.T +++ b/testsuite/tests/deriving/perf/all.T @@ -1,8 +1,6 @@ test('T10858', [compiler_stats_num_field('bytes allocated', [ (wordsize(64), 222312440, 8) ]), - only_ways(['normal']), - when(msys(), expect_broken(12713)) - ], + only_ways(['normal'])], compile, ['-O']) diff --git a/testsuite/timeout/WinCBindings.hsc b/testsuite/timeout/WinCBindings.hsc index 0c4ff3f..a72cdcf 100644 --- a/testsuite/timeout/WinCBindings.hsc +++ b/testsuite/timeout/WinCBindings.hsc @@ -259,9 +259,10 @@ foreign import WINDOWS_CCONV unsafe "windows.h WaitForSingleObject" type JOBOBJECTINFOCLASS = CInt type PVOID = Ptr () - -type ULONG_PTR = CUIntPtr type PULONG_PTR = Ptr ULONG_PTR +#if !MIN_VERSION_Win32(2,5,0) +type ULONG_PTR = CUIntPtr +#endif jobObjectExtendedLimitInformation :: JOBOBJECTINFOCLASS jobObjectExtendedLimitInformation = #const JobObjectExtendedLimitInformation From git at git.haskell.org Wed Jan 25 09:26:53 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 25 Jan 2017 09:26:53 +0000 (UTC) Subject: [commit: ghc] branch 'wip/dup_app' created Message-ID: <20170125092653.723673A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/dup_app Referencing: d4d760150a596fba0e3cc2753da8e1b2f1ba503d From git at git.haskell.org Wed Jan 25 09:26:56 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 25 Jan 2017 09:26:56 +0000 (UTC) Subject: [commit: ghc] wip/dup_app: Reduce dupAppSize (d4d7601) Message-ID: <20170125092656.3C68B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/dup_app Link : http://ghc.haskell.org/trac/ghc/changeset/d4d760150a596fba0e3cc2753da8e1b2f1ba503d/ghc >--------------------------------------------------------------- commit d4d760150a596fba0e3cc2753da8e1b2f1ba503d Author: alexbiehl Date: Wed Jan 25 10:23:37 2017 +0100 Reduce dupAppSize >--------------------------------------------------------------- d4d760150a596fba0e3cc2753da8e1b2f1ba503d compiler/coreSyn/CoreUtils.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/coreSyn/CoreUtils.hs b/compiler/coreSyn/CoreUtils.hs index d8e34ad..a7ef8ae 100644 --- a/compiler/coreSyn/CoreUtils.hs +++ b/compiler/coreSyn/CoreUtils.hs @@ -978,7 +978,7 @@ exprIsDupable dflags e decrement n = Just (n-1) dupAppSize :: Int -dupAppSize = 8 -- Size of term we are prepared to duplicate +dupAppSize = 4 -- Size of term we are prepared to duplicate -- This is *just* big enough to make test MethSharing -- inline enough join points. Really it should be -- smaller, and could be if we fixed Trac #4960. From git at git.haskell.org Wed Jan 25 10:30:47 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 25 Jan 2017 10:30:47 +0000 (UTC) Subject: [commit: ghc] master: Update .mailmap (675b54f) Message-ID: <20170125103047.CC6353A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/675b54f399a9ef131183528b50a8aa4a06209f74/ghc >--------------------------------------------------------------- commit 675b54f399a9ef131183528b50a8aa4a06209f74 Author: Matthew Pickering Date: Wed Jan 25 10:30:13 2017 +0000 Update .mailmap >--------------------------------------------------------------- 675b54f399a9ef131183528b50a8aa4a06209f74 .mailmap | 1 + 1 file changed, 1 insertion(+) diff --git a/.mailmap b/.mailmap index c542bab..4a3f653 100644 --- a/.mailmap +++ b/.mailmap @@ -11,6 +11,7 @@ Alexander Lukyanov # Ticket #9360. Alexander Vershilov Alexey Rodriguez Alexey Rodriguez mrchebas at gmail.com +Alex Biehl Andrew Farmer Andrew Farmer Andrew Pimlott andrew.pimlott.ctr at metnet.navy.mil From git at git.haskell.org Wed Jan 25 11:51:31 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 25 Jan 2017 11:51:31 +0000 (UTC) Subject: [commit: ghc] master: Typos in comments [ci skip] (e4ae78a) Message-ID: <20170125115131.8E4243A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e4ae78ae118f5b009a87b71f9ec21fb00962283a/ghc >--------------------------------------------------------------- commit e4ae78ae118f5b009a87b71f9ec21fb00962283a Author: Gabor Greif Date: Tue Jan 24 14:54:31 2017 +0100 Typos in comments [ci skip] >--------------------------------------------------------------- e4ae78ae118f5b009a87b71f9ec21fb00962283a compiler/basicTypes/ConLike.hs | 2 +- compiler/basicTypes/RdrName.hs | 6 +++--- compiler/cmm/CmmSink.hs | 2 +- compiler/coreSyn/CoreSyn.hs | 6 +++--- compiler/deSugar/DsMeta.hs | 2 +- compiler/iface/IfaceSyn.hs | 2 +- compiler/main/DynFlags.hs | 2 +- compiler/rename/RnEnv.hs | 4 ++-- compiler/simplCore/CoreMonad.hs | 2 +- compiler/stgSyn/StgSyn.hs | 2 +- compiler/typecheck/TcErrors.hs | 2 +- compiler/typecheck/TcSMonad.hs | 4 ++-- compiler/types/Unify.hs | 2 +- 13 files changed, 19 insertions(+), 19 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc e4ae78ae118f5b009a87b71f9ec21fb00962283a From git at git.haskell.org Wed Jan 25 11:51:34 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 25 Jan 2017 11:51:34 +0000 (UTC) Subject: [commit: ghc] master: Add myself [ci skip] (a1cd959) Message-ID: <20170125115134.53B713A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a1cd959e526d9c0265d26a646d7c9f9d13496fcf/ghc >--------------------------------------------------------------- commit a1cd959e526d9c0265d26a646d7c9f9d13496fcf Author: Gabor Greif Date: Wed Jan 25 12:19:49 2017 +0100 Add myself [ci skip] >--------------------------------------------------------------- a1cd959e526d9c0265d26a646d7c9f9d13496fcf .mailmap | 1 + 1 file changed, 1 insertion(+) diff --git a/.mailmap b/.mailmap index 4a3f653..5cfc6c4 100644 --- a/.mailmap +++ b/.mailmap @@ -100,6 +100,7 @@ Edward Z. Yang Erik de Castro Lopo Evan Hauck Fumiaki Kinoshita +Gabor Greif Gabor Pali Gabriele Keller keller Gabriele Keller keller at .cse.unsw.edu.au From git at git.haskell.org Wed Jan 25 15:00:24 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 25 Jan 2017 15:00:24 +0000 (UTC) Subject: [commit: ghc] master: Update Win32 submodule to fix Windows build (078c211) Message-ID: <20170125150024.B77E73A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/078c21140d4f27e586c9fa893d4ac94d28d6013c/ghc >--------------------------------------------------------------- commit 078c21140d4f27e586c9fa893d4ac94d28d6013c Author: Matthew Pickering Date: Wed Jan 25 14:53:55 2017 +0000 Update Win32 submodule to fix Windows build Reviewers: RyanGlScott, austin, Phyx, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D3021 >--------------------------------------------------------------- 078c21140d4f27e586c9fa893d4ac94d28d6013c libraries/Win32 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/Win32 b/libraries/Win32 index 8d3f144..716c9a3 160000 --- a/libraries/Win32 +++ b/libraries/Win32 @@ -1 +1 @@ -Subproject commit 8d3f144a902bd13e1c6192e62ac1b2cf7cef595d +Subproject commit 716c9a3e97611aea3a0a907ba80fe9c11e1afc7f From git at git.haskell.org Thu Jan 26 00:23:14 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 26 Jan 2017 00:23:14 +0000 (UTC) Subject: [commit: ghc] master: Template Haskell support for COMPLETE pragmas (95dc6dc) Message-ID: <20170126002314.17CD23A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/95dc6dc070deac733d4a4a63a93e606a2e772a67/ghc >--------------------------------------------------------------- commit 95dc6dc070deac733d4a4a63a93e606a2e772a67 Author: Matthew Pickering Date: Sat Jan 21 19:29:49 2017 +0000 Template Haskell support for COMPLETE pragmas Reviewers: RyanGlScott, austin, goldfire, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2997 GHC Trac Issues: #13098 >--------------------------------------------------------------- 95dc6dc070deac733d4a4a63a93e606a2e772a67 compiler/deSugar/DsMeta.hs | 21 +++++- compiler/hsSyn/Convert.hs | 5 ++ compiler/prelude/THNames.hs | 85 +++++++++++----------- .../template-haskell/Language/Haskell/TH/Lib.hs | 5 +- .../template-haskell/Language/Haskell/TH/Ppr.hs | 3 + .../template-haskell/Language/Haskell/TH/Syntax.hs | 2 + libraries/template-haskell/changelog.md | 2 + testsuite/tests/th/T13098.hs | 9 +++ testsuite/tests/th/all.T | 1 + 9 files changed, 90 insertions(+), 43 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 95dc6dc070deac733d4a4a63a93e606a2e772a67 From git at git.haskell.org Thu Jan 26 00:23:10 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 26 Jan 2017 00:23:10 +0000 (UTC) Subject: [commit: ghc] master: COMPLETE pragmas for enhanced pattern exhaustiveness checking (1a3f1ee) Message-ID: <20170126002310.95F803A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1a3f1eebf81952accb6340252816211c7d391300/ghc >--------------------------------------------------------------- commit 1a3f1eebf81952accb6340252816211c7d391300 Author: Matthew Pickering Date: Wed Jan 18 13:25:30 2017 +0000 COMPLETE pragmas for enhanced pattern exhaustiveness checking This patch adds a new pragma so that users can specify `COMPLETE` sets of `ConLike`s in order to sate the pattern match checker. A function which matches on all the patterns in a complete grouping will not cause the exhaustiveness checker to emit warnings. ``` pattern P :: () pattern P = () {-# COMPLETE P #-} foo P = () ``` This example would previously have caused the checker to warn that all cases were not matched even though matching on `P` is sufficient to make `foo` covering. With the addition of the pragma, the compiler will recognise that matching on `P` alone is enough and not emit any warnings. Reviewers: goldfire, gkaracha, alanz, austin, bgamari Reviewed By: alanz Subscribers: lelf, nomeata, gkaracha, thomie Differential Revision: https://phabricator.haskell.org/D2669 GHC Trac Issues: #8779 >--------------------------------------------------------------- 1a3f1eebf81952accb6340252816211c7d391300 compiler/basicTypes/ConLike.hs | 5 + compiler/deSugar/Check.hs | 276 ++++++++++++++------- compiler/deSugar/Desugar.hs | 14 +- compiler/deSugar/DsMeta.hs | 1 + compiler/deSugar/DsMonad.hs | 26 +- compiler/deSugar/PmExpr.hs | 57 +++-- compiler/deSugar/TmOracle.hs | 13 +- compiler/hsSyn/HsBinds.hs | 13 + compiler/iface/IfaceSyn.hs | 10 + compiler/iface/MkIface.hs | 20 +- compiler/iface/TcIface.hs | 31 +++ compiler/main/HscTypes.hs | 42 +++- compiler/main/TidyPgm.hs | 5 +- compiler/parser/Lexer.x | 7 +- compiler/parser/Parser.y | 13 + compiler/parser/RdrHsSyn.hs | 2 +- compiler/rename/RnBinds.hs | 10 + compiler/typecheck/TcBinds.hs | 107 +++++++- compiler/typecheck/TcRnDriver.hs | 2 +- compiler/typecheck/TcRnMonad.hs | 3 +- compiler/typecheck/TcRnTypes.hs | 24 +- compiler/vectorise/Vectorise/Monad.hs | 2 +- docs/users_guide/glasgow_exts.rst | 78 ++++++ .../tests/pmcheck/complete_sigs/Completesig03.hs | 7 + .../pmcheck/complete_sigs/Completesig03.stderr | 2 + .../tests/pmcheck/complete_sigs/Completesig03A.hs | 5 + .../complete_sigs}/Makefile | 0 testsuite/tests/pmcheck/complete_sigs/all.T | 15 ++ .../tests/pmcheck/complete_sigs/completesig01.hs | 20 ++ .../tests/pmcheck/complete_sigs/completesig02.hs | 10 + .../pmcheck/complete_sigs/completesig02.stderr | 4 + .../tests/pmcheck/complete_sigs/completesig04.hs | 3 + .../pmcheck/complete_sigs/completesig04.stderr | 4 + .../tests/pmcheck/complete_sigs/completesig05.hs | 14 ++ .../tests/pmcheck/complete_sigs/completesig06.hs | 29 +++ .../pmcheck/complete_sigs/completesig06.stderr | 29 +++ .../tests/pmcheck/complete_sigs/completesig07.hs | 24 ++ .../pmcheck/complete_sigs/completesig07.stderr | 11 + .../tests/pmcheck/complete_sigs/completesig08.hs | 30 +++ .../tests/pmcheck/complete_sigs/completesig09.hs | 13 + .../tests/pmcheck/complete_sigs/completesig10.hs | 33 +++ .../pmcheck/complete_sigs/completesig10.stderr | 4 + .../tests/pmcheck/complete_sigs/completesig11.hs | 14 ++ .../pmcheck/complete_sigs/completesig11.stderr | 4 + .../tests/pmcheck/complete_sigs/completesig12.hs | 22 ++ .../tests/pmcheck/complete_sigs/completesig13.hs | 19 ++ .../tests/pmcheck/complete_sigs/completesig14.hs | 11 + .../pmcheck/complete_sigs/completesig14.stderr | 4 + .../tests/pmcheck/complete_sigs/completesig15.hs | 12 + .../pmcheck/complete_sigs/completesig15.stderr | 4 + testsuite/tests/pmcheck/should_compile/all.T | 2 +- 51 files changed, 956 insertions(+), 154 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 1a3f1eebf81952accb6340252816211c7d391300 From git at git.haskell.org Thu Jan 26 02:32:00 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 26 Jan 2017 02:32:00 +0000 (UTC) Subject: [commit: ghc] master: Generalize the type of runRW# (c344005) Message-ID: <20170126023200.1F39C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c344005b2344800bee9fee1c5ca97867691b9c70/ghc >--------------------------------------------------------------- commit c344005b2344800bee9fee1c5ca97867691b9c70 Author: David Feuer Date: Wed Jan 25 21:14:54 2017 -0500 Generalize the type of runRW# * Generalize the type of `runRW#` to allow arbitrary return types. * Use `runRW#` to implement `Control.Monad.ST.Lazy.runST` (this provides evidence that it actually works properly with the generalized type). * Adjust the type signature in the definition of `oneShot` to match the one it is given in `MkId`. Reviewers: simonmar, austin, bgamari, hvr Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D3012 GHC Trac Issues: #13178 >--------------------------------------------------------------- c344005b2344800bee9fee1c5ca97867691b9c70 compiler/basicTypes/MkId.hs | 9 ++++----- libraries/base/Control/Monad/ST/Lazy/Imp.hs | 3 +-- libraries/ghc-prim/GHC/Magic.hs | 24 ++++++++++++++++++------ 3 files changed, 23 insertions(+), 13 deletions(-) diff --git a/compiler/basicTypes/MkId.hs b/compiler/basicTypes/MkId.hs index 417a6c7..65860d9 100644 --- a/compiler/basicTypes/MkId.hs +++ b/compiler/basicTypes/MkId.hs @@ -1236,12 +1236,11 @@ runRWId = pcMiscPrelId runRWName ty info -- State# RealWorld stateRW = mkTyConApp statePrimTyCon [realWorldTy] - -- (# State# RealWorld, o #) - ret_ty = mkTupleTy Unboxed [stateRW, openAlphaTy] - -- State# RealWorld -> (# State# RealWorld, o #) + -- o + ret_ty = openAlphaTy + -- State# RealWorld -> o arg_ty = stateRW `mkFunTy` ret_ty - -- (State# RealWorld -> (# State# RealWorld, o #)) - -- -> (# State# RealWorld, o #) + -- (State# RealWorld -> o) -> o ty = mkSpecForAllTys [runtimeRep1TyVar, openAlphaTyVar] $ arg_ty `mkFunTy` ret_ty diff --git a/libraries/base/Control/Monad/ST/Lazy/Imp.hs b/libraries/base/Control/Monad/ST/Lazy/Imp.hs index 45d2219..414c06c 100644 --- a/libraries/base/Control/Monad/ST/Lazy/Imp.hs +++ b/libraries/base/Control/Monad/ST/Lazy/Imp.hs @@ -89,12 +89,11 @@ instance Monad (ST s) where in k_a new_s -{-# NOINLINE runST #-} -- | Return the value computed by a state transformer computation. -- The @forall@ ensures that the internal state used by the 'ST' -- computation is inaccessible to the rest of the program. runST :: (forall s. ST s a) -> a -runST st = case st of ST the_st -> let (r,_) = the_st (S# realWorld#) in r +runST (ST st) = runRW# (\s -> case st (S# s) of (r, _) -> r) -- | Allow the result of a state transformer computation to be used (lazily) -- inside the computation. diff --git a/libraries/ghc-prim/GHC/Magic.hs b/libraries/ghc-prim/GHC/Magic.hs index 96f1742..ecdffc5 100644 --- a/libraries/ghc-prim/GHC/Magic.hs +++ b/libraries/ghc-prim/GHC/Magic.hs @@ -3,6 +3,8 @@ {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE TypeInType #-} +{-# LANGUAGE ScopedTypeVariables #-} ----------------------------------------------------------------------------- -- | @@ -25,6 +27,7 @@ module GHC.Magic ( inline, noinline, lazy, oneShot, runRW# ) where import GHC.Prim import GHC.CString () +import GHC.Types (RuntimeRep, TYPE) -- | The call @inline f@ arranges that 'f' is inlined, regardless of -- its size. More precisely, the call @inline f@ rewrites to the @@ -88,16 +91,25 @@ lazy x = x -- that would otherwise be shared are re-evaluated every time they are used. Otherwise, -- the use of `oneShot` is safe. -- --- 'oneShot' is open kinded, i.e. the type variables can refer to unlifted --- types as well. -oneShot :: (a -> b) -> (a -> b) +-- 'oneShot' is representation polymorphic: the type variables may refer to lifted +-- or unlifted types. +oneShot :: forall (q :: RuntimeRep) (r :: RuntimeRep) + (a :: TYPE q) (b :: TYPE r). + (a -> b) -> a -> b oneShot f = f -- Implementation note: This is wired in in MkId.lhs, so the code here is -- mostly there to have a place for the documentation. --- | Apply a function to a 'RealWorld' token. -runRW# :: (State# RealWorld -> (# State# RealWorld, o #)) - -> (# State# RealWorld, o #) +-- | Apply a function to a 'State# RealWorld' token. When manually applying +-- a function to `realWorld#`, it is necessary to use `NOINLINE` to prevent +-- semantically undesirable floating. `runRW#` is inlined, but only very late +-- in compilation after all floating is complete. + +-- 'runRW#' is representation polymorphic: the result may have a lifted or +-- unlifted type. + +runRW# :: forall (r :: RuntimeRep) (o :: TYPE r). + (State# RealWorld -> o) -> o -- See Note [runRW magic] in MkId #if !defined(__HADDOCK_VERSION__) runRW# m = m realWorld# From git at git.haskell.org Thu Jan 26 04:36:25 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 26 Jan 2017 04:36:25 +0000 (UTC) Subject: [commit: ghc] master: Add pragCompleteDName to templateHaskellNames (e4ab8ba) Message-ID: <20170126043625.354433A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e4ab8ba72af27cd23ecd3737b166b625190c34a5/ghc >--------------------------------------------------------------- commit e4ab8ba72af27cd23ecd3737b166b625190c34a5 Author: Ryan Scott Date: Wed Jan 25 23:32:17 2017 -0500 Add pragCompleteDName to templateHaskellNames 95dc6dc070deac733d4a4a63a93e606a2e772a67 forgot to add `pragCompleteDName` to the list of `templateHaskellNames`, which caused a panic if you actually tried to splice a `COMPLETE` pragma using Template Haskell. This applies the easy fix and augments the regression test to check for this in the future. >--------------------------------------------------------------- e4ab8ba72af27cd23ecd3737b166b625190c34a5 compiler/prelude/THNames.hs | 2 +- testsuite/tests/th/T13098.hs | 18 ++++++++++++++++++ 2 files changed, 19 insertions(+), 1 deletion(-) diff --git a/compiler/prelude/THNames.hs b/compiler/prelude/THNames.hs index e051082..253a89b 100644 --- a/compiler/prelude/THNames.hs +++ b/compiler/prelude/THNames.hs @@ -67,7 +67,7 @@ templateHaskellNames = [ classDName, instanceWithOverlapDName, standaloneDerivWithStrategyDName, sigDName, forImpDName, pragInlDName, pragSpecDName, pragSpecInlDName, pragSpecInstDName, - pragRuleDName, pragAnnDName, defaultSigDName, + pragRuleDName, pragCompleteDName, pragAnnDName, defaultSigDName, dataFamilyDName, openTypeFamilyDName, closedTypeFamilyDName, dataInstDName, newtypeInstDName, tySynInstDName, infixLDName, infixRDName, infixNDName, diff --git a/testsuite/tests/th/T13098.hs b/testsuite/tests/th/T13098.hs index 77e23f3..8df07d2 100644 --- a/testsuite/tests/th/T13098.hs +++ b/testsuite/tests/th/T13098.hs @@ -1,4 +1,6 @@ +{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE ViewPatterns #-} module T13098 where @@ -7,3 +9,19 @@ import Language.Haskell.TH $( sequence [ dataD (cxt []) (mkName "T") [PlainTV (mkName "a")] Nothing [normalC (mkName "T") []] [] , pragCompleteD [mkName "T"] Nothing ] ) + +$([d| class LL f where + go :: f a -> () + + instance LL [] where + go _ = () + + pattern T2 :: LL f => f a + pattern T2 <- (go -> ()) + + {-# COMPLETE T2 :: [] #-} + + -- No warning + foo :: [a] -> Int + foo T2 = 5 + |]) From git at git.haskell.org Thu Jan 26 04:53:00 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 26 Jan 2017 04:53:00 +0000 (UTC) Subject: [commit: ghc] master: Nix typo and redundant where-clauses (88a89b7) Message-ID: <20170126045300.5C1313A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/88a89b761ae37c38c190779b64e97bdd8cc10253/ghc >--------------------------------------------------------------- commit 88a89b761ae37c38c190779b64e97bdd8cc10253 Author: Ryan Scott Date: Wed Jan 25 23:51:32 2017 -0500 Nix typo and redundant where-clauses >--------------------------------------------------------------- 88a89b761ae37c38c190779b64e97bdd8cc10253 compiler/basicTypes/DataCon.hs | 1 - compiler/basicTypes/RdrName.hs | 1 - compiler/hsSyn/HsTypes.hs | 1 - compiler/nativeGen/SPARC/CodeGen/Gen32.hs | 2 -- compiler/typecheck/TcTyClsDecls.hs | 2 +- 5 files changed, 1 insertion(+), 6 deletions(-) diff --git a/compiler/basicTypes/DataCon.hs b/compiler/basicTypes/DataCon.hs index f4cdb21..620aea6 100644 --- a/compiler/basicTypes/DataCon.hs +++ b/compiler/basicTypes/DataCon.hs @@ -1109,7 +1109,6 @@ dataConUserType (MkData { dcUnivTyVars = univ_tvs, mkFunTys theta $ mkFunTys arg_tys $ res_ty - where -- | Finds the instantiated types of the arguments required to construct a 'DataCon' representation -- NB: these INCLUDE any dictionary args diff --git a/compiler/basicTypes/RdrName.hs b/compiler/basicTypes/RdrName.hs index 1bba34d..321b13a 100644 --- a/compiler/basicTypes/RdrName.hs +++ b/compiler/basicTypes/RdrName.hs @@ -738,7 +738,6 @@ availFromGRE (GRE { gre_name = me, gre_par = parent }) NoParent | isTyConName me -> AvailTC me [me] [] | otherwise -> avail me FldParent p mb_lbl -> AvailTC p [] [mkFieldLabel me mb_lbl] - where mkFieldLabel :: Name -> Maybe FastString -> FieldLabel mkFieldLabel me mb_lbl = diff --git a/compiler/hsSyn/HsTypes.hs b/compiler/hsSyn/HsTypes.hs index 7dd3491..c974d1f 100644 --- a/compiler/hsSyn/HsTypes.hs +++ b/compiler/hsSyn/HsTypes.hs @@ -1053,7 +1053,6 @@ splitLHsInstDeclTy (HsIB { hsib_vars = itkvs = (itkvs ++ map hsLTyVarName tvs, cxt, body_ty) -- Return implicitly bound type and kind vars -- For an instance decl, all of them are in scope - where getLHsInstDeclHead :: LHsSigType name -> LHsType name getLHsInstDeclHead inst_ty diff --git a/compiler/nativeGen/SPARC/CodeGen/Gen32.hs b/compiler/nativeGen/SPARC/CodeGen/Gen32.hs index a708558..a0e86f1 100644 --- a/compiler/nativeGen/SPARC/CodeGen/Gen32.hs +++ b/compiler/nativeGen/SPARC/CodeGen/Gen32.hs @@ -234,8 +234,6 @@ getRegister (CmmMachOp mop [x, y]) MO_S_Shr rep -> trivialCode rep SRA x y _ -> pprPanic "getRegister(sparc) - binary CmmMachOp (1)" (pprMachOp mop) - where - getRegister (CmmLoad mem pk) = do Amode src code <- getAmode mem diff --git a/compiler/typecheck/TcTyClsDecls.hs b/compiler/typecheck/TcTyClsDecls.hs index e790a11..d3e308f 100644 --- a/compiler/typecheck/TcTyClsDecls.hs +++ b/compiler/typecheck/TcTyClsDecls.hs @@ -324,7 +324,7 @@ See also Note [Kind checking recursive type and class declarations] kcTyClGroup :: [LTyClDecl Name] -> TcM [TcTyCon] -- Kind check this group, kind generalize, and return the resulting local env --- This bindds the TyCons and Classes of the group, but not the DataCons +-- This binds the TyCons and Classes of the group, but not the DataCons -- See Note [Kind checking for type and class decls] -- Third return value is Nothing if the tycon be unsaturated; otherwise, -- the arity From git at git.haskell.org Thu Jan 26 11:03:11 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 26 Jan 2017 11:03:11 +0000 (UTC) Subject: [commit: ghc] master: Typos in comments [ci skip] (ff9355e) Message-ID: <20170126110311.7D1763A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ff9355e48d0cb04b3adf26e27e12e128f79618f4/ghc >--------------------------------------------------------------- commit ff9355e48d0cb04b3adf26e27e12e128f79618f4 Author: Gabor Greif Date: Thu Jan 26 11:59:56 2017 +0100 Typos in comments [ci skip] >--------------------------------------------------------------- ff9355e48d0cb04b3adf26e27e12e128f79618f4 compiler/backpack/NameShape.hs | 2 +- compiler/coreSyn/CoreSyn.hs | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/compiler/backpack/NameShape.hs b/compiler/backpack/NameShape.hs index 0804d71..9817854 100644 --- a/compiler/backpack/NameShape.hs +++ b/compiler/backpack/NameShape.hs @@ -159,7 +159,7 @@ ns_module = mkHoleModule . ns_mod_name -- | Substitution on @{A.T}@. We enforce the invariant that the -- 'nameModule' of keys of this map have 'moduleUnitId' @hole@ -- (meaning that if we have a hole substitution, the keys of the map --- are never affected.) Alternately, this is ismorphic to +-- are never affected.) Alternately, this is isomorphic to -- @Map ('ModuleName', 'OccName') 'Name'@. type ShNameSubst = NameEnv Name diff --git a/compiler/coreSyn/CoreSyn.hs b/compiler/coreSyn/CoreSyn.hs index 6f692e0..0bf15f5 100644 --- a/compiler/coreSyn/CoreSyn.hs +++ b/compiler/coreSyn/CoreSyn.hs @@ -271,7 +271,7 @@ data Expr b | App (Expr b) (Arg b) | Lam b (Expr b) | Let (Bind b) (Expr b) - | Case (Expr b) b Type [Alt b] -- See #case_invariant# + | Case (Expr b) b Type [Alt b] -- See #case_invariants# | Cast (Expr b) Coercion | Tick (Tickish Id) (Expr b) | Type Type From git at git.haskell.org Thu Jan 26 13:20:30 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 26 Jan 2017 13:20:30 +0000 (UTC) Subject: [commit: ghc] master: Make type import/export API Annotation friendly (0d1cb15) Message-ID: <20170126132030.E8F143A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/0d1cb1574dd58d1026cac812e2098135823fa419/ghc >--------------------------------------------------------------- commit 0d1cb1574dd58d1026cac812e2098135823fa419 Author: Alan Zimmerman Date: Mon Jan 23 20:23:28 2017 +0200 Make type import/export API Annotation friendly Summary: At the moment an export of the form type C(..) is parsed by the rule ``` | 'type' oqtycon {% amms (mkTypeImpExp (sLL $1 $> (unLoc $2))) [mj AnnType $1,mj AnnVal $2] } ``` This means that the origiinal oqtycon loses its location which is then retained in the AnnVal annotation. The problem is if the oqtycon has its own annotations, these get lost. e.g. in type (?)(..) the parens annotations for (?) get lost. This patch adds a wrapper around the name in the IE type to (a) provide a distinct location for the adornment annotation and (b) identify the specific adornment, for use in the pretty printer rather than occName magic. Updates haddock submodule Test Plan: ./validate Reviewers: mpickering, dfeuer, bgamari, austin Reviewed By: dfeuer Subscribers: dfeuer, thomie, mpickering Differential Revision: https://phabricator.haskell.org/D3016 GHC Trac Issues: #13163 >--------------------------------------------------------------- 0d1cb1574dd58d1026cac812e2098135823fa419 compiler/hsSyn/HsImpExp.hs | 108 +++++++++++++++------- compiler/parser/Parser.y | 25 ++--- compiler/parser/RdrHsSyn.hs | 55 +++++++---- compiler/rename/RnNames.hs | 108 ++++++++++++++-------- compiler/typecheck/TcRnExports.hs | 40 ++++---- testsuite/driver/extra_files.py | 1 + testsuite/tests/ghc-api/annotations/Makefile | 4 + testsuite/tests/ghc-api/annotations/T13163.stdout | 78 ++++++++++++++++ testsuite/tests/ghc-api/annotations/Test13163.hs | 16 ++++ testsuite/tests/ghc-api/annotations/all.T | 1 + utils/check-ppr/README | 7 +- utils/haddock | 2 +- 12 files changed, 325 insertions(+), 120 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 0d1cb1574dd58d1026cac812e2098135823fa419 From git at git.haskell.org Thu Jan 26 16:04:34 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 26 Jan 2017 16:04:34 +0000 (UTC) Subject: [commit: ghc] master: Prune unneeded Derive* language pragmas (50544ee) Message-ID: <20170126160434.EB76C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/50544eea6ba519ce225e8bd01265e5a4a5d04bef/ghc >--------------------------------------------------------------- commit 50544eea6ba519ce225e8bd01265e5a4a5d04bef Author: Gabor Greif Date: Thu Jan 26 16:46:04 2017 +0100 Prune unneeded Derive* language pragmas >--------------------------------------------------------------- 50544eea6ba519ce225e8bd01265e5a4a5d04bef compiler/coreSyn/CoreSyn.hs | 2 +- compiler/types/TyCoRep.hs | 3 +-- 2 files changed, 2 insertions(+), 3 deletions(-) diff --git a/compiler/coreSyn/CoreSyn.hs b/compiler/coreSyn/CoreSyn.hs index 0bf15f5..333a55b 100644 --- a/compiler/coreSyn/CoreSyn.hs +++ b/compiler/coreSyn/CoreSyn.hs @@ -3,7 +3,7 @@ (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 -} -{-# LANGUAGE CPP, DeriveDataTypeable, DeriveFunctor #-} +{-# LANGUAGE CPP, DeriveDataTypeable #-} -- | CoreSyn holds all the main data types for use by for the Glasgow Haskell Compiler midsection module CoreSyn ( diff --git a/compiler/types/TyCoRep.hs b/compiler/types/TyCoRep.hs index 22345ec..e4c1c97 100644 --- a/compiler/types/TyCoRep.hs +++ b/compiler/types/TyCoRep.hs @@ -17,8 +17,7 @@ Note [The Type-related module hierarchy] -- We expose the relevant stuff from this module via the Type module {-# OPTIONS_HADDOCK hide #-} -{-# LANGUAGE CPP, DeriveDataTypeable, DeriveFunctor, DeriveFoldable, - DeriveTraversable, MultiWayIf #-} +{-# LANGUAGE CPP, DeriveDataTypeable, MultiWayIf #-} {-# LANGUAGE ImplicitParams #-} module TyCoRep ( From git at git.haskell.org Thu Jan 26 16:04:48 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 26 Jan 2017 16:04:48 +0000 (UTC) Subject: [commit: nofib] master: Add .arcconfig file to allow patches by phabricator (ce4b36b) Message-ID: <20170126160448.024043A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/nofib On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ce4b36b56727f1bdfc318fc0f7f4c4b192781537/nofib >--------------------------------------------------------------- commit ce4b36b56727f1bdfc318fc0f7f4c4b192781537 Author: Matthew Pickering Date: Thu Jan 26 11:02:31 2017 -0500 Add .arcconfig file to allow patches by phabricator Reviewers: RyanGlScott, bgamari Reviewed By: RyanGlScott, bgamari Differential Revision: https://phabricator.haskell.org/D2945 >--------------------------------------------------------------- ce4b36b56727f1bdfc318fc0f7f4c4b192781537 .arcconfig | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/.arcconfig b/.arcconfig new file mode 100644 index 0000000..d0aa0e7 --- /dev/null +++ b/.arcconfig @@ -0,0 +1,5 @@ +{ + "project.name" : "nofib", + "repository.callsign" : "NOFIB", + "phabricator.uri" : "https://phabricator.haskell.org" +} From git at git.haskell.org Thu Jan 26 16:06:42 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 26 Jan 2017 16:06:42 +0000 (UTC) Subject: [commit: hsc2hs] master: Add .arcconfig file (9e4da90) Message-ID: <20170126160642.36C113A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/hsc2hs On branch : master Link : http://git.haskell.org/hsc2hs.git/commitdiff/9e4da90b7f47c23a2989cba6083fc6ed3880790f >--------------------------------------------------------------- commit 9e4da90b7f47c23a2989cba6083fc6ed3880790f Author: Matthew Pickering Date: Thu Jan 26 11:05:51 2017 -0500 Add .arcconfig file Summary: Also testing submitting a patch for hsc2hs Reviewers: austin, bgamari, hvr Reviewed By: hvr Subscribers: erikd, RyanGlScott, thomie Differential Revision: https://phabricator.haskell.org/D2676 >--------------------------------------------------------------- 9e4da90b7f47c23a2989cba6083fc6ed3880790f .arcconfig | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/.arcconfig b/.arcconfig new file mode 100644 index 0000000..b4543d3 --- /dev/null +++ b/.arcconfig @@ -0,0 +1,5 @@ +{ + "project.name" : "hsc2hs", + "repository.callsign" : "HSCHS", + "phabricator.uri" : "https://phabricator.haskell.org" +} From git at git.haskell.org Thu Jan 26 17:48:51 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 26 Jan 2017 17:48:51 +0000 (UTC) Subject: [commit: ghc] master: Generalizes the type of asProxyTypeOf (#12805) (3eebd1f) Message-ID: <20170126174851.1E9283A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3eebd1f5fd56689baa63fcc63b7f4bde0ae70d0b/ghc >--------------------------------------------------------------- commit 3eebd1f5fd56689baa63fcc63b7f4bde0ae70d0b Author: Dave Laing Date: Thu Jan 26 12:32:24 2017 -0500 Generalizes the type of asProxyTypeOf (#12805) Test Plan: validate Reviewers: austin, hvr, bgamari, RyanGlScott, simonpj Reviewed By: RyanGlScott, simonpj Subscribers: simonpj, RyanGlScott, thomie Differential Revision: https://phabricator.haskell.org/D3017 GHC Trac Issues: #12805 >--------------------------------------------------------------- 3eebd1f5fd56689baa63fcc63b7f4bde0ae70d0b libraries/base/Data/Proxy.hs | 2 +- libraries/base/changelog.md | 2 ++ 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/libraries/base/Data/Proxy.hs b/libraries/base/Data/Proxy.hs index 2f619b2..d6f0354 100644 --- a/libraries/base/Data/Proxy.hs +++ b/libraries/base/Data/Proxy.hs @@ -113,6 +113,6 @@ instance MonadPlus Proxy -- It is usually used as an infix operator, and its typing forces its first -- argument (which is usually overloaded) to have the same type as the tag -- of the second. -asProxyTypeOf :: a -> Proxy a -> a +asProxyTypeOf :: a -> proxy a -> a asProxyTypeOf = const {-# INLINE asProxyTypeOf #-} diff --git a/libraries/base/changelog.md b/libraries/base/changelog.md index 608830a..40e18ff 100644 --- a/libraries/base/changelog.md +++ b/libraries/base/changelog.md @@ -43,6 +43,8 @@ * Add `type family AppendSymbol (m :: Symbol) (n :: Symbol) :: Symbol` to `GHC.TypeLits` (#12162) + * The type of `asProxyTypeOf` in `Data.Proxy` has been generalized (#12805) + ## 4.9.0.0 *May 2016* * Bundled with GHC 8.0 From git at git.haskell.org Thu Jan 26 17:48:48 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 26 Jan 2017 17:48:48 +0000 (UTC) Subject: [commit: ghc] master: Don't unnecessarily qualify TH-converted instances with empty contexts (ad3d2df) Message-ID: <20170126174848.636BA3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ad3d2dfa19a1ed788c682e8b0c7c6e66e63d3f79/ghc >--------------------------------------------------------------- commit ad3d2dfa19a1ed788c682e8b0c7c6e66e63d3f79 Author: Ryan Scott Date: Thu Jan 26 12:31:59 2017 -0500 Don't unnecessarily qualify TH-converted instances with empty contexts Summary: The addition of rigorous pretty-printer tests (499e43824bda967546ebf95ee33ec1f84a114a7c) had the unfortunate side-effect of revealing a bug in `hsSyn/Convert.hs` wherein instances are _always_ qualified with an instance context, even if the context is empty. This led to instances like this: ``` instance Foo Int ``` being pretty-printed like this! ``` instance () => Foo Int ``` We can prevent this by checking if the context is empty before adding an HsQualTy to the type. Also does some refactoring around HsForAllTys in `Convert` while I was in town. Fixes #13183. Test Plan: ./validate Reviewers: goldfire, bgamari, austin, alanz Reviewed By: alanz Subscribers: mpickering, thomie Differential Revision: https://phabricator.haskell.org/D3018 GHC Trac Issues: #13183 >--------------------------------------------------------------- ad3d2dfa19a1ed788c682e8b0c7c6e66e63d3f79 compiler/hsSyn/Convert.hs | 66 +++++++++++++++++++++++++++---------- testsuite/tests/th/T10598_TH.stderr | 6 ++-- testsuite/tests/th/T5700.stderr | 2 +- testsuite/tests/th/T5883.stderr | 2 +- testsuite/tests/th/T7532.stderr | 4 +-- 5 files changed, 55 insertions(+), 25 deletions(-) diff --git a/compiler/hsSyn/Convert.hs b/compiler/hsSyn/Convert.hs index a1ea110..ad4abf8 100644 --- a/compiler/hsSyn/Convert.hs +++ b/compiler/hsSyn/Convert.hs @@ -260,7 +260,7 @@ cvtDec (InstanceD o ctxt ty decs) ; unless (null fams') (failWith (mkBadDecMsg doc fams')) ; ctxt' <- cvtContext ctxt ; L loc ty' <- cvtType ty - ; let inst_ty' = L loc $ HsQualTy { hst_ctxt = ctxt', hst_body = L loc ty' } + ; let inst_ty' = mkHsQualTy ctxt loc ctxt' $ L loc ty' ; returnJustL $ InstD $ ClsInstD $ ClsInstDecl { cid_poly_ty = mkLHsSigType inst_ty' , cid_binds = binds' @@ -346,7 +346,7 @@ cvtDec (TH.RoleAnnotD tc roles) cvtDec (TH.StandaloneDerivD ds cxt ty) = do { cxt' <- cvtContext cxt ; L loc ty' <- cvtType ty - ; let inst_ty' = L loc $ HsQualTy { hst_ctxt = cxt', hst_body = L loc ty' } + ; let inst_ty' = mkHsQualTy cxt loc cxt' $ L loc ty' ; returnJustL $ DerivD $ DerivDecl { deriv_strategy = fmap (L loc . cvtDerivStrategy) ds , deriv_type = mkLHsSigType inst_ty' @@ -510,16 +510,9 @@ cvtConstr (ForallC tvs ctxt con) ; L _ con' <- cvtConstr con ; returnL $ case con' of ConDeclGADT { con_type = conT } -> - let hs_ty - | null tvs = rho_ty - | otherwise = noLoc $ HsForAllTy - { hst_bndrs = hsq_explicit tvs' - , hst_body = rho_ty } - rho_ty - | null ctxt = hsib_body conT - | otherwise = noLoc $ HsQualTy - { hst_ctxt = L loc ctxt' - , hst_body = hsib_body conT } + let hs_ty = mkHsForAllTy tvs noSrcSpan tvs' rho_ty + rho_ty = mkHsQualTy ctxt noSrcSpan (L loc ctxt') + (hsib_body conT) in con' { con_type = HsIB PlaceHolder hs_ty } ConDeclH98 {} -> let qvars = case (tvs, con_qvars con') of @@ -1221,12 +1214,8 @@ cvtTypeKind ty_str ty ; cxt' <- cvtContext cxt ; ty' <- cvtType ty ; loc <- getL - ; let hs_ty | null tvs = rho_ty - | otherwise = L loc (HsForAllTy { hst_bndrs = hsQTvExplicit tvs' - , hst_body = rho_ty }) - rho_ty | null cxt = ty' - | otherwise = L loc (HsQualTy { hst_ctxt = cxt' - , hst_body = ty' }) + ; let hs_ty = mkHsForAllTy tvs loc tvs' rho_ty + rho_ty = mkHsQualTy cxt loc cxt' ty' ; return hs_ty } @@ -1433,6 +1422,47 @@ unboxedSumChecks alt arity | otherwise = return () +-- | If passed an empty list of 'TH.TyVarBndr's, this simply returns the +-- third argument (an 'LHsType'). Otherwise, return an 'HsForAllTy' +-- using the provided 'LHsQTyVars' and 'LHsType'. +mkHsForAllTy :: [TH.TyVarBndr] + -- ^ The original Template Haskell type variable binders + -> SrcSpan + -- ^ The location of the returned 'LHsType' if it needs an + -- explicit forall + -> LHsQTyVars name + -- ^ The converted type variable binders + -> LHsType name + -- ^ The converted rho type + -> LHsType name + -- ^ The complete type, quantified with a forall if necessary +mkHsForAllTy tvs loc tvs' rho_ty + | null tvs = rho_ty + | otherwise = L loc $ HsForAllTy { hst_bndrs = hsQTvExplicit tvs' + , hst_body = rho_ty } + +-- | If passed an empty 'TH.Cxt', this simply returns the third argument +-- (an 'LHsType'). Otherwise, return an 'HsQualTy' using the provided +-- 'LHsContext' and 'LHsType'. + +-- It's important that we don't build an HsQualTy if the context is empty, +-- as the pretty-printer for HsType _always_ prints contexts, even if +-- they're empty. See Trac #13183. +mkHsQualTy :: TH.Cxt + -- ^ The original Template Haskell context + -> SrcSpan + -- ^ The location of the returned 'LHsType' if it needs an + -- explicit context + -> LHsContext name + -- ^ The converted context + -> LHsType name + -- ^ The converted tau type + -> LHsType name + -- ^ The complete type, qualified with a context if necessary +mkHsQualTy ctxt loc ctxt' ty + | null ctxt = ty + | otherwise = L loc $ HsQualTy { hst_ctxt = ctxt', hst_body = ty } + -------------------------------------------------------------------- -- Turning Name back into RdrName -------------------------------------------------------------------- diff --git a/testsuite/tests/th/T10598_TH.stderr b/testsuite/tests/th/T10598_TH.stderr index e149418..6471421 100644 --- a/testsuite/tests/th/T10598_TH.stderr +++ b/testsuite/tests/th/T10598_TH.stderr @@ -36,6 +36,6 @@ T10598_TH.hs:(27,3)-(42,50): Splicing declarations deriving stock Eq deriving anyclass C deriving newtype Read - deriving stock instance () => Ord Foo - deriving anyclass instance () => D Foo - deriving newtype instance () => Show Foo + deriving stock instance Ord Foo + deriving anyclass instance D Foo + deriving newtype instance Show Foo diff --git a/testsuite/tests/th/T5700.stderr b/testsuite/tests/th/T5700.stderr index f2f4288..729a366 100644 --- a/testsuite/tests/th/T5700.stderr +++ b/testsuite/tests/th/T5700.stderr @@ -1,6 +1,6 @@ T5700.hs:8:3-9: Splicing declarations mkC ''D ======> - instance () => C D where + instance C D where {-# INLINE inlinable #-} inlinable _ = GHC.Tuple.() diff --git a/testsuite/tests/th/T5883.stderr b/testsuite/tests/th/T5883.stderr index b63ea2f..aa87a41 100644 --- a/testsuite/tests/th/T5883.stderr +++ b/testsuite/tests/th/T5883.stderr @@ -6,6 +6,6 @@ T5883.hs:(7,4)-(12,4): Splicing declarations {-# INLINE show #-} |] ======> data Unit = Unit - instance () => Show Unit where + instance Show Unit where {-# INLINE show #-} show _ = "" diff --git a/testsuite/tests/th/T7532.stderr b/testsuite/tests/th/T7532.stderr index 21b753b..baaf04f 100644 --- a/testsuite/tests/th/T7532.stderr +++ b/testsuite/tests/th/T7532.stderr @@ -6,10 +6,10 @@ instance C Bool where T7532.hs:11:3-7: Splicing declarations bang' ======> - instance () => C Int where + instance C Int where data D Int = T ==================== Renamer ==================== -instance () => C Int where +instance C Int where data D Int = T7532.T From git at git.haskell.org Thu Jan 26 23:11:17 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 26 Jan 2017 23:11:17 +0000 (UTC) Subject: [commit: ghc] master: Bump nofib submodule (d8cb4b0) Message-ID: <20170126231117.B45793A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d8cb4b0df2b5dceebaa70e31e4f3b0df1826920d/ghc >--------------------------------------------------------------- commit d8cb4b0df2b5dceebaa70e31e4f3b0df1826920d Author: Ben Gamari Date: Thu Jan 26 18:10:43 2017 -0500 Bump nofib submodule >--------------------------------------------------------------- d8cb4b0df2b5dceebaa70e31e4f3b0df1826920d nofib | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/nofib b/nofib index bed591d..ce4b36b 160000 --- a/nofib +++ b/nofib @@ -1 +1 @@ -Subproject commit bed591d4aa45c7b92a40985c72bc6b3daaa68f0d +Subproject commit ce4b36b56727f1bdfc318fc0f7f4c4b192781537 From git at git.haskell.org Thu Jan 26 23:44:54 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 26 Jan 2017 23:44:54 +0000 (UTC) Subject: [commit: ghc] master: Fatal if we try to reinitialize the RTS (2ffcdfa) Message-ID: <20170126234454.5C49A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2ffcdfadaa53c9bc4b24606dc2e28a356a60d21e/ghc >--------------------------------------------------------------- commit 2ffcdfadaa53c9bc4b24606dc2e28a356a60d21e Author: Simon Marlow Date: Thu Jan 26 18:13:43 2017 -0500 Fatal if we try to reinitialize the RTS This isn't supported, and fatalling with an error is better than segfaulting later. Test Plan: validate Reviewers: JonCoens, austin, erikd, niteria, bgamari Reviewed By: niteria, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D3020 >--------------------------------------------------------------- 2ffcdfadaa53c9bc4b24606dc2e28a356a60d21e rts/RtsStartup.c | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/rts/RtsStartup.c b/rts/RtsStartup.c index 98c1dd2..9ec8af8 100644 --- a/rts/RtsStartup.c +++ b/rts/RtsStartup.c @@ -62,6 +62,7 @@ // Count of how many outstanding hs_init()s there have been. static int hs_init_count = 0; +static bool rts_shutdown = false; static void flushStdHandles(void); @@ -145,6 +146,10 @@ hs_init_ghc(int *argc, char **argv[], RtsConfig rts_config) // second and subsequent inits are ignored return; } + if (rts_shutdown) { + errorBelch("hs_init_ghc: reinitializing the RTS after shutdown is not currently supported"); + stg_exit(1); + } setlocale(LC_CTYPE,""); @@ -338,6 +343,7 @@ hs_exit_(bool wait_foreign) // ignore until it's the last one return; } + rts_shutdown = true; /* start timing the shutdown */ stat_startExit(); From git at git.haskell.org Thu Jan 26 23:44:51 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 26 Jan 2017 23:44:51 +0000 (UTC) Subject: [commit: ghc] master: Bump hsc2hs submodule (4e63e85) Message-ID: <20170126234451.A49DE3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4e63e859d98a612e04887099ab97bce09b3db25f/ghc >--------------------------------------------------------------- commit 4e63e859d98a612e04887099ab97bce09b3db25f Author: Ben Gamari Date: Thu Jan 26 18:12:15 2017 -0500 Bump hsc2hs submodule >--------------------------------------------------------------- 4e63e859d98a612e04887099ab97bce09b3db25f utils/hsc2hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/utils/hsc2hs b/utils/hsc2hs index fbc552f..9e4da90 160000 --- a/utils/hsc2hs +++ b/utils/hsc2hs @@ -1 +1 @@ -Subproject commit fbc552f4bb003edbdd52305a5eb34a903c9fe625 +Subproject commit 9e4da90b7f47c23a2989cba6083fc6ed3880790f From git at git.haskell.org Thu Jan 26 23:44:57 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 26 Jan 2017 23:44:57 +0000 (UTC) Subject: [commit: ghc] master: Fix the right-shift operation for negative big integers (fixes #12136) (06b9561) Message-ID: <20170126234457.A8A323A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/06b9561a2f10de68cc14b68a9bfa7617c0019bd9/ghc >--------------------------------------------------------------- commit 06b9561a2f10de68cc14b68a9bfa7617c0019bd9 Author: Daishi Nakajima Date: Thu Jan 26 18:14:08 2017 -0500 Fix the right-shift operation for negative big integers (fixes #12136) In `x shiftR y`, any of the following conditions cause an abort: - `x` is a negative big integer - The size of `x` and `y` is a multiple of `GMP_NUMB_BITS` - The bit of the absolute value of `x` is filled with `1` For example: Assuming `GMP_NUMB_BITS = 2`, the processing of `-15 shiftR 2` is as follows: 1. -15 = -1111 (twos complement: 10001) 2. right shift 2 (as a positive number) -> 0011 3. Due to the shift larger than GMP_NUMB_BITS, the size of the destination is decreasing (2bit) -> 11 4. Add 1, and get carry: (1) 00 5. abort I fixed it that the destination size does not decrease in such a case. Test Plan: I tested the specific case being reported. Reviewers: goldfire, austin, hvr, bgamari, rwbarton Reviewed By: bgamari, rwbarton Subscribers: mpickering, rwbarton, thomie Differential Revision: https://phabricator.haskell.org/D2998 GHC Trac Issues: #12136 >--------------------------------------------------------------- 06b9561a2f10de68cc14b68a9bfa7617c0019bd9 libraries/integer-gmp/cbits/wrappers.c | 14 +++++++++++--- libraries/integer-gmp/src/GHC/Integer/Type.hs | 2 +- testsuite/tests/numeric/should_run/T12136.hs | 19 +++++++++++++++++++ testsuite/tests/numeric/should_run/T12136.stdout | 1 + testsuite/tests/numeric/should_run/all.T | 1 + 5 files changed, 33 insertions(+), 4 deletions(-) diff --git a/libraries/integer-gmp/cbits/wrappers.c b/libraries/integer-gmp/cbits/wrappers.c index 1736efd..c99c017 100644 --- a/libraries/integer-gmp/cbits/wrappers.c +++ b/libraries/integer-gmp/cbits/wrappers.c @@ -105,7 +105,10 @@ integer_gmp_mpn_rshift (mp_limb_t rp[], const mp_limb_t sp[], mp_size_t sn, /* Twos-complement version of 'integer_gmp_mpn_rshift' for performing * arithmetic right shifts on "negative" MPNs. * - * Same pre-conditions as 'integer_gmp_mpn_rshift' + * pre-conditions: + * - 0 < count < sn*GMP_NUMB_BITS + * - rn = sn - floor((count - 1) / GMP_NUMB_BITS) + * - sn > 0 * * This variant is needed to operate on MPNs interpreted as negative * numbers, which require "rounding" towards minus infinity iff a @@ -117,7 +120,7 @@ integer_gmp_mpn_rshift_2c (mp_limb_t rp[], const mp_limb_t sp[], { const mp_size_t limb_shift = count / GMP_NUMB_BITS; const unsigned int bit_shift = count % GMP_NUMB_BITS; - const mp_size_t rn = sn - limb_shift; + mp_size_t rn = sn - limb_shift; // whether non-zero bits were shifted out bool nz_shift_out = false; @@ -125,8 +128,13 @@ integer_gmp_mpn_rshift_2c (mp_limb_t rp[], const mp_limb_t sp[], if (bit_shift) { if (mpn_rshift(rp, &sp[limb_shift], rn, bit_shift)) nz_shift_out = true; - } else + } else { + // rp was allocated (rn + 1) limbs, to prevent carry + // on mpn_add_1 when all the bits of {rp, rn} are 1. + memset(&rp[rn], 0, sizeof(mp_limb_t)); memcpy(rp, &sp[limb_shift], rn*sizeof(mp_limb_t)); + rn++; + } if (!nz_shift_out) for (unsigned i = 0; i < limb_shift; i++) diff --git a/libraries/integer-gmp/src/GHC/Integer/Type.hs b/libraries/integer-gmp/src/GHC/Integer/Type.hs index 035cb1e..0d279ef 100644 --- a/libraries/integer-gmp/src/GHC/Integer/Type.hs +++ b/libraries/integer-gmp/src/GHC/Integer/Type.hs @@ -1142,7 +1142,7 @@ shiftRNegBigNat x@(BN# xba#) n# where xn# = sizeofBigNat# x yn# = xn# -# nlimbs# - nlimbs# = quotInt# n# GMP_LIMB_BITS# + nlimbs# = quotInt# (n# -# 1#) GMP_LIMB_BITS# orBigNat :: BigNat -> BigNat -> BigNat diff --git a/testsuite/tests/numeric/should_run/T12136.hs b/testsuite/tests/numeric/should_run/T12136.hs new file mode 100644 index 0000000..1f967a8 --- /dev/null +++ b/testsuite/tests/numeric/should_run/T12136.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE CPP #-} + +#include "MachDeps.h" + +module Main where + +import Data.Bits + +#if WORD_SIZE_IN_BITS != 64 && WORD_SIZE_IN_BITS != 32 +# error unsupported WORD_SIZE_IN_BITS config +#endif + +-- a negative integer the size of GMP_LIMB_BITS*2 +negativeBigInteger :: Integer +negativeBigInteger = 1 - (1 `shiftL` (64 * 2)) + +main = do + -- rigt shift by GMP_LIMB_BITS + print $ negativeBigInteger `shiftR` 64 diff --git a/testsuite/tests/numeric/should_run/T12136.stdout b/testsuite/tests/numeric/should_run/T12136.stdout new file mode 100644 index 0000000..e40641e --- /dev/null +++ b/testsuite/tests/numeric/should_run/T12136.stdout @@ -0,0 +1 @@ +-18446744073709551616 diff --git a/testsuite/tests/numeric/should_run/all.T b/testsuite/tests/numeric/should_run/all.T index c0c4fe9..6510dc9 100644 --- a/testsuite/tests/numeric/should_run/all.T +++ b/testsuite/tests/numeric/should_run/all.T @@ -60,3 +60,4 @@ test('T9810', normal, compile_and_run, ['']) test('T10011', normal, compile_and_run, ['']) test('T10962', omit_ways(['ghci']), compile_and_run, ['']) test('T11702', extra_ways(['optasm']), compile_and_run, ['']) +test('T12136', normal, compile_and_run, ['']) From git at git.haskell.org Thu Jan 26 23:45:00 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 26 Jan 2017 23:45:00 +0000 (UTC) Subject: [commit: ghc] master: Remove Data.Tuple doc's claim to have tuple types (2af38b0) Message-ID: <20170126234500.601153A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2af38b065b506cd86e9be20d9592423730f0a5e2/ghc >--------------------------------------------------------------- commit 2af38b065b506cd86e9be20d9592423730f0a5e2 Author: Chris Martin Date: Thu Jan 26 18:14:36 2017 -0500 Remove Data.Tuple doc's claim to have tuple types "The tuple data types" seems like an inaccurate way to lead off the description of this module, which doesn't actually export the tuple data types. The latter part of the sentence, "associated functions", accurately describes the entire module. Reviewers: austin, hvr, bgamari Reviewed By: bgamari Subscribers: dfeuer, thomie Differential Revision: https://phabricator.haskell.org/D2924 >--------------------------------------------------------------- 2af38b065b506cd86e9be20d9592423730f0a5e2 libraries/base/Data/Tuple.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/base/Data/Tuple.hs b/libraries/base/Data/Tuple.hs index d8bccf3..372e2b8 100644 --- a/libraries/base/Data/Tuple.hs +++ b/libraries/base/Data/Tuple.hs @@ -11,7 +11,7 @@ -- Stability : experimental -- Portability : portable -- --- The tuple data types, and associated functions. +-- Functions associated with the tuple data types. -- ----------------------------------------------------------------------------- From git at git.haskell.org Fri Jan 27 22:29:13 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 27 Jan 2017 22:29:13 +0000 (UTC) Subject: [commit: ghc] branch 'wip/rwbarton-minusInteger' created Message-ID: <20170127222913.7300A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/rwbarton-minusInteger Referencing: ee0889d596d271b2f6bc2e2d6dce2a443edf1b67 From git at git.haskell.org Fri Jan 27 22:29:16 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 27 Jan 2017 22:29:16 +0000 (UTC) Subject: [commit: ghc] wip/rwbarton-minusInteger: Simplify minusInteger in integer-gmp slightly (ee0889d) Message-ID: <20170127222916.33FDC3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rwbarton-minusInteger Link : http://ghc.haskell.org/trac/ghc/changeset/ee0889d596d271b2f6bc2e2d6dce2a443edf1b67/ghc >--------------------------------------------------------------- commit ee0889d596d271b2f6bc2e2d6dce2a443edf1b67 Author: Reid Barton Date: Fri Jan 27 17:18:27 2017 -0500 Simplify minusInteger in integer-gmp slightly Summary: These two special cases were created in D2279 by mechanically inlining negateInteger into plusInteger. They aren't needed (the `minusInteger (S# x#) (S# y#)` case already handles all values correctly), and they can never help by avoiding an allocation, unlike the original special case in plusInteger, since we still have to allocate the result. Removing these special cases will save a couple comparisons and conditional branches in the common case of subtracting two small Integers. Test Plan: Existing test `plusMinusInteger` already tests the values in question. Reviewers: austin, hvr, goldfire, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D3034 >--------------------------------------------------------------- ee0889d596d271b2f6bc2e2d6dce2a443edf1b67 libraries/integer-gmp/src/GHC/Integer/Type.hs | 2 -- 1 file changed, 2 deletions(-) diff --git a/libraries/integer-gmp/src/GHC/Integer/Type.hs b/libraries/integer-gmp/src/GHC/Integer/Type.hs index 0d279ef..d5f92b3 100644 --- a/libraries/integer-gmp/src/GHC/Integer/Type.hs +++ b/libraries/integer-gmp/src/GHC/Integer/Type.hs @@ -421,8 +421,6 @@ plusInteger (Jp# x) (Jn# y) -- | Subtract one 'Integer' from another. minusInteger :: Integer -> Integer -> Integer minusInteger x (S# 0#) = x -minusInteger (S# 0#) (S# INT_MINBOUND#) = Jp# (wordToBigNat ABS_INT_MINBOUND##) -minusInteger (S# 0#) (S# y#) = S# (negateInt# y#) minusInteger (S# x#) (S# y#) = case subIntC# x# y# of (# z#, 0# #) -> S# z# From git at git.haskell.org Sat Jan 28 04:23:51 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 28 Jan 2017 04:23:51 +0000 (UTC) Subject: [commit: ghc] master: Add delete retry loop. [ci skip] (1f366b8) Message-ID: <20170128042351.A4C653A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1f366b8d15feaa05931bd2d81d8b0c5bae92f3b8/ghc >--------------------------------------------------------------- commit 1f366b8d15feaa05931bd2d81d8b0c5bae92f3b8 Author: Tamar Christina Date: Sat Jan 28 04:19:02 2017 +0000 Add delete retry loop. [ci skip] Summary: On Windows we have to retry the delete a couple of times. The reason for this is that a `FileDelete` command just marks a file for deletion. The file is really only removed when the last handle to the file is closed. Unfortunately there are a lot of system services that can have a file temporarily opened using a shared readonly lock, such as the built in AV and search indexer. We can't really guarantee that these are all off, so what we can do is whenever after a `rmtree` the folder still exists to try again and wait a bit. Based on what I've seen from the tests on CI server, is that this is relatively rare. So overall we won't be retrying a lot. If after a reasonable amount of time the folder is still locked then abort the current test by throwing an exception, this so it won't fail with an even more cryptic error. The issue is that these services often open a file using `FILE_SHARE_DELETE` permissions. So they can seemingly be removed, and for most intended purposes they are, but recreating the file with the same name will fail as the FS will prevent data loss. The MSDN docs for `DeleteFile` says: ``` The DeleteFile function marks a file for deletion on close. Therefore, the file deletion does not occur until the last handle to the file is closed. Subsequent calls to CreateFile to open the file fail with ERROR_ACCESS_DENIED. ``` Retrying seems to be a common pattern, SQLite has it in their driver http://www.sqlite.org/src/info/89f1848d7f The only way to avoid this is to run each way of a test in it's own folder. This would also have the added bonus of increased parallelism. Reviewers: austin, bgamari Reviewed By: bgamari Subscribers: thomie, #ghc_windows_task_force Differential Revision: https://phabricator.haskell.org/D2936 GHC Trac Issues: #12661, #13162 >--------------------------------------------------------------- 1f366b8d15feaa05931bd2d81d8b0c5bae92f3b8 testsuite/driver/testlib.py | 43 +++++++++++++++++++++++++++++-------------- 1 file changed, 29 insertions(+), 14 deletions(-) diff --git a/testsuite/driver/testlib.py b/testsuite/driver/testlib.py index c0135f0..78e2c6f 100644 --- a/testsuite/driver/testlib.py +++ b/testsuite/driver/testlib.py @@ -1893,26 +1893,41 @@ def find_expected_file(name, suff): if config.msys: import stat + import time def cleanup(): testdir = getTestOpts().testdir - + max_attemps = 5 + retries = max_attemps def on_error(function, path, excinfo): # At least one test (T11489) removes the write bit from a file it # produces. Windows refuses to delete read-only files with a # permission error. Try setting the write bit and try again. - if excinfo[1].errno == 13: - os.chmod(path, stat.S_IWRITE) - function(path) - - shutil.rmtree(testdir, ignore_errors=False, onerror=on_error) - - if os.path.exists(testdir): - # And now we try to cleanup the folder again, since the above - # Would have removed the problematic file(s), but not the folder. - # The onerror doesn't seem to be raised during the tree walk, only - # afterwards to report the failures. - # See https://bugs.python.org/issue8523 and https://bugs.python.org/issue19643 - shutil.rmtree(testdir, ignore_errors=False) + os.chmod(path, stat.S_IWRITE) + function(path) + + # On Windows we have to retry the delete a couple of times. + # The reason for this is that a FileDelete command just marks a + # file for deletion. The file is really only removed when the last + # handle to the file is closed. Unfortunately there are a lot of + # system services that can have a file temporarily opened using a shared + # readonly lock, such as the built in AV and search indexer. + # + # We can't really guarantee that these are all off, so what we can do is + # whenever after a rmtree the folder still exists to try again and wait a bit. + # + # Based on what I've seen from the tests on CI server, is that this is relatively rare. + # So overall we won't be retrying a lot. If after a reasonable amount of time the folder is + # still locked then abort the current test by throwing an exception, this so it won't fail + # with an even more cryptic error. + # + # See Trac #13162 + while retries > 0 and os.path.exists(testdir): + time.sleep((max_attemps-retries)*6) + shutil.rmtree(testdir, onerror=on_error, ignore_errors=False) + retries=-1 + + if retries == 0 and os.path.exists(testdir): + raise Exception("Unable to remove folder '" + testdir + "'. Unable to start current test.") else: def cleanup(): testdir = getTestOpts().testdir From git at git.haskell.org Sat Jan 28 12:02:51 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 28 Jan 2017 12:02:51 +0000 (UTC) Subject: [commit: ghc] master: Document GHC.Profiling functions [ci skip] (de78ee6) Message-ID: <20170128120251.C881D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/de78ee6fb77e7505160ab23e6e1b4e66dc87f698/ghc >--------------------------------------------------------------- commit de78ee6fb77e7505160ab23e6e1b4e66dc87f698 Author: Ömer Sinan Ağacan Date: Sat Jan 28 14:59:30 2017 +0300 Document GHC.Profiling functions [ci skip] >--------------------------------------------------------------- de78ee6fb77e7505160ab23e6e1b4e66dc87f698 libraries/base/GHC/Profiling.hs | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/libraries/base/GHC/Profiling.hs b/libraries/base/GHC/Profiling.hs index 7329176..917a208 100644 --- a/libraries/base/GHC/Profiling.hs +++ b/libraries/base/GHC/Profiling.hs @@ -6,5 +6,14 @@ module GHC.Profiling where import GHC.Base -foreign import ccall startProfTimer :: IO () +-- | Stop attributing ticks to cost centres. Allocations will still be +-- attributed. +-- +-- @since 4.7.0.0 foreign import ccall stopProfTimer :: IO () + +-- | Start attributing ticks to cost centres. This is called by the RTS on +-- startup. +-- +-- @since 4.7.0.0 +foreign import ccall startProfTimer :: IO () From git at git.haskell.org Sat Jan 28 21:26:58 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 28 Jan 2017 21:26:58 +0000 (UTC) Subject: [commit: ghc] branch 'wip/orf-2017' created Message-ID: <20170128212658.186CB3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/orf-2017 Referencing: 623acf55a9d2940f55ba279cbefe65bcf3f9c024 From git at git.haskell.org Sat Jan 28 21:27:02 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 28 Jan 2017 21:27:02 +0000 (UTC) Subject: [commit: ghc] wip/orf-2017: Add HasField class with magic constraint solving (f21526f) Message-ID: <20170128212702.65B913A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/orf-2017 Link : http://ghc.haskell.org/trac/ghc/changeset/f21526f48734b1a45eb5ccf7925376c91b1940f4/ghc >--------------------------------------------------------------- commit f21526f48734b1a45eb5ccf7925376c91b1940f4 Author: Adam Gundry Date: Fri Nov 18 15:54:02 2016 +0000 Add HasField class with magic constraint solving >--------------------------------------------------------------- f21526f48734b1a45eb5ccf7925376c91b1940f4 compiler/basicTypes/DataCon.hs | 14 ++- compiler/basicTypes/RdrName.hs | 31 +++-- compiler/deSugar/DsBinds.hs | 4 + compiler/prelude/PrelNames.hs | 16 +++ compiler/rename/RnPat.hs | 15 +-- compiler/typecheck/TcEvidence.hs | 7 ++ compiler/typecheck/TcHsSyn.hs | 5 + compiler/typecheck/TcInteract.hs | 127 ++++++++++++++++++++- compiler/typecheck/TcSMonad.hs | 19 ++- compiler/typecheck/TcValidity.hs | 44 +++++++ compiler/types/TyCon.hs | 5 +- compiler/utils/FastStringEnv.hs | 5 +- libraries/base/GHC/Records.hs | 34 ++++++ libraries/base/base.cabal | 1 + testsuite/driver/extra_files.py | 1 + .../should_fail/HasFieldFail01_A.hs | 3 + .../tests/overloadedrecflds/should_fail/all.T | 5 + .../should_fail/hasfieldfail01.hs | 9 ++ .../should_fail/hasfieldfail01.stderr | 11 ++ .../should_fail/hasfieldfail02.hs | 16 +++ .../should_fail/hasfieldfail02.stderr | 13 +++ .../should_fail/hasfieldfail03.hs | 39 +++++++ .../should_fail/hasfieldfail03.stderr | 21 ++++ testsuite/tests/overloadedrecflds/should_run/all.T | 2 + .../overloadedrecflds/should_run/hasfieldrun01.hs | 51 +++++++++ .../should_run/hasfieldrun01.stdout | 8 ++ .../overloadedrecflds/should_run/hasfieldrun02.hs | 16 +++ ...dedrecfldsrun06.stdout => hasfieldrun02.stdout} | 0 28 files changed, 496 insertions(+), 26 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc f21526f48734b1a45eb5ccf7925376c91b1940f4 From git at git.haskell.org Sat Jan 28 21:27:06 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 28 Jan 2017 21:27:06 +0000 (UTC) Subject: [commit: ghc] wip/orf-2017: Remove Proxy# from IsLabel and add function space instance using HasField (623acf5) Message-ID: <20170128212706.B653C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/orf-2017 Link : http://ghc.haskell.org/trac/ghc/changeset/623acf55a9d2940f55ba279cbefe65bcf3f9c024/ghc >--------------------------------------------------------------- commit 623acf55a9d2940f55ba279cbefe65bcf3f9c024 Author: Adam Gundry Date: Fri Jan 27 15:09:13 2017 +0000 Remove Proxy# from IsLabel and add function space instance using HasField >--------------------------------------------------------------- 623acf55a9d2940f55ba279cbefe65bcf3f9c024 compiler/deSugar/Coverage.hs | 2 +- compiler/deSugar/DsExpr.hs | 2 +- compiler/deSugar/DsMeta.hs | 2 +- compiler/deSugar/Match.hs | 2 +- compiler/hsSyn/HsExpr.hs | 8 +-- compiler/parser/Parser.y | 2 +- compiler/rename/RnExpr.hs | 8 ++- compiler/typecheck/TcExpr.hs | 58 ++++++++++++++-------- compiler/typecheck/TcHsSyn.hs | 3 +- compiler/typecheck/TcRnTypes.hs | 2 +- libraries/base/GHC/OverloadedLabels.hs | 44 ++++++++++------ testsuite/tests/overloadedrecflds/ghci/all.T | 2 +- ...ghci01.script => duplicaterecfldsghci01.script} | 0 ...ghci01.stdout => duplicaterecfldsghci01.stdout} | 0 .../ghci/overloadedlabelsghci01.script | 7 +-- .../tests/overloadedrecflds/should_fail/all.T | 2 + .../should_fail/hasfieldfail01.stderr | 4 +- .../should_fail/overloadedlabelsfail01.hs | 5 +- .../should_fail/overloadedlabelsfail01.stderr | 29 +++++------ .../should_fail/overloadedlabelsfail02.hs | 3 ++ .../should_fail/overloadedlabelsfail02.stderr | 2 + .../should_fail/overloadedlabelsfail03.hs | 5 ++ .../should_fail/overloadedlabelsfail03.stderr | 10 ++++ .../should_run/OverloadedLabelsRun04_A.hs | 2 +- .../tests/overloadedrecflds/should_run/T12243.hs | 25 ++++++++++ .../overloadedrecflds/should_run/T12243.stdout | 2 + testsuite/tests/overloadedrecflds/should_run/all.T | 2 + .../overloadedrecflds/should_run/hasfieldrun02.hs | 6 --- .../should_run/overloadedlabelsrun01.hs | 4 +- .../should_run/overloadedlabelsrun02.hs | 4 +- .../should_run/overloadedlabelsrun03.hs | 2 +- .../should_run/overloadedrecfldsrun07.hs | 42 ++++++++++++++++ ...drun02.stdout => overloadedrecfldsrun07.stdout} | 1 + 33 files changed, 204 insertions(+), 88 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 623acf55a9d2940f55ba279cbefe65bcf3f9c024 From git at git.haskell.org Sat Jan 28 22:44:18 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 28 Jan 2017 22:44:18 +0000 (UTC) Subject: [commit: ghc] master: Convert pprTrace in isPredTy to a WARN (bc42e2b) Message-ID: <20170128224418.9E75D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/bc42e2b03a87e3f6c0d24584382f281c6580801b/ghc >--------------------------------------------------------------- commit bc42e2b03a87e3f6c0d24584382f281c6580801b Author: Ryan Scott Date: Sat Jan 28 16:54:11 2017 -0500 Convert pprTrace in isPredTy to a WARN Summary: There was a `pprTrace` in `isPredTy` that could fire under certain scenarios, causing normal GHC users to see debugging output. This turns it into a less chatty `WARN`, and expounds on the comment below it to add the scenario in #13187 which triggered the `pprTrace`. Reviewers: goldfire, austin, bgamari Reviewed By: goldfire, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D3033 GHC Trac Issues: #13187 >--------------------------------------------------------------- bc42e2b03a87e3f6c0d24584382f281c6580801b compiler/types/Type.hs | 24 +++++++++++++++++++----- 1 file changed, 19 insertions(+), 5 deletions(-) diff --git a/compiler/types/Type.hs b/compiler/types/Type.hs index b611786..ad1b11f 100644 --- a/compiler/types/Type.hs +++ b/compiler/types/Type.hs @@ -1525,12 +1525,26 @@ isPredTy ty = go ty [] go_k k [] = isConstraintKind k go_k k (arg:args) = case piResultTy_maybe k arg of Just k' -> go_k k' args - Nothing -> pprTrace "isPredTy" (ppr ty) + Nothing -> WARN( True, text "isPredTy" <+> ppr ty ) False - -- This last case should not happen; but it does if we - -- we call isPredTy during kind checking, especially if - -- there is actually a kind error. Example that showed - -- this up: polykinds/T11399 + -- This last case shouldn't happen under most circumstances. It can + -- occur if we call isPredTy during kind checking, especially if one + -- of the following happens: + -- + -- 1. There is actually a kind error. Example in which this showed up: + -- polykinds/T11399 + -- 2. A type constructor application appears to be oversaturated. An + -- example of this occurred in GHC Trac #13187: + -- + -- {-# LANGUAGE PolyKinds #-} + -- type Const a b = b + -- f :: Const Int (,) Bool Char -> Char + -- + -- This code is actually fine, since Const is polymorphic in its + -- return kind. It does show that isPredTy could possibly report a + -- false negative if a constraint is similarly oversaturated, but + -- it's hard to do better than isPredTy currently does without + -- zonking, so we punt on such cases for now. isClassPred, isEqPred, isNomEqPred, isIPPred :: PredType -> Bool isClassPred ty = case tyConAppTyCon_maybe ty of From git at git.haskell.org Sun Jan 29 09:52:59 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 09:52:59 +0000 (UTC) Subject: [commit: ghc] branch 'wip/erikd/heapview' created Message-ID: <20170129095259.6D0633A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/erikd/heapview Referencing: 2e4cd2ec44cc9e27506a0f3f3e9407bb217b9fdc From git at git.haskell.org Sun Jan 29 09:53:02 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 09:53:02 +0000 (UTC) Subject: [commit: ghc] wip/erikd/heapview: ghc.mk: Add heapview library (a089b38) Message-ID: <20170129095302.346C73A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/erikd/heapview Link : http://ghc.haskell.org/trac/ghc/changeset/a089b38012ad0275436f6240b31b0775d378db2d/ghc >--------------------------------------------------------------- commit a089b38012ad0275436f6240b31b0775d378db2d Author: Erik de Castro Lopo Date: Sat Jan 28 22:11:06 2017 +1100 ghc.mk: Add heapview library >--------------------------------------------------------------- a089b38012ad0275436f6240b31b0775d378db2d ghc.mk | 1 + libraries/heapview/GHC/Disassembler.hs | 5 + libraries/heapview/GHC/HeapView.hs | 238 +++++++++++++++++---------------- libraries/heapview/heapview.cabal | 19 +-- 4 files changed, 140 insertions(+), 123 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc a089b38012ad0275436f6240b31b0775d378db2d From git at git.haskell.org Sun Jan 29 09:53:05 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 09:53:05 +0000 (UTC) Subject: [commit: ghc] wip/erikd/heapview: Add tests for heapview (9d765cc) Message-ID: <20170129095305.93AC93A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/erikd/heapview Link : http://ghc.haskell.org/trac/ghc/changeset/9d765cc94fd43984933e7662a919d9a6e1de2732/ghc >--------------------------------------------------------------- commit 9d765cc94fd43984933e7662a919d9a6e1de2732 Author: Erik de Castro Lopo Date: Sat Jan 28 23:23:57 2017 +1100 Add tests for heapview >--------------------------------------------------------------- 9d765cc94fd43984933e7662a919d9a6e1de2732 libraries/{base => heapview}/tests/Makefile | 0 libraries/heapview/tests/all.T | 3 ++ libraries/heapview/tests/heapview_all.hs | 77 ++++++++++++++++++++++++++++ libraries/heapview/tests/heapview_all.stdout | 1 + 4 files changed, 81 insertions(+) diff --git a/libraries/base/tests/Makefile b/libraries/heapview/tests/Makefile similarity index 100% copy from libraries/base/tests/Makefile copy to libraries/heapview/tests/Makefile diff --git a/libraries/heapview/tests/all.T b/libraries/heapview/tests/all.T new file mode 100644 index 0000000..63b7571 --- /dev/null +++ b/libraries/heapview/tests/all.T @@ -0,0 +1,3 @@ +setTestOpts(extra_ways(['sanity'])) + +test('heapview_all', normal, compile_and_run, ['']) diff --git a/libraries/heapview/tests/heapview_all.hs b/libraries/heapview/tests/heapview_all.hs new file mode 100644 index 0000000..7e4b773 --- /dev/null +++ b/libraries/heapview/tests/heapview_all.hs @@ -0,0 +1,77 @@ +{-# LANGUAGE MagicHash, BangPatterns #-} +{-# OPTIONS_GHC -Wall #-} + +import GHC.Exts +import GHC.HeapView +import Control.DeepSeq + +import System.Environment +import System.Mem + +import Control.Monad + +main :: IO () +main = do + args <- map length `fmap` getArgs + let list2 = 4:list + (list ++ list2 ++ args) `deepseq` pure () + + let x = list ++ list2 ++ args + performGC + getClosureAssert list >>= \ cl -> + unless (name cl == ":") $ fail "Wrong name" + + getClosureAssert list2 >>= \ cl -> do + eq <- areBoxesEqual (ptrArgs cl !! 1) (asBox list) + unless eq $ fail "Doesn't reference list" + + getClosureData args >>= \ cl -> + unless (tipe (info cl) == CONSTR_0_1) $ + fail $ "Not a CONSTR_0_1" + + getClosureData x >>= \ cl -> + unless (tipe (info cl) == THUNK_2_0) $ do + fail "Not a THUNK_2_0" + + + let !(I# m) = length args + 42 + let !(I# m') = length args + 23 + let f = \ y n -> take (I# m + I# y) n ++ args + t = f m' list2 + + getClosureData f >>= \ cl -> do + unless (tipe (info cl) == FUN_1_1) $ do + fail "Not a FUN_1_1" + unless (dataArgs cl == [42]) $ do + fail "Wrong data arg" + + getClosureData t >>= \ cl -> do + unless (tipe (info cl) == THUNK) $ do + fail "Not a THUNK" + unless (dataArgs cl == [23]) $ do + fail "Wrong data arg" + + eq <- areBoxesEqual (ptrArgs cl !! 1) (asBox f) + unless eq $ fail "t doesnt reference f" + + let z = id (:) () z + z `seq` pure () + performGC + getClosureAssert z >>= \ cl -> do + eq <- areBoxesEqual (ptrArgs cl !! 1) (asBox z) + unless eq $ + fail "z doesnt reference itself" + + putStrLn "Done. No errors." + + +list :: [Int] +list = [1,2,3] + + +getClosureAssert :: a -> IO Closure +getClosureAssert x = do + cl <- getClosureData x + case cl of + ConsClosure {} -> pure cl + _ -> fail "Expected ConsClosure" diff --git a/libraries/heapview/tests/heapview_all.stdout b/libraries/heapview/tests/heapview_all.stdout new file mode 100644 index 0000000..b747b9b --- /dev/null +++ b/libraries/heapview/tests/heapview_all.stdout @@ -0,0 +1 @@ +Done. No errors. From git at git.haskell.org Sun Jan 29 09:53:08 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 09:53:08 +0000 (UTC) Subject: [commit: ghc] wip/erikd/heapview: heapview: Strip back API (05c4756) Message-ID: <20170129095308.55D553A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/erikd/heapview Link : http://ghc.haskell.org/trac/ghc/changeset/05c47562053e8ab622450a3b948394506fcbf12e/ghc >--------------------------------------------------------------- commit 05c47562053e8ab622450a3b948394506fcbf12e Author: Erik de Castro Lopo Date: Sun Jan 29 17:42:53 2017 +1100 heapview: Strip back API >--------------------------------------------------------------- 05c47562053e8ab622450a3b948394506fcbf12e libraries/heapview/GHC/AssertNF.hs | 150 -------------- libraries/heapview/GHC/Disassembler.hs | 295 ---------------------------- libraries/heapview/GHC/HeapView.hs | 346 +-------------------------------- libraries/heapview/heapview.cabal | 4 +- 4 files changed, 2 insertions(+), 793 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 05c47562053e8ab622450a3b948394506fcbf12e From git at git.haskell.org Sun Jan 29 09:53:11 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 09:53:11 +0000 (UTC) Subject: [commit: ghc] wip/erikd/heapview: heapview.cabal: Remove un-needed dependencies (09c4bb8) Message-ID: <20170129095311.16DD03A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/erikd/heapview Link : http://ghc.haskell.org/trac/ghc/changeset/09c4bb8bd311f1f853c25f62db782ded9a648fc2/ghc >--------------------------------------------------------------- commit 09c4bb8bd311f1f853c25f62db782ded9a648fc2 Author: Erik de Castro Lopo Date: Sun Jan 29 20:03:36 2017 +1100 heapview.cabal: Remove un-needed dependencies >--------------------------------------------------------------- 09c4bb8bd311f1f853c25f62db782ded9a648fc2 libraries/heapview/heapview.cabal | 5 ----- 1 file changed, 5 deletions(-) diff --git a/libraries/heapview/heapview.cabal b/libraries/heapview/heapview.cabal index 1ba938d..1e5d419 100644 --- a/libraries/heapview/heapview.cabal +++ b/libraries/heapview/heapview.cabal @@ -39,11 +39,6 @@ library build-depends: rts == 1.0.* , ghc-prim == 0.5.0.0 , base >= 4.9.0 && < 4.11 - , binary >= 0.5 && < 0.9 - , bytestring >= 0.10.6.0 - , containers >= 0.5 && < 0.6 - , deepseq >= 1.4 - , template-haskell == 2.12.* , transformers >= 0.2 && < 0.6 ghc-options: -Wall From git at git.haskell.org Sun Jan 29 09:53:15 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 09:53:15 +0000 (UTC) Subject: [commit: ghc] wip/erikd/heapview: Add RTS support for GHC.HeapView functionality (6a03eac) Message-ID: <20170129095315.43D253A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/erikd/heapview Link : http://ghc.haskell.org/trac/ghc/changeset/6a03eac3d9f8da68163cf7f07d52237e2045b17f/ghc >--------------------------------------------------------------- commit 6a03eac3d9f8da68163cf7f07d52237e2045b17f Author: Erik de Castro Lopo Date: Sat Jan 28 18:06:55 2017 +1100 Add RTS support for GHC.HeapView functionality >--------------------------------------------------------------- 6a03eac3d9f8da68163cf7f07d52237e2045b17f rts/HeapView.c | 203 +++++++++++++++++++++++++++++++++++++++++++++++++++ rts/HeapView.h | 5 ++ rts/HeapViewPrim.cmm | 53 ++++++++++++++ 3 files changed, 261 insertions(+) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 6a03eac3d9f8da68163cf7f07d52237e2045b17f From git at git.haskell.org Sun Jan 29 09:53:18 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 09:53:18 +0000 (UTC) Subject: [commit: ghc] wip/erikd/heapview: heapview: Make constructor fields strict (1594835) Message-ID: <20170129095318.074E43A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/erikd/heapview Link : http://ghc.haskell.org/trac/ghc/changeset/15948353952750beff1ba3f23487092071b422b0/ghc >--------------------------------------------------------------- commit 15948353952750beff1ba3f23487092071b422b0 Author: Erik de Castro Lopo Date: Sun Jan 29 20:47:42 2017 +1100 heapview: Make constructor fields strict >--------------------------------------------------------------- 15948353952750beff1ba3f23487092071b422b0 libraries/heapview/GHC/Exts/HeapView.hs | 178 ++++++++++++++++---------------- 1 file changed, 89 insertions(+), 89 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 15948353952750beff1ba3f23487092071b422b0 From git at git.haskell.org Sun Jan 29 09:53:20 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 09:53:20 +0000 (UTC) Subject: [commit: ghc] wip/erikd/heapview: heapview: Rename `tipe` to `cltype` (eb6cf2a) Message-ID: <20170129095320.D56A13A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/erikd/heapview Link : http://ghc.haskell.org/trac/ghc/changeset/eb6cf2a5f8119976f490a8641182bf24dd5ec837/ghc >--------------------------------------------------------------- commit eb6cf2a5f8119976f490a8641182bf24dd5ec837 Author: Erik de Castro Lopo Date: Sun Jan 29 20:22:06 2017 +1100 heapview: Rename `tipe` to `cltype` >--------------------------------------------------------------- eb6cf2a5f8119976f490a8641182bf24dd5ec837 libraries/heapview/GHC/HeapView.hs | 8 ++++---- libraries/heapview/tests/heapview_all.hs | 8 ++++---- 2 files changed, 8 insertions(+), 8 deletions(-) diff --git a/libraries/heapview/GHC/HeapView.hs b/libraries/heapview/GHC/HeapView.hs index b8ceeab..ca16852 100644 --- a/libraries/heapview/GHC/HeapView.hs +++ b/libraries/heapview/GHC/HeapView.hs @@ -115,7 +115,7 @@ asBox x = Box (unsafeCoerce# x) data StgInfoTable = StgInfoTable { ptrs :: HalfWord, nptrs :: HalfWord, - tipe :: ClosureType, + cltype :: ClosureType, srtlen :: HalfWord } deriving (Show) @@ -142,13 +142,13 @@ instance Storable StgInfoTable where $ do ptrs' <- load nptrs' <- load - tipe' <- load + cltype' <- load srtlen' <- load return StgInfoTable { ptrs = ptrs', nptrs = nptrs', - tipe = toEnum (fromIntegral (tipe'::HalfWord)), + cltype = toEnum (fromIntegral (cltype'::HalfWord)), srtlen = srtlen' } @@ -493,7 +493,7 @@ getClosureData :: a -> IO Closure getClosureData x = do (iptr, wds, ptrs) <- getClosureRaw x itbl <- peek iptr - case tipe itbl of + case cltype itbl of t | t >= CONSTR && t <= CONSTR_NOCAF -> do (pkg, modl, name) <- dataConInfoPtrToNames iptr if modl == "ByteCodeInstr" && name == "BreakInfo" diff --git a/libraries/heapview/tests/heapview_all.hs b/libraries/heapview/tests/heapview_all.hs index 7e4b773..645aa4d 100644 --- a/libraries/heapview/tests/heapview_all.hs +++ b/libraries/heapview/tests/heapview_all.hs @@ -26,11 +26,11 @@ main = do unless eq $ fail "Doesn't reference list" getClosureData args >>= \ cl -> - unless (tipe (info cl) == CONSTR_0_1) $ + unless (cltype (info cl) == CONSTR_0_1) $ fail $ "Not a CONSTR_0_1" getClosureData x >>= \ cl -> - unless (tipe (info cl) == THUNK_2_0) $ do + unless (cltype (info cl) == THUNK_2_0) $ do fail "Not a THUNK_2_0" @@ -40,13 +40,13 @@ main = do t = f m' list2 getClosureData f >>= \ cl -> do - unless (tipe (info cl) == FUN_1_1) $ do + unless (cltype (info cl) == FUN_1_1) $ do fail "Not a FUN_1_1" unless (dataArgs cl == [42]) $ do fail "Wrong data arg" getClosureData t >>= \ cl -> do - unless (tipe (info cl) == THUNK) $ do + unless (cltype (info cl) == THUNK) $ do fail "Not a THUNK" unless (dataArgs cl == [23]) $ do fail "Wrong data arg" From git at git.haskell.org Sun Jan 29 09:53:23 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 09:53:23 +0000 (UTC) Subject: [commit: ghc] wip/erikd/heapview: heapview: Clean up language pragmas (2e4cd2e) Message-ID: <20170129095323.889883A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/erikd/heapview Link : http://ghc.haskell.org/trac/ghc/changeset/2e4cd2ec44cc9e27506a0f3f3e9407bb217b9fdc/ghc >--------------------------------------------------------------- commit 2e4cd2ec44cc9e27506a0f3f3e9407bb217b9fdc Author: Erik de Castro Lopo Date: Sun Jan 29 20:50:01 2017 +1100 heapview: Clean up language pragmas >--------------------------------------------------------------- 2e4cd2ec44cc9e27506a0f3f3e9407bb217b9fdc libraries/heapview/GHC/Exts/HeapView.hs | 14 +++++++++++++- 1 file changed, 13 insertions(+), 1 deletion(-) diff --git a/libraries/heapview/GHC/Exts/HeapView.hs b/libraries/heapview/GHC/Exts/HeapView.hs index f80b848..1edd59f 100644 --- a/libraries/heapview/GHC/Exts/HeapView.hs +++ b/libraries/heapview/GHC/Exts/HeapView.hs @@ -1,4 +1,16 @@ -{-# LANGUAGE MagicHash, UnboxedTuples, CPP, ForeignFunctionInterface, GHCForeignImportPrim, UnliftedFFITypes, BangPatterns, RecordWildCards, DeriveFunctor, DeriveFoldable, DeriveTraversable, PatternGuards #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveFoldable #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE GHCForeignImportPrim #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE PatternGuards #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE UnliftedFFITypes #-} + {-| Module : GHC.HeapView Copyright : (c) 2012 Joachim Breitner From git at git.haskell.org Sun Jan 29 09:53:30 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 09:53:30 +0000 (UTC) Subject: [commit: ghc] wip/erikd/heapview: Fix deprecation warnings from containers (39c5fdc) Message-ID: <20170129095330.9089E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/erikd/heapview Link : http://ghc.haskell.org/trac/ghc/changeset/39c5fdc14218dae9e649e0d5616b8937c7b10630/ghc >--------------------------------------------------------------- commit 39c5fdc14218dae9e649e0d5616b8937c7b10630 Author: Erik de Castro Lopo Date: Sat Jan 28 16:37:53 2017 +1100 Fix deprecation warnings from containers Summary: The functions that causing warnings were deprecated in containers 0.5 and GHC is already using containers 0.5.9.1. Test Plan: validate Reviewers: rwbarton, bgamari, hsyl20, austin Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D3036 >--------------------------------------------------------------- 39c5fdc14218dae9e649e0d5616b8937c7b10630 compiler/coreSyn/TrieMap.hs | 8 ++++---- compiler/simplCore/FloatOut.hs | 4 ++-- compiler/utils/FiniteMap.hs | 2 +- compiler/utils/UniqDFM.hs | 4 ++-- compiler/utils/UniqFM.hs | 10 +++++----- 5 files changed, 14 insertions(+), 14 deletions(-) diff --git a/compiler/coreSyn/TrieMap.hs b/compiler/coreSyn/TrieMap.hs index f8546d1..4a6e245 100644 --- a/compiler/coreSyn/TrieMap.hs +++ b/compiler/coreSyn/TrieMap.hs @@ -119,7 +119,7 @@ instance TrieMap IntMap.IntMap where emptyTM = IntMap.empty lookupTM k m = IntMap.lookup k m alterTM = xtInt - foldTM k m z = IntMap.fold k z m + foldTM k m z = IntMap.foldr k z m mapTM f m = IntMap.map f m xtInt :: Int -> XT a -> IntMap.IntMap a -> IntMap.IntMap a @@ -130,7 +130,7 @@ instance Ord k => TrieMap (Map.Map k) where emptyTM = Map.empty lookupTM = Map.lookup alterTM k f m = Map.alter f k m - foldTM k m z = Map.fold k z m + foldTM k m z = Map.foldr k z m mapTM f m = Map.map f m @@ -939,8 +939,8 @@ xtTyLit l f m = StrTyLit n -> m { tlm_string = tlm_string m |> Map.alter f n } foldTyLit :: (a -> b -> b) -> TyLitMap a -> b -> b -foldTyLit l m = flip (Map.fold l) (tlm_string m) - . flip (Map.fold l) (tlm_number m) +foldTyLit l m = flip (Map.foldr l) (tlm_string m) + . flip (Map.foldr l) (tlm_number m) ------------------------------------------------- -- | @TypeMap a@ is a map from 'Type' to @a at . If you are a client, this diff --git a/compiler/simplCore/FloatOut.hs b/compiler/simplCore/FloatOut.hs index 3c220fe..475108c 100644 --- a/compiler/simplCore/FloatOut.hs +++ b/compiler/simplCore/FloatOut.hs @@ -497,10 +497,10 @@ addTopFloatPairs float_bag prs add (Rec prs1) prs2 = prs1 ++ prs2 flattenMajor :: MajorEnv -> Bag FloatBind -flattenMajor = M.fold (unionBags . flattenMinor) emptyBag +flattenMajor = M.foldr (unionBags . flattenMinor) emptyBag flattenMinor :: MinorEnv -> Bag FloatBind -flattenMinor = M.fold unionBags emptyBag +flattenMinor = M.foldr unionBags emptyBag emptyFloats :: FloatBinds emptyFloats = FB emptyBag M.empty diff --git a/compiler/utils/FiniteMap.hs b/compiler/utils/FiniteMap.hs index dccfca1..cb6e557 100644 --- a/compiler/utils/FiniteMap.hs +++ b/compiler/utils/FiniteMap.hs @@ -24,6 +24,6 @@ deleteList :: Ord key => [key] -> Map key elt -> Map key elt deleteList ks m = foldl (flip Map.delete) m ks foldRight :: (elt -> a -> a) -> a -> Map key elt -> a -foldRight = Map.fold +foldRight = Map.foldr foldRightWithKey :: (key -> elt -> a -> a) -> a -> Map key elt -> a foldRightWithKey = Map.foldrWithKey diff --git a/compiler/utils/UniqDFM.hs b/compiler/utils/UniqDFM.hs index bbf6bb0..10e8aa9 100644 --- a/compiler/utils/UniqDFM.hs +++ b/compiler/utils/UniqDFM.hs @@ -360,10 +360,10 @@ mapUDFM :: (elt1 -> elt2) -> UniqDFM elt1 -> UniqDFM elt2 mapUDFM f (UDFM m i) = UDFM (M.map (fmap f) m) i anyUDFM :: (elt -> Bool) -> UniqDFM elt -> Bool -anyUDFM p (UDFM m _i) = M.fold ((||) . p . taggedFst) False m +anyUDFM p (UDFM m _i) = M.foldr ((||) . p . taggedFst) False m allUDFM :: (elt -> Bool) -> UniqDFM elt -> Bool -allUDFM p (UDFM m _i) = M.fold ((&&) . p . taggedFst) True m +allUDFM p (UDFM m _i) = M.foldr ((&&) . p . taggedFst) True m instance Monoid (UniqDFM a) where mempty = emptyUDFM diff --git a/compiler/utils/UniqFM.hs b/compiler/utils/UniqFM.hs index be5da83..38d9434 100644 --- a/compiler/utils/UniqFM.hs +++ b/compiler/utils/UniqFM.hs @@ -237,7 +237,7 @@ disjointUFM :: UniqFM elt1 -> UniqFM elt2 -> Bool disjointUFM (UFM x) (UFM y) = M.null (M.intersection x y) foldUFM :: (elt -> a -> a) -> a -> UniqFM elt -> a -foldUFM k z (UFM m) = M.fold k z m +foldUFM k z (UFM m) = M.foldr k z m mapUFM :: (elt1 -> elt2) -> UniqFM elt1 -> UniqFM elt2 mapUFM f (UFM m) = UFM (M.map f m) @@ -285,10 +285,10 @@ ufmToSet_Directly :: UniqFM elt -> S.IntSet ufmToSet_Directly (UFM m) = M.keysSet m anyUFM :: (elt -> Bool) -> UniqFM elt -> Bool -anyUFM p (UFM m) = M.fold ((||) . p) False m +anyUFM p (UFM m) = M.foldr ((||) . p) False m allUFM :: (elt -> Bool) -> UniqFM elt -> Bool -allUFM p (UFM m) = M.fold ((&&) . p) True m +allUFM p (UFM m) = M.foldr ((&&) . p) True m seqEltsUFM :: ([elt] -> ()) -> UniqFM elt -> () seqEltsUFM seqList = seqList . nonDetEltsUFM @@ -312,13 +312,13 @@ nonDetKeysUFM (UFM m) = map getUnique $ M.keys m -- If you use this please provide a justification why it doesn't introduce -- nondeterminism. nonDetFoldUFM :: (elt -> a -> a) -> a -> UniqFM elt -> a -nonDetFoldUFM k z (UFM m) = M.fold k z m +nonDetFoldUFM k z (UFM m) = M.foldr k z m -- See Note [Deterministic UniqFM] to learn about nondeterminism. -- If you use this please provide a justification why it doesn't introduce -- nondeterminism. nonDetFoldUFM_Directly:: (Unique -> elt -> a -> a) -> a -> UniqFM elt -> a -nonDetFoldUFM_Directly k z (UFM m) = M.foldWithKey (k . getUnique) z m +nonDetFoldUFM_Directly k z (UFM m) = M.foldrWithKey (k . getUnique) z m -- See Note [Deterministic UniqFM] to learn about nondeterminism. -- If you use this please provide a justification why it doesn't introduce From git at git.haskell.org Sun Jan 29 09:53:27 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 09:53:27 +0000 (UTC) Subject: [commit: ghc] wip/erikd/heapview: Add the heapview library (f7d3d6a) Message-ID: <20170129095327.CFD5C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/erikd/heapview Link : http://ghc.haskell.org/trac/ghc/changeset/f7d3d6a88cfe9f57ef2771648df8593422a336ca/ghc >--------------------------------------------------------------- commit f7d3d6a88cfe9f57ef2771648df8593422a336ca Author: Erik de Castro Lopo Date: Sat Jan 28 18:48:08 2017 +1100 Add the heapview library This library allows the GHC heap to be inspected from haskell code. >--------------------------------------------------------------- f7d3d6a88cfe9f57ef2771648df8593422a336ca libraries/{compact => heapview}/.gitignore | 0 libraries/heapview/GHC/AssertNF.hs | 150 +++ libraries/heapview/GHC/Disassembler.hs | 290 ++++++ libraries/heapview/GHC/HeapView.hs | 1016 ++++++++++++++++++++ libraries/heapview/GHC/HeapView/Debug.hs | 68 ++ .../cabal08/p2 => libraries/heapview}/LICENSE | 4 +- libraries/{compact => heapview}/Setup.hs | 0 libraries/heapview/heapview.cabal | 53 + 8 files changed, 1579 insertions(+), 2 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc f7d3d6a88cfe9f57ef2771648df8593422a336ca From git at git.haskell.org Sun Jan 29 09:53:33 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 09:53:33 +0000 (UTC) Subject: [commit: ghc] wip/erikd/heapview: heapview: Move HeadView.hs to GHC.Exts (01c4b25) Message-ID: <20170129095333.EDCD03A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/erikd/heapview Link : http://ghc.haskell.org/trac/ghc/changeset/01c4b2566ae24b53cd84f5c29b83895a8f8b30c1/ghc >--------------------------------------------------------------- commit 01c4b2566ae24b53cd84f5c29b83895a8f8b30c1 Author: Erik de Castro Lopo Date: Sun Jan 29 20:36:54 2017 +1100 heapview: Move HeadView.hs to GHC.Exts >--------------------------------------------------------------- 01c4b2566ae24b53cd84f5c29b83895a8f8b30c1 libraries/heapview/GHC/{ => Exts}/HeapView.hs | 2 +- libraries/heapview/GHC/{ => Exts}/HeapView/Debug.hs | 4 ++-- libraries/heapview/heapview.cabal | 4 ++-- libraries/heapview/tests/heapview_all.hs | 2 +- 4 files changed, 6 insertions(+), 6 deletions(-) diff --git a/libraries/heapview/GHC/HeapView.hs b/libraries/heapview/GHC/Exts/HeapView.hs similarity index 99% rename from libraries/heapview/GHC/HeapView.hs rename to libraries/heapview/GHC/Exts/HeapView.hs index ca16852..92f61e0 100644 --- a/libraries/heapview/GHC/HeapView.hs +++ b/libraries/heapview/GHC/Exts/HeapView.hs @@ -10,7 +10,7 @@ values, i.e. to investigate sharing and lazy evaluation. -} -module GHC.HeapView ( +module GHC.Exts.HeapView ( -- * Heap data types GenClosure(..), Closure, diff --git a/libraries/heapview/GHC/HeapView/Debug.hs b/libraries/heapview/GHC/Exts/HeapView/Debug.hs similarity index 97% rename from libraries/heapview/GHC/HeapView/Debug.hs rename to libraries/heapview/GHC/Exts/HeapView/Debug.hs index fc31d39..4821a21 100644 --- a/libraries/heapview/GHC/HeapView/Debug.hs +++ b/libraries/heapview/GHC/Exts/HeapView/Debug.hs @@ -1,7 +1,7 @@ -- | Utilities to debug "GHC.HeapView". -module GHC.HeapView.Debug where +module GHC.Exts.HeapView.Debug where -import GHC.HeapView +import GHC.Exts.HeapView import Text.Printf import System.IO import Control.Monad diff --git a/libraries/heapview/heapview.cabal b/libraries/heapview/heapview.cabal index 1e5d419..73dbd41 100644 --- a/libraries/heapview/heapview.cabal +++ b/libraries/heapview/heapview.cabal @@ -43,5 +43,5 @@ library ghc-options: -Wall - exposed-modules: GHC.HeapView - GHC.HeapView.Debug + exposed-modules: GHC.Exts.HeapView + GHC.Exts.HeapView.Debug diff --git a/libraries/heapview/tests/heapview_all.hs b/libraries/heapview/tests/heapview_all.hs index 645aa4d..962cb7b 100644 --- a/libraries/heapview/tests/heapview_all.hs +++ b/libraries/heapview/tests/heapview_all.hs @@ -2,7 +2,7 @@ {-# OPTIONS_GHC -Wall #-} import GHC.Exts -import GHC.HeapView +import GHC.Exts.HeapView import Control.DeepSeq import System.Environment From git at git.haskell.org Sun Jan 29 19:46:20 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 19:46:20 +0000 (UTC) Subject: [commit: ghc] master: UNREG: fix "_bytes" string literal forward declaration (34a0205) Message-ID: <20170129194620.2DC823A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/34a0205587c8c6017a26ddf7023e91789da2e81b/ghc >--------------------------------------------------------------- commit 34a0205587c8c6017a26ddf7023e91789da2e81b Author: Sergei Trofimovich Date: Sun Jan 29 18:39:48 2017 +0000 UNREG: fix "_bytes" string literal forward declaration Typical UNREG build failure looks like that: ghc-unreg/includes/Stg.h:226:46: error: note: in definition of macro 'EI_' #define EI_(X) extern StgWordArray (X) GNU_ATTRIBUTE(aligned (8)) ^ | 226 | #define EI_(X) extern StgWordArray (X) GNU_ATTRIBUTE(aligned (8)) | ^ /tmp/ghc10489_0/ghc_3.hc:1754:6: error: note: previous definition of 'ghczmprim_GHCziTypes_zdtcTyCon2_bytes' was here char ghczmprim_GHCziTypes_zdtcTyCon2_bytes[] = "TyCon"; ^~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ | 1754 | char ghczmprim_GHCziTypes_zdtcTyCon2_bytes[] = "TyCon"; | ^ As we see here "_bytes" string literals are defined as 'char []' array, not 'StgWord []'. The change special-cases "_bytes" string literals to have correct declaration type. Signed-off-by: Sergei Trofimovich >--------------------------------------------------------------- 34a0205587c8c6017a26ddf7023e91789da2e81b compiler/cmm/CLabel.hs | 6 ++++++ compiler/cmm/PprC.hs | 3 ++- includes/Stg.h | 1 + 3 files changed, 9 insertions(+), 1 deletion(-) diff --git a/compiler/cmm/CLabel.hs b/compiler/cmm/CLabel.hs index ee87ef1..2f38203 100644 --- a/compiler/cmm/CLabel.hs +++ b/compiler/cmm/CLabel.hs @@ -89,6 +89,7 @@ module CLabel ( addLabelSize, foreignLabelStdcallInfo, + isBytesLabel, isForeignLabel, mkCCLabel, mkCCSLabel, @@ -573,6 +574,11 @@ addLabelSize (ForeignLabel str _ src fod) sz addLabelSize label _ = label +-- | Whether label is a top-level string literal +isBytesLabel :: CLabel -> Bool +isBytesLabel (IdLabel _ _ Bytes) = True +isBytesLabel _lbl = False + -- | Whether label is a non-haskell label (defined in C code) isForeignLabel :: CLabel -> Bool isForeignLabel (ForeignLabel _ _ _ _) = True diff --git a/compiler/cmm/PprC.hs b/compiler/cmm/PprC.hs index 6380451..811d908 100644 --- a/compiler/cmm/PprC.hs +++ b/compiler/cmm/PprC.hs @@ -1007,7 +1007,8 @@ pprExternDecl _in_srt lbl hcat [ visibility, label_type lbl, lparen, ppr lbl, text ");" ] where - label_type lbl | isForeignLabel lbl && isCFunctionLabel lbl = text "FF_" + label_type lbl | isBytesLabel lbl = text "B_" + | isForeignLabel lbl && isCFunctionLabel lbl = text "FF_" | isCFunctionLabel lbl = text "F_" | otherwise = text "I_" diff --git a/includes/Stg.h b/includes/Stg.h index f1949b1..e3de331 100644 --- a/includes/Stg.h +++ b/includes/Stg.h @@ -223,6 +223,7 @@ typedef StgInt I_; typedef StgWord StgWordArray[]; typedef StgFunPtr F_; +#define EB_(X) extern char X[] #define EI_(X) extern StgWordArray (X) GNU_ATTRIBUTE(aligned (8)) #define II_(X) static StgWordArray (X) GNU_ATTRIBUTE(aligned (8)) #define IF_(f) static StgFunPtr GNUC3_ATTRIBUTE(used) f(void) From git at git.haskell.org Sun Jan 29 20:17:43 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:17:43 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: [WIP] Coercion: Represent arrows explicitly (4206a0c) Message-ID: <20170129201743.DA0443A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/4206a0c764c8fcd7653ab7c3b281045dc0e6ceaa/ghc >--------------------------------------------------------------- commit 4206a0c764c8fcd7653ab7c3b281045dc0e6ceaa Author: Ben Gamari Date: Sat Dec 17 21:31:33 2016 -0500 [WIP] Coercion: Represent arrows explicitly **(This is still a work in progress)** This adds explicit representation of arrow types in coercions (via a `FunCo` constructor), following what is done with types. There are two reasons why we want to do this, * Function arrows are very common and therefore deserve a succinct representation * The `(->)` tycon has some magic to handle representational polymorphism; handling it explicitly makes this magic slightly simplier (although admittedly this magic may be replaced by a more principled solution in the near future) Test Plan: Validate Reviewers: goldfire, austin Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2784 >--------------------------------------------------------------- 4206a0c764c8fcd7653ab7c3b281045dc0e6ceaa compiler/coreSyn/CoreFVs.hs | 1 + compiler/coreSyn/CoreLint.hs | 33 ++++-- compiler/coreSyn/CoreSubst.hs | 4 +- compiler/coreSyn/TrieMap.hs | 6 +- compiler/iface/ToIface.hs | 4 +- compiler/prelude/TysPrim.hs | 27 ++--- compiler/specialise/Rules.hs | 7 ++ compiler/typecheck/TcCanonical.hs | 2 +- compiler/typecheck/TcTyDecls.hs | 1 + compiler/typecheck/TcType.hs | 14 ++- compiler/typecheck/TcUnify.hs | 3 + compiler/typecheck/TcValidity.hs | 1 + compiler/types/Coercion.hs | 140 +++++++++++++++++++--- compiler/types/Coercion.hs-boot | 6 +- compiler/types/FamInstEnv.hs | 1 + compiler/types/OptCoercion.hs | 15 +++ compiler/types/TyCoRep.hs | 24 +++- compiler/types/TyCon.hs | 4 +- compiler/types/Type.hs | 155 ++++++++++++++++++++----- compiler/types/Unify.hs | 15 ++- testsuite/tests/ghci/scripts/T8535.stdout | 2 +- testsuite/tests/ghci/scripts/ghci020.stdout | 2 +- testsuite/tests/ghci/should_run/T10145.stdout | 2 +- testsuite/tests/typecheck/should_compile/all.T | 1 + 24 files changed, 382 insertions(+), 88 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 4206a0c764c8fcd7653ab7c3b281045dc0e6ceaa From git at git.haskell.org Sun Jan 29 20:17:46 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:17:46 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: CoreLint: Improve debug output (16e3617) Message-ID: <20170129201746.935803A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/16e361743ecb206194784b5064d774e7c10ff9ab/ghc >--------------------------------------------------------------- commit 16e361743ecb206194784b5064d774e7c10ff9ab Author: Ben Gamari Date: Sun Jan 31 21:35:20 2016 +0100 CoreLint: Improve debug output >--------------------------------------------------------------- 16e361743ecb206194784b5064d774e7c10ff9ab compiler/coreSyn/CoreLint.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/coreSyn/CoreLint.hs b/compiler/coreSyn/CoreLint.hs index 6a3f15d..c86b6b2 100644 --- a/compiler/coreSyn/CoreLint.hs +++ b/compiler/coreSyn/CoreLint.hs @@ -878,7 +878,7 @@ lintTyKind tyvar arg_ty -- and then apply it to both boxed and unboxed types. = do { arg_kind <- lintType arg_ty ; unless (arg_kind `eqType` tyvar_kind) - (addErrL (mkKindErrMsg tyvar arg_ty $$ (text "xx" <+> ppr arg_kind))) } + (addErrL (mkKindErrMsg tyvar arg_ty $$ (text "Linted Arg kind:" <+> ppr arg_kind))) } where tyvar_kind = tyVarKind tyvar From git at git.haskell.org Sun Jan 29 20:17:57 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:17:57 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Various fixes (91e5c2f) Message-ID: <20170129201757.72CBE3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/91e5c2feeb500b241fc53e8c247d838385cb35bd/ghc >--------------------------------------------------------------- commit 91e5c2feeb500b241fc53e8c247d838385cb35bd Author: Ben Gamari Date: Fri Mar 11 19:16:55 2016 +0100 Various fixes >--------------------------------------------------------------- 91e5c2feeb500b241fc53e8c247d838385cb35bd compiler/utils/Binary.hs | 6 +++--- libraries/ghci/GHCi/TH/Binary.hs | 14 +++++++------- 2 files changed, 10 insertions(+), 10 deletions(-) diff --git a/compiler/utils/Binary.hs b/compiler/utils/Binary.hs index 081b5f9..bb9d77b 100644 --- a/compiler/utils/Binary.hs +++ b/compiler/utils/Binary.hs @@ -79,7 +79,7 @@ import Data.Time #if MIN_VERSION_base(4,9,0) import Type.Reflection import Type.Reflection.Unsafe -import GHC.Exts ( TYPE, Levity(..) ) +import Data.Kind (Type) #else import Data.Typeable #endif @@ -597,7 +597,7 @@ getTypeRepX bh = do case tag of 0 -> do con <- get bh TypeRepX rep_k <- getTypeRepX bh - Just HRefl <- pure $ eqTypeRep rep_k (typeRep :: TypeRep (TYPE 'Lifted)) + Just HRefl <- pure $ eqTypeRep rep_k (typeRep :: TypeRep Type) pure $ TypeRepX $ mkTrCon con rep_k 1 -> do TypeRepX f <- getTypeRepX bh TypeRepX x <- getTypeRepX bh @@ -611,7 +611,7 @@ instance Typeable a => Binary (TypeRep (a :: k)) where put_ = putTypeRep get bh = do TypeRepX rep <- getTypeRepX bh - case rep `eqTypeRep` typeRep of + case rep `eqTypeRep` (typeRep :: TypeRep a) of Just HRefl -> pure rep Nothing -> fail "Binary: Type mismatch" diff --git a/libraries/ghci/GHCi/TH/Binary.hs b/libraries/ghci/GHCi/TH/Binary.hs index 7870c74..9743bfe 100644 --- a/libraries/ghci/GHCi/TH/Binary.hs +++ b/libraries/ghci/GHCi/TH/Binary.hs @@ -14,10 +14,10 @@ import qualified Data.ByteString as B import Control.Monad (when) import Type.Reflection import Type.Reflection.Unsafe +import Data.Kind (Type) #else import Data.Typeable #endif -import GHC.Exts (TYPE, Levity(..)) import GHC.Serialized import qualified Language.Haskell.TH as TH import qualified Language.Haskell.TH.Syntax as TH @@ -99,11 +99,11 @@ getTypeRepX = do tag <- get :: Get Word8 case tag of 0 -> do con <- get :: Get TyCon - TypeRep rep_k <- getTypeRepX - Just HRefl <- pure $ eqTypeRep rep_k (typeRep :: TypeRep (TYPE 'Lifted)) + TypeRepX rep_k <- getTypeRepX + Just HRefl <- pure $ eqTypeRep rep_k (typeRep :: TypeRep Type) pure $ TypeRepX $ mkTrCon con rep_k - 1 -> do TypeRep f <- getTypeRepX - TypeRep x <- getTypeRepX + 1 -> do TypeRepX f <- getTypeRepX + TypeRepX x <- getTypeRepX case typeRepKind f of TRFun arg _ -> do Just HRefl <- pure $ eqTypeRep arg x @@ -114,13 +114,13 @@ instance Typeable a => Binary (TypeRep (a :: k)) where put = putTypeRep get = do TypeRepX rep <- getTypeRepX - case rep `eqTypeRep` typeRef of + case rep `eqTypeRep` (typeRep :: TypeRep a) of Just HRefl -> pure rep Nothing -> fail "Binary: Type mismatch" instance Binary TypeRepX where put (TypeRepX rep) = putTypeRep rep - get = getTypeRep + get = getTypeRepX #else instance Binary TyCon where put tc = put (tyConPackage tc) >> put (tyConModule tc) >> put (tyConName tc) From git at git.haskell.org Sun Jan 29 20:17:54 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:17:54 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Add quick compatibility note (d78b3fd) Message-ID: <20170129201754.BC28B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/d78b3fdddc868a11a5992a88f10a3a4f5643078d/ghc >--------------------------------------------------------------- commit d78b3fdddc868a11a5992a88f10a3a4f5643078d Author: Ben Gamari Date: Fri Mar 11 17:32:13 2016 +0100 Add quick compatibility note >--------------------------------------------------------------- d78b3fdddc868a11a5992a88f10a3a4f5643078d libraries/base/Data/Typeable.hs | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/libraries/base/Data/Typeable.hs b/libraries/base/Data/Typeable.hs index f33ac48..486c5b8 100644 --- a/libraries/base/Data/Typeable.hs +++ b/libraries/base/Data/Typeable.hs @@ -28,6 +28,11 @@ -- -- == Compatibility Notes -- +-- Since GHC 8.2, GHC has supported type-indexed type representations. +-- "Data.Typeable" provides type representations which are qualified over this +-- index, providing an interface very similar to the "Typeable" notion seen in +-- previous releases. For the type-indexed interface, see "Data.Reflection". +-- -- Since GHC 7.8, 'Typeable' is poly-kinded. The changes required for this might -- break some old programs involving 'Typeable'. More details on this, including -- how to fix your code, can be found on the From git at git.haskell.org Sun Jan 29 20:17:49 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:17:49 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: TcSMonad: Introduce tcLookupId (5c522f9) Message-ID: <20170129201749.476C13A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/5c522f95501a4cbbac6e4417c19a362da6e65a0e/ghc >--------------------------------------------------------------- commit 5c522f95501a4cbbac6e4417c19a362da6e65a0e Author: Ben Gamari Date: Sun Jan 31 17:42:57 2016 +0100 TcSMonad: Introduce tcLookupId >--------------------------------------------------------------- 5c522f95501a4cbbac6e4417c19a362da6e65a0e compiler/typecheck/TcSMonad.hs | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/compiler/typecheck/TcSMonad.hs b/compiler/typecheck/TcSMonad.hs index d80fea1..13c3dc1 100644 --- a/compiler/typecheck/TcSMonad.hs +++ b/compiler/typecheck/TcSMonad.hs @@ -43,7 +43,7 @@ module TcSMonad ( getTopEnv, getGblEnv, getLclEnv, getTcEvBindsVar, getTcLevel, getTcEvBindsAndTCVs, getTcEvBindsMap, - tcLookupClass, + tcLookupClass, tcLookupId, -- Inerts InertSet(..), InertCans(..), @@ -125,7 +125,7 @@ import FamInstEnv import qualified TcRnMonad as TcM import qualified TcMType as TcM import qualified TcEnv as TcM - ( checkWellStaged, topIdLvl, tcGetDefaultTys, tcLookupClass ) + ( checkWellStaged, topIdLvl, tcGetDefaultTys, tcLookupClass, tcLookupId ) import PrelNames( heqTyConKey, eqTyConKey ) import Kind import TcType @@ -2612,6 +2612,9 @@ getLclEnv = wrapTcS $ TcM.getLclEnv tcLookupClass :: Name -> TcS Class tcLookupClass c = wrapTcS $ TcM.tcLookupClass c +tcLookupId :: Name -> TcS Id +tcLookupId n = wrapTcS $ TcM.tcLookupId n + -- Setting names as used (used in the deriving of Coercible evidence) -- Too hackish to expose it to TcS? In that case somehow extract the used -- constructors from the result of solveInteract From git at git.haskell.org Sun Jan 29 20:17:52 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:17:52 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Fix rebase (b3ffe51) Message-ID: <20170129201752.095433A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/b3ffe518f2ceb4fe2ffdfcc582d77d8877e7896a/ghc >--------------------------------------------------------------- commit b3ffe518f2ceb4fe2ffdfcc582d77d8877e7896a Author: Ben Gamari Date: Fri Mar 11 17:23:30 2016 +0100 Fix rebase >--------------------------------------------------------------- b3ffe518f2ceb4fe2ffdfcc582d77d8877e7896a compiler/prelude/PrelNames.hs | 38 +++++++++++++-------------- compiler/typecheck/TcInteract.hs | 14 +++++----- libraries/base/Data/Typeable/Internal.hs | 44 ++++++++++++++++---------------- 3 files changed, 48 insertions(+), 48 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc b3ffe518f2ceb4fe2ffdfcc582d77d8877e7896a From git at git.haskell.org Sun Jan 29 20:18:00 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:18:00 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Fix serialization (69ddbb9) Message-ID: <20170129201800.27DC23A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/69ddbb911cb0eeee2823b80b2853a95613bbb035/ghc >--------------------------------------------------------------- commit 69ddbb911cb0eeee2823b80b2853a95613bbb035 Author: Ben Gamari Date: Fri Mar 11 19:23:16 2016 +0100 Fix serialization >--------------------------------------------------------------- 69ddbb911cb0eeee2823b80b2853a95613bbb035 compiler/utils/Binary.hs | 12 +++++++----- libraries/ghci/GHCi/TH/Binary.hs | 14 ++++++++------ 2 files changed, 15 insertions(+), 11 deletions(-) diff --git a/compiler/utils/Binary.hs b/compiler/utils/Binary.hs index bb9d77b..a0b002e 100644 --- a/compiler/utils/Binary.hs +++ b/compiler/utils/Binary.hs @@ -597,14 +597,16 @@ getTypeRepX bh = do case tag of 0 -> do con <- get bh TypeRepX rep_k <- getTypeRepX bh - Just HRefl <- pure $ eqTypeRep rep_k (typeRep :: TypeRep Type) - pure $ TypeRepX $ mkTrCon con rep_k + case rep_k `eqTypeRep` (typeRep :: TypeRep Type) of + Just HRefl -> pure $ TypeRepX $ mkTrCon con rep_k + Nothing -> fail "getTypeRepX: Kind mismatch" + 1 -> do TypeRepX f <- getTypeRepX bh TypeRepX x <- getTypeRepX bh case typeRepKind f of - TRFun arg _ -> do - Just HRefl <- pure $ eqTypeRep arg x - pure $ TypeRepX $ mkTrApp f x + TRFun arg _ | Just HRefl <- arg `eqTypeRep` x -> + pure $ TypeRepX $ mkTrApp f x + _ -> fail "getTypeRepX: Kind mismatch" _ -> fail "Binary: Invalid TypeRepX" instance Typeable a => Binary (TypeRep (a :: k)) where diff --git a/libraries/ghci/GHCi/TH/Binary.hs b/libraries/ghci/GHCi/TH/Binary.hs index 9743bfe..73ff12e 100644 --- a/libraries/ghci/GHCi/TH/Binary.hs +++ b/libraries/ghci/GHCi/TH/Binary.hs @@ -100,15 +100,17 @@ getTypeRepX = do case tag of 0 -> do con <- get :: Get TyCon TypeRepX rep_k <- getTypeRepX - Just HRefl <- pure $ eqTypeRep rep_k (typeRep :: TypeRep Type) - pure $ TypeRepX $ mkTrCon con rep_k + case rep_k `eqTypeRep` (typeRep :: TypeRep Type) of + Just HRefl -> pure $ TypeRepX $ mkTrCon con rep_k + Nothing -> fail "getTypeRepX: Kind mismatch" + 1 -> do TypeRepX f <- getTypeRepX TypeRepX x <- getTypeRepX case typeRepKind f of - TRFun arg _ -> do - Just HRefl <- pure $ eqTypeRep arg x - pure $ TypeRepX $ mkTrApp f x - _ -> fail "Binary: Invalid TTypeRep" + TRFun arg _ | Just HRefl <- arg `eqTypeRep` x -> + pure $ TypeRepX $ mkTrApp f x + _ -> fail "getTypeRepX: Kind mismatch" + _ -> fail "getTypeRepX: Invalid TypeRepX" instance Typeable a => Binary (TypeRep (a :: k)) where put = putTypeRep From git at git.haskell.org Sun Jan 29 20:18:02 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:18:02 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Fix warnings (473288e) Message-ID: <20170129201802.DA3FF3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/473288ec7d035fddcf11b9382868e7ee81b6efbe/ghc >--------------------------------------------------------------- commit 473288ec7d035fddcf11b9382868e7ee81b6efbe Author: Ben Gamari Date: Fri Mar 11 17:51:26 2016 +0100 Fix warnings >--------------------------------------------------------------- 473288ec7d035fddcf11b9382868e7ee81b6efbe libraries/base/Data/Typeable/Internal.hs | 17 ++++++++++++----- libraries/ghc-boot/GHC/Serialized.hs | 1 - 2 files changed, 12 insertions(+), 6 deletions(-) diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs index c72a6f6..fc425a0 100644 --- a/libraries/base/Data/Typeable/Internal.hs +++ b/libraries/base/Data/Typeable/Internal.hs @@ -68,7 +68,7 @@ module Data.Typeable.Internal ( -- * Construction -- | These are for internal use only - mkTrCon, mkTrApp, mkTyCon, + mkTrCon, mkTrApp, mkTyCon, mkTyCon#, typeSymbolTypeRep, typeNatTypeRep, -- * Representations for primitive types @@ -223,6 +223,7 @@ mkTrCon tc kind = TrTyCon fpr tc kind fpr = fingerprintFingerprints [fpr_tc, fpr_k] -- | Construct a representation for a type application. +-- TODO: Is this necessary? mkTrApp :: forall k1 k2 (a :: k1 -> k2) (b :: k1). TypeRep (a :: k1 -> k2) -> TypeRep (b :: k1) @@ -253,7 +254,7 @@ pattern TRCon con <- TrTyCon _ con _ -- | Splits a type application. splitApp :: TypeRep a -> Maybe (AppResult a) -splitApp (TrTyCon _ a _) = Nothing +splitApp (TrTyCon _ _ _) = Nothing splitApp (TrApp _ f x) = Just $ App f x ----------------- Observation --------------------- @@ -262,7 +263,9 @@ typeRepKind :: forall k (a :: k). TypeRep a -> TypeRep k typeRepKind (TrTyCon _ _ k) = k typeRepKind (TrApp _ f _) = case typeRepKind f of - TRFun arg res -> res + TRFun _arg res -> res + -- TODO: why is this case needed? + _ -> error "typeRepKind: impossible" -- | Observe the type constructor of a quantified type representation. typeRepXTyCon :: TypeRepX -> TyCon @@ -320,14 +323,17 @@ typeRepXFingerprint (TypeRepX t) = typeRepFingerprint t -- | @since 2.01 instance Show (TypeRep a) where - showsPrec p (TrTyCon _ tycon _) = shows tycon - showsPrec p (TrApp _ f x) = shows f . showString " " . shows x + showsPrec p (TrTyCon _ tycon _) = showsPrec p tycon + showsPrec p (TrApp _ f x) = showsPrec p f . showString " " . showsPrec p x + -- TODO: Reconsider precedence -- | @since 4.10.0.0 instance Show TypeRepX where showsPrec p (TypeRepX ty) = showsPrec p ty -- Some (Show.TypeRepX) helpers: +{- +-- FIXME: Handle tuples, etc. showArgs :: Show a => ShowS -> [a] -> ShowS showArgs _ [] = id showArgs _ [a] = showsPrec 10 a @@ -337,6 +343,7 @@ showTuple :: [TypeRepX] -> ShowS showTuple args = showChar '(' . showArgs (showChar ',') args . showChar ')' +-} -- | Helper to fully evaluate 'TypeRep' for use as @NFData(rnf)@ implementation -- diff --git a/libraries/ghc-boot/GHC/Serialized.hs b/libraries/ghc-boot/GHC/Serialized.hs index 7f86df9..8653049 100644 --- a/libraries/ghc-boot/GHC/Serialized.hs +++ b/libraries/ghc-boot/GHC/Serialized.hs @@ -22,7 +22,6 @@ module GHC.Serialized ( import Data.Bits import Data.Word ( Word8 ) import Data.Data -import Data.Typeable -- | Represents a serialized value of a particular type. Attempts can be made to deserialize it at certain types From git at git.haskell.org Sun Jan 29 20:18:05 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:18:05 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Implement Data.Typeable.funResultTy (ebde9e4) Message-ID: <20170129201805.90AB43A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/ebde9e405701878733d8d32436762fc446b594b6/ghc >--------------------------------------------------------------- commit ebde9e405701878733d8d32436762fc446b594b6 Author: Ben Gamari Date: Tue Mar 15 16:21:58 2016 +0100 Implement Data.Typeable.funResultTy >--------------------------------------------------------------- ebde9e405701878733d8d32436762fc446b594b6 libraries/base/Data/Typeable.hs | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/libraries/base/Data/Typeable.hs b/libraries/base/Data/Typeable.hs index 486c5b8..7718cf3 100644 --- a/libraries/base/Data/Typeable.hs +++ b/libraries/base/Data/Typeable.hs @@ -69,6 +69,9 @@ module Data.Typeable , rnfTypeRep , showsTypeRep + -- * Observing type representations + , funResultTy + -- * Type constructors , I.TyCon -- abstract, instance of: Eq, Show, Typeable -- For now don't export Module to avoid name clashes @@ -147,6 +150,18 @@ gcast2 x = fmap (\Refl -> x) (eqT :: Maybe (t :~: t')) typeRepTyCon :: TypeRep -> TyCon typeRepTyCon = I.typeRepXTyCon +-- | Applies a type to a function type. Returns: @Just u@ if the first argument +-- represents a function of type @t -> u@ and the second argument represents a +-- function of type @t at . Otherwise, returns @Nothing at . +funResultTy :: TypeRep -> TypeRep -> Maybe TypeRep +funResultTy (I.TypeRepX f) (I.TypeRepX x) + | Just HRefl <- (I.typeRep :: I.TypeRep Type) `I.eqTypeRep` I.typeRepKind f + , I.TRFun arg res <- f + , Just HRefl <- arg `I.eqTypeRep` x + = Just (I.TypeRepX res) + | otherwise + = Nothing + -- | Force a 'TypeRep' to normal form. rnfTypeRep :: TypeRep -> () rnfTypeRep = I.rnfTypeRepX From git at git.haskell.org Sun Jan 29 20:18:09 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:18:09 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Start implementing library side of TTypeable (0ac9466) Message-ID: <20170129201809.063C03A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/0ac9466dc8429b995f1cf6e7fe27c2ade08bd194/ghc >--------------------------------------------------------------- commit 0ac9466dc8429b995f1cf6e7fe27c2ade08bd194 Author: Ben Gamari Date: Sat Jan 30 00:04:54 2016 +0100 Start implementing library side of TTypeable >--------------------------------------------------------------- 0ac9466dc8429b995f1cf6e7fe27c2ade08bd194 compiler/deSugar/DsBinds.hs | 79 +++-- compiler/prelude/PrelNames.hs | 72 +++-- compiler/typecheck/TcEvidence.hs | 20 +- compiler/typecheck/TcHsSyn.hs | 8 +- compiler/typecheck/TcInteract.hs | 65 +++- compiler/utils/Binary.hs | 55 +++- libraries/base/Data/Dynamic.hs | 49 +-- libraries/base/Data/Type/Equality.hs | 6 + libraries/base/Data/Typeable.hs | 191 ++++++++---- libraries/base/Data/Typeable/Internal.hs | 509 +++++++++++++++++-------------- libraries/base/GHC/Conc/Sync.hs | 4 - libraries/base/GHC/Show.hs | 2 +- libraries/base/Type/Reflection.hs | 43 +++ libraries/base/Type/Reflection/Unsafe.hs | 20 ++ libraries/base/base.cabal | 4 +- libraries/binary | 2 +- libraries/bytestring | 2 +- libraries/dph | 2 +- libraries/ghc-boot/GHC/Serialized.hs | 16 +- libraries/ghc-prim/GHC/Types.hs | 15 +- libraries/ghci/GHCi/TH/Binary.hs | 57 ++++ libraries/pretty | 2 +- nofib | 2 +- 23 files changed, 801 insertions(+), 424 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 0ac9466dc8429b995f1cf6e7fe27c2ade08bd194 From git at git.haskell.org Sun Jan 29 20:18:11 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:18:11 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Binary: More explicit pattern matching (74b9694) Message-ID: <20170129201811.B41973A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/74b9694219324a4ad9ffc1c5ef006a643e250774/ghc >--------------------------------------------------------------- commit 74b9694219324a4ad9ffc1c5ef006a643e250774 Author: Ben Gamari Date: Wed Mar 16 09:40:54 2016 +0100 Binary: More explicit pattern matching >--------------------------------------------------------------- 74b9694219324a4ad9ffc1c5ef006a643e250774 compiler/utils/Binary.hs | 9 ++++++--- libraries/ghci/GHCi/TH/Binary.hs | 9 ++++++--- 2 files changed, 12 insertions(+), 6 deletions(-) diff --git a/compiler/utils/Binary.hs b/compiler/utils/Binary.hs index a0b002e..e9bac4c 100644 --- a/compiler/utils/Binary.hs +++ b/compiler/utils/Binary.hs @@ -604,9 +604,12 @@ getTypeRepX bh = do 1 -> do TypeRepX f <- getTypeRepX bh TypeRepX x <- getTypeRepX bh case typeRepKind f of - TRFun arg _ | Just HRefl <- arg `eqTypeRep` x -> - pure $ TypeRepX $ mkTrApp f x - _ -> fail "getTypeRepX: Kind mismatch" + TRFun arg _ -> + case arg `eqTypeRep` x of + Just HRefl -> + pure $ TypeRepX $ mkTrApp f x + _ -> fail "getTypeRepX: Kind mismatch" + _ -> fail "getTypeRepX: Applied non-arrow type" _ -> fail "Binary: Invalid TypeRepX" instance Typeable a => Binary (TypeRep (a :: k)) where diff --git a/libraries/ghci/GHCi/TH/Binary.hs b/libraries/ghci/GHCi/TH/Binary.hs index 73ff12e..9def3c0 100644 --- a/libraries/ghci/GHCi/TH/Binary.hs +++ b/libraries/ghci/GHCi/TH/Binary.hs @@ -107,9 +107,12 @@ getTypeRepX = do 1 -> do TypeRepX f <- getTypeRepX TypeRepX x <- getTypeRepX case typeRepKind f of - TRFun arg _ | Just HRefl <- arg `eqTypeRep` x -> - pure $ TypeRepX $ mkTrApp f x - _ -> fail "getTypeRepX: Kind mismatch" + TRFun arg _ -> + case arg `eqTypeRep` x of + Just HRefl -> + pure $ TypeRepX $ mkTrApp f x + _ -> fail "getTypeRepX: Kind mismatch" + _ -> fail "getTypeRepX: Applied non-arrow type" _ -> fail "getTypeRepX: Invalid TypeRepX" instance Typeable a => Binary (TypeRep (a :: k)) where From git at git.haskell.org Sun Jan 29 20:18:14 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:18:14 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: More serialization (1d16eb5) Message-ID: <20170129201814.760CE3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/1d16eb5925d8d5ca23066f2e2373d8581d268628/ghc >--------------------------------------------------------------- commit 1d16eb5925d8d5ca23066f2e2373d8581d268628 Author: Ben Gamari Date: Wed Mar 16 10:33:37 2016 +0100 More serialization >--------------------------------------------------------------- 1d16eb5925d8d5ca23066f2e2373d8581d268628 compiler/utils/Binary.hs | 14 +++++++++----- libraries/base/Data/Typeable.hs | 20 +++++++++++++------- libraries/ghci/GHCi/TH/Binary.hs | 13 ++++++++----- 3 files changed, 30 insertions(+), 17 deletions(-) diff --git a/compiler/utils/Binary.hs b/compiler/utils/Binary.hs index e9bac4c..f06de81 100644 --- a/compiler/utils/Binary.hs +++ b/compiler/utils/Binary.hs @@ -590,12 +590,13 @@ putTypeRep bh (TRApp f x) = do put_ bh (1 :: Word8) putTypeRep bh f putTypeRep bh x +putTypeRep _ _ = fail "putTypeRep: Impossible" getTypeRepX :: BinHandle -> IO TypeRepX getTypeRepX bh = do tag <- get bh :: IO Word8 case tag of - 0 -> do con <- get bh + 0 -> do con <- get bh :: IO TyCon TypeRepX rep_k <- getTypeRepX bh case rep_k `eqTypeRep` (typeRep :: TypeRep Type) of Just HRefl -> pure $ TypeRepX $ mkTrCon con rep_k @@ -605,10 +606,13 @@ getTypeRepX bh = do TypeRepX x <- getTypeRepX bh case typeRepKind f of TRFun arg _ -> - case arg `eqTypeRep` x of - Just HRefl -> - pure $ TypeRepX $ mkTrApp f x - _ -> fail "getTypeRepX: Kind mismatch" + case (typeRep :: TypeRep Type) `eqTypeRep` arg of + Just HRefl -> -- FIXME: Generalize (->) + case x `eqTypeRep` arg of + Just HRefl -> + pure $ TypeRepX $ mkTrApp f x + _ -> fail "getTypeRepX: Kind mismatch" + Nothing -> fail "getTypeRepX: Arrow of non-Type argument" _ -> fail "getTypeRepX: Applied non-arrow type" _ -> fail "Binary: Invalid TypeRepX" diff --git a/libraries/base/Data/Typeable.hs b/libraries/base/Data/Typeable.hs index 7718cf3..21f93d2 100644 --- a/libraries/base/Data/Typeable.hs +++ b/libraries/base/Data/Typeable.hs @@ -154,13 +154,19 @@ typeRepTyCon = I.typeRepXTyCon -- represents a function of type @t -> u@ and the second argument represents a -- function of type @t at . Otherwise, returns @Nothing at . funResultTy :: TypeRep -> TypeRep -> Maybe TypeRep -funResultTy (I.TypeRepX f) (I.TypeRepX x) - | Just HRefl <- (I.typeRep :: I.TypeRep Type) `I.eqTypeRep` I.typeRepKind f - , I.TRFun arg res <- f - , Just HRefl <- arg `I.eqTypeRep` x - = Just (I.TypeRepX res) - | otherwise - = Nothing +{- +funResultTy (I.TypeRepX f) (I.TypeRepX x) = + case (I.typeRep :: I.TypeRep Type) `I.eqTypeRep` I.typeRepKind f of + Just HRefl -> + case f of + I.TRFun arg res -> + case arg `I.eqTypeRep` x of + Just HRefl -> Just (I.TypeRepX res) + Nothing -> Nothing + _ -> Nothing + Nothing -> Nothing +-} +funResultTy _ _ = Nothing -- | Force a 'TypeRep' to normal form. rnfTypeRep :: TypeRep -> () diff --git a/libraries/ghci/GHCi/TH/Binary.hs b/libraries/ghci/GHCi/TH/Binary.hs index 9def3c0..c714514 100644 --- a/libraries/ghci/GHCi/TH/Binary.hs +++ b/libraries/ghci/GHCi/TH/Binary.hs @@ -11,7 +11,6 @@ module GHCi.TH.Binary () where import Data.Binary import qualified Data.ByteString as B #if MIN_VERSION_base(4,9,0) -import Control.Monad (when) import Type.Reflection import Type.Reflection.Unsafe import Data.Kind (Type) @@ -93,6 +92,7 @@ putTypeRep (TRApp f x) = do put (1 :: Word8) putTypeRep f putTypeRep x +putTypeRep _ = fail "putTypeRep: Impossible" getTypeRepX :: Get TypeRepX getTypeRepX = do @@ -108,10 +108,13 @@ getTypeRepX = do TypeRepX x <- getTypeRepX case typeRepKind f of TRFun arg _ -> - case arg `eqTypeRep` x of - Just HRefl -> - pure $ TypeRepX $ mkTrApp f x - _ -> fail "getTypeRepX: Kind mismatch" + case (typeRep :: TypeRep Type) `eqTypeRep` arg of + Just HRefl -> -- FIXME: Generalize (->) + case arg `eqTypeRep` x of + Just HRefl -> + pure $ TypeRepX $ mkTrApp f x + _ -> fail "getTypeRepX: Kind mismatch" + _ -> fail "getTypeRepX: Arrow of non-Type argument" _ -> fail "getTypeRepX: Applied non-arrow type" _ -> fail "getTypeRepX: Invalid TypeRepX" From git at git.haskell.org Sun Jan 29 20:18:17 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:18:17 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Kill todo (12477d6) Message-ID: <20170129201817.27D473A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/12477d6d47e0e564404c7870218d8194d1c92bc6/ghc >--------------------------------------------------------------- commit 12477d6d47e0e564404c7870218d8194d1c92bc6 Author: Ben Gamari Date: Wed Mar 16 13:36:24 2016 +0100 Kill todo >--------------------------------------------------------------- 12477d6d47e0e564404c7870218d8194d1c92bc6 libraries/base/Data/Typeable/Internal.hs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs index 0d69f7a..11612fd 100644 --- a/libraries/base/Data/Typeable/Internal.hs +++ b/libraries/base/Data/Typeable/Internal.hs @@ -264,8 +264,7 @@ typeRepKind (TrTyCon _ _ k) = k typeRepKind (TrApp _ f _) = case typeRepKind f of TRFun _arg res -> res - -- TODO: why is this case needed? - _ -> error "typeRepKind: impossible" + _ -> error "typeRepKind: impossible" -- | Observe the type constructor of a quantified type representation. typeRepXTyCon :: TypeRepX -> TyCon From git at git.haskell.org Sun Jan 29 20:18:19 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:18:19 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Fix primitive types (57ec619) Message-ID: <20170129201819.D55713A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/57ec619e50377acbaef827325fc76403d338221c/ghc >--------------------------------------------------------------- commit 57ec619e50377acbaef827325fc76403d338221c Author: Ben Gamari Date: Wed Mar 16 19:52:17 2016 +0100 Fix primitive types >--------------------------------------------------------------- 57ec619e50377acbaef827325fc76403d338221c compiler/typecheck/TcInteract.hs | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/compiler/typecheck/TcInteract.hs b/compiler/typecheck/TcInteract.hs index 47d9f2e..ac7fed1 100644 --- a/compiler/typecheck/TcInteract.hs +++ b/compiler/typecheck/TcInteract.hs @@ -26,10 +26,10 @@ import Name import PrelNames ( knownNatClassName, knownSymbolClassName, typeableClassName, coercibleTyConKey, heqTyConKey, ipClassKey, - trTYPE'PtrRepLiftedName, trRuntimeRepName, trArrowName ) + trTYPEName, trTYPE'PtrRepLiftedName, trRuntimeRepName, trArrowName ) import TysWiredIn ( typeNatKind, typeSymbolKind, heqDataCon, coercibleDataCon, runtimeRepTy ) -import TysPrim ( eqPrimTyCon, eqReprPrimTyCon ) +import TysPrim ( eqPrimTyCon, eqReprPrimTyCon, tYPETyCon ) import Id( idType ) import CoAxiom ( TypeEqn, CoAxiom(..), CoAxBranch(..), fromBranches ) import Class @@ -2164,7 +2164,9 @@ matchTypeable clas [k,t] -- clas = Typeable | k `eqType` typeNatKind = doTyLit knownNatClassName t | k `eqType` typeSymbolKind = doTyLit knownSymbolClassName t | t `eqType` liftedTypeKind = doPrimRep trTYPE'PtrRepLiftedName t + | t `eqType` mkTyConTy tYPETyCon = doPrimRep trTYPEName t | t `eqType` runtimeRepTy = doPrimRep trRuntimeRepName t + | t `eqType` mkTyConTy funTyCon = doPrimRep trArrowName t | Just (tc, ks) <- splitTyConApp_maybe t -- See Note [Typeable (T a b c)] , onlyNamedBndrsApplied tc ks = doTyConApp clas t tc | Just (arg,ret) <- splitFunTy_maybe t = doFunTy clas t arg ret From git at git.haskell.org Sun Jan 29 20:18:22 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:18:22 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Finally serialization is both general and correct (ace8fd9) Message-ID: <20170129201822.B83003A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/ace8fd96e33983f6ddeb46084e10de3c894916c3/ghc >--------------------------------------------------------------- commit ace8fd96e33983f6ddeb46084e10de3c894916c3 Author: Ben Gamari Date: Wed Mar 16 12:16:20 2016 +0100 Finally serialization is both general and correct >--------------------------------------------------------------- ace8fd96e33983f6ddeb46084e10de3c894916c3 compiler/utils/Binary.hs | 13 +++++-------- libraries/ghci/GHCi/TH/Binary.hs | 11 ++++------- 2 files changed, 9 insertions(+), 15 deletions(-) diff --git a/compiler/utils/Binary.hs b/compiler/utils/Binary.hs index f06de81..88ea8cd 100644 --- a/compiler/utils/Binary.hs +++ b/compiler/utils/Binary.hs @@ -606,15 +606,12 @@ getTypeRepX bh = do TypeRepX x <- getTypeRepX bh case typeRepKind f of TRFun arg _ -> - case (typeRep :: TypeRep Type) `eqTypeRep` arg of - Just HRefl -> -- FIXME: Generalize (->) - case x `eqTypeRep` arg of - Just HRefl -> - pure $ TypeRepX $ mkTrApp f x - _ -> fail "getTypeRepX: Kind mismatch" - Nothing -> fail "getTypeRepX: Arrow of non-Type argument" + case arg `eqTypeRep` typeRepKind x of + Just HRefl -> + pure $ TypeRepX $ mkTrApp f x + _ -> fail "getTypeRepX: Kind mismatch" _ -> fail "getTypeRepX: Applied non-arrow type" - _ -> fail "Binary: Invalid TypeRepX" + _ -> fail "getTypeRepX: Invalid TypeRepX" instance Typeable a => Binary (TypeRep (a :: k)) where put_ = putTypeRep diff --git a/libraries/ghci/GHCi/TH/Binary.hs b/libraries/ghci/GHCi/TH/Binary.hs index c714514..5dd6fa8 100644 --- a/libraries/ghci/GHCi/TH/Binary.hs +++ b/libraries/ghci/GHCi/TH/Binary.hs @@ -108,13 +108,10 @@ getTypeRepX = do TypeRepX x <- getTypeRepX case typeRepKind f of TRFun arg _ -> - case (typeRep :: TypeRep Type) `eqTypeRep` arg of - Just HRefl -> -- FIXME: Generalize (->) - case arg `eqTypeRep` x of - Just HRefl -> - pure $ TypeRepX $ mkTrApp f x - _ -> fail "getTypeRepX: Kind mismatch" - _ -> fail "getTypeRepX: Arrow of non-Type argument" + case arg `eqTypeRep` typeRepKind x of + Just HRefl -> + pure $ TypeRepX $ mkTrApp f x + _ -> fail "getTypeRepX: Kind mismatch" _ -> fail "getTypeRepX: Applied non-arrow type" _ -> fail "getTypeRepX: Invalid TypeRepX" From git at git.haskell.org Sun Jan 29 20:18:25 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:18:25 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Break recursive loop in serialization (2671802) Message-ID: <20170129201825.73E2B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/267180280d98b8a5188c6d4b05a6597b242ca503/ghc >--------------------------------------------------------------- commit 267180280d98b8a5188c6d4b05a6597b242ca503 Author: Ben Gamari Date: Wed Mar 16 13:01:45 2016 +0100 Break recursive loop in serialization >--------------------------------------------------------------- 267180280d98b8a5188c6d4b05a6597b242ca503 compiler/utils/Binary.hs | 18 ++++++++++++++---- libraries/ghci/GHCi/TH/Binary.hs | 18 ++++++++++++++---- 2 files changed, 28 insertions(+), 8 deletions(-) diff --git a/compiler/utils/Binary.hs b/compiler/utils/Binary.hs index 88ea8cd..9f3fb8d 100644 --- a/compiler/utils/Binary.hs +++ b/compiler/utils/Binary.hs @@ -80,6 +80,7 @@ import Data.Time import Type.Reflection import Type.Reflection.Unsafe import Data.Kind (Type) +import GHC.Exts (RuntimeRep) #else import Data.Typeable #endif @@ -582,12 +583,19 @@ instance Binary TyCon where #if MIN_VERSION_base(4,9,0) putTypeRep :: BinHandle -> TypeRep a -> IO () +-- Special handling for Type and RuntimeRep due to recursive kind relations. +-- See Note [Mutually recursive representations of primitive types] +putTypeRep bh rep + | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep Type) + = put_ bh (0 :: Word8) + | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep RuntimeRep) + = put_ bh (1 :: Word8) putTypeRep bh rep@(TRCon con) = do - put_ bh (0 :: Word8) + put_ bh (2 :: Word8) put_ bh con putTypeRep bh (typeRepKind rep) putTypeRep bh (TRApp f x) = do - put_ bh (1 :: Word8) + put_ bh (3 :: Word8) putTypeRep bh f putTypeRep bh x putTypeRep _ _ = fail "putTypeRep: Impossible" @@ -596,13 +604,15 @@ getTypeRepX :: BinHandle -> IO TypeRepX getTypeRepX bh = do tag <- get bh :: IO Word8 case tag of - 0 -> do con <- get bh :: IO TyCon + 0 -> return $ TypeRepX (typeRep :: TypeRep Type) + 1 -> return $ TypeRepX (typeRep :: TypeRep RuntimeRep) + 2 -> do con <- get bh :: IO TyCon TypeRepX rep_k <- getTypeRepX bh case rep_k `eqTypeRep` (typeRep :: TypeRep Type) of Just HRefl -> pure $ TypeRepX $ mkTrCon con rep_k Nothing -> fail "getTypeRepX: Kind mismatch" - 1 -> do TypeRepX f <- getTypeRepX bh + 3 -> do TypeRepX f <- getTypeRepX bh TypeRepX x <- getTypeRepX bh case typeRepKind f of TRFun arg _ -> diff --git a/libraries/ghci/GHCi/TH/Binary.hs b/libraries/ghci/GHCi/TH/Binary.hs index 5dd6fa8..ea0809f 100644 --- a/libraries/ghci/GHCi/TH/Binary.hs +++ b/libraries/ghci/GHCi/TH/Binary.hs @@ -14,6 +14,7 @@ import qualified Data.ByteString as B import Type.Reflection import Type.Reflection.Unsafe import Data.Kind (Type) +import GHC.Exts (RuntimeRep) #else import Data.Typeable #endif @@ -84,12 +85,19 @@ instance Binary TyCon where get = mkTyCon <$> get <*> get <*> get putTypeRep :: TypeRep a -> Put +-- Special handling for Type and RuntimeRep due to recursive kind relations. +-- See Note [Mutually recursive representations of primitive types] +putTypeRep rep + | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep Type) + = put (0 :: Word8) + | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep RuntimeRep) + = put (1 :: Word8) putTypeRep rep@(TRCon con) = do - put (0 :: Word8) + put (2 :: Word8) put con putTypeRep (typeRepKind rep) putTypeRep (TRApp f x) = do - put (1 :: Word8) + put (3 :: Word8) putTypeRep f putTypeRep x putTypeRep _ = fail "putTypeRep: Impossible" @@ -98,13 +106,15 @@ getTypeRepX :: Get TypeRepX getTypeRepX = do tag <- get :: Get Word8 case tag of - 0 -> do con <- get :: Get TyCon + 0 -> return $ TypeRepX (typeRep :: TypeRep Type) + 1 -> return $ TypeRepX (typeRep :: TypeRep RuntimeRep) + 2 -> do con <- get :: Get TyCon TypeRepX rep_k <- getTypeRepX case rep_k `eqTypeRep` (typeRep :: TypeRep Type) of Just HRefl -> pure $ TypeRepX $ mkTrCon con rep_k Nothing -> fail "getTypeRepX: Kind mismatch" - 1 -> do TypeRepX f <- getTypeRepX + 3 -> do TypeRepX f <- getTypeRepX TypeRepX x <- getTypeRepX case typeRepKind f of TRFun arg _ -> From git at git.haskell.org Sun Jan 29 20:18:28 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:18:28 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Message: Import Data.Typeable.TypeRep (7e16c17) Message-ID: <20170129201828.337343A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/7e16c17a48df6688ddee9360e6522ab2587d6797/ghc >--------------------------------------------------------------- commit 7e16c17a48df6688ddee9360e6522ab2587d6797 Author: Ben Gamari Date: Wed Mar 16 10:35:59 2016 +0100 Message: Import Data.Typeable.TypeRep >--------------------------------------------------------------- 7e16c17a48df6688ddee9360e6522ab2587d6797 libraries/ghci/GHCi/Message.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/libraries/ghci/GHCi/Message.hs b/libraries/ghci/GHCi/Message.hs index fe4e95e..9e8286c 100644 --- a/libraries/ghci/GHCi/Message.hs +++ b/libraries/ghci/GHCi/Message.hs @@ -39,6 +39,10 @@ import Data.ByteString (ByteString) import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as LB import Data.Dynamic +#if MIN_VERSION_base(4,9,0) +-- Previously this was re-exported by Data.Dynamic +import Data.Typeable (TypeRep) +#endif import Data.IORef import Data.Map (Map) import GHC.Generics From git at git.haskell.org Sun Jan 29 20:18:30 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:18:30 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: TcInteract: Unused parameter (482e7cd) Message-ID: <20170129201830.E19C03A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/482e7cd135344e11414440710fce148a5ba4c520/ghc >--------------------------------------------------------------- commit 482e7cd135344e11414440710fce148a5ba4c520 Author: Ben Gamari Date: Wed Mar 16 11:04:54 2016 +0100 TcInteract: Unused parameter >--------------------------------------------------------------- 482e7cd135344e11414440710fce148a5ba4c520 compiler/typecheck/TcInteract.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/compiler/typecheck/TcInteract.hs b/compiler/typecheck/TcInteract.hs index e7bbafa..47d9f2e 100644 --- a/compiler/typecheck/TcInteract.hs +++ b/compiler/typecheck/TcInteract.hs @@ -2166,7 +2166,7 @@ matchTypeable clas [k,t] -- clas = Typeable | t `eqType` liftedTypeKind = doPrimRep trTYPE'PtrRepLiftedName t | t `eqType` runtimeRepTy = doPrimRep trRuntimeRepName t | Just (tc, ks) <- splitTyConApp_maybe t -- See Note [Typeable (T a b c)] - , onlyNamedBndrsApplied tc ks = doTyConApp clas t tc ks + , onlyNamedBndrsApplied tc ks = doTyConApp clas t tc | Just (arg,ret) <- splitFunTy_maybe t = doFunTy clas t arg ret | Just (f,kt) <- splitAppTy_maybe t = doTyApp clas t f kt @@ -2201,8 +2201,8 @@ doPrimRep rep_name ty -- kind variables have been instantiated). -- -- TODO: Do we want to encode the applied kinds in the representation? -doTyConApp :: Class -> Type -> TyCon -> [Kind] -> TcS LookupInstResult -doTyConApp clas ty tc ks +doTyConApp :: Class -> Type -> TyCon -> TcS LookupInstResult +doTyConApp clas ty tc = return $ GenInst [mk_typeable_pred clas $ typeKind ty] (\[ev] -> EvTypeable ty $ EvTypeableTyCon tc ev) True From git at git.haskell.org Sun Jan 29 20:18:33 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:18:33 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Move special tycons (bdff108) Message-ID: <20170129201833.A08843A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/bdff108b9b5302426f323d8d437ef6352ce89ee9/ghc >--------------------------------------------------------------- commit bdff108b9b5302426f323d8d437ef6352ce89ee9 Author: Ben Gamari Date: Wed Mar 16 17:51:01 2016 +0100 Move special tycons >--------------------------------------------------------------- bdff108b9b5302426f323d8d437ef6352ce89ee9 compiler/prelude/TysPrim.hs | 172 +++++++++++++++++++++++---------------- compiler/typecheck/TcTypeable.hs | 18 +--- 2 files changed, 104 insertions(+), 86 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc bdff108b9b5302426f323d8d437ef6352ce89ee9 From git at git.haskell.org Sun Jan 29 20:18:36 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:18:36 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: TcTypeable: Don't generate bindings for special primitive tycons (8d7ed74) Message-ID: <20170129201836.57B6E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/8d7ed74bd24861a6d0947c2a84afa47cd0639fba/ghc >--------------------------------------------------------------- commit 8d7ed74bd24861a6d0947c2a84afa47cd0639fba Author: Ben Gamari Date: Wed Mar 16 15:34:03 2016 +0100 TcTypeable: Don't generate bindings for special primitive tycons >--------------------------------------------------------------- 8d7ed74bd24861a6d0947c2a84afa47cd0639fba compiler/typecheck/TcTypeable.hs | 19 +++++++++++++++++-- 1 file changed, 17 insertions(+), 2 deletions(-) diff --git a/compiler/typecheck/TcTypeable.hs b/compiler/typecheck/TcTypeable.hs index 9996a7d..8ebb305 100644 --- a/compiler/typecheck/TcTypeable.hs +++ b/compiler/typecheck/TcTypeable.hs @@ -14,7 +14,8 @@ import IfaceEnv( newGlobalBinder ) import TcEnv import TcRnMonad import PrelNames -import TysPrim ( primTyCons ) +import TysPrim ( primTyCons, tYPETyConName, funTyConName ) +import TysWiredIn ( runtimeRepTyCon ) import Id import Type import TyCon @@ -22,6 +23,7 @@ import DataCon import Name( getOccName ) import OccName import Module +import NameSet import HsSyn import DynFlags import Bag @@ -167,6 +169,17 @@ mkTypeableTyConBinds tycons ; gbl_env <- tcExtendGlobalValEnv tycon_rep_ids getGblEnv ; return (gbl_env `addTypecheckedBinds` tc_binds) } +-- | The names of the 'TyCon's which we handle explicitly in "Data.Typeable.Internal" +-- and should not generate bindings for in "GHC.Types". +-- +-- See Note [Mutually recursive representations of primitive types] +specialPrimTyCons :: NameSet +specialPrimTyCons = mkNameSet + [ tYPETyConName + , tyConName runtimeRepTyCon + , funTyConName + ] + -- | Generate bindings for the type representation of a wired-in TyCon defined -- by the virtual "GHC.Prim" module. This is where we inject the representation -- bindings for primitive types into "GHC.Types" @@ -210,7 +223,9 @@ ghcPrimTypeableBinds stuff where all_prim_tys :: [TyCon] all_prim_tys = [ tc' | tc <- funTyCon : primTyCons - , tc' <- tc : tyConATs tc ] + , tc' <- tc : tyConATs tc + , not $ tyConName tc' `elemNameSet` specialPrimTyCons + ] mkBind :: TyCon -> LHsBinds Id mkBind = mk_typeable_binds stuff From git at git.haskell.org Sun Jan 29 20:18:39 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:18:39 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Fix pretty-printer (fe5bcf6) Message-ID: <20170129201839.1CC643A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/fe5bcf68d079f330e7781958385c6f6f2572bba2/ghc >--------------------------------------------------------------- commit fe5bcf68d079f330e7781958385c6f6f2572bba2 Author: Ben Gamari Date: Wed Mar 16 22:07:23 2016 +0100 Fix pretty-printer >--------------------------------------------------------------- fe5bcf68d079f330e7781958385c6f6f2572bba2 libraries/base/Data/Typeable/Internal.hs | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs index d879905..a2431ac 100644 --- a/libraries/base/Data/Typeable/Internal.hs +++ b/libraries/base/Data/Typeable/Internal.hs @@ -347,14 +347,18 @@ instance Show (TypeRep (a :: k)) where showChar '(' . showArgs (showChar ',') tys . showChar ')' where (tc, tys) = splitApps rep showsPrec p (TrTyCon _ tycon _) = showsPrec p tycon - showsPrec _ (TrApp _ (TrTyCon _ tycon _) x) + --showsPrec p (TRFun x r) = + -- showParen (p > 8) $ + -- showsPrec 9 x . showString " -> " . showsPrec 8 r + showsPrec p (TrApp _ (TrApp _ (TrTyCon _ tycon _) x) r) | isArrowTyCon tycon = - shows x . showString " ->" + showParen (p > 8) $ + showsPrec 9 x . showString " -> " . showsPrec p r showsPrec p (TrApp _ f x) | otherwise = showParen (p > 9) $ - showsPrec p f . + showsPrec 8 f . space . showsPrec 9 x where From git at git.haskell.org Sun Jan 29 20:18:41 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:18:41 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Internal things (f83025c) Message-ID: <20170129201841.C94223A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/f83025c82bb7b61647b49666d3320182787d0688/ghc >--------------------------------------------------------------- commit f83025c82bb7b61647b49666d3320182787d0688 Author: Ben Gamari Date: Wed Mar 16 17:51:27 2016 +0100 Internal things >--------------------------------------------------------------- f83025c82bb7b61647b49666d3320182787d0688 libraries/base/Data/Typeable/Internal.hs | 35 ++++++++++++++++++++++++++------ libraries/base/Type/Reflection.hs | 1 + 2 files changed, 30 insertions(+), 6 deletions(-) diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs index ce028e3..d879905 100644 --- a/libraries/base/Data/Typeable/Internal.hs +++ b/libraries/base/Data/Typeable/Internal.hs @@ -71,6 +71,8 @@ module Data.Typeable.Internal ( mkTrCon, mkTrApp, mkTyCon, mkTyCon#, typeSymbolTypeRep, typeNatTypeRep, + debugShow, + -- * Representations for primitive types trTYPE, trTYPE'PtrRepLifted, @@ -320,6 +322,22 @@ typeRepXFingerprint (TypeRepX t) = typeRepFingerprint t ----------------- Showing TypeReps -------------------- +debugShow :: TypeRep a -> String +debugShow rep + | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep Type) = "Type" + | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep RuntimeRep) = "RuntimeRep" + | (tc, _) <- splitApps rep + , isArrowTyCon tc = "Arrow" +debugShow (TrApp _ f x) = "App ("++debugShow f++") ("++debugShow x++")" +debugShow (TrTyCon _ x k) + | isArrowTyCon x = "Arrow" + | "->" <- show x = "Arrow #" ++ show ( tyConFingerprint x + , tyConFingerprint trArrowTyCon + , tyConFingerprint $ typeRepTyCon (typeRep :: TypeRep (->)) + , typeRepTyCon (typeRep :: TypeRep (->)) + ) + | otherwise = show x++" :: "++debugShow k + -- | @since 2.01 instance Show (TypeRep (a :: k)) where showsPrec _ rep @@ -329,16 +347,18 @@ instance Show (TypeRep (a :: k)) where showChar '(' . showArgs (showChar ',') tys . showChar ')' where (tc, tys) = splitApps rep showsPrec p (TrTyCon _ tycon _) = showsPrec p tycon + showsPrec _ (TrApp _ (TrTyCon _ tycon _) x) + | isArrowTyCon tycon = + shows x . showString " ->" + showsPrec p (TrApp _ f x) - | Just HRefl <- f `eqTypeRep` (typeRep :: TypeRep (->)) = - shows x . showString " -> " | otherwise = - showsPrec p f . space . showParen need_parens (showsPrec 10 x) + showParen (p > 9) $ + showsPrec p f . + space . + showsPrec 9 x where space = showChar ' ' - need_parens = case x of - TrApp {} -> True - TrTyCon {} -> False -- | @since 4.10.0.0 instance Show TypeRepX where @@ -351,6 +371,9 @@ splitApps = go [] go xs (TrTyCon _ tc _) = (tc, xs) go xs (TrApp _ f x) = go (TypeRepX x : xs) f +isArrowTyCon :: TyCon -> Bool +isArrowTyCon tc = tc == typeRepTyCon (typeRep :: TypeRep (->)) + isListTyCon :: TyCon -> Bool isListTyCon tc = tc == typeRepTyCon (typeRep :: TypeRep [Int]) diff --git a/libraries/base/Type/Reflection.hs b/libraries/base/Type/Reflection.hs index 8057a2e..480e148 100644 --- a/libraries/base/Type/Reflection.hs +++ b/libraries/base/Type/Reflection.hs @@ -37,6 +37,7 @@ module Type.Reflection , I.tyConModule , I.tyConName , I.rnfTyCon + , I.debugShow ) where import qualified Data.Typeable.Internal as I From git at git.haskell.org Sun Jan 29 20:18:44 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:18:44 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Fix up representation pretty-printer (ce229eb) Message-ID: <20170129201844.872AD3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/ce229eb960810b4358cf948cf5febf05ab52da08/ghc >--------------------------------------------------------------- commit ce229eb960810b4358cf948cf5febf05ab52da08 Author: Ben Gamari Date: Wed Mar 16 13:36:30 2016 +0100 Fix up representation pretty-printer >--------------------------------------------------------------- ce229eb960810b4358cf948cf5febf05ab52da08 libraries/base/Data/Typeable/Internal.hs | 44 +++++++++++++++++++++++--------- 1 file changed, 32 insertions(+), 12 deletions(-) diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs index 11612fd..ce028e3 100644 --- a/libraries/base/Data/Typeable/Internal.hs +++ b/libraries/base/Data/Typeable/Internal.hs @@ -321,29 +321,49 @@ typeRepXFingerprint (TypeRepX t) = typeRepFingerprint t ----------------- Showing TypeReps -------------------- -- | @since 2.01 -instance Show (TypeRep a) where +instance Show (TypeRep (a :: k)) where + showsPrec _ rep + | isListTyCon tc, [ty] <- tys = + showChar '[' . shows ty . showChar ']' + | isTupleTyCon tc = + showChar '(' . showArgs (showChar ',') tys . showChar ')' + where (tc, tys) = splitApps rep showsPrec p (TrTyCon _ tycon _) = showsPrec p tycon - showsPrec p (TrApp _ f x) = showsPrec p f . showString " " . showsPrec p x - -- TODO: Reconsider precedence + showsPrec p (TrApp _ f x) + | Just HRefl <- f `eqTypeRep` (typeRep :: TypeRep (->)) = + shows x . showString " -> " + | otherwise = + showsPrec p f . space . showParen need_parens (showsPrec 10 x) + where + space = showChar ' ' + need_parens = case x of + TrApp {} -> True + TrTyCon {} -> False -- | @since 4.10.0.0 instance Show TypeRepX where showsPrec p (TypeRepX ty) = showsPrec p ty --- Some (Show.TypeRepX) helpers: -{- --- FIXME: Handle tuples, etc. +splitApps :: TypeRep a -> (TyCon, [TypeRepX]) +splitApps = go [] + where + go :: [TypeRepX] -> TypeRep a -> (TyCon, [TypeRepX]) + go xs (TrTyCon _ tc _) = (tc, xs) + go xs (TrApp _ f x) = go (TypeRepX x : xs) f + +isListTyCon :: TyCon -> Bool +isListTyCon tc = tc == typeRepTyCon (typeRep :: TypeRep [Int]) + +isTupleTyCon :: TyCon -> Bool +isTupleTyCon tc + | ('(':',':_) <- tyConName tc = True + | otherwise = False + showArgs :: Show a => ShowS -> [a] -> ShowS showArgs _ [] = id showArgs _ [a] = showsPrec 10 a showArgs sep (a:as) = showsPrec 10 a . sep . showArgs sep as -showTuple :: [TypeRepX] -> ShowS -showTuple args = showChar '(' - . showArgs (showChar ',') args - . showChar ')' --} - -- | Helper to fully evaluate 'TypeRep' for use as @NFData(rnf)@ implementation -- -- @since 4.8.0.0 From git at git.haskell.org Sun Jan 29 20:18:47 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:18:47 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Fix recursive fingerprints (e245e83) Message-ID: <20170129201847.401163A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/e245e83f4c6a8320fa46fa59303be912cd82f090/ghc >--------------------------------------------------------------- commit e245e83f4c6a8320fa46fa59303be912cd82f090 Author: Ben Gamari Date: Wed Mar 16 11:53:01 2016 +0100 Fix recursive fingerprints >--------------------------------------------------------------- e245e83f4c6a8320fa46fa59303be912cd82f090 libraries/base/Data/Typeable/Internal.hs | 17 +++++++++++++---- 1 file changed, 13 insertions(+), 4 deletions(-) diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs index fc425a0..0d69f7a 100644 --- a/libraries/base/Data/Typeable/Internal.hs +++ b/libraries/base/Data/Typeable/Internal.hs @@ -434,11 +434,20 @@ For this reason we are forced to define their representations manually. -} +-- | We can't use 'mkTrCon' here as it requires the fingerprint of the kind +-- which is knot-tied. +mkPrimTrCon :: forall k (a :: k). TyCon -> TypeRep k -> TypeRep a +mkPrimTrCon tc kind = TrTyCon fpr tc kind + where + fpr_tc = tyConFingerprint tc + fpr_tag = fingerprintString "prim" + fpr = fingerprintFingerprints [fpr_tag, fpr_tc] + mkPrimTyCon :: String -> TyCon mkPrimTyCon = mkTyCon "ghc-prim" "GHC.Prim" trTYPE :: TypeRep TYPE -trTYPE = mkTrCon (mkPrimTyCon "TYPE") runtimeRep_arr_type +trTYPE = mkPrimTrCon (mkPrimTyCon "TYPE") runtimeRep_arr_type where runtimeRep_arr :: TypeRep ((->) RuntimeRep) runtimeRep_arr = mkTrApp trArrow trRuntimeRep @@ -447,10 +456,10 @@ trTYPE = mkTrCon (mkPrimTyCon "TYPE") runtimeRep_arr_type runtimeRep_arr_type = mkTrApp runtimeRep_arr star trRuntimeRep :: TypeRep RuntimeRep -trRuntimeRep = mkTrCon (mkPrimTyCon "RuntimeRep") star +trRuntimeRep = mkPrimTrCon (mkPrimTyCon "RuntimeRep") star tr'PtrRepLifted :: TypeRep 'PtrRepLifted -tr'PtrRepLifted = mkTrCon (mkPrimTyCon "'PtrRepLifted") trRuntimeRep +tr'PtrRepLifted = mkPrimTrCon (mkPrimTyCon "'PtrRepLifted") trRuntimeRep trTYPE'PtrRepLifted :: TypeRep (TYPE 'PtrRepLifted) trTYPE'PtrRepLifted = mkTrApp trTYPE tr'PtrRepLifted @@ -459,7 +468,7 @@ trArrowTyCon :: TyCon trArrowTyCon = mkPrimTyCon "->" trArrow :: TypeRep (->) -trArrow = mkTrCon trArrowTyCon star_arr_star_arr_star +trArrow = mkPrimTrCon trArrowTyCon star_arr_star_arr_star -- Some useful aliases star :: TypeRep (TYPE 'PtrRepLifted) From git at git.haskell.org Sun Jan 29 20:18:49 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:18:49 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Another recursive serialization case (e68d961) Message-ID: <20170129201849.ED4453A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/e68d96155dd7db6c0bed529522ac322dfc2103e5/ghc >--------------------------------------------------------------- commit e68d96155dd7db6c0bed529522ac322dfc2103e5 Author: Ben Gamari Date: Wed Mar 16 14:05:43 2016 +0100 Another recursive serialization case >--------------------------------------------------------------- e68d96155dd7db6c0bed529522ac322dfc2103e5 compiler/utils/Binary.hs | 14 +++++++++----- libraries/ghci/GHCi/TH/Binary.hs | 14 +++++++++----- 2 files changed, 18 insertions(+), 10 deletions(-) diff --git a/compiler/utils/Binary.hs b/compiler/utils/Binary.hs index 9f3fb8d..431c55b 100644 --- a/compiler/utils/Binary.hs +++ b/compiler/utils/Binary.hs @@ -583,19 +583,22 @@ instance Binary TyCon where #if MIN_VERSION_base(4,9,0) putTypeRep :: BinHandle -> TypeRep a -> IO () --- Special handling for Type and RuntimeRep due to recursive kind relations. +-- Special handling for Type, (->), and RuntimeRep due to recursive kind +-- relations. -- See Note [Mutually recursive representations of primitive types] putTypeRep bh rep | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep Type) = put_ bh (0 :: Word8) | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep RuntimeRep) = put_ bh (1 :: Word8) + | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep (->)) + = put_ bh (2 :: Word8) putTypeRep bh rep@(TRCon con) = do - put_ bh (2 :: Word8) + put_ bh (3 :: Word8) put_ bh con putTypeRep bh (typeRepKind rep) putTypeRep bh (TRApp f x) = do - put_ bh (3 :: Word8) + put_ bh (4 :: Word8) putTypeRep bh f putTypeRep bh x putTypeRep _ _ = fail "putTypeRep: Impossible" @@ -606,13 +609,14 @@ getTypeRepX bh = do case tag of 0 -> return $ TypeRepX (typeRep :: TypeRep Type) 1 -> return $ TypeRepX (typeRep :: TypeRep RuntimeRep) - 2 -> do con <- get bh :: IO TyCon + 2 -> return $ TypeRepX (typeRep :: TypeRep (->)) + 3 -> do con <- get bh :: IO TyCon TypeRepX rep_k <- getTypeRepX bh case rep_k `eqTypeRep` (typeRep :: TypeRep Type) of Just HRefl -> pure $ TypeRepX $ mkTrCon con rep_k Nothing -> fail "getTypeRepX: Kind mismatch" - 3 -> do TypeRepX f <- getTypeRepX bh + 4 -> do TypeRepX f <- getTypeRepX bh TypeRepX x <- getTypeRepX bh case typeRepKind f of TRFun arg _ -> diff --git a/libraries/ghci/GHCi/TH/Binary.hs b/libraries/ghci/GHCi/TH/Binary.hs index ea0809f..f617e2a 100644 --- a/libraries/ghci/GHCi/TH/Binary.hs +++ b/libraries/ghci/GHCi/TH/Binary.hs @@ -85,19 +85,22 @@ instance Binary TyCon where get = mkTyCon <$> get <*> get <*> get putTypeRep :: TypeRep a -> Put --- Special handling for Type and RuntimeRep due to recursive kind relations. +-- Special handling for Type, (->), and RuntimeRep due to recursive kind +-- relations. -- See Note [Mutually recursive representations of primitive types] putTypeRep rep | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep Type) = put (0 :: Word8) | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep RuntimeRep) = put (1 :: Word8) + | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep (->)) + = put (2 :: Word8) putTypeRep rep@(TRCon con) = do - put (2 :: Word8) + put (3 :: Word8) put con putTypeRep (typeRepKind rep) putTypeRep (TRApp f x) = do - put (3 :: Word8) + put (4 :: Word8) putTypeRep f putTypeRep x putTypeRep _ = fail "putTypeRep: Impossible" @@ -108,13 +111,14 @@ getTypeRepX = do case tag of 0 -> return $ TypeRepX (typeRep :: TypeRep Type) 1 -> return $ TypeRepX (typeRep :: TypeRep RuntimeRep) - 2 -> do con <- get :: Get TyCon + 2 -> return $ TypeRepX (typeRep :: TypeRep (->)) + 3 -> do con <- get :: Get TyCon TypeRepX rep_k <- getTypeRepX case rep_k `eqTypeRep` (typeRep :: TypeRep Type) of Just HRefl -> pure $ TypeRepX $ mkTrCon con rep_k Nothing -> fail "getTypeRepX: Kind mismatch" - 3 -> do TypeRepX f <- getTypeRepX + 4 -> do TypeRepX f <- getTypeRepX TypeRepX x <- getTypeRepX case typeRepKind f of TRFun arg _ -> From git at git.haskell.org Sun Jan 29 20:18:52 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:18:52 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Fix a few TTypeRep references (ca62568) Message-ID: <20170129201852.AAD793A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/ca6256801cebdd1adead0b50c26acd20b9d01369/ghc >--------------------------------------------------------------- commit ca6256801cebdd1adead0b50c26acd20b9d01369 Author: Ben Gamari Date: Wed Mar 16 11:51:00 2016 +0100 Fix a few TTypeRep references >--------------------------------------------------------------- ca6256801cebdd1adead0b50c26acd20b9d01369 compiler/deSugar/DsBinds.hs | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/compiler/deSugar/DsBinds.hs b/compiler/deSugar/DsBinds.hs index 4fc1403..13549ad 100644 --- a/compiler/deSugar/DsBinds.hs +++ b/compiler/deSugar/DsBinds.hs @@ -1207,10 +1207,10 @@ type TypeRepExpr = CoreExpr ds_ev_typeable :: Type -> EvTypeable -> DsM CoreExpr ds_ev_typeable ty (EvTypeableTyCon tc kind_ev) = do { mkTrCon <- dsLookupGlobalId mkTrConName - -- mkTrCon :: forall k (a :: k). TyCon -> TTypeRep k -> TTypeRep a + -- mkTrCon :: forall k (a :: k). TyCon -> TypeRep k -> TypeRep a ; tc_rep <- tyConRep tc -- :: TyCon - ; kind_rep <- getRep kind_ev (typeKind ty) -- :: TTypeRep k + ; kind_rep <- getRep kind_ev (typeKind ty) -- :: TypeRep k -- Note that we use the kind of the type, not the TyCon from which it is -- constructed since the latter may be kind polymorphic whereas the @@ -1241,8 +1241,8 @@ ds_ev_typeable ty (EvTypeableTyLit ev) ty_kind = typeKind ty -- tr_fun is the Name of - -- typeNatTypeRep :: KnownNat a => Proxy# a -> TTypeRep a - -- of typeSymbolTypeRep :: KnownSymbol a => Proxy# a -> TTypeRep a + -- typeNatTypeRep :: KnownNat a => Proxy# a -> TypeRep a + -- of typeSymbolTypeRep :: KnownSymbol a => Proxy# a -> TypeRep a tr_fun | ty_kind `eqType` typeNatKind = typeNatTypeRepName | ty_kind `eqType` typeSymbolKind = typeSymbolTypeRepName | otherwise = panic "dsEvTypeable: unknown type lit kind" @@ -1256,10 +1256,10 @@ ds_ev_typeable ty ev getRep :: EvTerm -- ^ EvTerm for @Typeable ty@ -> Type -- ^ The type @ty@ - -> DsM TypeRepExpr -- ^ Return @CoreExpr :: TTypeRep ty@ + -> DsM TypeRepExpr -- ^ Return @CoreExpr :: TypeRep ty@ -- namely @typeRep# dict@ -- Remember that --- typeRep# :: forall k (a::k). Typeable k a -> TTypeRep a +-- typeRep# :: forall k (a::k). Typeable k a -> TypeRep a getRep ev ty = do { typeable_expr <- dsEvTerm ev ; typeRepId <- dsLookupGlobalId typeRepIdName From git at git.haskell.org Sun Jan 29 20:18:55 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:18:55 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Make TRApp bidirectional (9abac3c) Message-ID: <20170129201855.6E0413A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/9abac3c1817207026db2b13d3b1ad7742eee377c/ghc >--------------------------------------------------------------- commit 9abac3c1817207026db2b13d3b1ad7742eee377c Author: Ben Gamari Date: Sun Jul 10 10:51:23 2016 +0200 Make TRApp bidirectional >--------------------------------------------------------------- 9abac3c1817207026db2b13d3b1ad7742eee377c libraries/base/Data/Typeable/Internal.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs index 25c7399..8213c12 100644 --- a/libraries/base/Data/Typeable/Internal.hs +++ b/libraries/base/Data/Typeable/Internal.hs @@ -247,6 +247,7 @@ pattern TRApp :: forall k2 (t :: k2). () => forall k1 (a :: k1 -> k2) (b :: k1). (t ~ a b) => TypeRep a -> TypeRep b -> TypeRep t pattern TRApp f x <- TrApp _ f x + where TRApp f x = mkTrApp f x -- | Use a 'TypeRep' as 'Typeable' evidence. withTypeable :: forall a r. TypeRep a -> (Typeable a => r) -> r From git at git.haskell.org Sun Jan 29 20:18:58 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:18:58 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Fix up type printer (4daf937) Message-ID: <20170129201858.349193A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/4daf937fe4588d5bd689eab95ecdd49a768740c2/ghc >--------------------------------------------------------------- commit 4daf937fe4588d5bd689eab95ecdd49a768740c2 Author: Ben Gamari Date: Sun Jul 10 10:51:56 2016 +0200 Fix up type printer >--------------------------------------------------------------- 4daf937fe4588d5bd689eab95ecdd49a768740c2 libraries/base/Data/Typeable/Internal.hs | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs index 702616f..6e5242b 100644 --- a/libraries/base/Data/Typeable/Internal.hs +++ b/libraries/base/Data/Typeable/Internal.hs @@ -333,13 +333,17 @@ instance Show (TypeRep (a :: k)) where showsPrec = showTypeable showTypeable :: Int -> TypeRep (a :: k) -> ShowS -showTypeable p rep = +showTypeable p rep + | Just HRefl <- star `eqTypeRep` rep = + showTypeable' 9 rep + + | otherwise = showParen (p > 9) $ - showTypeable' 8 rep . showString " :: " . showTypeable' 8 (typeRepKind rep) + showTypeable' 9 rep . showString " :: " . showTypeable' 8 (typeRepKind rep) showTypeable' :: Int -> TypeRep (a :: k) -> ShowS showTypeable' _ rep - | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep *) = + | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep Type) = showChar '*' | isListTyCon tc, [ty] <- tys = showChar '[' . shows ty . showChar ']' From git at git.haskell.org Sun Jan 29 20:19:00 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:19:00 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Add TRArrow pattern synonym (3bd60ba) Message-ID: <20170129201900.E19A33A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/3bd60ba48f68983c5f8df7e9732aaae1bf8c7184/ghc >--------------------------------------------------------------- commit 3bd60ba48f68983c5f8df7e9732aaae1bf8c7184 Author: Ben Gamari Date: Sun Jul 10 10:51:33 2016 +0200 Add TRArrow pattern synonym >--------------------------------------------------------------- 3bd60ba48f68983c5f8df7e9732aaae1bf8c7184 libraries/base/Data/Typeable/Internal.hs | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs index 8213c12..702616f 100644 --- a/libraries/base/Data/Typeable/Internal.hs +++ b/libraries/base/Data/Typeable/Internal.hs @@ -186,13 +186,17 @@ instance Ord TypeRepX where TypeRepX a `compare` TypeRepX b = typeRepFingerprint a `compare` typeRepFingerprint b +--pattern TRArrow :: TypeRep (->) +pattern TRArrow <- (eqTypeRep trArrow -> Just HRefl) + where TRArrow = trArrow + pattern TRFun :: forall fun. () => forall arg res. (fun ~ (arg -> res)) => TypeRep arg -> TypeRep res -> TypeRep fun -pattern TRFun arg res <- TrApp _ (TrApp _ (eqTypeRep trArrow -> Just HRefl) arg) res where - TRFun arg res = mkTrApp (mkTrApp trArrow arg) res +pattern TRFun arg res <- TRApp (TRApp TRArrow arg) res + where TRFun arg res = mkTrApp (mkTrApp trArrow arg) res decomposeFun :: forall fun r. TypeRep fun From git at git.haskell.org Sun Jan 29 20:19:03 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:19:03 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Fix T8132 (8c3cc63) Message-ID: <20170129201903.9BDB73A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/8c3cc63af47480e36b0ba67c5c329664588e543a/ghc >--------------------------------------------------------------- commit 8c3cc63af47480e36b0ba67c5c329664588e543a Author: Ben Gamari Date: Wed Mar 16 23:22:32 2016 +0100 Fix T8132 >--------------------------------------------------------------- 8c3cc63af47480e36b0ba67c5c329664588e543a testsuite/tests/polykinds/T8132.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/testsuite/tests/polykinds/T8132.hs b/testsuite/tests/polykinds/T8132.hs index 337e288..cdbfd7f 100644 --- a/testsuite/tests/polykinds/T8132.hs +++ b/testsuite/tests/polykinds/T8132.hs @@ -1,6 +1,7 @@ {-# LANGUAGE MagicHash #-} -import Data.Typeable.Internal +import Data.Typeable data K = K -instance Typeable K where typeRep# _ = undefined +-- This used to have a RHS but now we hide typeRep# +instance Typeable K -- where typeRep# _ = undefined From git at git.haskell.org Sun Jan 29 20:19:06 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:19:06 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Kill redundant comment (2db3572) Message-ID: <20170129201906.5B2E03A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/2db3572fa076fe608c7345be7be7c774e17430be/ghc >--------------------------------------------------------------- commit 2db3572fa076fe608c7345be7be7c774e17430be Author: Ben Gamari Date: Fri Jul 8 17:07:12 2016 +0200 Kill redundant comment >--------------------------------------------------------------- 2db3572fa076fe608c7345be7be7c774e17430be libraries/base/Data/Typeable/Internal.hs | 6 ------ 1 file changed, 6 deletions(-) diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs index e73fee6..9e22c22 100644 --- a/libraries/base/Data/Typeable/Internal.hs +++ b/libraries/base/Data/Typeable/Internal.hs @@ -292,12 +292,6 @@ eqTypeRep a b | typeRepFingerprint a == typeRepFingerprint b = Just (unsafeCoerce# HRefl) | otherwise = Nothing -{- ********************************************************************* -* * - The Typeable class -* * -********************************************************************* -} - ------------------------------------------------------------- -- -- The Typeable class and friends From git at git.haskell.org Sun Jan 29 20:19:09 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:19:09 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Clarify serialization errors (bfdeae0) Message-ID: <20170129201909.21E983A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/bfdeae0d5848a3d420812a5303fe844758d242c0/ghc >--------------------------------------------------------------- commit bfdeae0d5848a3d420812a5303fe844758d242c0 Author: Ben Gamari Date: Fri Jul 8 14:56:38 2016 +0200 Clarify serialization errors >--------------------------------------------------------------- bfdeae0d5848a3d420812a5303fe844758d242c0 compiler/utils/Binary.hs | 33 ++++++++++++++++++++++++++------- libraries/ghci/GHCi/TH/Binary.hs | 33 ++++++++++++++++++++++++++------- 2 files changed, 52 insertions(+), 14 deletions(-) diff --git a/compiler/utils/Binary.hs b/compiler/utils/Binary.hs index 4153dbc..89b1f55 100644 --- a/compiler/utils/Binary.hs +++ b/compiler/utils/Binary.hs @@ -601,7 +601,7 @@ putTypeRep bh (TRApp f x) = do put_ bh (4 :: Word8) putTypeRep bh f putTypeRep bh x -putTypeRep _ _ = fail "putTypeRep: Impossible" +putTypeRep _ _ = fail "Binary.putTypeRep: Impossible" getTypeRepX :: BinHandle -> IO TypeRepX getTypeRepX bh = do @@ -614,7 +614,10 @@ getTypeRepX bh = do TypeRepX rep_k <- getTypeRepX bh case rep_k `eqTypeRep` (typeRep :: TypeRep Type) of Just HRefl -> pure $ TypeRepX $ mkTrCon con rep_k - Nothing -> fail "getTypeRepX: Kind mismatch" + Nothing -> failure "Kind mismatch in constructor application" + [ " Type constructor: " ++ show con + , " Applied to type : " ++ show rep_k + ] 4 -> do TypeRepX f <- getTypeRepX bh TypeRepX x <- getTypeRepX bh @@ -623,17 +626,33 @@ getTypeRepX bh = do case arg `eqTypeRep` typeRepKind x of Just HRefl -> pure $ TypeRepX $ mkTrApp f x - _ -> fail "getTypeRepX: Kind mismatch" - _ -> fail "getTypeRepX: Applied non-arrow type" - _ -> fail "getTypeRepX: Invalid TypeRepX" + _ -> failure "Kind mismatch in type application" + [ " Found argument of kind: " ++ show (typeRepKind x) + , " Where the constructor: " ++ show f + , " Expects kind: " ++ show arg + ] + _ -> failure "Applied non-arrow" + [ " Applied type: " ++ show f + , " To argument: " ++ show x + ] + _ -> failure "Invalid TypeRepX" [] + where + failure description info = + fail $ unlines $ [ "Binary.getTypeRepX: "++description ] + ++ map (" "++) info instance Typeable a => Binary (TypeRep (a :: k)) where put_ = putTypeRep get bh = do TypeRepX rep <- getTypeRepX bh - case rep `eqTypeRep` (typeRep :: TypeRep a) of + case rep `eqTypeRep` expected of Just HRefl -> pure rep - Nothing -> fail "Binary: Type mismatch" + Nothing -> fail $ unlines + [ "Binary: Type mismatch" + , " Deserialized type: " ++ show rep + , " Expected type: " ++ show expected + ] + where expected = typeRep :: TypeRep a instance Binary TypeRepX where put_ bh (TypeRepX rep) = putTypeRep bh rep diff --git a/libraries/ghci/GHCi/TH/Binary.hs b/libraries/ghci/GHCi/TH/Binary.hs index 6ae8112..6c52ad4 100644 --- a/libraries/ghci/GHCi/TH/Binary.hs +++ b/libraries/ghci/GHCi/TH/Binary.hs @@ -103,7 +103,7 @@ putTypeRep (TRApp f x) = do put (4 :: Word8) putTypeRep f putTypeRep x -putTypeRep _ = fail "putTypeRep: Impossible" +putTypeRep _ = fail "GHCi.TH.Binary.putTypeRep: Impossible" getTypeRepX :: Get TypeRepX getTypeRepX = do @@ -116,7 +116,10 @@ getTypeRepX = do TypeRepX rep_k <- getTypeRepX case rep_k `eqTypeRep` (typeRep :: TypeRep Type) of Just HRefl -> pure $ TypeRepX $ mkTrCon con rep_k - Nothing -> fail "getTypeRepX: Kind mismatch" + Nothing -> failure "Kind mismatch" + [ "Type constructor: " ++ show con + , "Applied to type: " ++ show rep_k + ] 4 -> do TypeRepX f <- getTypeRepX TypeRepX x <- getTypeRepX @@ -125,17 +128,33 @@ getTypeRepX = do case arg `eqTypeRep` typeRepKind x of Just HRefl -> pure $ TypeRepX $ mkTrApp f x - _ -> fail "getTypeRepX: Kind mismatch" - _ -> fail "getTypeRepX: Applied non-arrow type" - _ -> fail "getTypeRepX: Invalid TypeRepX" + _ -> failure "Kind mismatch" + [ "Found argument of kind: " ++ show (typeRepKind x) + , "Where the constructor: " ++ show f + , "Expects an argument of kind: " ++ show arg + ] + _ -> failure "Applied non-arrow type" + [ "Applied type: " ++ show f + , "To argument: " ++ show x + ] + _ -> failure "Invalid TypeRepX" [] + where + failure description info = + fail $ unlines $ [ "GHCi.TH.Binary.getTypeRepX: "++description ] + ++ map (" "++) info instance Typeable a => Binary (TypeRep (a :: k)) where put = putTypeRep get = do TypeRepX rep <- getTypeRepX - case rep `eqTypeRep` (typeRep :: TypeRep a) of + case rep `eqTypeRep` expected of Just HRefl -> pure rep - Nothing -> fail "Binary: Type mismatch" + Nothing -> fail $ unlines + [ "GHCi.TH.Binary: Type mismatch" + , " Deserialized type: " ++ show rep + , " Expected type: " ++ show expected + ] + where expected = typeRep :: TypeRep a instance Binary TypeRepX where put (TypeRepX rep) = putTypeRep rep From git at git.haskell.org Sun Jan 29 20:19:11 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:19:11 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Add mkFunTy (ff407d5) Message-ID: <20170129201911.D5C083A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/ff407d59c86760552ea093048ea5e0c23ecf318e/ghc >--------------------------------------------------------------- commit ff407d59c86760552ea093048ea5e0c23ecf318e Author: Ben Gamari Date: Wed Mar 16 23:15:36 2016 +0100 Add mkFunTy >--------------------------------------------------------------- ff407d59c86760552ea093048ea5e0c23ecf318e libraries/base/Data/Typeable.hs | 14 ++++++++++++++ libraries/base/Data/Typeable/Internal.hs | 3 ++- 2 files changed, 16 insertions(+), 1 deletion(-) diff --git a/libraries/base/Data/Typeable.hs b/libraries/base/Data/Typeable.hs index 21f93d2..3eb53c5 100644 --- a/libraries/base/Data/Typeable.hs +++ b/libraries/base/Data/Typeable.hs @@ -68,6 +68,7 @@ module Data.Typeable , typeRepTyCon , rnfTypeRep , showsTypeRep + , mkFunTy -- * Observing type representations , funResultTy @@ -168,6 +169,19 @@ funResultTy (I.TypeRepX f) (I.TypeRepX x) = -} funResultTy _ _ = Nothing +-- | Build a function type. +mkFunTy :: TypeRep -> TypeRep -> TypeRep +mkFunTy (I.TypeRepX arg) (I.TypeRepX res) + | Just HRefl <- arg `I.eqTypeRep` liftedTy + , Just HRefl <- res `I.eqTypeRep` liftedTy + = I.TypeRepX (I.TRFun arg res) + | otherwise + = error $ "mkFunTy: Attempted to construct function type from non-lifted "++ + "type: arg="++show arg++", res="++show res + where liftedTy = I.typeRep :: I.TypeRep * + -- TODO: We should be able to support this but the kind of (->) must be + -- generalized + -- | Force a 'TypeRep' to normal form. rnfTypeRep :: TypeRep -> () rnfTypeRep = I.rnfTypeRepX diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs index 8e1c565..108aa71 100644 --- a/libraries/base/Data/Typeable/Internal.hs +++ b/libraries/base/Data/Typeable/Internal.hs @@ -190,7 +190,8 @@ pattern TRFun :: forall fun. () => TypeRep arg -> TypeRep res -> TypeRep fun -pattern TRFun arg res <- TrApp _ (TrApp _ (eqTypeRep trArrow -> Just HRefl) arg) res +pattern TRFun arg res <- TrApp _ (TrApp _ (eqTypeRep trArrow -> Just HRefl) arg) res where + TRFun arg res = mkTrApp (mkTrApp trArrow arg) res decomposeFun :: forall fun r. TypeRep fun From git at git.haskell.org Sun Jan 29 20:19:14 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:19:14 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Inline space (957ac8d) Message-ID: <20170129201914.8BEE83A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/957ac8d8e77e25f9aba3830fbcb72eb79d971bfb/ghc >--------------------------------------------------------------- commit 957ac8d8e77e25f9aba3830fbcb72eb79d971bfb Author: Ben Gamari Date: Wed Mar 16 22:10:16 2016 +0100 Inline space >--------------------------------------------------------------- 957ac8d8e77e25f9aba3830fbcb72eb79d971bfb libraries/base/Data/Typeable/Internal.hs | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs index f671f0b..8e1c565 100644 --- a/libraries/base/Data/Typeable/Internal.hs +++ b/libraries/base/Data/Typeable/Internal.hs @@ -340,10 +340,8 @@ instance Show (TypeRep (a :: k)) where | otherwise = showParen (p > 9) $ showsPrec 8 f . - space . + showChar ' ' . showsPrec 9 x - where - space = showChar ' ' -- | @since 4.10.0.0 instance Show TypeRepX where From git at git.haskell.org Sun Jan 29 20:19:17 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:19:17 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Implement withTypeable (eef1797) Message-ID: <20170129201917.43DD03A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/eef1797c0a020efa900e403842967cc2991dfeb3/ghc >--------------------------------------------------------------- commit eef1797c0a020efa900e403842967cc2991dfeb3 Author: Ben Gamari Date: Wed Apr 13 00:02:51 2016 +0200 Implement withTypeable >--------------------------------------------------------------- eef1797c0a020efa900e403842967cc2991dfeb3 libraries/base/Data/Typeable/Internal.hs | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs index b2d7726..c72e41a 100644 --- a/libraries/base/Data/Typeable/Internal.hs +++ b/libraries/base/Data/Typeable/Internal.hs @@ -85,6 +85,7 @@ import Data.Type.Equality import GHC.Word import GHC.Show import GHC.TypeLits( KnownNat, KnownSymbol, natVal', symbolVal' ) +import Unsafe.Coerce import GHC.Fingerprint.Type import {-# SOURCE #-} GHC.Fingerprint @@ -245,8 +246,11 @@ pattern TRApp :: forall k2 (t :: k2). () => TypeRep a -> TypeRep b -> TypeRep t pattern TRApp f x <- TrApp _ f x +-- | Use a 'TypeRep' as 'Typeable' evidence. withTypeable :: TypeRep a -> (Typeable a => b) -> b -withTypeable = undefined +withTypeable rep f = f' rep + where f' :: TypeRep a -> b + f' = unsafeCoerce rep -- | Pattern match on a type constructor -- TODO: do we want to expose kinds in these patterns? From git at git.haskell.org Sun Jan 29 20:19:19 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:19:19 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: TcInteract: Fix something (0eacb10) Message-ID: <20170129201919.EBA603A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/0eacb1040e8aedf34f702aebd52072c01a957842/ghc >--------------------------------------------------------------- commit 0eacb1040e8aedf34f702aebd52072c01a957842 Author: Ben Gamari Date: Fri Jul 15 00:59:57 2016 +0200 TcInteract: Fix something >--------------------------------------------------------------- 0eacb1040e8aedf34f702aebd52072c01a957842 compiler/typecheck/TcInteract.hs | 0 1 file changed, 0 insertions(+), 0 deletions(-) From git at git.haskell.org Sun Jan 29 20:19:22 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:19:22 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: More test fixes (7d8c0c3) Message-ID: <20170129201922.A5BFE3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/7d8c0c39b1007d7d22bcb3da12db772b687af1f3/ghc >--------------------------------------------------------------- commit 7d8c0c39b1007d7d22bcb3da12db772b687af1f3 Author: Ben Gamari Date: Wed Mar 16 23:15:48 2016 +0100 More test fixes >--------------------------------------------------------------- 7d8c0c39b1007d7d22bcb3da12db772b687af1f3 libraries/base/tests/dynamic002.hs | 5 +++++ libraries/base/tests/dynamic004.hs | 1 - 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/libraries/base/tests/dynamic002.hs b/libraries/base/tests/dynamic002.hs index 6d53d2e..fff14ec 100644 --- a/libraries/base/tests/dynamic002.hs +++ b/libraries/base/tests/dynamic002.hs @@ -1,7 +1,12 @@ +{-# LANGUAGE CPP #-} + -- !!! Testing Typeable instances module Main(main) where import Data.Dynamic +#if MIN_VERSION_base(4,9,0) +import Data.Typeable (TypeCon, TypeRep) +#endif import Data.Array import Data.Array.MArray import Data.Array.ST diff --git a/libraries/base/tests/dynamic004.hs b/libraries/base/tests/dynamic004.hs index e6b7a82..2091646 100644 --- a/libraries/base/tests/dynamic004.hs +++ b/libraries/base/tests/dynamic004.hs @@ -1,7 +1,6 @@ module Main where import Data.Typeable -import Data.Typeable.Internal import GHC.Fingerprint import Text.Printf From git at git.haskell.org Sun Jan 29 20:19:25 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:19:25 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Note need for mkTrApp (0a16af4) Message-ID: <20170129201925.6208E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/0a16af4a5b571bbd007c6b5b433fd89662ed00cc/ghc >--------------------------------------------------------------- commit 0a16af4a5b571bbd007c6b5b433fd89662ed00cc Author: Ben Gamari Date: Fri Jul 8 23:10:45 2016 +0200 Note need for mkTrApp >--------------------------------------------------------------- 0a16af4a5b571bbd007c6b5b433fd89662ed00cc libraries/base/Data/Typeable/Internal.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs index 9e22c22..25c7399 100644 --- a/libraries/base/Data/Typeable/Internal.hs +++ b/libraries/base/Data/Typeable/Internal.hs @@ -225,7 +225,9 @@ mkTrCon tc kind = TrTyCon fpr tc kind fpr = fingerprintFingerprints [fpr_tc, fpr_k] -- | Construct a representation for a type application. --- TODO: Is this necessary? +-- +-- Note that this is known-key to the compiler, which uses it in desugar +-- 'Typeable' evidence. mkTrApp :: forall k1 k2 (a :: k1 -> k2) (b :: k1). TypeRep (a :: k1 -> k2) -> TypeRep (b :: k1) From git at git.haskell.org Sun Jan 29 20:19:28 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:19:28 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Internal: Rename type variable (b106230) Message-ID: <20170129201928.269DE3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/b106230d7013f604231a324f19d77de9e79cb48e/ghc >--------------------------------------------------------------- commit b106230d7013f604231a324f19d77de9e79cb48e Author: Ben Gamari Date: Fri Mar 18 11:49:43 2016 +0100 Internal: Rename type variable >--------------------------------------------------------------- b106230d7013f604231a324f19d77de9e79cb48e libraries/base/Data/Typeable/Internal.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs index 8a58d4e..b2d7726 100644 --- a/libraries/base/Data/Typeable/Internal.hs +++ b/libraries/base/Data/Typeable/Internal.hs @@ -240,9 +240,9 @@ data AppResult (t :: k) where App :: TypeRep a -> TypeRep b -> AppResult (a b) -- | Pattern match on a type application -pattern TRApp :: forall k2 (fun :: k2). () - => forall k1 (a :: k1 -> k2) (b :: k1). (fun ~ a b) - => TypeRep a -> TypeRep b -> TypeRep fun +pattern TRApp :: forall k2 (t :: k2). () + => forall k1 (a :: k1 -> k2) (b :: k1). (t ~ a b) + => TypeRep a -> TypeRep b -> TypeRep t pattern TRApp f x <- TrApp _ f x withTypeable :: TypeRep a -> (Typeable a => b) -> b From git at git.haskell.org Sun Jan 29 20:19:30 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:19:30 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Bump base to 4.10.0 (1410730) Message-ID: <20170129201930.CA1363A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/14107305c5ab10f21d5b7bedefd4c430a7cac147/ghc >--------------------------------------------------------------- commit 14107305c5ab10f21d5b7bedefd4c430a7cac147 Author: Ben Gamari Date: Fri May 20 16:53:57 2016 +0200 Bump base to 4.10.0 >--------------------------------------------------------------- 14107305c5ab10f21d5b7bedefd4c430a7cac147 compiler/utils/Binary.hs | 6 +++--- libraries/base/tests/dynamic002.hs | 2 +- libraries/ghc-boot/GHC/Serialized.hs | 2 +- libraries/ghci/GHCi/Message.hs | 2 +- libraries/ghci/GHCi/TH/Binary.hs | 4 ++-- 5 files changed, 8 insertions(+), 8 deletions(-) diff --git a/compiler/utils/Binary.hs b/compiler/utils/Binary.hs index 431c55b..4153dbc 100644 --- a/compiler/utils/Binary.hs +++ b/compiler/utils/Binary.hs @@ -76,7 +76,7 @@ import qualified Data.ByteString.Unsafe as BS import Data.IORef import Data.Char ( ord, chr ) import Data.Time -#if MIN_VERSION_base(4,9,0) +#if MIN_VERSION_base(4,10,0) import Type.Reflection import Type.Reflection.Unsafe import Data.Kind (Type) @@ -575,13 +575,13 @@ instance Binary TyCon where p <- get bh m <- get bh n <- get bh -#if MIN_VERSION_base(4,9,0) +#if MIN_VERSION_base(4,10,0) return (mkTyCon p m n) #else return (mkTyCon3 p m n) #endif -#if MIN_VERSION_base(4,9,0) +#if MIN_VERSION_base(4,10,0) putTypeRep :: BinHandle -> TypeRep a -> IO () -- Special handling for Type, (->), and RuntimeRep due to recursive kind -- relations. diff --git a/libraries/base/tests/dynamic002.hs b/libraries/base/tests/dynamic002.hs index fff14ec..560c4b4 100644 --- a/libraries/base/tests/dynamic002.hs +++ b/libraries/base/tests/dynamic002.hs @@ -4,7 +4,7 @@ module Main(main) where import Data.Dynamic -#if MIN_VERSION_base(4,9,0) +#if MIN_VERSION_base(4,10,0) import Data.Typeable (TypeCon, TypeRep) #endif import Data.Array diff --git a/libraries/ghc-boot/GHC/Serialized.hs b/libraries/ghc-boot/GHC/Serialized.hs index 8653049..42a9604 100644 --- a/libraries/ghc-boot/GHC/Serialized.hs +++ b/libraries/ghc-boot/GHC/Serialized.hs @@ -36,7 +36,7 @@ toSerialized serialize what = Serialized rep (serialize what) -- | If the 'Serialized' value contains something of the given type, then use the specified deserializer to return @Just@ that. -- Otherwise return @Nothing at . fromSerialized :: forall a. Typeable a => ([Word8] -> a) -> Serialized -> Maybe a -#if MIN_VERSION_base(4,9,0) +#if MIN_VERSION_base(4,10,0) fromSerialized deserialize (Serialized the_type bytes) | the_type == rep = Just (deserialize bytes) | otherwise = Nothing diff --git a/libraries/ghci/GHCi/Message.hs b/libraries/ghci/GHCi/Message.hs index 9e8286c..b22833f 100644 --- a/libraries/ghci/GHCi/Message.hs +++ b/libraries/ghci/GHCi/Message.hs @@ -39,7 +39,7 @@ import Data.ByteString (ByteString) import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as LB import Data.Dynamic -#if MIN_VERSION_base(4,9,0) +#if MIN_VERSION_base(4,10,0) -- Previously this was re-exported by Data.Dynamic import Data.Typeable (TypeRep) #endif diff --git a/libraries/ghci/GHCi/TH/Binary.hs b/libraries/ghci/GHCi/TH/Binary.hs index f617e2a..6ae8112 100644 --- a/libraries/ghci/GHCi/TH/Binary.hs +++ b/libraries/ghci/GHCi/TH/Binary.hs @@ -10,7 +10,7 @@ module GHCi.TH.Binary () where import Data.Binary import qualified Data.ByteString as B -#if MIN_VERSION_base(4,9,0) +#if MIN_VERSION_base(4,10,0) import Type.Reflection import Type.Reflection.Unsafe import Data.Kind (Type) @@ -79,7 +79,7 @@ instance Binary TH.PatSynArgs -- We need Binary TypeRep for serializing annotations -#if MIN_VERSION_base(4,9,0) +#if MIN_VERSION_base(4,10,0) instance Binary TyCon where put tc = put (tyConPackage tc) >> put (tyConModule tc) >> put (tyConName tc) get = mkTyCon <$> get <*> get <*> get From git at git.haskell.org Sun Jan 29 20:19:33 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:19:33 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Fix withTypeable (e6f1b12) Message-ID: <20170129201933.86A6E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/e6f1b1229d018606f70af1fbaf2937a5a6383f0c/ghc >--------------------------------------------------------------- commit e6f1b1229d018606f70af1fbaf2937a5a6383f0c Author: Ben Gamari Date: Fri May 20 18:07:01 2016 +0200 Fix withTypeable >--------------------------------------------------------------- e6f1b1229d018606f70af1fbaf2937a5a6383f0c libraries/base/Data/Typeable/Internal.hs | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs index c72e41a..8c225a7 100644 --- a/libraries/base/Data/Typeable/Internal.hs +++ b/libraries/base/Data/Typeable/Internal.hs @@ -247,10 +247,13 @@ pattern TRApp :: forall k2 (t :: k2). () pattern TRApp f x <- TrApp _ f x -- | Use a 'TypeRep' as 'Typeable' evidence. -withTypeable :: TypeRep a -> (Typeable a => b) -> b -withTypeable rep f = f' rep - where f' :: TypeRep a -> b - f' = unsafeCoerce rep +withTypeable :: forall a r. TypeRep a -> (Typeable a => r) -> r +withTypeable rep k = unsafeCoerce k' rep + where k' :: Gift a r + k' = Gift k + +-- | A helper to satisfy the type checker in 'withTypeable'. +newtype Gift a r = Gift (Typeable a => r) -- | Pattern match on a type constructor -- TODO: do we want to expose kinds in these patterns? From git at git.haskell.org Sun Jan 29 20:19:36 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:19:36 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Rework Show (aa8510a) Message-ID: <20170129201936.448A33A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/aa8510a6ae8e9abcc283e6fa68a71777fb53d075/ghc >--------------------------------------------------------------- commit aa8510a6ae8e9abcc283e6fa68a71777fb53d075 Author: Ben Gamari Date: Mon Jul 4 14:43:40 2016 +0200 Rework Show >--------------------------------------------------------------- aa8510a6ae8e9abcc283e6fa68a71777fb53d075 libraries/base/Data/Typeable/Internal.hs | 48 +++++++++++++++++++------------- 1 file changed, 28 insertions(+), 20 deletions(-) diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs index 8c225a7..e73fee6 100644 --- a/libraries/base/Data/Typeable/Internal.hs +++ b/libraries/base/Data/Typeable/Internal.hs @@ -329,29 +329,37 @@ typeRepXFingerprint (TypeRepX t) = typeRepFingerprint t ----------------- Showing TypeReps -------------------- instance Show (TypeRep (a :: k)) where - showsPrec _ rep - | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep *) = - showChar '*' - | isListTyCon tc, [ty] <- tys = - showChar '[' . shows ty . showChar ']' - | isTupleTyCon tc = - showChar '(' . showArgs (showChar ',') tys . showChar ')' - where (tc, tys) = splitApps rep - showsPrec p (TrTyCon _ tycon _) = showsPrec p tycon + showsPrec = showTypeable + +showTypeable :: Int -> TypeRep (a :: k) -> ShowS +showTypeable p rep = + showParen (p > 9) $ + showTypeable' 8 rep . showString " :: " . showTypeable' 8 (typeRepKind rep) + +showTypeable' :: Int -> TypeRep (a :: k) -> ShowS +showTypeable' _ rep + | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep *) = + showChar '*' + | isListTyCon tc, [ty] <- tys = + showChar '[' . shows ty . showChar ']' + | isTupleTyCon tc = + showChar '(' . showArgs (showChar ',') tys . showChar ')' + where (tc, tys) = splitApps rep +showTypeable' p (TrTyCon _ tycon _) = showsPrec p tycon --showsPrec p (TRFun x r) = -- showParen (p > 8) $ -- showsPrec 9 x . showString " -> " . showsPrec 8 r - showsPrec p (TrApp _ (TrApp _ (TrTyCon _ tycon _) x) r) - | isArrowTyCon tycon = - showParen (p > 8) $ - showsPrec 9 x . showString " -> " . showsPrec p r - - showsPrec p (TrApp _ f x) - | otherwise = - showParen (p > 9) $ - showsPrec 8 f . - showChar ' ' . - showsPrec 9 x +showTypeable' p (TrApp _ (TrApp _ (TrTyCon _ tycon _) x) r) + | isArrowTyCon tycon = + showParen (p > 8) $ + showsPrec 9 x . showString " -> " . showsPrec p r + +showTypeable' p (TrApp _ f x) + | otherwise = + showParen (p > 9) $ + showsPrec 8 f . + showChar ' ' . + showsPrec 9 x -- | @since 4.10.0.0 instance Show TypeRepX where From git at git.haskell.org Sun Jan 29 20:19:38 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:19:38 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Fix showTypeable (622eb75) Message-ID: <20170129201938.F33BD3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/622eb750ddeb4e6a6bbc3aa61d4f760efe22ebb8/ghc >--------------------------------------------------------------- commit 622eb750ddeb4e6a6bbc3aa61d4f760efe22ebb8 Author: Ben Gamari Date: Fri Jul 15 01:00:20 2016 +0200 Fix showTypeable >--------------------------------------------------------------- 622eb750ddeb4e6a6bbc3aa61d4f760efe22ebb8 libraries/base/Data/Typeable/Internal.hs | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs index 6e5242b..6237d25 100644 --- a/libraries/base/Data/Typeable/Internal.hs +++ b/libraries/base/Data/Typeable/Internal.hs @@ -334,7 +334,7 @@ instance Show (TypeRep (a :: k)) where showTypeable :: Int -> TypeRep (a :: k) -> ShowS showTypeable p rep - | Just HRefl <- star `eqTypeRep` rep = + | Just HRefl <- star `eqTypeRep` typeRepKind rep = showTypeable' 9 rep | otherwise = @@ -351,14 +351,13 @@ showTypeable' _ rep showChar '(' . showArgs (showChar ',') tys . showChar ')' where (tc, tys) = splitApps rep showTypeable' p (TrTyCon _ tycon _) = showsPrec p tycon - --showsPrec p (TRFun x r) = - -- showParen (p > 8) $ - -- showsPrec 9 x . showString " -> " . showsPrec 8 r +--showTypeable' p (TRFun x r) = +-- showParen (p > 8) $ +-- showsPrec 9 x . showString " -> " . showsPrec 8 r showTypeable' p (TrApp _ (TrApp _ (TrTyCon _ tycon _) x) r) | isArrowTyCon tycon = showParen (p > 8) $ - showsPrec 9 x . showString " -> " . showsPrec p r - + showsPrec 9 x . showString " -> " . showsPrec 8 r showTypeable' p (TrApp _ f x) | otherwise = showParen (p > 9) $ From git at git.haskell.org Sun Jan 29 20:19:41 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:19:41 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Accept easy test output (73e17b3) Message-ID: <20170129201941.AC4F33A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/73e17b35d31cd6d1ebaf87712d4283e674636936/ghc >--------------------------------------------------------------- commit 73e17b35d31cd6d1ebaf87712d4283e674636936 Author: Ben Gamari Date: Wed Mar 16 22:58:53 2016 +0100 Accept easy test output >--------------------------------------------------------------- 73e17b35d31cd6d1ebaf87712d4283e674636936 testsuite/tests/ghci.debugger/scripts/print019.stderr | 6 +++--- testsuite/tests/typecheck/should_fail/TcStaticPointersFail02.stderr | 4 ++-- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/testsuite/tests/ghci.debugger/scripts/print019.stderr b/testsuite/tests/ghci.debugger/scripts/print019.stderr index cc62fa1..c266bc8 100644 --- a/testsuite/tests/ghci.debugger/scripts/print019.stderr +++ b/testsuite/tests/ghci.debugger/scripts/print019.stderr @@ -5,10 +5,10 @@ Use :print or :force to determine these types Relevant bindings include it :: a1 (bound at :10:1) These potential instances exist: - instance Show TypeRep -- Defined in ‘Data.Typeable.Internal’ instance Show Ordering -- Defined in ‘GHC.Show’ instance Show TyCon -- Defined in ‘GHC.Show’ - ...plus 30 others - ...plus 10 instances involving out-of-scope types + instance Show Integer -- Defined in ‘GHC.Show’ + ...plus 29 others + ...plus 12 instances involving out-of-scope types (use -fprint-potential-instances to see them all) • In a stmt of an interactive GHCi command: print it diff --git a/testsuite/tests/typecheck/should_fail/TcStaticPointersFail02.stderr b/testsuite/tests/typecheck/should_fail/TcStaticPointersFail02.stderr index e6e637c..b48d63f 100644 --- a/testsuite/tests/typecheck/should_fail/TcStaticPointersFail02.stderr +++ b/testsuite/tests/typecheck/should_fail/TcStaticPointersFail02.stderr @@ -1,13 +1,13 @@ TcStaticPointersFail02.hs:9:6: error: - • No instance for (Data.Typeable.Internal.Typeable b) + • No instance for (base-4.9.0.0:Data.Typeable.Internal.Typeable b) arising from a static form • In the expression: static (undefined :: (forall a. a -> a) -> b) In an equation for ‘f1’: f1 = static (undefined :: (forall a. a -> a) -> b) TcStaticPointersFail02.hs:12:6: error: - • No instance for (Data.Typeable.Internal.Typeable + • No instance for (base-4.9.0.0:Data.Typeable.Internal.Typeable (Monad m => a -> m a)) arising from a static form (maybe you haven't applied a function to enough arguments?) From git at git.haskell.org Sun Jan 29 20:19:44 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:19:44 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Kill debugShow (e01ebe4) Message-ID: <20170129201944.6314A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/e01ebe48f765f87b7264211f7e8e8ef4c8393e9f/ghc >--------------------------------------------------------------- commit e01ebe48f765f87b7264211f7e8e8ef4c8393e9f Author: Ben Gamari Date: Wed Mar 16 22:08:49 2016 +0100 Kill debugShow >--------------------------------------------------------------- e01ebe48f765f87b7264211f7e8e8ef4c8393e9f libraries/base/Data/Typeable/Internal.hs | 19 ------------------- libraries/base/Type/Reflection.hs | 1 - 2 files changed, 20 deletions(-) diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs index a2431ac..f671f0b 100644 --- a/libraries/base/Data/Typeable/Internal.hs +++ b/libraries/base/Data/Typeable/Internal.hs @@ -71,8 +71,6 @@ module Data.Typeable.Internal ( mkTrCon, mkTrApp, mkTyCon, mkTyCon#, typeSymbolTypeRep, typeNatTypeRep, - debugShow, - -- * Representations for primitive types trTYPE, trTYPE'PtrRepLifted, @@ -322,23 +320,6 @@ typeRepXFingerprint (TypeRepX t) = typeRepFingerprint t ----------------- Showing TypeReps -------------------- -debugShow :: TypeRep a -> String -debugShow rep - | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep Type) = "Type" - | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep RuntimeRep) = "RuntimeRep" - | (tc, _) <- splitApps rep - , isArrowTyCon tc = "Arrow" -debugShow (TrApp _ f x) = "App ("++debugShow f++") ("++debugShow x++")" -debugShow (TrTyCon _ x k) - | isArrowTyCon x = "Arrow" - | "->" <- show x = "Arrow #" ++ show ( tyConFingerprint x - , tyConFingerprint trArrowTyCon - , tyConFingerprint $ typeRepTyCon (typeRep :: TypeRep (->)) - , typeRepTyCon (typeRep :: TypeRep (->)) - ) - | otherwise = show x++" :: "++debugShow k - --- | @since 2.01 instance Show (TypeRep (a :: k)) where showsPrec _ rep | isListTyCon tc, [ty] <- tys = diff --git a/libraries/base/Type/Reflection.hs b/libraries/base/Type/Reflection.hs index 480e148..8057a2e 100644 --- a/libraries/base/Type/Reflection.hs +++ b/libraries/base/Type/Reflection.hs @@ -37,7 +37,6 @@ module Type.Reflection , I.tyConModule , I.tyConName , I.rnfTyCon - , I.debugShow ) where import qualified Data.Typeable.Internal as I From git at git.haskell.org Sun Jan 29 20:19:47 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:19:47 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Render TYPE 'PtrRepLifted as * (3006200) Message-ID: <20170129201947.2486E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/3006200420fad41f9f7dd404549301cffb1f4e5e/ghc >--------------------------------------------------------------- commit 3006200420fad41f9f7dd404549301cffb1f4e5e Author: Ben Gamari Date: Thu Mar 17 01:02:39 2016 +0100 Render TYPE 'PtrRepLifted as * >--------------------------------------------------------------- 3006200420fad41f9f7dd404549301cffb1f4e5e libraries/base/Data/Typeable/Internal.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs index 108aa71..8a58d4e 100644 --- a/libraries/base/Data/Typeable/Internal.hs +++ b/libraries/base/Data/Typeable/Internal.hs @@ -323,6 +323,8 @@ typeRepXFingerprint (TypeRepX t) = typeRepFingerprint t instance Show (TypeRep (a :: k)) where showsPrec _ rep + | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep *) = + showChar '*' | isListTyCon tc, [ty] <- tys = showChar '[' . shows ty . showChar ']' | isTupleTyCon tc = From git at git.haskell.org Sun Jan 29 20:19:49 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:19:49 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Rename TypeRepX to SomeTypeRep (541c138) Message-ID: <20170129201949.E11BE3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/541c138e370daf6471fb388a4483316f81b99e70/ghc >--------------------------------------------------------------- commit 541c138e370daf6471fb388a4483316f81b99e70 Author: Ben Gamari Date: Fri Nov 18 09:03:43 2016 -0500 Rename TypeRepX to SomeTypeRep >--------------------------------------------------------------- 541c138e370daf6471fb388a4483316f81b99e70 compiler/utils/Binary.hs | 34 +++++++-------- libraries/base/Data/Dynamic.hs | 4 +- libraries/base/Data/Typeable.hs | 14 +++--- libraries/base/Data/Typeable/Internal.hs | 46 ++++++++++---------- libraries/base/Type/Reflection.hs | 4 +- libraries/ghci/GHCi/TH/Binary.hs | 34 +++++++-------- .../tests/dependent/should_compile/RaeJobTalk.hs | 50 +++++++++++----------- testsuite/tests/dependent/should_compile/T11711.hs | 10 ++--- .../dependent/should_compile/dynamic-paper.hs | 16 +++---- 9 files changed, 106 insertions(+), 106 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 541c138e370daf6471fb388a4483316f81b99e70 From git at git.haskell.org Sun Jan 29 20:19:52 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:19:52 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Add reference to precedence note (f6bcb2d) Message-ID: <20170129201952.92DC03A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/f6bcb2d96b195e5915471bbdff76a50d49a23740/ghc >--------------------------------------------------------------- commit f6bcb2d96b195e5915471bbdff76a50d49a23740 Author: Ben Gamari Date: Sun Oct 2 14:36:57 2016 -0400 Add reference to precedence note >--------------------------------------------------------------- f6bcb2d96b195e5915471bbdff76a50d49a23740 libraries/base/Data/Typeable/Internal.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs index 870189a..4c064d6 100644 --- a/libraries/base/Data/Typeable/Internal.hs +++ b/libraries/base/Data/Typeable/Internal.hs @@ -335,6 +335,8 @@ typeRepXFingerprint (TypeRepX t) = typeRepFingerprint t ----------------- Showing TypeReps -------------------- +-- This follows roughly the precedence structure described in Note [Precedence +-- in types]. instance Show (TypeRep (a :: k)) where showsPrec = showTypeable From git at git.haskell.org Sun Jan 29 20:19:55 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:19:55 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: testsuite: Add test of Typeable Binary instances (009b607) Message-ID: <20170129201955.CABE03A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/009b60765d42ee62985af468ed7c643a46366438/ghc >--------------------------------------------------------------- commit 009b60765d42ee62985af468ed7c643a46366438 Author: Ben Gamari Date: Fri Jul 22 13:13:36 2016 +0200 testsuite: Add test of Typeable Binary instances >--------------------------------------------------------------- 009b60765d42ee62985af468ed7c643a46366438 .../typecheck/should_run/TestTypeableBinary.hs | 37 ++++++++++++++++++++++ .../typecheck/should_run/TestTypeableBinary.stdout | 15 +++++++++ testsuite/tests/typecheck/should_run/all.T | 1 + 3 files changed, 53 insertions(+) diff --git a/testsuite/tests/typecheck/should_run/TestTypeableBinary.hs b/testsuite/tests/typecheck/should_run/TestTypeableBinary.hs new file mode 100644 index 0000000..e427c13 --- /dev/null +++ b/testsuite/tests/typecheck/should_run/TestTypeableBinary.hs @@ -0,0 +1,37 @@ +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE PolyKinds #-} + +import qualified Data.ByteString as BS +import Type.Reflection +import Data.Binary +import GHCi.TH.Binary () + +import GHC.Exts +import Data.Kind +import Data.Proxy + +testRoundtrip :: Typeable a => TypeRep a -> IO () +testRoundtrip rep + | rep /= rep' = putStrLn $ "bad: " ++ show rep ++ " /= " ++ show rep' + | otherwise = putStrLn $ "good: " ++ show rep + where + rep' = decode (encode rep) + +main :: IO () +main = do + testRoundtrip (typeRep :: TypeRep Int) + testRoundtrip (typeRep :: TypeRep Int#) + testRoundtrip (typeRep :: TypeRep IO) + testRoundtrip (typeRep :: TypeRep Maybe) + testRoundtrip (typeRep :: TypeRep TYPE) + testRoundtrip (typeRep :: TypeRep RuntimeRep) + testRoundtrip (typeRep :: TypeRep 'IntRep) + testRoundtrip (typeRep :: TypeRep (->)) + testRoundtrip (typeRep :: TypeRep (Proxy Int)) + testRoundtrip (typeRep :: TypeRep (Proxy Int#)) + testRoundtrip (typeRep :: TypeRep Type) + testRoundtrip (typeRep :: TypeRep (Int -> Int)) + testRoundtrip (typeRep :: TypeRep 5) + testRoundtrip (typeRep :: TypeRep "hello world") + testRoundtrip (typeRep :: TypeRep ('Just 5)) diff --git a/testsuite/tests/typecheck/should_run/TestTypeableBinary.stdout b/testsuite/tests/typecheck/should_run/TestTypeableBinary.stdout new file mode 100644 index 0000000..7e32096 --- /dev/null +++ b/testsuite/tests/typecheck/should_run/TestTypeableBinary.stdout @@ -0,0 +1,15 @@ +good: (Int) +good: Int# :: ((TYPE :: ((RuntimeRep) -> (*))) ('IntRep :: (RuntimeRep))) +good: IO :: ((*) -> (*)) +good: Maybe :: ((*) -> (*)) +good: TYPE :: ((RuntimeRep) -> (*)) +good: (RuntimeRep) +good: 'IntRep :: (RuntimeRep) +good: -> :: ((*) -> ((*) -> (*))) +good: ((Proxy :: ((*) -> (*))) (Int)) +good: ((Proxy :: (((TYPE :: ((RuntimeRep) -> (*))) ('IntRep :: (RuntimeRep))) -> (*))) (Int# :: ((TYPE :: ((RuntimeRep) -> (*))) ('IntRep :: (RuntimeRep))))) +good: (*) +good: ((Int) -> (Int)) +good: 5 :: (Nat) +good: "hello world" :: (Symbol) +good: ('Just :: ((Nat) -> ((Maybe :: ((*) -> (*))) (Nat)))) (5 :: (Nat)) :: ((Maybe :: ((*) -> (*))) (Nat)) diff --git a/testsuite/tests/typecheck/should_run/all.T b/testsuite/tests/typecheck/should_run/all.T index eab9f8a..9d4139e 100755 --- a/testsuite/tests/typecheck/should_run/all.T +++ b/testsuite/tests/typecheck/should_run/all.T @@ -117,3 +117,4 @@ test('KindInvariant', normal, ghci_script, ['KindInvariant.script']) test('StrictPats', normal, compile_and_run, ['']) test('T12809', normal, compile_and_run, ['']) test('EtaExpandLevPoly', normal, compile_and_run, ['']) +test('TestTypeableBinary', normal, compile_and_run, ['']) From git at git.haskell.org Sun Jan 29 20:19:58 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:19:58 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Clarify comments (6371dba) Message-ID: <20170129201958.7FD653A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/6371dbaeb0eb6e9eed81fac498853d3e41a43cdc/ghc >--------------------------------------------------------------- commit 6371dbaeb0eb6e9eed81fac498853d3e41a43cdc Author: Ben Gamari Date: Sun Jul 17 22:02:55 2016 +0200 Clarify comments >--------------------------------------------------------------- 6371dbaeb0eb6e9eed81fac498853d3e41a43cdc compiler/prelude/TysPrim.hs | 7 ++++--- compiler/typecheck/TcTypeable.hs | 4 ++-- 2 files changed, 6 insertions(+), 5 deletions(-) diff --git a/compiler/prelude/TysPrim.hs b/compiler/prelude/TysPrim.hs index 83ee6a3..80e2049 100644 --- a/compiler/prelude/TysPrim.hs +++ b/compiler/prelude/TysPrim.hs @@ -160,10 +160,11 @@ primTyCons ] -- | The names of the 'TyCon's which we define 'Typeable' bindings for --- explicitly in "Data.Typeable.Internal" --- and should not generate bindings for in "GHC.Types". +-- explicitly in "Data.Typeable.Internal" and should not generate representation +-- bindings for in "GHC.Types". -- --- See Note [Mutually recursive representations of primitive types] +-- See Note [Mutually recursive representations of primitive types] in +-- "Data.Typeable.Internal" and Note [Grand plan for Typeable] in "TcTypeable". primTypeableTyCons :: NameEnv TyConRepName primTypeableTyCons = mkNameEnv [ (tYPETyConName, trTYPEName) diff --git a/compiler/typecheck/TcTypeable.hs b/compiler/typecheck/TcTypeable.hs index d27b509..402f64c 100644 --- a/compiler/typecheck/TcTypeable.hs +++ b/compiler/typecheck/TcTypeable.hs @@ -168,9 +168,9 @@ mkTypeableTyConBinds tycons ; gbl_env <- tcExtendGlobalValEnv tycon_rep_ids getGblEnv ; return (gbl_env `addTypecheckedBinds` tc_binds) } --- | Generate bindings for the type representation of a wired-in TyCon defined +-- | Generate bindings for the type representation of a wired-in 'TyCon's defined -- by the virtual "GHC.Prim" module. This is where we inject the representation --- bindings for primitive types into "GHC.Types" +-- bindings for these primitive types into "GHC.Types" -- -- See Note [Grand plan for Typeable] in this module. mkPrimTypeableBinds :: TcM TcGblEnv From git at git.haskell.org Sun Jan 29 20:20:01 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:20:01 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: testsuite/TypeRep: Add test for #12409 (4c17891) Message-ID: <20170129202001.39A5E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/4c178916f5b4a608e321b39256f44955d98a337a/ghc >--------------------------------------------------------------- commit 4c178916f5b4a608e321b39256f44955d98a337a Author: Ben Gamari Date: Tue Jul 19 10:57:48 2016 +0200 testsuite/TypeRep: Add test for #12409 >--------------------------------------------------------------- 4c178916f5b4a608e321b39256f44955d98a337a testsuite/tests/typecheck/should_run/TypeRep.hs | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) diff --git a/testsuite/tests/typecheck/should_run/TypeRep.hs b/testsuite/tests/typecheck/should_run/TypeRep.hs index 5fbf909..002e4fb 100644 --- a/testsuite/tests/typecheck/should_run/TypeRep.hs +++ b/testsuite/tests/typecheck/should_run/TypeRep.hs @@ -1,5 +1,9 @@ {-# LANGUAGE DataKinds #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE TypeInType #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE MagicHash #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE AllowAmbiguousTypes #-} @@ -30,6 +34,12 @@ main = do print $ rep @Bool print $ rep @Ordering print $ rep @(Int -> Int) + print $ rep @((Eq Int, Eq String) :: Constraint) + + -- Unboxed things (#12049) + print $ rep @Int# + print $ rep @(##) + print $ rep @(# Int#, Int #) -- Various instantiations of a kind-polymorphic type print $ rep @(Proxy (Eq Int)) @@ -45,4 +55,4 @@ main = do print $ rep @(Proxy 'LiftedRep) -- Something lifted and primitive - print $ rep @RealWorld + print $ rep @RealWorld -- #12132 From git at git.haskell.org Sun Jan 29 20:20:04 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:20:04 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Introduce TrFun (765bc30) Message-ID: <20170129202004.074173A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/765bc30d85a3f853bfd32771515015da8e665682/ghc >--------------------------------------------------------------- commit 765bc30d85a3f853bfd32771515015da8e665682 Author: Ben Gamari Date: Fri Oct 7 09:19:52 2016 -0400 Introduce TrFun Here we special-case saturated applications of (->) since otherwise we would need to generalize the kind of (->), which is more work that I have time for at the moment. Sadly this means we can no longer split function types. >--------------------------------------------------------------- 765bc30d85a3f853bfd32771515015da8e665682 compiler/deSugar/DsBinds.hs | 13 +++++ compiler/prelude/PrelNames.hs | 10 ++-- compiler/prelude/TysPrim.hs | 1 - compiler/typecheck/TcEvidence.hs | 6 +++ compiler/typecheck/TcHsSyn.hs | 4 ++ compiler/typecheck/TcInteract.hs | 18 ++----- libraries/base/Data/Typeable/Internal.hs | 82 ++++++++++++-------------------- 7 files changed, 64 insertions(+), 70 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 765bc30d85a3f853bfd32771515015da8e665682 From git at git.haskell.org Sun Jan 29 20:20:06 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:20:06 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Debug (26952ca) Message-ID: <20170129202006.B7EE73A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/26952ca4fa1dfb8018f2ff8729597a70dfbee5f8/ghc >--------------------------------------------------------------- commit 26952ca4fa1dfb8018f2ff8729597a70dfbee5f8 Author: Ben Gamari Date: Mon Sep 5 21:51:34 2016 -0400 Debug >--------------------------------------------------------------- 26952ca4fa1dfb8018f2ff8729597a70dfbee5f8 libraries/base/Data/Typeable/Internal.hs | 17 ++++++++++------- 1 file changed, 10 insertions(+), 7 deletions(-) diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs index bc10e36..870189a 100644 --- a/libraries/base/Data/Typeable/Internal.hs +++ b/libraries/base/Data/Typeable/Internal.hs @@ -338,14 +338,18 @@ typeRepXFingerprint (TypeRepX t) = typeRepFingerprint t instance Show (TypeRep (a :: k)) where showsPrec = showTypeable +fpr _ = id +--fpr rep = showString " (" . shows (typeRepFingerprint rep) . showString ")" + showTypeable :: Int -> TypeRep (a :: k) -> ShowS showTypeable p rep | Just HRefl <- star `eqTypeRep` typeRepKind rep = - showTypeable' 9 rep + showParen True $ + showTypeable' 1 rep . fpr (typeRepKind rep) . fpr rep | otherwise = - showParen (p > 9) $ - showTypeable' 9 rep . showString " :: " . showTypeable' 8 (typeRepKind rep) + showParen (p > 1) $ + showTypeable' 1 rep . showString " :: " . showParen True (showTypeable' 0 (typeRepKind rep) . fpr (typeRepKind rep)) . fpr rep showTypeable' :: Int -> TypeRep (a :: k) -> ShowS showTypeable' _ rep @@ -356,10 +360,9 @@ showTypeable' _ rep | isTupleTyCon tc = showChar '(' . showArgs (showChar ',') tys . showChar ')' where (tc, tys) = splitApps rep -showTypeable' p (TrTyCon _ tycon _) = showsPrec p tycon ---showTypeable' p (TRFun x r) = --- showParen (p > 8) $ --- showsPrec 9 x . showString " -> " . showsPrec 8 r +showTypeable' p (TrTyCon _ tycon _) = + showParen (p > 9) $ + showsPrec p tycon showTypeable' p (TrApp _ (TrApp _ (TrTyCon _ tycon _) x) r) | isArrowTyCon tycon = showParen (p > 8) $ From git at git.haskell.org Sun Jan 29 20:20:09 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:20:09 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: TcTypeable: Clarify comment (63d611b) Message-ID: <20170129202009.763D63A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/63d611b69f21748bcb5cb68feb8d9b2a7873f42c/ghc >--------------------------------------------------------------- commit 63d611b69f21748bcb5cb68feb8d9b2a7873f42c Author: Ben Gamari Date: Fri Jul 22 13:16:05 2016 +0200 TcTypeable: Clarify comment >--------------------------------------------------------------- 63d611b69f21748bcb5cb68feb8d9b2a7873f42c compiler/typecheck/TcTypeable.hs | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/compiler/typecheck/TcTypeable.hs b/compiler/typecheck/TcTypeable.hs index 2bbf522..62a4202 100644 --- a/compiler/typecheck/TcTypeable.hs +++ b/compiler/typecheck/TcTypeable.hs @@ -215,7 +215,11 @@ ghcPrimTypeableTyCons = filter (not . definedManually) $ concat , primTyCons ] where - definedManually tc = tyConName tc `elemNameEnv` primTypeableTcCons + -- Some things, like TYPE, have mutually recursion kind relationships and + -- therefore have manually-defined representations. See Note [Mutually + -- recursive representations of primitive types] in Data.Typeable.Internal + -- and Note [Grand plan for Typeable] for details. + definedManually tc = tyConName tc `elemNameEnv` primTypeableTyCons -- | Generate bindings for the type representation of the wired-in TyCons defined -- by the virtual "GHC.Prim" module. This differs from the usual From git at git.haskell.org Sun Jan 29 20:20:12 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:20:12 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Give unboxed tuples type representations (f03a227) Message-ID: <20170129202012.310AE3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/f03a22726d0fed7410221686343a71b844cb69e3/ghc >--------------------------------------------------------------- commit f03a22726d0fed7410221686343a71b844cb69e3 Author: Ben Gamari Date: Tue Jul 19 11:59:32 2016 +0200 Give unboxed tuples type representations This fixes #12409. Ultimately this was a bit of a toss-up between 1. keeping unboxed tuples unrepresentable and improving the error offered by the solver, and 2. allowing unboxed tuples to be representable Ultimately it seemed easier (and perhaps more useful) to do (2), so that's what this patch does. >--------------------------------------------------------------- f03a22726d0fed7410221686343a71b844cb69e3 compiler/prelude/TysWiredIn.hs | 2 +- compiler/typecheck/TcTypeable.hs | 25 +++++++++++++++++++++---- compiler/types/TyCon.hs | 4 +++- 3 files changed, 25 insertions(+), 6 deletions(-) diff --git a/compiler/prelude/TysWiredIn.hs b/compiler/prelude/TysWiredIn.hs index 66eb396..8d59b80 100644 --- a/compiler/prelude/TysWiredIn.hs +++ b/compiler/prelude/TysWiredIn.hs @@ -865,7 +865,7 @@ mk_tuple Unboxed arity = (tycon, tuple_con) tc_res_kind = unboxedTupleKind rr_tys tc_arity = arity * 2 - flavour = UnboxedAlgTyCon + flavour = UnboxedAlgTyCon (mkPrelTyConRepName tc_name) dc_tvs = binderVars tc_binders (rr_tys, dc_arg_tys) = splitAt arity (mkTyVarTys dc_tvs) diff --git a/compiler/typecheck/TcTypeable.hs b/compiler/typecheck/TcTypeable.hs index 402f64c..2bbf522 100644 --- a/compiler/typecheck/TcTypeable.hs +++ b/compiler/typecheck/TcTypeable.hs @@ -15,6 +15,7 @@ import TcEnv import TcRnMonad import PrelNames import TysPrim ( primTyCons, primTypeableTyCons ) +import TysWiredIn ( tupleTyCon ) import Id import Type import TyCon @@ -26,6 +27,8 @@ import NameEnv import HsSyn import DynFlags import Bag +import BasicTypes ( Boxity(..) ) +import Constants ( mAX_TUPLE_SIZE ) import Fingerprint(Fingerprint(..), fingerprintString) import Outputable import FastString ( FastString, mkFastString ) @@ -198,6 +201,22 @@ mkPrimTypeableBinds } where +-- | This is the list of primitive 'TyCon's for which we must generate bindings +-- in "GHC.Types". This should include all types defined in "GHC.Prim". +-- +-- The majority of the types we need here are contained in 'primTyCons'. +-- However, not all of them: in particular unboxed tuples are absent since we +-- don't want to include them in the original name cache. See +-- Note [Built-in syntax and the OrigNameCache] in IfaceEnv for more. +ghcPrimTypeableTyCons :: [TyCon] +ghcPrimTypeableTyCons = filter (not . definedManually) $ concat + [ [funTyCon, tupleTyCon Unboxed 0] + , map (tupleTyCon Unboxed) [2..mAX_TUPLE_SIZE] + , primTyCons + ] + where + definedManually tc = tyConName tc `elemNameEnv` primTypeableTcCons + -- | Generate bindings for the type representation of the wired-in TyCons defined -- by the virtual "GHC.Prim" module. This differs from the usual -- @mkTypeableBinds@ path in that here we need to lie to 'mk_typeable_binds' @@ -210,10 +229,8 @@ ghcPrimTypeableBinds stuff = unionManyBags (map mkBind all_prim_tys) where all_prim_tys :: [TyCon] - all_prim_tys = [ tc' | tc <- funTyCon : primTyCons - , tc' <- tc : tyConATs tc - , not $ tyConName tc' `elemNameEnv` primTypeableTyCons - ] + all_prim_tys = [ tc' | tc <- ghcPrimTypeableTyCons + , tc' <- tc : tyConATs tc ] mkBind :: TyCon -> LHsBinds Id mkBind = mk_typeable_binds stuff diff --git a/compiler/types/TyCon.hs b/compiler/types/TyCon.hs index fb170bb..cd57fae 100644 --- a/compiler/types/TyCon.hs +++ b/compiler/types/TyCon.hs @@ -898,6 +898,7 @@ data AlgTyConFlav -- | An unboxed type constructor. Note that this carries no TyConRepName -- as it is not representable. | UnboxedAlgTyCon + TyConRepName -- | Type constructors representing a class dictionary. -- See Note [ATyCon for classes] in TyCoRep @@ -951,7 +952,7 @@ instance Outputable AlgTyConFlav where -- name, if any okParent :: Name -> AlgTyConFlav -> Bool okParent _ (VanillaAlgTyCon {}) = True -okParent _ (UnboxedAlgTyCon) = True +okParent _ (UnboxedAlgTyCon {}) = True okParent tc_name (ClassTyCon cls _) = tc_name == tyConName (classTyCon cls) okParent _ (DataFamInstTyCon _ fam_tc tys) = tyConArity fam_tc == length tys @@ -1169,6 +1170,7 @@ tyConRepName_maybe (PrimTyCon { primRepName = mb_rep_nm }) tyConRepName_maybe (AlgTyCon { algTcParent = parent }) | VanillaAlgTyCon rep_nm <- parent = Just rep_nm | ClassTyCon _ rep_nm <- parent = Just rep_nm + | UnboxedAlgTyCon rep_nm <- parent = Just rep_nm tyConRepName_maybe (FamilyTyCon { famTcFlav = DataFamilyTyCon rep_nm }) = Just rep_nm tyConRepName_maybe (PromotedDataCon { tcRepName = rep_nm }) From git at git.haskell.org Sun Jan 29 20:20:14 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:20:14 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Things (10f40d5) Message-ID: <20170129202014.E08AC3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/10f40d51a1b09dd956e2ab7994bcd5524a251dcb/ghc >--------------------------------------------------------------- commit 10f40d51a1b09dd956e2ab7994bcd5524a251dcb Author: Ben Gamari Date: Sun Oct 23 14:26:15 2016 -0400 Things >--------------------------------------------------------------- 10f40d51a1b09dd956e2ab7994bcd5524a251dcb compiler/coreSyn/CoreLint.hs | 2 +- libraries/base/Data/Dynamic.hs | 8 ++++++-- libraries/base/Type/Reflection.hs | 1 - 3 files changed, 7 insertions(+), 4 deletions(-) diff --git a/compiler/coreSyn/CoreLint.hs b/compiler/coreSyn/CoreLint.hs index c86b6b2..3ca3785 100644 --- a/compiler/coreSyn/CoreLint.hs +++ b/compiler/coreSyn/CoreLint.hs @@ -1174,7 +1174,7 @@ lintArrow :: SDoc -> LintedKind -> LintedKind -> LintM LintedKind -- See Note [GHC Formalism] lintArrow what k1 k2 -- Eg lintArrow "type or kind `blah'" k1 k2 -- or lintarrow "coercion `blah'" k1 k2 - = do { unless (okArrowArgKind k1) (addErrL (msg (text "argument") k1)) + = do { --unless (okArrowArgKind k1) (addErrL (msg (text "argument") k1)) ; unless (okArrowResultKind k2) (addErrL (msg (text "result") k2)) ; return liftedTypeKind } where diff --git a/libraries/base/Data/Dynamic.hs b/libraries/base/Data/Dynamic.hs index dd6a5f2..a147605 100644 --- a/libraries/base/Data/Dynamic.hs +++ b/libraries/base/Data/Dynamic.hs @@ -4,6 +4,7 @@ {-# LANGUAGE ExplicitForAll #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} ----------------------------------------------------------------------------- -- | @@ -135,8 +136,11 @@ fromDynamic (Dynamic t v) -- (f::(a->b)) `dynApply` (x::a) = (f a)::b dynApply :: Dynamic -> Dynamic -> Maybe Dynamic dynApply (Dynamic (TRFun ta tr) f) (Dynamic ta' x) - | Just HRefl <- ta `eqTypeRep` ta' = Just (Dynamic tr (f x)) -dynApply _ _ = Nothing + | Just HRefl <- ta `eqTypeRep` ta' + , Just HRefl <- typeRepKind tr `eqTypeRep` typeRep @Type + = Just (Dynamic tr (f x)) +dynApply _ _ + = Nothing dynApp :: Dynamic -> Dynamic -> Dynamic dynApp f x = case dynApply f x of diff --git a/libraries/base/Type/Reflection.hs b/libraries/base/Type/Reflection.hs index 8057a2e..94d3d91 100644 --- a/libraries/base/Type/Reflection.hs +++ b/libraries/base/Type/Reflection.hs @@ -17,7 +17,6 @@ module Type.Reflection , I.TypeRep , I.typeOf , pattern I.TRApp, pattern I.TRCon, pattern I.TRFun - , I.decomposeFun , I.typeRepFingerprint , I.typeRepTyCon , I.typeRepKind From git at git.haskell.org Sun Jan 29 20:20:17 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:20:17 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Fix serialization (ee5a085) Message-ID: <20170129202017.9502A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/ee5a0852c5509dc86519055d0c889873664a521a/ghc >--------------------------------------------------------------- commit ee5a0852c5509dc86519055d0c889873664a521a Author: Ben Gamari Date: Sun Jul 17 21:09:57 2016 +0200 Fix serialization >--------------------------------------------------------------- ee5a0852c5509dc86519055d0c889873664a521a compiler/utils/Binary.hs | 2 +- libraries/ghci/GHCi/TH/Binary.hs | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/compiler/utils/Binary.hs b/compiler/utils/Binary.hs index 89b1f55..8ac57bf 100644 --- a/compiler/utils/Binary.hs +++ b/compiler/utils/Binary.hs @@ -612,7 +612,7 @@ getTypeRepX bh = do 2 -> return $ TypeRepX (typeRep :: TypeRep (->)) 3 -> do con <- get bh :: IO TyCon TypeRepX rep_k <- getTypeRepX bh - case rep_k `eqTypeRep` (typeRep :: TypeRep Type) of + case typeRepKind rep_k `eqTypeRep` (typeRep :: TypeRep Type) of Just HRefl -> pure $ TypeRepX $ mkTrCon con rep_k Nothing -> failure "Kind mismatch in constructor application" [ " Type constructor: " ++ show con diff --git a/libraries/ghci/GHCi/TH/Binary.hs b/libraries/ghci/GHCi/TH/Binary.hs index 6c52ad4..267cc03 100644 --- a/libraries/ghci/GHCi/TH/Binary.hs +++ b/libraries/ghci/GHCi/TH/Binary.hs @@ -114,7 +114,7 @@ getTypeRepX = do 2 -> return $ TypeRepX (typeRep :: TypeRep (->)) 3 -> do con <- get :: Get TyCon TypeRepX rep_k <- getTypeRepX - case rep_k `eqTypeRep` (typeRep :: TypeRep Type) of + case typeRepKind rep_k `eqTypeRep` (typeRep :: TypeRep Type) of Just HRefl -> pure $ TypeRepX $ mkTrCon con rep_k Nothing -> failure "Kind mismatch" [ "Type constructor: " ++ show con From git at git.haskell.org Sun Jan 29 20:20:20 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:20:20 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Add a TestEquality TypeRep instance (82897d3) Message-ID: <20170129202020.5263D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/82897d30effa3b018de83e65e860d3769b423cbb/ghc >--------------------------------------------------------------- commit 82897d30effa3b018de83e65e860d3769b423cbb Author: Ben Gamari Date: Thu Sep 1 12:47:38 2016 -0400 Add a TestEquality TypeRep instance >--------------------------------------------------------------- 82897d30effa3b018de83e65e860d3769b423cbb libraries/base/Data/Typeable/Internal.hs | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs index 6237d25..bc10e36 100644 --- a/libraries/base/Data/Typeable/Internal.hs +++ b/libraries/base/Data/Typeable/Internal.hs @@ -85,6 +85,7 @@ import Data.Type.Equality import GHC.Word import GHC.Show import GHC.TypeLits( KnownNat, KnownSymbol, natVal', symbolVal' ) +import Data.Type.Equality import Unsafe.Coerce import GHC.Fingerprint.Type @@ -168,6 +169,11 @@ on f g = \ x y -> g x `f` g y instance Eq (TypeRep a) where (==) = (==) `on` typeRepFingerprint +instance TestEquality TypeRep where + testEquality a b + | typeRepFingerprint a == typeRepFingerprint b = Just (unsafeCoerce# Refl) + | otherwise = Nothing + -- | @since 4.4.0.0 instance Ord (TypeRep a) where compare = compare `on` typeRepFingerprint From git at git.haskell.org Sun Jan 29 20:20:23 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:20:23 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Fix it (0098ba2) Message-ID: <20170129202023.08AA23A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/0098ba28c5d651876ba2dd3c93bea7255cf1213c/ghc >--------------------------------------------------------------- commit 0098ba28c5d651876ba2dd3c93bea7255cf1213c Author: Ben Gamari Date: Wed Oct 5 08:08:53 2016 -0400 Fix it >--------------------------------------------------------------- 0098ba28c5d651876ba2dd3c93bea7255cf1213c compiler/prelude/TysWiredIn.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/prelude/TysWiredIn.hs b/compiler/prelude/TysWiredIn.hs index 8d59b80..ff95d3a 100644 --- a/compiler/prelude/TysWiredIn.hs +++ b/compiler/prelude/TysWiredIn.hs @@ -974,7 +974,7 @@ mk_sum :: Arity -> (TyCon, Array ConTagZ DataCon) mk_sum arity = (tycon, sum_cons) where tycon = mkSumTyCon tc_name tc_binders tc_res_kind (arity * 2) tyvars (elems sum_cons) - UnboxedAlgTyCon + (UnboxedAlgTyCon (mkPrelTyConRepName tc_name)) tc_binders = mkTemplateTyConBinders (nOfThem arity runtimeRepTy) (\ks -> map tYPE ks) From git at git.haskell.org Sun Jan 29 20:20:25 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:20:25 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Unpack the fingerprints (4b79d99) Message-ID: <20170129202025.B5C473A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/4b79d997a941ad8c17070219de60eff27fd9d6f9/ghc >--------------------------------------------------------------- commit 4b79d997a941ad8c17070219de60eff27fd9d6f9 Author: Ben Gamari Date: Mon Oct 3 21:49:59 2016 -0400 Unpack the fingerprints >--------------------------------------------------------------- 4b79d997a941ad8c17070219de60eff27fd9d6f9 libraries/base/Data/Typeable/Internal.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs index 4c064d6..c8558ed 100644 --- a/libraries/base/Data/Typeable/Internal.hs +++ b/libraries/base/Data/Typeable/Internal.hs @@ -153,9 +153,9 @@ rnfString (c:cs) = c `seq` rnfString cs -- | A concrete representation of a (monomorphic) type. -- 'TypeRep' supports reasonably efficient equality. data TypeRep (a :: k) where - TrTyCon :: !Fingerprint -> !TyCon -> TypeRep k -> TypeRep (a :: k) + TrTyCon :: {-# UNPACK #-} !Fingerprint -> !TyCon -> TypeRep k -> TypeRep (a :: k) TrApp :: forall k1 k2 (a :: k1 -> k2) (b :: k1). - !Fingerprint + {-# UNPACK #-} !Fingerprint -> TypeRep (a :: k1 -> k2) -> TypeRep (b :: k1) -> TypeRep (a b) From git at git.haskell.org Sun Jan 29 20:20:28 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:20:28 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Binary: Simple serialization test works (2a7b4e8) Message-ID: <20170129202028.6E4AE3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/2a7b4e811470ee1cc57dc3dff30f224a4e4ca2c3/ghc >--------------------------------------------------------------- commit 2a7b4e811470ee1cc57dc3dff30f224a4e4ca2c3 Author: Ben Gamari Date: Sun Jul 17 23:55:02 2016 +0200 Binary: Simple serialization test works >--------------------------------------------------------------- 2a7b4e811470ee1cc57dc3dff30f224a4e4ca2c3 compiler/utils/Binary.hs | 9 ++++++--- libraries/ghci/GHCi/TH/Binary.hs | 9 ++++++--- 2 files changed, 12 insertions(+), 6 deletions(-) diff --git a/compiler/utils/Binary.hs b/compiler/utils/Binary.hs index 8ac57bf..a82e55f 100644 --- a/compiler/utils/Binary.hs +++ b/compiler/utils/Binary.hs @@ -80,7 +80,7 @@ import Data.Time import Type.Reflection import Type.Reflection.Unsafe import Data.Kind (Type) -import GHC.Exts (RuntimeRep) +import GHC.Exts (TYPE, RuntimeRep) #else import Data.Typeable #endif @@ -583,11 +583,13 @@ instance Binary TyCon where #if MIN_VERSION_base(4,10,0) putTypeRep :: BinHandle -> TypeRep a -> IO () --- Special handling for Type, (->), and RuntimeRep due to recursive kind +-- Special handling for TYPE, (->), and RuntimeRep due to recursive kind -- relations. -- See Note [Mutually recursive representations of primitive types] putTypeRep bh rep | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep Type) + = put_ bh (5 :: Word8) + | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep TYPE) = put_ bh (0 :: Word8) | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep RuntimeRep) = put_ bh (1 :: Word8) @@ -607,7 +609,8 @@ getTypeRepX :: BinHandle -> IO TypeRepX getTypeRepX bh = do tag <- get bh :: IO Word8 case tag of - 0 -> return $ TypeRepX (typeRep :: TypeRep Type) + 5 -> return $ TypeRepX (typeRep :: TypeRep Type) + 0 -> return $ TypeRepX (typeRep :: TypeRep TYPE) 1 -> return $ TypeRepX (typeRep :: TypeRep RuntimeRep) 2 -> return $ TypeRepX (typeRep :: TypeRep (->)) 3 -> do con <- get bh :: IO TyCon diff --git a/libraries/ghci/GHCi/TH/Binary.hs b/libraries/ghci/GHCi/TH/Binary.hs index 267cc03..86960e2 100644 --- a/libraries/ghci/GHCi/TH/Binary.hs +++ b/libraries/ghci/GHCi/TH/Binary.hs @@ -14,7 +14,7 @@ import qualified Data.ByteString as B import Type.Reflection import Type.Reflection.Unsafe import Data.Kind (Type) -import GHC.Exts (RuntimeRep) +import GHC.Exts (TYPE, RuntimeRep) #else import Data.Typeable #endif @@ -85,11 +85,13 @@ instance Binary TyCon where get = mkTyCon <$> get <*> get <*> get putTypeRep :: TypeRep a -> Put --- Special handling for Type, (->), and RuntimeRep due to recursive kind +-- Special handling for TYPE, (->), and RuntimeRep due to recursive kind -- relations. -- See Note [Mutually recursive representations of primitive types] putTypeRep rep | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep Type) + = put (5 :: Word8) + | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep TYPE) = put (0 :: Word8) | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep RuntimeRep) = put (1 :: Word8) @@ -109,7 +111,8 @@ getTypeRepX :: Get TypeRepX getTypeRepX = do tag <- get :: Get Word8 case tag of - 0 -> return $ TypeRepX (typeRep :: TypeRep Type) + 5 -> return $ TypeRepX (typeRep :: TypeRep Type) + 0 -> return $ TypeRepX (typeRep :: TypeRep TYPE) 1 -> return $ TypeRepX (typeRep :: TypeRep RuntimeRep) 2 -> return $ TypeRepX (typeRep :: TypeRep (->)) 3 -> do con <- get :: Get TyCon From git at git.haskell.org Sun Jan 29 20:20:31 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:20:31 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Temporarily override submodule upstream repo paths (414aa45) Message-ID: <20170129202031.259F23A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/414aa451ea650809a79109a8e7b246863ceba0e5/ghc >--------------------------------------------------------------- commit 414aa451ea650809a79109a8e7b246863ceba0e5 Author: Ben Gamari Date: Fri Jul 29 18:24:26 2016 +0200 Temporarily override submodule upstream repo paths >--------------------------------------------------------------- 414aa451ea650809a79109a8e7b246863ceba0e5 .gitmodules | 26 +++++++++++++------------- 1 file changed, 13 insertions(+), 13 deletions(-) diff --git a/.gitmodules b/.gitmodules index 783c568..d2eda81 100644 --- a/.gitmodules +++ b/.gitmodules @@ -16,7 +16,7 @@ ignore = untracked [submodule "libraries/haskeline"] path = libraries/haskeline - url = ../packages/haskeline.git + url = git://github.com/bgamari/haskeline ignore = untracked [submodule "libraries/pretty"] path = libraries/pretty @@ -24,7 +24,7 @@ ignore = untracked [submodule "libraries/terminfo"] path = libraries/terminfo - url = ../packages/terminfo.git + url = git://github.com/bgamari/packages-terminfo ignore = untracked [submodule "libraries/transformers"] path = libraries/transformers @@ -56,43 +56,43 @@ ignore = untracked [submodule "libraries/array"] path = libraries/array - url = ../packages/array.git + url = git://github.com/bgamari/array ignore = none [submodule "libraries/deepseq"] path = libraries/deepseq - url = ../packages/deepseq.git + url = git://github.com/bgamari/deepseq ignore = none [submodule "libraries/directory"] path = libraries/directory - url = ../packages/directory.git + url = git://github.com/bgamari/directory ignore = none [submodule "libraries/filepath"] path = libraries/filepath - url = ../packages/filepath.git + url = git://github.com/bgamari/filepath ignore = none [submodule "libraries/hoopl"] path = libraries/hoopl - url = ../packages/hoopl.git + url = git://github.com/bgamari/hoopl ignore = none [submodule "libraries/hpc"] path = libraries/hpc - url = ../packages/hpc.git + url = git://github.com/bgamari/hpc ignore = none [submodule "libraries/process"] path = libraries/process - url = ../packages/process.git + url = git://github.com/bgamari/process ignore = none [submodule "libraries/unix"] path = libraries/unix - url = ../packages/unix.git + url = git://github.com/bgamari/unix ignore = none [submodule "libraries/parallel"] path = libraries/parallel - url = ../packages/parallel.git + url = git://github.com/bgamari/parallel ignore = none [submodule "libraries/stm"] path = libraries/stm - url = ../packages/stm.git + url = git://github.com/bgamari/packages-stm ignore = none [submodule "libraries/dph"] path = libraries/dph @@ -100,7 +100,7 @@ ignore = none [submodule "utils/haddock"] path = utils/haddock - url = ../haddock.git + url = git://github.com/bgamari/haddock ignore = none branch = ghc-head [submodule "nofib"] From git at git.haskell.org Sun Jan 29 20:20:33 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:20:33 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Begin reintroducing typeRepKind (d86c376) Message-ID: <20170129202033.D03473A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/d86c376d0419e90719354a3ab26944182ad4cc78/ghc >--------------------------------------------------------------- commit d86c376d0419e90719354a3ab26944182ad4cc78 Author: Ben Gamari Date: Tue Nov 29 19:39:28 2016 -0500 Begin reintroducing typeRepKind It's necessary. >--------------------------------------------------------------- d86c376d0419e90719354a3ab26944182ad4cc78 libraries/base/Data/Dynamic.hs | 1 + libraries/base/Data/Typeable/Internal.hs | 15 +++++++++++---- libraries/base/Type/Reflection.hs | 1 + 3 files changed, 13 insertions(+), 4 deletions(-) diff --git a/libraries/base/Data/Dynamic.hs b/libraries/base/Data/Dynamic.hs index 6dd5fe2..446ad36 100644 --- a/libraries/base/Data/Dynamic.hs +++ b/libraries/base/Data/Dynamic.hs @@ -137,6 +137,7 @@ fromDynamic (Dynamic t v) dynApply :: Dynamic -> Dynamic -> Maybe Dynamic dynApply (Dynamic (TRFun ta tr) f) (Dynamic ta' x) | Just HRefl <- ta `eqTypeRep` ta' + , Just HRefl <- typeRep @Type `eqTypeRep` typeRepKind tr = Just (Dynamic tr (f x)) dynApply _ _ = Nothing diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs index e97437e..a0cc89d 100644 --- a/libraries/base/Data/Typeable/Internal.hs +++ b/libraries/base/Data/Typeable/Internal.hs @@ -56,6 +56,7 @@ module Data.Typeable.Internal ( splitApp, rnfTypeRep, eqTypeRep, + typeRepKind, -- * SomeTypeRep SomeTypeRep(..), @@ -155,7 +156,7 @@ data TypeRep (a :: k) where -> TypeRep (a :: k1 -> k2) -> TypeRep (b :: k1) -> TypeRep (a b) - TrFun :: forall a b. + TrFun :: forall (r1 :: RuntimeRep) (r2 :: RuntimeRep) (a :: TYPE r1) (b :: TYPE r2). {-# UNPACK #-} !Fingerprint -> TypeRep a -> TypeRep b @@ -194,7 +195,7 @@ instance Ord SomeTypeRep where typeRepFingerprint a `compare` typeRepFingerprint b pattern TRFun :: forall fun. () - => forall arg res. (fun ~ (arg -> res)) + => forall (r1 :: RuntimeRep) (r2 :: RuntimeRep) (arg :: TYPE r1) (res :: TYPE r2). (fun ~ (arg -> res)) => TypeRep arg -> TypeRep res -> TypeRep fun @@ -291,6 +292,10 @@ eqTypeRep a b | typeRepFingerprint a == typeRepFingerprint b = Just (unsafeCoerce# HRefl) | otherwise = Nothing +-- | Observe the kind of a type. +typeRepKind :: TypeRep (a :: k) -> TypeRep k +typeRepKind a = undefined + ------------------------------------------------------------- -- -- The Typeable class and friends @@ -361,12 +366,14 @@ instance Show SomeTypeRep where showsPrec p (SomeTypeRep ty) = showsPrec p ty splitApps :: TypeRep a -> (TyCon, [SomeTypeRep]) -splitApps = go [] +splitApps = undefined --go [] + {- where go :: [SomeTypeRep] -> TypeRep a -> (TyCon, [SomeTypeRep]) go xs (TrTyCon _ tc _) = (tc, xs) go xs (TrApp _ f x) = go (SomeTypeRep x : xs) f go _ (TrFun _ _ _) = error "splitApps: FunTy" -- TODO +-} isListTyCon :: TyCon -> Bool isListTyCon tc = tc == typeRepTyCon (typeRep :: TypeRep [Int]) @@ -483,7 +490,7 @@ mkPrimTrCon tc kind_vars = TrTyCon fpr tc kind_vars mkPrimTyCon :: String -> TyCon mkPrimTyCon = mkTyCon "ghc-prim" "GHC.Prim" -mkTrFun :: forall a b. +mkTrFun :: forall (r1 :: RuntimeRep) (r2 :: RuntimeRep) (a :: TYPE r1) (b :: TYPE r2). TypeRep a -> TypeRep b -> TypeRep ((a -> b) :: Type) mkTrFun arg res = TrFun fpr arg res where fpr = undefined diff --git a/libraries/base/Type/Reflection.hs b/libraries/base/Type/Reflection.hs index 2c9605a..13b28d2 100644 --- a/libraries/base/Type/Reflection.hs +++ b/libraries/base/Type/Reflection.hs @@ -22,6 +22,7 @@ module Type.Reflection , I.splitApp , I.rnfTypeRep , I.eqTypeRep + , I.typeRepKind -- ** Quantified , I.SomeTypeRep(..) From git at git.haskell.org Sun Jan 29 20:20:36 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:20:36 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Rip out manual TypeReps (979b758) Message-ID: <20170129202036.88B3F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/979b758ca8072c430596aa54d8b9ae38ca68c482/ghc >--------------------------------------------------------------- commit 979b758ca8072c430596aa54d8b9ae38ca68c482 Author: Ben Gamari Date: Wed Nov 30 13:35:46 2016 -0500 Rip out manual TypeReps >--------------------------------------------------------------- 979b758ca8072c430596aa54d8b9ae38ca68c482 compiler/prelude/PrelNames.hs | 16 --------- compiler/prelude/TysPrim.hs | 5 +-- compiler/typecheck/TcInteract.hs | 6 +--- libraries/base/Data/Typeable/Internal.hs | 60 ++------------------------------ 4 files changed, 4 insertions(+), 83 deletions(-) diff --git a/compiler/prelude/PrelNames.hs b/compiler/prelude/PrelNames.hs index 323fc1c..2cb465a 100644 --- a/compiler/prelude/PrelNames.hs +++ b/compiler/prelude/PrelNames.hs @@ -238,11 +238,6 @@ basicKnownKeyNames mkTrFunName, typeSymbolTypeRepName, typeNatTypeRepName, trGhcPrimModuleName, - -- Representations - trTYPEName, - trTYPE'PtrRepLiftedName, - trRuntimeRepName, - tr'PtrRepLiftedName, -- Dynamic toDynName, @@ -1227,17 +1222,6 @@ typeSymbolTypeRepName = varQual tYPEABLE_INTERNAL (fsLit "typeSymbolTypeRep") ty -- this is the Typeable 'Module' for GHC.Prim (which has no code, so we place in GHC.Types) -- See Note [Grand plan for Typeable] in TcTypeable. trGhcPrimModuleName = varQual gHC_TYPES (fsLit "tr$ModuleGHCPrim") trGhcPrimModuleKey --- Representations for primitive types --- These are of type `TypeRep a` -trTYPEName - , trTYPE'PtrRepLiftedName - , trRuntimeRepName - , tr'PtrRepLiftedName - :: Name -trTYPEName = varQual tYPEABLE_INTERNAL (fsLit "trTYPE") trTYPEKey -trTYPE'PtrRepLiftedName = varQual tYPEABLE_INTERNAL (fsLit "trTYPE'PtrRepLifted") trTYPE'PtrRepLiftedKey -trRuntimeRepName = varQual tYPEABLE_INTERNAL (fsLit "trRuntimeRep") trRuntimeRepKey -tr'PtrRepLiftedName = varQual tYPEABLE_INTERNAL (fsLit "tr'PtrRepLifted") tr'PtrRepLiftedKey -- Custom type errors errorMessageTypeErrorFamName diff --git a/compiler/prelude/TysPrim.hs b/compiler/prelude/TysPrim.hs index 1ac4ad7..0f9e252 100644 --- a/compiler/prelude/TysPrim.hs +++ b/compiler/prelude/TysPrim.hs @@ -166,10 +166,7 @@ primTyCons -- See Note [Mutually recursive representations of primitive types] in -- "Data.Typeable.Internal" and Note [Grand plan for Typeable] in "TcTypeable". primTypeableTyCons :: NameEnv TyConRepName -primTypeableTyCons = mkNameEnv - [ (tYPETyConName, trTYPEName) - , (tyConName runtimeRepTyCon, trRuntimeRepName) - ] +primTypeableTyCons = mkNameEnv [] -- TODO: Remove me mkPrimTc :: FastString -> Unique -> TyCon -> Name mkPrimTc fs unique tycon diff --git a/compiler/typecheck/TcInteract.hs b/compiler/typecheck/TcInteract.hs index f1a0bc7..ff49d1a 100644 --- a/compiler/typecheck/TcInteract.hs +++ b/compiler/typecheck/TcInteract.hs @@ -25,8 +25,7 @@ import TcType import Name import PrelNames ( knownNatClassName, knownSymbolClassName, typeableClassName, coercibleTyConKey, - heqTyConKey, ipClassKey, - trTYPEName, trTYPE'PtrRepLiftedName, trRuntimeRepName ) + heqTyConKey, ipClassKey ) import TysWiredIn ( typeNatKind, typeSymbolKind, heqDataCon, coercibleDataCon, runtimeRepTy ) import TysPrim ( eqPrimTyCon, eqReprPrimTyCon, tYPETyCon ) @@ -2163,9 +2162,6 @@ matchTypeable clas [k,t] -- clas = Typeable -- Now cases that do work | k `eqType` typeNatKind = doTyLit knownNatClassName t | k `eqType` typeSymbolKind = doTyLit knownSymbolClassName t - | t `eqType` liftedTypeKind = doPrimRep trTYPE'PtrRepLiftedName t - | t `eqType` mkTyConTy tYPETyCon = doPrimRep trTYPEName t - | t `eqType` runtimeRepTy = doPrimRep trRuntimeRepName t | Just (arg,ret) <- splitFunTy_maybe t = doFunTy clas t arg ret | t `eqType` mkTyConTy funTyCon = return NoInstance --doPrimRep trArrowName t | Just (tc, ks) <- splitTyConApp_maybe t -- See Note [Typeable (T a b c)] diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs index cb1c807..db1ccb8 100644 --- a/libraries/base/Data/Typeable/Internal.hs +++ b/libraries/base/Data/Typeable/Internal.hs @@ -69,12 +69,6 @@ module Data.Typeable.Internal ( -- | These are for internal use only mkTrCon, mkTrApp, mkTyCon, mkTyCon#, typeSymbolTypeRep, typeNatTypeRep, - - -- * Representations for primitive types - trTYPE, - trTYPE'PtrRepLifted, - trRuntimeRep, - tr'PtrRepLifted, ) where import GHC.Base @@ -477,58 +471,8 @@ typeSymbolTypeRep p = typeLitTypeRep (show (symbolVal' p)) tcSymbol typeLitTypeRep :: forall (a :: k). (Typeable k) => String -> TyCon -> TypeRep a typeLitTypeRep nm kind_tycon = mkTrCon (mkTypeLitTyCon nm kind_tycon) [] -{- ********************************************************* -* * -* TyCon/TypeRep definitions for primitive types * -* (TYPE, RuntimeRep, (->) and promoted constructors) * -* * -********************************************************* -} - -{- -Note [Mutually recursive representations of primitive types] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -These primitive types exhibit mutual recursion through their kinds. - - TYPE :: RuntimeRep -> TYPE 'PtrRepLifted - RuntimeRep :: TYPE 'PtrRepLifted - 'PtrRepLifted :: RuntimeRep - (->) :: TYPE 'PtrRepLifted -> TYPE 'PtrRepLifted -> Type 'PtrRepLifted - TYPE 'PtrRepLifted :: TYPE 'PtrRepLifted - -For this reason we are forced to define their representations -manually. --} - --- | We can't use 'mkTrCon' here as it requires the fingerprint of the kind --- which is knot-tied. -mkPrimTrCon :: forall k (a :: k). TyCon -> [SomeTypeRep] -> TypeRep a -mkPrimTrCon tc kind_vars = TrTyCon fpr tc kind_vars - where - fpr_tc = tyConFingerprint tc - fpr_tag = fingerprintString "prim" - fpr = fingerprintFingerprints [fpr_tag, fpr_tc] - -mkPrimTyCon :: String -> TyCon -mkPrimTyCon = mkTyCon "ghc-prim" "GHC.Prim" - +-- | For compiler use. mkTrFun :: forall (r1 :: RuntimeRep) (r2 :: RuntimeRep) (a :: TYPE r1) (b :: TYPE r2). TypeRep a -> TypeRep b -> TypeRep ((a -> b) :: Type) mkTrFun arg res = TrFun fpr arg res - where fpr = undefined - -trTYPE :: TypeRep TYPE -trTYPE = mkPrimTrCon (mkPrimTyCon "TYPE") [] - -trRuntimeRep :: TypeRep RuntimeRep -trRuntimeRep = mkPrimTrCon (mkPrimTyCon "RuntimeRep") [] - -tr'PtrRepLifted :: TypeRep 'PtrRepLifted -tr'PtrRepLifted = mkPrimTrCon (mkPrimTyCon "'PtrRepLifted") [] - -trTYPE'PtrRepLifted :: TypeRep (TYPE 'PtrRepLifted) -trTYPE'PtrRepLifted = mkTrApp trTYPE tr'PtrRepLifted - --- Some useful aliases -star :: TypeRep (TYPE 'PtrRepLifted) -star = trTYPE'PtrRepLifted + where fpr = fingerprintFingerprints [typeRepFingerprint arg, typeRepFingerprint res] From git at git.haskell.org Sun Jan 29 20:20:39 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:20:39 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: TcTypeable: Fix it (7c41111) Message-ID: <20170129202039.3C6063A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/7c411111ced82df14bc5791667037013474a349f/ghc >--------------------------------------------------------------- commit 7c411111ced82df14bc5791667037013474a349f Author: Ben Gamari Date: Mon Dec 19 12:40:09 2016 -0500 TcTypeable: Fix it >--------------------------------------------------------------- 7c411111ced82df14bc5791667037013474a349f compiler/typecheck/TcTypeable.hs | 12 ++++++------ compiler/types/Kind.hs | 13 ++++++++++++- compiler/types/Type.hs-boot | 2 ++ 3 files changed, 20 insertions(+), 7 deletions(-) diff --git a/compiler/typecheck/TcTypeable.hs b/compiler/typecheck/TcTypeable.hs index 829d172..722b22f 100644 --- a/compiler/typecheck/TcTypeable.hs +++ b/compiler/typecheck/TcTypeable.hs @@ -20,11 +20,10 @@ import TysPrim ( primTyCons, primTypeableTyCons ) import TysWiredIn ( tupleTyCon ) import Id import Type -import Kind ( isConstraintKind ) +import Kind ( isTYPEApp ) import TyCon import DataCon -import Name ( getOccName, nameOccName ) -import Literal ( mkMachInt ) +import Name ( getOccName ) import OccName import Module import NameEnv @@ -350,7 +349,7 @@ mkTyConRepTyConRHS stuff@(Stuff {..}) tycon Fingerprint high low = fingerprintString hashThis int :: Int -> HsLit - int n = HsIntPrim (show n) (toInteger n) + int n = HsIntPrim (SourceText $ show n) (toInteger n) word64 :: Word64 -> HsLit word64 @@ -438,7 +437,8 @@ mkTyConKindRep (Stuff {..}) tycon = do t2' <- go bndrs t2 return $ nlHsApps (dataConWrapId kindRepAppDataCon) [t1', t2'] go _ ty | Just rr <- isTYPEApp ty - = pprTrace "mkTyConKeyRepBinds(TYPE)" (ppr rr) $ return $ nlHsApps (dataConWrapId kindRepTYPEDataCon) [rr] + = pprTrace "mkTyConKeyRepBinds(TYPE)" (ppr rr) $ + return $ nlHsApps (dataConWrapId kindRepTYPEDataCon) [nlHsVar $ dataConWrapId rr] go bndrs (TyConApp tycon tys) | Just rep_name <- tyConRepName_maybe tycon = do rep_id <- lookupId rep_name @@ -449,7 +449,7 @@ mkTyConKindRep (Stuff {..}) tycon = do ] | otherwise = pprPanic "UnrepresentableThingy" empty - go bndrs (ForAllTy (TvBndr var _) ty) + go _bndrs (ForAllTy (TvBndr var _) ty) = pprPanic "mkTyConKeyRepBinds(forall)" (ppr var $$ ppr ty) -- = let bndrs' = extendVarEnv (mapVarEnv (+1) bndrs) var 0 -- in go bndrs' ty diff --git a/compiler/types/Kind.hs b/compiler/types/Kind.hs index b67eec0..6b9567e 100644 --- a/compiler/types/Kind.hs +++ b/compiler/types/Kind.hs @@ -8,6 +8,7 @@ module Kind ( -- ** Predicates on Kinds isLiftedTypeKind, isUnliftedTypeKind, isConstraintKind, + isTYPEApp, returnsTyCon, returnsConstraintKind, isConstraintKindCon, okArrowArgKind, okArrowResultKind, @@ -19,7 +20,8 @@ module Kind ( #include "HsVersions.h" -import {-# SOURCE #-} Type ( typeKind, coreViewOneStarKind ) +import {-# SOURCE #-} Type ( typeKind, coreViewOneStarKind, splitTyConApp_maybe ) +import {-# SOURCE #-} DataCon ( DataCon ) import TyCoRep import TyCon @@ -68,6 +70,15 @@ isConstraintKindCon tc = tyConUnique tc == constraintKindTyConKey isConstraintKind (TyConApp tc _) = isConstraintKindCon tc isConstraintKind _ = False +isTYPEApp :: Kind -> Maybe DataCon +isTYPEApp (TyConApp tc args) + | tc `hasKey` tYPETyConKey + , [arg] <- args + , Just (tc, []) <- splitTyConApp_maybe arg + , Just dc <- isPromotedDataCon_maybe tc + = Just dc +isTYPEApp _ = Nothing + -- | Does the given type "end" in the given tycon? For example @k -> [a] -> *@ -- ends in @*@ and @Maybe a -> [a]@ ends in @[]@. returnsTyCon :: Unique -> Type -> Bool diff --git a/compiler/types/Type.hs-boot b/compiler/types/Type.hs-boot index 9436d19..5456dd7 100644 --- a/compiler/types/Type.hs-boot +++ b/compiler/types/Type.hs-boot @@ -19,3 +19,5 @@ partitionInvisibles :: TyCon -> (a -> Type) -> [a] -> ([a], [a]) coreView :: Type -> Maybe Type tyCoVarsOfTypesWellScoped :: [Type] -> [TyVar] + +splitTyConApp_maybe :: Type -> Maybe (TyCon, [Type]) \ No newline at end of file From git at git.haskell.org Sun Jan 29 20:20:42 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:20:42 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Getting there (a52df0a) Message-ID: <20170129202042.042553A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/a52df0aa973eb4f711f84f9d0d48391c5f478b8a/ghc >--------------------------------------------------------------- commit a52df0aa973eb4f711f84f9d0d48391c5f478b8a Author: Ben Gamari Date: Wed Nov 30 17:41:31 2016 -0500 Getting there >--------------------------------------------------------------- a52df0aa973eb4f711f84f9d0d48391c5f478b8a compiler/typecheck/TcTypeable.hs | 25 ++++++++++-- libraries/base/Data/Typeable/Internal.hs | 13 ++++-- libraries/base/Type/Reflection/Unsafe.hs | 2 + libraries/ghci/GHCi/TH/Binary.hs | 69 ++++++++++++++++++++++++++++++-- 4 files changed, 98 insertions(+), 11 deletions(-) diff --git a/compiler/typecheck/TcTypeable.hs b/compiler/typecheck/TcTypeable.hs index e057934..829d172 100644 --- a/compiler/typecheck/TcTypeable.hs +++ b/compiler/typecheck/TcTypeable.hs @@ -178,6 +178,17 @@ mkTypeableTyConBinds tycons ; stuff <- collect_stuff mod mod_expr ; let all_tycons = [ tc' | tc <- tycons, tc' <- tc : tyConATs tc ] -- We need type representations for any associated types + + -- First extend the type environment with all of the bindings which we + -- are going to produce since we may need to refer to them while + -- generating the RHSs + ; let tycon_rep_bndrs :: [Id] + tycon_rep_bndrs = [ rep_id + | tc <- all_tycons + , Just rep_id <- pure $ tyConRepId stuff tc + ] + ; gbl_env <- tcExtendGlobalValEnv tycon_rep_bndrs getGblEnv + ; foldlM (mk_typeable_binds stuff) gbl_env all_tycons } -- | Generate bindings for the type representation of a wired-in 'TyCon's defined @@ -297,15 +308,21 @@ mk_typeable_binds stuff gbl_env tycon (tyConDataCons tycon) typecheckAndAddBindings gbl_env' $ unionManyBags promoted_reps +-- | The 'Id' of the @TyCon@ binding for a type constructor. +tyConRepId :: TypeableStuff -> TyCon -> Maybe Id +tyConRepId (Stuff {..}) tycon + = mkRepId <$> tyConRepName_maybe tycon + where + mkRepId rep_name = mkExportedVanillaId rep_name (mkTyConTy trTyConTyCon) + -- | Make typeable bindings for the given 'TyCon'. mkTyConRepBinds :: TypeableStuff -> TyCon -> TcRn (LHsBinds Id) mkTyConRepBinds stuff@(Stuff {..}) tycon = pprTrace "mkTyConRepBinds" (ppr tycon) $ - case tyConRepName_maybe tycon of - Just rep_name -> do + case tyConRepId stuff tycon of + Just tycon_rep_id -> do tycon_rep_rhs <- mkTyConRepTyConRHS stuff tycon - let tycon_rep_id = mkExportedVanillaId rep_name (mkTyConTy trTyConTyCon) - tycon_rep = mkVarBind tycon_rep_id tycon_rep_rhs + let tycon_rep = mkVarBind tycon_rep_id tycon_rep_rhs return $ unitBag tycon_rep _ -> return emptyBag diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs index db1ccb8..773d2ca 100644 --- a/libraries/base/Data/Typeable/Internal.hs +++ b/libraries/base/Data/Typeable/Internal.hs @@ -43,7 +43,8 @@ module Data.Typeable.Internal ( -- * TyCon TyCon, -- Abstract - tyConPackage, tyConModule, tyConName, + tyConPackage, tyConModule, tyConName, tyConKindVars, tyConKindRep, + KindRep(..), rnfTyCon, -- * TypeRep @@ -117,6 +118,12 @@ tyConFingerprint :: TyCon -> Fingerprint tyConFingerprint (TyCon hi lo _ _ _ _) = Fingerprint (W64# hi) (W64# lo) +tyConKindVars :: TyCon -> Int +tyConKindVars (TyCon _ _ _ _ n _) = I# n + +tyConKindRep :: TyCon -> KindRep +tyConKindRep (TyCon _ _ _ _ _ k) = k + -- | Helper to fully evaluate 'TyCon' for use as @NFData(rnf)@ implementation -- -- @since 4.8.0.0 @@ -202,8 +209,8 @@ instance Ord SomeTypeRep where SomeTypeRep a `compare` SomeTypeRep b = typeRepFingerprint a `compare` typeRepFingerprint b -pattern TRFun :: forall fun. () - => forall (r1 :: RuntimeRep) (r2 :: RuntimeRep) (arg :: TYPE r1) (res :: TYPE r2). (fun ~ (arg -> res)) +pattern TRFun :: forall k (fun :: k). () + => forall (r1 :: RuntimeRep) (r2 :: RuntimeRep) (arg :: TYPE r1) (res :: TYPE r2). (k ~ Type, fun ~~ (arg -> res)) => TypeRep arg -> TypeRep res -> TypeRep fun diff --git a/libraries/base/Type/Reflection/Unsafe.hs b/libraries/base/Type/Reflection/Unsafe.hs index d1897f3..b9f71be 100644 --- a/libraries/base/Type/Reflection/Unsafe.hs +++ b/libraries/base/Type/Reflection/Unsafe.hs @@ -14,6 +14,8 @@ ----------------------------------------------------------------------------- module Type.Reflection.Unsafe ( + tyConKindRep, tyConKindVars, + KindRep(..), mkTrCon, mkTrApp, mkTyCon ) where diff --git a/libraries/ghci/GHCi/TH/Binary.hs b/libraries/ghci/GHCi/TH/Binary.hs index 617cb7c..13f62a6 100644 --- a/libraries/ghci/GHCi/TH/Binary.hs +++ b/libraries/ghci/GHCi/TH/Binary.hs @@ -14,7 +14,7 @@ import qualified Data.ByteString as B import Type.Reflection import Type.Reflection.Unsafe import Data.Kind (Type) -import GHC.Exts (TYPE, RuntimeRep) +import GHC.Exts (TYPE, RuntimeRep(..), VecCount, VecElem) #else import Data.Typeable #endif @@ -80,9 +80,70 @@ instance Binary TH.PatSynArgs -- We need Binary TypeRep for serializing annotations #if MIN_VERSION_base(4,10,0) +instance Binary VecCount where + put = putWord8 . fromIntegral . fromEnum + get = toEnum . fromIntegral <$> getWord8 + +instance Binary VecElem where + put = putWord8 . fromIntegral . fromEnum + get = toEnum . fromIntegral <$> getWord8 + +instance Binary RuntimeRep where + put (VecRep a b) = putWord8 0 >> put a >> put b + put PtrRepLifted = putWord8 1 + put PtrRepUnlifted = putWord8 2 + put VoidRep = putWord8 3 + put IntRep = putWord8 4 + put WordRep = putWord8 5 + put Int64Rep = putWord8 6 + put Word64Rep = putWord8 7 + put AddrRep = putWord8 8 + put FloatRep = putWord8 9 + put DoubleRep = putWord8 10 + put UnboxedTupleRep = putWord8 11 + put UnboxedSumRep = putWord8 12 + + get = do + tag <- getWord8 + case tag of + 0 -> VecRep <$> get <*> get + 1 -> pure PtrRepLifted + 2 -> pure PtrRepUnlifted + 3 -> pure VoidRep + 4 -> pure IntRep + 5 -> pure WordRep + 6 -> pure Int64Rep + 7 -> pure Word64Rep + 8 -> pure AddrRep + 9 -> pure FloatRep + 10 -> pure DoubleRep + 11 -> pure UnboxedTupleRep + 12 -> pure UnboxedSumRep + instance Binary TyCon where - put tc = put (tyConPackage tc) >> put (tyConModule tc) >> put (tyConName tc) - get = mkTyCon <$> get <*> get <*> get + put tc = do + put (tyConPackage tc) + put (tyConModule tc) + put (tyConName tc) + put (tyConKindVars tc) + put (tyConKindRep tc) + get = mkTyCon <$> get <*> get <*> get <*> get <*> get + +instance Binary KindRep where + put (KindRepTyConApp tc k) = putWord8 0 >> put tc >> put k + put (KindRepVar bndr) = putWord8 1 >> put bndr + put (KindRepApp a b) = putWord8 2 >> put a >> put b + put (KindRepFun a b) = putWord8 3 >> put a >> put b + put (KindRepTYPE r) = putWord8 4 >> put r + + get = do + tag <- getWord8 + case tag of + 0 -> KindRepTyConApp <$> get <*> get + 1 -> KindRepVar <$> get + 2 -> KindRepApp <$> get <*> get + 3 -> KindRepFun <$> get <*> get + 4 -> KindRepTYPE <$> get putTypeRep :: TypeRep a -> Put -- Special handling for TYPE, (->), and RuntimeRep due to recursive kind @@ -120,7 +181,7 @@ getSomeTypeRep = do 3 -> do con <- get :: Get TyCon SomeTypeRep rep_k <- getSomeTypeRep ks <- get :: Get [SomeTypeRep] - return $ mkTrCon con ks + return $ SomeTypeRep $ mkTrCon con ks 4 -> do SomeTypeRep f <- getSomeTypeRep SomeTypeRep x <- getSomeTypeRep From git at git.haskell.org Sun Jan 29 20:20:44 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:20:44 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Continue reintroduction of kind representations (1a644df) Message-ID: <20170129202044.B74243A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/1a644df32be7802948cfe1c9d4d34d86f4d754e7/ghc >--------------------------------------------------------------- commit 1a644df32be7802948cfe1c9d4d34d86f4d754e7 Author: Ben Gamari Date: Tue Nov 29 23:48:05 2016 -0500 Continue reintroduction of kind representations >--------------------------------------------------------------- 1a644df32be7802948cfe1c9d4d34d86f4d754e7 compiler/basicTypes/OccName.hs | 5 +-- compiler/prelude/PrelNames.hs | 31 ++++++++++++++++-- compiler/prelude/THNames.hs | 32 +++++++++---------- compiler/typecheck/TcTypeable.hs | 68 ++++++++++++++++++++++++++-------------- libraries/ghc-prim/GHC/Types.hs | 15 +++++++++ 5 files changed, 107 insertions(+), 44 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 1a644df32be7802948cfe1c9d4d34d86f4d754e7 From git at git.haskell.org Sun Jan 29 20:20:47 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:20:47 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Enum Vec* (f74e8f2) Message-ID: <20170129202047.748393A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/f74e8f2cefc8b70d509a2c17e9c221070a3afae0/ghc >--------------------------------------------------------------- commit f74e8f2cefc8b70d509a2c17e9c221070a3afae0 Author: Ben Gamari Date: Wed Nov 30 17:41:40 2016 -0500 Enum Vec* >--------------------------------------------------------------- f74e8f2cefc8b70d509a2c17e9c221070a3afae0 libraries/base/GHC/Enum.hs | 52 +++++++++++++++++++++++++++++++++++++++++----- 1 file changed, 47 insertions(+), 5 deletions(-) diff --git a/libraries/base/GHC/Enum.hs b/libraries/base/GHC/Enum.hs index 2cec6c6..7c41123 100644 --- a/libraries/base/GHC/Enum.hs +++ b/libraries/base/GHC/Enum.hs @@ -878,8 +878,50 @@ dn_list x0 delta lim = go (x0 :: Integer) | otherwise = x : go (x+delta) -- Instances from GHC.Types -deriving instance Bounded VecCount -deriving instance Enum VecCount - -deriving instance Bounded VecElem -deriving instance Enum VecElem +instance Bounded VecCount where + minBound = Vec2 + maxBound = Vec64 + +instance Enum VecCount where + fromEnum Vec2 = 0 + fromEnum Vec4 = 1 + fromEnum Vec8 = 2 + fromEnum Vec16 = 3 + fromEnum Vec32 = 4 + fromEnum Vec64 = 5 + + toEnum 0 = Vec2 + toEnum 1 = Vec4 + toEnum 2 = Vec8 + toEnum 3 = Vec16 + toEnum 4 = Vec32 + toEnum 5 = Vec64 + toEnum _ = error "Enum(VecCount): Invalid index" + +instance Bounded VecElem where + minBound = Int8ElemRep + maxBound = DoubleElemRep + +instance Enum VecElem where + fromEnum Int8ElemRep = 0 + fromEnum Int16ElemRep = 1 + fromEnum Int32ElemRep = 2 + fromEnum Int64ElemRep = 3 + fromEnum Word8ElemRep = 4 + fromEnum Word16ElemRep = 5 + fromEnum Word32ElemRep = 6 + fromEnum Word64ElemRep = 7 + fromEnum FloatElemRep = 8 + fromEnum DoubleElemRep = 9 + + toEnum 0 = Int8ElemRep + toEnum 1 = Int16ElemRep + toEnum 2 = Int32ElemRep + toEnum 3 = Int64ElemRep + toEnum 4 = Word8ElemRep + toEnum 5 = Word16ElemRep + toEnum 6 = Word32ElemRep + toEnum 7 = Word64ElemRep + toEnum 8 = FloatElemRep + toEnum 9 = DoubleElemRep + toEnum _ = error "Enum(VecElem): Invalid index" From git at git.haskell.org Sun Jan 29 20:20:50 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:20:50 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Continue (2c2c2c6) Message-ID: <20170129202050.35A2C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/2c2c2c6a3714cbbdfa95573daead7ee3b1e1c988/ghc >--------------------------------------------------------------- commit 2c2c2c6a3714cbbdfa95573daead7ee3b1e1c988 Author: Ben Gamari Date: Wed Nov 30 13:18:05 2016 -0500 Continue >--------------------------------------------------------------- 2c2c2c6a3714cbbdfa95573daead7ee3b1e1c988 compiler/typecheck/TcTypeable.hs | 193 ++++++++++++++++++++++++------- libraries/base/Data/Typeable/Internal.hs | 58 +++++++--- libraries/base/GHC/Show.hs | 2 +- libraries/ghc-prim/GHC/Classes.hs | 8 +- libraries/ghc-prim/GHC/Types.hs | 6 +- 5 files changed, 202 insertions(+), 65 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 2c2c2c6a3714cbbdfa95573daead7ee3b1e1c988 From git at git.haskell.org Sun Jan 29 20:20:52 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:20:52 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Begin reverting to Simon's story (611e199) Message-ID: <20170129202052.EAD2E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/611e199393d9e63ff2aa98dbc3275e43efaa74e0/ghc >--------------------------------------------------------------- commit 611e199393d9e63ff2aa98dbc3275e43efaa74e0 Author: Ben Gamari Date: Fri Nov 18 11:39:42 2016 -0500 Begin reverting to Simon's story >--------------------------------------------------------------- 611e199393d9e63ff2aa98dbc3275e43efaa74e0 compiler/deSugar/DsBinds.hs | 15 ++++++-- compiler/prelude/PrelNames.hs | 13 +++++-- compiler/typecheck/TcEvidence.hs | 9 ++--- compiler/typecheck/TcHsSyn.hs | 2 +- compiler/typecheck/TcInteract.hs | 10 +++--- compiler/utils/Binary.hs | 15 +++++--- libraries/base/Data/Dynamic.hs | 1 - libraries/base/Data/Typeable/Internal.hs | 61 ++++++++++++-------------------- libraries/base/Type/Reflection.hs | 3 +- libraries/ghci/GHCi/TH/Binary.hs | 20 +++++------ 10 files changed, 77 insertions(+), 72 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 611e199393d9e63ff2aa98dbc3275e43efaa74e0 From git at git.haskell.org Sun Jan 29 20:20:55 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:20:55 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: base: Derive Enum, Bounded for VecCount, VecElem (be9f9f2) Message-ID: <20170129202055.A469F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/be9f9f2bc7809ba78569f05a46dc2894152304ba/ghc >--------------------------------------------------------------- commit be9f9f2bc7809ba78569f05a46dc2894152304ba Author: Ben Gamari Date: Wed Nov 30 15:45:08 2016 -0500 base: Derive Enum, Bounded for VecCount, VecElem >--------------------------------------------------------------- be9f9f2bc7809ba78569f05a46dc2894152304ba compiler/prelude/TysWiredIn.hs | 4 ++-- libraries/base/GHC/Enum.hs | 7 +++++++ libraries/ghc-prim/GHC/Types.hs | 2 ++ 3 files changed, 11 insertions(+), 2 deletions(-) diff --git a/compiler/prelude/TysWiredIn.hs b/compiler/prelude/TysWiredIn.hs index ff95d3a..ace7444 100644 --- a/compiler/prelude/TysWiredIn.hs +++ b/compiler/prelude/TysWiredIn.hs @@ -1168,7 +1168,7 @@ liftedRepDataConTy, unliftedRepDataConTy, = map (mkTyConTy . promoteDataCon) runtimeRepSimpleDataCons vecCountTyCon :: TyCon -vecCountTyCon = pcNonEnumTyCon vecCountTyConName Nothing [] +vecCountTyCon = pcTyCon True vecCountTyConName Nothing [] vecCountDataCons -- See Note [Wiring in RuntimeRep] @@ -1187,7 +1187,7 @@ vec2DataConTy, vec4DataConTy, vec8DataConTy, vec16DataConTy, vec32DataConTy, vec64DataConTy] = map (mkTyConTy . promoteDataCon) vecCountDataCons vecElemTyCon :: TyCon -vecElemTyCon = pcNonEnumTyCon vecElemTyConName Nothing [] vecElemDataCons +vecElemTyCon = pcTyCon True vecElemTyConName Nothing [] vecElemDataCons -- See Note [Wiring in RuntimeRep] vecElemDataCons :: [DataCon] diff --git a/libraries/base/GHC/Enum.hs b/libraries/base/GHC/Enum.hs index 50ca4a0..2cec6c6 100644 --- a/libraries/base/GHC/Enum.hs +++ b/libraries/base/GHC/Enum.hs @@ -876,3 +876,10 @@ dn_list x0 delta lim = go (x0 :: Integer) where go x | x < lim = [] | otherwise = x : go (x+delta) + +-- Instances from GHC.Types +deriving instance Bounded VecCount +deriving instance Enum VecCount + +deriving instance Bounded VecElem +deriving instance Enum VecElem diff --git a/libraries/ghc-prim/GHC/Types.hs b/libraries/ghc-prim/GHC/Types.hs index d36739e..b71559a 100644 --- a/libraries/ghc-prim/GHC/Types.hs +++ b/libraries/ghc-prim/GHC/Types.hs @@ -395,6 +395,7 @@ data VecCount = Vec2 | Vec16 | Vec32 | Vec64 +-- Enum, Bounded instances in GHC.Enum -- | Element of a SIMD vector type data VecElem = Int8ElemRep @@ -407,6 +408,7 @@ data VecElem = Int8ElemRep | Word64ElemRep | FloatElemRep | DoubleElemRep +-- Enum, Bounded instances in GHC.Enum {- ********************************************************************* * * From git at git.haskell.org Sun Jan 29 20:20:58 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:20:58 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Message: Fix it (2fa2dae) Message-ID: <20170129202058.64DDB3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/2fa2dae3db3a86f41a20c62bcba64323d00408a6/ghc >--------------------------------------------------------------- commit 2fa2dae3db3a86f41a20c62bcba64323d00408a6 Author: Ben Gamari Date: Tue Jan 3 00:35:58 2017 -0500 Message: Fix it >--------------------------------------------------------------- 2fa2dae3db3a86f41a20c62bcba64323d00408a6 libraries/ghci/GHCi/Message.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/ghci/GHCi/Message.hs b/libraries/ghci/GHCi/Message.hs index b22833f..85dd75c 100644 --- a/libraries/ghci/GHCi/Message.hs +++ b/libraries/ghci/GHCi/Message.hs @@ -377,7 +377,7 @@ fromSerializableException (EOtherException str) = toException (ErrorCall str) -- as the minimum instance Binary ExitCode where put ExitSuccess = putWord8 0 - put (ExitFailure ec) = putWord8 1 `mappend` put ec + put (ExitFailure ec) = putWord8 1 >> put ec get = do w <- getWord8 case w of From git at git.haskell.org Sun Jan 29 20:21:01 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:21:01 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Things (e912ddf) Message-ID: <20170129202101.2B6323A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/e912ddf6f3862147f5f3e0bf6f233a7c5ce1391e/ghc >--------------------------------------------------------------- commit e912ddf6f3862147f5f3e0bf6f233a7c5ce1391e Author: Ben Gamari Date: Thu Jan 19 16:13:40 2017 -0500 Things >--------------------------------------------------------------- e912ddf6f3862147f5f3e0bf6f233a7c5ce1391e compiler/prelude/TysPrim.hs | 168 +++++++++++++++++---------------------- compiler/typecheck/TcInteract.hs | 4 +- compiler/typecheck/TcTypeable.hs | 14 +--- 3 files changed, 76 insertions(+), 110 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc e912ddf6f3862147f5f3e0bf6f233a7c5ce1391e From git at git.haskell.org Sun Jan 29 20:21:03 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:21:03 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: ghc-bin: Bump time bound (d53585c) Message-ID: <20170129202103.E72193A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/d53585cd08926e852d0c93d543783f459b7cef66/ghc >--------------------------------------------------------------- commit d53585cd08926e852d0c93d543783f459b7cef66 Author: Ben Gamari Date: Thu Jan 19 15:20:05 2017 -0500 ghc-bin: Bump time bound >--------------------------------------------------------------- d53585cd08926e852d0c93d543783f459b7cef66 ghc/ghc-bin.cabal.in | 2 +- libraries/hpc | 2 +- libraries/time | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/ghc/ghc-bin.cabal.in b/ghc/ghc-bin.cabal.in index 9c9ca0e..0f50453 100644 --- a/ghc/ghc-bin.cabal.in +++ b/ghc/ghc-bin.cabal.in @@ -52,7 +52,7 @@ Executable ghc deepseq == 1.4.*, ghci == @ProjectVersionMunged@, haskeline == 0.7.*, - time == 1.7.*, + time == 1.8.*, transformers == 0.5.* CPP-Options: -DGHCI GHC-Options: -fno-warn-name-shadowing diff --git a/libraries/hpc b/libraries/hpc index 9267329..8625c1c 160000 --- a/libraries/hpc +++ b/libraries/hpc @@ -1 +1 @@ -Subproject commit 92673292ab7ce7878e982d0a02df3e548ef15b52 +Subproject commit 8625c1c0550719437acad89d49401cf048990084 diff --git a/libraries/time b/libraries/time index b6098be..ee8fe45 160000 --- a/libraries/time +++ b/libraries/time @@ -1 +1 @@ -Subproject commit b6098be8a4facfa854c633f2a3a82ab8e72962ef +Subproject commit ee8fe452fa45f6d78f8ce6deedb88b20eb3d5f42 From git at git.haskell.org Sun Jan 29 20:21:06 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:21:06 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Fix up submodules (0d039fa) Message-ID: <20170129202106.A18AE3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/0d039facb7e7092ed665b2d4bcec86e0595da1f1/ghc >--------------------------------------------------------------- commit 0d039facb7e7092ed665b2d4bcec86e0595da1f1 Author: Ben Gamari Date: Mon Dec 19 12:43:46 2016 -0500 Fix up submodules >--------------------------------------------------------------- 0d039facb7e7092ed665b2d4bcec86e0595da1f1 libraries/parallel | 2 +- libraries/stm | 2 +- libraries/terminfo | 2 +- libraries/unix | 2 +- libraries/xhtml | 2 +- utils/haddock | 2 +- 6 files changed, 6 insertions(+), 6 deletions(-) diff --git a/libraries/parallel b/libraries/parallel index 040c4f0..829ff3a 160000 --- a/libraries/parallel +++ b/libraries/parallel @@ -1 +1 @@ -Subproject commit 040c4f0226a5a9a1e720d89a9e1239028d9f62d9 +Subproject commit 829ff3ae248fe05b74bfea30e285dd0ff50424ea diff --git a/libraries/stm b/libraries/stm index 9c3c3bb..f549f65 160000 --- a/libraries/stm +++ b/libraries/stm @@ -1 +1 @@ -Subproject commit 9c3c3bb28834d1ba9574be7f887c8914afd4232c +Subproject commit f549f65a2fcc85b7ff8648bed2543e8b192ea27d diff --git a/libraries/terminfo b/libraries/terminfo index 6ab1dff..d9c6c52 160000 --- a/libraries/terminfo +++ b/libraries/terminfo @@ -1 +1 @@ -Subproject commit 6ab1dffebc0665dd347eba351a495dd80032d0e5 +Subproject commit d9c6c5257bf392fb4bca92ad0777a719b57a2794 diff --git a/libraries/unix b/libraries/unix index d0b0e8c..901b0b9 160000 --- a/libraries/unix +++ b/libraries/unix @@ -1 +1 @@ -Subproject commit d0b0e8cf5a7fa5b9dc500d2f623258200818cb16 +Subproject commit 901b0b9c2faa2d48a68861c5277774e1a540e1cb diff --git a/libraries/xhtml b/libraries/xhtml index 45e5cb8..fb9e0bb 160000 --- a/libraries/xhtml +++ b/libraries/xhtml @@ -1 +1 @@ -Subproject commit 45e5cb820a129780407bc37968364e4f64174f7d +Subproject commit fb9e0bbb69e15873682a9f25d39652099a3ccac1 diff --git a/utils/haddock b/utils/haddock index 7f1987b..b8cb056 160000 --- a/utils/haddock +++ b/utils/haddock @@ -1 +1 @@ -Subproject commit 7f1987b35eb7bb15ca2fd93321440af519dd8cd5 +Subproject commit b8cb056c5bb6d4b5ba08af18175edfacd68055b5 From git at git.haskell.org Sun Jan 29 20:21:09 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:21:09 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Fix it (5988da0) Message-ID: <20170129202109.58C8F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/5988da0bfde10d25c73bd44f4554cac30d290e30/ghc >--------------------------------------------------------------- commit 5988da0bfde10d25c73bd44f4554cac30d290e30 Author: Ben Gamari Date: Thu Jan 19 15:56:48 2017 -0500 Fix it >--------------------------------------------------------------- 5988da0bfde10d25c73bd44f4554cac30d290e30 compiler/types/TyCon.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/types/TyCon.hs b/compiler/types/TyCon.hs index cd57fae..1c749dc 100644 --- a/compiler/types/TyCon.hs +++ b/compiler/types/TyCon.hs @@ -2056,7 +2056,7 @@ isTcTyCon _ = False -- Precondition: The fully-applied TyCon has kind (TYPE blah) isTcLevPoly :: TyCon -> Bool isTcLevPoly FunTyCon{} = False -isTcLevPoly (AlgTyCon { algTcParent = UnboxedAlgTyCon }) = True +isTcLevPoly (AlgTyCon { algTcParent = UnboxedAlgTyCon _ }) = True isTcLevPoly AlgTyCon{} = False isTcLevPoly SynonymTyCon{} = True isTcLevPoly FamilyTyCon{} = True From git at git.haskell.org Sun Jan 29 20:21:12 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:21:12 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: TcTypeable: Kill tracing (2fc04db) Message-ID: <20170129202112.173B03A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/2fc04db5086c31c8ccdc498a9b71552558ecc376/ghc >--------------------------------------------------------------- commit 2fc04db5086c31c8ccdc498a9b71552558ecc376 Author: Ben Gamari Date: Tue Dec 20 00:13:30 2016 -0500 TcTypeable: Kill tracing >--------------------------------------------------------------- 2fc04db5086c31c8ccdc498a9b71552558ecc376 compiler/typecheck/TcTypeable.hs | 20 ++++++-------------- 1 file changed, 6 insertions(+), 14 deletions(-) diff --git a/compiler/typecheck/TcTypeable.hs b/compiler/typecheck/TcTypeable.hs index 0400871..e2134b3 100644 --- a/compiler/typecheck/TcTypeable.hs +++ b/compiler/typecheck/TcTypeable.hs @@ -187,13 +187,7 @@ mkTypeableTyConBinds mod_id tycons , tc' <- tc : promoted , Just rep_id <- pure $ tyConRepId stuff tc' ] - ; gbl_env <- pprTrace "typeable tycons" (ppr $ map (\x -> (x, tyConRepId stuff x)) all_tycons) - $ pprTrace "typeable tycons'" (ppr [ (tc', promoted, tyConRepId stuff tc') - | tc <- all_tycons - , let promoted = map promoteDataCon (tyConDataCons tc) - , tc' <- tc:promoted ]) - $ pprTrace "typeable binders" (ppr tycon_rep_bndrs) $ - tcExtendGlobalValEnv tycon_rep_bndrs getGblEnv + ; gbl_env <- tcExtendGlobalValEnv tycon_rep_bndrs getGblEnv ; setGblEnv gbl_env $ foldlM (mk_typeable_binds stuff) gbl_env all_tycons } @@ -206,7 +200,7 @@ mkPrimTypeableBinds :: TcM TcGblEnv mkPrimTypeableBinds = do { mod <- getModule ; if mod == gHC_TYPES - then do { trModuleTyCon <- pprTrace "mkPrimTypeableBinds" (ppr $ map tyConName ghcPrimTypeableTyCons) $ tcLookupTyCon trModuleTyConName + then do { trModuleTyCon <- tcLookupTyCon trModuleTyConName ; let ghc_prim_module_id = mkExportedVanillaId trGhcPrimModuleName (mkTyConTy trModuleTyCon) @@ -293,7 +287,7 @@ mkTrNameLit = do mk_typeable_binds :: TypeableStuff -> TcGblEnv -> TyCon -> TcM TcGblEnv mk_typeable_binds stuff gbl_env tycon = do binds <- mkTyConRepBinds stuff tycon - let gbl_env' = pprTrace "mk_typeable_binds" (ppr binds) $ gbl_env `addTypecheckedBinds` [binds] + let gbl_env' = gbl_env `addTypecheckedBinds` [binds] setGblEnv gbl_env' $ do promoted_reps <- mapM (mkTyConRepBinds stuff . promoteDataCon) (tyConDataCons tycon) @@ -309,8 +303,7 @@ tyConRepId (Stuff {..}) tycon -- | Make typeable bindings for the given 'TyCon'. mkTyConRepBinds :: TypeableStuff -> TyCon -> TcRn (LHsBinds Id) mkTyConRepBinds stuff@(Stuff {..}) tycon - = pprTrace "mkTyConRepBinds" (ppr tycon) $ - case tyConRepId stuff tycon of + = case tyConRepId stuff tycon of Just tycon_rep_id -> do tycon_rep_rhs <- mkTyConRepTyConRHS stuff tycon let tycon_rep = mkVarBind tycon_rep_id tycon_rep_rhs @@ -415,7 +408,7 @@ mkTyConKindRep :: TypeableStuff -> TyCon -> TcRn (LHsExpr Id) mkTyConKindRep (Stuff {..}) tycon = do let bndrs = mkVarEnv $ (`zip` [0..]) $ map binderVar $ reverse $ filter isNamedTyConBinder (tyConBinders tycon) - pprTrace "mkTyConKeyRepBinds" (ppr tycon <+> pprType' (tyConKind tycon)) $ go bndrs (tyConResKind tycon) + go bndrs (tyConResKind tycon) where -- Compute RHS go :: VarEnv Int -> Kind -> TcRn (LHsExpr Id) @@ -430,8 +423,7 @@ mkTyConKindRep (Stuff {..}) tycon = do t2' <- go bndrs t2 return $ nlHsApps (dataConWrapId kindRepAppDataCon) [t1', t2'] go _ ty | Just rr <- isTYPEApp ty - = pprTrace "mkTyConKeyRepBinds(type)" (ppr rr) $ - return $ nlHsApps (dataConWrapId kindRepTYPEDataCon) [nlHsVar $ dataConWrapId rr] + = return $ nlHsApps (dataConWrapId kindRepTYPEDataCon) [nlHsVar $ dataConWrapId rr] go bndrs (TyConApp tycon tys) | Just rep_name <- tyConRepName_maybe tycon = do rep_id <- lookupId rep_name From git at git.haskell.org Sun Jan 29 20:21:14 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:21:14 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: TcTypeable: It compiles GHC.Types! (cc90a29) Message-ID: <20170129202114.C6B623A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/cc90a2937fde651a3dd8db0e29505fe5b8cacad4/ghc >--------------------------------------------------------------- commit cc90a2937fde651a3dd8db0e29505fe5b8cacad4 Author: Ben Gamari Date: Tue Dec 20 00:12:33 2016 -0500 TcTypeable: It compiles GHC.Types! >--------------------------------------------------------------- cc90a2937fde651a3dd8db0e29505fe5b8cacad4 compiler/typecheck/TcTypeable.hs | 99 +++++++++++++++++++++------------------- 1 file changed, 51 insertions(+), 48 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc cc90a2937fde651a3dd8db0e29505fe5b8cacad4 From git at git.haskell.org Sun Jan 29 20:21:17 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:21:17 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Revert "TcTypeable: Kill tracing" (5554455) Message-ID: <20170129202117.7A0683A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/555445542eea4ca8ac7d811b0c0b9706eb6bf174/ghc >--------------------------------------------------------------- commit 555445542eea4ca8ac7d811b0c0b9706eb6bf174 Author: Ben Gamari Date: Thu Jan 19 21:12:21 2017 -0500 Revert "TcTypeable: Kill tracing" This reverts commit 7f16ece736023cf5f28d3dbb5629564805978ec2. >--------------------------------------------------------------- 555445542eea4ca8ac7d811b0c0b9706eb6bf174 compiler/typecheck/TcTypeable.hs | 20 ++++++++++++++------ 1 file changed, 14 insertions(+), 6 deletions(-) diff --git a/compiler/typecheck/TcTypeable.hs b/compiler/typecheck/TcTypeable.hs index b33dff7..7b7e0ed 100644 --- a/compiler/typecheck/TcTypeable.hs +++ b/compiler/typecheck/TcTypeable.hs @@ -185,7 +185,13 @@ mkTypeableTyConBinds mod_id tycons , tc' <- tc : promoted , Just rep_id <- pure $ tyConRepId stuff tc' ] - ; gbl_env <- tcExtendGlobalValEnv tycon_rep_bndrs getGblEnv + ; gbl_env <- pprTrace "typeable tycons" (ppr $ map (\x -> (x, tyConRepId stuff x)) all_tycons) + $ pprTrace "typeable tycons'" (ppr [ (tc', promoted, tyConRepId stuff tc') + | tc <- all_tycons + , let promoted = map promoteDataCon (tyConDataCons tc) + , tc' <- tc:promoted ]) + $ pprTrace "typeable binders" (ppr tycon_rep_bndrs) $ + tcExtendGlobalValEnv tycon_rep_bndrs getGblEnv ; setGblEnv gbl_env $ foldlM (mk_typeable_binds stuff) gbl_env all_tycons } @@ -198,7 +204,7 @@ mkPrimTypeableBinds :: TcM TcGblEnv mkPrimTypeableBinds = do { mod <- getModule ; if mod == gHC_TYPES - then do { trModuleTyCon <- tcLookupTyCon trModuleTyConName + then do { trModuleTyCon <- pprTrace "mkPrimTypeableBinds" (ppr $ map tyConName ghcPrimTypeableTyCons) $ tcLookupTyCon trModuleTyConName ; let ghc_prim_module_id = mkExportedVanillaId trGhcPrimModuleName (mkTyConTy trModuleTyCon) @@ -279,7 +285,7 @@ mkTrNameLit = do mk_typeable_binds :: TypeableStuff -> TcGblEnv -> TyCon -> TcM TcGblEnv mk_typeable_binds stuff gbl_env tycon = do binds <- mkTyConRepBinds stuff tycon - let gbl_env' = gbl_env `addTypecheckedBinds` [binds] + let gbl_env' = pprTrace "mk_typeable_binds" (ppr binds) $ gbl_env `addTypecheckedBinds` [binds] setGblEnv gbl_env' $ do promoted_reps <- mapM (mkTyConRepBinds stuff . promoteDataCon) (tyConDataCons tycon) @@ -295,7 +301,8 @@ tyConRepId (Stuff {..}) tycon -- | Make typeable bindings for the given 'TyCon'. mkTyConRepBinds :: TypeableStuff -> TyCon -> TcRn (LHsBinds Id) mkTyConRepBinds stuff@(Stuff {..}) tycon - = case tyConRepId stuff tycon of + = pprTrace "mkTyConRepBinds" (ppr tycon) $ + case tyConRepId stuff tycon of Just tycon_rep_id -> do tycon_rep_rhs <- mkTyConRepTyConRHS stuff tycon let tycon_rep = mkVarBind tycon_rep_id tycon_rep_rhs @@ -399,7 +406,7 @@ mkTyConKindRep :: TypeableStuff -> TyCon -> TcRn (LHsExpr Id) mkTyConKindRep (Stuff {..}) tycon = do let bndrs = mkVarEnv $ (`zip` [0..]) $ map binderVar $ reverse $ filter isNamedTyConBinder (tyConBinders tycon) - go bndrs (tyConResKind tycon) + pprTrace "mkTyConKeyRepBinds" (ppr tycon <+> pprType' (tyConKind tycon)) $ go bndrs (tyConResKind tycon) where -- Compute RHS go :: VarEnv Int -> Kind -> TcRn (LHsExpr Id) @@ -414,7 +421,8 @@ mkTyConKindRep (Stuff {..}) tycon = do t2' <- go bndrs t2 return $ nlHsApps (dataConWrapId kindRepAppDataCon) [t1', t2'] go _ ty | Just rr <- isTYPEApp ty - = return $ nlHsApps (dataConWrapId kindRepTYPEDataCon) [nlHsVar $ dataConWrapId rr] + = pprTrace "mkTyConKeyRepBinds(type)" (ppr rr) $ + return $ nlHsApps (dataConWrapId kindRepTYPEDataCon) [nlHsVar $ dataConWrapId rr] go bndrs (TyConApp tycon tys) | Just rep_name <- tyConRepName_maybe tycon = do rep_id <- lookupId rep_name From git at git.haskell.org Sun Jan 29 20:21:20 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:21:20 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Fix up rebase (ed590f0) Message-ID: <20170129202120.3EAEC3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/ed590f04a32674bfb9d6aab44f311feb8dc3c865/ghc >--------------------------------------------------------------- commit ed590f04a32674bfb9d6aab44f311feb8dc3c865 Author: Ben Gamari Date: Thu Jan 19 22:50:04 2017 -0500 Fix up rebase >--------------------------------------------------------------- ed590f04a32674bfb9d6aab44f311feb8dc3c865 compiler/typecheck/TcHsSyn.hs | 2 +- compiler/typecheck/TcTypeable.hs | 191 ++++++++++++++++++++++----------------- compiler/utils/Fingerprint.hsc | 1 + 3 files changed, 110 insertions(+), 84 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc ed590f04a32674bfb9d6aab44f311feb8dc3c865 From git at git.haskell.org Sun Jan 29 20:21:23 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:21:23 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Fixes (ac90630) Message-ID: <20170129202123.0E2033A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/ac90630d632a34c9ec8b5f5552f01f9719e4004a/ghc >--------------------------------------------------------------- commit ac90630d632a34c9ec8b5f5552f01f9719e4004a Author: Ben Gamari Date: Thu Jan 19 21:12:11 2017 -0500 Fixes >--------------------------------------------------------------- ac90630d632a34c9ec8b5f5552f01f9719e4004a compiler/typecheck/TcTypeable.hs | 3 +-- libraries/Cabal | 2 +- libraries/hpc | 2 +- libraries/time | 2 +- 4 files changed, 4 insertions(+), 5 deletions(-) diff --git a/compiler/typecheck/TcTypeable.hs b/compiler/typecheck/TcTypeable.hs index e160142..b33dff7 100644 --- a/compiler/typecheck/TcTypeable.hs +++ b/compiler/typecheck/TcTypeable.hs @@ -371,8 +371,7 @@ which looks like, Note how $trProxyType encodes only the kind variables of the TyCon instantiation. To compute the kind (Proxy Int) we need to have a recipe to -compute the kind of a concrete instantiation of Proxy. We call"inplace/bin/ghc-stage1" -hisuf hi -osuf o -hcsuf hc -static -O -H64m -Wall -this-unit-id ghc-prim-0.5.0.0 -hide-all-packages -i -ilibraries/ghc-prim/. -ilibraries/ghc-prim/dist-install/build -Ilibraries/ghc-prim/dist-install/build -ilibraries/ghc-prim/dist-install/build/./autogen -Ilibraries/ghc-prim/dist-install/build/./autogen -Ilibraries/ghc-prim/. -optP-include -optPlibraries/ghc-prim/dist-install/build/./autogen/cabal_macros.h -package-id rts -this-unit-id ghc-prim -XHaskell2010 -O -dcore-lint -no-user-package-db -rtsopts -Wno-trustworthy-safe -Wno-deprecated-flags -Wnoncanonical-monad-instances -odir libraries/ghc-prim/dist-install/build -hidir libraries/ghc-prim/dist-install/build -stubdir libraries/ghc-prim/dist-install/build -split-sections -dynamic-too -c libraries/ghc-prim/./GHC/Types.hs -o libraries/ghc-prim/dist-install/build/GHC/Types.o -dyno libraries/ghc-prim/dist-install/build/GHC/Types. dyn_o - this recipe a +compute the kind of a concrete instantiation of Proxy. We call this recipe a KindRep and store it in the TyCon produced for Proxy, type KindBndr = Int -- de Bruijn index diff --git a/libraries/Cabal b/libraries/Cabal index 824d0ba..d8fbdd6 160000 --- a/libraries/Cabal +++ b/libraries/Cabal @@ -1 +1 @@ -Subproject commit 824d0bae1aee2a25cabdcef92e5e1dd470c7dac0 +Subproject commit d8fbdd6bab216aee3f36a8e46fadf1040425b023 diff --git a/libraries/hpc b/libraries/hpc index 8625c1c..c23cad3 160000 --- a/libraries/hpc +++ b/libraries/hpc @@ -1 +1 @@ -Subproject commit 8625c1c0550719437acad89d49401cf048990084 +Subproject commit c23cad32f408559ba95b880c04dc1a2c60ec3d01 diff --git a/libraries/time b/libraries/time index ee8fe45..b6098be 160000 --- a/libraries/time +++ b/libraries/time @@ -1 +1 @@ -Subproject commit ee8fe452fa45f6d78f8ce6deedb88b20eb3d5f42 +Subproject commit b6098be8a4facfa854c633f2a3a82ab8e72962ef From git at git.haskell.org Sun Jan 29 20:21:25 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:21:25 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Un-bump time bound (b169b7e) Message-ID: <20170129202125.C09C73A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/b169b7ebb547d5d37d7d4581d937325ca5d828b5/ghc >--------------------------------------------------------------- commit b169b7ebb547d5d37d7d4581d937325ca5d828b5 Author: Ben Gamari Date: Fri Jan 27 18:54:22 2017 -0500 Un-bump time bound >--------------------------------------------------------------- b169b7ebb547d5d37d7d4581d937325ca5d828b5 ghc/ghc-bin.cabal.in | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ghc/ghc-bin.cabal.in b/ghc/ghc-bin.cabal.in index 0f50453..9c9ca0e 100644 --- a/ghc/ghc-bin.cabal.in +++ b/ghc/ghc-bin.cabal.in @@ -52,7 +52,7 @@ Executable ghc deepseq == 1.4.*, ghci == @ProjectVersionMunged@, haskeline == 0.7.*, - time == 1.8.*, + time == 1.7.*, transformers == 0.5.* CPP-Options: -DGHCI GHC-Options: -fno-warn-name-shadowing From git at git.haskell.org Sun Jan 29 20:21:28 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:21:28 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Fix unique clash (4f27d3d) Message-ID: <20170129202128.87F2A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/4f27d3dad97ecd337909d29e7a1cf0faf81c845f/ghc >--------------------------------------------------------------- commit 4f27d3dad97ecd337909d29e7a1cf0faf81c845f Author: Ben Gamari Date: Sat Jan 28 00:20:53 2017 -0500 Fix unique clash >--------------------------------------------------------------- 4f27d3dad97ecd337909d29e7a1cf0faf81c845f compiler/prelude/PrelNames.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/prelude/PrelNames.hs b/compiler/prelude/PrelNames.hs index 2cb465a..b03b3f8 100644 --- a/compiler/prelude/PrelNames.hs +++ b/compiler/prelude/PrelNames.hs @@ -1799,7 +1799,7 @@ someTypeRepDataConKey = mkPreludeTyConUnique 186 typeSymbolAppendFamNameKey :: Unique -typeSymbolAppendFamNameKey = mkPreludeTyConUnique 185 +typeSymbolAppendFamNameKey = mkPreludeTyConUnique 187 ---------------- Template Haskell ------------------- -- THNames.hs: USES TyConUniques 200-299 From git at git.haskell.org Sun Jan 29 20:21:31 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:21:31 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Fix hs-boot file (c56580f) Message-ID: <20170129202131.45DDA3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/c56580f266b0f2637f36c3ba0a80d8aabce8d7a9/ghc >--------------------------------------------------------------- commit c56580f266b0f2637f36c3ba0a80d8aabce8d7a9 Author: Ben Gamari Date: Sat Jan 28 00:21:15 2017 -0500 Fix hs-boot file >--------------------------------------------------------------- c56580f266b0f2637f36c3ba0a80d8aabce8d7a9 compiler/types/Type.hs-boot | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/compiler/types/Type.hs-boot b/compiler/types/Type.hs-boot index 5456dd7..9f0d653 100644 --- a/compiler/types/Type.hs-boot +++ b/compiler/types/Type.hs-boot @@ -2,6 +2,7 @@ module Type where import TyCon import Var ( TyVar ) import {-# SOURCE #-} TyCoRep( Type, Kind ) +import Util isPredTy :: Type -> Bool isCoercionTy :: Type -> Bool @@ -20,4 +21,4 @@ coreView :: Type -> Maybe Type tyCoVarsOfTypesWellScoped :: [Type] -> [TyVar] -splitTyConApp_maybe :: Type -> Maybe (TyCon, [Type]) \ No newline at end of file +splitTyConApp_maybe :: HasCallStack => Type -> Maybe (TyCon, [Type]) \ No newline at end of file From git at git.haskell.org Sun Jan 29 20:21:34 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:21:34 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Fix up Binary instances (ccd8b09) Message-ID: <20170129202134.139DF3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/ccd8b09785aece6f58442707d10e23df22adc1d8/ghc >--------------------------------------------------------------- commit ccd8b09785aece6f58442707d10e23df22adc1d8 Author: Ben Gamari Date: Sat Jan 28 00:21:53 2017 -0500 Fix up Binary instances >--------------------------------------------------------------- ccd8b09785aece6f58442707d10e23df22adc1d8 compiler/utils/Binary.hs | 67 ++++++++++---------- libraries/ghci/GHCi/TH/Binary.hs | 133 ++++++++++++++++++++------------------- 2 files changed, 101 insertions(+), 99 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc ccd8b09785aece6f58442707d10e23df22adc1d8 From git at git.haskell.org Sun Jan 29 20:21:36 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:21:36 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Add explicit forall to SomeTypeRep (2bba4e0) Message-ID: <20170129202136.BBEA93A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/2bba4e051efa4720baf9657a1ef20f2d579134ab/ghc >--------------------------------------------------------------- commit 2bba4e051efa4720baf9657a1ef20f2d579134ab Author: Ben Gamari Date: Sat Jan 28 00:22:16 2017 -0500 Add explicit forall to SomeTypeRep >--------------------------------------------------------------- 2bba4e051efa4720baf9657a1ef20f2d579134ab libraries/base/Data/Typeable/Internal.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs index 773d2ca..ab5d973 100644 --- a/libraries/base/Data/Typeable/Internal.hs +++ b/libraries/base/Data/Typeable/Internal.hs @@ -197,7 +197,7 @@ instance Ord (TypeRep a) where -- | A non-indexed type representation. data SomeTypeRep where - SomeTypeRep :: TypeRep a -> SomeTypeRep + SomeTypeRep :: forall k (a :: k). TypeRep a -> SomeTypeRep instance Eq SomeTypeRep where SomeTypeRep a == SomeTypeRep b = From git at git.haskell.org Sun Jan 29 20:21:39 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:21:39 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: TcTypeable: Look through type synonyms (8bd1218) Message-ID: <20170129202139.7B1D03A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/8bd12185e0319ff7fed468c5357332b5ce18e33b/ghc >--------------------------------------------------------------- commit 8bd12185e0319ff7fed468c5357332b5ce18e33b Author: Ben Gamari Date: Sat Jan 28 00:22:39 2017 -0500 TcTypeable: Look through type synonyms >--------------------------------------------------------------- 8bd12185e0319ff7fed468c5357332b5ce18e33b compiler/typecheck/TcTypeable.hs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/compiler/typecheck/TcTypeable.hs b/compiler/typecheck/TcTypeable.hs index 99a7e5b..c3e9b21 100644 --- a/compiler/typecheck/TcTypeable.hs +++ b/compiler/typecheck/TcTypeable.hs @@ -434,6 +434,9 @@ mkTyConKindRep (Stuff {..}) tycon = do where -- Compute RHS go :: VarEnv Int -> Kind -> TcRn (LHsExpr Id) + go bndrs ty + | Just ty' <- coreView ty + = go bndrs ty' go bndrs (TyVarTy v) | Just idx <- lookupVarEnv bndrs v = return $ nlHsDataCon kindRepVarDataCon @@ -456,7 +459,7 @@ mkTyConKindRep (Stuff {..}) tycon = do `nlHsApp` nlHsVar rep_id `nlHsApp` mkList (mkTyConTy kindRepTyCon) tys' | otherwise - = pprPanic "UnrepresentableThingy" empty + = pprPanic "UnrepresentableThingy" (ppr tycon) go _bndrs (ForAllTy (TvBndr var _) ty) = pprPanic "mkTyConKeyRepBinds(forall)" (ppr var $$ ppr ty) -- = let bndrs' = extendVarEnv (mapVarEnv (+1) bndrs) var 0 From git at git.haskell.org Sun Jan 29 20:21:42 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:21:42 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Fix utils/Binary (a0b139d) Message-ID: <20170129202142.347263A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/a0b139d02057bb253f633a68a9b05eb292806392/ghc >--------------------------------------------------------------- commit a0b139d02057bb253f633a68a9b05eb292806392 Author: Ben Gamari Date: Sat Jan 28 00:40:50 2017 -0500 Fix utils/Binary >--------------------------------------------------------------- a0b139d02057bb253f633a68a9b05eb292806392 compiler/utils/Binary.hs | 81 ++++++++++++++++++++++++++++++++++++++---------- 1 file changed, 65 insertions(+), 16 deletions(-) diff --git a/compiler/utils/Binary.hs b/compiler/utils/Binary.hs index ba6b1ae..56bf1e2 100644 --- a/compiler/utils/Binary.hs +++ b/compiler/utils/Binary.hs @@ -80,7 +80,7 @@ import Data.Time import Type.Reflection import Type.Reflection.Unsafe import Data.Kind (Type) -import GHC.Exts (TYPE, RuntimeRep) +import GHC.Exts (RuntimeRep(..), VecCount(..), VecElem(..)) #else import Data.Typeable #endif @@ -571,17 +571,72 @@ instance Binary TyCon where put_ bh (tyConPackage tc) put_ bh (tyConModule tc) put_ bh (tyConName tc) - get bh = do - p <- get bh - m <- get bh - n <- get bh + put_ bh (tyConKindVars tc) + put_ bh (tyConKindRep tc) + get bh = #if MIN_VERSION_base(4,10,0) - return (mkTyCon p m n) + mkTyCon <$> get bh <*> get bh <*> get bh <*> get bh <*> get bh #else - return (mkTyCon3 p m n) + mkTyCon3 <$> get bh <*> get bh <*> get bh #endif #if MIN_VERSION_base(4,10,0) +instance Binary VecCount where + put_ bh = putByte bh . fromIntegral . fromEnum + get bh = toEnum . fromIntegral <$> getByte bh + +instance Binary VecElem where + put_ bh = putByte bh . fromIntegral . fromEnum + get bh = toEnum . fromIntegral <$> getByte bh + +instance Binary RuntimeRep where + put_ bh (VecRep a b) = putByte bh 0 >> put_ bh a >> put_ bh b + put_ bh (TupleRep reps) = putByte bh 1 >> put_ bh reps + put_ bh (SumRep reps) = putByte bh 2 >> put_ bh reps + put_ bh LiftedRep = putByte bh 3 + put_ bh UnliftedRep = putByte bh 4 + put_ bh IntRep = putByte bh 5 + put_ bh WordRep = putByte bh 6 + put_ bh Int64Rep = putByte bh 7 + put_ bh Word64Rep = putByte bh 8 + put_ bh AddrRep = putByte bh 9 + put_ bh FloatRep = putByte bh 10 + put_ bh DoubleRep = putByte bh 11 + + get bh = do + tag <- getByte bh + case tag of + 0 -> VecRep <$> get bh <*> get bh + 1 -> TupleRep <$> get bh + 2 -> SumRep <$> get bh + 3 -> pure LiftedRep + 4 -> pure UnliftedRep + 5 -> pure IntRep + 6 -> pure WordRep + 7 -> pure Int64Rep + 8 -> pure Word64Rep + 9 -> pure AddrRep + 10 -> pure FloatRep + 11 -> pure DoubleRep + _ -> fail "GHCi.TH.Binary.putRuntimeRep: invalid tag" + +instance Binary KindRep where + put_ bh (KindRepTyConApp tc k) = putByte bh 0 >> put_ bh tc >> put_ bh k + put_ bh (KindRepVar bndr) = putByte bh 1 >> put_ bh bndr + put_ bh (KindRepApp a b) = putByte bh 2 >> put_ bh a >> put_ bh b + put_ bh (KindRepFun a b) = putByte bh 3 >> put_ bh a >> put_ bh b + put_ bh (KindRepTYPE r) = putByte bh 4 >> put_ bh r + + get bh = do + tag <- getByte bh + case tag of + 0 -> KindRepTyConApp <$> get bh <*> get bh + 1 -> KindRepVar <$> get bh + 2 -> KindRepApp <$> get bh <*> get bh + 3 -> KindRepFun <$> get bh <*> get bh + 4 -> KindRepTYPE <$> get bh + _ -> fail "GHCi.TH.Binary.putKindRep: invalid tag" + putTypeRep :: BinHandle -> TypeRep a -> IO () -- Special handling for TYPE, (->), and RuntimeRep due to recursive kind -- relations. @@ -589,7 +644,7 @@ putTypeRep :: BinHandle -> TypeRep a -> IO () putTypeRep bh rep | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep Type) = put_ bh (0 :: Word8) -putTypeRep bh rep@(TRCon' con ks) = do +putTypeRep bh (TRCon' con ks) = do put_ bh (1 :: Word8) put_ bh con put_ bh ks @@ -612,17 +667,10 @@ getSomeTypeRep bh = do ks <- get bh :: IO [SomeTypeRep] return $ SomeTypeRep $ mkTrCon con ks - case typeRepKind rep_k `eqTypeRep` (typeRep :: TypeRep Type) of - Just HRefl -> pure $ SomeTypeRep $ mkTrCon con rep_k - Nothing -> failure "Kind mismatch in constructor application" - [ " Type constructor: " ++ show con - , " Applied to type : " ++ show rep_k - ] - 2 -> do SomeTypeRep f <- getSomeTypeRep bh SomeTypeRep x <- getSomeTypeRep bh case typeRepKind f of - TRFun arg _ -> + TRFun arg res -> case arg `eqTypeRep` typeRepKind x of Just HRefl -> case typeRepKind res `eqTypeRep` (typeRep :: TypeRep Type) of @@ -644,6 +692,7 @@ getSomeTypeRep bh = do case typeRepKind res `eqTypeRep` (typeRep :: TypeRep Type) of Just HRefl -> return $ SomeTypeRep $ TRFun arg res Nothing -> failure "Kind mismatch" [] + _ -> failure "Kind mismatch" [] _ -> failure "Invalid SomeTypeRep" [] where failure description info = From git at git.haskell.org Sun Jan 29 20:21:44 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:21:44 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Begin work on kind computation (142f89c) Message-ID: <20170129202144.E3CD23A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/142f89c713b93e6e54e0eaea557cd8a8ef85e182/ghc >--------------------------------------------------------------- commit 142f89c713b93e6e54e0eaea557cd8a8ef85e182 Author: Ben Gamari Date: Sat Jan 28 02:18:03 2017 -0500 Begin work on kind computation >--------------------------------------------------------------- 142f89c713b93e6e54e0eaea557cd8a8ef85e182 libraries/base/Data/Typeable/Internal.hs | 109 ++++++++++++++++++++++++++++++- libraries/ghc-prim/GHC/Types.hs | 2 +- 2 files changed, 108 insertions(+), 3 deletions(-) diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs index ab5d973..7264b1d 100644 --- a/libraries/base/Data/Typeable/Internal.hs +++ b/libraries/base/Data/Typeable/Internal.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE Trustworthy #-} {-# LANGUAGE TypeInType #-} {-# LANGUAGE ViewPatterns #-} @@ -73,6 +74,7 @@ module Data.Typeable.Internal ( ) where import GHC.Base +import qualified GHC.Arr as A import GHC.Types (TYPE) import Data.Type.Equality import GHC.Word @@ -307,9 +309,112 @@ eqTypeRep a b | typeRepFingerprint a == typeRepFingerprint b = Just (unsafeCoerce# HRefl) | otherwise = Nothing + +------------------------------------------------------------- +-- +-- Computing kinds +-- +------------------------------------------------------------- + -- | Observe the kind of a type. typeRepKind :: TypeRep (a :: k) -> TypeRep k -typeRepKind a = undefined +typeRepKind (TrTyCon _ tc args) + = unsafeCoerceRep $ tyConKind tc args +typeRepKind (TrApp _ f _) + | TRFun _ res <- typeRepKind f + = res +typeRepKind (TrFun _ _ _) = typeRep @Type +typeRepKind _ = error "Ill-kinded type representation" + +tyConKind :: TyCon -> [SomeTypeRep] -> SomeTypeRep +tyConKind (TyCon _ _ _ _ nKindVars# kindRep) kindVars = go kindRep + where + nKindVars = I# nKindVars# + kindVarsArr :: A.Array KindBndr SomeTypeRep + kindVarsArr = A.listArray (0,nKindVars) kindVars + + go :: KindRep -> SomeTypeRep + go (KindRepTyConApp tc args) = undefined -- tyConKind tc args + go (KindRepVar var) = kindVarsArr A.! var + go (KindRepApp f a) + = SomeTypeRep $ TRApp (unsafeCoerceRep $ go f) (unsafeCoerceRep $ go a) + go (KindRepFun a b) + = SomeTypeRep $ TRFun (unsafeCoerceRep $ go a) (unsafeCoerceRep $ go b) + go (KindRepTYPE r) = unkindedTypeRep $ runtimeRepTypeRep r + +unsafeCoerceRep :: SomeTypeRep -> TypeRep a +unsafeCoerceRep (SomeTypeRep r) = unsafeCoerce r + +unkindedTypeRep :: SomeKindedTypeRep k -> SomeTypeRep +unkindedTypeRep (SomeKindedTypeRep x) = SomeTypeRep x + +data SomeKindedTypeRep k where + SomeKindedTypeRep :: forall (a :: k). TypeRep a -> SomeKindedTypeRep k + +kApp :: SomeKindedTypeRep (k -> k') -> SomeKindedTypeRep k -> SomeKindedTypeRep k' +kApp (SomeKindedTypeRep f) (SomeKindedTypeRep a) = SomeKindedTypeRep (TRApp f a) + +kindedTypeRep :: forall (a :: k). Typeable a => SomeKindedTypeRep k +kindedTypeRep = SomeKindedTypeRep (typeRep @a) + +buildList :: forall k. Typeable k => [SomeKindedTypeRep k] -> SomeKindedTypeRep [k] +buildList = foldr cons nil + where + nil = kindedTypeRep @[k] @'[] + cons x rest = SomeKindedTypeRep (typeRep @'(:)) `kApp` x `kApp` rest + +runtimeRepTypeRep :: RuntimeRep -> SomeKindedTypeRep RuntimeRep +runtimeRepTypeRep r = + case r of + LiftedRep -> rep @'LiftedRep + UnliftedRep -> rep @'UnliftedRep + VecRep c e -> kindedTypeRep @_ @'VecRep + `kApp` vecCountTypeRep c + `kApp` vecElemTypeRep e + TupleRep rs -> kindedTypeRep @_ @'TupleRep + `kApp` buildList (map runtimeRepTypeRep rs) + SumRep rs -> kindedTypeRep @_ @'SumRep + `kApp` buildList (map runtimeRepTypeRep rs) + IntRep -> rep @'IntRep + WordRep -> rep @'WordRep + Int64Rep -> rep @'Int64Rep + Word64Rep -> rep @'Word64Rep + AddrRep -> rep @'AddrRep + FloatRep -> rep @'FloatRep + DoubleRep -> rep @'DoubleRep + where + rep :: forall (a :: RuntimeRep). Typeable a => SomeKindedTypeRep RuntimeRep + rep = kindedTypeRep @RuntimeRep @a + +vecCountTypeRep :: VecCount -> SomeKindedTypeRep VecCount +vecCountTypeRep c = + case c of + Vec2 -> rep @'Vec2 + Vec4 -> rep @'Vec4 + Vec8 -> rep @'Vec8 + Vec16 -> rep @'Vec16 + Vec32 -> rep @'Vec32 + Vec64 -> rep @'Vec64 + where + rep :: forall (a :: VecCount). Typeable a => SomeKindedTypeRep VecCount + rep = kindedTypeRep @VecCount @a + +vecElemTypeRep :: VecElem -> SomeKindedTypeRep VecElem +vecElemTypeRep e = + case e of + Int8ElemRep -> rep @'Int8ElemRep + Int16ElemRep -> rep @'Int16ElemRep + Int32ElemRep -> rep @'Int32ElemRep + Int64ElemRep -> rep @'Int64ElemRep + Word8ElemRep -> rep @'Word8ElemRep + Word16ElemRep -> rep @'Word16ElemRep + Word32ElemRep -> rep @'Word32ElemRep + Word64ElemRep -> rep @'Word64ElemRep + FloatElemRep -> rep @'FloatElemRep + DoubleElemRep -> rep @'DoubleElemRep + where + rep :: forall (a :: VecElem). Typeable a => SomeKindedTypeRep VecElem + rep = kindedTypeRep @VecElem @a ------------------------------------------------------------- -- @@ -319,7 +424,7 @@ typeRepKind a = undefined -- | The class 'Typeable' allows a concrete representation of a type to -- be calculated. -class Typeable a where +class Typeable (a :: k) where typeRep# :: TypeRep a typeRep :: Typeable a => TypeRep a diff --git a/libraries/ghc-prim/GHC/Types.hs b/libraries/ghc-prim/GHC/Types.hs index b71559a..35c0183 100644 --- a/libraries/ghc-prim/GHC/Types.hs +++ b/libraries/ghc-prim/GHC/Types.hs @@ -39,7 +39,7 @@ module GHC.Types ( VecCount(..), VecElem(..), -- * Runtime type representation - Module(..), TrName(..), TyCon(..), KindRep(..) + Module(..), TrName(..), TyCon(..), KindRep(..), KindBndr ) where import GHC.Prim From git at git.haskell.org Sun Jan 29 20:21:47 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:21:47 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Binary: Compatibility with base<4.10 (80800f0) Message-ID: <20170129202147.9C46B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/80800f05451e41120f7f7e2b9516c54f177ef6d0/ghc >--------------------------------------------------------------- commit 80800f05451e41120f7f7e2b9516c54f177ef6d0 Author: Ben Gamari Date: Sat Jan 28 02:23:59 2017 -0500 Binary: Compatibility with base<4.10 >--------------------------------------------------------------- 80800f05451e41120f7f7e2b9516c54f177ef6d0 compiler/utils/Binary.hs | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/compiler/utils/Binary.hs b/compiler/utils/Binary.hs index 56bf1e2..5e894fd 100644 --- a/compiler/utils/Binary.hs +++ b/compiler/utils/Binary.hs @@ -566,6 +566,7 @@ instance Binary (Bin a) where -- ----------------------------------------------------------------------------- -- Instances for Data.Typeable stuff +#if MIN_VERSION_base(4,10,0) instance Binary TyCon where put_ bh tc = do put_ bh (tyConPackage tc) @@ -574,9 +575,14 @@ instance Binary TyCon where put_ bh (tyConKindVars tc) put_ bh (tyConKindRep tc) get bh = -#if MIN_VERSION_base(4,10,0) mkTyCon <$> get bh <*> get bh <*> get bh <*> get bh <*> get bh #else +instance Binary TyCon where + put_ bh tc = do + put_ bh (tyConPackage tc) + put_ bh (tyConModule tc) + put_ bh (tyConName tc) + get bh = mkTyCon3 <$> get bh <*> get bh <*> get bh #endif From git at git.haskell.org Sun Jan 29 20:21:50 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:21:50 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: TcTypeable: Fix kind variable count (529bbc9) Message-ID: <20170129202150.58B563A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/529bbc9eebbaa495965879da423d683805d844b8/ghc >--------------------------------------------------------------- commit 529bbc9eebbaa495965879da423d683805d844b8 Author: Ben Gamari Date: Sat Jan 28 02:24:10 2017 -0500 TcTypeable: Fix kind variable count >--------------------------------------------------------------- 529bbc9eebbaa495965879da423d683805d844b8 compiler/typecheck/TcTypeable.hs | 4 ++-- libraries/base/Data/Typeable/Internal.hs | 3 +-- 2 files changed, 3 insertions(+), 4 deletions(-) diff --git a/compiler/typecheck/TcTypeable.hs b/compiler/typecheck/TcTypeable.hs index c3e9b21..e35a27c 100644 --- a/compiler/typecheck/TcTypeable.hs +++ b/compiler/typecheck/TcTypeable.hs @@ -342,11 +342,11 @@ mkTyConRepTyConRHS stuff@(Stuff {..}) todo tycon `nlHsApp` nlHsLit (word64 low) `nlHsApp` mod_rep_expr todo `nlHsApp` trNameLit (mkFastString tycon_str) - `nlHsApp` nlHsLit (int 0) -- TODO + `nlHsApp` nlHsLit (int n_kind_vars) `nlHsApp` kind_rep return rep_rhs where - + n_kind_vars = length $ filter isNamedTyConBinder (tyConBinders tycon) tycon_str = add_tick (occNameString (getOccName tycon)) add_tick s | isPromotedDataCon tycon = '\'' : s | otherwise = s diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs index 7264b1d..4448fcb 100644 --- a/libraries/base/Data/Typeable/Internal.hs +++ b/libraries/base/Data/Typeable/Internal.hs @@ -329,9 +329,8 @@ typeRepKind _ = error "Ill-kinded type representation" tyConKind :: TyCon -> [SomeTypeRep] -> SomeTypeRep tyConKind (TyCon _ _ _ _ nKindVars# kindRep) kindVars = go kindRep where - nKindVars = I# nKindVars# kindVarsArr :: A.Array KindBndr SomeTypeRep - kindVarsArr = A.listArray (0,nKindVars) kindVars + kindVarsArr = A.listArray (0, I# (nKindVars# -# 1#)) kindVars go :: KindRep -> SomeTypeRep go (KindRepTyConApp tc args) = undefined -- tyConKind tc args From git at git.haskell.org Sun Jan 29 20:21:53 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:21:53 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: TcTypeable: A bit more debug output and fix binder ordering (0129388) Message-ID: <20170129202153.203393A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/01293886816aeae11b479679fa5909f044924525/ghc >--------------------------------------------------------------- commit 01293886816aeae11b479679fa5909f044924525 Author: Ben Gamari Date: Sat Jan 28 03:14:52 2017 -0500 TcTypeable: A bit more debug output and fix binder ordering >--------------------------------------------------------------- 01293886816aeae11b479679fa5909f044924525 compiler/typecheck/TcTypeable.hs | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/compiler/typecheck/TcTypeable.hs b/compiler/typecheck/TcTypeable.hs index e35a27c..96c05d4 100644 --- a/compiler/typecheck/TcTypeable.hs +++ b/compiler/typecheck/TcTypeable.hs @@ -429,8 +429,12 @@ F :: forall k. k -> forall k'. k' -> Type mkTyConKindRep :: TypeableStuff -> TyCon -> TcRn (LHsExpr Id) mkTyConKindRep (Stuff {..}) tycon = do let bndrs = mkVarEnv $ (`zip` [0..]) $ map binderVar - $ reverse $ filter isNamedTyConBinder (tyConBinders tycon) - pprTrace "mkTyConKeyRepBinds" (ppr tycon <+> pprType' (tyConKind tycon)) $ go bndrs (tyConResKind tycon) + $ filter isNamedTyConBinder (tyConBinders tycon) + pprTrace "mkTyConKindRepBinds" + (ppr tycon + $$ pprType' (tyConKind tycon) + $$ ppr (map binderVar $ filter isNamedTyConBinder $ tyConBinders tycon)) + $ go bndrs (tyConResKind tycon) where -- Compute RHS go :: VarEnv Int -> Kind -> TcRn (LHsExpr Id) From git at git.haskell.org Sun Jan 29 20:21:55 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:21:55 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Internal: Various cleanups (5e00482) Message-ID: <20170129202155.D03C83A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/5e00482b9dc5abd8266dc9e90246142d31f78f93/ghc >--------------------------------------------------------------- commit 5e00482b9dc5abd8266dc9e90246142d31f78f93 Author: Ben Gamari Date: Sat Jan 28 03:15:15 2017 -0500 Internal: Various cleanups >--------------------------------------------------------------- 5e00482b9dc5abd8266dc9e90246142d31f78f93 libraries/base/Data/Typeable/Internal.hs | 46 +++++++++++++++++++------------- 1 file changed, 27 insertions(+), 19 deletions(-) diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs index 4448fcb..93eb2d3 100644 --- a/libraries/base/Data/Typeable/Internal.hs +++ b/libraries/base/Data/Typeable/Internal.hs @@ -186,12 +186,14 @@ on f g = \ x y -> g x `f` g y -- | @since 2.01 instance Eq (TypeRep a) where - (==) = (==) `on` typeRepFingerprint + TrTyCon a _ _ _ _ == TrTyCon b _ _ _ _ = a == b + {-# INLINABLE (==) #-} instance TestEquality TypeRep where - testEquality a b - | typeRepFingerprint a == typeRepFingerprint b = Just (unsafeCoerce# Refl) - | otherwise = Nothing + testEquality (TrTyCon a _ _ _ _) (TrTyCon b _ _ _ _) + | a == b = Just (unsafeCoerce# Refl) + | otherwise = Nothing + {-# INLINEABLE testEquality #-} -- | @since 4.4.0.0 instance Ord (TypeRep a) where @@ -253,10 +255,6 @@ mkTrApp a b = TrApp fpr a b fpr_b = typeRepFingerprint b fpr = fingerprintFingerprints [fpr_a, fpr_b] - -data AppResult (t :: k) where - App :: TypeRep a -> TypeRep b -> AppResult (a b) - -- | Pattern match on a type application pattern TRApp :: forall k2 (t :: k2). () => forall k1 (a :: k1 -> k2) (b :: k1). (t ~ a b) @@ -282,6 +280,9 @@ pattern TRCon con <- TrTyCon _ con _ pattern TRCon' :: forall k (a :: k). TyCon -> [SomeTypeRep] -> TypeRep a pattern TRCon' con ks <- TrTyCon _ con ks +data AppResult (t :: k) where + App :: TypeRep a -> TypeRep b -> AppResult (a b) + -- | Splits a type application. splitApp :: TypeRep a -> Maybe (AppResult a) splitApp (TrTyCon _ _ _) = Nothing @@ -326,15 +327,20 @@ typeRepKind (TrApp _ f _) typeRepKind (TrFun _ _ _) = typeRep @Type typeRepKind _ = error "Ill-kinded type representation" -tyConKind :: TyCon -> [SomeTypeRep] -> SomeTypeRep -tyConKind (TyCon _ _ _ _ nKindVars# kindRep) kindVars = go kindRep - where - kindVarsArr :: A.Array KindBndr SomeTypeRep - kindVarsArr = A.listArray (0, I# (nKindVars# -# 1#)) kindVars +tyConKind :: TyCon -> [SomeTypeRep] -> SomeTypeRep +tyConKind (TyCon _ _ _ _ nKindVars# kindRep) kindVars = + let kindVarsArr :: A.Array KindBndr SomeTypeRep + kindVarsArr = A.listArray (0, I# (nKindVars# -# 1#)) kindVars + in instantiateKindRep kindVarsArr kindRep +instantiateKindRep :: A.Array KindBndr SomeTypeRep -> KindRep -> SomeTypeRep +instantiateKindRep vars = go + where go :: KindRep -> SomeTypeRep - go (KindRepTyConApp tc args) = undefined -- tyConKind tc args - go (KindRepVar var) = kindVarsArr A.! var + go (KindRepTyConApp tc args) + = SomeTypeRep $ mkTrCon tc (map go args) + go (KindRepVar var) + = vars A.! var go (KindRepApp f a) = SomeTypeRep $ TRApp (unsafeCoerceRep $ go f) (unsafeCoerceRep $ go a) go (KindRepFun a b) @@ -485,14 +491,16 @@ instance Show SomeTypeRep where showsPrec p (SomeTypeRep ty) = showsPrec p ty splitApps :: TypeRep a -> (TyCon, [SomeTypeRep]) -splitApps = undefined --go [] - {- +splitApps = go [] where go :: [SomeTypeRep] -> TypeRep a -> (TyCon, [SomeTypeRep]) go xs (TrTyCon _ tc _) = (tc, xs) go xs (TrApp _ f x) = go (SomeTypeRep x : xs) f - go _ (TrFun _ _ _) = error "splitApps: FunTy" -- TODO --} + go [] (TrFun _ a b) = (funTyCon, [SomeTypeRep a, SomeTypeRep b]) + go _ (TrFun _ _ _) = error "Data.Typeable.Internal.splitApps: Impossible" + +funTyCon :: TyCon +funTyCon = typeRepTyCon (typeRep @(->)) isListTyCon :: TyCon -> Bool isListTyCon tc = tc == typeRepTyCon (typeRep :: TypeRep [Int]) From git at git.haskell.org Sun Jan 29 20:21:58 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:21:58 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Hi (8e5addb) Message-ID: <20170129202158.8CA8B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/8e5addb074e44daa1a95629fe6716b0df4eb2af5/ghc >--------------------------------------------------------------- commit 8e5addb074e44daa1a95629fe6716b0df4eb2af5 Author: Ben Gamari Date: Sat Jan 28 03:16:32 2017 -0500 Hi >--------------------------------------------------------------- 8e5addb074e44daa1a95629fe6716b0df4eb2af5 libraries/directory | 2 +- libraries/process | 2 +- utils/hsc2hs | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/libraries/directory b/libraries/directory index 4a4a19d..65d1d85 160000 --- a/libraries/directory +++ b/libraries/directory @@ -1 +1 @@ -Subproject commit 4a4a19d1c46c70ffd9a3e1c4c283e2e16214258f +Subproject commit 65d1d85a3fc3373a425a0298d572da9cd9ee3d86 diff --git a/libraries/process b/libraries/process index 0524859..85cc1d1 160000 --- a/libraries/process +++ b/libraries/process @@ -1 +1 @@ -Subproject commit 0524859137fc01bdb2a4833fd0aa6b23a48c6b15 +Subproject commit 85cc1d17e9550a075003a764a2429d4acde65159 diff --git a/utils/hsc2hs b/utils/hsc2hs index 9e4da90..fbc552f 160000 --- a/utils/hsc2hs +++ b/utils/hsc2hs @@ -1 +1 @@ -Subproject commit 9e4da90b7f47c23a2989cba6083fc6ed3880790f +Subproject commit fbc552f4bb003edbdd52305a5eb34a903c9fe625 From git at git.haskell.org Sun Jan 29 20:22:01 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:22:01 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Reenable Core Lint (f0a6eec) Message-ID: <20170129202201.4CB6E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/f0a6eecd9f104975376b7d8bd9290fdd042412c8/ghc >--------------------------------------------------------------- commit f0a6eecd9f104975376b7d8bd9290fdd042412c8 Author: Ben Gamari Date: Sat Jan 28 03:21:58 2017 -0500 Reenable Core Lint >--------------------------------------------------------------- f0a6eecd9f104975376b7d8bd9290fdd042412c8 compiler/coreSyn/CoreLint.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/coreSyn/CoreLint.hs b/compiler/coreSyn/CoreLint.hs index 3ca3785..c86b6b2 100644 --- a/compiler/coreSyn/CoreLint.hs +++ b/compiler/coreSyn/CoreLint.hs @@ -1174,7 +1174,7 @@ lintArrow :: SDoc -> LintedKind -> LintedKind -> LintM LintedKind -- See Note [GHC Formalism] lintArrow what k1 k2 -- Eg lintArrow "type or kind `blah'" k1 k2 -- or lintarrow "coercion `blah'" k1 k2 - = do { --unless (okArrowArgKind k1) (addErrL (msg (text "argument") k1)) + = do { unless (okArrowArgKind k1) (addErrL (msg (text "argument") k1)) ; unless (okArrowResultKind k2) (addErrL (msg (text "result") k2)) ; return liftedTypeKind } where From git at git.haskell.org Sun Jan 29 20:22:04 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:22:04 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Fix up obviously incorrect comparisons (dfd90e2) Message-ID: <20170129202204.09D503A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/dfd90e24ba3757128860890f09e4a6eb25320dcb/ghc >--------------------------------------------------------------- commit dfd90e24ba3757128860890f09e4a6eb25320dcb Author: Ben Gamari Date: Sat Jan 28 10:52:31 2017 -0500 Fix up obviously incorrect comparisons Up too late late night. >--------------------------------------------------------------- dfd90e24ba3757128860890f09e4a6eb25320dcb libraries/base/Data/Typeable/Internal.hs | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs index 93eb2d3..aa04030 100644 --- a/libraries/base/Data/Typeable/Internal.hs +++ b/libraries/base/Data/Typeable/Internal.hs @@ -186,13 +186,15 @@ on f g = \ x y -> g x `f` g y -- | @since 2.01 instance Eq (TypeRep a) where - TrTyCon a _ _ _ _ == TrTyCon b _ _ _ _ = a == b + _ == _ = True {-# INLINABLE (==) #-} instance TestEquality TypeRep where - testEquality (TrTyCon a _ _ _ _) (TrTyCon b _ _ _ _) - | a == b = Just (unsafeCoerce# Refl) - | otherwise = Nothing + a `testEquality` b + | Just HRefl <- eqTypeRep a b + = Just Refl + | otherwise + = Nothing {-# INLINEABLE testEquality #-} -- | @since 4.4.0.0 From git at git.haskell.org Sun Jan 29 20:22:06 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:22:06 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Clean up whitespace (e93b95e) Message-ID: <20170129202206.BF1523A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/e93b95e58fde6dcd1272b102b48b1495780f0d8f/ghc >--------------------------------------------------------------- commit e93b95e58fde6dcd1272b102b48b1495780f0d8f Author: Ben Gamari Date: Sat Jan 28 10:52:52 2017 -0500 Clean up whitespace >--------------------------------------------------------------- e93b95e58fde6dcd1272b102b48b1495780f0d8f compiler/typecheck/TcTypeable.hs | 1 - compiler/types/Type.hs-boot | 0 2 files changed, 1 deletion(-) diff --git a/compiler/typecheck/TcTypeable.hs b/compiler/typecheck/TcTypeable.hs index 96c05d4..82cec42 100644 --- a/compiler/typecheck/TcTypeable.hs +++ b/compiler/typecheck/TcTypeable.hs @@ -492,4 +492,3 @@ mkTyConKindRep (Stuff {..}) tycon = do consExpr :: Type -> LHsExpr Id consExpr ty = mkLHsWrap (mkWpTyApps [ty]) (nlHsDataCon consDataCon) - From git at git.haskell.org Sun Jan 29 20:22:09 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:22:09 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Fix kind instantiation (132fddc) Message-ID: <20170129202209.7777C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/132fddc0dfc721d43ed12235df501a24d7cb3004/ghc >--------------------------------------------------------------- commit 132fddc0dfc721d43ed12235df501a24d7cb3004 Author: Ben Gamari Date: Sat Jan 28 13:18:39 2017 -0500 Fix kind instantiation >--------------------------------------------------------------- 132fddc0dfc721d43ed12235df501a24d7cb3004 libraries/base/Data/Typeable/Internal.hs | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs index aa04030..72079b1 100644 --- a/libraries/base/Data/Typeable/Internal.hs +++ b/libraries/base/Data/Typeable/Internal.hs @@ -326,8 +326,10 @@ typeRepKind (TrTyCon _ tc args) typeRepKind (TrApp _ f _) | TRFun _ res <- typeRepKind f = res + | otherwise + = error ("Ill-kinded type application: " ++ show (typeRepKind f)) typeRepKind (TrFun _ _ _) = typeRep @Type -typeRepKind _ = error "Ill-kinded type representation" +typeRepKind t = error ("Ill-kinded type representation: "++show t) tyConKind :: TyCon -> [SomeTypeRep] -> SomeTypeRep tyConKind (TyCon _ _ _ _ nKindVars# kindRep) kindVars = @@ -347,7 +349,9 @@ instantiateKindRep vars = go = SomeTypeRep $ TRApp (unsafeCoerceRep $ go f) (unsafeCoerceRep $ go a) go (KindRepFun a b) = SomeTypeRep $ TRFun (unsafeCoerceRep $ go a) (unsafeCoerceRep $ go b) - go (KindRepTYPE r) = unkindedTypeRep $ runtimeRepTypeRep r + go (KindRepTYPE r) = unkindedTypeRep $ tYPE `kApp` runtimeRepTypeRep r + + tYPE = kindedTypeRep @(RuntimeRep -> Type) @TYPE unsafeCoerceRep :: SomeTypeRep -> TypeRep a unsafeCoerceRep (SomeTypeRep r) = unsafeCoerce r From git at git.haskell.org Sun Jan 29 20:22:12 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:22:12 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Export mkTrFun (81b9058) Message-ID: <20170129202212.32F223A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/81b9058e17ba1d86ef915ed9186817674d2bbaa1/ghc >--------------------------------------------------------------- commit 81b9058e17ba1d86ef915ed9186817674d2bbaa1 Author: Ben Gamari Date: Sat Jan 28 13:18:51 2017 -0500 Export mkTrFun >--------------------------------------------------------------- 81b9058e17ba1d86ef915ed9186817674d2bbaa1 libraries/base/Data/Typeable/Internal.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs index 72079b1..a733d61 100644 --- a/libraries/base/Data/Typeable/Internal.hs +++ b/libraries/base/Data/Typeable/Internal.hs @@ -69,7 +69,8 @@ module Data.Typeable.Internal ( -- * Construction -- | These are for internal use only - mkTrCon, mkTrApp, mkTyCon, mkTyCon#, + mkTrCon, mkTrApp, mkTrFun, + mkTyCon, mkTyCon#, typeSymbolTypeRep, typeNatTypeRep, ) where From git at git.haskell.org Sun Jan 29 20:22:14 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:22:14 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Kill dead TODO (4538c79) Message-ID: <20170129202214.E2CCA3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/4538c794da02856e8567a3a6853115adf0ab9d90/ghc >--------------------------------------------------------------- commit 4538c794da02856e8567a3a6853115adf0ab9d90 Author: Ben Gamari Date: Sat Jan 28 21:53:09 2017 -0500 Kill dead TODO >--------------------------------------------------------------- 4538c794da02856e8567a3a6853115adf0ab9d90 compiler/typecheck/TcInteract.hs | 2 -- 1 file changed, 2 deletions(-) diff --git a/compiler/typecheck/TcInteract.hs b/compiler/typecheck/TcInteract.hs index 68041e2..9dfb454 100644 --- a/compiler/typecheck/TcInteract.hs +++ b/compiler/typecheck/TcInteract.hs @@ -2189,8 +2189,6 @@ doPrimRep rep_name ty -- | Representation for type constructor applied to some kinds. 'onlyNamedBndrsApplied' -- has ensured that this application results in a type of monomorphic kind (e.g. all -- kind variables have been instantiated). --- --- TODO: Do we want to encode the applied kinds in the representation? doTyConApp :: Class -> Type -> TyCon -> [Kind] -> TcS LookupInstResult doTyConApp clas ty tc kind_args = return $ GenInst (map (mk_typeable_pred clas) kind_args) From git at git.haskell.org Sun Jan 29 20:22:17 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:22:17 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: TcTypeable: Be more careful about non-representable types (eda8b06) Message-ID: <20170129202217.AA13F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/eda8b0682053e8ee102963e0a75c40b003307980/ghc >--------------------------------------------------------------- commit eda8b0682053e8ee102963e0a75c40b003307980 Author: Ben Gamari Date: Sat Jan 28 21:53:20 2017 -0500 TcTypeable: Be more careful about non-representable types >--------------------------------------------------------------- eda8b0682053e8ee102963e0a75c40b003307980 compiler/typecheck/TcTypeable.hs | 155 +++++++++++++++++++++++---------------- 1 file changed, 91 insertions(+), 64 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc eda8b0682053e8ee102963e0a75c40b003307980 From git at git.haskell.org Sun Jan 29 20:22:20 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:22:20 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Handle literal kinds (a617532) Message-ID: <20170129202220.693F43A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/a617532e85f03a84252d8273b94bf2ad7abe8997/ghc >--------------------------------------------------------------- commit a617532e85f03a84252d8273b94bf2ad7abe8997 Author: Ben Gamari Date: Sat Jan 28 23:17:43 2017 -0500 Handle literal kinds >--------------------------------------------------------------- a617532e85f03a84252d8273b94bf2ad7abe8997 compiler/prelude/PrelNames.hs | 12 +++++++- compiler/typecheck/TcTypeable.hs | 63 +++++++++++++++++++++++----------------- libraries/ghc-prim/GHC/Types.hs | 31 +++++++++----------- 3 files changed, 62 insertions(+), 44 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc a617532e85f03a84252d8273b94bf2ad7abe8997 From git at git.haskell.org Sun Jan 29 20:22:23 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:22:23 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Generate Typeable declarations for types in hs-boot files (4268d60) Message-ID: <20170129202223.21F483A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/4268d6014c5c4d468d6791f877aa30e5dd6d82e6/ghc >--------------------------------------------------------------- commit 4268d6014c5c4d468d6791f877aa30e5dd6d82e6 Author: Ben Gamari Date: Sat Jan 28 23:38:40 2017 -0500 Generate Typeable declarations for types in hs-boot files >--------------------------------------------------------------- 4268d6014c5c4d468d6791f877aa30e5dd6d82e6 compiler/typecheck/TcRnDriver.hs | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/compiler/typecheck/TcRnDriver.hs b/compiler/typecheck/TcRnDriver.hs index 28ca41b..7430175 100644 --- a/compiler/typecheck/TcRnDriver.hs +++ b/compiler/typecheck/TcRnDriver.hs @@ -581,6 +581,10 @@ tcRnHsBootDecls hsc_src decls <- tcTyClsInstDecls tycl_decls deriv_decls val_binds ; setGblEnv tcg_env $ do { + -- Emit Typeable bindings + ; tcg_env <- pprTrace "tcRnHsBootDecls" (ppr tycl_decls) mkTypeableBinds + ; setGblEnv tcg_env $ do { + -- Typecheck value declarations ; traceTc "Tc5" empty ; val_ids <- tcHsBootSigs val_binds val_sigs @@ -600,7 +604,7 @@ tcRnHsBootDecls hsc_src decls } ; setGlobalTypeEnv gbl_env type_env2 - }} + }}} ; traceTc "boot" (ppr lie); return gbl_env } badBootDecl :: HscSource -> String -> Located decl -> TcM () From git at git.haskell.org Sun Jan 29 20:22:25 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:22:25 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Simplify treatment of type lits (f99b787) Message-ID: <20170129202225.CEDD43A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/f99b787b421d2a1989bb29daf22a3611fc6d38aa/ghc >--------------------------------------------------------------- commit f99b787b421d2a1989bb29daf22a3611fc6d38aa Author: Ben Gamari Date: Sun Jan 29 00:57:39 2017 -0500 Simplify treatment of type lits >--------------------------------------------------------------- f99b787b421d2a1989bb29daf22a3611fc6d38aa compiler/prelude/PrelNames.hs | 71 +++++++++++++++++++++----------- compiler/typecheck/TcTypeable.hs | 20 +++++---- libraries/base/Data/Typeable/Internal.hs | 20 +++++++-- libraries/ghc-prim/GHC/Types.hs | 11 +++-- 4 files changed, 82 insertions(+), 40 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc f99b787b421d2a1989bb29daf22a3611fc6d38aa From git at git.haskell.org Sun Jan 29 20:22:28 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:22:28 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Revert OccName changes (db8ec27) Message-ID: <20170129202228.85A623A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/db8ec27033daeb9add9baf71ba1e5fe498d0ddd9/ghc >--------------------------------------------------------------- commit db8ec27033daeb9add9baf71ba1e5fe498d0ddd9 Author: Ben Gamari Date: Sun Jan 29 01:12:19 2017 -0500 Revert OccName changes >--------------------------------------------------------------- db8ec27033daeb9add9baf71ba1e5fe498d0ddd9 compiler/basicTypes/OccName.hs | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/compiler/basicTypes/OccName.hs b/compiler/basicTypes/OccName.hs index 83cb41a..0de9801 100644 --- a/compiler/basicTypes/OccName.hs +++ b/compiler/basicTypes/OccName.hs @@ -73,7 +73,7 @@ module OccName ( mkPReprTyConOcc, mkPADFunOcc, mkRecFldSelOcc, - mkTyConRepOcc, mkKindRepOcc, + mkTyConRepOcc, -- ** Deconstruction occNameFS, occNameString, occNameSpace, @@ -610,7 +610,7 @@ mkDataConWrapperOcc, mkWorkerOcc, mkDataConWorkerOcc, mkNewTyCoOcc, mkInstTyCoOcc, mkEqPredCoOcc, mkClassOpAuxOcc, mkCon2TagOcc, mkTag2ConOcc, mkMaxTagOcc, - mkTyConRepOcc, mkKindRepOcc + mkTyConRepOcc :: OccName -> OccName -- These derived variables have a prefix that no Haskell value could have @@ -640,7 +640,6 @@ mkTyConRepOcc occ = mk_simple_deriv varName prefix occ where prefix | isDataOcc occ = "$tc'" | otherwise = "$tc" -mkKindRepOcc = mk_simple_deriv varName "$tk" -- Generic deriving mechanism mkGenR = mk_simple_deriv tcName "Rep_" From git at git.haskell.org Sun Jan 29 20:22:31 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:22:31 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Clean up build issues (cac1821) Message-ID: <20170129202231.43F7C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/cac1821ed54805762132892dedc069221fb25a33/ghc >--------------------------------------------------------------- commit cac1821ed54805762132892dedc069221fb25a33 Author: Ben Gamari Date: Sun Jan 29 01:35:23 2017 -0500 Clean up build issues >--------------------------------------------------------------- cac1821ed54805762132892dedc069221fb25a33 libraries/base/Data/Typeable/Internal.hs | 23 +++++++++++++++++------ libraries/base/Type/Reflection/Unsafe.hs | 2 +- 2 files changed, 18 insertions(+), 7 deletions(-) diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs index 646baa0..8e6e282 100644 --- a/libraries/base/Data/Typeable/Internal.hs +++ b/libraries/base/Data/Typeable/Internal.hs @@ -45,7 +45,7 @@ module Data.Typeable.Internal ( -- * TyCon TyCon, -- Abstract tyConPackage, tyConModule, tyConName, tyConKindVars, tyConKindRep, - KindRep(..), + KindRep(.., KindRepTypeLit), TypeLitSort(..), rnfTyCon, -- * TypeRep @@ -143,6 +143,8 @@ rnfKindRep (KindRepVar _) = () rnfKindRep (KindRepApp a b) = rnfKindRep a `seq` rnfKindRep b rnfKindRep (KindRepFun a b) = rnfKindRep a `seq` rnfKindRep b rnfKindRep (KindRepTYPE rr) = rnfRuntimeRep rr +rnfKindRep (KindRepTypeLitS _ _) = () +rnfKindRep (KindRepTypeLitD _ t) = rnfString t rnfRuntimeRep :: RuntimeRep -> () rnfRuntimeRep (VecRep !_ !_) = () @@ -330,7 +332,6 @@ typeRepKind (TrApp _ f _) | otherwise = error ("Ill-kinded type application: " ++ show (typeRepKind f)) typeRepKind (TrFun _ _ _) = typeRep @Type -typeRepKind t = error ("Ill-kinded type representation: "++show t) tyConKind :: TyCon -> [SomeTypeRep] -> SomeTypeRep tyConKind (TyCon _ _ _ _ nKindVars# kindRep) kindVars = @@ -352,7 +353,7 @@ instantiateKindRep vars = go = SomeTypeRep $ TRFun (unsafeCoerceRep $ go a) (unsafeCoerceRep $ go b) go (KindRepTYPE r) = unkindedTypeRep $ tYPE `kApp` runtimeRepTypeRep r go (KindRepTypeLitS sort s) - = mkTypeLitFromString sort (unpackString# s) + = mkTypeLitFromString sort (unpackCString# s) go (KindRepTypeLitD sort s) = mkTypeLitFromString sort s @@ -547,6 +548,16 @@ rnfSomeTypeRep (SomeTypeRep r) = rnfTypeRep r * * ********************************************************* -} +pattern KindRepTypeLit :: TypeLitSort -> String -> KindRep +pattern KindRepTypeLit sort t <- (getKindRepTypeLit -> Just (sort, t)) + where + KindRepTypeLit sort t = KindRepTypeLitD sort t + +getKindRepTypeLit :: KindRep -> Maybe (TypeLitSort, String) +getKindRepTypeLit (KindRepTypeLitS sort t) = Just (sort, unpackCString# t) +getKindRepTypeLit (KindRepTypeLitD sort t) = Just (sort, t) +getKindRepTypeLit _ = Nothing + -- | Exquisitely unsafe. mkTyCon# :: Addr# -- ^ package name -> Addr# -- ^ module name @@ -593,7 +604,7 @@ typeNatTypeRep p = typeLitTypeRep (show (natVal' p)) tcNat -- | Used to make `'Typeable' instance for things of kind Symbol typeSymbolTypeRep :: KnownSymbol a => Proxy# a -> TypeRep a -typeSymbolTypeRep p = typeSymbolTypeRep (show (symbolVal' p)) tcSymbol +typeSymbolTypeRep p = typeLitTypeRep (show (symbolVal' p)) tcSymbol mkTypeLitFromString :: TypeLitSort -> String -> SomeTypeRep mkTypeLitFromString TypeLitSymbol s = @@ -602,10 +613,10 @@ mkTypeLitFromString TypeLitNat s = SomeTypeRep $ (typeLitTypeRep s tcSymbol :: TypeRep Nat) tcSymbol :: TyCon -tcSymbol = typeRepTyCon typeRep +tcSymbol = typeRepTyCon (typeRep @Symbol) tcNat :: TyCon -tcNat = typeRepTyCon typeRep +tcNat = typeRepTyCon (typeRep @Nat) -- | An internal function, to make representations for type literals. typeLitTypeRep :: forall (a :: k). (Typeable k) => String -> TyCon -> TypeRep a diff --git a/libraries/base/Type/Reflection/Unsafe.hs b/libraries/base/Type/Reflection/Unsafe.hs index b9f71be..879d240 100644 --- a/libraries/base/Type/Reflection/Unsafe.hs +++ b/libraries/base/Type/Reflection/Unsafe.hs @@ -15,7 +15,7 @@ module Type.Reflection.Unsafe ( tyConKindRep, tyConKindVars, - KindRep(..), + KindRep(..), TypeLit(..), mkTrCon, mkTrApp, mkTyCon ) where From git at git.haskell.org Sun Jan 29 20:22:33 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:22:33 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: Clean up Data.Dynamic (42f4758) Message-ID: <20170129202233.ED7A43A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/42f475843e208d8f5517e731fe30ff985e3cc9a5/ghc >--------------------------------------------------------------- commit 42f475843e208d8f5517e731fe30ff985e3cc9a5 Author: Ben Gamari Date: Sun Jan 29 01:36:29 2017 -0500 Clean up Data.Dynamic >--------------------------------------------------------------- 42f475843e208d8f5517e731fe30ff985e3cc9a5 libraries/base/Data/Dynamic.hs | 2 -- 1 file changed, 2 deletions(-) diff --git a/libraries/base/Data/Dynamic.hs b/libraries/base/Data/Dynamic.hs index 446ad36..e7e6157 100644 --- a/libraries/base/Data/Dynamic.hs +++ b/libraries/base/Data/Dynamic.hs @@ -50,7 +50,6 @@ module Data.Dynamic import Data.Type.Equality import Type.Reflection import Data.Maybe -import Unsafe.Coerce import GHC.Base import GHC.Show @@ -87,7 +86,6 @@ instance Show Dynamic where -- | @since 4.0.0.0 instance Exception Dynamic -type Obj = Any -- Use GHC's primitive 'Any' type to hold the dynamically typed value. -- -- In GHC's new eval/apply execution model this type must not look From git at git.haskell.org Sun Jan 29 20:22:36 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:22:36 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable: fixup! Clean up build issues (75b19c0) Message-ID: <20170129202236.A5EE73A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttypeable Link : http://ghc.haskell.org/trac/ghc/changeset/75b19c023da7f6bafcfb3d9f39ef26378a07791a/ghc >--------------------------------------------------------------- commit 75b19c023da7f6bafcfb3d9f39ef26378a07791a Author: Ben Gamari Date: Sun Jan 29 01:37:55 2017 -0500 fixup! Clean up build issues >--------------------------------------------------------------- 75b19c023da7f6bafcfb3d9f39ef26378a07791a libraries/base/Type/Reflection/Unsafe.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/base/Type/Reflection/Unsafe.hs b/libraries/base/Type/Reflection/Unsafe.hs index 879d240..e1225b3 100644 --- a/libraries/base/Type/Reflection/Unsafe.hs +++ b/libraries/base/Type/Reflection/Unsafe.hs @@ -15,7 +15,7 @@ module Type.Reflection.Unsafe ( tyConKindRep, tyConKindVars, - KindRep(..), TypeLit(..), + KindRep(..), TypeLitSort(..), mkTrCon, mkTrApp, mkTyCon ) where From git at git.haskell.org Sun Jan 29 20:22:42 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 20:22:42 +0000 (UTC) Subject: [commit: ghc] wip/ttypeable's head updated: fixup! Clean up build issues (75b19c0) Message-ID: <20170129202242.B76863A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/ttypeable' now includes: d122935 Mark mapUnionFV as INLINABLE rather than INLINE 68f72f1 Replace INLINEABLE by INLINABLE (#12613) 55d92cc Update test output bc7c730 Pattern Synonyms documentation update 796f0f2 Print foralls in user format b0ae0dd Remove #ifdef with never fulfilled condition c36904d Fix layout of MultiWayIf expressions (#10807) f897b74 TH: Use atomicModifyIORef' for fresh names 0b6024c Comments and manual only: spelling 13d3b53 Test Trac #12634 f21eedb Check.hs: Use actual import lists instead of comments 0b533a2 A bit of tracing about flattening 2fbfbca Fix desugaring of pattern bindings (again) 66a8c19 Fix a bug in occurs checking 3012c43 Add Outputable Report in TcErrors b612da6 Fix impredicativity (again) fc4ef66 Comments only 5d473cd Add missing stderr file 3f27237 Make tcrun042 fail 28a00ea Correct spelling in note references b3d55e2 Document Safe Haskell restrictions on Generic instances 9e86276 Implement deriving strategies b61b7c2 CodeGen X86: fix unsafe foreign calls wrt inlining 59d7ee5 GHCi: Don't remove shadowed bindings from typechecker scope. 3c17905 Support more than 64 logical processors on Windows 151edd8 Recognise US spelling for specialisation flags. f869b23 Move -dno-debug-output to the end of the test flags d1b4fec Mark T11978a as broken due to #12019 1e795a0 Use check stacking on Windows. c93813d Add NUMA support for Windows 2d6642b Fix interaction of record pattern synonyms and record wildcards 1851349 Don't warn about name shadowing when renaming the patten in a PatSyn decl ce3370e PPC/CodeGen: fix lwa instruction generation 48ff084 Do not warn about unused underscore-prefixed fields (fixes Trac #12609) 0014fa5 ghc-pkg: Allow unregistering multiple packages in one call b0d53a8 Turn `__GLASGOW_HASKELL_LLVM__` into an integer again f547b44 Eliminate some unsafeCoerce#s with deriving strategies 23cf32d Disallow standalone deriving declarations involving unboxed tuples or sums 4d2b15d validate: Add --build-only 42f1d86 runghc: use executeFile to run ghc process on POSIX 3630ad3 Mark #6132 as broken on OS X 8cab9bd Ignore output from derefnull and divbyzero on Darwin e9104d4 DynFlags: Fix absolute import path to generated header eda5a4a testsuite: Mark test for #12355 as unbroken on Darwin. 22c6b7f Update Cabal submodule to latest version. 8952cc3 runghc: Fix import of System.Process on Windows 7a6731c genapply: update source file in autogenerated text c5d6288 Mark zipWithAndUnzipM as INLINABLE rather than INLINE e4cf962 Bring Note in TcDeriv up to date 465c6c5 Improve error handling in TcRnMonad 58ecdf8 Remove unused T12124.srderr 4a03012 Refactor TcDeriv and TcGenDeriv a2bedb5 RegAlloc: Make some pattern matched complete 57a207c Remove dead code “mkHsConApp” cbe11d5 Add compact to packages so it gets cleaned on make clean. e41b9c6 Fix memory leak from #12664 f3be304 Don't suggest deprecated flags in error messages 76aaa6e Simplify implementation of wWarningFlags 082991a Tc267, tests what happens if you forgot to knot-tie. 3b9e45e Note about external interface changes. 940ded8 Remove reexports from ghc-boot, help bootstrap with GHC 8. 887485a Exclude Cabal PackageTests from gen_contents_index. 00b530d The Backpack patch. 4e8a060 Distinguish between UnitId and InstalledUnitId. 5bd8e8d Make InstalledUnitId be ONLY a FastString. 027a086 Update haddock.Cabal perf for Cabal update. 61b143a Report that we support Backpack in --info. 46b78e6 Cabal submodule update. e660f4b Rework renaming of children in export lists. f2d80de Add trailing comma to fix the build. 21647bc Fix build 7b060e1 Generate a unique symbol for signature object stub files, fixes #12673 bcd3445 Do not segfault if no common root can be found 8dc72f3 Cleanup PosixSource.h 6c47f2e Default +RTS -qn to the number of cores 85e81a8 Turn on -n4m with -A16m or greater 1a9705c Escape lambda. b255ae7 Orient improvement constraints better b5c8963 Rename a parameter; trivial refactor 88eb773 Delete orphan where clause 76a5477 Move zonking out of tcFamTyPats cc5ca21 Improved stats for Trac #1969 a6111b8 More tests for Trac #12522 b5be2ec Add test case for #12689 f8d2c20 Add a broken test case for #12689 8fa5f5b Add derived shadows only for Wanted constraints d2959df Comments and equation ordering only bce9908 RnExpr: Actually fail if patterns found in expression 577effd testsuite: Bump T1969 allocations 184d7cb Add test for #12411 042c593 Add test for #12589 fef1df4 Add test for #12456 57f7a37 Add missing @since annotations 2fdf21b Further improve error handling in TcRn monad 015e9e3 Cabal submodule update. 1cccb64 Unique: Simplify encoding of sum uniques 34d933d Clean up handling of known-key Names in interface files 3991da4 MkIface: Turn a foldr into a foldl' aa06883 Improve find_lbl panic message 90df91a PrelInfo: Fix style 8c6a3d6 Add missing Semigroup instances for Monoidal datatypes in base d5a4e49 Make error when deriving an instance for a typeclass less misleading 3ce0e0b Build ghc-iserv with --export-dynamic 6c73932 Check for empty entity string in "prim" foreign imports 0d9524a Disable T-signals-child test on single-threaded runtime e39589e Fix Windows build following D2588 b501709 Fix Show derivation in the presence of RebindableSyntax/OverloadedStrings 512541b Add a forward reference for a Note afdde48 Correct name of makeStableName in haddock 3174beb Comments about -Wredundant-constraints 82b54fc Fix comment typo 692c8df Fix shadowing in mkWwBodies 609d2c8 Typo in comment a693d1c Correct order of existentials in pattern synonyms f7278a9 Fix wrapping order in matchExpectedConTy 1790762 Test Trac #12681 db71d97 Reduce trace output slightly 156db6b Add more variants of T3064 (in comments) a391a38 Comments only f43db14 Typos in comments 3adaacd Re-add accidentally-deleted line 9cb4459 testsuite: Work around #12554 deed418 testsuite: Mark break011 as broken 8b84b4f testsuite: Mark T10858 as broken on Windows 3325435 testsuite: Mark T9405 as broken on Windows 8bb960e testsuite/driver: Never symlink on Windows c6ee773 testsuite/timeout: Ensure that processes are cleaned up on Windows 17d696f validate: Allow user to override Python interpreter 7d2df32 testsuite/driver: More Unicode awareness 5b55e4b testsuite: Eliminate unnecessary compile_timeout_multiplier 2864ad7 testsuite/driver: Allow threading on Windows c5c6d80 testsuite: Mark T7037 as broken on Windows cf5eec3 Bump parallel submodule 8fa2cdb Track dep_finsts in exports hash, as it affects downstream deps. f148513 Add option to not retain CAFs to the linker API 1275994 remove unnecessary ifdef 46f5f02 fixup! Add option to not retain CAFs to the linker API 7129861 DynamicLoading: Replace map + zip with zipWith 161f463 ghc/Main.hs: Add import list to DynamicLoading fa8940e fix build failure on Solaris caused by usage of --export-dynamic a3bc93e Add some missing RTS symbols 3866481 Compute export hash based on ALL transitive orphan modules. 02f2f21 cmm/Hoopl/Dataflow: remove unused code 1f09c16 Test for newtype with unboxed argument 2cb8cc2 StgCmmPrim: Add missing write barrier. a6094fa configure.ac: Report Unregisterised setting 518f289 New story for abstract data types in hsig files. 7e77c4b Support constraint synonym implementations of abstract classes. 9df4ce4 Only delete instances when merging when there is an exact match. 01490b4 Mark previously failing backpack tests as passing, with correct output. c2142ca Fix Mac OS X build by removing space after ASSERT. c23dc61 check-cpp: Make it more robust ff225b4 Typos in comments 45bfd1a Refactor typechecking of pattern bindings 82efad7 Comments and trivial refactoring cdbc73a Test Trac #12507 d61c7e8 Make TcLevel increase by 1 not 2 3f5673f A collection of type-inference refactorings. 1f09b24 Accept 20% dedgradation in Trac #5030 compile time 9417e57 Refactor occurrence-check logic e1fc5a3 Define emitNewWantedEq, and use it 6ddba64 Improve TcCanonical.unifyWanted and unifyDerived f41a8a3 Add and use a new dynamic-library-dirs field in the ghc-pkg info acc9851 Fix failure in setnumcapabilities001 (#12728) 1050e46 rts: configure.ac should populate HAVE_LIBNUMA instead of USE_LIBNUMA a662f46 Skip T5611 on OSX as it fails non-deterministically. 3cb32d8 Add -Wcpp-undef warning flag 6e9a51c Refactoring: Delete copied function in backpack/NameShape b76cf04 cmm/Hoopl/Dataflow: minor cleanup aaede1e rts/package.conf.in: Fix CPP usage a6bcf87 Refactoring: Replace when (not ...) with unless in ErrUtils f084e68 rts: Move path utilities to separate source file 1c4a39d Prioritise class-level equality costraints 1221f81 Don't instantaite when typechecking a pattern synonym 08ba691 Take account of kinds in promoteTcType 03b0b8e Test Trac #12174 853cdae Test Trac #12081 a182c0e testsuite: Bump peak_megabytes_allocated for T3064 801c263 Fundeps work even for unary type classes 9f814b2 Delete extraneous backtick in users' guide 925d178 Make traceRn behave more like traceTc 488a9ed rts/linker: Move loadArchive to new source file 23143f6 Refine ASSERT in buildPatSyn for the nullary case. 48876ae Remove -dtrace-level b8effa7 CmmUtils: remove the last dataflow functions 3562727 Simple refactor to remove misleading comment f9308c2 Collect coercion variables, not type variables eefe86d Allow levity-polymorpic arrows 0eb8934 Fix typo in comment cc29eb5 Revert "rts/linker: Move loadArchive to new source file" 815b837 Minor doc addition as requested in #12774. 7187ded Clarify comments on kinds (Trac #12536) aae2b3d Make it possible to use +RTS -qn without -N 60343a4 Add test for #12732 5ebcb3a Document unpackClosure# primop 4b300a3 Minor refactoring in stg_unpackClosurezh 4e088b4 Fix a bug in parallel GC synchronisation 7ddbdfd Zap redundant imports 80d4a03 Typos in comments 795be0e Align GHCi's library search order more closely with LDs 0b70ec0 Have static pointers work with -fno-full-laziness. 19ce8a5 Sparc*: Prevent GHC from doing unaligned accesses 79fb6e6 Tiny refactor 9968949 Get rid of TcTyVars more assiduously 7a50966 Simplify the API for TcHsType.kcHsTyVarBndrs f4a14d6 Use substTyUnchecked in TcMType.new_meta_tv_x 13508ba Fix Trac #12797: approximateWC 623b8e4 Renaming and comments in CorePrep 8a5960a Uninstall signal handlers cc4710a testsuite: Simplify kernel32 glue logic f4fb3bc linker: Split out CacheFlush logic abfa319 linker: Shuffle configuration into LinkerInternals.h 43c8c1c linker: Move mmapForLinker declaration into LinkerInternals.h 3f05126 linker: Split symbol extras logic into new source file c3446c6 Shuffle declarations into LinkerInternals.h 6ea0b4f linker: Split PEi386 implementation into new source file f6c47df linker: Split MachO implementation into new source file bdc262c linker: Split ELF implementation into separate source file 6fecb7e linker: Move ARM interworking note to SymbolExtras.c dc4d596 Hoopl/Dataflow: make the module more self-contained 80076fa Add notes describing SRT concepts b5460dd Add testcase for #12757 967dd5c Merge cpe_ExprIsTrivial and exprIsTrivial eaa3482 testsuite: Update T10858 allocations ec22bac Add test for #12788 f46bfeb API Annotations: make all ModuleName Located a977c96 Omit unnecessary linker flags e43f05b Add comments from Trac #12768 7b0ae41 Remove a debug trace 2cdd9bd Take account of injectivity when doing fundeps b012120 Handle types w/ type variables in signatures inside patterns (DsMeta) 1cab42d Update release notes for type sigs in TH patterns patch 1c886ea Stop -dno-debug-output suppressing -ddump-tc-trace 25c8e80 Add tracing infrastructure to pattern match checker 630d881 Allow GeneralizedNewtypeDeriving for classes with associated type families ead83db Describe symptoms of (and the cure for) #12768 in 8.0.2 release notes 1964d86 Some minor linker cleanups. 7d988dd Fix broken validate build. 91f9e13 Fix hs_try_putmvar003 (#12800) 2e8463b Update 8.0.2 release notes for #12784 2325afe Fix comment about pointer tagging 7fe7163 Adapt the (commented out) pprTrace in OccurAnal f05d685 Refactoring of mkNewTypeEqn 317236d Refactor CallStack defaulting slightly 500d90d ghc-cabal: Use correct name of linker flags env variable 816d2e4 build system: Include CONF_LD_LINKER_OPTS in ALL_LD_OPTS 9030d8e configure: Pass HC_OPTS_STAGEx to build system bae4a55 Pass -no-pie to GCC 0a122a4 testsuite: Update allocation numbers for T5631 e06e21a Add Richard Eisenberg's new email to mailmap bef7e78 Read parentheses better 122d826 rts: Add api to pin a thread to a numa node but without fixing a capability aa10c67 rts/linker: Move loadArchive to new source file e8ae4dc Update user's guide after D2490 03e8d26 Prevent GND from inferring an instance context for method-less classes 60bb9d1 Revert "Pass -no-pie to GCC" 7a7bb5d Revert "Refactor CallStack defaulting slightly" ec0bf81 rts: Fix LoadArchive on OS X d421a7e Pass -no-pie to GCC 46e2bef testsuite: Lower allocations for T876 7eae862 ghc-pkg: Munge dynamic library directories 2cfbee8 rts: Fix build when linked with gold 4e0b8f4 rts: Fix #include of 587dccc Make default output less verbose (source/object paths) 568e003 template-haskell: Version bump ca1b986 ghc: Fix ghc's template-haskell bound 8cb7bc5 rts: Fix references to UChar 6c0f10f Kill Type pretty-printer 55d535d Remove CONSTR_STATIC 034e01e Accept output for scc003 e0ca7ff Fix numa001 failure with "too many NUMA nodes" cb16890 testsuite: Fix creep of T4029 011af2b configure: Verify that GCC recognizes -no-pie flag 1b336d9 Skip 64-bit symbol tables 98f9759 Hopefully fix build on OS X 642adec Mark T12041 as expect_broken with -DDEBUG (#12826) 017d11e Typos in comments, notes and manual 31d5b6e fixup! Stop the simplifier from removing StaticPtr binds. 0e58652 Test for unnecessary register spills 4a835f0 Update xhtml submodule a637eeb Don't use mmap symbols when !RTS_LINKER_USE_MMAP 0135188 Storage.c: Pass a size to sys_icache_invalidate fa70b1e Fix -fobject-code with -fexternal-interpreter 7acee06 Avoid calling newDynFlags when there are no changes d3542fa Generalise the implicit prelude import 8dfca69 Inline compiler/NOTES into X86/Ppr.hs b769586 Fix windows validate 31398fb Test for type synonym loops on TyCon. 2878604 Correct spelling of command-line option in comment cede770 Correct name of Note in comment 07e40e9 Add Data instance for Const 18eb57b Revert "Add Data instance for Const" 9a4983d Pass autoconf triplets to sub-project configures 20fb781 LLVM generate llvm.expect for conditional branches 4d4f353 testsuite: Rip out hack for #12554 04b024a GHCi: Unconditionally import System.Directory 231a3ae Have reify work for local variables with functional dependencies. 9c39e09 Switch to LLVM version 3.9 94d1221 Add missing SMP symbols to RT linker. d328abc Spelling in comment only 3bd1dd4 Add Data instance for Const 4b72f85 Optimise whole module exports 6ad94d8 Updated code comment regarding EquationInfo. Trac #12856 ea37b83 A few typos in comments 5bce207 testsuite: Add test for #12855 926469f testsuite: Add test for #12024 b98dbdf testsuite: Add (still broken) testcase for #12447 e7ec521 testsuite: Add (still failing) testcase for #12550 ea76a21 add ieee754 next* functions to math_funs 514acfe Implement fine-grained `-Werror=...` facility 4c0dc76 Ignore Hadrian build products. 7e4b611 Make transformers upstream repository location consistent with others 1399c8b ghc/hschooks.c: Fix include path of Rts.h f430253 Allow to unregister threadWaitReadSTM action. 14ac372 Collect wildcards in sum types during renaming (#12711) d081fcf Make quoting and reification return the same types 9a431e5 Make a panic into an ASSERT 0476a64 Fix a bug in mk_superclasses_of f04f118 Comments only in TcType 0123efd Add elemDVarEnv 1eec1f2 Another major constraint-solver refactoring 18d0bdd Allow TyVars in TcTypes 4431e48 Remove redundant kind check 90a65ad Perf improvements in T6048, T10547 e319466 Typos in comments c1b4b76 Fix a name-space problem with promotion f0f4682 Test Trac #12867 83a952d Test Trac #12845 a5a3926 Kill off ifaceTyVarsOfType bc35c3f Use 'v' instead of 'tpl' for template vars edbe831 Use TyVars in a DFunUnfolding 12eff23 Use TyVars in PatSyns 5f349fe Improve pretty-printing of types eb55ec2 Refactor functional dependencies a bit 1bfff60 Fix inference of partial signatures 086b483 A tiny bit more tc tracing f8c966c Be a bit more selective about improvement 6ec2304 Fix an long-standing bug in OccurAnal 5238842 Typos in comments only [ci skip] 605af54 Test Trac #12776 27a6bdf Test Trac #12885 3aa9368 Comments only (related to #12789) abd4a4c Make note of #12881 in 8.0.2 release notes f8c8de8 Zonk the free tvs of a RULE lhs to TyVars e755930 Typos in comments 36e3622 Store string as parsed in SourceText for CImport 1732d7a Define thread primitives if they're supported. 30cecae users_guide: Bring 8.0.2 release notes up-to-date with ghc-8.0 branch f1fc8cb Make diagnostics slightly more colorful 52222f9b Detect color support da5a61e Minor cleanup of foldRegs{Used,Defd} 2d99da0 testsuite: Mention CLEANUP option in README 3ec8563 Replace -fshow-source-paths with -fhide-source-paths c2268ba Refactor Pattern Match Checker to use ListT 6845087 Purge GHC of literate Perl 4d4e7a5 Use newBlockId instead of newLabelC 7753273 AsmCodeGen: Refactor worker in cmmNativeGens 6d5c2e7 NCGMonad: Add MonadUnique NatM instance eaed140 OrdList: Add Foldable, Traversable instances fe3748b testsuite: Bump haddock.compiler allocations 795f8bd hschooks.c: Ensure correct header file is included 6f7ed1e Make globals use sharedCAF 56d7451 Fix type of GarbageCollect declaration 428e152 Use C99's bool 758b81d rts: Add missing #include 23dc6c4 Remove most functions from cmm/BlockId b92f8e3 Added Eq1, Ord1, Read1 and Show1 instances for NonEmpty 679ccd1 Hoopl/Dataflow: use block-oriented interface 0ce59be Fix testsuite threading, timeout, encoding and performance issues on Windows dd9ba50 Update test output for Windows 605bb9b testsuite: Use python3 by default 20c0614 Update Mingw-w64 bindist for Windows ef37580 Fix windows validate. be8a47f Tweaks to grammar and such. 03766cd Rename RuntimeRepPolymorphism to LevityPolymorphism e2330b6 Revert "Make globals use sharedCAF" c2a2911 Revert "Fix windows validate." 6c54fa5 testsuite: Add another testcase for #11821 0200ded Fix typo in functional dependencies doc f48f5a9e Ensure flags destined for ld are properly passed 514c01e Levity polymorphic expressions mustn't be floated-out in let-bindings. a452c6e Make note of #12907 in 8.0.2 release notes 0ac5e0c rts: Fix type of bool literal 7214e92 testsuite: Remove Unicode literals from driver 6576bf8 rts: Ensure we always give MADV_DONTNEED a chance in osDecommitMemory 0f37550 Typos in comments a934e25 testsuite: Actually update haddock.compiler allocations 7fafb84 testsuite/conc059: Don't attempt to use stdcall where it isn't supported 747e77c Fix naming of the native latin1 encodings ddc271e Travis: Add dependency on python3 27731f1 Note Trac #12141 in mk/build.mk.sample f46369b fdReady: use poll() instead of select() 895a131 Install toplevel handler inside fork. 2350906 Maintain in-scope set in deeply_instantiate (fixes #12549). eb6f673 8.2.1-notes.rst: tweak binutils version 90c5af4 core-spec: Fix S_MatchData 517d03e Fix an asymptotic bug in the occurrence analyser 6305674 Fix used-variable calculation (Trac #12548) e912310 Use isFamFreeTyCon now we have it 3e3f7c2 Test Trac #12925 847d229 Color output is wreaking havoc on test results b82f71b Fix x86 Windows build and testsuite eec02ab Give concrete example for #12784 in 8.0.2 release notes 24e6594 Overhaul GC stats 19ae142 Mark rn017 and T7672 as expect_broken(#12930) with -DDEBUG 6e4188a Fix unsafe usage of `is_iloc` selector in Ord instance for ImportSpec eafa06d Revert "Mark rn017 and T7672 as expect_broken(#12930) with -DDEBUG" b7e88ee Reduce the size of string literals in binaries. 41ec722d Test Trac #12919 39143a4 Mark T9577 as broken on Darwin due to #12937 4dd6b37 Really mark T9577 as broken 7036fde Overhaul of Compact Regions (#12455) c02aeb5 Ignore output for compact_gc: sizes change when profiling 5aa9c75 Fix the test with -O 9043a40 Fix crashes in hash table scanning with THREADED_RTS d70d452 rts: Use pthread itimer implementation on Darwin 83d69dc Don't barf() on failures in loadArchive() 499e438 Add HsSyn prettyprinter tests 58d78dc Fix pretty printer test to nog generate stdout 9bcc4e3 Remove stray commented out line in all.T c5fbbac Ignore stderr of all printer tests 62332f3 Setup tcg_imports earlier during signature matching, so orphans are visible. 617d57d Reduce qualification in error messages from signature matching. 58c290a hschooks.c: Fix long line 5063edb arclint: Lint cabal files c766d53 rts/linker: Fix LoadArchive build on Windows 6889400 testsuite: Add test for #10249 1e5b7d7 Update Windows GCC driver. 55361b3 nativeGen: Fix string merging on Windows 2bb099e BlockId: remove BlockMap and BlockSet synonyms 6da6253 rts/PosixSource.h: Define __USE_MINGW_ANSI_STDIO on Windows f65ff2c Disambiguate reified closed type family kinds in TH 61932cd Bump haddock submodule d3b546b Scrutinee Constant Folding cee72d5 Disable colors unless printing to stderr 1c296c0c Export `warningGroups' and `warningHierarchies' 62418b8 Mark T12903 as broken on OS X 90fae01 Fix LLVM TBAA metadata 2823492 NCG: Implement trivColorable for PowerPC 64-bit ca593c7 testsuite: make tests respond to SIGINT properly d1df8d1 Ensure each test inherits the TEST_HC_OPTS 5349d64 Rename TH constructors for deriving strategies 24a4fe2 testsuite: Mark prog003 as broken on Windows 2618090 testsuite: Fix syntax error in rts/all.T 17ac9b1 rts: Provide _lock_file in symbol table on Windows 0ac5a00 Add `_unlock_file` to RTS symbols 490b942 Automate GCC driver wrapper c3c7024 Make globals use sharedCAF 818e027 Refactor pruning of implication constraints f1036ad Make dropDerivedSimples restore [WD] constraints 6720376 Disable T12903 due to flakiness d03dd23 Fix a long-standing bug in CSE bc3d37d Float unboxed expressions by boxing 8f6d241 Add infix flag for class and data declarations 24f6bec Sanity check if we pick up an hsig file without -instantiated-with. db23ccf Fix recompilation detection when set of signatures to merge changes. f723ba2 Revert "Float unboxed expressions by boxing" cc2e3ec base: Make raw buffer IO operations more strict cb582b6 Don't have CPP macros expanding to 'defined'. 9cb4a13 Fix Win32 x86 build validation after D2756 aa123f4 Fix testcase T12903 on OS X 7031704 print * in unicode correctly (fixes #12550) 8ec864d Fix pretty printing of top level SCC pragmas 9c9a222 Load orphan interfaces before checking if module implements signature 26ce99c Fix typo in users' guide 52c5e55 mk/config.mk.in: enable SMP on ARMv7+ (Trac #12981) 0c3341b Show constraints when reporting typed holes 6f7d827 Reset FPU precision back to MSVCRT defaults 8b2e588 Adds llvm-prof flavour 6370a56 Build terminfo on iOS. 3c7cf18 Fix pprCLabel on platforms without native codegen. be5384c testsuite: Mark T9577 as broken due to #12965 27287c8 procPointAnalysis doesn't need UniqSM fe5d68a Add entry to .gitignore to for __.SYMDEF_SORTED 9550b8d Make unboxedTuple{Type,Data}Name support 0- and 1-tuples 2940a61 testsuite: Specify expected allocations of T12877 for Windows 5c76f83 check-ppr: Add a --dump flag to aid in debugging 394231b Fix cost-centre-stacks bug (#5654) 1ec632f Fix pretty printing of MINIMAL signatures 503219e Warn about missing instance methods that start with an underscore d398162 testsuite: Separate out Windows results for T5205 4d683fa base: Bump version to 4.10.0.0 8f0546b testsuite: Add test for #12971 0cad52d testsuite: Mark T10294 as fixed 81c4956 testsuite: Add test for #12966 cd4b202 array: Check for integer overflow during allocation 0d213c1 UniqSupply: Use full range of machine word ffc2327 base: Add more POSIX types (fixes #12795) 6fecb2a Verify that known-key uniques fit in interface file ed4cf03 Typos in comments 13c1fc4 DynFlags: Rip out remnants of WarnContextQuantification c889df8 Packages: Kill unused UnitId argument to isDllName 5bf344b CLabel: Kill redundant UnitId argument from labelDynamic 222e99d Make up a module name for c-- files 4026b45 Fix string merging with -split-sections 8f71d95 Enable split sections by default where possible c8ed1bd testsuite: Add test for #12993 2fa00f5 UNREG: include CCS_OVERHEAD to STG a6657bd revert '-Wl' prefixing to *_LD_OPTS c480860 rts/Compact.cmm: fix UNREG build failure d88efb7 Fix Pretty printer tests on Windows 0af959b Revert "Do not init record accessors as exported" 87c3b1d fix OpenBSD linkage (wxneeded) 6c816c5 utils/genargs: delete unused tool 8906e7b Reshuffle levity polymorphism checks. 3dbd2b0 Windows: Improve terminal detection mechanism 2d1beb1 rts/win32/IOManager: Fix integer types 343b147 Reexport Language.Haskell.TH.Lib from Language.Haskell.TH 2a02040 Fix bug in previous fix for #5654 90cfa84 Run some tests with -fexternal-interpreter -prof 21dde81 Improve StringBuffer and FastString docs e0fe7c3 Docs: Delete duplicate paragraph in user guide 52ba947 Allow use of the external interpreter in stage1. 25b70a2 Check family instance consistency of hs-boot families later, fixes #11062. 630cfc3 Fix Haddock comment typo. b5d788a Introduce unboxedSum{Data,Type}Name to template-haskell 513eb6a Fix #12998 by removing CTimer 88e8194 T12035j: disable on NOSMP targets 4704d65 T8209: disable on NOSMP targets 7f5be7e T10296a: disable on NOSMP targets d327ebd regalloc_unit_tests: disable on UNREG targets bb74bc7 T8242: disable on NOSMP targets f1dfce1 Revert "Allow use of the external interpreter in stage1." 6263e10 Fix timeout's timeout on Windows c0c1f80 Mark T8089 as unbroken since #7325 is now resolved 27f7925 Allow use of the external interpreter in stage1. 4535fa2 Test Trac #12996 8fdb937 Make CompactionFailed a newtype 574abb7 Rewrite Note [Api annotations] for clarity. 9a29b65 Suppress duplicate .T files 1771da2 Fix typos (not test relevant) f97d489 Test Trac #12968, plus some comments c73a982 Add note for rebindable syntax of [a..b] c66dd05 Move typeSize/coercionSize into TyCoRep d250d49 Add INLINE pragamas on Traversable default methods e07ad4d Don't eta-expand in stable unfoldings 0a18231 Lint DFunUnfoldings 05d233e Move InId/OutId to CoreSyn c48595e Never apply worker/wrapper to DFuns 1a4c04b Fix 'SPECIALISE instance' c469db4 Test Trac #12950 74033c4 Improved perf for T12227 ccc918c Fix a forward reference to a Note 2189239 Disambiguate two Notes with identical names ee4e165 Support for abi-depends for computing shadowing. 99db12f Update ghc-cabal command line usage text. 46f7f31 Notes on parsing lists in Parser.y 41ade95 Fix another forward reference to a Note b7a6e62 Revert "Suppress duplicate .T files" efc4a16 Allow timeout to kill entire process tree. 7a13f1f Alpha-renaming and white space only f06b71a Fix a bug in ABot handling in CoreArity ea8f91d White space only 9a4af2c Comments only 11306d6 Ensure that even bottoming functions have an unfolding 432f952 Float unboxed expressions by boxing 793ddb6 Tiny refactor in CoreTidy 75e8c30 Propagate evaluated-ness a bit more faithfully ee872d3 Removed dead code in DsCCall.mk_alt b4c3a66 Push coercions in exprIsConApp_maybe 8712148 testsuite: Split out Windows allocations numbers for T12234 f95e669 users-guide: Kill extraneous link 8f89e76 rename: Don't require 'fail' in non-monadic contexts 158530a Add caret diagnostics 46a195f Use python3 for linters 1b06231 Fix test for T12877 94d2cce base: Override Foldable.{toList,length} for NonEmpty 2689a16 Define MAP_ANONYMOUS on systems that only provide MAP_ANON 48a5da9 rename: Add note describing #11216 9331e33 check-ppr: Make --dump the default behavior 3c9fbba Remove redudant import from check-ppr 815099c CallArity: Use exprIsCheap to detect thunks d2788ab Expand I/O CP in comments 88f5add testsuite: Fix T13025 4dec7d1 Testsuite: Skip failing tests on PowerPC 64-bit f3b99c7 Bump array submodule a370440 Fix various issues with testsuite code on Windows bab4ae8 Fix incorrect statement about plugin packages. 9ff0738 Remove documentation about non-existent flag. c560957 Disallow users to write instances of KnownNat and KnownSym cc0abfa Update .mailmap b28ca38 Don't suggest enabling TypeApplications when it's already enabled 8d63ca9 Refactor importdecls/topdecls parsing. 5800b02 Add specialization rules for realToFrac on Complex 683ed47 Don't use $ in the definition of (<**>) in GHC.Base 6b3c039 Typo in manual [ci skip] df72368 Typofixes in manual and comments [ci skip] 2664641 Remove a redundant test c909e6e Minor refactoring in CSE baf9ebe Ensure nested binders have Internal Names 19d5c73 Add a CSE pass to Stg (#9291) 5d2a92a Use atomic counter for GHC.Event.Unique 5797784 Remove single top-level section in Foldable docs 5ef956e Fix doctests in Data.Functor 5f91ac8 Coerce for fmapDefault and foldMapDefault e6aefd6 Use the right in-scope set 3540d1e Avoid exponential blowup in FamInstEnv.normaliseType b4f2afe Fix the implementation of the "push rules" 5088110 Add performance test for #13056 3a18baf More fixes for #5654 f3c7cf9 Add missing stderr file for T13035 e5d1ed9 Have addModFinalizer expose the local type environment. 54227a4 Actually add the right file for T13035 stderr c5452cc Revert "Have addModFinalizer expose the local type environment." c1ed955 Have addModFinalizer expose the local type environment. 7b317ef TH: Add Trustworthy language pragma 6c869f9 Parse holes as infix operators 7d2e5da Fix zonk_eq_types in TcCanonical a8a714e Typos in comments (and in a test) 1a6bdca Make HsIParamTy have a Located HsIPName e94b07d CmmCommonBlockElim: Ignore CmmUnwind nodes 6fe9b05 Properly detect MinTTY when running GHCi on Windows 0a6c257 -dead_strip is now the default on Darwin fe75d2d Ensure mkUserGuidePart is compiled with current GHC version e8d7432 testsuite: Add performance testcase from #12707 12ad4d4 Throw an exception on heap overflow 226c535 base: Add Foreign.ForeignPtr.plusForeignPtr. 8a76d32 Check that type variable does not reference itself in its kind signature 58e68b3 Enable subsections via symbols on iOS 89d4d26 users-guide: Produce OpenSearch description fe8bc14 Add doc header to Dynamic's re-export of Typeable 6de7613 event manager: Don't worry if attempt to wake dead manager fails eee8199 Remove deprecated InteractiveEval API 5857dfb Remove tyConString b1923ed Fix typo in comment c2bd62e Expose purgeObj in ObjLink 35a5b60 testsuite driver: don't append to existing output files 22845ad Fix terminal corruption bug and clean up SDoc interface. 266a9dc Don't use the splitter on Darwin 09bce7a Mark *FB functions INLINE[0] (Fixes #13001) 8b15fc4 Fix references in let/app invariant note 2be364a Inline partially-applied wrappers 436aa7a Revert "event manager: Don't worry if attempt to wake dead manager fails" 5f9c6d2 Support for using only partial pieces of included signatures. 9f169bc Attach warnings to non-PVP compatible uses of signatures. 0bbcf76 Warn if you explicitly export an identifier with warning attached. e41c61f Improve Backpack support for fixities. 5def07f Revamp Backpack/hs-boot handling of type class signatures. 8744869 Rewrite module signature documentation. f59aad6 Fix handling of closed type families in Backpack. 501de26 Improve coment in typecheckIfacesForMerging. f9df77e Add mkUserGuidePart.cabal to .gitignore c6b0486 Typos in manual, comments and tests 89ce9cd Small refactoring in TcErrors f5f6d42 Fix top-level constraint handling (Trac #12921) 6b976eb Record evaluated-ness on workers and wrappers d3ad013 Typos in comments 8b6fa4f Spelling fixes in non-exported data type a62701f Simplify CPP logic as we now need v7.10 for bootstrapping dde63e0 Require python3 like everywhere else too 13a8521 Desugar static forms to makeStatic calls. f63c8ef Use latin1 code page on Windows for response files. 331f88d Fix abort and import lib search on Windows db91d17 Properly introduce CTimer to System.Posix.Types c13151e Improve access violation reporting on Windows 1f48fbc Revert "Record evaluated-ness on workers and wrappers" 9d67f04 LLVM: Tweak TBAA metadata codegen 1ff3c58 Add dump-parsed-ast flag and functionality 4bfe3d4 Add missing test files for T13082. be79289 Unbreak libGHCi by adding missing symbol. 5a9a173 Refine exprOkForSpeculation 563d64f Comments about TyBinders (only) 715be01 Typos in manual and comments [ci skip] 38f289f Fix API Annotations for unboxed sums 769e3ee testsuite/recomp001: Sleep to ensure that GHC notices file change b1726c1 Bitmap: Use foldl' instead of foldr 19cc007 testsuite: Bump allocations for T12234 e7e5f7a Some 8.2.1 release notes for my stuff d5cd505 event manager: Don't worry if attempt to wake dead manager fails e195add Unquote ‘import’ in bad import error message d360ec3 Split mkInlineUnfolding into two functions 2b61f52 Unbreak build with ghc-7.10.1 e324e31 Typos in comments only [ci skip] 70472bf Spelling fixes in comments [ci skip] 3046dbb testsuite: Really fix recomp001 0b7cd65 Clean up RTS Linker Windows. 852c6a0 Modify ForeignPtr documentation in light of plusForeignPtr 181688a Improve suggestion for misspelled flag including '=' (fixes #11789) 0d769d5 Add CBool to Foreign.C.Types 38374ca Fix get_op in the case of an unambiguous record selector (#13132) e7985ed Update levity polymorphism f5bea98 Fix the GHC 7.10 build f07a6c1 Don't error on missing Perl, just warn and disable object splitting. bf1e1f3 Add explicit foldMap implementation for Maybe 9be18ea Fix a nasty bug in exprIsExpandable b78fa75 Simplify and improve CSE b8f1b01 Test Trac #11444 5ff812c check-cpp.py: change rb'foo' to br'foo' for Python 3.2 compatibility 7026edc Add 'type family (m :: Symbol) <> (n :: Symbol)' a2a67b7 Bump Cabal submodule d49b2bb Allow top-level string literals in Core (#8472) 33140f4 Show explicit quantifiers in conflicting definitions error b476131 Add a failing test for #13099 b626a00 testsuite: Don't fail if "target has RTS linker" field is missing c43011d Clean up some shell code and M4 quoting 15b9a85 Warn on missing home modules f9ccad2 Always use -Xlinker for -rpath 560bc28 Revert "Remove unnecessary isTyVar tests in TcType" 238f31c configure.ac: Eliminate stray close bracket 3f1a21d testsuite: Bump allocations on T5321Fun and T12707 5d38fb6 Remove clean_cmd and extra_clean usage from .T files 294f95d Preserve coercion axioms when thinning. bbe8956 Rewrite Backpack comments on never-exported TyThings. 9ef237b Failing test for #13149. 6850eb6 Improve pretty-printing of IfaceCoercions 2b64e92 Apply the right substitution in ty-fam improvement 80560e6 Typos and grammar in manual/comments 18ceb14 Make checkFamInstConsistency faster 729a5e4 Don't quantify implicit type variables when quoting type signatures in TH 596dece Record evaluated-ness on workers and wrappers 532c6ad Make tickishContains faster 368d547 typecheck: Fix note 1761bfa users-guide: Document -dppr-ticks 53e2e70 Ensure that scrutinee constant folding wraps numbers abaa681 Re-sort case alternatives after scrutinee constant folding (#13170) a8c81f3 Document -fspecialise-aggressively 8f49f6d Add a failing test for #13102 7726fd7 Remove unused LOCAL_GHC_PKG definition from a test Makefile 90e83a7 Skip path_with_commas when dyn unavailable 9fd87ef Don't put foralls in front of TH-spliced GADT constructors that don't need them 99f8182 Partially revert D3001 deb75cb UniqSet: Implement unionManyUniqSets in terms of foldl' instead of foldr efc8e3b nativeGen: Use `foldl'` instead of `foldr` in free register accumulation 2cc67ad HscTypes: Use foldl' instead of foldr 2aaafc8 Bump Win32 version. 65cc762 testsuite: Bump compiler allocations of T5837 675b54f Update .mailmap e4ae78a Typos in comments [ci skip] a1cd959 Add myself [ci skip] 078c211 Update Win32 submodule to fix Windows build 1a3f1ee COMPLETE pragmas for enhanced pattern exhaustiveness checking 95dc6dc Template Haskell support for COMPLETE pragmas c344005 Generalize the type of runRW# e4ab8ba Add pragCompleteDName to templateHaskellNames 88a89b7 Nix typo and redundant where-clauses ff9355e Typos in comments [ci skip] 0d1cb15 Make type import/export API Annotation friendly 50544ee Prune unneeded Derive* language pragmas ad3d2df Don't unnecessarily qualify TH-converted instances with empty contexts 3eebd1f Generalizes the type of asProxyTypeOf (#12805) d8cb4b0 Bump nofib submodule 4e63e85 Bump hsc2hs submodule 2ffcdfa Fatal if we try to reinitialize the RTS 06b9561 Fix the right-shift operation for negative big integers (fixes #12136) 2af38b0 Remove Data.Tuple doc's claim to have tuple types 4206a0c [WIP] Coercion: Represent arrows explicitly 5c522f9 TcSMonad: Introduce tcLookupId 16e3617 CoreLint: Improve debug output 0ac9466 Start implementing library side of TTypeable b3ffe51 Fix rebase d78b3fd Add quick compatibility note 473288e Fix warnings 91e5c2f Various fixes 69ddbb9 Fix serialization ebde9e4 Implement Data.Typeable.funResultTy 74b9694 Binary: More explicit pattern matching 1d16eb5 More serialization 7e16c17 Message: Import Data.Typeable.TypeRep 482e7cd TcInteract: Unused parameter ca62568 Fix a few TTypeRep references e245e83 Fix recursive fingerprints ace8fd9 Finally serialization is both general and correct 2671802 Break recursive loop in serialization 12477d6 Kill todo ce229eb Fix up representation pretty-printer e68d961 Another recursive serialization case 8d7ed74 TcTypeable: Don't generate bindings for special primitive tycons bdff108 Move special tycons f83025c Internal things 57ec619 Fix primitive types fe5bcf6 Fix pretty-printer e01ebe4 Kill debugShow 957ac8d Inline space 73e17b3 Accept easy test output ff407d5 Add mkFunTy 7d8c0c3 More test fixes 8c3cc63 Fix T8132 3006200 Render TYPE 'PtrRepLifted as * b106230 Internal: Rename type variable eef1797 Implement withTypeable 1410730 Bump base to 4.10.0 e6f1b12 Fix withTypeable aa8510a Rework Show bfdeae0 Clarify serialization errors 2db3572 Kill redundant comment 0a16af4 Note need for mkTrApp 9abac3c Make TRApp bidirectional 3bd60ba Add TRArrow pattern synonym 4daf937 Fix up type printer 0eacb10 TcInteract: Fix something 622eb75 Fix showTypeable ee5a085 Fix serialization 6371dba Clarify comments 2a7b4e8 Binary: Simple serialization test works f03a227 Give unboxed tuples type representations 4c17891 testsuite/TypeRep: Add test for #12409 009b607 testsuite: Add test of Typeable Binary instances 63d611b TcTypeable: Clarify comment 414aa45 Temporarily override submodule upstream repo paths 82897d3 Add a TestEquality TypeRep instance 26952ca Debug f6bcb2d Add reference to precedence note 4b79d99 Unpack the fingerprints 0098ba2 Fix it 765bc30 Introduce TrFun 10f40d5 Things 541c138 Rename TypeRepX to SomeTypeRep 611e199 Begin reverting to Simon's story d86c376 Begin reintroducing typeRepKind 1a644df Continue reintroduction of kind representations 2c2c2c6 Continue 979b758 Rip out manual TypeReps be9f9f2 base: Derive Enum, Bounded for VecCount, VecElem a52df0a Getting there f74e8f2 Enum Vec* 7c41111 TcTypeable: Fix it 0d039fa Fix up submodules cc90a29 TcTypeable: It compiles GHC.Types! 2fc04db TcTypeable: Kill tracing 2fa2dae Message: Fix it d53585c ghc-bin: Bump time bound 5988da0 Fix it e912ddf Things ac90630 Fixes 5554455 Revert "TcTypeable: Kill tracing" ed590f0 Fix up rebase b169b7e Un-bump time bound 4f27d3d Fix unique clash c56580f Fix hs-boot file ccd8b09 Fix up Binary instances 2bba4e0 Add explicit forall to SomeTypeRep 8bd1218 TcTypeable: Look through type synonyms a0b139d Fix utils/Binary 142f89c Begin work on kind computation 80800f0 Binary: Compatibility with base<4.10 529bbc9 TcTypeable: Fix kind variable count 0129388 TcTypeable: A bit more debug output and fix binder ordering 5e00482 Internal: Various cleanups 8e5addb Hi f0a6eec Reenable Core Lint dfd90e2 Fix up obviously incorrect comparisons e93b95e Clean up whitespace 132fddc Fix kind instantiation 81b9058 Export mkTrFun 4538c79 Kill dead TODO eda8b06 TcTypeable: Be more careful about non-representable types a617532 Handle literal kinds 4268d60 Generate Typeable declarations for types in hs-boot files f99b787 Simplify treatment of type lits db8ec27 Revert OccName changes cac1821 Clean up build issues 42f4758 Clean up Data.Dynamic 75b19c0 fixup! Clean up build issues From git at git.haskell.org Sun Jan 29 21:25:57 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 29 Jan 2017 21:25:57 +0000 (UTC) Subject: [commit: ghc] master: UNREG: add a forward declaration for local literals (4441f90) Message-ID: <20170129212557.687163A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4441f90738e27ea7ba368723f27d19c03093aa66/ghc >--------------------------------------------------------------- commit 4441f90738e27ea7ba368723f27d19c03093aa66 Author: Sergei Trofimovich Date: Sun Jan 29 21:11:40 2017 +0000 UNREG: add a forward declaration for local literals When toplevel literals don't have a way to be exported from module GHC infers their labels as static. Example from GHC.Arr: static char rdVA_bytes[] = " out of range "; When this label is used in module internally we also need to provide it's forward declaration. Signed-off-by: Sergei Trofimovich >--------------------------------------------------------------- 4441f90738e27ea7ba368723f27d19c03093aa66 includes/Stg.h | 1 + 1 file changed, 1 insertion(+) diff --git a/includes/Stg.h b/includes/Stg.h index e3de331..939bed6 100644 --- a/includes/Stg.h +++ b/includes/Stg.h @@ -224,6 +224,7 @@ typedef StgWord StgWordArray[]; typedef StgFunPtr F_; #define EB_(X) extern char X[] +#define IB_(X) static char X[] #define EI_(X) extern StgWordArray (X) GNU_ATTRIBUTE(aligned (8)) #define II_(X) static StgWordArray (X) GNU_ATTRIBUTE(aligned (8)) #define IF_(f) static StgFunPtr GNUC3_ATTRIBUTE(used) f(void) From git at git.haskell.org Mon Jan 30 14:34:12 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 30 Jan 2017 14:34:12 +0000 (UTC) Subject: [commit: ghc] master: Fix mismatched tick in GHC.Generics documentation (f60287c) Message-ID: <20170130143412.6E8293A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f60287c478a5f52bcb7e558c0995f552713772d1/ghc >--------------------------------------------------------------- commit f60287c478a5f52bcb7e558c0995f552713772d1 Author: Ryan Scott Date: Mon Jan 30 09:31:47 2017 -0500 Fix mismatched tick in GHC.Generics documentation [ci skip] A Generic derivation example in the documentation of GHC.Generics put a tick (used for datatype promotion) in the wrong place. Fixes #13206. >--------------------------------------------------------------- f60287c478a5f52bcb7e558c0995f552713772d1 libraries/base/GHC/Generics.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/base/GHC/Generics.hs b/libraries/base/GHC/Generics.hs index 2ba16ed..8e128d4 100644 --- a/libraries/base/GHC/Generics.hs +++ b/libraries/base/GHC/Generics.hs @@ -76,7 +76,7 @@ module GHC.Generics ( -- type 'Rep' (Tree a) = -- 'D1' ('MetaData \"Tree\" \"Main\" \"package-name\" 'False) -- ('C1' ('MetaCons \"Leaf\" 'PrefixI 'False) --- ('S1' '(MetaSel 'Nothing +-- ('S1' ('MetaSel 'Nothing -- 'NoSourceUnpackedness -- 'NoSourceStrictness -- 'DecidedLazy) From git at git.haskell.org Mon Jan 30 17:03:13 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 30 Jan 2017 17:03:13 +0000 (UTC) Subject: [commit: ghc] master: Fix deprecation warnings from containers (d2cf5de) Message-ID: <20170130170313.5F1ED3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d2cf5dea70acbffb6039dc5eda31c8ff03b8f43e/ghc >--------------------------------------------------------------- commit d2cf5dea70acbffb6039dc5eda31c8ff03b8f43e Author: Erik de Castro Lopo Date: Mon Jan 30 11:47:00 2017 -0500 Fix deprecation warnings from containers The functions that were causing warnings were deprecated in containers 0.5 and GHC is already using containers 0.5.9.1. Test Plan: validate Reviewers: rwbarton, bgamari, hsyl20, austin, dfeuer Reviewed By: dfeuer Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D3036 >--------------------------------------------------------------- d2cf5dea70acbffb6039dc5eda31c8ff03b8f43e compiler/coreSyn/TrieMap.hs | 8 ++++---- compiler/simplCore/FloatOut.hs | 4 ++-- compiler/utils/FiniteMap.hs | 2 +- compiler/utils/UniqDFM.hs | 4 ++-- compiler/utils/UniqFM.hs | 10 +++++----- 5 files changed, 14 insertions(+), 14 deletions(-) diff --git a/compiler/coreSyn/TrieMap.hs b/compiler/coreSyn/TrieMap.hs index f8546d1..4a6e245 100644 --- a/compiler/coreSyn/TrieMap.hs +++ b/compiler/coreSyn/TrieMap.hs @@ -119,7 +119,7 @@ instance TrieMap IntMap.IntMap where emptyTM = IntMap.empty lookupTM k m = IntMap.lookup k m alterTM = xtInt - foldTM k m z = IntMap.fold k z m + foldTM k m z = IntMap.foldr k z m mapTM f m = IntMap.map f m xtInt :: Int -> XT a -> IntMap.IntMap a -> IntMap.IntMap a @@ -130,7 +130,7 @@ instance Ord k => TrieMap (Map.Map k) where emptyTM = Map.empty lookupTM = Map.lookup alterTM k f m = Map.alter f k m - foldTM k m z = Map.fold k z m + foldTM k m z = Map.foldr k z m mapTM f m = Map.map f m @@ -939,8 +939,8 @@ xtTyLit l f m = StrTyLit n -> m { tlm_string = tlm_string m |> Map.alter f n } foldTyLit :: (a -> b -> b) -> TyLitMap a -> b -> b -foldTyLit l m = flip (Map.fold l) (tlm_string m) - . flip (Map.fold l) (tlm_number m) +foldTyLit l m = flip (Map.foldr l) (tlm_string m) + . flip (Map.foldr l) (tlm_number m) ------------------------------------------------- -- | @TypeMap a@ is a map from 'Type' to @a at . If you are a client, this diff --git a/compiler/simplCore/FloatOut.hs b/compiler/simplCore/FloatOut.hs index 3c220fe..475108c 100644 --- a/compiler/simplCore/FloatOut.hs +++ b/compiler/simplCore/FloatOut.hs @@ -497,10 +497,10 @@ addTopFloatPairs float_bag prs add (Rec prs1) prs2 = prs1 ++ prs2 flattenMajor :: MajorEnv -> Bag FloatBind -flattenMajor = M.fold (unionBags . flattenMinor) emptyBag +flattenMajor = M.foldr (unionBags . flattenMinor) emptyBag flattenMinor :: MinorEnv -> Bag FloatBind -flattenMinor = M.fold unionBags emptyBag +flattenMinor = M.foldr unionBags emptyBag emptyFloats :: FloatBinds emptyFloats = FB emptyBag M.empty diff --git a/compiler/utils/FiniteMap.hs b/compiler/utils/FiniteMap.hs index dccfca1..cb6e557 100644 --- a/compiler/utils/FiniteMap.hs +++ b/compiler/utils/FiniteMap.hs @@ -24,6 +24,6 @@ deleteList :: Ord key => [key] -> Map key elt -> Map key elt deleteList ks m = foldl (flip Map.delete) m ks foldRight :: (elt -> a -> a) -> a -> Map key elt -> a -foldRight = Map.fold +foldRight = Map.foldr foldRightWithKey :: (key -> elt -> a -> a) -> a -> Map key elt -> a foldRightWithKey = Map.foldrWithKey diff --git a/compiler/utils/UniqDFM.hs b/compiler/utils/UniqDFM.hs index bbf6bb0..10e8aa9 100644 --- a/compiler/utils/UniqDFM.hs +++ b/compiler/utils/UniqDFM.hs @@ -360,10 +360,10 @@ mapUDFM :: (elt1 -> elt2) -> UniqDFM elt1 -> UniqDFM elt2 mapUDFM f (UDFM m i) = UDFM (M.map (fmap f) m) i anyUDFM :: (elt -> Bool) -> UniqDFM elt -> Bool -anyUDFM p (UDFM m _i) = M.fold ((||) . p . taggedFst) False m +anyUDFM p (UDFM m _i) = M.foldr ((||) . p . taggedFst) False m allUDFM :: (elt -> Bool) -> UniqDFM elt -> Bool -allUDFM p (UDFM m _i) = M.fold ((&&) . p . taggedFst) True m +allUDFM p (UDFM m _i) = M.foldr ((&&) . p . taggedFst) True m instance Monoid (UniqDFM a) where mempty = emptyUDFM diff --git a/compiler/utils/UniqFM.hs b/compiler/utils/UniqFM.hs index be5da83..38d9434 100644 --- a/compiler/utils/UniqFM.hs +++ b/compiler/utils/UniqFM.hs @@ -237,7 +237,7 @@ disjointUFM :: UniqFM elt1 -> UniqFM elt2 -> Bool disjointUFM (UFM x) (UFM y) = M.null (M.intersection x y) foldUFM :: (elt -> a -> a) -> a -> UniqFM elt -> a -foldUFM k z (UFM m) = M.fold k z m +foldUFM k z (UFM m) = M.foldr k z m mapUFM :: (elt1 -> elt2) -> UniqFM elt1 -> UniqFM elt2 mapUFM f (UFM m) = UFM (M.map f m) @@ -285,10 +285,10 @@ ufmToSet_Directly :: UniqFM elt -> S.IntSet ufmToSet_Directly (UFM m) = M.keysSet m anyUFM :: (elt -> Bool) -> UniqFM elt -> Bool -anyUFM p (UFM m) = M.fold ((||) . p) False m +anyUFM p (UFM m) = M.foldr ((||) . p) False m allUFM :: (elt -> Bool) -> UniqFM elt -> Bool -allUFM p (UFM m) = M.fold ((&&) . p) True m +allUFM p (UFM m) = M.foldr ((&&) . p) True m seqEltsUFM :: ([elt] -> ()) -> UniqFM elt -> () seqEltsUFM seqList = seqList . nonDetEltsUFM @@ -312,13 +312,13 @@ nonDetKeysUFM (UFM m) = map getUnique $ M.keys m -- If you use this please provide a justification why it doesn't introduce -- nondeterminism. nonDetFoldUFM :: (elt -> a -> a) -> a -> UniqFM elt -> a -nonDetFoldUFM k z (UFM m) = M.fold k z m +nonDetFoldUFM k z (UFM m) = M.foldr k z m -- See Note [Deterministic UniqFM] to learn about nondeterminism. -- If you use this please provide a justification why it doesn't introduce -- nondeterminism. nonDetFoldUFM_Directly:: (Unique -> elt -> a -> a) -> a -> UniqFM elt -> a -nonDetFoldUFM_Directly k z (UFM m) = M.foldWithKey (k . getUnique) z m +nonDetFoldUFM_Directly k z (UFM m) = M.foldrWithKey (k . getUnique) z m -- See Note [Deterministic UniqFM] to learn about nondeterminism. -- If you use this please provide a justification why it doesn't introduce From git at git.haskell.org Mon Jan 30 19:02:55 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 30 Jan 2017 19:02:55 +0000 (UTC) Subject: [commit: ghc] master: Fixes bug #11046 (5593573) Message-ID: <20170130190255.EA4433A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/559357384e300355b62edb3d60dcc3fadb942a50/ghc >--------------------------------------------------------------- commit 559357384e300355b62edb3d60dcc3fadb942a50 Author: Iavor S. Diatchki Date: Mon Jan 30 11:57:35 2017 -0500 Fixes bug #11046 For some time now, type-level operators such as '+' have been treated as type constructors, rahter than type variables. This pathc fixes TH's `lookupName` function to account for this behavior. Reviewers: bgamari, austin, goldfire, RyanGlScott Reviewed By: RyanGlScott Subscribers: Phyx, thomie Differential Revision: https://phabricator.haskell.org/D3025 GHC Trac Issues: #11046 >--------------------------------------------------------------- 559357384e300355b62edb3d60dcc3fadb942a50 compiler/typecheck/TcSplice.hs | 3 ++- docs/users_guide/8.2.1-notes.rst | 3 +++ testsuite/tests/th/T11046.hs | 10 ++++++++++ testsuite/tests/th/T11046_helper.hs | 9 +++++++++ testsuite/tests/th/all.T | 1 + 5 files changed, 25 insertions(+), 1 deletion(-) diff --git a/compiler/typecheck/TcSplice.hs b/compiler/typecheck/TcSplice.hs index 9942107..15c3aba 100644 --- a/compiler/typecheck/TcSplice.hs +++ b/compiler/typecheck/TcSplice.hs @@ -1195,7 +1195,8 @@ lookupName is_type_name s occ :: OccName occ | is_type_name - = if isLexCon occ_fs then mkTcOccFS occ_fs + = if isLexVarSym occ_fs || isLexCon occ_fs + then mkTcOccFS occ_fs else mkTyVarOccFS occ_fs | otherwise = if isLexCon occ_fs then mkDataOccFS occ_fs diff --git a/docs/users_guide/8.2.1-notes.rst b/docs/users_guide/8.2.1-notes.rst index ae156cb..9a38299 100644 --- a/docs/users_guide/8.2.1-notes.rst +++ b/docs/users_guide/8.2.1-notes.rst @@ -193,6 +193,9 @@ Template Haskell type variables ``a`` and ``k`` as implicitly quantified. (:ghc-ticket:`13018` and :ghc-ticket:`13123`) +- Looking up type constructors with symbol names (e.g., ``+``) now works + as expected (:ghc-ticket:`11046`) + Runtime system ~~~~~~~~~~~~~~ diff --git a/testsuite/tests/th/T11046.hs b/testsuite/tests/th/T11046.hs new file mode 100644 index 0000000..3c07c77 --- /dev/null +++ b/testsuite/tests/th/T11046.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE TemplateHaskell #-} +module T11046 where + +import T11046_helper +import GHC.TypeLits +import Control.Monad(unless) + +$(check "GHC.TypeLits.*") +$(check "GHC.TypeLits.+") +$(check "GHC.TypeLits.Nat") diff --git a/testsuite/tests/th/T11046_helper.hs b/testsuite/tests/th/T11046_helper.hs new file mode 100644 index 0000000..f7fa19c --- /dev/null +++ b/testsuite/tests/th/T11046_helper.hs @@ -0,0 +1,9 @@ +{-# Language TemplateHaskell #-} +module T11046_helper where +import Language.Haskell.TH + +check :: String -> Q [Dec] +check x = do mb <- lookupTypeName x + case mb of + Nothing -> fail "Bug #11046 is still present." + Just _ -> return [] diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T index d378412..f05a634 100644 --- a/testsuite/tests/th/all.T +++ b/testsuite/tests/th/all.T @@ -370,3 +370,4 @@ test('T12993', normal, multimod_compile, ['T12993.hs', '-v0']) test('T13018', normal, compile, ['-v0']) test('T13123', normal, compile, ['-v0']) test('T13098', normal, compile, ['-v0']) +test('T11046', normal, multimod_compile, ['T11046','-v0']) From git at git.haskell.org Mon Jan 30 19:02:59 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 30 Jan 2017 19:02:59 +0000 (UTC) Subject: [commit: ghc] master: Add a flag to emit error messages as JSON (9169111) Message-ID: <20170130190259.EB3683A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/91691117fc194c525f58ccd5b266dd1d10493e5a/ghc >--------------------------------------------------------------- commit 91691117fc194c525f58ccd5b266dd1d10493e5a Author: Matthew Pickering Date: Mon Jan 30 11:53:17 2017 -0500 Add a flag to emit error messages as JSON This patch adds the flag `-ddump-json` which dumps all the compiler output as a JSON array. This allows tooling to more easily parse GHC's output to display to users. The flag is currently experimental and will hopefully be refined for the next release. In particular I have avoided any changes which involve significant refactoring and provided what is easy given the current infrastructure. Reviewers: austin, bgamari Reviewed By: bgamari Subscribers: DanielG, gracjan, thomie Differential Revision: https://phabricator.haskell.org/D3010 GHC Trac Issues: #13190 >--------------------------------------------------------------- 91691117fc194c525f58ccd5b266dd1d10493e5a compiler/basicTypes/SrcLoc.hs | 14 ++++ compiler/ghc.cabal.in | 1 + compiler/ghc.mk | 1 + compiler/main/DynFlags.hs | 98 +++++++++++++++++++++- compiler/main/DynFlags.hs-boot | 1 + compiler/main/ErrUtils.hs | 8 ++ compiler/main/ErrUtils.hs-boot | 7 +- compiler/main/GHC.hs | 1 + compiler/utils/Json.hs | 54 ++++++++++++ docs/users_guide/8.2.1-notes.rst | 4 + docs/users_guide/debugging.rst | 6 ++ testsuite/tests/driver/all.T | 2 + .../{ghci/scripts/ghci038.hs => driver/json.hs} | 5 +- testsuite/tests/driver/json.stderr | 8 ++ testsuite/tests/driver/json2.hs | 4 + testsuite/tests/driver/json2.stderr | 9 ++ 16 files changed, 218 insertions(+), 5 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 91691117fc194c525f58ccd5b266dd1d10493e5a From git at git.haskell.org Mon Jan 30 19:03:03 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 30 Jan 2017 19:03:03 +0000 (UTC) Subject: [commit: ghc] master: Fix broken tests (2ec1c83) Message-ID: <20170130190303.3FAAB3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2ec1c834ca1129b69f4dd3e2586d9f318cbb3fa6/ghc >--------------------------------------------------------------- commit 2ec1c834ca1129b69f4dd3e2586d9f318cbb3fa6 Author: Phil Ruffwind Date: Mon Jan 30 11:49:58 2017 -0500 Fix broken tests 1. DoParamM requires the FlexibleContexts pragma now. 2. topHandler02 and topHandler03 were broken as timeout.py failed to translate signals to exit codes. 3. topHandler03 does not produce a consistent stderr, as it depends on what the user has /bin/sh set to. dash writes "Terminated" whereas bash and zsh produce nothing in non-interactive mode. 4. The remaining tests are broken due to changes in the error message formatting. Test Plan: validate Reviewers: thomie, dfeuer, austin, hvr, bgamari Reviewed By: bgamari Subscribers: Phyx, dfeuer Differential Revision: https://phabricator.haskell.org/D2807 >--------------------------------------------------------------- 2ec1c834ca1129b69f4dd3e2586d9f318cbb3fa6 libraries/base/tests/all.T | 5 +---- libraries/base/tests/topHandler03.stderr | 1 - .../tests/deriving/should_fail/drvfail006.stderr | 8 +++----- testsuite/tests/rebindable/DoParamM.stderr | 20 ++++++++++---------- testsuite/tests/typecheck/should_compile/tc232.hs | 1 + testsuite/timeout/timeout.py | 8 ++++++-- 6 files changed, 21 insertions(+), 22 deletions(-) diff --git a/libraries/base/tests/all.T b/libraries/base/tests/all.T index 3211054..3be05af 100644 --- a/libraries/base/tests/all.T +++ b/libraries/base/tests/all.T @@ -138,9 +138,6 @@ test('CatEntail', normal, compile, ['']) test('T7653', high_memory_usage, compile_and_run, ['']) test('T7787', normal, compile_and_run, ['']) -def stderr_contains(pattern): - return normalise_errmsg_fun(lambda s: pattern if pattern in s else s) - test('topHandler01', when(opsys('mingw32'), skip), compile_and_run, ['']) test('topHandler02', [when(opsys('mingw32'), skip), @@ -148,7 +145,7 @@ test('topHandler02', signal_exit_code(2) ], compile_and_run, ['']) test('topHandler03', - [when(opsys('mingw32'), skip), stderr_contains('Terminated'), + [when(opsys('mingw32'), skip), ignore_stderr, signal_exit_code(15) ], compile_and_run, ['']) test('topHandler04', diff --git a/libraries/base/tests/topHandler03.stderr b/libraries/base/tests/topHandler03.stderr deleted file mode 100644 index e45928c..0000000 --- a/libraries/base/tests/topHandler03.stderr +++ /dev/null @@ -1 +0,0 @@ -Terminated diff --git a/testsuite/tests/deriving/should_fail/drvfail006.stderr b/testsuite/tests/deriving/should_fail/drvfail006.stderr index 3968d97..61900e8 100644 --- a/testsuite/tests/deriving/should_fail/drvfail006.stderr +++ b/testsuite/tests/deriving/should_fail/drvfail006.stderr @@ -1,6 +1,4 @@ -drvfail006.hs:9:45: - Can't make a derived instance of `MonadState T' - (even with cunning newtype deriving): - `MonadState' does not have arity 1 - In the newtype declaration for `T' +drvfail006.hs:9:45: error: + • ‘MonadState’ is not a unary constraint, as expected by a deriving clause + • In the newtype declaration for ‘T’ diff --git a/testsuite/tests/rebindable/DoParamM.stderr b/testsuite/tests/rebindable/DoParamM.stderr index 6328d08..8d37640 100644 --- a/testsuite/tests/rebindable/DoParamM.stderr +++ b/testsuite/tests/rebindable/DoParamM.stderr @@ -11,12 +11,12 @@ DoParamM.hs:286:28: error: Actual type: LIO Unlocked Locked () • In a stmt of a 'do' block: tlock2_do In the expression: - do { tlock2_do; - tlock2_do } + do tlock2_do + tlock2_do In an equation for ‘tlock4_do’: tlock4_do - = do { tlock2_do; - tlock2_do } + = do tlock2_do + tlock2_do DoParamM.hs:302:37: error: • Couldn't match type ‘Locked’ with ‘Unlocked’ @@ -24,11 +24,11 @@ DoParamM.hs:302:37: error: Actual type: LIO Locked Unlocked () • In a stmt of a 'do' block: unlock In the expression: - do { tlock2_do; - unlock; - unlock } + do tlock2_do + unlock + unlock In an equation for ‘tlock4'_do’: tlock4'_do - = do { tlock2_do; - unlock; - unlock } + = do tlock2_do + unlock + unlock diff --git a/testsuite/tests/typecheck/should_compile/tc232.hs b/testsuite/tests/typecheck/should_compile/tc232.hs index 9d5ede3..2fc8544 100644 --- a/testsuite/tests/typecheck/should_compile/tc232.hs +++ b/testsuite/tests/typecheck/should_compile/tc232.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE FlexibleContexts #-} {-# OPTIONS_GHC -fno-warn-redundant-constraints #-} -- This one fixed the constraint solver (Lint error) diff --git a/testsuite/timeout/timeout.py b/testsuite/timeout/timeout.py index 51fb63c..f3468ad 100644 --- a/testsuite/timeout/timeout.py +++ b/testsuite/timeout/timeout.py @@ -42,8 +42,12 @@ try: (pid2, res) = os.waitpid(pid, 0) if (os.WIFEXITED(res)): sys.exit(os.WEXITSTATUS(res)) - else: - sys.exit(res) + elif os.WIFSIGNALED(res): + # represent signals using the Bourne shell convention + sys.exit(128 + os.WTERMSIG(res)) + else: # WIFCONTINUED or WIFSTOPPED + killProcess(pid) + sys.exit(99) # unexpected except KeyboardInterrupt: sys.exit(98) From git at git.haskell.org Mon Jan 30 19:03:07 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 30 Jan 2017 19:03:07 +0000 (UTC) Subject: [commit: ghc] master: Check that a default type signature aligns with the non-default signature (7363d53) Message-ID: <20170130190307.41B573A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7363d5380e600e2ef868a069d5df6857d9e5c17e/ghc >--------------------------------------------------------------- commit 7363d5380e600e2ef868a069d5df6857d9e5c17e Author: Ryan Scott Date: Mon Jan 30 11:51:22 2017 -0500 Check that a default type signature aligns with the non-default signature Before, GHC was extremely permissive about the form a default type signature could take on in a class declaration. Notably, it would accept garbage like this: class Monad m => MonadSupply m where fresh :: m Integer default fresh :: MonadTrans t => t m Integer fresh = lift fresh And then give an extremely confusing error message when you actually tried to declare an empty instance of MonadSupply. We now do extra validity checking of default type signatures to ensure that they align with their non-default type signature counterparts. That is, a default type signature is allowed to differ from the non-default one only in its context - they must otherwise be alpha-equivalent. Fixes #12918. Test Plan: ./validate Reviewers: goldfire, simonpj, austin, bgamari Reviewed By: bgamari Subscribers: mpickering, dfeuer, thomie Differential Revision: https://phabricator.haskell.org/D2983 GHC Trac Issues: #12918 >--------------------------------------------------------------- 7363d5380e600e2ef868a069d5df6857d9e5c17e compiler/typecheck/Inst.hs | 4 + compiler/typecheck/TcTyClsDecls.hs | 212 ++++++++++++++++++++- compiler/typecheck/TcType.hs | 30 ++- docs/users_guide/8.2.1-notes.rst | 6 + docs/users_guide/glasgow_exts.rst | 53 ++++++ testsuite/tests/generics/T10361b.hs | 4 +- .../tests/typecheck/should_fail/T12151.stderr | 6 + testsuite/tests/typecheck/should_fail/T12918a.hs | 9 + .../tests/typecheck/should_fail/T12918a.stderr | 8 + testsuite/tests/typecheck/should_fail/T12918b.hs | 34 ++++ .../tests/typecheck/should_fail/T12918b.stderr | 41 ++++ testsuite/tests/typecheck/should_fail/T7437.stderr | 8 + testsuite/tests/typecheck/should_fail/all.T | 2 + 13 files changed, 405 insertions(+), 12 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 7363d5380e600e2ef868a069d5df6857d9e5c17e From git at git.haskell.org Mon Jan 30 19:03:09 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 30 Jan 2017 19:03:09 +0000 (UTC) Subject: [commit: ghc] master: Slighly clean up symbol loading error. (f41c27d) Message-ID: <20170130190309.F24973A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f41c27d3ffdddbb1afe07de1bd25205061194c93/ghc >--------------------------------------------------------------- commit f41c27d3ffdddbb1afe07de1bd25205061194c93 Author: Tamar Christina Date: Mon Jan 30 11:58:19 2017 -0500 Slighly clean up symbol loading error. The symbol not found error that is triggered during lazy-loading was a bit chaotic before. This reformats it a bit to: ``` ghc-stage2.exe: | E:\...\libLLVMSupport.a: unknown symbol `_ZN4llvm5APIntC1Ejyb' ghc-stage2.exe: | E:\...\libLLVMCore.a: unknown symbol `_ZN4llvm5APInt14AssignSlowCaseERKS0_' ghc-stage2.exe: | E:\...\libLLVMCore.a: unknown symbol `_ZN4llvm13ConstantRangeC1ENS_5APIntES1_' ghc-stage2.exe: | E:\...\libLLVMCore.a: unknown symbol `_ZN4llvm14FoldingSetImplC2Ej' ghc-stage2.exe: | E:\...\libLLVMCore.a: unknown symbol `_ZN4llvm15LLVMContextImplD1Ev' ghc-stage2.exe: | E:\...\libLLVMLTO.a: unknown symbol `_ZN4llvm11LLVMContextD1Ev' ghc-stage2.exe: | E:\...\libLLVMCore.a: unknown symbol `_ZNK4llvm5Value10getContextEv' ghc-stage2.exe: ^^ Could not load 'LLVMIsMultithreaded', dependency unresolved. See top entry above. ``` I have also thought about also showing the demangled names, as it may be useful for the end user. `libgcc` seems to provide a method for this so we wouldn't need any extra dependency. Any thoughts on this or would it not be useful? Reviewers: austin, erikd, simonmar, bgamari Reviewed By: bgamari Subscribers: RyanGlScott, thomie, #ghc_windows_task_force Differential Revision: https://phabricator.haskell.org/D3027 GHC Trac Issues: #13093, #13113 >--------------------------------------------------------------- f41c27d3ffdddbb1afe07de1bd25205061194c93 rts/Linker.c | 7 +++++-- rts/linker/PEi386.c | 2 +- 2 files changed, 6 insertions(+), 3 deletions(-) diff --git a/rts/Linker.c b/rts/Linker.c index 9462bdb..8945a96 100644 --- a/rts/Linker.c +++ b/rts/Linker.c @@ -870,12 +870,11 @@ SymbolAddr* loadSymbol(SymbolName *lbl, RtsSymbolInfo *pinfo) { /* Symbol can be found during linking, but hasn't been relocated. Do so now. See Note [runtime-linker-phases] */ - if (oc && oc->status == OBJECT_LOADED) { + if (oc && lbl && oc->status == OBJECT_LOADED) { oc->status = OBJECT_NEEDED; IF_DEBUG(linker, debugBelch("lookupSymbol: on-demand loading symbol '%s'\n", lbl)); int r = ocTryLoad(oc); if (!r) { - errorBelch("Could not on-demand load symbol '%s'\n", lbl); return NULL; } @@ -893,6 +892,10 @@ SymbolAddr* lookupSymbol( SymbolName* lbl ) { ACQUIRE_LOCK(&linker_mutex); SymbolAddr* r = lookupSymbol_(lbl); + if (!r) { + errorBelch("^^ Could not load '%s', dependency unresolved. See top entry above.\n", lbl); + fflush(stderr); + } RELEASE_LOCK(&linker_mutex); return r; } diff --git a/rts/linker/PEi386.c b/rts/linker/PEi386.c index 824c821..f29bb8b 100644 --- a/rts/linker/PEi386.c +++ b/rts/linker/PEi386.c @@ -1326,7 +1326,7 @@ ocResolve_PEi386 ( ObjectCode* oc ) S = (size_t) lookupSymbol_( (char*)symbol ); if ((void*)S == NULL) { - errorBelch("%" PATH_FMT ": unknown symbol `%s'\n", oc->fileName, symbol); + errorBelch(" | %" PATH_FMT ": unknown symbol `%s'", oc->fileName, symbol); return false; } } From git at git.haskell.org Mon Jan 30 19:03:12 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 30 Jan 2017 19:03:12 +0000 (UTC) Subject: [commit: ghc] master: Fix links to building guides in MAKEHELP.md (9af1fb2) Message-ID: <20170130190312.A95693A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9af1fb28dd60a6952117c23281ccee9cedaaba85/ghc >--------------------------------------------------------------- commit 9af1fb28dd60a6952117c23281ccee9cedaaba85 Author: Takenobu Tani Date: Mon Jan 30 11:59:42 2017 -0500 Fix links to building guides in MAKEHELP.md MAKEHELP.md has an old link to 'Building/Hacking'. I updated it to suitable links for new contributors. Reviewers: austin, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D3039 >--------------------------------------------------------------- 9af1fb28dd60a6952117c23281ccee9cedaaba85 MAKEHELP.md | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/MAKEHELP.md b/MAKEHELP.md index 8537cf9..2332984 100644 --- a/MAKEHELP.md +++ b/MAKEHELP.md @@ -3,7 +3,9 @@ Quick `make` guide for GHC For a "Getting Started" guide, see: - http://ghc.haskell.org/trac/ghc/wiki/Building/Hacking + https://ghc.haskell.org/trac/ghc/wiki/Building/QuickStart + https://ghc.haskell.org/trac/ghc/wiki/Building/Using + https://ghc.haskell.org/trac/ghc/wiki/Building/StandardTargets Common commands: From git at git.haskell.org Mon Jan 30 19:03:15 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 30 Jan 2017 19:03:15 +0000 (UTC) Subject: [commit: ghc] master: Simplify minusInteger in integer-gmp slightly (f984bf2) Message-ID: <20170130190315.5E8183A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f984bf2e1deedb4931c0c2d5b6b5128b8b154cb5/ghc >--------------------------------------------------------------- commit f984bf2e1deedb4931c0c2d5b6b5128b8b154cb5 Author: Reid Barton Date: Mon Jan 30 11:59:28 2017 -0500 Simplify minusInteger in integer-gmp slightly These two special cases were created in D2278 by mechanically inlining negateInteger into plusInteger. They aren't needed (the `minusInteger (S# x#) (S# y#)` case already handles all values correctly), and they can never help by avoiding an allocation, unlike the original special case in plusInteger, since we still have to allocate the result. Removing these special cases will save a couple comparisons and conditional branches in the common case of subtracting two small Integers. Test Plan: Existing test `plusMinusInteger` already tests the values in question. Reviewers: bgamari, goldfire, austin, hvr Reviewed By: bgamari, hvr Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D3034 >--------------------------------------------------------------- f984bf2e1deedb4931c0c2d5b6b5128b8b154cb5 libraries/integer-gmp/src/GHC/Integer/Type.hs | 2 -- 1 file changed, 2 deletions(-) diff --git a/libraries/integer-gmp/src/GHC/Integer/Type.hs b/libraries/integer-gmp/src/GHC/Integer/Type.hs index 0d279ef..d5f92b3 100644 --- a/libraries/integer-gmp/src/GHC/Integer/Type.hs +++ b/libraries/integer-gmp/src/GHC/Integer/Type.hs @@ -421,8 +421,6 @@ plusInteger (Jp# x) (Jn# y) -- | Subtract one 'Integer' from another. minusInteger :: Integer -> Integer -> Integer minusInteger x (S# 0#) = x -minusInteger (S# 0#) (S# INT_MINBOUND#) = Jp# (wordToBigNat ABS_INT_MINBOUND##) -minusInteger (S# 0#) (S# y#) = S# (negateInt# y#) minusInteger (S# x#) (S# y#) = case subIntC# x# y# of (# z#, 0# #) -> S# z# From git at git.haskell.org Mon Jan 30 19:03:18 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 30 Jan 2017 19:03:18 +0000 (UTC) Subject: [commit: ghc] master: Print COMPLETE pragmas in --show-iface (5f8e234) Message-ID: <20170130190318.205543A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5f8e23444caf7a3d085cd8d97762dc3ed777c297/ghc >--------------------------------------------------------------- commit 5f8e23444caf7a3d085cd8d97762dc3ed777c297 Author: Matthew Pickering Date: Mon Jan 30 11:59:11 2017 -0500 Print COMPLETE pragmas in --show-iface Reviewers: austin, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D3032 >--------------------------------------------------------------- 5f8e23444caf7a3d085cd8d97762dc3ed777c297 compiler/iface/IfaceSyn.hs | 4 ++++ compiler/iface/LoadIface.hs | 1 + 2 files changed, 5 insertions(+) diff --git a/compiler/iface/IfaceSyn.hs b/compiler/iface/IfaceSyn.hs index 7a1d427..d4dd51e 100644 --- a/compiler/iface/IfaceSyn.hs +++ b/compiler/iface/IfaceSyn.hs @@ -298,6 +298,10 @@ type IfaceAnnTarget = AnnTarget OccName data IfaceCompleteMatch = IfaceCompleteMatch [IfExtName] IfExtName +instance Outputable IfaceCompleteMatch where + ppr (IfaceCompleteMatch cls ty) = text "COMPLETE" <> colon <+> ppr cls + <+> dcolon <+> ppr ty + diff --git a/compiler/iface/LoadIface.hs b/compiler/iface/LoadIface.hs index 7c138c4..75f2b6a 100644 --- a/compiler/iface/LoadIface.hs +++ b/compiler/iface/LoadIface.hs @@ -1011,6 +1011,7 @@ pprModIface iface , ppr (mi_warns iface) , pprTrustInfo (mi_trust iface) , pprTrustPkg (mi_trust_pkg iface) + , vcat (map ppr (mi_complete_sigs iface)) ] where pp_hsc_src HsBootFile = text "[boot]" From git at git.haskell.org Mon Jan 30 19:03:20 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 30 Jan 2017 19:03:20 +0000 (UTC) Subject: [commit: ghc] master: Fix minor typo in README.md (e9a239c) Message-ID: <20170130190320.CE8123A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e9a239ce3569239768204c93a2eb90bfb0f3383d/ghc >--------------------------------------------------------------- commit e9a239ce3569239768204c93a2eb90bfb0f3383d Author: Takenobu Tani Date: Mon Jan 30 11:59:58 2017 -0500 Fix minor typo in README.md Reviewers: austin, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D3040 >--------------------------------------------------------------- e9a239ce3569239768204c93a2eb90bfb0f3383d README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.md b/README.md index 2cecbdc..a1b2354 100644 --- a/README.md +++ b/README.md @@ -77,7 +77,7 @@ this step has already been performed. These steps give you the default build, which includes everything optimised and built in various ways (eg. profiling libs are built). -It can take a long time. To customise the build, see the file `HACKING`. +It can take a long time. To customise the build, see the file `HACKING.md`. Filing bugs and feature requests ================================ From git at git.haskell.org Mon Jan 30 21:02:32 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 30 Jan 2017 21:02:32 +0000 (UTC) Subject: [commit: ghc] master: Turn libraries/integer-gmp/gmp/tarball into a submodule (32729d3) Message-ID: <20170130210232.78D323A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/32729d3586d7ecdeb8561b6d0b2a688db709560c/ghc >--------------------------------------------------------------- commit 32729d3586d7ecdeb8561b6d0b2a688db709560c Author: Reid Barton Date: Mon Jan 30 14:18:07 2017 -0500 Turn libraries/integer-gmp/gmp/tarball into a submodule The submodule repository contains the latest version of the GMP source distribution (6.1.2) with the doc/ subdirectory removed, as described in gmp/ghc.mk. Rather than applying the old patch from gmp/tarball/patch I moved its contents into gmp/gmpsrc.patch, canceling a patch related to memory management there. Experimentally, the PIC-related patch for OS X is still necessary. The upgrade to GMP 6.1.2 fixes #7655. Test Plan: Built on OS X with in-tree gmp and tested that the command `ghc -e 'length (show (2^(5*10^6) :: Integer))'` no longer segfaults. Reviewers: mpickering, hvr, austin, bgamari Reviewed By: bgamari Subscribers: mpickering, thomie Differential Revision: https://phabricator.haskell.org/D3044 GHC Trac Issues: #7655 >--------------------------------------------------------------- 32729d3586d7ecdeb8561b6d0b2a688db709560c .gitmodules | 5 +- libraries/integer-gmp/gmp/ghc.mk | 11 +- libraries/integer-gmp/gmp/gmp-tarballs | 1 + libraries/integer-gmp/gmp/gmpsrc.patch | 106 +- libraries/integer-gmp/gmp/tarball/README | 8 - .../gmp/tarball/gmp-5.0.3-nodoc-patched.tar.bz2 | Bin 2176824 -> 0 bytes libraries/integer-gmp/gmp/tarball/gmp-5.0.4.patch | 1584 -------------------- libraries/integer-gmp/gmp/tarball/patch | 103 -- mk/build.mk.sample | 2 +- 9 files changed, 93 insertions(+), 1727 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 32729d3586d7ecdeb8561b6d0b2a688db709560c From git at git.haskell.org Tue Jan 31 10:32:22 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 31 Jan 2017 10:32:22 +0000 (UTC) Subject: [commit: ghc] branch 'wip/D3050' created Message-ID: <20170131103222.2A9DC3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/D3050 Referencing: 43b1ae1d704ff80c8b27742178f6cecde39a3d68 From git at git.haskell.org Tue Jan 31 10:32:24 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 31 Jan 2017 10:32:24 +0000 (UTC) Subject: [commit: ghc] wip/D3050: Fix binary instance for SrcStrictness (43b1ae1) Message-ID: <20170131103224.E07473A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/D3050 Link : http://ghc.haskell.org/trac/ghc/changeset/43b1ae1d704ff80c8b27742178f6cecde39a3d68/ghc >--------------------------------------------------------------- commit 43b1ae1d704ff80c8b27742178f6cecde39a3d68 Author: alexbiehl Date: Tue Jan 31 10:54:50 2017 +0100 Fix binary instance for SrcStrictness Summary: Found while revisiting the binary serialization for interface files. Test Plan: Building and validating currently Reviewers: austin, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D3050 >--------------------------------------------------------------- 43b1ae1d704ff80c8b27742178f6cecde39a3d68 compiler/basicTypes/DataCon.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/basicTypes/DataCon.hs b/compiler/basicTypes/DataCon.hs index f4cdb21..0364c8a 100644 --- a/compiler/basicTypes/DataCon.hs +++ b/compiler/basicTypes/DataCon.hs @@ -696,7 +696,7 @@ instance Binary SrcStrictness where do h <- getByte bh case h of 0 -> return SrcLazy - 1 -> return SrcLazy + 1 -> return SrcStrict _ -> return NoSrcStrict instance Binary SrcUnpackedness where From git at git.haskell.org Tue Jan 31 10:34:44 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 31 Jan 2017 10:34:44 +0000 (UTC) Subject: [commit: ghc] wip/D3050: Fix binary instance for SrcStrictness (cd24be6) Message-ID: <20170131103444.936373A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/D3050 Link : http://ghc.haskell.org/trac/ghc/changeset/cd24be6482929d2deddbb22d4c2979e40a739428/ghc >--------------------------------------------------------------- commit cd24be6482929d2deddbb22d4c2979e40a739428 Author: alexbiehl Date: Tue Jan 31 10:54:50 2017 +0100 Fix binary instance for SrcStrictness Summary: Found while revisiting the binary serialization for interface files. Test Plan: Building and validating currently Reviewers: austin, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D3050 >--------------------------------------------------------------- cd24be6482929d2deddbb22d4c2979e40a739428 compiler/basicTypes/DataCon.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/basicTypes/DataCon.hs b/compiler/basicTypes/DataCon.hs index 620aea6..952ea8d 100644 --- a/compiler/basicTypes/DataCon.hs +++ b/compiler/basicTypes/DataCon.hs @@ -696,7 +696,7 @@ instance Binary SrcStrictness where do h <- getByte bh case h of 0 -> return SrcLazy - 1 -> return SrcLazy + 1 -> return SrcStrict _ -> return NoSrcStrict instance Binary SrcUnpackedness where From git at git.haskell.org Tue Jan 31 10:34:47 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 31 Jan 2017 10:34:47 +0000 (UTC) Subject: [commit: ghc] wip/D3050's head updated: Fix binary instance for SrcStrictness (cd24be6) Message-ID: <20170131103447.56E173A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/D3050' now includes: 675b54f Update .mailmap e4ae78a Typos in comments [ci skip] a1cd959 Add myself [ci skip] 078c211 Update Win32 submodule to fix Windows build 1a3f1ee COMPLETE pragmas for enhanced pattern exhaustiveness checking 95dc6dc Template Haskell support for COMPLETE pragmas c344005 Generalize the type of runRW# e4ab8ba Add pragCompleteDName to templateHaskellNames 88a89b7 Nix typo and redundant where-clauses ff9355e Typos in comments [ci skip] 0d1cb15 Make type import/export API Annotation friendly 50544ee Prune unneeded Derive* language pragmas ad3d2df Don't unnecessarily qualify TH-converted instances with empty contexts 3eebd1f Generalizes the type of asProxyTypeOf (#12805) d8cb4b0 Bump nofib submodule 4e63e85 Bump hsc2hs submodule 2ffcdfa Fatal if we try to reinitialize the RTS 06b9561 Fix the right-shift operation for negative big integers (fixes #12136) 2af38b0 Remove Data.Tuple doc's claim to have tuple types 1f366b8 Add delete retry loop. [ci skip] de78ee6 Document GHC.Profiling functions [ci skip] bc42e2b Convert pprTrace in isPredTy to a WARN 34a0205 UNREG: fix "_bytes" string literal forward declaration 4441f90 UNREG: add a forward declaration for local literals f60287c Fix mismatched tick in GHC.Generics documentation d2cf5de Fix deprecation warnings from containers 2ec1c83 Fix broken tests 7363d53 Check that a default type signature aligns with the non-default signature 9169111 Add a flag to emit error messages as JSON 5593573 Fixes bug #11046 f41c27d Slighly clean up symbol loading error. 5f8e234 Print COMPLETE pragmas in --show-iface f984bf2 Simplify minusInteger in integer-gmp slightly 9af1fb2 Fix links to building guides in MAKEHELP.md e9a239c Fix minor typo in README.md 32729d3 Turn libraries/integer-gmp/gmp/tarball into a submodule cd24be6 Fix binary instance for SrcStrictness From git at git.haskell.org Tue Jan 31 11:25:34 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 31 Jan 2017 11:25:34 +0000 (UTC) Subject: [commit: ghc] master: Fix binary instance for SrcStrictness (c71f0c4) Message-ID: <20170131112534.B77233A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c71f0c4ef931885a6c35d64e803338ba3781ff23/ghc >--------------------------------------------------------------- commit c71f0c4ef931885a6c35d64e803338ba3781ff23 Author: alexbiehl Date: Tue Jan 31 10:54:50 2017 +0100 Fix binary instance for SrcStrictness Summary: Found while revisiting the binary serialization for interface files. Test Plan: Building and validating currently Reviewers: austin, bgamari, mpickering Reviewed By: mpickering Subscribers: mpickering, thomie Differential Revision: https://phabricator.haskell.org/D3050 >--------------------------------------------------------------- c71f0c4ef931885a6c35d64e803338ba3781ff23 compiler/basicTypes/DataCon.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/basicTypes/DataCon.hs b/compiler/basicTypes/DataCon.hs index 620aea6..952ea8d 100644 --- a/compiler/basicTypes/DataCon.hs +++ b/compiler/basicTypes/DataCon.hs @@ -696,7 +696,7 @@ instance Binary SrcStrictness where do h <- getByte bh case h of 0 -> return SrcLazy - 1 -> return SrcLazy + 1 -> return SrcStrict _ -> return NoSrcStrict instance Binary SrcUnpackedness where From git at git.haskell.org Tue Jan 31 23:00:27 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 31 Jan 2017 23:00:27 +0000 (UTC) Subject: [commit: ghc] master: Use top-level instances to solve superclasses where possible (748b797) Message-ID: <20170131230027.73A613A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/748b79741652028827b6225c36b8ab55d22bdeb0/ghc >--------------------------------------------------------------- commit 748b79741652028827b6225c36b8ab55d22bdeb0 Author: Daniel Haraj Date: Tue Jan 31 22:28:55 2017 +0000 Use top-level instances to solve superclasses where possible This patch introduces a new flag `-fsolve-constant-dicts` which makes the constraint solver solve super class constraints with available dictionaries if possible. The flag is enabled by `-O1`. The motivation of this patch is that the compiler can produce more efficient code if the constraint solver used top-level instance declarations to solve constraints that are currently solved givens and their superclasses. In particular, as it currently stands, the compiler imposes a performance penalty on the common use-case where superclasses are bundled together for user convenience. The performance penalty applies to constraint synonyms as well. This example illustrates the issue: ``` {-# LANGUAGE ConstraintKinds, MultiParamTypeClasses, FlexibleContexts #-} module B where class M a b where m :: a -> b type C a b = (Num a, M a b) f :: C Int b => b -> Int -> Int f _ x = x + 1 ``` Output without the patch, notice that we get the instance for `Num Int` by using the class selector `p1`. ``` f :: forall b_arz. C Int b_arz => b_arz -> Int -> Int f = \ (@ b_a1EB) ($d(%,%)_a1EC :: C Int b_a1EB) _ (eta1_B1 :: Int) -> + @ Int (GHC.Classes.$p1(%,%) @ (Num Int) @ (M Int b_a1EB) $d(%,%)_a1EC) eta1_B1 B.f1 ``` Output with the patch, nicely optimised code! ``` f :: forall b. C Int b => b -> Int -> Int f = \ (@ b) _ _ (x_azg :: Int) -> case x_azg of { GHC.Types.I# x1_a1DP -> GHC.Types.I# (GHC.Prim.+# x1_a1DP 1#) } ``` Reviewers: simonpj, bgamari, austin Reviewed By: simonpj Subscribers: mpickering, rwbarton, thomie Differential Revision: https://phabricator.haskell.org/D2714 GHC Trac Issues: #12791, #5835 >--------------------------------------------------------------- 748b79741652028827b6225c36b8ab55d22bdeb0 compiler/main/DynFlags.hs | 3 + compiler/typecheck/TcInteract.hs | 259 ++++++++++++++++++++++++-- compiler/typecheck/TcSMonad.hs | 16 +- docs/users_guide/8.2.1-notes.rst | 9 + docs/users_guide/using-optimisation.rst | 31 +++ testsuite/tests/perf/should_run/T12791.hs | 15 ++ testsuite/tests/perf/should_run/T12791.stdout | 1 + testsuite/tests/perf/should_run/T5835.hs | 11 ++ testsuite/tests/perf/should_run/T5835.stdout | 1 + testsuite/tests/perf/should_run/all.T | 20 ++ 10 files changed, 351 insertions(+), 15 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 748b79741652028827b6225c36b8ab55d22bdeb0 From git at git.haskell.org Tue Jan 31 23:49:44 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 31 Jan 2017 23:49:44 +0000 (UTC) Subject: [commit: ghc] master: Mark reallyUnsafePtrEquality# as can_fail (b3576ed) Message-ID: <20170131234944.E3DDA3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b3576ed22570364f917c620a3cd29709355e4d51/ghc >--------------------------------------------------------------- commit b3576ed22570364f917c620a3cd29709355e4d51 Author: David Feuer Date: Tue Jan 31 18:44:14 2017 -0500 Mark reallyUnsafePtrEquality# as can_fail As described in the note, floating `reallyUnsafePtrEquality#` out can make it much less precise. Marking it `can_fail` will prevent it from floating out, which I believe is particularly important in light of 5a9a1738023aeb742e537fb4a59c4aa8fecc1f8a, and should also help prevent let/app invariant failures as seen in #11444 and #13027. Reviewers: simonpj, austin, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2987 GHC Trac Issues: #13027, #11444 >--------------------------------------------------------------- b3576ed22570364f917c620a3cd29709355e4d51 compiler/prelude/primops.txt.pp | 35 +++++++++++++++++++++++++++++++++++ 1 file changed, 35 insertions(+) diff --git a/compiler/prelude/primops.txt.pp b/compiler/prelude/primops.txt.pp index 6795ca7..5245272 100644 --- a/compiler/prelude/primops.txt.pp +++ b/compiler/prelude/primops.txt.pp @@ -2542,6 +2542,41 @@ section "Unsafe pointer equality" primop ReallyUnsafePtrEqualityOp "reallyUnsafePtrEquality#" GenPrimOp a -> a -> Int# + { Returns 1# if the given pointers are equal and 0# otherwise. } + with + can_fail = True -- See Note [reallyUnsafePtrEquality#] + + +-- Note [reallyUnsafePtrEquality#] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- +-- reallyUnsafePtrEquality# can't actually fail, per se, but we mark it can_fail +-- anyway. Until 5a9a1738023a, GHC considered primops okay for speculation only +-- when their arguments were known to be forced. This was unnecessarily +-- conservative, but it prevented reallyUnsafePtrEquality# from floating out of +-- places where its arguments were known to be forced. Unfortunately, GHC could +-- sometimes lose track of whether those arguments were forced, leading to let/app +-- invariant failures (see Trac 13027 and the discussion in Trac 11444). Now that +-- ok_for_speculation skips over lifted arguments, we need to explicitly prevent +-- reallyUnsafePtrEquality# from floating out. The reasons are closely related +-- to those described in Note [dataToTag#], although the consequences are less +-- severe. Imagine if we had +-- +-- \x y . case x of x' +-- DEFAULT -> +-- case y of y' +-- DEFAULT -> +-- let eq = reallyUnsafePtrEquality# x' y' +-- in ... +-- +-- If the let floats out, we'll get +-- +-- \x y . let eq = reallyUnsafePtrEquality# x y +-- in case x of ... +-- +-- The trouble is that pointer equality between thunks is very different +-- from pointer equality between the values those thunks reduce to, and the latter +-- is typically much more precise. ------------------------------------------------------------------------ section "Parallelism" From git at git.haskell.org Tue Jan 31 23:50:34 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 31 Jan 2017 23:50:34 +0000 (UTC) Subject: [commit: ghc] master: users guide: Fix markup of COMPLETE pragma examples (cb4b4fe) Message-ID: <20170131235034.3E9FA3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/cb4b4fe916b0a704ce0c43f263173b12bd9d98ca/ghc >--------------------------------------------------------------- commit cb4b4fe916b0a704ce0c43f263173b12bd9d98ca Author: Ben Gamari Date: Mon Jan 30 19:21:54 2017 -0500 users guide: Fix markup of COMPLETE pragma examples >--------------------------------------------------------------- cb4b4fe916b0a704ce0c43f263173b12bd9d98ca docs/users_guide/glasgow_exts.rst | 45 ++++++++++++++++++--------------------- 1 file changed, 21 insertions(+), 24 deletions(-) diff --git a/docs/users_guide/glasgow_exts.rst b/docs/users_guide/glasgow_exts.rst index 9df6ffb..cf80901 100644 --- a/docs/users_guide/glasgow_exts.rst +++ b/docs/users_guide/glasgow_exts.rst @@ -12838,23 +12838,21 @@ get the best of both worlds, we can choose one as our implementation and then provide a set of pattern synonyms so that users can use the other representation if they desire. We can then specify a ``COMPLETE`` pragma in order to inform the pattern match checker that a function which matches on both ``LeftChoice`` -and ``RightChoice`` is total. +and ``RightChoice`` is total. :: -:: - - data Choice a = Choice Bool a + data Choice a = Choice Bool a - pattern LeftChoice :: a -> Choice a - pattern LeftChoice a = Choice False a + pattern LeftChoice :: a -> Choice a + pattern LeftChoice a = Choice False a - pattern RightChoice :: a -> Choice a - pattern RightChoice a = Choice True a + pattern RightChoice :: a -> Choice a + pattern RightChoice a = Choice True a - {-# COMPLETE LeftChoice, RightChoice #-} + {-# COMPLETE LeftChoice, RightChoice #-} - foo :: Choice Int -> Int - foo (LeftChoice n) = n * 2 - foo (RightChoice n) = n - 2 + foo :: Choice Int -> Int + foo (LeftChoice n) = n * 2 + foo (RightChoice n) = n - 2 ``COMPLETE`` pragmas are only used by the pattern match checker. If a function definition matches on all the constructors specified in the pragma then the @@ -12872,23 +12870,22 @@ to match on all the patterns if the types were inconsistent. The result type must also be unambiguous. Usually this can be inferred but when all the pattern synonyms in a group are polymorphic in the constructor -the user must provide a type signature. +the user must provide a type signature. :: -:: - class LL f where - go :: f a -> () + class LL f where + go :: f a -> () - instance LL [] where - go _ = () + instance LL [] where + go _ = () - pattern T :: LL f => f a - pattern T <- (go -> ()) + pattern T :: LL f => f a + pattern T <- (go -> ()) - {-# COMPLETE T :: [] #-} + {-# COMPLETE T :: [] #-} - -- No warning - foo :: [a] -> Int - foo T = 5 + -- No warning + foo :: [a] -> Int + foo T = 5 .. _overlap-pragma: From git at git.haskell.org Tue Jan 31 23:50:36 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 31 Jan 2017 23:50:36 +0000 (UTC) Subject: [commit: ghc] master: Export callStackDoc (25e0cfc) Message-ID: <20170131235036.EBF463A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/25e0cfc676ef07647cb16a7206d686eaa0eddcc9/ghc >--------------------------------------------------------------- commit 25e0cfc676ef07647cb16a7206d686eaa0eddcc9 Author: Ben Gamari Date: Tue Jan 31 16:12:30 2017 -0500 Export callStackDoc It's generally a pretty useful thing to have around. [skip ci] Test Plan: Build it Reviewers: austin, dfeuer Reviewed By: dfeuer Subscribers: dfeuer, thomie Differential Revision: https://phabricator.haskell.org/D3048 >--------------------------------------------------------------- 25e0cfc676ef07647cb16a7206d686eaa0eddcc9 compiler/utils/Outputable.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/utils/Outputable.hs b/compiler/utils/Outputable.hs index 118ef32..7d79f93 100644 --- a/compiler/utils/Outputable.hs +++ b/compiler/utils/Outputable.hs @@ -83,7 +83,7 @@ module Outputable ( pprPanic, pprSorry, assertPprPanic, pprPgmError, pprTrace, pprTraceIt, warnPprTrace, pprSTrace, trace, pgmError, panic, sorry, assertPanic, - pprDebugAndThen, + pprDebugAndThen, callStackDoc ) where import {-# SOURCE #-} DynFlags( DynFlags, From git at git.haskell.org Tue Jan 31 23:50:39 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 31 Jan 2017 23:50:39 +0000 (UTC) Subject: [commit: ghc] master: README: Mention acceptability of pull requests (afc05c7) Message-ID: <20170131235039.A9B593A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/afc05c76c3bd672ce04527c89b29d184e94c8c6d/ghc >--------------------------------------------------------------- commit afc05c76c3bd672ce04527c89b29d184e94c8c6d Author: Ben Gamari Date: Mon Jan 30 21:34:18 2017 -0500 README: Mention acceptability of pull requests >--------------------------------------------------------------- afc05c76c3bd672ce04527c89b29d184e94c8c6d README.md | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/README.md b/README.md index a1b2354..59f83bf 100644 --- a/README.md +++ b/README.md @@ -31,8 +31,7 @@ There are two ways to get a source tree: Note: cloning GHC from Github requires a special setup. See [Getting a GHC repository from Github] [7]. - **DO NOT submit pull request directly to the github repo.** - *See the GHC team's working conventions re [how to contribute a patch to GHC](http://ghc.haskell.org/trac/ghc/wiki/WorkingConventions/FixingBugs).* + *See the GHC team's working conventions regarding [how to contribute a patch to GHC](http://ghc.haskell.org/trac/ghc/wiki/WorkingConventions/FixingBugs).* First time contributors are encouraged to get started by just sending a Pull Request. Building & Installing From git at git.haskell.org Tue Jan 31 23:50:43 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 31 Jan 2017 23:50:43 +0000 (UTC) Subject: [commit: ghc] master: Abstract over the way eventlogs are flushed (4dfc6d1) Message-ID: <20170131235043.3F3803A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4dfc6d1c40b298d4b8f136e46420227eda60a03d/ghc >--------------------------------------------------------------- commit 4dfc6d1c40b298d4b8f136e46420227eda60a03d Author: alexbiehl Date: Tue Jan 31 16:06:33 2017 -0500 Abstract over the way eventlogs are flushed Currently eventlog data is always written to a file `progname.eventlog`. This patch introduces the `flushEventLog` field in `RtsConfig` which allows to customize the writing of eventlog data. One possible scenario is the ongoing live-profile-monitor effort by @NCrashed which slurps all eventlog data through `fluchEventLog`. `flushEventLog` takes a buffer with eventlog data and its size and returns `false` (0) in case eventlog data could not be procesed. Reviewers: simonmar, austin, erikd, bgamari Reviewed By: simonmar, bgamari Subscribers: qnikst, thomie, NCrashed Differential Revision: https://phabricator.haskell.org/D2934 >--------------------------------------------------------------- 4dfc6d1c40b298d4b8f136e46420227eda60a03d docs/users_guide/8.2.1-notes.rst | 4 ++ docs/users_guide/runtime_control.rst | 43 ++++++++++-- includes/RtsAPI.h | 4 ++ includes/rts/EventLogWriter.h | 40 +++++++++++ rts/RtsFlags.c | 1 + rts/Trace.c | 21 +++++- rts/eventlog/EventLog.c | 128 ++++++++++++++--------------------- rts/eventlog/EventLog.h | 3 +- rts/eventlog/EventLogWriter.c | 122 +++++++++++++++++++++++++++++++++ 9 files changed, 281 insertions(+), 85 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 4dfc6d1c40b298d4b8f136e46420227eda60a03d From git at git.haskell.org Tue Jan 31 23:50:45 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 31 Jan 2017 23:50:45 +0000 (UTC) Subject: [commit: ghc] master: user-guide: fix links and file names (fixes #13198) (b15136a) Message-ID: <20170131235045.EE9D33A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b15136afb84a5193aa385ae7c635026aed54cf3b/ghc >--------------------------------------------------------------- commit b15136afb84a5193aa385ae7c635026aed54cf3b Author: Takenobu Tani Date: Tue Jan 31 16:07:48 2017 -0500 user-guide: fix links and file names (fixes #13198) There are some incorrect links and file names in GHC user's guide. * docs/users_guide/glasgow_exts.rst - GHC/Base.lhs - GHC/List.lhs * docs/users_guide/ffi-chap.rst - :base-ref:`Foreign` - :base-ref:`Control.Concurrent` I fixed them. Reviewers: austin, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D3035 GHC Trac Issues: #13198 >--------------------------------------------------------------- b15136afb84a5193aa385ae7c635026aed54cf3b docs/users_guide/ffi-chap.rst | 4 ++-- docs/users_guide/glasgow_exts.rst | 6 +++--- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/docs/users_guide/ffi-chap.rst b/docs/users_guide/ffi-chap.rst index 70b55d0..d4bf343 100644 --- a/docs/users_guide/ffi-chap.rst +++ b/docs/users_guide/ffi-chap.rst @@ -21,7 +21,7 @@ that programs using these features are not portable. Hence, these features should be avoided where possible. The FFI libraries are documented in the accompanying library -documentation; see for example the :base-ref:`Foreign` module. +documentation; see for example the :base-ref:`Foreign ` module. .. _ffi-ghcexts: @@ -569,7 +569,7 @@ where it is useful to have more control over which OS thread is used, for example when calling foreign code that makes use of thread-local state. For cases like this, we provide *bound threads*, which are Haskell threads tied to a particular OS thread. For information on bound -threads, see the documentation for the :base-ref:`Control.Concurrent` module. +threads, see the documentation for the :base-ref:`Control.Concurrent ` module. Foreign exports and multi-threading ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ diff --git a/docs/users_guide/glasgow_exts.rst b/docs/users_guide/glasgow_exts.rst index cf80901..0bbf658 100644 --- a/docs/users_guide/glasgow_exts.rst +++ b/docs/users_guide/glasgow_exts.rst @@ -13333,7 +13333,7 @@ Controlling what's going on in rewrite rules great detail what rules are being fired. If you add :ghc-flag:`-dppr-debug` you get a still more detailed listing. -- The definition of (say) ``build`` in ``GHC/Base.lhs`` looks like +- The definition of (say) ``build`` in ``GHC/Base.hs`` looks like this: :: build :: forall a. (forall b. (a -> b -> b) -> b -> b) -> [a] @@ -13346,10 +13346,10 @@ Controlling what's going on in rewrite rules any inlining happening in the RHS of the ``INLINE`` thing. I regret the delicacy of this. -- In ``libraries/base/GHC/Base.lhs`` look at the rules for ``map`` to +- In ``libraries/base/GHC/Base.hs`` look at the rules for ``map`` to see how to write rules that will do fusion and yet give an efficient program even if fusion doesn't happen. More rules in - ``GHC/List.lhs``. + ``GHC/List.hs``. .. _special-ids: From git at git.haskell.org Tue Jan 31 23:50:48 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 31 Jan 2017 23:50:48 +0000 (UTC) Subject: [commit: ghc] master: FloatOut: Allow floating through breakpoint ticks (44f079f) Message-ID: <20170131235048.AD5613A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/44f079f74869d8cb417e2dcc104517ae7f593e5f/ghc >--------------------------------------------------------------- commit 44f079f74869d8cb417e2dcc104517ae7f593e5f Author: Ben Gamari Date: Tue Jan 31 16:05:26 2017 -0500 FloatOut: Allow floating through breakpoint ticks I believe this is actually a completely valid thing to do, despite the arguments put forth in #10052. All that was missing was logic in SetLevels to correctly substitute the cloned binders into the breakpoint's free variable list. This is a prerequisite for enabling StaticPointer support in the interpreter. Test Plan: Validate Reviewers: austin, scpmw Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D3049 >--------------------------------------------------------------- 44f079f74869d8cb417e2dcc104517ae7f593e5f compiler/simplCore/FloatOut.hs | 27 +++++++++++++-------------- compiler/simplCore/SetLevels.hs | 3 ++- 2 files changed, 15 insertions(+), 15 deletions(-) diff --git a/compiler/simplCore/FloatOut.hs b/compiler/simplCore/FloatOut.hs index 475108c..10955d2 100644 --- a/compiler/simplCore/FloatOut.hs +++ b/compiler/simplCore/FloatOut.hs @@ -260,26 +260,21 @@ floatBody lvl arg -- Used rec rhss, and case-alternative rhss {- Note [Floating past breakpoints] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Notes from Peter Wortmann (re: #10052) +We used to disallow floating out of breakpoint ticks (see #10052). However, I +think this is too restrictive. -"This case clearly means we're trying to float past a breakpoint..." +Consider the case of an expression scoped over by a breakpoint tick, -Further: + tick<...> (let x = ... in f x) -"Breakpoints as they currently exist are the only Tikish that is not -scoped, counting, and not splittable. +In this case it is completely legal to float out x, despite the fact that +breakpoint ticks are scoped, -This means that we can't: - - Simply float code out of it, because the payload must still be covered (scoped) - - Copy the tick, because it would change entry counts (here: duplicate breakpoints)" + let x = ... in (tick<...> f x) -While this seems like an odd case, it can apparently occur in real -life: through the combination of optimizations + GHCi usage. For an -example, see #10052 as mentioned above. So not only does the -interpreter not like some compiler-generated things (like unboxed -tuples), the compiler doesn't like interpreter-introduced things! +The reason here is that we know that the breakpoint will still be hit when the +expression is entered since the tick still scopes over the RHS. -Also see Note [GHCi and -O] in GHC.hs. -} floatExpr :: LevelledExpr @@ -318,6 +313,10 @@ floatExpr (Tick tickish expr) (fs, annotated_defns, Tick tickish expr') } -- Note [Floating past breakpoints] + | Breakpoint{} <- tickish + = case (floatExpr expr) of { (fs, floating_defns, expr') -> + (fs, floating_defns, Tick tickish expr') } + | otherwise = pprPanic "floatExpr tick" (ppr tickish) diff --git a/compiler/simplCore/SetLevels.hs b/compiler/simplCore/SetLevels.hs index 955d3ba..c0d6e8d 100644 --- a/compiler/simplCore/SetLevels.hs +++ b/compiler/simplCore/SetLevels.hs @@ -305,7 +305,8 @@ lvlExpr env (_, AnnCast expr (_, co)) = do lvlExpr env (_, AnnTick tickish expr) = do expr' <- lvlExpr env expr - return (Tick tickish expr') + let tickish' = substTickish (le_subst env) tickish + return (Tick tickish' expr') lvlExpr env expr@(_, AnnApp _ _) = do let