From git at git.haskell.org Mon Feb 1 00:09:33 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 1 Feb 2016 00:09:33 +0000 (UTC) Subject: [commit: ghc] master: When encountering a duplicate symbol, show source of the first symbol (34519f0) Message-ID: <20160201000933.E34B93A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/34519f0811c58cb1fd073fae3f83b6543c69a634/ghc >--------------------------------------------------------------- commit 34519f0811c58cb1fd073fae3f83b6543c69a634 Author: Reid Barton Date: Sun Jan 31 19:10:29 2016 -0500 When encountering a duplicate symbol, show source of the first symbol Test Plan: Used this to track down an issue I was having. Reviewers: simonmar, austin, erikd, bgamari Reviewed By: erikd, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1863 >--------------------------------------------------------------- 34519f0811c58cb1fd073fae3f83b6543c69a634 rts/Linker.c | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/rts/Linker.c b/rts/Linker.c index b9a1d34..29bd5d8 100644 --- a/rts/Linker.c +++ b/rts/Linker.c @@ -430,13 +430,17 @@ static int ghciInsertSymbolTable( " %s\n" "whilst processing object file\n" " %" PATH_FMT "\n" + "The symbol was previously defined in\n" + " %" PATH_FMT "\n" "This could be caused by:\n" " * Loading two different object files which export the same symbol\n" " * Specifying the same object file twice on the GHCi command line\n" " * An incorrect `package.conf' entry, causing some object to be\n" " loaded twice.\n", (char*)key, - obj_name + obj_name, + pinfo->owner->archiveMemberName ? pinfo->owner->archiveMemberName + : pinfo->owner->fileName ); return 0; } From git at git.haskell.org Mon Feb 1 02:02:46 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 1 Feb 2016 02:02:46 +0000 (UTC) Subject: [commit: ghc] master: Minor doc fixes to GHC.Generics (f8e2b7e) Message-ID: <20160201020246.385893A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f8e2b7e3c0ea65ad06b7082cb7d4b5bd76e93f5b/ghc >--------------------------------------------------------------- commit f8e2b7e3c0ea65ad06b7082cb7d4b5bd76e93f5b Author: RyanGlScott Date: Sun Jan 31 21:02:57 2016 -0500 Minor doc fixes to GHC.Generics This adds @since annotations and fixes a couple of Haddock formatting errors. >--------------------------------------------------------------- f8e2b7e3c0ea65ad06b7082cb7d4b5bd76e93f5b libraries/base/GHC/Generics.hs | 28 +++++++++++++++++++++++----- 1 file changed, 23 insertions(+), 5 deletions(-) diff --git a/libraries/base/GHC/Generics.hs b/libraries/base/GHC/Generics.hs index 4cadf43..4c5a3d1 100644 --- a/libraries/base/GHC/Generics.hs +++ b/libraries/base/GHC/Generics.hs @@ -75,9 +75,9 @@ module GHC.Generics ( -- 'D1' ('MetaData \"Tree\" \"Main\" \"package-name\" 'False) -- ('C1' ('MetaCons \"Leaf\" 'PrefixI 'False) -- ('S1' '(MetaSel 'Nothing --- 'NoSourceUnpackedness --- 'NoSourceStrictness --- 'DecidedLazy) +-- 'NoSourceUnpackedness +-- 'NoSourceStrictness +-- 'DecidedLazy) -- ('Rec0' a)) -- ':+:' -- 'C1' ('MetaCons \"Node\" 'PrefixI 'False) @@ -828,8 +828,12 @@ class Datatype d where -- | The fully-qualified name of the module where the type is declared moduleName :: t d (f :: * -> *) a -> [Char] -- | The package name of the module where the type is declared + -- + -- @since 4.9.0.0 packageName :: t d (f :: * -> *) a -> [Char] -- | Marks if the datatype is actually a newtype + -- + -- @since 4.7.0.0 isNewtype :: t d (f :: * -> *) a -> Bool isNewtype _ = False @@ -865,6 +869,8 @@ data Fixity = Prefix | Infix Associativity Int deriving (Eq, Show, Ord, Read, Generic) -- | This variant of 'Fixity' appears at the type level. +-- +-- @since 4.9.0.0 data FixityI = PrefixI | InfixI Associativity Nat -- | Get the precedence of a fixity value. @@ -889,6 +895,8 @@ data Associativity = LeftAssociative -- -- The fields of @ExampleConstructor@ have 'NoSourceUnpackedness', -- 'SourceNoUnpack', and 'SourceUnpack', respectively. +-- +-- @since 4.9.0.0 data SourceUnpackedness = NoSourceUnpackedness | SourceNoUnpack | SourceUnpack @@ -903,6 +911,8 @@ data SourceUnpackedness = NoSourceUnpackedness -- -- The fields of @ExampleConstructor@ have 'NoSourceStrictness', -- 'SourceLazy', and 'SourceStrict', respectively. +-- +-- @since 4.9.0.0 data SourceStrictness = NoSourceStrictness | SourceLazy | SourceStrict @@ -928,6 +938,8 @@ data SourceStrictness = NoSourceStrictness -- -- * If compiled with @-O2@ enabled, then the fields will have 'DecidedUnpack', -- 'DecidedStrict', and 'DecidedLazy', respectively. +-- +-- @since 4.9.0.0 data DecidedStrictness = DecidedLazy | DecidedStrict | DecidedUnpack @@ -938,10 +950,16 @@ class Selector s where -- | The name of the selector selName :: t s (f :: * -> *) a -> [Char] -- | The selector's unpackedness annotation (if any) + -- + -- @since 4.9.0.0 selSourceUnpackedness :: t s (f :: * -> *) a -> SourceUnpackedness -- | The selector's strictness annotation (if any) + -- + -- @since 4.9.0.0 selSourceStrictness :: t s (f :: * -> *) a -> SourceStrictness -- | The strictness that the compiler inferred for the selector + -- + -- @since 4.9.0.0 selDecidedStrictness :: t s (f :: * -> *) a -> DecidedStrictness instance (SingI mn, SingI su, SingI ss, SingI ds) @@ -987,8 +1005,8 @@ class Generic1 f where -- and @s@ is @'True@ if the constructor contains record selectors. -- -- * In @MetaSel mn su ss ds@, if the field is uses record syntax, then @mn@ is --- 'Just' the record name. Otherwise, @mn@ is 'Nothing. @su@ and @ss@ are the --- field's unpackedness and strictness annotations, and @ds@ is the +-- 'Just' the record name. Otherwise, @mn@ is 'Nothing'. @su@ and @ss@ are +-- the field's unpackedness and strictness annotations, and @ds@ is the -- strictness that GHC infers for the field. data Meta = MetaData Symbol Symbol Symbol Bool | MetaCons Symbol FixityI Bool From git at git.haskell.org Mon Feb 1 02:09:49 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 1 Feb 2016 02:09:49 +0000 (UTC) Subject: [commit: ghc] master: Missing @since annotations in GHC.Generics (a883c1b) Message-ID: <20160201020949.ADFEB3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a883c1b7b08657102a2081b55c8fe68714d8bf73/ghc >--------------------------------------------------------------- commit a883c1b7b08657102a2081b55c8fe68714d8bf73 Author: RyanGlScott Date: Sun Jan 31 21:10:48 2016 -0500 Missing @since annotations in GHC.Generics [ci skip] >--------------------------------------------------------------- a883c1b7b08657102a2081b55c8fe68714d8bf73 libraries/base/GHC/Generics.hs | 28 ++++++++++++++++++++++++++++ 1 file changed, 28 insertions(+) diff --git a/libraries/base/GHC/Generics.hs b/libraries/base/GHC/Generics.hs index 4c5a3d1..27f2c57 100644 --- a/libraries/base/GHC/Generics.hs +++ b/libraries/base/GHC/Generics.hs @@ -760,43 +760,69 @@ newtype (:.:) f (g :: * -> *) (p :: *) = Comp1 { unComp1 :: f (g p) } deriving (Eq, Ord, Read, Show, Generic) -- | Constants of kind @#@ +-- +-- @since 4.9.0.0 data family URec (a :: *) (p :: *) -- | Used for marking occurrences of 'Addr#' +-- +-- @since 4.9.0.0 data instance URec (Ptr ()) p = UAddr { uAddr# :: Addr# } deriving (Eq, Ord, Generic) -- | Used for marking occurrences of 'Char#' +-- +-- @since 4.9.0.0 data instance URec Char p = UChar { uChar# :: Char# } deriving (Eq, Ord, Show, Generic) -- | Used for marking occurrences of 'Double#' +-- +-- @since 4.9.0.0 data instance URec Double p = UDouble { uDouble# :: Double# } deriving (Eq, Ord, Show, Generic) -- | Used for marking occurrences of 'Float#' +-- +-- @since 4.9.0.0 data instance URec Float p = UFloat { uFloat# :: Float# } deriving (Eq, Ord, Show, Generic) -- | Used for marking occurrences of 'Int#' +-- +-- @since 4.9.0.0 data instance URec Int p = UInt { uInt# :: Int# } deriving (Eq, Ord, Show, Generic) -- | Used for marking occurrences of 'Word#' +-- +-- @since 4.9.0.0 data instance URec Word p = UWord { uWord# :: Word# } deriving (Eq, Ord, Show, Generic) -- | Type synonym for 'URec': 'Addr#' +-- +-- @since 4.9.0.0 type UAddr = URec (Ptr ()) -- | Type synonym for 'URec': 'Char#' +-- +-- @since 4.9.0.0 type UChar = URec Char -- | Type synonym for 'URec': 'Double#' +-- +-- @since 4.9.0.0 type UDouble = URec Double -- | Type synonym for 'URec': 'Float#' +-- +-- @since 4.9.0.0 type UFloat = URec Float -- | Type synonym for 'URec': 'Int#' +-- +-- @since 4.9.0.0 type UInt = URec Int -- | Type synonym for 'URec': 'Word#' +-- +-- @since 4.9.0.0 type UWord = URec Word -- | Tag for K1: recursion (of kind *) @@ -1008,6 +1034,8 @@ class Generic1 f where -- 'Just' the record name. Otherwise, @mn@ is 'Nothing'. @su@ and @ss@ are -- the field's unpackedness and strictness annotations, and @ds@ is the -- strictness that GHC infers for the field. +-- +-- @since 4.9.0.0 data Meta = MetaData Symbol Symbol Symbol Bool | MetaCons Symbol FixityI Bool | MetaSel (Maybe Symbol) From git at git.haskell.org Mon Feb 1 06:53:07 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 1 Feb 2016 06:53:07 +0000 (UTC) Subject: [commit: ghc] wip/gadtpm: Fit everything in 80 columns (7afa6e5) Message-ID: <20160201065307.CC1EE3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/gadtpm Link : http://ghc.haskell.org/trac/ghc/changeset/7afa6e5c1e99cbe18a8b546841efb94dff2e3dfd/ghc >--------------------------------------------------------------- commit 7afa6e5c1e99cbe18a8b546841efb94dff2e3dfd Author: George Karachalias Date: Fri Jan 29 17:40:18 2016 +0100 Fit everything in 80 columns >--------------------------------------------------------------- 7afa6e5c1e99cbe18a8b546841efb94dff2e3dfd compiler/deSugar/Check.hs | 23 +++++++++++++---------- 1 file changed, 13 insertions(+), 10 deletions(-) diff --git a/compiler/deSugar/Check.hs b/compiler/deSugar/Check.hs index 0ae5a31..b963990 100644 --- a/compiler/deSugar/Check.hs +++ b/compiler/deSugar/Check.hs @@ -307,13 +307,15 @@ translatePat fam_insts pat = case pat of -- list ListPat ps ty Nothing -> do - foldr (mkListPatVec ty) [nilPattern ty] <$> translatePatVec fam_insts (map unLoc ps) + foldr (mkListPatVec ty) [nilPattern ty] + <$> translatePatVec fam_insts (map unLoc ps) -- overloaded list ListPat lpats elem_ty (Just (pat_ty, _to_list)) | Just e_ty <- splitListTyConApp_maybe pat_ty , (_, norm_elem_ty) <- normaliseType fam_insts Nominal elem_ty - -- elem_ty is frequently something like `Item [Int]`, but we prefer `Int` + -- elem_ty is frequently something like + -- `Item [Int]`, but we prefer `Int` , norm_elem_ty `eqType` e_ty -> -- We have to ensure that the element types are exactly the same. -- Otherwise, one may give an instance IsList [Int] (more specific than @@ -505,14 +507,15 @@ cantFailPattern _ = False -- | Translate a guard statement to Pattern translateGuard :: FamInstEnvs -> GuardStmt Id -> PmM PatVec -translateGuard _ (BodyStmt e _ _ _) = translateBoolGuard e -translateGuard _ (LetStmt binds) = translateLet (unLoc binds) -translateGuard fam_insts (BindStmt p e _ _ _) = translateBind fam_insts p e -translateGuard _ (LastStmt {}) = panic "translateGuard LastStmt" -translateGuard _ (ParStmt {}) = panic "translateGuard ParStmt" -translateGuard _ (TransStmt {}) = panic "translateGuard TransStmt" -translateGuard _ (RecStmt {}) = panic "translateGuard RecStmt" -translateGuard _ (ApplicativeStmt {}) = panic "translateGuard ApplicativeLastStmt" +translateGuard fam_insts guard = case guard of + BodyStmt e _ _ _ -> translateBoolGuard e + LetStmt binds -> translateLet (unLoc binds) + BindStmt p e _ _ _ -> translateBind fam_insts p e + LastStmt {} -> panic "translateGuard LastStmt" + ParStmt {} -> panic "translateGuard ParStmt" + TransStmt {} -> panic "translateGuard TransStmt" + RecStmt {} -> panic "translateGuard RecStmt" + ApplicativeStmt {} -> panic "translateGuard ApplicativeLastStmt" -- | Translate let-bindings translateLet :: HsLocalBinds Id -> PmM PatVec From git at git.haskell.org Mon Feb 1 06:53:10 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 1 Feb 2016 06:53:10 +0000 (UTC) Subject: [commit: ghc] wip/gadtpm: Some cleanup (09505c2) Message-ID: <20160201065310.8F10F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/gadtpm Link : http://ghc.haskell.org/trac/ghc/changeset/09505c2697e69e38a5790db898dffba3b8a756f6/ghc >--------------------------------------------------------------- commit 09505c2697e69e38a5790db898dffba3b8a756f6 Author: George Karachalias Date: Sun Jan 31 16:12:34 2016 +0100 Some cleanup >--------------------------------------------------------------- 09505c2697e69e38a5790db898dffba3b8a756f6 compiler/deSugar/Check.hs | 160 +++++++++++++++++++++++-------------------- compiler/deSugar/PmExpr.hs | 6 +- compiler/deSugar/TmOracle.hs | 2 +- 3 files changed, 92 insertions(+), 76 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 09505c2697e69e38a5790db898dffba3b8a756f6 From git at git.haskell.org Mon Feb 1 10:38:57 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 1 Feb 2016 10:38:57 +0000 (UTC) Subject: [commit: ghc] master: Suppress substitution assertions to fix tests (e5a0a89) Message-ID: <20160201103857.6D67A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e5a0a8903715b8717342dabeb72d69b4d5e61e5c/ghc >--------------------------------------------------------------- commit e5a0a8903715b8717342dabeb72d69b4d5e61e5c Author: Bartosz Nitka Date: Mon Feb 1 02:39:50 2016 -0800 Suppress substitution assertions to fix tests This is one place that I've missed with D1862. This doesn't fix the underlying problem and I prefer to suppress it now and fix it later as this is a part of a larger effort (#11371) to fix an old bug with `substTy` called with invalid `in_scope` sets. Test Plan: `make test TEST="hClose002 hClose003 hDuplicateTo001" Reviewers: thomie, austin, bgamari, trofi Reviewed By: trofi Differential Revision: https://phabricator.haskell.org/D1872 GHC Trac Issues: #11371 >--------------------------------------------------------------- e5a0a8903715b8717342dabeb72d69b4d5e61e5c compiler/basicTypes/MkId.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/basicTypes/MkId.hs b/compiler/basicTypes/MkId.hs index fd6c2ce..8aaa005 100644 --- a/compiler/basicTypes/MkId.hs +++ b/compiler/basicTypes/MkId.hs @@ -695,7 +695,7 @@ wrapCo co rep_ty (unbox_rep, box_rep) -- co :: arg_ty ~ rep_ty UnitBox -> do { rep_id <- newLocal (TcType.substTy subst rep_ty) ; return ([rep_id], Var rep_id) } Boxer boxer -> boxer subst - ; let sco = substCo subst co + ; let sco = substCoUnchecked subst co ; return (rep_ids, rep_expr `Cast` mkSymCo sco) } ------------------------ From git at git.haskell.org Mon Feb 1 12:27:20 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 1 Feb 2016 12:27:20 +0000 (UTC) Subject: [commit: ghc] wip/gadtpm: Overhaul the Overhauled Pattern Match Checker (b5df2cc) Message-ID: <20160201122720.D128F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/gadtpm Link : http://ghc.haskell.org/trac/ghc/changeset/b5df2cc6cf2af4508a4f34a718320a6d79f9adca/ghc >--------------------------------------------------------------- commit b5df2cc6cf2af4508a4f34a718320a6d79f9adca Author: George Karachalias Date: Mon Feb 1 11:43:12 2016 +0100 Overhaul the Overhauled Pattern Match Checker * Changed the representation of Value Set Abstractions. Instead of using a prefix tree, we now use a list of Value Vector Abstractions. The set of constraints Delta for every Value Vector Abstraction is the oracle state so that we solve everything only once. * Instead of doing everything lazily, we prune at once (and in general everything is much stricter). A case writtern with pattern guards is not checked in almost the same time as the equivalent with pattern matching. * Do not store the covered and the divergent sets at all. Since what we only need is a yes/no (does this clause cover anything? Does it force any thunk?) We just keep a boolean for each. * Removed flags `-Wtoo-many-guards` and `-ffull-guard-reasoning`. Replaced with `fmax-pmcheck-iterations=n`. Still debatable what should the default `n` be. * When a guard is for sure not going to contribute anything, we treat it as such: The oracle is not called and cases `CGuard`, `UGuard` and `DGuard` from the paper are not happening at all (the generation of a fresh variable, the unfolding of the pattern list etc.). his combined with the above seems to be enough to drop the memory increase for test T783 down to 18.7%. * Do not export function `dsPmWarn` (it is now called directly from within `checkSingle` and `checkMatches`). * Make `PmExprVar` hold a `Name` instead of an `Id`. The term oracle does not handle type information so using `Id` was a waste of time/space. * Added testcases T11195, T11303b (data families) and T11374 The patch addresses at least the following: #11195, #11276, #11303, #11374, #11162 >--------------------------------------------------------------- b5df2cc6cf2af4508a4f34a718320a6d79f9adca compiler/deSugar/Check.hs | 1236 +++++++++----------- compiler/deSugar/DsMonad.hs | 39 +- compiler/deSugar/Match.hs | 16 +- compiler/deSugar/PmExpr.hs | 31 +- compiler/deSugar/TmOracle.hs | 34 +- compiler/ghci/RtClosureInspect.hs | 3 - compiler/main/DynFlags.hs | 12 +- compiler/nativeGen/Dwarf/Constants.hs | 4 - compiler/typecheck/TcRnTypes.hs | 3 +- compiler/types/OptCoercion.hs | 4 +- docs/users_guide/8.0.1-notes.rst | 9 - docs/users_guide/bugs.rst | 10 - docs/users_guide/using-warnings.rst | 34 - libraries/base/Foreign/C/Error.hs | 1 - testsuite/tests/pmcheck/should_compile/T11195.hs | 189 +++ testsuite/tests/pmcheck/should_compile/T11303b.hs | 25 + testsuite/tests/pmcheck/should_compile/T11374.hs | 59 + .../tests/pmcheck/should_compile/T2204.stderr | 6 +- .../tests/pmcheck/should_compile/T9951b.stderr | 6 +- testsuite/tests/pmcheck/should_compile/all.T | 3 + .../tests/pmcheck/should_compile/pmc001.stderr | 12 +- .../tests/pmcheck/should_compile/pmc007.stderr | 12 +- utils/mkUserGuidePart/Options/Warnings.hs | 13 - 23 files changed, 911 insertions(+), 850 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 b5df2cc6cf2af4508a4f34a718320a6d79f9adca From git at git.haskell.org Mon Feb 1 12:27:23 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 1 Feb 2016 12:27:23 +0000 (UTC) Subject: [commit: ghc] wip/gadtpm's head updated: Overhaul the Overhauled Pattern Match Checker (b5df2cc) Message-ID: <20160201122723.230693A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/gadtpm' now includes: 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 b5df2cc Overhaul the Overhauled Pattern Match Checker From git at git.haskell.org Mon Feb 1 12:58:56 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 1 Feb 2016 12:58:56 +0000 (UTC) Subject: [commit: ghc] branch 'wip/gadtpm-prefix-tree' created Message-ID: <20160201125856.8EF053A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/gadtpm-prefix-tree Referencing: a883c1b7b08657102a2081b55c8fe68714d8bf73 From git at git.haskell.org Mon Feb 1 14:51:05 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 1 Feb 2016 14:51:05 +0000 (UTC) Subject: [commit: ghc] master: Simplify ghc-boot database representation with new type class. (0d60165) Message-ID: <20160201145105.E5A673A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/0d601657ca6ec1812492bb16a7d0e181b370e2d8/ghc >--------------------------------------------------------------- commit 0d601657ca6ec1812492bb16a7d0e181b370e2d8 Author: Edward Z. Yang Date: Mon Feb 1 14:31:49 2016 +0100 Simplify ghc-boot database representation with new type class. Previously, we had an 'OriginalModule' type in ghc-boot which was basically identical to 'Module', and we had to do a bit of gyrating to get it converted into the right form. This commit introduces a new typeclass, 'DbModuleRep' which represents types which we know how to serialize to and from the (now renamed) 'DbModule' type. The upshot is that we can just store 'Module's DIRECTLY in the 'InstalledPackageInfo', no conversion needed. I took the opportunity to clean up ghc-pkg to make its use of the 'BinaryStringRep' classes more type safe. Signed-off-by: Edward Z. Yang Test Plan: validate Reviewers: austin, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1811 >--------------------------------------------------------------- 0d601657ca6ec1812492bb16a7d0e181b370e2d8 compiler/basicTypes/Module.hs | 7 ++- compiler/main/PackageConfig.hs | 26 +-------- compiler/main/Packages.hs | 10 +++- libraries/ghc-boot/GHC/PackageDb.hs | 107 +++++++++++++++--------------------- utils/ghc-pkg/Main.hs | 48 +++++++++++----- 5 files changed, 93 insertions(+), 105 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 0d601657ca6ec1812492bb16a7d0e181b370e2d8 From git at git.haskell.org Mon Feb 1 14:51:08 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 1 Feb 2016 14:51:08 +0000 (UTC) Subject: [commit: ghc] master: Hide the CallStack implicit parameter (94048f9) Message-ID: <20160201145108.B81343A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/94048f9fb01c541215cfc9cc215af83566b63236/ghc >--------------------------------------------------------------- commit 94048f9fb01c541215cfc9cc215af83566b63236 Author: Eric Seidel Date: Mon Feb 1 14:32:19 2016 +0100 Hide the CallStack implicit parameter The implicit parameter isn't actually very relevant to the CallStack machinery, so we hide the implementation details behind a constraint alias ``` type HasCallStack = (?callStack :: CallStack) ``` This has a few benefits: 1. No need to enable `ImplicitParams` in user code. 2. No need to remember the `?callStack` naming convention. 3. Gives us the option to change the implementation details in the future with less user-land breakage. The revised `CallStack` API is exported from `GHC.Stack` and makes no mention of the implicit parameter. Test Plan: ./validate Reviewers: simonpj, austin, hvr, bgamari Reviewed By: simonpj, bgamari Subscribers: thomie Projects: #ghc Differential Revision: https://phabricator.haskell.org/D1818 >--------------------------------------------------------------- 94048f9fb01c541215cfc9cc215af83566b63236 compiler/typecheck/TcEvidence.hs | 25 ++--- docs/users_guide/8.0.1-notes.rst | 26 +++--- docs/users_guide/ghci.rst | 4 +- docs/users_guide/glasgow_exts.rst | 186 ++++++++++++++++++++++---------------- libraries/base/GHC/Err.hs | 21 +++-- libraries/base/GHC/Exception.hs | 6 +- libraries/base/GHC/Stack.hs | 31 +++++-- libraries/base/GHC/Stack/Types.hs | 93 +++++++++++++------ testsuite/driver/testlib.py | 6 +- 9 files changed, 245 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 94048f9fb01c541215cfc9cc215af83566b63236 From git at git.haskell.org Mon Feb 1 14:51:11 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 1 Feb 2016 14:51:11 +0000 (UTC) Subject: [commit: ghc] master: Implement basic uniform warning set tower (86897e1) Message-ID: <20160201145111.7B04D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/86897e1fe23cb26fa2278e86542b34c33301606a/ghc >--------------------------------------------------------------- commit 86897e1fe23cb26fa2278e86542b34c33301606a Author: Herbert Valerio Riedel Date: Mon Feb 1 14:32:30 2016 +0100 Implement basic uniform warning set tower This implements/completes the current basic warning sets to provide the following tower of warning sets (i.e. each line subsumes the warnings from the sets listed below): - `-Weverything` - `-Wall` - `-Wextra` (alias of `-W`) - `-Wdefault` So for each of flags there's also a complement `-Wno-...` flag, which subtracts the given set from the current enabled-warnings state. Thus, we can now easily perform simple set subtraction operations, as warning flags are evaluated from left-to-right on the command line. So e.g. - `-Weverything -Wno-all -Wno-compat` enables *all* warnings not enabled by `-Wall` and `-Wcompat`. - `-Wextra -Wno-default` only warnings that `-Wextra` provides beyond the default warnings. Reviewers: quchen, austin, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1850 >--------------------------------------------------------------- 86897e1fe23cb26fa2278e86542b34c33301606a compiler/main/DynFlags.hs | 28 ++++++++++++++++++++++++---- 1 file changed, 24 insertions(+), 4 deletions(-) diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index b86d1a7..4b4eb77 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -2579,13 +2579,29 @@ dynamic_flags = [ , defFlag "W" (NoArg (mapM_ setWarningFlag minusWOpts)) , defFlag "Werror" (NoArg (setGeneralFlag Opt_WarnIsError)) , defFlag "Wwarn" (NoArg (unSetGeneralFlag Opt_WarnIsError)) - , defFlag "Wcompat" (NoArg (mapM_ setWarningFlag minusWcompatOpts)) - , defFlag "Wno-compat" (NoArg (mapM_ unSetWarningFlag minusWcompatOpts)) - , defFlag "Wall" (NoArg (mapM_ setWarningFlag minusWallOpts)) , defFlag "Wnot" (NoArg (do upd (\dfs -> dfs {warningFlags = IntSet.empty}) - deprecate "Use -w instead")) + deprecate "Use -w or -Wno-everything instead")) , defFlag "w" (NoArg (upd (\dfs -> dfs {warningFlags = IntSet.empty}))) + -- New-style uniform warning sets + -- + -- Note that -Weverything > -Wall > -Wextra > -Wdefault > -Wno-everything + , defFlag "Weverything" (NoArg (mapM_ setWarningFlag minusWeverythingOpts)) + , defFlag "Wno-everything" + (NoArg (upd (\dfs -> dfs {warningFlags = IntSet.empty}))) + + , defFlag "Wall" (NoArg (mapM_ setWarningFlag minusWallOpts)) + , defFlag "Wno-all" (NoArg (mapM_ unSetWarningFlag minusWallOpts)) + + , defFlag "Wextra" (NoArg (mapM_ setWarningFlag minusWOpts)) + , defFlag "Wno-extra" (NoArg (mapM_ unSetWarningFlag minusWOpts)) + + , defFlag "Wdefault" (NoArg (mapM_ setWarningFlag standardWarnings)) + , defFlag "Wno-default" (NoArg (mapM_ unSetWarningFlag standardWarnings)) + + , defFlag "Wcompat" (NoArg (mapM_ setWarningFlag minusWcompatOpts)) + , defFlag "Wno-compat" (NoArg (mapM_ unSetWarningFlag minusWcompatOpts)) + ------ Plugin flags ------------------------------------------------ , defGhcFlag "fplugin-opt" (hasArg addPluginModuleNameOption) , defGhcFlag "fplugin" (hasArg addPluginModuleName) @@ -3540,6 +3556,10 @@ minusWallOpts Opt_WarnMissingPatSynSigs ] +-- | Things you get with -Weverything, i.e. *all* known warnings flags +minusWeverythingOpts :: [WarningFlag] +minusWeverythingOpts = [ toEnum 0 .. ] + -- | Things you get with -Wcompat. -- -- This is intended to group together warnings that will be enabled by default From git at git.haskell.org Mon Feb 1 14:51:14 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 1 Feb 2016 14:51:14 +0000 (UTC) Subject: [commit: ghc] master: Fix LOOKS_LIKE_PTR for 64-bit platforms (ba88aab) Message-ID: <20160201145114.3397B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ba88aab0d1223cd5066a66500360df4bddb159d1/ghc >--------------------------------------------------------------- commit ba88aab0d1223cd5066a66500360df4bddb159d1 Author: Reid Barton Date: Mon Feb 1 14:32:38 2016 +0100 Fix LOOKS_LIKE_PTR for 64-bit platforms I'm not sure what this is used for. But it won't correctly detect RTS-filled slop on 64-bit platforms. Test Plan: Untested. But I did verify that unsigned long x = (unsigned long)0xaaaaaaaaaaaaaaaaULL; compiles warning-free and produces the expected output using both gcc and clang, with -Wall -Wextra -O, and with and without -m32. Reviewers: simonmar, austin, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1860 >--------------------------------------------------------------- ba88aab0d1223cd5066a66500360df4bddb159d1 rts/RetainerProfile.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/rts/RetainerProfile.c b/rts/RetainerProfile.c index 7a1a661..6a6a542 100644 --- a/rts/RetainerProfile.c +++ b/rts/RetainerProfile.c @@ -2063,7 +2063,7 @@ retainerProfile(void) #define LOOKS_LIKE_PTR(r) ((LOOKS_LIKE_STATIC_CLOSURE(r) || \ ((HEAP_ALLOCED(r) && ((Bdescr((P_)r)->flags & BF_FREE) == 0)))) && \ - ((StgWord)(*(StgPtr)r)!=0xaaaaaaaa)) + ((StgWord)(*(StgPtr)r)!=(StgWord)0xaaaaaaaaaaaaaaaaULL)) static nat sanityCheckHeapClosure( StgClosure *c ) From git at git.haskell.org Mon Feb 1 14:51:16 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 1 Feb 2016 14:51:16 +0000 (UTC) Subject: [commit: ghc] master: Add some Outputable instances (2ad46a8) Message-ID: <20160201145116.E28A03A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2ad46a860f0b648aaeff224109b6045da30304d7/ghc >--------------------------------------------------------------- commit 2ad46a860f0b648aaeff224109b6045da30304d7 Author: Oleg Grenrus Date: Mon Feb 1 14:32:54 2016 +0100 Add some Outputable instances Reviewers: austin, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1865 >--------------------------------------------------------------- 2ad46a860f0b648aaeff224109b6045da30304d7 compiler/main/DynFlags.hs | 10 +++++++++- compiler/utils/Outputable.hs | 4 ++++ 2 files changed, 13 insertions(+), 1 deletion(-) diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 4b4eb77..13f3bd7 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -604,7 +604,10 @@ data WarningFlag = deriving (Eq, Show, Enum) data Language = Haskell98 | Haskell2010 - deriving Enum + deriving (Eq, Enum, Show) + +instance Outputable Language where + ppr = text . show -- | The various Safe Haskell modes data SafeHaskellMode @@ -1675,6 +1678,11 @@ Note [Verbosity levels] data OnOff a = On a | Off a + deriving (Eq, Show) + +instance Outputable a => Outputable (OnOff a) where + ppr (On x) = text "On" <+> ppr x + ppr (Off x) = text "Off" <+> ppr x -- OnOffs accumulate in reverse order, so we use foldr in order to -- process them in the right order diff --git a/compiler/utils/Outputable.hs b/compiler/utils/Outputable.hs index 1abb1c5..bf0cc90 100644 --- a/compiler/utils/Outputable.hs +++ b/compiler/utils/Outputable.hs @@ -95,6 +95,7 @@ import Platform import Pretty ( Doc, Mode(..) ) import Panic import GHC.Serialized +import GHC.LanguageExtensions (Extension) import Data.ByteString (ByteString) import qualified Data.ByteString as BS @@ -815,6 +816,9 @@ instance Outputable a => Outputable (SCC a) where instance Outputable Serialized where ppr (Serialized the_type bytes) = int (length bytes) <+> text "of type" <+> text (show the_type) +instance Outputable Extension where + ppr = text . show + {- ************************************************************************ * * From git at git.haskell.org Mon Feb 1 14:51:19 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 1 Feb 2016 14:51:19 +0000 (UTC) Subject: [commit: ghc] master: Typo in docs (02e3ce0) Message-ID: <20160201145119.B960A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/02e3ce0bc65f586376c3d2ecab498a4c5a3f6a54/ghc >--------------------------------------------------------------- commit 02e3ce0bc65f586376c3d2ecab498a4c5a3f6a54 Author: Ben Gamari Date: Mon Feb 1 14:33:15 2016 +0100 Typo in docs Spelling mistakes fixed, * identiy > identity * suprising > surprising Reviewers: austin, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1871 >--------------------------------------------------------------- 02e3ce0bc65f586376c3d2ecab498a4c5a3f6a54 docs/backpack/algorithm.tex | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/docs/backpack/algorithm.tex b/docs/backpack/algorithm.tex index c98781c..1c5adbd 100644 --- a/docs/backpack/algorithm.tex +++ b/docs/backpack/algorithm.tex @@ -198,7 +198,7 @@ in a Cabal package, including the name and version of the containing package, the transitive dependencies of the component, and even the build information for the component. This ID is opaque to GHC and selected by Cabal (although GHC may take a component ID and suffix it with a unit name to -derive a new component ID.) Component IDs identiy entries in the +derive a new component ID.) Component IDs identity entries in the \textbf{component database}, which contains the results of typechecking a component, but no actual object code. However, it does contain the elaborated source, so that it can be built into actual code when @@ -1152,7 +1152,7 @@ provide a record selector. This capability seems quite attractive, although in practice record selectors rarely seem to be abstracted this way: one reason is that \verb|M.foo| still \emph{is} a record selector, and can be used to modify a record. (Many library authors find this -suprising!) +surprising!) Nor does this seem to be an insurmountable instance of the avoidance problem: From git at git.haskell.org Mon Feb 1 15:30:02 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 1 Feb 2016 15:30:02 +0000 (UTC) Subject: [commit: ghc] master: Fix runtime linker error message when old symbol had no owner (7329310) Message-ID: <20160201153002.7E7273A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/73293109645efe42bf3fdf3335f4ab7cef39001b/ghc >--------------------------------------------------------------- commit 73293109645efe42bf3fdf3335f4ab7cef39001b Author: Reid Barton Date: Mon Feb 1 09:43:48 2016 -0500 Fix runtime linker error message when old symbol had no owner Test Plan: Actually run validate. This fixes test linker_error3. Reviewers: austin, erikd, bgamari Reviewed By: erikd, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1874 >--------------------------------------------------------------- 73293109645efe42bf3fdf3335f4ab7cef39001b rts/Linker.c | 1 + 1 file changed, 1 insertion(+) diff --git a/rts/Linker.c b/rts/Linker.c index 29bd5d8..c225ab6 100644 --- a/rts/Linker.c +++ b/rts/Linker.c @@ -439,6 +439,7 @@ static int ghciInsertSymbolTable( " loaded twice.\n", (char*)key, obj_name, + pinfo->owner == NULL ? "(GHCi built-in symbols)" : pinfo->owner->archiveMemberName ? pinfo->owner->archiveMemberName : pinfo->owner->fileName ); From git at git.haskell.org Mon Feb 1 21:11:31 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 1 Feb 2016 21:11:31 +0000 (UTC) Subject: [commit: ghc] master: Avoid mangled/derived names in GHCi autocomplete (fixes #11328) (dd0b7c7) Message-ID: <20160201211131.5F2483A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/dd0b7c78f64f2498594d3ef89d3bf884402f14d9/ghc >--------------------------------------------------------------- commit dd0b7c78f64f2498594d3ef89d3bf884402f14d9 Author: Adam Gundry Date: Mon Feb 1 16:41:03 2016 +0100 Avoid mangled/derived names in GHCi autocomplete (fixes #11328) This changes `getRdrNamesInScope` to use field labels rather than selector names for fields from modules with `DuplicateRecordFields` enabled. Moreover, it filters out derived names (e.g. type representation bindings) that shouldn't show up in autocomplete. Test Plan: New test ghci/should_run/T11328 Reviewers: kolmodin, austin, bgamari, simonpj Reviewed By: bgamari, simonpj Subscribers: simonpj, thomie Differential Revision: https://phabricator.haskell.org/D1870 GHC Trac Issues: #11328 >--------------------------------------------------------------- dd0b7c78f64f2498594d3ef89d3bf884402f14d9 compiler/basicTypes/RdrName.hs | 4 ++-- compiler/main/InteractiveEval.hs | 5 ++++- testsuite/tests/ghci/should_run/T11328.script | 4 ++++ testsuite/tests/ghci/should_run/T11328.stdout | 5 +++++ testsuite/tests/ghci/should_run/all.T | 1 + 5 files changed, 16 insertions(+), 3 deletions(-) diff --git a/compiler/basicTypes/RdrName.hs b/compiler/basicTypes/RdrName.hs index 6e0350d..62771e9 100644 --- a/compiler/basicTypes/RdrName.hs +++ b/compiler/basicTypes/RdrName.hs @@ -629,10 +629,10 @@ greUsedRdrName gre at GRE{ gre_name = name, gre_lcl = lcl, gre_imp = iss } occ = greOccName gre greRdrNames :: GlobalRdrElt -> [RdrName] -greRdrNames GRE{ gre_name = name, gre_lcl = lcl, gre_imp = iss } +greRdrNames gre at GRE{ gre_lcl = lcl, gre_imp = iss } = (if lcl then [unqual] else []) ++ concatMap do_spec (map is_decl iss) where - occ = nameOccName name + occ = greOccName gre unqual = Unqual occ do_spec decl_spec | is_qual decl_spec = [qual] diff --git a/compiler/main/InteractiveEval.hs b/compiler/main/InteractiveEval.hs index b66a4f8..ac4c60e 100644 --- a/compiler/main/InteractiveEval.hs +++ b/compiler/main/InteractiveEval.hs @@ -800,13 +800,16 @@ getNamesInScope :: GhcMonad m => m [Name] getNamesInScope = withSession $ \hsc_env -> do return (map gre_name (globalRdrEnvElts (ic_rn_gbl_env (hsc_IC hsc_env)))) +-- | Returns all 'RdrName's in scope in the current interactive +-- context, excluding any that are internally-generated. getRdrNamesInScope :: GhcMonad m => m [RdrName] getRdrNamesInScope = withSession $ \hsc_env -> do let ic = hsc_IC hsc_env gbl_rdrenv = ic_rn_gbl_env ic gbl_names = concatMap greRdrNames $ globalRdrEnvElts gbl_rdrenv - return gbl_names + -- Exclude internally generated names; see e.g. Trac #11328 + return (filter (not . isDerivedOccName . rdrNameOcc) gbl_names) -- | Parses a string as an identifier, and returns the list of 'Name's that diff --git a/testsuite/tests/ghci/should_run/T11328.script b/testsuite/tests/ghci/should_run/T11328.script new file mode 100644 index 0000000..410e4b7 --- /dev/null +++ b/testsuite/tests/ghci/should_run/T11328.script @@ -0,0 +1,4 @@ +:seti -XDuplicateRecordFields +data T = MkT { foo :: Int } +:complete repl "foo" +:complete repl "$" diff --git a/testsuite/tests/ghci/should_run/T11328.stdout b/testsuite/tests/ghci/should_run/T11328.stdout new file mode 100644 index 0000000..272da79 --- /dev/null +++ b/testsuite/tests/ghci/should_run/T11328.stdout @@ -0,0 +1,5 @@ +1 1 "" +"foo" +2 2 "" +"$" +"$!" diff --git a/testsuite/tests/ghci/should_run/all.T b/testsuite/tests/ghci/should_run/all.T index 68c7407..930f14b 100644 --- a/testsuite/tests/ghci/should_run/all.T +++ b/testsuite/tests/ghci/should_run/all.T @@ -22,3 +22,4 @@ test('T9914', just_ghci, ghci_script, ['T9914.script']) test('T9915', just_ghci, ghci_script, ['T9915.script']) test('T10145', just_ghci, ghci_script, ['T10145.script']) test('T7253', just_ghci, ghci_script, ['T7253.script']) +test('T11328', just_ghci, ghci_script, ['T11328.script']) From git at git.haskell.org Mon Feb 1 21:41:51 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 1 Feb 2016 21:41:51 +0000 (UTC) Subject: [commit: ghc] master: Update unix submodule to latest snapshot (ddd38e7) Message-ID: <20160201214151.129C43A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ddd38e7dce5d841b89479a4496b117553f0feeec/ghc >--------------------------------------------------------------- commit ddd38e7dce5d841b89479a4496b117553f0feeec Author: Herbert Valerio Riedel Date: Mon Feb 1 19:38:46 2016 +0100 Update unix submodule to latest snapshot Besides containing more internal refactorings, this update also bumps unix's version number to 2.7.2.0 >--------------------------------------------------------------- ddd38e7dce5d841b89479a4496b117553f0feeec libraries/unix | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/unix b/libraries/unix index 91b8238..ff1c16d 160000 --- a/libraries/unix +++ b/libraries/unix @@ -1 +1 @@ -Subproject commit 91b82383873b46385d239f2b059f353b11f07e0f +Subproject commit ff1c16d4ee0c4ca043bd99a5d6741ea2d53e7000 From git at git.haskell.org Tue Feb 2 01:15:38 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Feb 2016 01:15:38 +0000 (UTC) Subject: [commit: ghc] master: TyCoRep: Implement some helpers for dropping/checking Levity arguments (af8fdb9) Message-ID: <20160202011538.BEC223A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/af8fdb97c27d6ba4c8f4ffffc2bdc2eceba61bf1/ghc >--------------------------------------------------------------- commit af8fdb97c27d6ba4c8f4ffffc2bdc2eceba61bf1 Author: ?mer Sinan A?acan Date: Mon Feb 1 20:15:21 2016 -0500 TyCoRep: Implement some helpers for dropping/checking Levity arguments Also fix `isLevityTy` (it should use `coreView`) and start using `dropLevityArgs` in some places. Reviewers: goldfire, simonpj, austin, hvr, bgamari Reviewed By: simonpj Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1867 >--------------------------------------------------------------- af8fdb97c27d6ba4c8f4ffffc2bdc2eceba61bf1 compiler/ghci/RtClosureInspect.hs | 2 +- compiler/types/TyCoRep.hs | 18 ++++++++++++++++-- compiler/types/Type.hs | 6 ++++-- 3 files changed, 21 insertions(+), 5 deletions(-) diff --git a/compiler/ghci/RtClosureInspect.hs b/compiler/ghci/RtClosureInspect.hs index 2dca546..d7922c5 100644 --- a/compiler/ghci/RtClosureInspect.hs +++ b/compiler/ghci/RtClosureInspect.hs @@ -804,7 +804,7 @@ extractSubTerms recurse clos = liftM thdOf3 . go 0 (nonPtrs clos) | Just (tc, elem_tys) <- tcSplitTyConApp_maybe ty , isUnboxedTupleTyCon tc -- See Note [Unboxed tuple levity vars] in TyCon - = do (ptr_i, ws, terms0) <- go ptr_i ws (drop (length elem_tys `div` 2) elem_tys) + = do (ptr_i, ws, terms0) <- go ptr_i ws (dropLevityArgs elem_tys) (ptr_i, ws, terms1) <- go ptr_i ws tys return (ptr_i, ws, unboxedTupleTerm ty terms0 : terms1) | otherwise diff --git a/compiler/types/TyCoRep.hs b/compiler/types/TyCoRep.hs index 758ac25..3576fdd 100644 --- a/compiler/types/TyCoRep.hs +++ b/compiler/types/TyCoRep.hs @@ -39,6 +39,7 @@ module TyCoRep ( mkFunTy, mkFunTys, isLiftedTypeKind, isUnliftedTypeKind, isCoercionType, isLevityTy, isLevityVar, + isLevityKindedTy, dropLevityArgs, sameVis, -- Functions over binders @@ -120,7 +121,7 @@ module TyCoRep ( import {-# SOURCE #-} DataCon( dataConTyCon, dataConFullSig , DataCon, eqSpecTyVar ) import {-# SOURCE #-} Type( isPredTy, isCoercionTy, mkAppTy - , partitionInvisibles, coreView ) + , partitionInvisibles, coreView, typeKind ) -- Transitively pulls in a LOT of stuff, better to break the loop import {-# SOURCE #-} Coercion @@ -523,13 +524,26 @@ isUnliftedTypeKind _ = False -- | Is this the type 'Levity'? isLevityTy :: Type -> Bool +isLevityTy ty | Just ty' <- coreView ty = isLevityTy ty' isLevityTy (TyConApp tc []) = tc `hasKey` levityTyConKey -isLevityTy _ = False +isLevityTy _ = False + +-- | Is this a type of kind Levity? (e.g. Lifted, Unlifted) +isLevityKindedTy :: Type -> Bool +isLevityKindedTy = isLevityTy . typeKind -- | Is a tyvar of type 'Levity'? isLevityVar :: TyVar -> Bool isLevityVar = isLevityTy . tyVarKind +-- | Drops prefix of Levity constructors in 'TyConApp's. Useful for e.g. +-- dropping 'Lifted and 'Unlifted arguments of unboxed tuple TyCon applications: +-- +-- dropLevityArgs ['Lifted, 'Unlifted, String, Int#] == [String, Int#] +-- +dropLevityArgs :: [Type] -> [Type] +dropLevityArgs = dropWhile isLevityKindedTy + {- %************************************************************************ %* * diff --git a/compiler/types/Type.hs b/compiler/types/Type.hs index 43aad5b..12befed 100644 --- a/compiler/types/Type.hs +++ b/compiler/types/Type.hs @@ -103,7 +103,9 @@ module Type ( -- (Lifting and boxity) isUnliftedType, isUnboxedTupleType, isAlgType, isClosedAlgType, isPrimitiveType, isStrictType, - isLevityTy, isLevityVar, getLevity, getLevityFromKind, + isLevityTy, isLevityVar, isLevityKindedTy, + dropLevityArgs, + getLevity, getLevityFromKind, -- * Main data types representing Kinds Kind, @@ -1134,7 +1136,7 @@ repType ty else UbxTupleRep (concatMap (flattenRepType . go rec_nts) non_levity_tys) where -- See Note [Unboxed tuple levity vars] in TyCon - non_levity_tys = drop (length tys `div` 2) tys + non_levity_tys = dropLevityArgs tys go rec_nts (CastTy ty _) = go rec_nts ty From git at git.haskell.org Tue Feb 2 08:21:35 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Feb 2016 08:21:35 +0000 (UTC) Subject: [commit: ghc] master: Remote GHCi: parallelise BCO serialization (c996db5) Message-ID: <20160202082135.028C33A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c996db5b1802ebeb93420785127f7fd55b7ec0c0/ghc >--------------------------------------------------------------- commit c996db5b1802ebeb93420785127f7fd55b7ec0c0 Author: Simon Marlow Date: Mon Feb 1 16:39:50 2016 +0000 Remote GHCi: parallelise BCO serialization Summary: Serialization of BCOs is slow, but we can parallelise it when using ghci -j. It parallelises nicely, saving multiple seconds off the link time in a large example I have. Test Plan: * validate * `ghci -fexternal-interpreter` in `nofib/real/anna` Reviewers: niteria, bgamari, ezyang, austin, hvr, erikd Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1877 GHC Trac Issues: #11100 >--------------------------------------------------------------- c996db5b1802ebeb93420785127f7fd55b7ec0c0 compiler/ghci/GHCi.hs | 39 ++++++++++++++++++++++++++++++++++++++- compiler/ghci/Linker.hs | 4 ++-- compiler/utils/Util.hs | 8 ++++++++ libraries/ghci/GHCi/Message.hs | 3 +-- libraries/ghci/GHCi/Run.hs | 4 +++- 5 files changed, 52 insertions(+), 6 deletions(-) diff --git a/compiler/ghci/GHCi.hs b/compiler/ghci/GHCi.hs index 2e2cd35..80aeccf 100644 --- a/compiler/ghci/GHCi.hs +++ b/compiler/ghci/GHCi.hs @@ -13,6 +13,7 @@ module GHCi , evalString , evalStringToIOString , mallocData + , createBCOs , mkCostCentres , costCentreStackInfo , newBreakArray @@ -47,6 +48,7 @@ module GHCi import GHCi.Message import GHCi.Run import GHCi.RemoteTypes +import GHCi.ResolvedBCO import GHCi.BreakArray (BreakArray) import HscTypes import UniqFM @@ -57,14 +59,17 @@ import Outputable import Exception import BasicTypes import FastString +import Util import Control.Concurrent import Control.Monad import Control.Monad.IO.Class import Data.Binary +import Data.Binary.Put import Data.ByteString (ByteString) +import qualified Data.ByteString.Lazy as LB import Data.IORef -import Foreign +import Foreign hiding (void) import GHC.Stack.CCS (CostCentre,CostCentreStack) import System.Exit import Data.Maybe @@ -76,6 +81,7 @@ import GHC.IO.Handle.FD (fdToHandle) import System.Posix as Posix #endif import System.Process +import GHC.Conc {- Note [Remote GHCi] @@ -258,6 +264,37 @@ mkCostCentres mkCostCentres hsc_env mod ccs = iservCmd hsc_env (MkCostCentres mod ccs) +-- | Create a set of BCOs that may be mutually recursive. +createBCOs :: HscEnv -> [ResolvedBCO] -> IO [HValueRef] +createBCOs hsc_env rbcos = do + n_jobs <- case parMakeCount (hsc_dflags hsc_env) of + Nothing -> liftIO getNumProcessors + Just n -> return n + -- Serializing ResolvedBCO is expensive, so if we're in parallel mode + -- (-j) parallelise the serialization. + if (n_jobs == 1) + then + iservCmd hsc_env (CreateBCOs [runPut (put rbcos)]) + + else do + old_caps <- getNumCapabilities + if old_caps == n_jobs + then void $ evaluate puts + else bracket_ (setNumCapabilities n_jobs) + (setNumCapabilities old_caps) + (void $ evaluate puts) + iservCmd hsc_env (CreateBCOs puts) + where + puts = parMap doChunk (chunkList 100 rbcos) + + -- make sure we force the whole lazy ByteString + doChunk c = pseq (LB.length bs) bs + where bs = runPut (put c) + + -- We don't have the parallel package, so roll our own simple parMap + parMap _ [] = [] + parMap f (x:xs) = fx `par` (fxs `pseq` (fx : fxs)) + where fx = f x; fxs = parMap f xs costCentreStackInfo :: HscEnv -> RemotePtr CostCentreStack -> IO [String] costCentreStackInfo hsc_env ccs = diff --git a/compiler/ghci/Linker.hs b/compiler/ghci/Linker.hs index 982b4fc..2b471ee 100644 --- a/compiler/ghci/Linker.hs +++ b/compiler/ghci/Linker.hs @@ -499,7 +499,7 @@ linkExpr hsc_env span root_ul_bco ; let nobreakarray = error "no break array" bco_ix = mkNameEnv [(unlinkedBCOName root_ul_bco, 0)] ; resolved <- linkBCO hsc_env ie ce bco_ix nobreakarray root_ul_bco - ; [root_hvref] <- iservCmd hsc_env (CreateBCOs [resolved]) + ; [root_hvref] <- createBCOs hsc_env [resolved] ; fhv <- mkFinalizedHValue hsc_env root_hvref ; return (pls, fhv) }}} @@ -971,7 +971,7 @@ linkSomeBCOs hsc_env ie ce mods = foldr fun do_link mods [] bco_ix = mkNameEnv (zip names [0..]) resolved <- sequence [ linkBCO hsc_env ie ce bco_ix breakarray bco | (breakarray, bco) <- flat ] - hvrefs <- iservCmd hsc_env (CreateBCOs resolved) + hvrefs <- createBCOs hsc_env resolved return (zip names hvrefs) -- | Useful to apply to the result of 'linkSomeBCOs' diff --git a/compiler/utils/Util.hs b/compiler/utils/Util.hs index c0a335c..b8af6a7 100644 --- a/compiler/utils/Util.hs +++ b/compiler/utils/Util.hs @@ -35,6 +35,8 @@ module Util ( isIn, isn'tIn, + chunkList, + -- * Tuples fstOf3, sndOf3, thdOf3, firstM, first3M, @@ -503,6 +505,12 @@ isn'tIn msg x ys | otherwise = x /= y && notElem100 (i + 1) x ys # endif /* DEBUG */ + +-- | Split a list into chunks of /n/ elements +chunkList :: Int -> [a] -> [[a]] +chunkList _ [] = [] +chunkList n xs = as : chunkList n bs where (as,bs) = splitAt n xs + {- ************************************************************************ * * diff --git a/libraries/ghci/GHCi/Message.hs b/libraries/ghci/GHCi/Message.hs index 50d4a16..b8f9fcc 100644 --- a/libraries/ghci/GHCi/Message.hs +++ b/libraries/ghci/GHCi/Message.hs @@ -14,7 +14,6 @@ module GHCi.Message ) where import GHCi.RemoteTypes -import GHCi.ResolvedBCO import GHCi.InfoTable (StgInfoTable) import GHCi.FFI import GHCi.TH.Binary () @@ -66,7 +65,7 @@ data Message a where -- Interpreter ------------------------------------------- -- | Create a set of BCO objects, and return HValueRefs to them - CreateBCOs :: [ResolvedBCO] -> Message [HValueRef] + CreateBCOs :: [LB.ByteString] -> Message [HValueRef] -- | Release 'HValueRef's FreeHValueRefs :: [HValueRef] -> Message () diff --git a/libraries/ghci/GHCi/Run.hs b/libraries/ghci/GHCi/Run.hs index 3faced4..a2ea4e2 100644 --- a/libraries/ghci/GHCi/Run.hs +++ b/libraries/ghci/GHCi/Run.hs @@ -23,6 +23,8 @@ import Control.Concurrent import Control.DeepSeq import Control.Exception import Control.Monad +import Data.Binary +import Data.Binary.Get import Data.ByteString (ByteString) import qualified Data.ByteString.Unsafe as B import GHC.Exts @@ -51,7 +53,7 @@ run m = case m of RemoveLibrarySearchPath ptr -> removeLibrarySearchPath (fromRemotePtr ptr) ResolveObjs -> resolveObjs FindSystemLibrary str -> findSystemLibrary str - CreateBCOs bco -> createBCOs bco + CreateBCOs bcos -> createBCOs (concatMap (runGet get) bcos) FreeHValueRefs rs -> mapM_ freeRemoteRef rs EvalStmt opts r -> evalStmt opts r ResumeStmt opts r -> resumeStmt opts r From git at git.haskell.org Tue Feb 2 08:21:37 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Feb 2016 08:21:37 +0000 (UTC) Subject: [commit: ghc] master: Remote GHCi: Optimize the serialization/deserialization of byte code (2fb6a8c) Message-ID: <20160202082137.A30A43A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2fb6a8c30567e7d071ffcf88e22ea7f72f60b826/ghc >--------------------------------------------------------------- commit 2fb6a8c30567e7d071ffcf88e22ea7f72f60b826 Author: Simon Marlow Date: Fri Jan 29 11:27:50 2016 +0000 Remote GHCi: Optimize the serialization/deserialization of byte code Summary: This cuts allocations by about a quarter. Test Plan: * validate * `ghci -fexternal-interpreter` in `nofib/real/anna` Reviewers: niteria, bgamari, ezyang, austin, hvr, erikd Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1875 GHC Trac Issues: #11100 >--------------------------------------------------------------- 2fb6a8c30567e7d071ffcf88e22ea7f72f60b826 compiler/ghci/ByteCodeLink.hs | 14 ++++++++- libraries/ghci/GHCi/ResolvedBCO.hs | 64 ++++++++++++++++++++++++++++++++------ 2 files changed, 67 insertions(+), 11 deletions(-) diff --git a/compiler/ghci/ByteCodeLink.hs b/compiler/ghci/ByteCodeLink.hs index 74f490b..c108d16 100644 --- a/compiler/ghci/ByteCodeLink.hs +++ b/compiler/ghci/ByteCodeLink.hs @@ -28,6 +28,7 @@ import SizedSeq import GHCi import ByteCodeTypes import HscTypes +import DynFlags import Name import NameEnv import PrimOp @@ -39,6 +40,8 @@ import Util -- Standard libraries import Data.Array.Unboxed +import Data.Array.Base +import Data.Word import Foreign.Ptr import GHC.IO ( IO(..) ) import GHC.Exts @@ -68,10 +71,19 @@ linkBCO hsc_env ie ce bco_ix breakarray (UnlinkedBCO _ arity insns bitmap lits0 ptrs0) = do lits <- mapM (lookupLiteral hsc_env ie) (ssElts lits0) ptrs <- mapM (resolvePtr hsc_env ie ce bco_ix breakarray) (ssElts ptrs0) - return (ResolvedBCO arity insns bitmap + let dflags = hsc_dflags hsc_env + return (ResolvedBCO arity (toWordArray dflags insns) bitmap (listArray (0, fromIntegral (sizeSS lits0)-1) lits) (addListToSS emptySS ptrs)) +-- Turn the insns array from a Word16 array into a Word array. The +-- latter is much faster to serialize/deserialize. Assumes the input +-- array is zero-indexed. +toWordArray :: DynFlags -> UArray Int Word16 -> UArray Int Word +toWordArray dflags (UArray _ _ n arr) = UArray 0 (n'-1) n' arr + where n' = (n + w16s_per_word - 1) `quot` w16s_per_word + w16s_per_word = wORD_SIZE dflags `quot` 2 + lookupLiteral :: HscEnv -> ItblEnv -> BCONPtr -> IO Word lookupLiteral _ _ (BCONPtrWord lit) = return lit lookupLiteral hsc_env _ (BCONPtrLbl sym) = do diff --git a/libraries/ghci/GHCi/ResolvedBCO.hs b/libraries/ghci/GHCi/ResolvedBCO.hs index a349ded..aa63d36 100644 --- a/libraries/ghci/GHCi/ResolvedBCO.hs +++ b/libraries/ghci/GHCi/ResolvedBCO.hs @@ -1,4 +1,5 @@ -{-# LANGUAGE RecordWildCards, DeriveGeneric, GeneralizedNewtypeDeriving #-} +{-# LANGUAGE RecordWildCards, DeriveGeneric, GeneralizedNewtypeDeriving, + BangPatterns #-} module GHCi.ResolvedBCO ( ResolvedBCO(..) , ResolvedBCOPtr(..) @@ -8,38 +9,81 @@ import SizedSeq import GHCi.RemoteTypes import GHCi.BreakArray +import Control.Monad.ST import Data.Array.Unboxed +import Data.Array.Base import Data.Binary import GHC.Generics -- ----------------------------------------------------------------------------- -- ResolvedBCO --- A ResolvedBCO is one in which all the Name references have been +-- A A ResolvedBCO is one in which all the Name references have been -- resolved to actual addresses or RemoteHValues. - +-- +-- Note, all arrays are zero-indexed (we assume this when +-- serializing/deserializing) data ResolvedBCO = ResolvedBCO { - resolvedBCOArity :: Int, - resolvedBCOInstrs :: UArray Int Word16, -- insns + resolvedBCOArity :: {-# UNPACK #-} !Int, + resolvedBCOInstrs :: UArray Int Word, -- insns resolvedBCOBitmap :: UArray Int Word, -- bitmap resolvedBCOLits :: UArray Int Word, -- non-ptrs resolvedBCOPtrs :: (SizedSeq ResolvedBCOPtr) -- ptrs } deriving (Generic, Show) -instance Binary ResolvedBCO +instance Binary ResolvedBCO where + put ResolvedBCO{..} = do + put resolvedBCOArity + putArray resolvedBCOInstrs + putArray resolvedBCOBitmap + putArray resolvedBCOLits + put resolvedBCOPtrs + get = ResolvedBCO <$> get <*> getArray <*> getArray <*> getArray <*> get + +-- Specialized versions of the binary get/put for UArray Int Word. +-- This saves a bit of time and allocation over using the default +-- get/put, because we get specialisd code and also avoid serializing +-- the bounds. +putArray :: UArray Int Word -> Put +putArray a@(UArray _ _ n _) = do + put n + mapM_ put (elems a) + +getArray :: Get (UArray Int Word) +getArray = do + n <- get + xs <- gets n [] + return $! mkArray n xs + where + gets 0 xs = return xs + gets n xs = do + x <- get + gets (n-1) (x:xs) + + mkArray :: Int -> [Word] -> UArray Int Word + mkArray n0 xs0 = runST $ do + !marr <- newArray (0,n0-1) 0 + let go 0 _ = return () + go _ [] = error "mkArray" + go n (x:xs) = do + let n' = n-1 + unsafeWrite marr n' x + go n' xs + go n0 xs0 + unsafeFreezeSTUArray marr data ResolvedBCOPtr - = ResolvedBCORef Int + = ResolvedBCORef {-# UNPACK #-} !Int -- ^ reference to the Nth BCO in the current set - | ResolvedBCOPtr (RemoteRef HValue) + | ResolvedBCOPtr {-# UNPACK #-} !(RemoteRef HValue) -- ^ reference to a previously created BCO - | ResolvedBCOStaticPtr (RemotePtr ()) + | ResolvedBCOStaticPtr {-# UNPACK #-} !(RemotePtr ()) -- ^ reference to a static ptr | ResolvedBCOPtrBCO ResolvedBCO -- ^ a nested BCO - | ResolvedBCOPtrBreakArray (RemoteRef BreakArray) + | ResolvedBCOPtrBreakArray {-# UNPACK #-} !(RemoteRef BreakArray) -- ^ Resolves to the MutableArray# inside the BreakArray deriving (Generic, Show) From git at git.haskell.org Tue Feb 2 08:21:40 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Feb 2016 08:21:40 +0000 (UTC) Subject: [commit: ghc] master: Remote GHCi: batch the creation of strings (7cb1fae) Message-ID: <20160202082140.5CF9C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7cb1fae2d6ec90b10708a2631cd1069561177bd4/ghc >--------------------------------------------------------------- commit 7cb1fae2d6ec90b10708a2631cd1069561177bd4 Author: Simon Marlow Date: Mon Feb 1 16:19:10 2016 +0000 Remote GHCi: batch the creation of strings Summary: This makes a big performance difference especially when loading a large number of modules and using parallel compilation (ghci -jN). Test Plan: * validate * `ghci -fexternal-interpreter` in `nofib/real/anna` Reviewers: niteria, bgamari, ezyang, austin, hvr, erikd Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1876 GHC Trac Issues: #11100 >--------------------------------------------------------------- 7cb1fae2d6ec90b10708a2631cd1069561177bd4 compiler/ghci/ByteCodeAsm.hs | 58 ++++++++++++++-- compiler/ghci/ByteCodeGen.hs | 2 +- compiler/ghci/ByteCodeLink.hs | 5 +- compiler/ghci/ByteCodeTypes.hs | 1 + libraries/ghci/GHCi/Message.hs | 149 +++++++++++++++++++++-------------------- libraries/ghci/GHCi/Run.hs | 8 +++ libraries/ghci/SizedSeq.hs | 6 ++ 7 files changed, 148 insertions(+), 81 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 7cb1fae2d6ec90b10708a2631cd1069561177bd4 From git at git.haskell.org Tue Feb 2 09:47:22 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Feb 2016 09:47:22 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Typo in docs (555825c) Message-ID: <20160202094722.1ECA43A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/555825c7886890f24c02eff9d5c2c21292a9b4bd/ghc >--------------------------------------------------------------- commit 555825c7886890f24c02eff9d5c2c21292a9b4bd Author: Ben Gamari Date: Mon Feb 1 14:33:15 2016 +0100 Typo in docs Spelling mistakes fixed, * identiy > identity * suprising > surprising Reviewers: austin, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1871 (cherry picked from commit 02e3ce0bc65f586376c3d2ecab498a4c5a3f6a54) >--------------------------------------------------------------- 555825c7886890f24c02eff9d5c2c21292a9b4bd docs/backpack/algorithm.tex | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/docs/backpack/algorithm.tex b/docs/backpack/algorithm.tex index c98781c..1c5adbd 100644 --- a/docs/backpack/algorithm.tex +++ b/docs/backpack/algorithm.tex @@ -198,7 +198,7 @@ in a Cabal package, including the name and version of the containing package, the transitive dependencies of the component, and even the build information for the component. This ID is opaque to GHC and selected by Cabal (although GHC may take a component ID and suffix it with a unit name to -derive a new component ID.) Component IDs identiy entries in the +derive a new component ID.) Component IDs identity entries in the \textbf{component database}, which contains the results of typechecking a component, but no actual object code. However, it does contain the elaborated source, so that it can be built into actual code when @@ -1152,7 +1152,7 @@ provide a record selector. This capability seems quite attractive, although in practice record selectors rarely seem to be abstracted this way: one reason is that \verb|M.foo| still \emph{is} a record selector, and can be used to modify a record. (Many library authors find this -suprising!) +surprising!) Nor does this seem to be an insurmountable instance of the avoidance problem: From git at git.haskell.org Tue Feb 2 09:47:24 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Feb 2016 09:47:24 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Hide the CallStack implicit parameter (ac90950) Message-ID: <20160202094724.E20EA3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/ac90950133bb421c73b801e44a46a15b82ee84ec/ghc >--------------------------------------------------------------- commit ac90950133bb421c73b801e44a46a15b82ee84ec Author: Eric Seidel Date: Mon Feb 1 14:32:19 2016 +0100 Hide the CallStack implicit parameter The implicit parameter isn't actually very relevant to the CallStack machinery, so we hide the implementation details behind a constraint alias ``` type HasCallStack = (?callStack :: CallStack) ``` This has a few benefits: 1. No need to enable `ImplicitParams` in user code. 2. No need to remember the `?callStack` naming convention. 3. Gives us the option to change the implementation details in the future with less user-land breakage. The revised `CallStack` API is exported from `GHC.Stack` and makes no mention of the implicit parameter. Test Plan: ./validate Reviewers: simonpj, austin, hvr, bgamari Reviewed By: simonpj, bgamari Subscribers: thomie Projects: #ghc Differential Revision: https://phabricator.haskell.org/D1818 (cherry picked from commit 94048f9fb01c541215cfc9cc215af83566b63236) >--------------------------------------------------------------- ac90950133bb421c73b801e44a46a15b82ee84ec compiler/typecheck/TcEvidence.hs | 25 ++--- docs/users_guide/8.0.1-notes.rst | 26 +++--- docs/users_guide/ghci.rst | 4 +- docs/users_guide/glasgow_exts.rst | 186 ++++++++++++++++++++++---------------- libraries/base/GHC/Err.hs | 21 +++-- libraries/base/GHC/Exception.hs | 6 +- libraries/base/GHC/Stack.hs | 31 +++++-- libraries/base/GHC/Stack/Types.hs | 93 +++++++++++++------ testsuite/driver/testlib.py | 6 +- 9 files changed, 245 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 ac90950133bb421c73b801e44a46a15b82ee84ec From git at git.haskell.org Tue Feb 2 09:47:27 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Feb 2016 09:47:27 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Implement basic uniform warning set tower (49637f8) Message-ID: <20160202094727.992F93A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/49637f888d21a9020928387757cecb22aa5b9288/ghc >--------------------------------------------------------------- commit 49637f888d21a9020928387757cecb22aa5b9288 Author: Herbert Valerio Riedel Date: Mon Feb 1 14:32:30 2016 +0100 Implement basic uniform warning set tower This implements/completes the current basic warning sets to provide the following tower of warning sets (i.e. each line subsumes the warnings from the sets listed below): - `-Weverything` - `-Wall` - `-Wextra` (alias of `-W`) - `-Wdefault` So for each of flags there's also a complement `-Wno-...` flag, which subtracts the given set from the current enabled-warnings state. Thus, we can now easily perform simple set subtraction operations, as warning flags are evaluated from left-to-right on the command line. So e.g. - `-Weverything -Wno-all -Wno-compat` enables *all* warnings not enabled by `-Wall` and `-Wcompat`. - `-Wextra -Wno-default` only warnings that `-Wextra` provides beyond the default warnings. Reviewers: quchen, austin, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1850 (cherry picked from commit 86897e1fe23cb26fa2278e86542b34c33301606a) >--------------------------------------------------------------- 49637f888d21a9020928387757cecb22aa5b9288 compiler/main/DynFlags.hs | 28 ++++++++++++++++++++++++---- 1 file changed, 24 insertions(+), 4 deletions(-) diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 3850026..21f63e6 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -2583,13 +2583,29 @@ dynamic_flags = [ , defFlag "W" (NoArg (mapM_ setWarningFlag minusWOpts)) , defFlag "Werror" (NoArg (setGeneralFlag Opt_WarnIsError)) , defFlag "Wwarn" (NoArg (unSetGeneralFlag Opt_WarnIsError)) - , defFlag "Wcompat" (NoArg (mapM_ setWarningFlag minusWcompatOpts)) - , defFlag "Wno-compat" (NoArg (mapM_ unSetWarningFlag minusWcompatOpts)) - , defFlag "Wall" (NoArg (mapM_ setWarningFlag minusWallOpts)) , defFlag "Wnot" (NoArg (do upd (\dfs -> dfs {warningFlags = IntSet.empty}) - deprecate "Use -w instead")) + deprecate "Use -w or -Wno-everything instead")) , defFlag "w" (NoArg (upd (\dfs -> dfs {warningFlags = IntSet.empty}))) + -- New-style uniform warning sets + -- + -- Note that -Weverything > -Wall > -Wextra > -Wdefault > -Wno-everything + , defFlag "Weverything" (NoArg (mapM_ setWarningFlag minusWeverythingOpts)) + , defFlag "Wno-everything" + (NoArg (upd (\dfs -> dfs {warningFlags = IntSet.empty}))) + + , defFlag "Wall" (NoArg (mapM_ setWarningFlag minusWallOpts)) + , defFlag "Wno-all" (NoArg (mapM_ unSetWarningFlag minusWallOpts)) + + , defFlag "Wextra" (NoArg (mapM_ setWarningFlag minusWOpts)) + , defFlag "Wno-extra" (NoArg (mapM_ unSetWarningFlag minusWOpts)) + + , defFlag "Wdefault" (NoArg (mapM_ setWarningFlag standardWarnings)) + , defFlag "Wno-default" (NoArg (mapM_ unSetWarningFlag standardWarnings)) + + , defFlag "Wcompat" (NoArg (mapM_ setWarningFlag minusWcompatOpts)) + , defFlag "Wno-compat" (NoArg (mapM_ unSetWarningFlag minusWcompatOpts)) + ------ Plugin flags ------------------------------------------------ , defGhcFlag "fplugin-opt" (hasArg addPluginModuleNameOption) , defGhcFlag "fplugin" (hasArg addPluginModuleName) @@ -3543,6 +3559,10 @@ minusWallOpts Opt_WarnMissingPatSynSigs ] +-- | Things you get with -Weverything, i.e. *all* known warnings flags +minusWeverythingOpts :: [WarningFlag] +minusWeverythingOpts = [ toEnum 0 .. ] + -- | Things you get with -Wcompat. -- -- This is intended to group together warnings that will be enabled by default From git at git.haskell.org Tue Feb 2 09:47:30 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Feb 2016 09:47:30 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Fix LOOKS_LIKE_PTR for 64-bit platforms (63de06a) Message-ID: <20160202094730.72FB73A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/63de06a1a0f237aebf457fae97e8eb7e82933bec/ghc >--------------------------------------------------------------- commit 63de06a1a0f237aebf457fae97e8eb7e82933bec Author: Reid Barton Date: Mon Feb 1 14:32:38 2016 +0100 Fix LOOKS_LIKE_PTR for 64-bit platforms I'm not sure what this is used for. But it won't correctly detect RTS-filled slop on 64-bit platforms. Test Plan: Untested. But I did verify that unsigned long x = (unsigned long)0xaaaaaaaaaaaaaaaaULL; compiles warning-free and produces the expected output using both gcc and clang, with -Wall -Wextra -O, and with and without -m32. Reviewers: simonmar, austin, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1860 (cherry picked from commit ba88aab0d1223cd5066a66500360df4bddb159d1) >--------------------------------------------------------------- 63de06a1a0f237aebf457fae97e8eb7e82933bec rts/RetainerProfile.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/rts/RetainerProfile.c b/rts/RetainerProfile.c index ba58c19..387c6d7 100644 --- a/rts/RetainerProfile.c +++ b/rts/RetainerProfile.c @@ -2066,7 +2066,7 @@ retainerProfile(void) #define LOOKS_LIKE_PTR(r) ((LOOKS_LIKE_STATIC_CLOSURE(r) || \ ((HEAP_ALLOCED(r) && ((Bdescr((P_)r)->flags & BF_FREE) == 0)))) && \ - ((StgWord)(*(StgPtr)r)!=0xaaaaaaaa)) + ((StgWord)(*(StgPtr)r)!=(StgWord)0xaaaaaaaaaaaaaaaaULL)) static nat sanityCheckHeapClosure( StgClosure *c ) From git at git.haskell.org Tue Feb 2 12:03:05 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Feb 2016 12:03:05 +0000 (UTC) Subject: [commit: ghc] master: Fix Windows build after D1874 (01c587c) Message-ID: <20160202120305.D894E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/01c587c03764de52cd01a3464c1a4a5c5bce7c00/ghc >--------------------------------------------------------------- commit 01c587c03764de52cd01a3464c1a4a5c5bce7c00 Author: Tamar Christina Date: Tue Feb 2 12:36:52 2016 +0100 Fix Windows build after D1874 Windows uses wchar_t* for paths. The code committed won't compile for Windows as the types are incorrect and the types in the branches of the ternary operator aren't consistent. Test Plan: ./validate --fast Reviewers: austin, rwbarton, erikd, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1878 >--------------------------------------------------------------- 01c587c03764de52cd01a3464c1a4a5c5bce7c00 rts/Linker.c | 26 ++++++++++++++++++++++++-- 1 file changed, 24 insertions(+), 2 deletions(-) diff --git a/rts/Linker.c b/rts/Linker.c index c225ab6..c7c61cf 100644 --- a/rts/Linker.c +++ b/rts/Linker.c @@ -199,6 +199,21 @@ static pathchar* pathdup(pathchar *path) return ret; } +static pathchar* mkPath(char* path) +{ +#if defined(mingw32_HOST_OS) + size_t required = mbstowcs(NULL, path, 0); + pathchar *ret = stgMallocBytes(sizeof(pathchar) * (required + 1), "mkPath"); + if (mbstowcs(ret, path, required) == (size_t)-1) + { + barf("mkPath failed converting char* to wchar_t*"); + } + + return ret; +#else + return pathdup(path); +#endif +} #if defined(OBJFORMAT_ELF) static int ocVerifyImage_ELF ( ObjectCode* oc ); @@ -425,6 +440,7 @@ static int ghciInsertSymbolTable( pinfo->weak = HS_BOOL_FALSE; return 1; } + pathchar* archiveName = NULL; debugBelch( "GHC runtime linker: fatal error: I found a duplicate definition for symbol\n" " %s\n" @@ -439,10 +455,16 @@ static int ghciInsertSymbolTable( " loaded twice.\n", (char*)key, obj_name, - pinfo->owner == NULL ? "(GHCi built-in symbols)" : - pinfo->owner->archiveMemberName ? pinfo->owner->archiveMemberName + pinfo->owner == NULL ? WSTR("(GHCi built-in symbols)") : + pinfo->owner->archiveMemberName ? archiveName = mkPath(pinfo->owner->archiveMemberName) : pinfo->owner->fileName ); + + if (archiveName) + { + stgFree(archiveName); + archiveName = NULL; + } return 0; } From git at git.haskell.org Tue Feb 2 13:03:23 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Feb 2016 13:03:23 +0000 (UTC) Subject: [commit: ghc] master: Use a correct substitution in tcCheckPatSynDecl (07ed241) Message-ID: <20160202130323.5735C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/07ed24132ebe62aab15f14a655506decdf252ff9/ghc >--------------------------------------------------------------- commit 07ed24132ebe62aab15f14a655506decdf252ff9 Author: Bartosz Nitka Date: Tue Feb 2 05:02:23 2016 -0800 Use a correct substitution in tcCheckPatSynDecl The `substTheta` call didn't have the free variables of the `prov_theta` in the `in_scope` set. It should be enough to add `univ_tvs`, as all the `ex_tvs` are already in the domain of the substitution. Test Plan: added a testcase Reviewers: simonpj, bgamari, goldfire, austin Reviewed By: simonpj, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1879 GHC Trac Issues: #11524 >--------------------------------------------------------------- 07ed24132ebe62aab15f14a655506decdf252ff9 compiler/typecheck/TcPatSyn.hs | 8 +++++++- testsuite/tests/typecheck/should_compile/T11524.hs | 18 ++++++++++++++++++ testsuite/tests/typecheck/should_compile/all.T | 1 + 3 files changed, 26 insertions(+), 1 deletion(-) diff --git a/compiler/typecheck/TcPatSyn.hs b/compiler/typecheck/TcPatSyn.hs index 707f706..f3aaa23 100644 --- a/compiler/typecheck/TcPatSyn.hs +++ b/compiler/typecheck/TcPatSyn.hs @@ -251,7 +251,13 @@ tcCheckPatSynDecl PSB{ psb_id = lname@(L _ name), psb_args = details else newMetaSigTyVars ex_tvs -- See the "Existential type variables part of -- Note [Checking against a pattern signature] - ; prov_dicts <- mapM (emitWanted origin) (substTheta subst prov_theta) + ; prov_dicts <- mapM (emitWanted origin) + (substTheta (extendTCvInScopeList subst univ_tvs) prov_theta) + -- Add the free vars of 'prov_theta' to the in_scope set to + -- satisfy the substition invariant. There's no need to + -- add 'ex_tvs' as they are already in the domain of the + -- substitution. + -- See also Note [The substitution invariant] in TyCoRep. ; args' <- zipWithM (tc_arg subst) arg_names arg_tys ; return (ex_tvs', prov_dicts, args') } diff --git a/testsuite/tests/typecheck/should_compile/T11524.hs b/testsuite/tests/typecheck/should_compile/T11524.hs new file mode 100644 index 0000000..d257554 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T11524.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE ExplicitForAll #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE TypeInType #-} + +module T11524 where + +data AType (a :: k) where + AMaybe :: AType Maybe + AInt :: AType Int + AApp :: forall k1 k2 (a :: k1 -> k2) (b :: k1). + AType a -> AType b -> AType (a b) + +pattern PApp :: () => (fun ~ a b) => AType a -> AType b -> AType fun +--pattern PApp :: forall k (fun :: k) k1 (a :: k1 -> k) (b :: k1). +-- () => (fun ~ a b) => AType a -> AType b -> AType fun +pattern PApp fun arg <- AApp fun arg diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index e6f0cfa..b269f58 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -502,3 +502,4 @@ test('RebindHR', normal, compile, ['']) test('RebindNegate', normal, compile, ['']) test('T11397', normal, compile, ['']) test('T11458', normal, compile, ['']) +test('T11524', normal, compile, ['']) From git at git.haskell.org Tue Feb 2 14:02:09 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Feb 2016 14:02:09 +0000 (UTC) Subject: [commit: ghc] master: Make TypeError a newtype, add changelog entry (a7ad0b9) Message-ID: <20160202140209.566323A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a7ad0b91e7dace173ed95f31b221628d50c175e8/ghc >--------------------------------------------------------------- commit a7ad0b91e7dace173ed95f31b221628d50c175e8 Author: RyanGlScott Date: Tue Feb 2 09:03:04 2016 -0500 Make TypeError a newtype, add changelog entry Summary: Phab:D866 added the `TypeError` datatype to `Control.Exception` to represent the error that is thrown when `-fdefer-type-errors` is on, but a changelog entry for it was never added. In addition, it should probably be a newtype. Reviewers: austin, hvr, KaneTW, bgamari Reviewed By: KaneTW, bgamari Subscribers: thomie, KaneTW Differential Revision: https://phabricator.haskell.org/D1873 GHC Trac Issues: #10284 >--------------------------------------------------------------- a7ad0b91e7dace173ed95f31b221628d50c175e8 docs/users_guide/8.0.1-notes.rst | 8 ++++++++ libraries/base/Control/Exception/Base.hs | 4 +++- libraries/base/changelog.md | 3 +++ 3 files changed, 14 insertions(+), 1 deletion(-) diff --git a/docs/users_guide/8.0.1-notes.rst b/docs/users_guide/8.0.1-notes.rst index cf4cf8d..9159026 100644 --- a/docs/users_guide/8.0.1-notes.rst +++ b/docs/users_guide/8.0.1-notes.rst @@ -304,6 +304,10 @@ Compiler :ghc-flag:`-this-unit-id` or, if you need compatibility over multiple versions of GHC, :ghc-flag:`-package-name`. +- When :ghc-flag:`-fdefer-type-errors` is enabled and an expression fails to + typecheck, ``Control.Exception.TypeError`` will now be thrown instead of + ``Control.Exception.ErrorCall``. + GHCi ~~~~ @@ -527,6 +531,10 @@ See ``changelog.md`` in the ``base`` package for full release notes. - Enable ``PolyKinds`` in the ``Data.Functor.Const`` module to give ``Const`` the kind ``* -> k -> *`` (see :ghc-ticket:`10039`). +- Add the ``TypeError`` datatype to ``Control.Exception``, which represents the + error that is thrown when an expression fails to typecheck when run using + :ghc-flag:`-fdefer-type-errors`. (see :ghc-ticket:`10284`) + binary ~~~~~~ diff --git a/libraries/base/Control/Exception/Base.hs b/libraries/base/Control/Exception/Base.hs index b609ef2..351771b 100644 --- a/libraries/base/Control/Exception/Base.hs +++ b/libraries/base/Control/Exception/Base.hs @@ -361,7 +361,9 @@ instance Exception NoMethodError -- |An expression that didn't typecheck during compile time was called. -- This is only possible with -fdefer-type-errors. The @String@ gives -- details about the failed type check. -data TypeError = TypeError String +-- +-- @since 4.9.0.0 +newtype TypeError = TypeError String instance Show TypeError where showsPrec _ (TypeError err) = showString err diff --git a/libraries/base/changelog.md b/libraries/base/changelog.md index 8560fe7..7f85f35 100644 --- a/libraries/base/changelog.md +++ b/libraries/base/changelog.md @@ -91,6 +91,9 @@ precision: `log1p`, `expm1`, `log1pexp` and `log1mexp`. These are not available from `Prelude`, but the full class is exported from `Numeric`. + * New `Control.Exception.TypeError` datatype, which is thrown when an + expression fails to typecheck when run using `-fdefer-type-errors` (#10284) + ### New instances * `Alt`, `Dual`, `First`, `Last`, `Product`, and `Sum` now have `Data`, From git at git.haskell.org Tue Feb 2 14:31:56 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Feb 2016 14:31:56 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Put docs in /usr/share/doc/ghc- (c5f4f95) Message-ID: <20160202143156.BF49A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/c5f4f95c64006a9f018301dc1311d65195d9dec4/ghc >--------------------------------------------------------------- commit c5f4f95c64006a9f018301dc1311d65195d9dec4 Author: Thomas Miedema Date: Fri Jan 29 20:30:47 2016 +0100 Put docs in /usr/share/doc/ghc- `make install` puts libraries in a direcory containing the version number. Do the same for the docs, such that multiple installs can live side-by-side. Delete unused ghcdocdir. Test Plan: ``` ./boot ./configure make show! VALUE=docdir ``` Reviewed by: bgamari Differential Revision: https://phabricator.haskell.org/D1868 GHC Trac Issues: #11354 (cherry picked from commit b61f5f734d08fe9cdca3ac06560fc15e97aa77ab) >--------------------------------------------------------------- c5f4f95c64006a9f018301dc1311d65195d9dec4 mk/install.mk.in | 11 ++++------- 1 file changed, 4 insertions(+), 7 deletions(-) diff --git a/mk/install.mk.in b/mk/install.mk.in index e404397..aa3afea 100644 --- a/mk/install.mk.in +++ b/mk/install.mk.in @@ -40,7 +40,7 @@ # # NOTE: The default e.g. ${docdir} above means that autoconf substitutes the # string "${docdir}", not the value of docdir! This is crucial for the GNU -# coding standards. +# coding standards. See Trac #1924. define set_default # $1 = variable to set @@ -52,9 +52,6 @@ $1 = $2 endif endef -# This gets used in the default docdir when autoconf >= 2.60 is used -PACKAGE_TARNAME = @PACKAGE_TARNAME@ - prefix = @prefix@ datarootdir = @datarootdir@ @@ -67,8 +64,10 @@ libdir = @libdir@ includedir = @includedir@ mandir = @mandir@ +# Note that `./configure --docdir=/foo/bar` should work. docdir = @docdir@ -$(eval $(call set_default,docdir,$${datarootdir}/doc/ghc)) +PACKAGE_TARNAME = ghc-${ProjectVersion} +$(eval $(call set_default,docdir,$${datarootdir}/doc/$${PACKAGE_TARNAME})) htmldir = @htmldir@ dvidir = @dvidir@ @@ -94,14 +93,12 @@ pdfdir = $(docdir) psdir = $(docdir) ghclibdir = $(libdir) -ghcdocdir = $(datarootdir)/doc else # Unix: override libdir and datadir to put ghc-specific stuff in # a subdirectory with the version number included. ghclibdir = $(libdir)/$(CrossCompilePrefix)ghc-$(ProjectVersion) -ghcdocdir = $(datarootdir)/doc/ghc endif ghclibexecdir = $(ghclibdir) From git at git.haskell.org Tue Feb 2 14:31:59 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Feb 2016 14:31:59 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Tidy up tidySkolemInfo (bb2f21d) Message-ID: <20160202143159.79F733A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/bb2f21ddc722190623f640e08a350c387fc32e4a/ghc >--------------------------------------------------------------- commit bb2f21ddc722190623f640e08a350c387fc32e4a Author: Simon Peyton Jones Date: Wed Jan 6 17:11:34 2016 +0000 Tidy up tidySkolemInfo Previously tidySkolemInfo used tidyOpenType, and returned a new TidyEnv. But that's not needed any more, because all the skolems should be in scope in the constraint tree. I also removed a (now-unnecessary) field of UnifyForAllSkol (cherry picked from commit 290a553e9bd98ed43765cf8e7a70ebc95c187253) >--------------------------------------------------------------- bb2f21ddc722190623f640e08a350c387fc32e4a compiler/typecheck/TcErrors.hs | 6 ++-- compiler/typecheck/TcMType.hs | 32 ++++++---------------- compiler/typecheck/TcRnTypes.hs | 3 +- compiler/typecheck/TcSMonad.hs | 2 +- testsuite/tests/deriving/should_fail/T7148a.stderr | 17 ++++++------ .../tests/typecheck/should_fail/tcfail174.stderr | 4 +-- 6 files changed, 24 insertions(+), 40 deletions(-) diff --git a/compiler/typecheck/TcErrors.hs b/compiler/typecheck/TcErrors.hs index 33ca07b..819a474 100644 --- a/compiler/typecheck/TcErrors.hs +++ b/compiler/typecheck/TcErrors.hs @@ -301,11 +301,11 @@ reportImplic ctxt implic@(Implic { ic_skols = tvs, ic_given = given where insoluble = isInsolubleStatus status (env1, tvs') = mapAccumL tidyTyCoVarBndr (cec_tidy ctxt) tvs - (env2, info') = tidySkolemInfo env1 info + info' = tidySkolemInfo env1 info implic' = implic { ic_skols = tvs' - , ic_given = map (tidyEvVar env2) given + , ic_given = map (tidyEvVar env1) given , ic_info = info' } - ctxt' = ctxt { cec_tidy = env2 + ctxt' = ctxt { cec_tidy = env1 , cec_encl = implic' : cec_encl ctxt , cec_suppress = insoluble -- Suppress inessential errors if there -- are are insolubles anywhere in the diff --git a/compiler/typecheck/TcMType.hs b/compiler/typecheck/TcMType.hs index f772da5..a160d4e 100644 --- a/compiler/typecheck/TcMType.hs +++ b/compiler/typecheck/TcMType.hs @@ -1216,8 +1216,8 @@ mkTypeErrorThingArgs ty num_args zonkTidyOrigin :: TidyEnv -> CtOrigin -> TcM (TidyEnv, CtOrigin) zonkTidyOrigin env (GivenOrigin skol_info) = do { skol_info1 <- zonkSkolemInfo skol_info - ; let (env1, skol_info2) = tidySkolemInfo env skol_info1 - ; return (env1, GivenOrigin skol_info2) } + ; let skol_info2 = tidySkolemInfo env skol_info1 + ; return (env, GivenOrigin skol_info2) } zonkTidyOrigin env orig@(TypeEqOrigin { uo_actual = act , uo_expected = exp , uo_thing = m_thing }) @@ -1276,25 +1276,9 @@ tidyEvVar :: TidyEnv -> EvVar -> EvVar tidyEvVar env var = setVarType var (tidyType env (varType var)) ---------------- -tidySkolemInfo :: TidyEnv -> SkolemInfo -> (TidyEnv, SkolemInfo) -tidySkolemInfo env (SigSkol cx ty) - = (env', SigSkol cx ty') - where - (env', ty') = tidyOpenType env ty - -tidySkolemInfo env (InferSkol ids) - = (env', InferSkol ids') - where - (env', ids') = mapAccumL do_one env ids - do_one env (name, ty) = (env', (name, ty')) - where - (env', ty') = tidyOpenType env ty - -tidySkolemInfo env (UnifyForAllSkol skol_tvs ty) - = (env1, UnifyForAllSkol skol_tvs' ty') - where - env1 = tidyFreeTyCoVars env (tyCoVarsOfType ty `delVarSetList` skol_tvs) - (env2, skol_tvs') = tidyTyCoVarBndrs env1 skol_tvs - ty' = tidyType env2 ty - -tidySkolemInfo env info = (env, info) +tidySkolemInfo :: TidyEnv -> SkolemInfo -> SkolemInfo +tidySkolemInfo env (DerivSkol ty) = DerivSkol (tidyType env ty) +tidySkolemInfo env (SigSkol cx ty) = SigSkol cx (tidyType env ty) +tidySkolemInfo env (InferSkol ids) = InferSkol (mapSnd (tidyType env) ids) +tidySkolemInfo env (UnifyForAllSkol ty) = UnifyForAllSkol (tidyType env ty) +tidySkolemInfo _ info = info diff --git a/compiler/typecheck/TcRnTypes.hs b/compiler/typecheck/TcRnTypes.hs index 7244a2a..ec285fa 100644 --- a/compiler/typecheck/TcRnTypes.hs +++ b/compiler/typecheck/TcRnTypes.hs @@ -2594,7 +2594,6 @@ data SkolemInfo | BracketSkol -- Template Haskell bracket | UnifyForAllSkol -- We are unifying two for-all types - [TcTyVar] -- The instantiated skolem variables TcType -- The instantiated type *inside* the forall | UnkSkol -- Unhelpful info (until I improve it) @@ -2621,7 +2620,7 @@ pprSkolInfo (PatSkol cl mc) = sep [ pprPatSkolInfo cl pprSkolInfo (InferSkol ids) = sep [ text "the inferred type of" , vcat [ ppr name <+> dcolon <+> ppr ty | (name,ty) <- ids ]] -pprSkolInfo (UnifyForAllSkol tvs ty) = text "the type" <+> ppr (mkInvForAllTys tvs ty) +pprSkolInfo (UnifyForAllSkol ty) = text "the type" <+> ppr ty -- UnkSkol -- For type variables the others are dealt with by pprSkolTvBinding. diff --git a/compiler/typecheck/TcSMonad.hs b/compiler/typecheck/TcSMonad.hs index ddacdd9..aa16a80 100644 --- a/compiler/typecheck/TcSMonad.hs +++ b/compiler/typecheck/TcSMonad.hs @@ -3065,7 +3065,7 @@ deferTcSForAllEq role loc kind_cos (bndrs1,body1) (bndrs2,body2) ; (subst, skol_tvs) <- wrapTcS $ TcM.tcInstSkolTyVars tvs1 ; let phi1 = Type.substTyUnchecked subst body1 phi2 = Type.substTyUnchecked subst body2' - skol_info = UnifyForAllSkol skol_tvs phi1 + skol_info = UnifyForAllSkol phi1 ; (ctev, hole_co) <- newWantedEq loc role phi1 phi2 ; env <- getLclEnv diff --git a/testsuite/tests/deriving/should_fail/T7148a.stderr b/testsuite/tests/deriving/should_fail/T7148a.stderr index 8dd23aa..9a6ea41 100644 --- a/testsuite/tests/deriving/should_fail/T7148a.stderr +++ b/testsuite/tests/deriving/should_fail/T7148a.stderr @@ -1,10 +1,11 @@ T7148a.hs:19:50: error: - Couldn't match representation of type ?b? with that of ?Result a b? - arising from the coercion of the method ?coerce? - from type ?forall b. Proxy b -> a -> Result a b? - to type ?forall b. - Proxy b -> IS_NO_LONGER a -> Result (IS_NO_LONGER a) b? - ?b? is a rigid type variable bound by - the type forall b1. Proxy b1 -> a -> Result a b1 at T7148a.hs:19:50 - When deriving the instance for (Convert (IS_NO_LONGER a)) + ? Couldn't match representation of type ?b? + with that of ?Result a b? + arising from the coercion of the method ?coerce? + from type ?forall b. Proxy b -> a -> Result a b? + to type ?forall b. + Proxy b -> IS_NO_LONGER a -> Result (IS_NO_LONGER a) b? + ?b? is a rigid type variable bound by + the type Proxy b -> a -> Result a b at T7148a.hs:19:50 + ? When deriving the instance for (Convert (IS_NO_LONGER a)) diff --git a/testsuite/tests/typecheck/should_fail/tcfail174.stderr b/testsuite/tests/typecheck/should_fail/tcfail174.stderr index e7ad3ca..9c473e9 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail174.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail174.stderr @@ -3,7 +3,7 @@ tcfail174.hs:14:14: error: ? Couldn't match type ?a? with ?a1? because type variable ?a1? would escape its scope This (rigid, skolem) type variable is bound by - the type forall a2. a2 -> a2 + the type a1 -> a1 at tcfail174.hs:14:1-14 Expected type: Capture (forall x. x -> a) Actual type: Capture (forall a. a -> a) @@ -16,7 +16,7 @@ tcfail174.hs:14:14: error: tcfail174.hs:17:14: error: ? Couldn't match type ?a? with ?b? ?a? is a rigid type variable bound by - the type forall a1. a1 -> a1 at tcfail174.hs:1:1 + the type a -> a at tcfail174.hs:1:1 ?b? is a rigid type variable bound by the type signature for: h2 :: forall b. Capture b From git at git.haskell.org Tue Feb 2 15:20:05 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Feb 2016 15:20:05 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Refactor the typechecker to use ExpTypes. (278e1fa) Message-ID: <20160202152005.E0C263A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/278e1fa2fd7b33254e323d394706e72f4664ad02/ghc >--------------------------------------------------------------- commit 278e1fa2fd7b33254e323d394706e72f4664ad02 Author: Richard Eisenberg Date: Wed Jan 13 23:29:17 2016 -0500 Refactor the typechecker to use ExpTypes. The idea here is described in [wiki:Typechecker]. Briefly, this refactor keeps solid track of "synthesis" mode vs "checking" in GHC's bidirectional type-checking algorithm. When in synthesis mode, the expected type is just an IORef to write to. In addition, this patch does a significant reworking of RebindableSyntax, allowing much more freedom in the types of the rebindable operators. For example, we can now have `negate :: Int -> Bool` and `(>>=) :: m a -> (forall x. a x -> m b) -> m b`. The magic is in tcSyntaxOp. This addresses tickets #11397, #11452, and #11458. Tests: typecheck/should_compile/{RebindHR,RebindNegate,T11397,T11458} th/T11452 (cherry picked from commit 00cbbab3362578df44851442408a8b91a2a769fa) >--------------------------------------------------------------- 278e1fa2fd7b33254e323d394706e72f4664ad02 compiler/deSugar/Check.hs | 160 +++---- compiler/deSugar/Coverage.hs | 32 +- compiler/deSugar/DsArrows.hs | 13 +- compiler/deSugar/DsExpr.hs | 61 +-- compiler/deSugar/DsExpr.hs-boot | 3 +- compiler/deSugar/DsGRHSs.hs | 2 +- compiler/deSugar/DsListComp.hs | 59 ++- compiler/deSugar/DsMeta.hs | 10 +- compiler/deSugar/DsUtils.hs | 10 +- compiler/deSugar/Match.hs | 32 +- compiler/deSugar/MatchLit.hs | 52 +-- compiler/deSugar/PmExpr.hs | 5 +- compiler/ghci/RtClosureInspect.hs | 4 - compiler/hsSyn/Convert.hs | 2 +- compiler/hsSyn/HsExpr.hs | 74 +++- compiler/hsSyn/HsExpr.hs-boot | 5 +- compiler/hsSyn/HsLit.hs | 6 +- compiler/hsSyn/HsPat.hs | 16 +- compiler/hsSyn/HsUtils.hs | 80 ++-- compiler/hsSyn/PlaceHolder.hs | 14 +- compiler/parser/Parser.y | 2 +- compiler/parser/RdrHsSyn.hs | 4 +- compiler/rename/RnEnv.hs | 8 +- compiler/rename/RnExpr.hs | 101 +++-- compiler/rename/RnPat.hs | 11 +- compiler/typecheck/Inst.hs | 55 ++- compiler/typecheck/TcArrows.hs | 45 +- compiler/typecheck/TcBinds.hs | 18 +- compiler/typecheck/TcErrors.hs | 112 +++-- compiler/typecheck/TcEvidence.hs | 38 +- compiler/typecheck/TcExpr.hs | 472 ++++++++++++++------- compiler/typecheck/TcExpr.hs-boot | 24 +- compiler/typecheck/TcGenDeriv.hs | 32 +- compiler/typecheck/TcHsSyn.hs | 303 ++++++++----- compiler/typecheck/TcHsType.hs | 11 +- compiler/typecheck/TcInstDcls.hs | 3 +- compiler/typecheck/TcMType.hs | 242 +++++++---- compiler/typecheck/TcMatches.hs | 436 ++++++++++--------- compiler/typecheck/TcMatches.hs-boot | 4 +- compiler/typecheck/TcPat.hs | 248 +++++++---- compiler/typecheck/TcPatSyn.hs | 26 +- compiler/typecheck/TcRnDriver.hs | 17 +- compiler/typecheck/TcRnMonad.hs | 4 +- compiler/typecheck/TcRnTypes.hs | 28 +- compiler/typecheck/TcRules.hs | 3 +- compiler/typecheck/TcSplice.hs | 42 +- compiler/typecheck/TcSplice.hs-boot | 8 +- compiler/typecheck/TcType.hs | 111 +++-- compiler/typecheck/TcUnify.hs | 449 +++++++++++++------- compiler/typecheck/TcValidity.hs | 2 +- compiler/utils/MonadUtils.hs | 7 +- testsuite/tests/ado/ado004.stderr | 30 +- .../tests/annotations/should_fail/annfail10.stderr | 12 +- testsuite/tests/deSugar/should_run/dsrun017.hs | 0 testsuite/tests/determinism/typecheck/A.hs | 2 +- testsuite/tests/gadt/gadt-escape1.stderr | 16 +- testsuite/tests/gadt/gadt13.stderr | 10 +- testsuite/tests/gadt/gadt7.stderr | 20 +- .../ghc-api/annotations-literals/parsed.stdout | 8 +- .../tests/ghci.debugger/scripts/break003.stderr | 2 +- .../tests/ghci.debugger/scripts/break003.stdout | 8 +- .../tests/ghci.debugger/scripts/break005.stdout | 4 +- .../tests/ghci.debugger/scripts/break006.stderr | 12 +- .../tests/ghci.debugger/scripts/break006.stdout | 10 +- .../tests/ghci.debugger/scripts/break012.stdout | 8 +- .../tests/ghci.debugger/scripts/hist001.stdout | 28 +- .../tests/ghci.debugger/scripts/print022.stdout | 4 +- testsuite/tests/ghci/scripts/T2182ghci.stderr | 30 +- testsuite/tests/ghci/scripts/T8959.script | 8 +- testsuite/tests/ghci/scripts/T8959.stderr | 48 +-- testsuite/tests/ghci/scripts/T8959.stdout | 11 +- .../tests/indexed-types/should_compile/T3484.hs | 4 +- .../tests/indexed-types/should_compile/T4120.hs | 4 +- .../tests/indexed-types/should_compile/T4494.hs | 3 +- .../tests/indexed-types/should_compile/T9090.hs | 2 +- .../tests/indexed-types/should_compile/T9316.hs | 2 +- .../tests/indexed-types/should_fail/T3330a.hs | 3 +- .../tests/indexed-types/should_fail/T5934.stderr | 11 +- .../tests/indexed-types/should_fail/T7788.stderr | 7 +- .../tests/indexed-types/should_fail/T8518.stderr | 33 +- testsuite/tests/module/mod71.stderr | 6 +- .../should_fail/overloadedlistsfail03.hs | 2 +- .../should_fail/overloadedlistsfail03.stderr | 13 +- .../should_fail/overloadedlistsfail05.hs | 2 +- .../should_fail/overloadedlistsfail05.stderr | 15 +- .../tests/parser/should_compile/read014.stderr | 8 +- testsuite/tests/parser/should_fail/T7848.stderr | 42 +- .../partial-sigs/should_compile/T10438.stderr | 16 +- .../partial-sigs/should_compile/T11192.stderr | 12 +- testsuite/tests/perf/compiler/all.T | 3 +- testsuite/tests/polykinds/T7438.stderr | 16 +- testsuite/tests/rebindable/rebindable6.hs | 5 +- testsuite/tests/rebindable/rebindable6.stderr | 24 +- .../tests/rename/should_compile/T3103/GHC/Num.hs | 9 + .../tests/rename/should_compile/T3103/GHC/Word.hs | 2 +- testsuite/tests/th/T11452.hs | 6 + testsuite/tests/th/T11452.stderr | 15 + testsuite/tests/th/T2222.stderr | 2 +- testsuite/tests/th/all.T | 1 + .../tests/typecheck/should_compile/RebindHR.hs | 26 ++ .../tests/typecheck/should_compile/RebindNegate.hs | 9 + testsuite/tests/typecheck/should_compile/T11397.hs | 69 +++ testsuite/tests/typecheck/should_compile/T11458.hs | 5 + testsuite/tests/typecheck/should_compile/T2683.hs | 2 +- testsuite/tests/typecheck/should_compile/T7888.hs | 4 + testsuite/tests/typecheck/should_compile/all.T | 4 + .../tests/typecheck/should_compile/tc141.stderr | 6 +- testsuite/tests/typecheck/should_compile/tc158.hs | 2 +- testsuite/tests/typecheck/should_compile/twins.hs | 2 +- .../tests/typecheck/should_fail/FDsFromGivens2.hs | 1 + .../typecheck/should_fail/FDsFromGivens2.stderr | 26 +- .../tests/typecheck/should_fail/T10619.stderr | 4 +- testsuite/tests/typecheck/should_fail/T3613.stderr | 4 +- testsuite/tests/typecheck/should_fail/T5570.stderr | 3 +- testsuite/tests/typecheck/should_fail/T7453.stderr | 50 +-- testsuite/tests/typecheck/should_fail/T7734.stderr | 12 +- testsuite/tests/typecheck/should_fail/T8603.stderr | 8 +- testsuite/tests/typecheck/should_fail/T9109.stderr | 11 +- .../tests/typecheck/should_fail/VtaFail.stderr | 2 +- .../tests/typecheck/should_fail/tcfail014.stderr | 6 +- .../tests/typecheck/should_fail/tcfail016.stderr | 25 +- .../tests/typecheck/should_fail/tcfail032.stderr | 6 +- .../tests/typecheck/should_fail/tcfail099.stderr | 6 +- .../tests/typecheck/should_fail/tcfail104.stderr | 14 +- .../tests/typecheck/should_fail/tcfail140.stderr | 7 +- .../tests/typecheck/should_fail/tcfail159.stderr | 9 +- .../tests/typecheck/should_fail/tcfail181.stderr | 2 +- utils/ghctags/Main.hs | 4 +- 128 files changed, 2660 insertions(+), 1714 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 278e1fa2fd7b33254e323d394706e72f4664ad02 From git at git.haskell.org Tue Feb 2 16:42:59 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Feb 2016 16:42:59 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Avoid mangled/derived names in GHCi autocomplete (fixes #11328) (6704660) Message-ID: <20160202164259.744123A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/670466039ac63a94af9e136212da8d511f02b935/ghc >--------------------------------------------------------------- commit 670466039ac63a94af9e136212da8d511f02b935 Author: Adam Gundry Date: Mon Feb 1 16:41:03 2016 +0100 Avoid mangled/derived names in GHCi autocomplete (fixes #11328) This changes `getRdrNamesInScope` to use field labels rather than selector names for fields from modules with `DuplicateRecordFields` enabled. Moreover, it filters out derived names (e.g. type representation bindings) that shouldn't show up in autocomplete. Test Plan: New test ghci/should_run/T11328 Reviewers: kolmodin, austin, bgamari, simonpj Reviewed By: bgamari, simonpj Subscribers: simonpj, thomie Differential Revision: https://phabricator.haskell.org/D1870 GHC Trac Issues: #11328 (cherry picked from commit dd0b7c78f64f2498594d3ef89d3bf884402f14d9) >--------------------------------------------------------------- 670466039ac63a94af9e136212da8d511f02b935 compiler/basicTypes/RdrName.hs | 4 ++-- compiler/main/InteractiveEval.hs | 5 ++++- testsuite/tests/ghci/should_run/T11328.script | 4 ++++ testsuite/tests/ghci/should_run/T11328.stdout | 5 +++++ testsuite/tests/ghci/should_run/all.T | 1 + 5 files changed, 16 insertions(+), 3 deletions(-) diff --git a/compiler/basicTypes/RdrName.hs b/compiler/basicTypes/RdrName.hs index 6e0350d..62771e9 100644 --- a/compiler/basicTypes/RdrName.hs +++ b/compiler/basicTypes/RdrName.hs @@ -629,10 +629,10 @@ greUsedRdrName gre at GRE{ gre_name = name, gre_lcl = lcl, gre_imp = iss } occ = greOccName gre greRdrNames :: GlobalRdrElt -> [RdrName] -greRdrNames GRE{ gre_name = name, gre_lcl = lcl, gre_imp = iss } +greRdrNames gre at GRE{ gre_lcl = lcl, gre_imp = iss } = (if lcl then [unqual] else []) ++ concatMap do_spec (map is_decl iss) where - occ = nameOccName name + occ = greOccName gre unqual = Unqual occ do_spec decl_spec | is_qual decl_spec = [qual] diff --git a/compiler/main/InteractiveEval.hs b/compiler/main/InteractiveEval.hs index 6e3f77b..d07a88f 100644 --- a/compiler/main/InteractiveEval.hs +++ b/compiler/main/InteractiveEval.hs @@ -790,13 +790,16 @@ getNamesInScope :: GhcMonad m => m [Name] getNamesInScope = withSession $ \hsc_env -> do return (map gre_name (globalRdrEnvElts (ic_rn_gbl_env (hsc_IC hsc_env)))) +-- | Returns all 'RdrName's in scope in the current interactive +-- context, excluding any that are internally-generated. getRdrNamesInScope :: GhcMonad m => m [RdrName] getRdrNamesInScope = withSession $ \hsc_env -> do let ic = hsc_IC hsc_env gbl_rdrenv = ic_rn_gbl_env ic gbl_names = concatMap greRdrNames $ globalRdrEnvElts gbl_rdrenv - return gbl_names + -- Exclude internally generated names; see e.g. Trac #11328 + return (filter (not . isDerivedOccName . rdrNameOcc) gbl_names) -- | Parses a string as an identifier, and returns the list of 'Name's that diff --git a/testsuite/tests/ghci/should_run/T11328.script b/testsuite/tests/ghci/should_run/T11328.script new file mode 100644 index 0000000..410e4b7 --- /dev/null +++ b/testsuite/tests/ghci/should_run/T11328.script @@ -0,0 +1,4 @@ +:seti -XDuplicateRecordFields +data T = MkT { foo :: Int } +:complete repl "foo" +:complete repl "$" diff --git a/testsuite/tests/ghci/should_run/T11328.stdout b/testsuite/tests/ghci/should_run/T11328.stdout new file mode 100644 index 0000000..272da79 --- /dev/null +++ b/testsuite/tests/ghci/should_run/T11328.stdout @@ -0,0 +1,5 @@ +1 1 "" +"foo" +2 2 "" +"$" +"$!" diff --git a/testsuite/tests/ghci/should_run/all.T b/testsuite/tests/ghci/should_run/all.T index 68c7407..930f14b 100644 --- a/testsuite/tests/ghci/should_run/all.T +++ b/testsuite/tests/ghci/should_run/all.T @@ -22,3 +22,4 @@ test('T9914', just_ghci, ghci_script, ['T9914.script']) test('T9915', just_ghci, ghci_script, ['T9915.script']) test('T10145', just_ghci, ghci_script, ['T10145.script']) test('T7253', just_ghci, ghci_script, ['T7253.script']) +test('T11328', just_ghci, ghci_script, ['T11328.script']) From git at git.haskell.org Tue Feb 2 16:43:02 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Feb 2016 16:43:02 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Remote GHCi: create cost centre stacks in batches (2c48f1c) Message-ID: <20160202164302.287E93A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/2c48f1cfb554522ac1438149860e63929ae9553e/ghc >--------------------------------------------------------------- commit 2c48f1cfb554522ac1438149860e63929ae9553e Author: Simon Marlow Date: Thu Jan 21 09:46:13 2016 +0000 Remote GHCi: create cost centre stacks in batches Towards optimising the binary serialisation that -fexternal-interpreter does, this saves quite a bit of time when using -fexternal-interpreter with -prof. (cherry picked from commit a496f82d5684f3025a60877600e82f0b29736e85) >--------------------------------------------------------------- 2c48f1cfb554522ac1438149860e63929ae9553e compiler/deSugar/Coverage.hs | 22 +++++++--------------- compiler/ghci/GHCi.hs | 11 +++++------ libraries/ghci/GHCi/Message.hs | 16 +++++++--------- libraries/ghci/GHCi/Run.hs | 19 +++++++++++-------- 4 files changed, 30 insertions(+), 38 deletions(-) diff --git a/compiler/deSugar/Coverage.hs b/compiler/deSugar/Coverage.hs index edf0017..9fc1734 100644 --- a/compiler/deSugar/Coverage.hs +++ b/compiler/deSugar/Coverage.hs @@ -158,26 +158,18 @@ mkCCSArray :: HscEnv -> Module -> Int -> [MixEntry_] -> IO (Array BreakIndex (RemotePtr GHC.Stack.CCS.CostCentre)) mkCCSArray hsc_env modul count entries = do - if interpreterProfiled (hsc_dflags hsc_env) + if interpreterProfiled dflags then do - let module_bs = fastStringToByteString (moduleNameFS (moduleName modul)) - c_module <- GHCi.mallocData hsc_env (module_bs `B.snoc` 0) - -- NB. null-terminate the string - costcentres <- - mapM (mkCostCentre hsc_env (castRemotePtr c_module)) entries + let module_str = moduleNameString (moduleName modul) + costcentres <- GHCi.mkCostCentres hsc_env module_str (map mk_one entries) return (listArray (0,count-1) costcentres) else do return (listArray (0,-1) []) where - mkCostCentre - :: HscEnv - -> RemotePtr CChar - -> MixEntry_ - -> IO (RemotePtr GHC.Stack.CCS.CostCentre) - mkCostCentre hsc_env at HscEnv{..} c_module (srcspan, decl_path, _, _) = do - let name = concat (intersperse "." decl_path) - src = showSDoc hsc_dflags (ppr srcspan) - GHCi.mkCostCentre hsc_env c_module name src + dflags = hsc_dflags hsc_env + mk_one (srcspan, decl_path, _, _) = (name, src) + where name = concat (intersperse "." decl_path) + src = showSDoc dflags (ppr srcspan) #endif diff --git a/compiler/ghci/GHCi.hs b/compiler/ghci/GHCi.hs index 08285a8..c54090c 100644 --- a/compiler/ghci/GHCi.hs +++ b/compiler/ghci/GHCi.hs @@ -13,7 +13,7 @@ module GHCi , evalString , evalStringToIOString , mallocData - , mkCostCentre + , mkCostCentres , costCentreStackInfo , newBreakArray , enableBreakpoint @@ -65,7 +65,6 @@ import Data.Binary import Data.ByteString (ByteString) import Data.IORef import Foreign -import Foreign.C import GHC.Stack.CCS (CostCentre,CostCentreStack) import System.Exit import Data.Maybe @@ -253,10 +252,10 @@ evalStringToIOString hsc_env fhv str = do mallocData :: HscEnv -> ByteString -> IO (RemotePtr ()) mallocData hsc_env bs = iservCmd hsc_env (MallocData bs) -mkCostCentre - :: HscEnv -> RemotePtr CChar -> String -> String -> IO (RemotePtr CostCentre) -mkCostCentre hsc_env c_module name src = - iservCmd hsc_env (MkCostCentre c_module name src) +mkCostCentres + :: HscEnv -> String -> [(String,String)] -> IO [RemotePtr CostCentre] +mkCostCentres hsc_env mod ccs = + iservCmd hsc_env (MkCostCentres mod ccs) costCentreStackInfo :: HscEnv -> RemotePtr CostCentreStack -> IO [String] diff --git a/libraries/ghci/GHCi/Message.hs b/libraries/ghci/GHCi/Message.hs index a22767a..bdb1a9f 100644 --- a/libraries/ghci/GHCi/Message.hs +++ b/libraries/ghci/GHCi/Message.hs @@ -32,7 +32,6 @@ import qualified Data.ByteString.Lazy as LB import Data.Dynamic import Data.IORef import Data.Map (Map) -import Foreign.C import GHC.Generics import GHC.Stack.CCS import qualified Language.Haskell.TH as TH @@ -122,12 +121,11 @@ data Message a where :: HValueRef {- IO a -} -> Message (EvalResult ()) - -- | Create a CostCentre - MkCostCentre - :: RemotePtr CChar -- module, RemotePtr so it can be shared - -> String -- name - -> String -- SrcSpan - -> Message (RemotePtr CostCentre) + -- | Create a set of CostCentres with the same module name + MkCostCentres + :: String -- module, RemotePtr so it can be shared + -> [(String,String)] -- (name, SrcSpan) + -> Message [RemotePtr CostCentre] -- | Show a 'CostCentreStack' as a @[String]@ CostCentreStackInfo @@ -334,7 +332,7 @@ getMessage = do 21 -> Msg <$> (EvalString <$> get) 22 -> Msg <$> (EvalStringToString <$> get <*> get) 23 -> Msg <$> (EvalIO <$> get) - 24 -> Msg <$> (MkCostCentre <$> get <*> get <*> get) + 24 -> Msg <$> (MkCostCentres <$> get <*> get) 25 -> Msg <$> (CostCentreStackInfo <$> get) 26 -> Msg <$> (NewBreakArray <$> get) 27 -> Msg <$> (EnableBreakpoint <$> get <*> get <*> get) @@ -389,7 +387,7 @@ putMessage m = case m of EvalString val -> putWord8 21 >> put val EvalStringToString str val -> putWord8 22 >> put str >> put val EvalIO val -> putWord8 23 >> put val - MkCostCentre mod name src -> putWord8 24 >> put mod >> put name >> put src + MkCostCentres mod ccs -> putWord8 24 >> put mod >> put ccs CostCentreStackInfo ptr -> putWord8 25 >> put ptr NewBreakArray sz -> putWord8 26 >> put sz EnableBreakpoint arr ix b -> putWord8 27 >> put arr >> put ix >> put b diff --git a/libraries/ghci/GHCi/Run.hs b/libraries/ghci/GHCi/Run.hs index 5951d9b..780ff3e 100644 --- a/libraries/ghci/GHCi/Run.hs +++ b/libraries/ghci/GHCi/Run.hs @@ -59,8 +59,7 @@ run m = case m of EvalString r -> evalString r EvalStringToString r s -> evalStringToString r s EvalIO r -> evalIO r - MkCostCentre mod name src -> - toRemotePtr <$> mkCostCentre (fromRemotePtr mod) name src + MkCostCentres mod ccs -> mkCostCentres mod ccs CostCentreStackInfo ptr -> ccsToStrings (fromRemotePtr ptr) NewBreakArray sz -> mkRemoteRef =<< newBreakArray sz EnableBreakpoint ref ix b -> do @@ -324,17 +323,21 @@ mkString bs = B.unsafeUseAsCStringLen bs $ \(cstr,len) -> do copyBytes ptr cstr len return (castRemotePtr (toRemotePtr ptr)) -mkCostCentre :: Ptr CChar -> String -> String -> IO (Ptr CostCentre) +mkCostCentres :: String -> [(String,String)] -> IO [RemotePtr CostCentre] #if defined(PROFILING) -mkCostCentre c_module decl_path srcspan = do - c_name <- newCString decl_path - c_srcspan <- newCString srcspan - c_mkCostCentre c_name c_module c_srcspan +mkCostCentres mod ccs = do + c_module <- newCString mod + mapM (mk_one c_module) ccs + where + mk_one c_module (decl_path,srcspan) = do + c_name <- newCString decl_path + c_srcspan <- newCString srcspan + toRemotePtr <$> c_mkCostCentre c_name c_module c_srcspan foreign import ccall unsafe "mkCostCentre" c_mkCostCentre :: Ptr CChar -> Ptr CChar -> Ptr CChar -> IO (Ptr CostCentre) #else -mkCostCentre _ _ _ = return nullPtr +mkCostCentres _ _ = return [] #endif getIdValFromApStack :: HValue -> Int -> IO (Maybe HValue) From git at git.haskell.org Tue Feb 2 16:43:04 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Feb 2016 16:43:04 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Update unix submodule to latest snapshot (5553041) Message-ID: <20160202164304.CF67E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/5553041115481d8ae70a95d5062907732221a1f9/ghc >--------------------------------------------------------------- commit 5553041115481d8ae70a95d5062907732221a1f9 Author: Herbert Valerio Riedel Date: Mon Feb 1 19:38:46 2016 +0100 Update unix submodule to latest snapshot Besides containing more internal refactorings, this update also bumps unix's version number to 2.7.2.0 (cherry picked from commit ddd38e7dce5d841b89479a4496b117553f0feeec) >--------------------------------------------------------------- 5553041115481d8ae70a95d5062907732221a1f9 libraries/unix | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/unix b/libraries/unix index 4f3b5d8..ff1c16d 160000 --- a/libraries/unix +++ b/libraries/unix @@ -1 +1 @@ -Subproject commit 4f3b5d8b87eef07d8df62a8d7240830bb81a8a6b +Subproject commit ff1c16d4ee0c4ca043bd99a5d6741ea2d53e7000 From git at git.haskell.org Tue Feb 2 16:43:07 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Feb 2016 16:43:07 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Remote GHCi: Optimize the serialization/deserialization of byte code (738234a) Message-ID: <20160202164307.84B293A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/738234afed2b1bc597e0c0815b94ff1e7ac232cc/ghc >--------------------------------------------------------------- commit 738234afed2b1bc597e0c0815b94ff1e7ac232cc Author: Simon Marlow Date: Fri Jan 29 11:27:50 2016 +0000 Remote GHCi: Optimize the serialization/deserialization of byte code Summary: This cuts allocations by about a quarter. Test Plan: * validate * `ghci -fexternal-interpreter` in `nofib/real/anna` Reviewers: niteria, bgamari, ezyang, austin, hvr, erikd Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1875 GHC Trac Issues: #11100 (cherry picked from commit 2fb6a8c30567e7d071ffcf88e22ea7f72f60b826) >--------------------------------------------------------------- 738234afed2b1bc597e0c0815b94ff1e7ac232cc compiler/ghci/ByteCodeLink.hs | 14 ++++++++- libraries/ghci/GHCi/ResolvedBCO.hs | 64 ++++++++++++++++++++++++++++++++------ 2 files changed, 67 insertions(+), 11 deletions(-) diff --git a/compiler/ghci/ByteCodeLink.hs b/compiler/ghci/ByteCodeLink.hs index 74f490b..c108d16 100644 --- a/compiler/ghci/ByteCodeLink.hs +++ b/compiler/ghci/ByteCodeLink.hs @@ -28,6 +28,7 @@ import SizedSeq import GHCi import ByteCodeTypes import HscTypes +import DynFlags import Name import NameEnv import PrimOp @@ -39,6 +40,8 @@ import Util -- Standard libraries import Data.Array.Unboxed +import Data.Array.Base +import Data.Word import Foreign.Ptr import GHC.IO ( IO(..) ) import GHC.Exts @@ -68,10 +71,19 @@ linkBCO hsc_env ie ce bco_ix breakarray (UnlinkedBCO _ arity insns bitmap lits0 ptrs0) = do lits <- mapM (lookupLiteral hsc_env ie) (ssElts lits0) ptrs <- mapM (resolvePtr hsc_env ie ce bco_ix breakarray) (ssElts ptrs0) - return (ResolvedBCO arity insns bitmap + let dflags = hsc_dflags hsc_env + return (ResolvedBCO arity (toWordArray dflags insns) bitmap (listArray (0, fromIntegral (sizeSS lits0)-1) lits) (addListToSS emptySS ptrs)) +-- Turn the insns array from a Word16 array into a Word array. The +-- latter is much faster to serialize/deserialize. Assumes the input +-- array is zero-indexed. +toWordArray :: DynFlags -> UArray Int Word16 -> UArray Int Word +toWordArray dflags (UArray _ _ n arr) = UArray 0 (n'-1) n' arr + where n' = (n + w16s_per_word - 1) `quot` w16s_per_word + w16s_per_word = wORD_SIZE dflags `quot` 2 + lookupLiteral :: HscEnv -> ItblEnv -> BCONPtr -> IO Word lookupLiteral _ _ (BCONPtrWord lit) = return lit lookupLiteral hsc_env _ (BCONPtrLbl sym) = do diff --git a/libraries/ghci/GHCi/ResolvedBCO.hs b/libraries/ghci/GHCi/ResolvedBCO.hs index a349ded..aa63d36 100644 --- a/libraries/ghci/GHCi/ResolvedBCO.hs +++ b/libraries/ghci/GHCi/ResolvedBCO.hs @@ -1,4 +1,5 @@ -{-# LANGUAGE RecordWildCards, DeriveGeneric, GeneralizedNewtypeDeriving #-} +{-# LANGUAGE RecordWildCards, DeriveGeneric, GeneralizedNewtypeDeriving, + BangPatterns #-} module GHCi.ResolvedBCO ( ResolvedBCO(..) , ResolvedBCOPtr(..) @@ -8,38 +9,81 @@ import SizedSeq import GHCi.RemoteTypes import GHCi.BreakArray +import Control.Monad.ST import Data.Array.Unboxed +import Data.Array.Base import Data.Binary import GHC.Generics -- ----------------------------------------------------------------------------- -- ResolvedBCO --- A ResolvedBCO is one in which all the Name references have been +-- A A ResolvedBCO is one in which all the Name references have been -- resolved to actual addresses or RemoteHValues. - +-- +-- Note, all arrays are zero-indexed (we assume this when +-- serializing/deserializing) data ResolvedBCO = ResolvedBCO { - resolvedBCOArity :: Int, - resolvedBCOInstrs :: UArray Int Word16, -- insns + resolvedBCOArity :: {-# UNPACK #-} !Int, + resolvedBCOInstrs :: UArray Int Word, -- insns resolvedBCOBitmap :: UArray Int Word, -- bitmap resolvedBCOLits :: UArray Int Word, -- non-ptrs resolvedBCOPtrs :: (SizedSeq ResolvedBCOPtr) -- ptrs } deriving (Generic, Show) -instance Binary ResolvedBCO +instance Binary ResolvedBCO where + put ResolvedBCO{..} = do + put resolvedBCOArity + putArray resolvedBCOInstrs + putArray resolvedBCOBitmap + putArray resolvedBCOLits + put resolvedBCOPtrs + get = ResolvedBCO <$> get <*> getArray <*> getArray <*> getArray <*> get + +-- Specialized versions of the binary get/put for UArray Int Word. +-- This saves a bit of time and allocation over using the default +-- get/put, because we get specialisd code and also avoid serializing +-- the bounds. +putArray :: UArray Int Word -> Put +putArray a@(UArray _ _ n _) = do + put n + mapM_ put (elems a) + +getArray :: Get (UArray Int Word) +getArray = do + n <- get + xs <- gets n [] + return $! mkArray n xs + where + gets 0 xs = return xs + gets n xs = do + x <- get + gets (n-1) (x:xs) + + mkArray :: Int -> [Word] -> UArray Int Word + mkArray n0 xs0 = runST $ do + !marr <- newArray (0,n0-1) 0 + let go 0 _ = return () + go _ [] = error "mkArray" + go n (x:xs) = do + let n' = n-1 + unsafeWrite marr n' x + go n' xs + go n0 xs0 + unsafeFreezeSTUArray marr data ResolvedBCOPtr - = ResolvedBCORef Int + = ResolvedBCORef {-# UNPACK #-} !Int -- ^ reference to the Nth BCO in the current set - | ResolvedBCOPtr (RemoteRef HValue) + | ResolvedBCOPtr {-# UNPACK #-} !(RemoteRef HValue) -- ^ reference to a previously created BCO - | ResolvedBCOStaticPtr (RemotePtr ()) + | ResolvedBCOStaticPtr {-# UNPACK #-} !(RemotePtr ()) -- ^ reference to a static ptr | ResolvedBCOPtrBCO ResolvedBCO -- ^ a nested BCO - | ResolvedBCOPtrBreakArray (RemoteRef BreakArray) + | ResolvedBCOPtrBreakArray {-# UNPACK #-} !(RemoteRef BreakArray) -- ^ Resolves to the MutableArray# inside the BreakArray deriving (Generic, Show) From git at git.haskell.org Tue Feb 2 16:43:10 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Feb 2016 16:43:10 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Remote GHCi: batch the creation of strings (2cd828e) Message-ID: <20160202164310.552403A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/2cd828eed8112f0faaebfa8576f402792a3a3d03/ghc >--------------------------------------------------------------- commit 2cd828eed8112f0faaebfa8576f402792a3a3d03 Author: Simon Marlow Date: Mon Feb 1 16:19:10 2016 +0000 Remote GHCi: batch the creation of strings Summary: This makes a big performance difference especially when loading a large number of modules and using parallel compilation (ghci -jN). Test Plan: * validate * `ghci -fexternal-interpreter` in `nofib/real/anna` Reviewers: niteria, bgamari, ezyang, austin, hvr, erikd Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1876 GHC Trac Issues: #11100 (cherry picked from commit 7cb1fae2d6ec90b10708a2631cd1069561177bd4) >--------------------------------------------------------------- 2cd828eed8112f0faaebfa8576f402792a3a3d03 compiler/ghci/ByteCodeAsm.hs | 58 ++++++++++++++-- compiler/ghci/ByteCodeGen.hs | 2 +- compiler/ghci/ByteCodeLink.hs | 5 +- compiler/ghci/ByteCodeTypes.hs | 1 + libraries/ghci/GHCi/Message.hs | 149 +++++++++++++++++++++-------------------- libraries/ghci/GHCi/Run.hs | 8 +++ libraries/ghci/SizedSeq.hs | 6 ++ 7 files changed, 148 insertions(+), 81 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 2cd828eed8112f0faaebfa8576f402792a3a3d03 From git at git.haskell.org Tue Feb 2 16:43:13 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Feb 2016 16:43:13 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Remote GHCi: parallelise BCO serialization (e2715ce) Message-ID: <20160202164313.01DF03A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/e2715ce6f2662a856fc68aeca9005cf30d2ebf35/ghc >--------------------------------------------------------------- commit e2715ce6f2662a856fc68aeca9005cf30d2ebf35 Author: Simon Marlow Date: Mon Feb 1 16:39:50 2016 +0000 Remote GHCi: parallelise BCO serialization Summary: Serialization of BCOs is slow, but we can parallelise it when using ghci -j. It parallelises nicely, saving multiple seconds off the link time in a large example I have. Test Plan: * validate * `ghci -fexternal-interpreter` in `nofib/real/anna` Reviewers: niteria, bgamari, ezyang, austin, hvr, erikd Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1877 GHC Trac Issues: #11100 (cherry picked from commit c996db5b1802ebeb93420785127f7fd55b7ec0c0) >--------------------------------------------------------------- e2715ce6f2662a856fc68aeca9005cf30d2ebf35 compiler/ghci/GHCi.hs | 39 ++++++++++++++++++++++++++++++++++++++- compiler/ghci/Linker.hs | 4 ++-- compiler/utils/Util.hs | 8 ++++++++ libraries/ghci/GHCi/Message.hs | 3 +-- libraries/ghci/GHCi/Run.hs | 4 +++- 5 files changed, 52 insertions(+), 6 deletions(-) diff --git a/compiler/ghci/GHCi.hs b/compiler/ghci/GHCi.hs index c54090c..9a33c68 100644 --- a/compiler/ghci/GHCi.hs +++ b/compiler/ghci/GHCi.hs @@ -13,6 +13,7 @@ module GHCi , evalString , evalStringToIOString , mallocData + , createBCOs , mkCostCentres , costCentreStackInfo , newBreakArray @@ -47,6 +48,7 @@ module GHCi import GHCi.Message import GHCi.Run import GHCi.RemoteTypes +import GHCi.ResolvedBCO import GHCi.BreakArray (BreakArray) import HscTypes import UniqFM @@ -57,14 +59,17 @@ import Outputable import Exception import BasicTypes import FastString +import Util import Control.Concurrent import Control.Monad import Control.Monad.IO.Class import Data.Binary +import Data.Binary.Put import Data.ByteString (ByteString) +import qualified Data.ByteString.Lazy as LB import Data.IORef -import Foreign +import Foreign hiding (void) import GHC.Stack.CCS (CostCentre,CostCentreStack) import System.Exit import Data.Maybe @@ -75,6 +80,7 @@ import GHC.IO.Handle.FD (fdToHandle) import System.Posix as Posix #endif import System.Process +import GHC.Conc {- Note [Remote GHCi] @@ -257,6 +263,37 @@ mkCostCentres mkCostCentres hsc_env mod ccs = iservCmd hsc_env (MkCostCentres mod ccs) +-- | Create a set of BCOs that may be mutually recursive. +createBCOs :: HscEnv -> [ResolvedBCO] -> IO [HValueRef] +createBCOs hsc_env rbcos = do + n_jobs <- case parMakeCount (hsc_dflags hsc_env) of + Nothing -> liftIO getNumProcessors + Just n -> return n + -- Serializing ResolvedBCO is expensive, so if we're in parallel mode + -- (-j) parallelise the serialization. + if (n_jobs == 1) + then + iservCmd hsc_env (CreateBCOs [runPut (put rbcos)]) + + else do + old_caps <- getNumCapabilities + if old_caps == n_jobs + then void $ evaluate puts + else bracket_ (setNumCapabilities n_jobs) + (setNumCapabilities old_caps) + (void $ evaluate puts) + iservCmd hsc_env (CreateBCOs puts) + where + puts = parMap doChunk (chunkList 100 rbcos) + + -- make sure we force the whole lazy ByteString + doChunk c = pseq (LB.length bs) bs + where bs = runPut (put c) + + -- We don't have the parallel package, so roll our own simple parMap + parMap _ [] = [] + parMap f (x:xs) = fx `par` (fxs `pseq` (fx : fxs)) + where fx = f x; fxs = parMap f xs costCentreStackInfo :: HscEnv -> RemotePtr CostCentreStack -> IO [String] costCentreStackInfo hsc_env ccs = diff --git a/compiler/ghci/Linker.hs b/compiler/ghci/Linker.hs index 982b4fc..2b471ee 100644 --- a/compiler/ghci/Linker.hs +++ b/compiler/ghci/Linker.hs @@ -499,7 +499,7 @@ linkExpr hsc_env span root_ul_bco ; let nobreakarray = error "no break array" bco_ix = mkNameEnv [(unlinkedBCOName root_ul_bco, 0)] ; resolved <- linkBCO hsc_env ie ce bco_ix nobreakarray root_ul_bco - ; [root_hvref] <- iservCmd hsc_env (CreateBCOs [resolved]) + ; [root_hvref] <- createBCOs hsc_env [resolved] ; fhv <- mkFinalizedHValue hsc_env root_hvref ; return (pls, fhv) }}} @@ -971,7 +971,7 @@ linkSomeBCOs hsc_env ie ce mods = foldr fun do_link mods [] bco_ix = mkNameEnv (zip names [0..]) resolved <- sequence [ linkBCO hsc_env ie ce bco_ix breakarray bco | (breakarray, bco) <- flat ] - hvrefs <- iservCmd hsc_env (CreateBCOs resolved) + hvrefs <- createBCOs hsc_env resolved return (zip names hvrefs) -- | Useful to apply to the result of 'linkSomeBCOs' diff --git a/compiler/utils/Util.hs b/compiler/utils/Util.hs index 75c0c79..e565e40 100644 --- a/compiler/utils/Util.hs +++ b/compiler/utils/Util.hs @@ -35,6 +35,8 @@ module Util ( isIn, isn'tIn, + chunkList, + -- * Tuples fstOf3, sndOf3, thdOf3, firstM, first3M, @@ -506,6 +508,12 @@ isn'tIn msg x ys | otherwise = x /= y && notElem100 (i + 1) x ys # endif /* DEBUG */ + +-- | Split a list into chunks of /n/ elements +chunkList :: Int -> [a] -> [[a]] +chunkList _ [] = [] +chunkList n xs = as : chunkList n bs where (as,bs) = splitAt n xs + {- ************************************************************************ * * diff --git a/libraries/ghci/GHCi/Message.hs b/libraries/ghci/GHCi/Message.hs index 50d4a16..b8f9fcc 100644 --- a/libraries/ghci/GHCi/Message.hs +++ b/libraries/ghci/GHCi/Message.hs @@ -14,7 +14,6 @@ module GHCi.Message ) where import GHCi.RemoteTypes -import GHCi.ResolvedBCO import GHCi.InfoTable (StgInfoTable) import GHCi.FFI import GHCi.TH.Binary () @@ -66,7 +65,7 @@ data Message a where -- Interpreter ------------------------------------------- -- | Create a set of BCO objects, and return HValueRefs to them - CreateBCOs :: [ResolvedBCO] -> Message [HValueRef] + CreateBCOs :: [LB.ByteString] -> Message [HValueRef] -- | Release 'HValueRef's FreeHValueRefs :: [HValueRef] -> Message () diff --git a/libraries/ghci/GHCi/Run.hs b/libraries/ghci/GHCi/Run.hs index 3faced4..a2ea4e2 100644 --- a/libraries/ghci/GHCi/Run.hs +++ b/libraries/ghci/GHCi/Run.hs @@ -23,6 +23,8 @@ import Control.Concurrent import Control.DeepSeq import Control.Exception import Control.Monad +import Data.Binary +import Data.Binary.Get import Data.ByteString (ByteString) import qualified Data.ByteString.Unsafe as B import GHC.Exts @@ -51,7 +53,7 @@ run m = case m of RemoveLibrarySearchPath ptr -> removeLibrarySearchPath (fromRemotePtr ptr) ResolveObjs -> resolveObjs FindSystemLibrary str -> findSystemLibrary str - CreateBCOs bco -> createBCOs bco + CreateBCOs bcos -> createBCOs (concatMap (runGet get) bcos) FreeHValueRefs rs -> mapM_ freeRemoteRef rs EvalStmt opts r -> evalStmt opts r ResumeStmt opts r -> resumeStmt opts r From git at git.haskell.org Tue Feb 2 16:43:15 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Feb 2016 16:43:15 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: fix validate breakage (8f37073) Message-ID: <20160202164315.9F3913A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/8f3707309e853fa989f12ef17d68890dc54930fb/ghc >--------------------------------------------------------------- commit 8f3707309e853fa989f12ef17d68890dc54930fb Author: Simon Marlow Date: Wed Jan 27 08:57:44 2016 -0800 fix validate breakage (Travis said it was OK!) (cherry picked from commit 0d5ddad900257a1a31658e5d9fc4be6648462588) >--------------------------------------------------------------- 8f3707309e853fa989f12ef17d68890dc54930fb compiler/deSugar/Coverage.hs | 2 -- 1 file changed, 2 deletions(-) diff --git a/compiler/deSugar/Coverage.hs b/compiler/deSugar/Coverage.hs index 9fc1734..0ccad63 100644 --- a/compiler/deSugar/Coverage.hs +++ b/compiler/deSugar/Coverage.hs @@ -13,8 +13,6 @@ import GHCi.RemoteTypes import Data.Array import ByteCodeTypes import GHC.Stack.CCS -import Foreign.C -import qualified Data.ByteString as B #endif import Type import HsSyn From git at git.haskell.org Tue Feb 2 17:25:02 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Feb 2016 17:25:02 +0000 (UTC) Subject: [commit: ghc] master: Add (failing) test for #11247 (db97ed9) Message-ID: <20160202172502.DDB983A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/db97ed9f91119bffa68e9d23acf1a08a8cd4e23c/ghc >--------------------------------------------------------------- commit db97ed9f91119bffa68e9d23acf1a08a8cd4e23c Author: Thomas Miedema Date: Mon Dec 21 17:23:21 2015 +0100 Add (failing) test for #11247 >--------------------------------------------------------------- db97ed9f91119bffa68e9d23acf1a08a8cd4e23c testsuite/tests/runghc/Makefile | 12 ++++++++++++ testsuite/tests/runghc/T11247-hs.hs | 1 + testsuite/tests/runghc/T11247-lhs.lhs | 1 + testsuite/tests/runghc/T11247-no-extension | 1 + testsuite/tests/runghc/T11247.stderr | 2 ++ testsuite/tests/runghc/T11247.stdout | 5 +++++ testsuite/tests/runghc/all.T | 3 +++ 7 files changed, 25 insertions(+) diff --git a/testsuite/tests/runghc/Makefile b/testsuite/tests/runghc/Makefile index f96c829..c414f84 100644 --- a/testsuite/tests/runghc/Makefile +++ b/testsuite/tests/runghc/Makefile @@ -10,3 +10,15 @@ T7859: #compile. T8601: -echo 'main = putStrLn "Hello World!"' | '$(RUNGHC)' -f '$(TEST_HC)' -hide-package --ghc-arg=bytestring + +T11247: + # Should all work: + '$(RUNGHC)' T11247-hs + '$(RUNGHC)' T11247-hs.hs + '$(RUNGHC)' T11247-lhs + '$(RUNGHC)' T11247-lhs.lhs + '$(RUNGHC)' T11247-no-extension + # Should print a "nice" error message that it can't find "foo." and + # "foo.bar" + -'$(RUNGHC)' foo. + -'$(RUNGHC)' foo.bar diff --git a/testsuite/tests/runghc/T11247-hs.hs b/testsuite/tests/runghc/T11247-hs.hs new file mode 100644 index 0000000..d88fc3c --- /dev/null +++ b/testsuite/tests/runghc/T11247-hs.hs @@ -0,0 +1 @@ +main = print "hello from a .hs file" diff --git a/testsuite/tests/runghc/T11247-lhs.lhs b/testsuite/tests/runghc/T11247-lhs.lhs new file mode 100644 index 0000000..307f328 --- /dev/null +++ b/testsuite/tests/runghc/T11247-lhs.lhs @@ -0,0 +1 @@ +> main = print "hello from a .lhs file" diff --git a/testsuite/tests/runghc/T11247-no-extension b/testsuite/tests/runghc/T11247-no-extension new file mode 100644 index 0000000..4248384 --- /dev/null +++ b/testsuite/tests/runghc/T11247-no-extension @@ -0,0 +1 @@ +main = print "hello from a file without extension" diff --git a/testsuite/tests/runghc/T11247.stderr b/testsuite/tests/runghc/T11247.stderr new file mode 100644 index 0000000..1c80dee --- /dev/null +++ b/testsuite/tests/runghc/T11247.stderr @@ -0,0 +1,2 @@ +target ?foo.? is not a module name or a source file +target ?foo.bar? is not a module name or a source file diff --git a/testsuite/tests/runghc/T11247.stdout b/testsuite/tests/runghc/T11247.stdout new file mode 100644 index 0000000..4e76a85 --- /dev/null +++ b/testsuite/tests/runghc/T11247.stdout @@ -0,0 +1,5 @@ +"hello from a .hs file" +"hello from a .hs file" +"hello from a .lhs file" +"hello from a .lhs file" +"hello from a file without extension" diff --git a/testsuite/tests/runghc/all.T b/testsuite/tests/runghc/all.T index 3ffaa20..0403fbc 100644 --- a/testsuite/tests/runghc/all.T +++ b/testsuite/tests/runghc/all.T @@ -3,3 +3,6 @@ test('T7859', req_interp, run_command, test('T8601', req_interp, run_command, ['$MAKE --no-print-directory -s T8601']) + +test('T11247', [req_interp, expect_broken(11247)], run_command, + ['$MAKE --no-print-directory -s T11247']) From git at git.haskell.org Tue Feb 2 18:38:50 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Feb 2016 18:38:50 +0000 (UTC) Subject: [commit: ghc] master: TcMType: Add some elementary notes (871c96f) Message-ID: <20160202183850.C4E623A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/871c96f10edecbf6107d4a930dfaa8596ad08b8d/ghc >--------------------------------------------------------------- commit 871c96f10edecbf6107d4a930dfaa8596ad08b8d Author: Ben Gamari Date: Tue Feb 2 14:50:22 2016 +0100 TcMType: Add some elementary notes It's astoundingly difficult to find a good description of zonking. Given that there is a Stack Overflow question on the matter, I'm clearly not the only one who feels this way. Hopefully this will clarify the issue. Test Plan: Read it Reviewers: goldfire, austin, simonpj Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1859 >--------------------------------------------------------------- 871c96f10edecbf6107d4a930dfaa8596ad08b8d compiler/typecheck/TcHsSyn.hs | 9 +++++++- compiler/typecheck/TcMType.hs | 49 +++++++++++++++++++++++++++++++++++++++++ compiler/typecheck/TcPluginM.hs | 2 +- 3 files changed, 58 insertions(+), 2 deletions(-) diff --git a/compiler/typecheck/TcHsSyn.hs b/compiler/typecheck/TcHsSyn.hs index 4289035..72052b1 100644 --- a/compiler/typecheck/TcHsSyn.hs +++ b/compiler/typecheck/TcHsSyn.hs @@ -19,9 +19,12 @@ module TcHsSyn ( shortCutLit, hsOverLitName, conLikeResTy, - -- re-exported from TcMonad + -- * re-exported from TcMonad TcId, TcIdSet, + -- * Zonking + -- | For a description of "zonking", see Note [What is zonking?] + -- in TcMType zonkTopDecls, zonkTopExpr, zonkTopLExpr, zonkTopBndrs, zonkTyBndrsX, emptyZonkEnv, mkEmptyZonkEnv, @@ -172,6 +175,7 @@ It's all pretty boring stuff, because HsSyn is such a large type, and the environment manipulation is tiresome. -} +-- Confused by zonking? See Note [What is zonking?] in TcMType. type UnboundTyVarZonker = TcTyVar -> TcM Type -- How to zonk an unbound type variable -- Note [Zonking the LHS of a RULE] @@ -187,6 +191,8 @@ type UnboundTyVarZonker = TcTyVar -> TcM Type -- Ids. It is knot-tied. We must be careful never to put coercion variables -- (which are Ids, after all) in the knot-tied env, because coercions can -- appear in types, and we sometimes inspect a zonked type in this module. +-- +-- Confused by zonking? See Note [What is zonking?] in TcMType. data ZonkEnv = ZonkEnv UnboundTyVarZonker @@ -1570,6 +1576,7 @@ zonk_tycomapper = TyCoMapper , tcm_hole = zonkCoHole , tcm_tybinder = \env tv _vis -> zonkTyBndrX env tv } +-- Confused by zonking? See Note [What is zonking?] in TcMType. zonkTcTypeToType :: ZonkEnv -> TcType -> TcM Type zonkTcTypeToType = mapType zonk_tycomapper diff --git a/compiler/typecheck/TcMType.hs b/compiler/typecheck/TcMType.hs index 3d9e57c..143a392 100644 --- a/compiler/typecheck/TcMType.hs +++ b/compiler/typecheck/TcMType.hs @@ -975,6 +975,55 @@ skolemiseUnboundMetaTyVar tv details ; return final_tv } {- +Note [What is a meta variable?] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +A "meta type-variable", also know as a "unification variable" is a placeholder +introduced by the typechecker for an as-yet-unknown monotype. + +For example, when we see a call `reverse (f xs)`, we know that we calling + reverse :: forall a. [a] -> [a] +So we know that the argument `f xs` must be a "list of something". But what is +the "something"? We don't know until we explore the `f xs` a bit more. So we set +out what we do know at the call of `reverse` by instantiate its type with a fresh +meta tyvar, `alpha` say. So now the type of the argument `f xs`, and of the +result, is `[alpha]`. The unification variable `alpha` stands for the +as-yet-unknown type of the elements of the list. + +As type inference progresses we may learn more about `alpha`. For example, suppose +`f` has the type + f :: forall b. b -> [Maybe b] +Then we instantiate `f`'s type with another fresh unification variable, say +`beta`; and equate `f`'s result type with reverse's argument type, thus +`[alpha] ~ [Maybe beta]`. + +Now we can solve this equality to learn that `alpha ~ Maybe beta`, so we've +refined our knowledge about `alpha`. And so on. + +If you found this Note useful, you may also want to have a look at +Section 5 of "Practical type inference for higher rank types" (Peyton Jones, +Vytiniotis, Weirich and Shields. J. Functional Programming. 2011). + +Note [What is zonking?] +~~~~~~~~~~~~~~~~~~~~~~~ +GHC relies heavily on mutability in the typechecker for efficient operation. +For this reason, throughout much of the type checking process meta type +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 +interesting part of replacing the mutable variables occurs in zonkTyVarOcc. + +There are two ways to zonk a Type: + + * zonkTcTypeToType, which is intended to be used at the end of type-checking + for the final zonk. It has to deal with unfilled metavars, either by filling + it with a value like Any or failing (determined by the UnboundTyVarZonker + used). + + * zonkTcType, which will happily ignore unfilled metavars. This is the + appropriate function to use while in the middle of type-checking. + Note [Zonking to Skolem] ~~~~~~~~~~~~~~~~~~~~~~~~ We used to zonk quantified type variables to regular TyVars. However, this diff --git a/compiler/typecheck/TcPluginM.hs b/compiler/typecheck/TcPluginM.hs index 7ba1f51..c405440 100644 --- a/compiler/typecheck/TcPluginM.hs +++ b/compiler/typecheck/TcPluginM.hs @@ -150,7 +150,7 @@ newFlexiTyVar = unsafeTcPluginTcM . TcM.newFlexiTyVar isTouchableTcPluginM :: TcTyVar -> TcPluginM Bool isTouchableTcPluginM = unsafeTcPluginTcM . TcM.isTouchableTcM - +-- Confused by zonking? See Note [What is zonking?] in TcMType. zonkTcType :: TcType -> TcPluginM TcType zonkTcType = unsafeTcPluginTcM . TcM.zonkTcType From git at git.haskell.org Tue Feb 2 21:04:18 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Feb 2016 21:04:18 +0000 (UTC) Subject: [commit: packages/binary] master: Add parsers for Ints of varaious sizes (e332ead) Message-ID: <20160202210418.23CA93A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/binary On branch : master Link : http://git.haskell.org/packages/binary.git/commitdiff/e332ead9965166325188094367ce82021e9c56e3 >--------------------------------------------------------------- commit e332ead9965166325188094367ce82021e9c56e3 Author: Alexey Khudyakov Date: Sat Feb 8 00:59:34 2014 +0400 Add parsers for Ints of varaious sizes >--------------------------------------------------------------- e332ead9965166325188094367ce82021e9c56e3 src/Data/Binary/Get.hs | 80 ++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 80 insertions(+) diff --git a/src/Data/Binary/Get.hs b/src/Data/Binary/Get.hs index 626c05c..df817cc 100644 --- a/src/Data/Binary/Get.hs +++ b/src/Data/Binary/Get.hs @@ -189,6 +189,25 @@ module Data.Binary.Get ( , getWord32host , getWord64host + -- ** Decoding words + , getInt8 + + -- *** Big-endian decoding + , getInt16be + , getInt32be + , getInt64be + + -- *** Little-endian decoding + , getInt16le + , getInt32le + , getInt64le + + -- *** Host-endian, unaligned decoding + , getInthost + , getInt16host + , getInt32host + , getInt64host + -- * Deprecated functions , runGetState -- DEPRECATED , remaining -- DEPRECATED @@ -427,6 +446,12 @@ getWord8 :: Get Word8 getWord8 = readN 1 B.unsafeHead {-# INLINE getWord8 #-} +-- | Read Int8 from the monad state +getInt8 :: Get Int8 +getInt8 = fromIntegral <$> getWord8 +{-# INLINE getInt8 #-} + + -- force GHC to inline getWordXX {-# RULES "getWord8/readN" getWord8 = readN 1 B.unsafeHead @@ -520,6 +545,39 @@ word64le = \s -> {-# INLINE getWord64le #-} {-# INLINE word64le #-} + +-- | Read a Int16 in big endian format +getInt16be :: Get Int16 +getInt16be = fromIntegral <$> getWord16be +{-# INLINE getInt16be #-} + +-- | Read a Int16 in big endian format +getInt32be :: Get Int32 +getInt32be = fromIntegral <$> getWord32be +{-# INLINE getInt32be #-} + +-- | Read a Int16 in big endian format +getInt64be :: Get Int64 +getInt64be = fromIntegral <$> getWord64be +{-# INLINE getInt64be #-} + + +-- | Read a Int16 in little endian format +getInt16le :: Get Int16 +getInt16le = fromIntegral <$> getWord16le +{-# INLINE getInt16le #-} + +-- | Read a Int32 in little endian format +getInt32le :: Get Int32 +getInt32le = fromIntegral <$> getWord32le +{-# INLINE getInt32le #-} + +-- | Read a Int64 in little endian format +getInt64le :: Get Int64 +getInt64le = fromIntegral <$> getWord64le +{-# INLINE getInt64le #-} + + ------------------------------------------------------------------------ -- Host-endian reads @@ -545,6 +603,28 @@ getWord64host :: Get Word64 getWord64host = getPtr (sizeOf (undefined :: Word64)) {-# INLINE getWord64host #-} +-- | /O(1)./ Read a single native machine word in native host +-- order. It works in the same way as 'getWordhost'. +getInthost :: Get Int +getInthost = getPtr (sizeOf (undefined :: Int)) +{-# INLINE getInthost #-} + +-- | /O(1)./ Read a 2 byte Int16 in native host order and host endianness. +getInt16host :: Get Int16 +getInt16host = getPtr (sizeOf (undefined :: Int16)) +{-# INLINE getInt16host #-} + +-- | /O(1)./ Read a Int32 in native host order and host endianness. +getInt32host :: Get Int32 +getInt32host = getPtr (sizeOf (undefined :: Int32)) +{-# INLINE getInt32host #-} + +-- | /O(1)./ Read a Int64 in native host order and host endianess. +getInt64host :: Get Int64 +getInt64host = getPtr (sizeOf (undefined :: Int64)) +{-# INLINE getInt64host #-} + + ------------------------------------------------------------------------ -- Unchecked shifts From git at git.haskell.org Tue Feb 2 21:04:20 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Feb 2016 21:04:20 +0000 (UTC) Subject: [commit: packages/binary] master: Add encoders for signed ints (a137fe7) Message-ID: <20160202210420.2C4A03A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/binary On branch : master Link : http://git.haskell.org/packages/binary.git/commitdiff/a137fe700fe433759291e2e08975aa3a41b2dd5b >--------------------------------------------------------------- commit a137fe700fe433759291e2e08975aa3a41b2dd5b Author: Alexey Khudyakov Date: Sun Feb 9 15:41:57 2014 +0400 Add encoders for signed ints >--------------------------------------------------------------- a137fe700fe433759291e2e08975aa3a41b2dd5b src/Data/Binary/Builder.hs | 10 ++++++ src/Data/Binary/Builder/Base.hs | 77 +++++++++++++++++++++++++++++++++++++++++ src/Data/Binary/Put.hs | 77 +++++++++++++++++++++++++++++++++++++++++ 3 files changed, 164 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 a137fe700fe433759291e2e08975aa3a41b2dd5b From git at git.haskell.org Tue Feb 2 21:04:22 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Feb 2016 21:04:22 +0000 (UTC) Subject: [commit: packages/binary] master: Add tests for signed ints (16bc21e) Message-ID: <20160202210422.33C6A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/binary On branch : master Link : http://git.haskell.org/packages/binary.git/commitdiff/16bc21e6e765e3719297d39eef23c0ea0e2defad >--------------------------------------------------------------- commit 16bc21e6e765e3719297d39eef23c0ea0e2defad Author: Alexey Khudyakov Date: Sun Feb 9 15:47:06 2014 +0400 Add tests for signed ints >--------------------------------------------------------------- 16bc21e6e765e3719297d39eef23c0ea0e2defad tests/QC.hs | 45 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 45 insertions(+) diff --git a/tests/QC.hs b/tests/QC.hs index d9b2cd8..0b3585d 100644 --- a/tests/QC.hs +++ b/tests/QC.hs @@ -61,6 +61,8 @@ mustThrowError a = unsafePerformIO $ (\(_e :: SomeException) -> return True) -- low level ones: +-- +-- Words prop_Word16be :: Word16 -> Property prop_Word16be = roundTripWith putWord16be getWord16be @@ -92,6 +94,38 @@ prop_Word64host = roundTripWith putWord64host getWord64host prop_Wordhost :: Word -> Property prop_Wordhost = roundTripWith putWordhost getWordhost +-- Ints + +prop_Int16be :: Int16 -> Property +prop_Int16be = roundTripWith putInt16be getInt16be + +prop_Int16le :: Int16 -> Property +prop_Int16le = roundTripWith putInt16le getInt16le + +prop_Int16host :: Int16 -> Property +prop_Int16host = roundTripWith putInt16host getInt16host + +prop_Int32be :: Int32 -> Property +prop_Int32be = roundTripWith putInt32be getInt32be + +prop_Int32le :: Int32 -> Property +prop_Int32le = roundTripWith putInt32le getInt32le + +prop_Int32host :: Int32 -> Property +prop_Int32host = roundTripWith putInt32host getInt32host + +prop_Int64be :: Int64 -> Property +prop_Int64be = roundTripWith putInt64be getInt64be + +prop_Int64le :: Int64 -> Property +prop_Int64le = roundTripWith putInt64le getInt64le + +prop_Int64host :: Int64 -> Property +prop_Int64host = roundTripWith putInt64host getInt64host + +prop_Inthost :: Int -> Property +prop_Inthost = roundTripWith putInthost getInthost + -- done, partial and fail @@ -418,6 +452,17 @@ tests = , testProperty "Word64le" (p prop_Word64le) , testProperty "Word64host" (p prop_Word64host) , testProperty "Wordhost" (p prop_Wordhost) + -- Int + , testProperty "Int16be" (p prop_Int16be) + , testProperty "Int16le" (p prop_Int16le) + , testProperty "Int16host" (p prop_Int16host) + , testProperty "Int32be" (p prop_Int32be) + , testProperty "Int32le" (p prop_Int32le) + , testProperty "Int32host" (p prop_Int32host) + , testProperty "Int64be" (p prop_Int64be) + , testProperty "Int64le" (p prop_Int64le) + , testProperty "Int64host" (p prop_Int64host) + , testProperty "Inthost" (p prop_Inthost) ] , testGroup "String utils" From git at git.haskell.org Tue Feb 2 21:04:24 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Feb 2016 21:04:24 +0000 (UTC) Subject: [commit: packages/binary] master: Add tests for 8-bt word/ints (f0567f8) Message-ID: <20160202210424.399423A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/binary On branch : master Link : http://git.haskell.org/packages/binary.git/commitdiff/f0567f8917a3450df8b7abba676a5c1c52dd143c >--------------------------------------------------------------- commit f0567f8917a3450df8b7abba676a5c1c52dd143c Author: Alexey Khudyakov Date: Sun Feb 9 15:53:06 2014 +0400 Add tests for 8-bt word/ints >--------------------------------------------------------------- f0567f8917a3450df8b7abba676a5c1c52dd143c tests/QC.hs | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/tests/QC.hs b/tests/QC.hs index 0b3585d..ff4d37c 100644 --- a/tests/QC.hs +++ b/tests/QC.hs @@ -64,6 +64,9 @@ mustThrowError a = unsafePerformIO $ -- -- Words +prop_Word8 :: Word8 -> Property +prop_Word8 = roundTripWith putWord8 getWord8 + prop_Word16be :: Word16 -> Property prop_Word16be = roundTripWith putWord16be getWord16be @@ -96,6 +99,9 @@ prop_Wordhost = roundTripWith putWordhost getWordhost -- Ints +prop_Int8 :: Int8 -> Property +prop_Int8 = roundTripWith putInt8 getInt8 + prop_Int16be :: Int16 -> Property prop_Int16be = roundTripWith putInt16be getInt16be @@ -442,7 +448,8 @@ tests = ] , testGroup "Primitives" - [ testProperty "Word16be" (p prop_Word16be) + [ testProperty "Word8" (p prop_Word8) + , testProperty "Word16be" (p prop_Word16be) , testProperty "Word16le" (p prop_Word16le) , testProperty "Word16host" (p prop_Word16host) , testProperty "Word32be" (p prop_Word32be) @@ -453,6 +460,7 @@ tests = , testProperty "Word64host" (p prop_Word64host) , testProperty "Wordhost" (p prop_Wordhost) -- Int + , testProperty "Int8" (p prop_Int8) , testProperty "Int16be" (p prop_Int16be) , testProperty "Int16le" (p prop_Int16le) , testProperty "Int16host" (p prop_Int16host) From git at git.haskell.org Tue Feb 2 21:04:26 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Feb 2016 21:04:26 +0000 (UTC) Subject: [commit: packages/binary] master: Fix documentation (03332c4) Message-ID: <20160202210426.406D33A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/binary On branch : master Link : http://git.haskell.org/packages/binary.git/commitdiff/03332c4784cda1ce5015092c8b13fab5dbd22e89 >--------------------------------------------------------------- commit 03332c4784cda1ce5015092c8b13fab5dbd22e89 Author: Alexey Khudyakov Date: Thu Nov 12 13:40:58 2015 +0300 Fix documentation >--------------------------------------------------------------- 03332c4784cda1ce5015092c8b13fab5dbd22e89 src/Data/Binary/Get.hs | 18 +++++++++--------- src/Data/Binary/Put.hs | 18 +++++++++--------- 2 files changed, 18 insertions(+), 18 deletions(-) diff --git a/src/Data/Binary/Get.hs b/src/Data/Binary/Get.hs index df817cc..438fd13 100644 --- a/src/Data/Binary/Get.hs +++ b/src/Data/Binary/Get.hs @@ -446,7 +446,7 @@ getWord8 :: Get Word8 getWord8 = readN 1 B.unsafeHead {-# INLINE getWord8 #-} --- | Read Int8 from the monad state +-- | Read an Int8 from the monad state getInt8 :: Get Int8 getInt8 = fromIntegral <$> getWord8 {-# INLINE getInt8 #-} @@ -546,33 +546,33 @@ word64le = \s -> {-# INLINE word64le #-} --- | Read a Int16 in big endian format +-- | Read an Int16 in big endian format getInt16be :: Get Int16 getInt16be = fromIntegral <$> getWord16be {-# INLINE getInt16be #-} --- | Read a Int16 in big endian format +-- | Read an Int32 in big endian format getInt32be :: Get Int32 getInt32be = fromIntegral <$> getWord32be {-# INLINE getInt32be #-} --- | Read a Int16 in big endian format +-- | Read an Int64 in big endian format getInt64be :: Get Int64 getInt64be = fromIntegral <$> getWord64be {-# INLINE getInt64be #-} --- | Read a Int16 in little endian format +-- | Read an Int16 in little endian format getInt16le :: Get Int16 getInt16le = fromIntegral <$> getWord16le {-# INLINE getInt16le #-} --- | Read a Int32 in little endian format +-- | Read an Int32 in little endian format getInt32le :: Get Int32 getInt32le = fromIntegral <$> getWord32le {-# INLINE getInt32le #-} --- | Read a Int64 in little endian format +-- | Read an Int64 in little endian format getInt64le :: Get Int64 getInt64le = fromIntegral <$> getWord64le {-# INLINE getInt64le #-} @@ -614,12 +614,12 @@ getInt16host :: Get Int16 getInt16host = getPtr (sizeOf (undefined :: Int16)) {-# INLINE getInt16host #-} --- | /O(1)./ Read a Int32 in native host order and host endianness. +-- | /O(1)./ Read an Int32 in native host order and host endianness. getInt32host :: Get Int32 getInt32host = getPtr (sizeOf (undefined :: Int32)) {-# INLINE getInt32host #-} --- | /O(1)./ Read a Int64 in native host order and host endianess. +-- | /O(1)./ Read an Int64 in native host order and host endianess. getInt64host :: Get Int64 getInt64host = getPtr (sizeOf (undefined :: Int64)) {-# INLINE getInt64host #-} diff --git a/src/Data/Binary/Put.hs b/src/Data/Binary/Put.hs index c522940..7fd5986 100644 --- a/src/Data/Binary/Put.hs +++ b/src/Data/Binary/Put.hs @@ -201,32 +201,32 @@ putWord64le :: Word64 -> Put putWord64le = tell . B.putWord64le {-# INLINE putWord64le #-} --- | Write a Int16 in big endian format +-- | Write an Int16 in big endian format putInt16be :: Int16 -> Put putInt16be = tell . B.putInt16be {-# INLINE putInt16be #-} --- | Write a Int16 in little endian format +-- | Write an Int16 in little endian format putInt16le :: Int16 -> Put putInt16le = tell . B.putInt16le {-# INLINE putInt16le #-} --- | Write a Int32 in big endian format +-- | Write an Int32 in big endian format putInt32be :: Int32 -> Put putInt32be = tell . B.putInt32be {-# INLINE putInt32be #-} --- | Write a Int32 in little endian format +-- | Write an Int32 in little endian format putInt32le :: Int32 -> Put putInt32le = tell . B.putInt32le {-# INLINE putInt32le #-} --- | Write a Int64 in big endian format +-- | Write an Int64 in big endian format putInt64be :: Int64 -> Put putInt64be = tell . B.putInt64be {-# INLINE putInt64be #-} --- | Write a Int64 in little endian format +-- | Write an Int64 in little endian format putInt64le :: Int64 -> Put putInt64le = tell . B.putInt64le {-# INLINE putInt64le #-} @@ -273,19 +273,19 @@ putInthost :: Int -> Put putInthost = tell . B.putInthost {-# INLINE putInthost #-} --- | /O(1)./ Write a Int16 in native host order and host endianness. +-- | /O(1)./ Write an Int16 in native host order and host endianness. -- For portability issues see @putInthost at . putInt16host :: Int16 -> Put putInt16host = tell . B.putInt16host {-# INLINE putInt16host #-} --- | /O(1)./ Write a Int32 in native host order and host endianness. +-- | /O(1)./ Write an Int32 in native host order and host endianness. -- For portability issues see @putInthost at . putInt32host :: Int32 -> Put putInt32host = tell . B.putInt32host {-# INLINE putInt32host #-} --- | /O(1)./ Write a Int64 in native host order +-- | /O(1)./ Write an Int64 in native host order -- On a 32 bit machine we write two host order Int32s, in big endian form. -- For portability issues see @putInthost at . putInt64host :: Int64 -> Put From git at git.haskell.org Tue Feb 2 21:04:28 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Feb 2016 21:04:28 +0000 (UTC) Subject: [commit: packages/binary] master: Merge branch 'master' into signed-int (7c4fe52) Message-ID: <20160202210428.49DB23A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/binary On branch : master Link : http://git.haskell.org/packages/binary.git/commitdiff/7c4fe524ff5fd4b214214ae743e3575988c0ffd2 >--------------------------------------------------------------- commit 7c4fe524ff5fd4b214214ae743e3575988c0ffd2 Merge: 03332c4 8429d6b Author: Alexey Khudyakov Date: Sun Nov 15 18:42:53 2015 +0300 Merge branch 'master' into signed-int >--------------------------------------------------------------- 7c4fe524ff5fd4b214214ae743e3575988c0ffd2 .gitignore | 2 + .hgignore | 2 + .travis.yml | 55 ++++++ README.md | 53 ++--- benchmarks/Builder.hs | 15 +- benchmarks/GenericsBench.hs | 52 +++++ benchmarks/GenericsBenchCache.hs | 89 +++++++++ benchmarks/GenericsBenchTypes.hs | 46 +++++ benchmarks/Get.hs | 277 +++++++++++++++----------- benchmarks/Makefile | 34 ---- binary.cabal | 79 +++++--- changelog.md | 113 +++++++++++ index.html | 161 ---------------- src/Data/Binary.hs | 4 + src/Data/Binary/Builder/Base.hs | 8 +- src/Data/Binary/Builder/Internal.hs | 2 +- src/Data/Binary/Class.hs | 121 ++++++++++-- src/Data/Binary/Generic.hs | 12 +- src/Data/Binary/Get.hs | 87 ++++----- src/Data/Binary/Get/Internal.hs | 135 ++++++++++--- src/Data/Binary/Put.hs | 5 +- tests/Action.hs | 375 ++++++++++++++++++++++++++++-------- tests/Arbitrary.hs | 1 + tests/File.hs | 18 +- tests/Makefile | 20 -- tests/QC.hs | 131 ++++++++----- 26 files changed, 1267 insertions(+), 630 deletions(-) diff --cc src/Data/Binary/Get.hs index 438fd13,de1a326..db96a97 --- a/src/Data/Binary/Get.hs +++ b/src/Data/Binary/Get.hs @@@ -444,14 -411,8 +430,14 @@@ getPtr n = readNWith n pee -- | Read a Word8 from the monad state getWord8 :: Get Word8 getWord8 = readN 1 B.unsafeHead - {-# INLINE getWord8 #-} + {-# INLINE[2] getWord8 #-} +-- | Read an Int8 from the monad state +getInt8 :: Get Int8 +getInt8 = fromIntegral <$> getWord8 +{-# INLINE getInt8 #-} + + -- force GHC to inline getWordXX {-# RULES "getWord8/readN" getWord8 = readN 1 B.unsafeHead @@@ -542,42 -502,9 +527,42 @@@ word64le = \s - (fromIntegral (s `B.unsafeIndex` 2) `shiftl_w64` 16) .|. (fromIntegral (s `B.unsafeIndex` 1) `shiftl_w64` 8) .|. (fromIntegral (s `B.unsafeIndex` 0) ) - {-# INLINE getWord64le #-} + {-# INLINE[2] getWord64le #-} {-# INLINE word64le #-} + +-- | Read an Int16 in big endian format +getInt16be :: Get Int16 +getInt16be = fromIntegral <$> getWord16be +{-# INLINE getInt16be #-} + +-- | Read an Int32 in big endian format +getInt32be :: Get Int32 +getInt32be = fromIntegral <$> getWord32be +{-# INLINE getInt32be #-} + +-- | Read an Int64 in big endian format +getInt64be :: Get Int64 +getInt64be = fromIntegral <$> getWord64be +{-# INLINE getInt64be #-} + + +-- | Read an Int16 in little endian format +getInt16le :: Get Int16 +getInt16le = fromIntegral <$> getWord16le +{-# INLINE getInt16le #-} + +-- | Read an Int32 in little endian format +getInt32le :: Get Int32 +getInt32le = fromIntegral <$> getWord32le +{-# INLINE getInt32le #-} + +-- | Read an Int64 in little endian format +getInt64le :: Get Int64 +getInt64le = fromIntegral <$> getWord64le +{-# INLINE getInt64le #-} + + ------------------------------------------------------------------------ -- Host-endian reads diff --cc tests/QC.hs index ff4d37c,493d2aa..414d6f9 --- a/tests/QC.hs +++ b/tests/QC.hs @@@ -444,12 -433,10 +473,11 @@@ tests ] , testGroup "Model" - [ testProperty "action" Action.prop_action - ] + Action.tests , testGroup "Primitives" - [ testProperty "Word16be" (p prop_Word16be) + [ testProperty "Word8" (p prop_Word8) + , testProperty "Word16be" (p prop_Word16be) , testProperty "Word16le" (p prop_Word16le) , testProperty "Word16host" (p prop_Word16host) , testProperty "Word32be" (p prop_Word32be) From git at git.haskell.org Tue Feb 2 21:04:30 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Feb 2016 21:04:30 +0000 (UTC) Subject: [commit: packages/binary] master: Import Control.Applicative for older GHC (cbc3e2d) Message-ID: <20160202210430.510583A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/binary On branch : master Link : http://git.haskell.org/packages/binary.git/commitdiff/cbc3e2d602684b1d1906f7bc3858db0f27d77af2 >--------------------------------------------------------------- commit cbc3e2d602684b1d1906f7bc3858db0f27d77af2 Author: Alexey Khudyakov Date: Sun Nov 15 18:45:47 2015 +0300 Import Control.Applicative for older GHC >--------------------------------------------------------------- cbc3e2d602684b1d1906f7bc3858db0f27d77af2 src/Data/Binary/Get.hs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/Data/Binary/Get.hs b/src/Data/Binary/Get.hs index db96a97..afc391b 100644 --- a/src/Data/Binary/Get.hs +++ b/src/Data/Binary/Get.hs @@ -215,6 +215,9 @@ module Data.Binary.Get ( , remaining -- DEPRECATED , getBytes -- DEPRECATED ) where +#if ! MIN_VERSION_base(4,8,0) +import Control.Applicative +#endif import Foreign import qualified Data.ByteString as B From git at git.haskell.org Tue Feb 2 21:04:32 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Feb 2016 21:04:32 +0000 (UTC) Subject: [commit: packages/binary] master: Clean up old CPP code. (ff7239c) Message-ID: <20160202210432.577CA3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/binary On branch : master Link : http://git.haskell.org/packages/binary.git/commitdiff/ff7239caa218d389869b3d09f8bcfd3feec6e9ab >--------------------------------------------------------------- commit ff7239caa218d389869b3d09f8bcfd3feec6e9ab Author: Lennart Kolmodin Date: Sun Dec 20 23:08:11 2015 +0100 Clean up old CPP code. >--------------------------------------------------------------- ff7239caa218d389869b3d09f8bcfd3feec6e9ab src/Data/Binary/Builder/Base.hs | 6 ------ 1 file changed, 6 deletions(-) diff --git a/src/Data/Binary/Builder/Base.hs b/src/Data/Binary/Builder/Base.hs index 5480dd0..ade8de7 100644 --- a/src/Data/Binary/Builder/Base.hs +++ b/src/Data/Binary/Builder/Base.hs @@ -74,15 +74,9 @@ import Foreign import System.IO.Unsafe as IO ( unsafePerformIO ) -#ifdef BYTESTRING_IN_BASE -import Data.ByteString.Base (inlinePerformIO) -import qualified Data.ByteString.Base as S -import qualified Data.ByteString.Lazy.Base as L -#else import Data.ByteString.Internal (inlinePerformIO) import qualified Data.ByteString.Internal as S import qualified Data.ByteString.Lazy.Internal as L -#endif #if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__) import GHC.Base (ord,Int(..),uncheckedShiftRL#) From git at git.haskell.org Tue Feb 2 21:04:34 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Feb 2016 21:04:34 +0000 (UTC) Subject: [commit: packages/binary] master: Use accursedUnutterablePerformIO rather than inlinePerformIO. (37983d3) Message-ID: <20160202210434.5FE4A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/binary On branch : master Link : http://git.haskell.org/packages/binary.git/commitdiff/37983d3eeeed7e332a4931cda066becded3b4fe6 >--------------------------------------------------------------- commit 37983d3eeeed7e332a4931cda066becded3b4fe6 Author: Lennart Kolmodin Date: Sun Dec 20 23:29:38 2015 +0100 Use accursedUnutterablePerformIO rather than inlinePerformIO. Let's share the address space with a malevolent agent of chaos. >--------------------------------------------------------------- 37983d3eeeed7e332a4931cda066becded3b4fe6 binary.cabal | 3 ++- src/Data/Binary/Builder/Base.hs | 4 ++-- src/Data/Binary/Get/Internal.hs | 5 +++-- src/Data/Binary/Internal.hs | 15 +++++++++++++++ 4 files changed, 22 insertions(+), 5 deletions(-) diff --git a/binary.cabal b/binary.cabal index 25c7c7c..f772d27 100644 --- a/binary.cabal +++ b/binary.cabal @@ -41,7 +41,8 @@ library Data.Binary.Builder.Internal other-modules: Data.Binary.Builder.Base, - Data.Binary.Class + Data.Binary.Class, + Data.Binary.Internal if impl(ghc >= 7.2.1) cpp-options: -DGENERICS diff --git a/src/Data/Binary/Builder/Base.hs b/src/Data/Binary/Builder/Base.hs index ade8de7..1b1c0b1 100644 --- a/src/Data/Binary/Builder/Base.hs +++ b/src/Data/Binary/Builder/Base.hs @@ -74,7 +74,7 @@ import Foreign import System.IO.Unsafe as IO ( unsafePerformIO ) -import Data.ByteString.Internal (inlinePerformIO) +import Data.Binary.Internal ( accursedUnutterablePerformIO ) import qualified Data.ByteString.Internal as S import qualified Data.ByteString.Lazy.Internal as L @@ -198,7 +198,7 @@ flush = Builder $ \ k buf@(Buffer p o u l) -> then k buf else let !b = Buffer p (o+u) 0 l !bs = S.PS p o u - in return $! L.Chunk bs (inlinePerformIO (k b)) + in return $! L.Chunk bs (accursedUnutterablePerformIO (k b)) {-# INLINE [0] flush #-} ------------------------------------------------------------------------ diff --git a/src/Data/Binary/Get/Internal.hs b/src/Data/Binary/Get/Internal.hs index 74e8eba..9dcd22c 100644 --- a/src/Data/Binary/Get/Internal.hs +++ b/src/Data/Binary/Get/Internal.hs @@ -44,12 +44,13 @@ module Data.Binary.Get.Internal ( import Foreign import qualified Data.ByteString as B -import qualified Data.ByteString.Internal as B import qualified Data.ByteString.Unsafe as B import Control.Applicative import Control.Monad +import Data.Binary.Internal ( accursedUnutterablePerformIO ) + #if __GLASGOW_HASKELL__ < 704 && !defined(__HADDOCK__) -- needed for (# unboxing #) with magic hash -- Do we still need these? Works without on modern GHCs. @@ -415,5 +416,5 @@ unsafeReadN !n f = C $ \inp ks -> do readNWith :: Int -> (Ptr a -> IO a) -> Get a readNWith n f = do - readN n $ \s -> B.inlinePerformIO $ B.unsafeUseAsCString s (f . castPtr) + readN n $ \s -> accursedUnutterablePerformIO $ B.unsafeUseAsCString s (f . castPtr) {-# INLINE readNWith #-} diff --git a/src/Data/Binary/Internal.hs b/src/Data/Binary/Internal.hs new file mode 100644 index 0000000..d04b728 --- /dev/null +++ b/src/Data/Binary/Internal.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE CPP #-} + +module Data.Binary.Internal + ( accursedUnutterablePerformIO ) where + +#if MIN_VERSION_bytestring(0,10,6) +import Data.ByteString.Internal( accursedUnutterablePerformIO ) +#else +import Data.ByteString.Internal( inlinePerformIO ) + +{-# INLINE accursedUnutterablePerformIO #-} +-- | You must be truly desperate to come to me for help. +accursedUnutterablePerformIO :: IO a -> a +accursedUnutterablePerformIO = inlinePerformIO +#endif From git at git.haskell.org Tue Feb 2 21:04:36 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Feb 2016 21:04:36 +0000 (UTC) Subject: [commit: packages/binary] master: Add @dcoutts's comments regarding accursedUnutterablePerformIO. (ad6e2a2) Message-ID: <20160202210436.674273A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/binary On branch : master Link : http://git.haskell.org/packages/binary.git/commitdiff/ad6e2a2d507b11ef8e6d0d08e76cf7d11dbce51d >--------------------------------------------------------------- commit ad6e2a2d507b11ef8e6d0d08e76cf7d11dbce51d Author: Lennart Kolmodin Date: Mon Jan 18 23:15:55 2016 +0100 Add @dcoutts's comments regarding accursedUnutterablePerformIO. >--------------------------------------------------------------- ad6e2a2d507b11ef8e6d0d08e76cf7d11dbce51d src/Data/Binary/Builder/Base.hs | 5 +++++ src/Data/Binary/Get/Internal.hs | 4 ++++ 2 files changed, 9 insertions(+) diff --git a/src/Data/Binary/Builder/Base.hs b/src/Data/Binary/Builder/Base.hs index 1b1c0b1..62d286e 100644 --- a/src/Data/Binary/Builder/Base.hs +++ b/src/Data/Binary/Builder/Base.hs @@ -198,6 +198,11 @@ flush = Builder $ \ k buf@(Buffer p o u l) -> then k buf else let !b = Buffer p (o+u) 0 l !bs = S.PS p o u + -- It should be safe to use accursedUnutterablePerformIO here. + -- The place in the buffer where we write is determined by the 'b' + -- value, and writes should be deterministic. The thunk should not + -- be floated out and shared since the buffer references the + -- incoming foreign ptr. in return $! L.Chunk bs (accursedUnutterablePerformIO (k b)) {-# INLINE [0] flush #-} diff --git a/src/Data/Binary/Get/Internal.hs b/src/Data/Binary/Get/Internal.hs index 9dcd22c..10e372f 100644 --- a/src/Data/Binary/Get/Internal.hs +++ b/src/Data/Binary/Get/Internal.hs @@ -414,7 +414,11 @@ unsafeReadN :: Int -> (B.ByteString -> a) -> Get a unsafeReadN !n f = C $ \inp ks -> do ks (B.unsafeDrop n inp) $! f inp -- strict return +-- | @readNWith n f@ where @f@ must be deterministic and not have side effects. readNWith :: Int -> (Ptr a -> IO a) -> Get a readNWith n f = do + -- It should be safe to use accursedUnutterablePerformIO here. + -- The action must be deterministic and not have any external side effects. + -- It depends on the value of the ByteString so the value dependencies look OK. readN n $ \s -> accursedUnutterablePerformIO $ B.unsafeUseAsCString s (f . castPtr) {-# INLINE readNWith #-} From git at git.haskell.org Tue Feb 2 21:04:37 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Feb 2016 21:04:37 +0000 (UTC) Subject: [commit: packages/binary] tag '0.8.2.0' created Message-ID: <20160202210437.63C483A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/binary New tag : 0.8.2.0 Referencing: f3c4d4a789679b3397e3edc4835ac925057871d8 From git at git.haskell.org Tue Feb 2 21:04:38 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Feb 2016 21:04:38 +0000 (UTC) Subject: [commit: packages/binary] master: Bump to 0.8.0.1. (6d3fd55) Message-ID: <20160202210438.6CFF23A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/binary On branch : master Link : http://git.haskell.org/packages/binary.git/commitdiff/6d3fd55cb3389e43f802adaa8c26d45ea034b4ea >--------------------------------------------------------------- commit 6d3fd55cb3389e43f802adaa8c26d45ea034b4ea Author: Lennart Kolmodin Date: Thu Jan 21 10:45:22 2016 +0100 Bump to 0.8.0.1. >--------------------------------------------------------------- 6d3fd55cb3389e43f802adaa8c26d45ea034b4ea binary.cabal | 2 +- changelog.md | 5 +++++ 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/binary.cabal b/binary.cabal index f772d27..7781a03 100644 --- a/binary.cabal +++ b/binary.cabal @@ -1,5 +1,5 @@ name: binary -version: 0.8.0.0 +version: 0.8.0.1 license: BSD3 license-file: LICENSE author: Lennart Kolmodin diff --git a/changelog.md b/changelog.md index 8244e66..69fde96 100644 --- a/changelog.md +++ b/changelog.md @@ -1,6 +1,11 @@ binary ====== +binary-0.8.0.1 +-------------- + +- Address compiler warnings. + binary-0.8.0.0 -------------- From git at git.haskell.org Tue Feb 2 21:04:39 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Feb 2016 21:04:39 +0000 (UTC) Subject: [commit: packages/binary] master: Add parsers for Ints of varaious sizes (e332ead) Message-ID: <20160202210439.6A8DA3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/binary On branch : master Link : http://git.haskell.org/packages/binary.git/commitdiff/e332ead9965166325188094367ce82021e9c56e3 >--------------------------------------------------------------- commit e332ead9965166325188094367ce82021e9c56e3 Author: Alexey Khudyakov Date: Sat Feb 8 00:59:34 2014 +0400 Add parsers for Ints of varaious sizes >--------------------------------------------------------------- e332ead9965166325188094367ce82021e9c56e3 src/Data/Binary/Get.hs | 80 ++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 80 insertions(+) diff --git a/src/Data/Binary/Get.hs b/src/Data/Binary/Get.hs index 626c05c..df817cc 100644 --- a/src/Data/Binary/Get.hs +++ b/src/Data/Binary/Get.hs @@ -189,6 +189,25 @@ module Data.Binary.Get ( , getWord32host , getWord64host + -- ** Decoding words + , getInt8 + + -- *** Big-endian decoding + , getInt16be + , getInt32be + , getInt64be + + -- *** Little-endian decoding + , getInt16le + , getInt32le + , getInt64le + + -- *** Host-endian, unaligned decoding + , getInthost + , getInt16host + , getInt32host + , getInt64host + -- * Deprecated functions , runGetState -- DEPRECATED , remaining -- DEPRECATED @@ -427,6 +446,12 @@ getWord8 :: Get Word8 getWord8 = readN 1 B.unsafeHead {-# INLINE getWord8 #-} +-- | Read Int8 from the monad state +getInt8 :: Get Int8 +getInt8 = fromIntegral <$> getWord8 +{-# INLINE getInt8 #-} + + -- force GHC to inline getWordXX {-# RULES "getWord8/readN" getWord8 = readN 1 B.unsafeHead @@ -520,6 +545,39 @@ word64le = \s -> {-# INLINE getWord64le #-} {-# INLINE word64le #-} + +-- | Read a Int16 in big endian format +getInt16be :: Get Int16 +getInt16be = fromIntegral <$> getWord16be +{-# INLINE getInt16be #-} + +-- | Read a Int16 in big endian format +getInt32be :: Get Int32 +getInt32be = fromIntegral <$> getWord32be +{-# INLINE getInt32be #-} + +-- | Read a Int16 in big endian format +getInt64be :: Get Int64 +getInt64be = fromIntegral <$> getWord64be +{-# INLINE getInt64be #-} + + +-- | Read a Int16 in little endian format +getInt16le :: Get Int16 +getInt16le = fromIntegral <$> getWord16le +{-# INLINE getInt16le #-} + +-- | Read a Int32 in little endian format +getInt32le :: Get Int32 +getInt32le = fromIntegral <$> getWord32le +{-# INLINE getInt32le #-} + +-- | Read a Int64 in little endian format +getInt64le :: Get Int64 +getInt64le = fromIntegral <$> getWord64le +{-# INLINE getInt64le #-} + + ------------------------------------------------------------------------ -- Host-endian reads @@ -545,6 +603,28 @@ getWord64host :: Get Word64 getWord64host = getPtr (sizeOf (undefined :: Word64)) {-# INLINE getWord64host #-} +-- | /O(1)./ Read a single native machine word in native host +-- order. It works in the same way as 'getWordhost'. +getInthost :: Get Int +getInthost = getPtr (sizeOf (undefined :: Int)) +{-# INLINE getInthost #-} + +-- | /O(1)./ Read a 2 byte Int16 in native host order and host endianness. +getInt16host :: Get Int16 +getInt16host = getPtr (sizeOf (undefined :: Int16)) +{-# INLINE getInt16host #-} + +-- | /O(1)./ Read a Int32 in native host order and host endianness. +getInt32host :: Get Int32 +getInt32host = getPtr (sizeOf (undefined :: Int32)) +{-# INLINE getInt32host #-} + +-- | /O(1)./ Read a Int64 in native host order and host endianess. +getInt64host :: Get Int64 +getInt64host = getPtr (sizeOf (undefined :: Int64)) +{-# INLINE getInt64host #-} + + ------------------------------------------------------------------------ -- Unchecked shifts From git at git.haskell.org Tue Feb 2 21:04:40 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Feb 2016 21:04:40 +0000 (UTC) Subject: [commit: packages/binary] master: Turn on more warnings if ghc >= 7.11. (6aafbcf) Message-ID: <20160202210440.7339F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/binary On branch : master Link : http://git.haskell.org/packages/binary.git/commitdiff/6aafbcfda0529380e75269c463182c9cf6d959e8 >--------------------------------------------------------------- commit 6aafbcfda0529380e75269c463182c9cf6d959e8 Author: Lennart Kolmodin Date: Thu Jan 21 11:24:39 2016 +0100 Turn on more warnings if ghc >= 7.11. >--------------------------------------------------------------- 6aafbcfda0529380e75269c463182c9cf6d959e8 binary.cabal | 3 +++ 1 file changed, 3 insertions(+) diff --git a/binary.cabal b/binary.cabal index 7781a03..899fc50 100644 --- a/binary.cabal +++ b/binary.cabal @@ -53,6 +53,9 @@ library ghc-options: -O2 -Wall -fliberate-case-threshold=1000 + if impl(ghc >= 7.11) + ghc-options: -Wcompat -Wnoncanonical-monad-instances + -- Due to circular dependency, we cannot make any of the test-suites or -- benchmark depend on the binary library. Instead, for each test-suite and -- benchmark, we include the source directory of binary and build-depend on all From git at git.haskell.org Tue Feb 2 21:04:41 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Feb 2016 21:04:41 +0000 (UTC) Subject: [commit: packages/binary] master: Add encoders for signed ints (a137fe7) Message-ID: <20160202210441.735BD3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/binary On branch : master Link : http://git.haskell.org/packages/binary.git/commitdiff/a137fe700fe433759291e2e08975aa3a41b2dd5b >--------------------------------------------------------------- commit a137fe700fe433759291e2e08975aa3a41b2dd5b Author: Alexey Khudyakov Date: Sun Feb 9 15:41:57 2014 +0400 Add encoders for signed ints >--------------------------------------------------------------- a137fe700fe433759291e2e08975aa3a41b2dd5b src/Data/Binary/Builder.hs | 10 ++++++ src/Data/Binary/Builder/Base.hs | 77 +++++++++++++++++++++++++++++++++++++++++ src/Data/Binary/Put.hs | 77 +++++++++++++++++++++++++++++++++++++++++ 3 files changed, 164 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 a137fe700fe433759291e2e08975aa3a41b2dd5b From git at git.haskell.org Tue Feb 2 21:04:42 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Feb 2016 21:04:42 +0000 (UTC) Subject: [commit: packages/binary] master: Add arbitrary for Action in Arbitrary instance. (cf1d522) Message-ID: <20160202210442.78D953A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/binary On branch : master Link : http://git.haskell.org/packages/binary.git/commitdiff/cf1d5225e631eed640b2fba6cf1508bc0a4457f3 >--------------------------------------------------------------- commit cf1d5225e631eed640b2fba6cf1508bc0a4457f3 Author: Lennart Kolmodin Date: Fri Jan 22 22:09:25 2016 +0100 Add arbitrary for Action in Arbitrary instance. >--------------------------------------------------------------- cf1d5225e631eed640b2fba6cf1508bc0a4457f3 tests/Action.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/tests/Action.hs b/tests/Action.hs index 2900389..bf20467 100644 --- a/tests/Action.hs +++ b/tests/Action.hs @@ -38,6 +38,7 @@ data Action deriving (Show, Eq) instance Arbitrary Action where + arbitrary = fmap Actions (gen_actions False) shrink action = case action of Actions [a] -> [a] From git at git.haskell.org Tue Feb 2 21:04:43 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Feb 2016 21:04:43 +0000 (UTC) Subject: [commit: packages/binary] master: Add tests for signed ints (16bc21e) Message-ID: <20160202210443.79F9A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/binary On branch : master Link : http://git.haskell.org/packages/binary.git/commitdiff/16bc21e6e765e3719297d39eef23c0ea0e2defad >--------------------------------------------------------------- commit 16bc21e6e765e3719297d39eef23c0ea0e2defad Author: Alexey Khudyakov Date: Sun Feb 9 15:47:06 2014 +0400 Add tests for signed ints >--------------------------------------------------------------- 16bc21e6e765e3719297d39eef23c0ea0e2defad tests/QC.hs | 45 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 45 insertions(+) diff --git a/tests/QC.hs b/tests/QC.hs index d9b2cd8..0b3585d 100644 --- a/tests/QC.hs +++ b/tests/QC.hs @@ -61,6 +61,8 @@ mustThrowError a = unsafePerformIO $ (\(_e :: SomeException) -> return True) -- low level ones: +-- +-- Words prop_Word16be :: Word16 -> Property prop_Word16be = roundTripWith putWord16be getWord16be @@ -92,6 +94,38 @@ prop_Word64host = roundTripWith putWord64host getWord64host prop_Wordhost :: Word -> Property prop_Wordhost = roundTripWith putWordhost getWordhost +-- Ints + +prop_Int16be :: Int16 -> Property +prop_Int16be = roundTripWith putInt16be getInt16be + +prop_Int16le :: Int16 -> Property +prop_Int16le = roundTripWith putInt16le getInt16le + +prop_Int16host :: Int16 -> Property +prop_Int16host = roundTripWith putInt16host getInt16host + +prop_Int32be :: Int32 -> Property +prop_Int32be = roundTripWith putInt32be getInt32be + +prop_Int32le :: Int32 -> Property +prop_Int32le = roundTripWith putInt32le getInt32le + +prop_Int32host :: Int32 -> Property +prop_Int32host = roundTripWith putInt32host getInt32host + +prop_Int64be :: Int64 -> Property +prop_Int64be = roundTripWith putInt64be getInt64be + +prop_Int64le :: Int64 -> Property +prop_Int64le = roundTripWith putInt64le getInt64le + +prop_Int64host :: Int64 -> Property +prop_Int64host = roundTripWith putInt64host getInt64host + +prop_Inthost :: Int -> Property +prop_Inthost = roundTripWith putInthost getInthost + -- done, partial and fail @@ -418,6 +452,17 @@ tests = , testProperty "Word64le" (p prop_Word64le) , testProperty "Word64host" (p prop_Word64host) , testProperty "Wordhost" (p prop_Wordhost) + -- Int + , testProperty "Int16be" (p prop_Int16be) + , testProperty "Int16le" (p prop_Int16le) + , testProperty "Int16host" (p prop_Int16host) + , testProperty "Int32be" (p prop_Int32be) + , testProperty "Int32le" (p prop_Int32le) + , testProperty "Int32host" (p prop_Int32host) + , testProperty "Int64be" (p prop_Int64be) + , testProperty "Int64le" (p prop_Int64le) + , testProperty "Int64host" (p prop_Int64host) + , testProperty "Inthost" (p prop_Inthost) ] , testGroup "String utils" From git at git.haskell.org Tue Feb 2 21:04:44 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Feb 2016 21:04:44 +0000 (UTC) Subject: [commit: packages/binary] master: Support ShortByteStrings. (9fa6234) Message-ID: <20160202210444.806CF3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/binary On branch : master Link : http://git.haskell.org/packages/binary.git/commitdiff/9fa6234c1f7b91d6c32a689bdcf9b40718fa2525 >--------------------------------------------------------------- commit 9fa6234c1f7b91d6c32a689bdcf9b40718fa2525 Author: Alexander Vershilov Date: Sat Jan 23 03:21:13 2016 +0300 Support ShortByteStrings. Implement Binary instance and builders for ShortByteString. >--------------------------------------------------------------- 9fa6234c1f7b91d6c32a689bdcf9b40718fa2525 src/Data/Binary/Builder.hs | 3 +++ src/Data/Binary/Builder/Base.hs | 19 ++++++++++++++++++- src/Data/Binary/Class.hs | 11 +++++++++++ src/Data/Binary/Put.hs | 13 +++++++++++++ tests/Arbitrary.hs | 8 ++++++++ tests/QC.hs | 10 ++++++++++ 6 files changed, 63 insertions(+), 1 deletion(-) diff --git a/src/Data/Binary/Builder.hs b/src/Data/Binary/Builder.hs index 7af1a4b..88e38ed 100644 --- a/src/Data/Binary/Builder.hs +++ b/src/Data/Binary/Builder.hs @@ -28,6 +28,9 @@ module Data.Binary.Builder ( , append , fromByteString -- :: S.ByteString -> Builder , fromLazyByteString -- :: L.ByteString -> Builder +#if MIN_VERSION_bytestring(0,10,4) + , fromShortByteString -- :: T.ByteString -> Builder +#endif -- * Flushing the buffer state , flush diff --git a/src/Data/Binary/Builder/Base.hs b/src/Data/Binary/Builder/Base.hs index 62d286e..169937a 100644 --- a/src/Data/Binary/Builder/Base.hs +++ b/src/Data/Binary/Builder/Base.hs @@ -33,7 +33,9 @@ module Data.Binary.Builder.Base ( , append , fromByteString -- :: S.ByteString -> Builder , fromLazyByteString -- :: L.ByteString -> Builder - +#if MIN_VERSION_bytestring(0,10,4) + , fromShortByteString -- :: T.ByteString -> Builder +#endif -- * Flushing the buffer state , flush @@ -64,6 +66,10 @@ module Data.Binary.Builder.Base ( import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L +#if MIN_VERSION_bytestring(0,10,4) +import qualified Data.ByteString.Short as T +import qualified Data.ByteString.Short.Internal as T +#endif #if MIN_VERSION_base(4,9,0) import Data.Semigroup #else @@ -170,6 +176,17 @@ fromLazyByteString :: L.ByteString -> Builder fromLazyByteString bss = flush `append` mapBuilder (bss `L.append`) {-# INLINE fromLazyByteString #-} +#if MIN_VERSION_bytestring(0,10,4) +-- | /O(n)./ A builder taking 'T.ShortByteString' and copy it to a Builder, +-- satisfying +-- +-- * @'toLazyByteString' ('fromShortByteString' bs) = 'L.fromChunks' ['T.fromShort' bs] +fromShortByteString :: T.ShortByteString -> Builder +fromShortByteString sbs = writeN (T.length sbs) $ \ptr -> + T.copyToPtr sbs 0 ptr (T.length sbs) +{-# INLINE fromShortByteString #-} +#endif + ------------------------------------------------------------------------ -- Our internal buffer type diff --git a/src/Data/Binary/Class.hs b/src/Data/Binary/Class.hs index ebac8b0..f3c2d70 100644 --- a/src/Data/Binary/Class.hs +++ b/src/Data/Binary/Class.hs @@ -73,6 +73,9 @@ import Data.List (unfoldr, foldl') -- And needed for the instances: import qualified Data.ByteString as B +#if MIN_VERSION_bytestring(0,10,4) +import qualified Data.ByteString.Short as BS +#endif import qualified Data.Map as Map import qualified Data.Set as Set import qualified Data.IntMap as IntMap @@ -553,6 +556,14 @@ instance Binary ByteString where putLazyByteString bs get = get >>= getLazyByteString + +#if MIN_VERSION_bytestring(0,10,4) +instance Binary BS.ShortByteString where + put bs = do put (BS.length bs) + putShortByteString bs + get = get >>= fmap BS.toShort . getByteString +#endif + ------------------------------------------------------------------------ -- Maps and Sets diff --git a/src/Data/Binary/Put.hs b/src/Data/Binary/Put.hs index a05bfc7..1858312 100644 --- a/src/Data/Binary/Put.hs +++ b/src/Data/Binary/Put.hs @@ -34,6 +34,9 @@ module Data.Binary.Put ( , putWord8 , putByteString , putLazyByteString +#if MIN_VERSION_bytestring(0,10,4) + , putShortByteString +#endif -- * Big-endian primitives , putWord16be @@ -60,6 +63,9 @@ import qualified Data.Binary.Builder as B import Data.Word import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L +#if MIN_VERSION_bytestring(0,10,4) +import Data.ByteString.Short +#endif import Control.Applicative import Prelude -- Silence AMP warning. @@ -160,6 +166,13 @@ putLazyByteString :: L.ByteString -> Put putLazyByteString = tell . B.fromLazyByteString {-# INLINE putLazyByteString #-} +#if MIN_VERSION_bytestring(0,10,4) +-- | Write 'ShortByteString' to the buffer +putShortByteString :: ShortByteString -> Put +putShortByteString = tell . B.fromShortByteString +{-# INLINE putShortByteString #-} +#endif + -- | Write a Word16 in big endian format putWord16be :: Word16 -> Put putWord16be = tell . B.putWord16be diff --git a/tests/Arbitrary.hs b/tests/Arbitrary.hs index dcb9d44..3d6281f 100644 --- a/tests/Arbitrary.hs +++ b/tests/Arbitrary.hs @@ -7,6 +7,9 @@ import Test.QuickCheck import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as L +#if MIN_VERSION_bytestring(0,10,4) +import qualified Data.ByteString.Short as S +#endif instance Arbitrary L.ByteString where arbitrary = fmap L.fromChunks arbitrary @@ -14,6 +17,11 @@ instance Arbitrary L.ByteString where instance Arbitrary B.ByteString where arbitrary = B.pack `fmap` arbitrary +#if MIN_VERSION_bytestring(0,10,4) +instance Arbitrary S.ShortByteString where + arbitrary = S.toShort `fmap` arbitrary +#endif + instance (Arbitrary a, Arbitrary b, Arbitrary c, Arbitrary d, Arbitrary e, Arbitrary f) => Arbitrary (a,b,c,d,e,f) where diff --git a/tests/QC.hs b/tests/QC.hs index 94348ff..be11864 100644 --- a/tests/QC.hs +++ b/tests/QC.hs @@ -20,6 +20,9 @@ import Control.Monad (unless, liftM2) import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy.Internal as L +#if MIN_VERSION_bytestring(0,10,4) +import Data.ByteString.Short (ShortByteString) +#endif import Data.Int import Data.Ratio import System.IO.Unsafe @@ -559,6 +562,9 @@ tests = , ("B.ByteString", p (test :: T B.ByteString )) , ("L.ByteString", p (test :: T L.ByteString )) +#if MIN_VERSION_bytestring(0,10,4) + , ("ShortByteString", p (test :: T ShortByteString )) +#endif ] , testGroup "Invariants" $ map (uncurry testProperty) @@ -566,6 +572,10 @@ tests = , ("[B.ByteString] invariant", p (prop_invariant :: B [B.ByteString] )) , ("L.ByteString invariant", p (prop_invariant :: B L.ByteString )) , ("[L.ByteString] invariant", p (prop_invariant :: B [L.ByteString] )) +#if MIN_VERSION_bytestring(0,10,4) + , ("ShortByteString invariant", p (prop_invariant :: B ShortByteString )) + , ("[ShortByteString] invariant", p (prop_invariant :: B [ShortByteString] )) +#endif ] #ifdef HAS_FIXED_CONSTRUCTOR , testGroup "Fixed" From git at git.haskell.org Tue Feb 2 21:04:45 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Feb 2016 21:04:45 +0000 (UTC) Subject: [commit: packages/binary] master: Add tests for 8-bt word/ints (f0567f8) Message-ID: <20160202210445.814DB3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/binary On branch : master Link : http://git.haskell.org/packages/binary.git/commitdiff/f0567f8917a3450df8b7abba676a5c1c52dd143c >--------------------------------------------------------------- commit f0567f8917a3450df8b7abba676a5c1c52dd143c Author: Alexey Khudyakov Date: Sun Feb 9 15:53:06 2014 +0400 Add tests for 8-bt word/ints >--------------------------------------------------------------- f0567f8917a3450df8b7abba676a5c1c52dd143c tests/QC.hs | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/tests/QC.hs b/tests/QC.hs index 0b3585d..ff4d37c 100644 --- a/tests/QC.hs +++ b/tests/QC.hs @@ -64,6 +64,9 @@ mustThrowError a = unsafePerformIO $ -- -- Words +prop_Word8 :: Word8 -> Property +prop_Word8 = roundTripWith putWord8 getWord8 + prop_Word16be :: Word16 -> Property prop_Word16be = roundTripWith putWord16be getWord16be @@ -96,6 +99,9 @@ prop_Wordhost = roundTripWith putWordhost getWordhost -- Ints +prop_Int8 :: Int8 -> Property +prop_Int8 = roundTripWith putInt8 getInt8 + prop_Int16be :: Int16 -> Property prop_Int16be = roundTripWith putInt16be getInt16be @@ -442,7 +448,8 @@ tests = ] , testGroup "Primitives" - [ testProperty "Word16be" (p prop_Word16be) + [ testProperty "Word8" (p prop_Word8) + , testProperty "Word16be" (p prop_Word16be) , testProperty "Word16le" (p prop_Word16le) , testProperty "Word16host" (p prop_Word16host) , testProperty "Word32be" (p prop_Word32be) @@ -453,6 +460,7 @@ tests = , testProperty "Word64host" (p prop_Word64host) , testProperty "Wordhost" (p prop_Wordhost) -- Int + , testProperty "Int8" (p prop_Int8) , testProperty "Int16be" (p prop_Int16be) , testProperty "Int16le" (p prop_Int16le) , testProperty "Int16host" (p prop_Int16host) From git at git.haskell.org Tue Feb 2 21:04:46 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Feb 2016 21:04:46 +0000 (UTC) Subject: [commit: packages/binary] master: Merge remote-tracking branch 'qnikst/bytestring-short' (52b8199) Message-ID: <20160202210446.883733A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/binary On branch : master Link : http://git.haskell.org/packages/binary.git/commitdiff/52b8199f4f06c56f66fbde9740d49a4488cc90dd >--------------------------------------------------------------- commit 52b8199f4f06c56f66fbde9740d49a4488cc90dd Merge: cf1d522 9fa6234 Author: Lennart Kolmodin Date: Mon Jan 25 22:14:01 2016 +0100 Merge remote-tracking branch 'qnikst/bytestring-short' >--------------------------------------------------------------- 52b8199f4f06c56f66fbde9740d49a4488cc90dd src/Data/Binary/Builder.hs | 3 +++ src/Data/Binary/Builder/Base.hs | 19 ++++++++++++++++++- src/Data/Binary/Class.hs | 11 +++++++++++ src/Data/Binary/Put.hs | 13 +++++++++++++ tests/Arbitrary.hs | 8 ++++++++ tests/QC.hs | 10 ++++++++++ 6 files changed, 63 insertions(+), 1 deletion(-) From git at git.haskell.org Tue Feb 2 21:04:47 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Feb 2016 21:04:47 +0000 (UTC) Subject: [commit: packages/binary] master: Fix documentation (03332c4) Message-ID: <20160202210447.88F383A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/binary On branch : master Link : http://git.haskell.org/packages/binary.git/commitdiff/03332c4784cda1ce5015092c8b13fab5dbd22e89 >--------------------------------------------------------------- commit 03332c4784cda1ce5015092c8b13fab5dbd22e89 Author: Alexey Khudyakov Date: Thu Nov 12 13:40:58 2015 +0300 Fix documentation >--------------------------------------------------------------- 03332c4784cda1ce5015092c8b13fab5dbd22e89 src/Data/Binary/Get.hs | 18 +++++++++--------- src/Data/Binary/Put.hs | 18 +++++++++--------- 2 files changed, 18 insertions(+), 18 deletions(-) diff --git a/src/Data/Binary/Get.hs b/src/Data/Binary/Get.hs index df817cc..438fd13 100644 --- a/src/Data/Binary/Get.hs +++ b/src/Data/Binary/Get.hs @@ -446,7 +446,7 @@ getWord8 :: Get Word8 getWord8 = readN 1 B.unsafeHead {-# INLINE getWord8 #-} --- | Read Int8 from the monad state +-- | Read an Int8 from the monad state getInt8 :: Get Int8 getInt8 = fromIntegral <$> getWord8 {-# INLINE getInt8 #-} @@ -546,33 +546,33 @@ word64le = \s -> {-# INLINE word64le #-} --- | Read a Int16 in big endian format +-- | Read an Int16 in big endian format getInt16be :: Get Int16 getInt16be = fromIntegral <$> getWord16be {-# INLINE getInt16be #-} --- | Read a Int16 in big endian format +-- | Read an Int32 in big endian format getInt32be :: Get Int32 getInt32be = fromIntegral <$> getWord32be {-# INLINE getInt32be #-} --- | Read a Int16 in big endian format +-- | Read an Int64 in big endian format getInt64be :: Get Int64 getInt64be = fromIntegral <$> getWord64be {-# INLINE getInt64be #-} --- | Read a Int16 in little endian format +-- | Read an Int16 in little endian format getInt16le :: Get Int16 getInt16le = fromIntegral <$> getWord16le {-# INLINE getInt16le #-} --- | Read a Int32 in little endian format +-- | Read an Int32 in little endian format getInt32le :: Get Int32 getInt32le = fromIntegral <$> getWord32le {-# INLINE getInt32le #-} --- | Read a Int64 in little endian format +-- | Read an Int64 in little endian format getInt64le :: Get Int64 getInt64le = fromIntegral <$> getWord64le {-# INLINE getInt64le #-} @@ -614,12 +614,12 @@ getInt16host :: Get Int16 getInt16host = getPtr (sizeOf (undefined :: Int16)) {-# INLINE getInt16host #-} --- | /O(1)./ Read a Int32 in native host order and host endianness. +-- | /O(1)./ Read an Int32 in native host order and host endianness. getInt32host :: Get Int32 getInt32host = getPtr (sizeOf (undefined :: Int32)) {-# INLINE getInt32host #-} --- | /O(1)./ Read a Int64 in native host order and host endianess. +-- | /O(1)./ Read an Int64 in native host order and host endianess. getInt64host :: Get Int64 getInt64host = getPtr (sizeOf (undefined :: Int64)) {-# INLINE getInt64host #-} diff --git a/src/Data/Binary/Put.hs b/src/Data/Binary/Put.hs index c522940..7fd5986 100644 --- a/src/Data/Binary/Put.hs +++ b/src/Data/Binary/Put.hs @@ -201,32 +201,32 @@ putWord64le :: Word64 -> Put putWord64le = tell . B.putWord64le {-# INLINE putWord64le #-} --- | Write a Int16 in big endian format +-- | Write an Int16 in big endian format putInt16be :: Int16 -> Put putInt16be = tell . B.putInt16be {-# INLINE putInt16be #-} --- | Write a Int16 in little endian format +-- | Write an Int16 in little endian format putInt16le :: Int16 -> Put putInt16le = tell . B.putInt16le {-# INLINE putInt16le #-} --- | Write a Int32 in big endian format +-- | Write an Int32 in big endian format putInt32be :: Int32 -> Put putInt32be = tell . B.putInt32be {-# INLINE putInt32be #-} --- | Write a Int32 in little endian format +-- | Write an Int32 in little endian format putInt32le :: Int32 -> Put putInt32le = tell . B.putInt32le {-# INLINE putInt32le #-} --- | Write a Int64 in big endian format +-- | Write an Int64 in big endian format putInt64be :: Int64 -> Put putInt64be = tell . B.putInt64be {-# INLINE putInt64be #-} --- | Write a Int64 in little endian format +-- | Write an Int64 in little endian format putInt64le :: Int64 -> Put putInt64le = tell . B.putInt64le {-# INLINE putInt64le #-} @@ -273,19 +273,19 @@ putInthost :: Int -> Put putInthost = tell . B.putInthost {-# INLINE putInthost #-} --- | /O(1)./ Write a Int16 in native host order and host endianness. +-- | /O(1)./ Write an Int16 in native host order and host endianness. -- For portability issues see @putInthost at . putInt16host :: Int16 -> Put putInt16host = tell . B.putInt16host {-# INLINE putInt16host #-} --- | /O(1)./ Write a Int32 in native host order and host endianness. +-- | /O(1)./ Write an Int32 in native host order and host endianness. -- For portability issues see @putInthost at . putInt32host :: Int32 -> Put putInt32host = tell . B.putInt32host {-# INLINE putInt32host #-} --- | /O(1)./ Write a Int64 in native host order +-- | /O(1)./ Write an Int64 in native host order -- On a 32 bit machine we write two host order Int32s, in big endian form. -- For portability issues see @putInthost at . putInt64host :: Int64 -> Put From git at git.haskell.org Tue Feb 2 21:04:48 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Feb 2016 21:04:48 +0000 (UTC) Subject: [commit: packages/binary] master: Update changelog. (fa80322) Message-ID: <20160202210448.8FECA3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/binary On branch : master Link : http://git.haskell.org/packages/binary.git/commitdiff/fa803227ffa6a2e406de304494d069e98c29d3e2 >--------------------------------------------------------------- commit fa803227ffa6a2e406de304494d069e98c29d3e2 Author: Lennart Kolmodin Date: Mon Jan 25 22:15:17 2016 +0100 Update changelog. >--------------------------------------------------------------- fa803227ffa6a2e406de304494d069e98c29d3e2 changelog.md | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/changelog.md b/changelog.md index 69fde96..08e0557 100644 --- a/changelog.md +++ b/changelog.md @@ -1,6 +1,11 @@ binary ====== +binary-0.9.0.0 +-------------- + +- Add binary instance for `Data.ByteString.Short`. + binary-0.8.0.1 -------------- From git at git.haskell.org Tue Feb 2 21:04:49 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Feb 2016 21:04:49 +0000 (UTC) Subject: [commit: packages/binary] master: Merge branch 'master' into signed-int (7c4fe52) Message-ID: <20160202210449.95F473A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/binary On branch : master Link : http://git.haskell.org/packages/binary.git/commitdiff/7c4fe524ff5fd4b214214ae743e3575988c0ffd2 >--------------------------------------------------------------- commit 7c4fe524ff5fd4b214214ae743e3575988c0ffd2 Merge: 03332c4 8429d6b Author: Alexey Khudyakov Date: Sun Nov 15 18:42:53 2015 +0300 Merge branch 'master' into signed-int >--------------------------------------------------------------- 7c4fe524ff5fd4b214214ae743e3575988c0ffd2 .gitignore | 2 + .hgignore | 2 + .travis.yml | 55 ++++++ README.md | 53 ++--- benchmarks/Builder.hs | 15 +- benchmarks/GenericsBench.hs | 52 +++++ benchmarks/GenericsBenchCache.hs | 89 +++++++++ benchmarks/GenericsBenchTypes.hs | 46 +++++ benchmarks/Get.hs | 277 +++++++++++++++----------- benchmarks/Makefile | 34 ---- binary.cabal | 79 +++++--- changelog.md | 113 +++++++++++ index.html | 161 ---------------- src/Data/Binary.hs | 4 + src/Data/Binary/Builder/Base.hs | 8 +- src/Data/Binary/Builder/Internal.hs | 2 +- src/Data/Binary/Class.hs | 121 ++++++++++-- src/Data/Binary/Generic.hs | 12 +- src/Data/Binary/Get.hs | 87 ++++----- src/Data/Binary/Get/Internal.hs | 135 ++++++++++--- src/Data/Binary/Put.hs | 5 +- tests/Action.hs | 375 ++++++++++++++++++++++++++++-------- tests/Arbitrary.hs | 1 + tests/File.hs | 18 +- tests/Makefile | 20 -- tests/QC.hs | 131 ++++++++----- 26 files changed, 1267 insertions(+), 630 deletions(-) diff --cc src/Data/Binary/Get.hs index 438fd13,de1a326..db96a97 --- a/src/Data/Binary/Get.hs +++ b/src/Data/Binary/Get.hs @@@ -444,14 -411,8 +430,14 @@@ getPtr n = readNWith n pee -- | Read a Word8 from the monad state getWord8 :: Get Word8 getWord8 = readN 1 B.unsafeHead - {-# INLINE getWord8 #-} + {-# INLINE[2] getWord8 #-} +-- | Read an Int8 from the monad state +getInt8 :: Get Int8 +getInt8 = fromIntegral <$> getWord8 +{-# INLINE getInt8 #-} + + -- force GHC to inline getWordXX {-# RULES "getWord8/readN" getWord8 = readN 1 B.unsafeHead @@@ -542,42 -502,9 +527,42 @@@ word64le = \s - (fromIntegral (s `B.unsafeIndex` 2) `shiftl_w64` 16) .|. (fromIntegral (s `B.unsafeIndex` 1) `shiftl_w64` 8) .|. (fromIntegral (s `B.unsafeIndex` 0) ) - {-# INLINE getWord64le #-} + {-# INLINE[2] getWord64le #-} {-# INLINE word64le #-} + +-- | Read an Int16 in big endian format +getInt16be :: Get Int16 +getInt16be = fromIntegral <$> getWord16be +{-# INLINE getInt16be #-} + +-- | Read an Int32 in big endian format +getInt32be :: Get Int32 +getInt32be = fromIntegral <$> getWord32be +{-# INLINE getInt32be #-} + +-- | Read an Int64 in big endian format +getInt64be :: Get Int64 +getInt64be = fromIntegral <$> getWord64be +{-# INLINE getInt64be #-} + + +-- | Read an Int16 in little endian format +getInt16le :: Get Int16 +getInt16le = fromIntegral <$> getWord16le +{-# INLINE getInt16le #-} + +-- | Read an Int32 in little endian format +getInt32le :: Get Int32 +getInt32le = fromIntegral <$> getWord32le +{-# INLINE getInt32le #-} + +-- | Read an Int64 in little endian format +getInt64le :: Get Int64 +getInt64le = fromIntegral <$> getWord64le +{-# INLINE getInt64le #-} + + ------------------------------------------------------------------------ -- Host-endian reads diff --cc tests/QC.hs index ff4d37c,493d2aa..414d6f9 --- a/tests/QC.hs +++ b/tests/QC.hs @@@ -444,12 -433,10 +473,11 @@@ tests ] , testGroup "Model" - [ testProperty "action" Action.prop_action - ] + Action.tests , testGroup "Primitives" - [ testProperty "Word16be" (p prop_Word16be) + [ testProperty "Word8" (p prop_Word8) + , testProperty "Word16be" (p prop_Word16be) , testProperty "Word16le" (p prop_Word16le) , testProperty "Word16host" (p prop_Word16host) , testProperty "Word32be" (p prop_Word32be) From git at git.haskell.org Tue Feb 2 21:04:50 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Feb 2016 21:04:50 +0000 (UTC) Subject: [commit: packages/binary] master: Merge remote-tracking branch 'shimuuar/signed-int' (0be40eb) Message-ID: <20160202210450.9762D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/binary On branch : master Link : http://git.haskell.org/packages/binary.git/commitdiff/0be40ebae1c8146ee592ada06abcb2c1a0d068dd >--------------------------------------------------------------- commit 0be40ebae1c8146ee592ada06abcb2c1a0d068dd Merge: fa80322 cbc3e2d Author: Lennart Kolmodin Date: Tue Jan 26 18:45:56 2016 +0100 Merge remote-tracking branch 'shimuuar/signed-int' >--------------------------------------------------------------- 0be40ebae1c8146ee592ada06abcb2c1a0d068dd src/Data/Binary/Builder.hs | 10 +++++ src/Data/Binary/Builder/Base.hs | 77 ++++++++++++++++++++++++++++++++++++++ src/Data/Binary/Get.hs | 83 +++++++++++++++++++++++++++++++++++++++++ src/Data/Binary/Put.hs | 77 ++++++++++++++++++++++++++++++++++++++ tests/QC.hs | 55 ++++++++++++++++++++++++++- 5 files changed, 301 insertions(+), 1 deletion(-) diff --cc src/Data/Binary/Put.hs index 1858312,9bb26f7..83ec710 --- a/src/Data/Binary/Put.hs +++ b/src/Data/Binary/Put.hs @@@ -32,11 -32,9 +32,12 @@@ module Data.Binary.Put -- * Primitives , putWord8 + , putInt8 , putByteString , putLazyByteString +#if MIN_VERSION_bytestring(0,10,4) + , putShortByteString +#endif -- * Big-endian primitives , putWord16be From git at git.haskell.org Tue Feb 2 21:04:51 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Feb 2016 21:04:51 +0000 (UTC) Subject: [commit: packages/binary] master: Import Control.Applicative for older GHC (cbc3e2d) Message-ID: <20160202210451.9CDE13A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/binary On branch : master Link : http://git.haskell.org/packages/binary.git/commitdiff/cbc3e2d602684b1d1906f7bc3858db0f27d77af2 >--------------------------------------------------------------- commit cbc3e2d602684b1d1906f7bc3858db0f27d77af2 Author: Alexey Khudyakov Date: Sun Nov 15 18:45:47 2015 +0300 Import Control.Applicative for older GHC >--------------------------------------------------------------- cbc3e2d602684b1d1906f7bc3858db0f27d77af2 src/Data/Binary/Get.hs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/Data/Binary/Get.hs b/src/Data/Binary/Get.hs index db96a97..afc391b 100644 --- a/src/Data/Binary/Get.hs +++ b/src/Data/Binary/Get.hs @@ -215,6 +215,9 @@ module Data.Binary.Get ( , remaining -- DEPRECATED , getBytes -- DEPRECATED ) where +#if ! MIN_VERSION_base(4,8,0) +import Control.Applicative +#endif import Foreign import qualified Data.ByteString as B From git at git.haskell.org Tue Feb 2 21:04:52 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Feb 2016 21:04:52 +0000 (UTC) Subject: [commit: packages/binary] master: Documentation fix. (3bb4123) Message-ID: <20160202210452.9D5E43A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/binary On branch : master Link : http://git.haskell.org/packages/binary.git/commitdiff/3bb4123408608c47f5ae185f8e49e0803fb26ed2 >--------------------------------------------------------------- commit 3bb4123408608c47f5ae185f8e49e0803fb26ed2 Author: Lennart Kolmodin Date: Tue Jan 26 18:46:34 2016 +0100 Documentation fix. >--------------------------------------------------------------- 3bb4123408608c47f5ae185f8e49e0803fb26ed2 src/Data/Binary/Get.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Data/Binary/Get.hs b/src/Data/Binary/Get.hs index c098214..3e891e4 100644 --- a/src/Data/Binary/Get.hs +++ b/src/Data/Binary/Get.hs @@ -169,7 +169,7 @@ module Data.Binary.Get ( , getLazyByteStringNul , getRemainingLazyByteString - -- ** Decoding words + -- ** Decoding Words , getWord8 -- *** Big-endian decoding @@ -188,7 +188,7 @@ module Data.Binary.Get ( , getWord32host , getWord64host - -- ** Decoding words + -- ** Decoding Ints , getInt8 -- *** Big-endian decoding From git at git.haskell.org Tue Feb 2 21:04:53 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Feb 2016 21:04:53 +0000 (UTC) Subject: [commit: packages/binary] master: Clean up old CPP code. (ff7239c) Message-ID: <20160202210453.A35133A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/binary On branch : master Link : http://git.haskell.org/packages/binary.git/commitdiff/ff7239caa218d389869b3d09f8bcfd3feec6e9ab >--------------------------------------------------------------- commit ff7239caa218d389869b3d09f8bcfd3feec6e9ab Author: Lennart Kolmodin Date: Sun Dec 20 23:08:11 2015 +0100 Clean up old CPP code. >--------------------------------------------------------------- ff7239caa218d389869b3d09f8bcfd3feec6e9ab src/Data/Binary/Builder/Base.hs | 6 ------ 1 file changed, 6 deletions(-) diff --git a/src/Data/Binary/Builder/Base.hs b/src/Data/Binary/Builder/Base.hs index 5480dd0..ade8de7 100644 --- a/src/Data/Binary/Builder/Base.hs +++ b/src/Data/Binary/Builder/Base.hs @@ -74,15 +74,9 @@ import Foreign import System.IO.Unsafe as IO ( unsafePerformIO ) -#ifdef BYTESTRING_IN_BASE -import Data.ByteString.Base (inlinePerformIO) -import qualified Data.ByteString.Base as S -import qualified Data.ByteString.Lazy.Base as L -#else import Data.ByteString.Internal (inlinePerformIO) import qualified Data.ByteString.Internal as S import qualified Data.ByteString.Lazy.Internal as L -#endif #if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__) import GHC.Base (ord,Int(..),uncheckedShiftRL#) From git at git.haskell.org Tue Feb 2 21:04:54 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Feb 2016 21:04:54 +0000 (UTC) Subject: [commit: packages/binary] master: Update changelog.md. (c363a51) Message-ID: <20160202210454.A3FA83A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/binary On branch : master Link : http://git.haskell.org/packages/binary.git/commitdiff/c363a514127b688058bca08b2cd4bbd21bde6155 >--------------------------------------------------------------- commit c363a514127b688058bca08b2cd4bbd21bde6155 Author: Lennart Kolmodin Date: Tue Jan 26 18:53:50 2016 +0100 Update changelog.md. >--------------------------------------------------------------- c363a514127b688058bca08b2cd4bbd21bde6155 changelog.md | 1 + 1 file changed, 1 insertion(+) diff --git a/changelog.md b/changelog.md index 08e0557..2f02205 100644 --- a/changelog.md +++ b/changelog.md @@ -5,6 +5,7 @@ binary-0.9.0.0 -------------- - Add binary instance for `Data.ByteString.Short`. +- Add get/put functions for all Int sizes to `Data.Binary.Builder`, `Data.Binary.Get` and `Data.Binary.Put`. binary-0.8.0.1 -------------- From git at git.haskell.org Tue Feb 2 21:04:55 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Feb 2016 21:04:55 +0000 (UTC) Subject: [commit: packages/binary] master: Use accursedUnutterablePerformIO rather than inlinePerformIO. (37983d3) Message-ID: <20160202210455.AB4E83A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/binary On branch : master Link : http://git.haskell.org/packages/binary.git/commitdiff/37983d3eeeed7e332a4931cda066becded3b4fe6 >--------------------------------------------------------------- commit 37983d3eeeed7e332a4931cda066becded3b4fe6 Author: Lennart Kolmodin Date: Sun Dec 20 23:29:38 2015 +0100 Use accursedUnutterablePerformIO rather than inlinePerformIO. Let's share the address space with a malevolent agent of chaos. >--------------------------------------------------------------- 37983d3eeeed7e332a4931cda066becded3b4fe6 binary.cabal | 3 ++- src/Data/Binary/Builder/Base.hs | 4 ++-- src/Data/Binary/Get/Internal.hs | 5 +++-- src/Data/Binary/Internal.hs | 15 +++++++++++++++ 4 files changed, 22 insertions(+), 5 deletions(-) diff --git a/binary.cabal b/binary.cabal index 25c7c7c..f772d27 100644 --- a/binary.cabal +++ b/binary.cabal @@ -41,7 +41,8 @@ library Data.Binary.Builder.Internal other-modules: Data.Binary.Builder.Base, - Data.Binary.Class + Data.Binary.Class, + Data.Binary.Internal if impl(ghc >= 7.2.1) cpp-options: -DGENERICS diff --git a/src/Data/Binary/Builder/Base.hs b/src/Data/Binary/Builder/Base.hs index ade8de7..1b1c0b1 100644 --- a/src/Data/Binary/Builder/Base.hs +++ b/src/Data/Binary/Builder/Base.hs @@ -74,7 +74,7 @@ import Foreign import System.IO.Unsafe as IO ( unsafePerformIO ) -import Data.ByteString.Internal (inlinePerformIO) +import Data.Binary.Internal ( accursedUnutterablePerformIO ) import qualified Data.ByteString.Internal as S import qualified Data.ByteString.Lazy.Internal as L @@ -198,7 +198,7 @@ flush = Builder $ \ k buf@(Buffer p o u l) -> then k buf else let !b = Buffer p (o+u) 0 l !bs = S.PS p o u - in return $! L.Chunk bs (inlinePerformIO (k b)) + in return $! L.Chunk bs (accursedUnutterablePerformIO (k b)) {-# INLINE [0] flush #-} ------------------------------------------------------------------------ diff --git a/src/Data/Binary/Get/Internal.hs b/src/Data/Binary/Get/Internal.hs index 74e8eba..9dcd22c 100644 --- a/src/Data/Binary/Get/Internal.hs +++ b/src/Data/Binary/Get/Internal.hs @@ -44,12 +44,13 @@ module Data.Binary.Get.Internal ( import Foreign import qualified Data.ByteString as B -import qualified Data.ByteString.Internal as B import qualified Data.ByteString.Unsafe as B import Control.Applicative import Control.Monad +import Data.Binary.Internal ( accursedUnutterablePerformIO ) + #if __GLASGOW_HASKELL__ < 704 && !defined(__HADDOCK__) -- needed for (# unboxing #) with magic hash -- Do we still need these? Works without on modern GHCs. @@ -415,5 +416,5 @@ unsafeReadN !n f = C $ \inp ks -> do readNWith :: Int -> (Ptr a -> IO a) -> Get a readNWith n f = do - readN n $ \s -> B.inlinePerformIO $ B.unsafeUseAsCString s (f . castPtr) + readN n $ \s -> accursedUnutterablePerformIO $ B.unsafeUseAsCString s (f . castPtr) {-# INLINE readNWith #-} diff --git a/src/Data/Binary/Internal.hs b/src/Data/Binary/Internal.hs new file mode 100644 index 0000000..d04b728 --- /dev/null +++ b/src/Data/Binary/Internal.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE CPP #-} + +module Data.Binary.Internal + ( accursedUnutterablePerformIO ) where + +#if MIN_VERSION_bytestring(0,10,6) +import Data.ByteString.Internal( accursedUnutterablePerformIO ) +#else +import Data.ByteString.Internal( inlinePerformIO ) + +{-# INLINE accursedUnutterablePerformIO #-} +-- | You must be truly desperate to come to me for help. +accursedUnutterablePerformIO :: IO a -> a +accursedUnutterablePerformIO = inlinePerformIO +#endif From git at git.haskell.org Tue Feb 2 21:04:56 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Feb 2016 21:04:56 +0000 (UTC) Subject: [commit: packages/binary] master: Use getIntX/putIntX in the Binary class instances. (8b1459e) Message-ID: <20160202210456.AAD5C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/binary On branch : master Link : http://git.haskell.org/packages/binary.git/commitdiff/8b1459ed8033e72b6ef243649adf71c8d4909f33 >--------------------------------------------------------------- commit 8b1459ed8033e72b6ef243649adf71c8d4909f33 Author: Lennart Kolmodin Date: Tue Jan 26 20:23:34 2016 +0100 Use getIntX/putIntX in the Binary class instances. >--------------------------------------------------------------- 8b1459ed8033e72b6ef243649adf71c8d4909f33 src/Data/Binary/Class.hs | 24 ++++++++++++------------ 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/src/Data/Binary/Class.hs b/src/Data/Binary/Class.hs index f3c2d70..0eecfcb 100644 --- a/src/Data/Binary/Class.hs +++ b/src/Data/Binary/Class.hs @@ -209,35 +209,35 @@ instance Binary Word64 where -- Int8s are written as a single byte. instance Binary Int8 where - put i = put (fromIntegral i :: Word8) - get = liftM fromIntegral (get :: Get Word8) + put = putInt8 + get = getInt8 -- Int16s are written as a 2 bytes in big endian format instance Binary Int16 where - put i = put (fromIntegral i :: Word16) - get = liftM fromIntegral (get :: Get Word16) + put = putInt16be + get = getInt16be -- Int32s are written as a 4 bytes in big endian format instance Binary Int32 where - put i = put (fromIntegral i :: Word32) - get = liftM fromIntegral (get :: Get Word32) + put = putInt32be + get = getInt32be -- Int64s are written as a 8 bytes in big endian format instance Binary Int64 where - put i = put (fromIntegral i :: Word64) - get = liftM fromIntegral (get :: Get Word64) + put = putInt64be + get = getInt64be ------------------------------------------------------------------------ -- Words are are written as Word64s, that is, 8 bytes in big endian format instance Binary Word where - put i = put (fromIntegral i :: Word64) - get = liftM fromIntegral (get :: Get Word64) + put = putWord64be . fromIntegral + get = liftM fromIntegral getWord64be -- Ints are are written as Int64s, that is, 8 bytes in big endian format instance Binary Int where - put i = put (fromIntegral i :: Int64) - get = liftM fromIntegral (get :: Get Int64) + put = putInt64be . fromIntegral + get = liftM fromIntegral getInt64be ------------------------------------------------------------------------ -- From git at git.haskell.org Tue Feb 2 21:04:57 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Feb 2016 21:04:57 +0000 (UTC) Subject: [commit: packages/binary] master: Add @dcoutts's comments regarding accursedUnutterablePerformIO. (ad6e2a2) Message-ID: <20160202210457.B2C0D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/binary On branch : master Link : http://git.haskell.org/packages/binary.git/commitdiff/ad6e2a2d507b11ef8e6d0d08e76cf7d11dbce51d >--------------------------------------------------------------- commit ad6e2a2d507b11ef8e6d0d08e76cf7d11dbce51d Author: Lennart Kolmodin Date: Mon Jan 18 23:15:55 2016 +0100 Add @dcoutts's comments regarding accursedUnutterablePerformIO. >--------------------------------------------------------------- ad6e2a2d507b11ef8e6d0d08e76cf7d11dbce51d src/Data/Binary/Builder/Base.hs | 5 +++++ src/Data/Binary/Get/Internal.hs | 4 ++++ 2 files changed, 9 insertions(+) diff --git a/src/Data/Binary/Builder/Base.hs b/src/Data/Binary/Builder/Base.hs index 1b1c0b1..62d286e 100644 --- a/src/Data/Binary/Builder/Base.hs +++ b/src/Data/Binary/Builder/Base.hs @@ -198,6 +198,11 @@ flush = Builder $ \ k buf@(Buffer p o u l) -> then k buf else let !b = Buffer p (o+u) 0 l !bs = S.PS p o u + -- It should be safe to use accursedUnutterablePerformIO here. + -- The place in the buffer where we write is determined by the 'b' + -- value, and writes should be deterministic. The thunk should not + -- be floated out and shared since the buffer references the + -- incoming foreign ptr. in return $! L.Chunk bs (accursedUnutterablePerformIO (k b)) {-# INLINE [0] flush #-} diff --git a/src/Data/Binary/Get/Internal.hs b/src/Data/Binary/Get/Internal.hs index 9dcd22c..10e372f 100644 --- a/src/Data/Binary/Get/Internal.hs +++ b/src/Data/Binary/Get/Internal.hs @@ -414,7 +414,11 @@ unsafeReadN :: Int -> (B.ByteString -> a) -> Get a unsafeReadN !n f = C $ \inp ks -> do ks (B.unsafeDrop n inp) $! f inp -- strict return +-- | @readNWith n f@ where @f@ must be deterministic and not have side effects. readNWith :: Int -> (Ptr a -> IO a) -> Get a readNWith n f = do + -- It should be safe to use accursedUnutterablePerformIO here. + -- The action must be deterministic and not have any external side effects. + -- It depends on the value of the ByteString so the value dependencies look OK. readN n $ \s -> accursedUnutterablePerformIO $ B.unsafeUseAsCString s (f . castPtr) {-# INLINE readNWith #-} From git at git.haskell.org Tue Feb 2 21:04:58 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Feb 2016 21:04:58 +0000 (UTC) Subject: [commit: packages/binary] master: Change next version to be 0.8.1.0 (13820f4) Message-ID: <20160202210458.B1D343A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/binary On branch : master Link : http://git.haskell.org/packages/binary.git/commitdiff/13820f4550d7c2c23cdad970f55c4133a9a3cebf >--------------------------------------------------------------- commit 13820f4550d7c2c23cdad970f55c4133a9a3cebf Author: Lennart Kolmodin Date: Tue Feb 2 20:55:25 2016 +0100 Change next version to be 0.8.1.0 PVP said 0.9.0.0 was not required. >--------------------------------------------------------------- 13820f4550d7c2c23cdad970f55c4133a9a3cebf binary.cabal | 2 +- changelog.md | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/binary.cabal b/binary.cabal index 899fc50..477f933 100644 --- a/binary.cabal +++ b/binary.cabal @@ -1,5 +1,5 @@ name: binary -version: 0.8.0.1 +version: 0.8.1.0 license: BSD3 license-file: LICENSE author: Lennart Kolmodin diff --git a/changelog.md b/changelog.md index 2f02205..e5c0eb6 100644 --- a/changelog.md +++ b/changelog.md @@ -1,7 +1,7 @@ binary ====== -binary-0.9.0.0 +binary-0.8.1.0 -------------- - Add binary instance for `Data.ByteString.Short`. From git at git.haskell.org Tue Feb 2 21:05:00 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Feb 2016 21:05:00 +0000 (UTC) Subject: [commit: packages/binary] master: Define MonadFail instance for Get Monad (a9df926) Message-ID: <20160202210500.B86083A301@ghc.haskell.org> Repository : ssh://git at git.haskell.org/binary On branch : master Link : http://git.haskell.org/packages/binary.git/commitdiff/a9df926504a66b8059783727956929b6643dc9fc >--------------------------------------------------------------- commit a9df926504a66b8059783727956929b6643dc9fc Author: Herbert Valerio Riedel Date: Tue Feb 2 21:20:00 2016 +0100 Define MonadFail instance for Get Monad >--------------------------------------------------------------- a9df926504a66b8059783727956929b6643dc9fc binary.cabal | 4 ++-- src/Data/Binary/Get/Internal.hs | 8 ++++++++ 2 files changed, 10 insertions(+), 2 deletions(-) diff --git a/binary.cabal b/binary.cabal index 477f933..a5eeb9c 100644 --- a/binary.cabal +++ b/binary.cabal @@ -53,8 +53,8 @@ library ghc-options: -O2 -Wall -fliberate-case-threshold=1000 - if impl(ghc >= 7.11) - ghc-options: -Wcompat -Wnoncanonical-monad-instances + if impl(ghc >= 8.0) + ghc-options: -Wcompat -Wnoncanonical-monad-instances -Wnoncanonical-monadfail-instances -- Due to circular dependency, we cannot make any of the test-suites or -- benchmark depend on the binary library. Instead, for each test-suite and diff --git a/src/Data/Binary/Get/Internal.hs b/src/Data/Binary/Get/Internal.hs index 10e372f..944a2ce 100644 --- a/src/Data/Binary/Get/Internal.hs +++ b/src/Data/Binary/Get/Internal.hs @@ -48,6 +48,9 @@ import qualified Data.ByteString.Unsafe as B import Control.Applicative import Control.Monad +#if MIN_VERSION_base(4,9,0) +import qualified Control.Monad.Fail as Fail +#endif import Data.Binary.Internal ( accursedUnutterablePerformIO ) @@ -94,6 +97,11 @@ type Success a r = B.ByteString -> a -> Decoder r instance Monad Get where return = pure (>>=) = bindG +#if MIN_VERSION_base(4,9,0) + fail = Fail.fail + +instance Fail.MonadFail Get where +#endif fail = failG bindG :: Get a -> (a -> Get b) -> Get b From git at git.haskell.org Tue Feb 2 21:05:01 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Feb 2016 21:05:01 +0000 (UTC) Subject: [commit: packages/binary] master: Turn on more warnings if ghc >= 7.11. (6aafbcf) Message-ID: <20160202210501.C0BE63A301@ghc.haskell.org> Repository : ssh://git at git.haskell.org/binary On branch : master Link : http://git.haskell.org/packages/binary.git/commitdiff/6aafbcfda0529380e75269c463182c9cf6d959e8 >--------------------------------------------------------------- commit 6aafbcfda0529380e75269c463182c9cf6d959e8 Author: Lennart Kolmodin Date: Thu Jan 21 11:24:39 2016 +0100 Turn on more warnings if ghc >= 7.11. >--------------------------------------------------------------- 6aafbcfda0529380e75269c463182c9cf6d959e8 binary.cabal | 3 +++ 1 file changed, 3 insertions(+) diff --git a/binary.cabal b/binary.cabal index 7781a03..899fc50 100644 --- a/binary.cabal +++ b/binary.cabal @@ -53,6 +53,9 @@ library ghc-options: -O2 -Wall -fliberate-case-threshold=1000 + if impl(ghc >= 7.11) + ghc-options: -Wcompat -Wnoncanonical-monad-instances + -- Due to circular dependency, we cannot make any of the test-suites or -- benchmark depend on the binary library. Instead, for each test-suite and -- benchmark, we include the source directory of binary and build-depend on all From git at git.haskell.org Tue Feb 2 21:05:02 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Feb 2016 21:05:02 +0000 (UTC) Subject: [commit: packages/binary] master: Merge pull request #104 from hvr/pr/monadfail-cpp (87b2d4d) Message-ID: <20160202210502.BF2D03A301@ghc.haskell.org> Repository : ssh://git at git.haskell.org/binary On branch : master Link : http://git.haskell.org/packages/binary.git/commitdiff/87b2d4d1f5eae08688fb770f8647e5cd453fdd2f >--------------------------------------------------------------- commit 87b2d4d1f5eae08688fb770f8647e5cd453fdd2f Merge: 13820f4 a9df926 Author: Lennart Kolmodin Date: Tue Feb 2 21:44:31 2016 +0100 Merge pull request #104 from hvr/pr/monadfail-cpp Define MonadFail instance for Get Monad >--------------------------------------------------------------- 87b2d4d1f5eae08688fb770f8647e5cd453fdd2f binary.cabal | 4 ++-- src/Data/Binary/Get/Internal.hs | 8 ++++++++ 2 files changed, 10 insertions(+), 2 deletions(-) From git at git.haskell.org Tue Feb 2 21:05:03 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Feb 2016 21:05:03 +0000 (UTC) Subject: [commit: packages/binary] master: Add arbitrary for Action in Arbitrary instance. (cf1d522) Message-ID: <20160202210503.C6C483A301@ghc.haskell.org> Repository : ssh://git at git.haskell.org/binary On branch : master Link : http://git.haskell.org/packages/binary.git/commitdiff/cf1d5225e631eed640b2fba6cf1508bc0a4457f3 >--------------------------------------------------------------- commit cf1d5225e631eed640b2fba6cf1508bc0a4457f3 Author: Lennart Kolmodin Date: Fri Jan 22 22:09:25 2016 +0100 Add arbitrary for Action in Arbitrary instance. >--------------------------------------------------------------- cf1d5225e631eed640b2fba6cf1508bc0a4457f3 tests/Action.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/tests/Action.hs b/tests/Action.hs index 2900389..bf20467 100644 --- a/tests/Action.hs +++ b/tests/Action.hs @@ -38,6 +38,7 @@ data Action deriving (Show, Eq) instance Arbitrary Action where + arbitrary = fmap Actions (gen_actions False) shrink action = case action of Actions [a] -> [a] From git at git.haskell.org Tue Feb 2 21:04:59 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Feb 2016 21:04:59 +0000 (UTC) Subject: [commit: packages/binary] master: Bump to 0.8.0.1. (6d3fd55) Message-ID: <20160202210459.BA2903A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/binary On branch : master Link : http://git.haskell.org/packages/binary.git/commitdiff/6d3fd55cb3389e43f802adaa8c26d45ea034b4ea >--------------------------------------------------------------- commit 6d3fd55cb3389e43f802adaa8c26d45ea034b4ea Author: Lennart Kolmodin Date: Thu Jan 21 10:45:22 2016 +0100 Bump to 0.8.0.1. >--------------------------------------------------------------- 6d3fd55cb3389e43f802adaa8c26d45ea034b4ea binary.cabal | 2 +- changelog.md | 5 +++++ 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/binary.cabal b/binary.cabal index f772d27..7781a03 100644 --- a/binary.cabal +++ b/binary.cabal @@ -1,5 +1,5 @@ name: binary -version: 0.8.0.0 +version: 0.8.0.1 license: BSD3 license-file: LICENSE author: Lennart Kolmodin diff --git a/changelog.md b/changelog.md index 8244e66..69fde96 100644 --- a/changelog.md +++ b/changelog.md @@ -1,6 +1,11 @@ binary ====== +binary-0.8.0.1 +-------------- + +- Address compiler warnings. + binary-0.8.0.0 -------------- From git at git.haskell.org Tue Feb 2 21:05:05 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Feb 2016 21:05:05 +0000 (UTC) Subject: [commit: packages/binary] master: Support ShortByteStrings. (9fa6234) Message-ID: <20160202210505.CE2233A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/binary On branch : master Link : http://git.haskell.org/packages/binary.git/commitdiff/9fa6234c1f7b91d6c32a689bdcf9b40718fa2525 >--------------------------------------------------------------- commit 9fa6234c1f7b91d6c32a689bdcf9b40718fa2525 Author: Alexander Vershilov Date: Sat Jan 23 03:21:13 2016 +0300 Support ShortByteStrings. Implement Binary instance and builders for ShortByteString. >--------------------------------------------------------------- 9fa6234c1f7b91d6c32a689bdcf9b40718fa2525 src/Data/Binary/Builder.hs | 3 +++ src/Data/Binary/Builder/Base.hs | 19 ++++++++++++++++++- src/Data/Binary/Class.hs | 11 +++++++++++ src/Data/Binary/Put.hs | 13 +++++++++++++ tests/Arbitrary.hs | 8 ++++++++ tests/QC.hs | 10 ++++++++++ 6 files changed, 63 insertions(+), 1 deletion(-) diff --git a/src/Data/Binary/Builder.hs b/src/Data/Binary/Builder.hs index 7af1a4b..88e38ed 100644 --- a/src/Data/Binary/Builder.hs +++ b/src/Data/Binary/Builder.hs @@ -28,6 +28,9 @@ module Data.Binary.Builder ( , append , fromByteString -- :: S.ByteString -> Builder , fromLazyByteString -- :: L.ByteString -> Builder +#if MIN_VERSION_bytestring(0,10,4) + , fromShortByteString -- :: T.ByteString -> Builder +#endif -- * Flushing the buffer state , flush diff --git a/src/Data/Binary/Builder/Base.hs b/src/Data/Binary/Builder/Base.hs index 62d286e..169937a 100644 --- a/src/Data/Binary/Builder/Base.hs +++ b/src/Data/Binary/Builder/Base.hs @@ -33,7 +33,9 @@ module Data.Binary.Builder.Base ( , append , fromByteString -- :: S.ByteString -> Builder , fromLazyByteString -- :: L.ByteString -> Builder - +#if MIN_VERSION_bytestring(0,10,4) + , fromShortByteString -- :: T.ByteString -> Builder +#endif -- * Flushing the buffer state , flush @@ -64,6 +66,10 @@ module Data.Binary.Builder.Base ( import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L +#if MIN_VERSION_bytestring(0,10,4) +import qualified Data.ByteString.Short as T +import qualified Data.ByteString.Short.Internal as T +#endif #if MIN_VERSION_base(4,9,0) import Data.Semigroup #else @@ -170,6 +176,17 @@ fromLazyByteString :: L.ByteString -> Builder fromLazyByteString bss = flush `append` mapBuilder (bss `L.append`) {-# INLINE fromLazyByteString #-} +#if MIN_VERSION_bytestring(0,10,4) +-- | /O(n)./ A builder taking 'T.ShortByteString' and copy it to a Builder, +-- satisfying +-- +-- * @'toLazyByteString' ('fromShortByteString' bs) = 'L.fromChunks' ['T.fromShort' bs] +fromShortByteString :: T.ShortByteString -> Builder +fromShortByteString sbs = writeN (T.length sbs) $ \ptr -> + T.copyToPtr sbs 0 ptr (T.length sbs) +{-# INLINE fromShortByteString #-} +#endif + ------------------------------------------------------------------------ -- Our internal buffer type diff --git a/src/Data/Binary/Class.hs b/src/Data/Binary/Class.hs index ebac8b0..f3c2d70 100644 --- a/src/Data/Binary/Class.hs +++ b/src/Data/Binary/Class.hs @@ -73,6 +73,9 @@ import Data.List (unfoldr, foldl') -- And needed for the instances: import qualified Data.ByteString as B +#if MIN_VERSION_bytestring(0,10,4) +import qualified Data.ByteString.Short as BS +#endif import qualified Data.Map as Map import qualified Data.Set as Set import qualified Data.IntMap as IntMap @@ -553,6 +556,14 @@ instance Binary ByteString where putLazyByteString bs get = get >>= getLazyByteString + +#if MIN_VERSION_bytestring(0,10,4) +instance Binary BS.ShortByteString where + put bs = do put (BS.length bs) + putShortByteString bs + get = get >>= fmap BS.toShort . getByteString +#endif + ------------------------------------------------------------------------ -- Maps and Sets diff --git a/src/Data/Binary/Put.hs b/src/Data/Binary/Put.hs index a05bfc7..1858312 100644 --- a/src/Data/Binary/Put.hs +++ b/src/Data/Binary/Put.hs @@ -34,6 +34,9 @@ module Data.Binary.Put ( , putWord8 , putByteString , putLazyByteString +#if MIN_VERSION_bytestring(0,10,4) + , putShortByteString +#endif -- * Big-endian primitives , putWord16be @@ -60,6 +63,9 @@ import qualified Data.Binary.Builder as B import Data.Word import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L +#if MIN_VERSION_bytestring(0,10,4) +import Data.ByteString.Short +#endif import Control.Applicative import Prelude -- Silence AMP warning. @@ -160,6 +166,13 @@ putLazyByteString :: L.ByteString -> Put putLazyByteString = tell . B.fromLazyByteString {-# INLINE putLazyByteString #-} +#if MIN_VERSION_bytestring(0,10,4) +-- | Write 'ShortByteString' to the buffer +putShortByteString :: ShortByteString -> Put +putShortByteString = tell . B.fromShortByteString +{-# INLINE putShortByteString #-} +#endif + -- | Write a Word16 in big endian format putWord16be :: Word16 -> Put putWord16be = tell . B.putWord16be diff --git a/tests/Arbitrary.hs b/tests/Arbitrary.hs index dcb9d44..3d6281f 100644 --- a/tests/Arbitrary.hs +++ b/tests/Arbitrary.hs @@ -7,6 +7,9 @@ import Test.QuickCheck import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as L +#if MIN_VERSION_bytestring(0,10,4) +import qualified Data.ByteString.Short as S +#endif instance Arbitrary L.ByteString where arbitrary = fmap L.fromChunks arbitrary @@ -14,6 +17,11 @@ instance Arbitrary L.ByteString where instance Arbitrary B.ByteString where arbitrary = B.pack `fmap` arbitrary +#if MIN_VERSION_bytestring(0,10,4) +instance Arbitrary S.ShortByteString where + arbitrary = S.toShort `fmap` arbitrary +#endif + instance (Arbitrary a, Arbitrary b, Arbitrary c, Arbitrary d, Arbitrary e, Arbitrary f) => Arbitrary (a,b,c,d,e,f) where diff --git a/tests/QC.hs b/tests/QC.hs index 94348ff..be11864 100644 --- a/tests/QC.hs +++ b/tests/QC.hs @@ -20,6 +20,9 @@ import Control.Monad (unless, liftM2) import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy.Internal as L +#if MIN_VERSION_bytestring(0,10,4) +import Data.ByteString.Short (ShortByteString) +#endif import Data.Int import Data.Ratio import System.IO.Unsafe @@ -559,6 +562,9 @@ tests = , ("B.ByteString", p (test :: T B.ByteString )) , ("L.ByteString", p (test :: T L.ByteString )) +#if MIN_VERSION_bytestring(0,10,4) + , ("ShortByteString", p (test :: T ShortByteString )) +#endif ] , testGroup "Invariants" $ map (uncurry testProperty) @@ -566,6 +572,10 @@ tests = , ("[B.ByteString] invariant", p (prop_invariant :: B [B.ByteString] )) , ("L.ByteString invariant", p (prop_invariant :: B L.ByteString )) , ("[L.ByteString] invariant", p (prop_invariant :: B [L.ByteString] )) +#if MIN_VERSION_bytestring(0,10,4) + , ("ShortByteString invariant", p (prop_invariant :: B ShortByteString )) + , ("[ShortByteString] invariant", p (prop_invariant :: B [ShortByteString] )) +#endif ] #ifdef HAS_FIXED_CONSTRUCTOR , testGroup "Fixed" From git at git.haskell.org Tue Feb 2 21:05:07 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Feb 2016 21:05:07 +0000 (UTC) Subject: [commit: packages/binary] master: Merge remote-tracking branch 'qnikst/bytestring-short' (52b8199) Message-ID: <20160202210507.D49DF3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/binary On branch : master Link : http://git.haskell.org/packages/binary.git/commitdiff/52b8199f4f06c56f66fbde9740d49a4488cc90dd >--------------------------------------------------------------- commit 52b8199f4f06c56f66fbde9740d49a4488cc90dd Merge: cf1d522 9fa6234 Author: Lennart Kolmodin Date: Mon Jan 25 22:14:01 2016 +0100 Merge remote-tracking branch 'qnikst/bytestring-short' >--------------------------------------------------------------- 52b8199f4f06c56f66fbde9740d49a4488cc90dd src/Data/Binary/Builder.hs | 3 +++ src/Data/Binary/Builder/Base.hs | 19 ++++++++++++++++++- src/Data/Binary/Class.hs | 11 +++++++++++ src/Data/Binary/Put.hs | 13 +++++++++++++ tests/Arbitrary.hs | 8 ++++++++ tests/QC.hs | 10 ++++++++++ 6 files changed, 63 insertions(+), 1 deletion(-) From git at git.haskell.org Tue Feb 2 21:05:09 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Feb 2016 21:05:09 +0000 (UTC) Subject: [commit: packages/binary] master: Update changelog. (fa80322) Message-ID: <20160202210509.DA0DD3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/binary On branch : master Link : http://git.haskell.org/packages/binary.git/commitdiff/fa803227ffa6a2e406de304494d069e98c29d3e2 >--------------------------------------------------------------- commit fa803227ffa6a2e406de304494d069e98c29d3e2 Author: Lennart Kolmodin Date: Mon Jan 25 22:15:17 2016 +0100 Update changelog. >--------------------------------------------------------------- fa803227ffa6a2e406de304494d069e98c29d3e2 changelog.md | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/changelog.md b/changelog.md index 69fde96..08e0557 100644 --- a/changelog.md +++ b/changelog.md @@ -1,6 +1,11 @@ binary ====== +binary-0.9.0.0 +-------------- + +- Add binary instance for `Data.ByteString.Short`. + binary-0.8.0.1 -------------- From git at git.haskell.org Tue Feb 2 21:05:11 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Feb 2016 21:05:11 +0000 (UTC) Subject: [commit: packages/binary] master: Merge remote-tracking branch 'shimuuar/signed-int' (0be40eb) Message-ID: <20160202210511.E192B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/binary On branch : master Link : http://git.haskell.org/packages/binary.git/commitdiff/0be40ebae1c8146ee592ada06abcb2c1a0d068dd >--------------------------------------------------------------- commit 0be40ebae1c8146ee592ada06abcb2c1a0d068dd Merge: fa80322 cbc3e2d Author: Lennart Kolmodin Date: Tue Jan 26 18:45:56 2016 +0100 Merge remote-tracking branch 'shimuuar/signed-int' >--------------------------------------------------------------- 0be40ebae1c8146ee592ada06abcb2c1a0d068dd src/Data/Binary/Builder.hs | 10 +++++ src/Data/Binary/Builder/Base.hs | 77 ++++++++++++++++++++++++++++++++++++++ src/Data/Binary/Get.hs | 83 +++++++++++++++++++++++++++++++++++++++++ src/Data/Binary/Put.hs | 77 ++++++++++++++++++++++++++++++++++++++ tests/QC.hs | 55 ++++++++++++++++++++++++++- 5 files changed, 301 insertions(+), 1 deletion(-) diff --cc src/Data/Binary/Put.hs index 1858312,9bb26f7..83ec710 --- a/src/Data/Binary/Put.hs +++ b/src/Data/Binary/Put.hs @@@ -32,11 -32,9 +32,12 @@@ module Data.Binary.Put -- * Primitives , putWord8 + , putInt8 , putByteString , putLazyByteString +#if MIN_VERSION_bytestring(0,10,4) + , putShortByteString +#endif -- * Big-endian primitives , putWord16be From git at git.haskell.org Tue Feb 2 21:05:13 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Feb 2016 21:05:13 +0000 (UTC) Subject: [commit: packages/binary] master: Documentation fix. (3bb4123) Message-ID: <20160202210513.E80213A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/binary On branch : master Link : http://git.haskell.org/packages/binary.git/commitdiff/3bb4123408608c47f5ae185f8e49e0803fb26ed2 >--------------------------------------------------------------- commit 3bb4123408608c47f5ae185f8e49e0803fb26ed2 Author: Lennart Kolmodin Date: Tue Jan 26 18:46:34 2016 +0100 Documentation fix. >--------------------------------------------------------------- 3bb4123408608c47f5ae185f8e49e0803fb26ed2 src/Data/Binary/Get.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Data/Binary/Get.hs b/src/Data/Binary/Get.hs index c098214..3e891e4 100644 --- a/src/Data/Binary/Get.hs +++ b/src/Data/Binary/Get.hs @@ -169,7 +169,7 @@ module Data.Binary.Get ( , getLazyByteStringNul , getRemainingLazyByteString - -- ** Decoding words + -- ** Decoding Words , getWord8 -- *** Big-endian decoding @@ -188,7 +188,7 @@ module Data.Binary.Get ( , getWord32host , getWord64host - -- ** Decoding words + -- ** Decoding Ints , getInt8 -- *** Big-endian decoding From git at git.haskell.org Tue Feb 2 21:05:15 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Feb 2016 21:05:15 +0000 (UTC) Subject: [commit: packages/binary] master: Update changelog.md. (c363a51) Message-ID: <20160202210515.EDC653A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/binary On branch : master Link : http://git.haskell.org/packages/binary.git/commitdiff/c363a514127b688058bca08b2cd4bbd21bde6155 >--------------------------------------------------------------- commit c363a514127b688058bca08b2cd4bbd21bde6155 Author: Lennart Kolmodin Date: Tue Jan 26 18:53:50 2016 +0100 Update changelog.md. >--------------------------------------------------------------- c363a514127b688058bca08b2cd4bbd21bde6155 changelog.md | 1 + 1 file changed, 1 insertion(+) diff --git a/changelog.md b/changelog.md index 08e0557..2f02205 100644 --- a/changelog.md +++ b/changelog.md @@ -5,6 +5,7 @@ binary-0.9.0.0 -------------- - Add binary instance for `Data.ByteString.Short`. +- Add get/put functions for all Int sizes to `Data.Binary.Builder`, `Data.Binary.Get` and `Data.Binary.Put`. binary-0.8.0.1 -------------- From git at git.haskell.org Tue Feb 2 21:05:18 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Feb 2016 21:05:18 +0000 (UTC) Subject: [commit: packages/binary] master: Use getIntX/putIntX in the Binary class instances. (8b1459e) Message-ID: <20160202210518.00A323A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/binary On branch : master Link : http://git.haskell.org/packages/binary.git/commitdiff/8b1459ed8033e72b6ef243649adf71c8d4909f33 >--------------------------------------------------------------- commit 8b1459ed8033e72b6ef243649adf71c8d4909f33 Author: Lennart Kolmodin Date: Tue Jan 26 20:23:34 2016 +0100 Use getIntX/putIntX in the Binary class instances. >--------------------------------------------------------------- 8b1459ed8033e72b6ef243649adf71c8d4909f33 src/Data/Binary/Class.hs | 24 ++++++++++++------------ 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/src/Data/Binary/Class.hs b/src/Data/Binary/Class.hs index f3c2d70..0eecfcb 100644 --- a/src/Data/Binary/Class.hs +++ b/src/Data/Binary/Class.hs @@ -209,35 +209,35 @@ instance Binary Word64 where -- Int8s are written as a single byte. instance Binary Int8 where - put i = put (fromIntegral i :: Word8) - get = liftM fromIntegral (get :: Get Word8) + put = putInt8 + get = getInt8 -- Int16s are written as a 2 bytes in big endian format instance Binary Int16 where - put i = put (fromIntegral i :: Word16) - get = liftM fromIntegral (get :: Get Word16) + put = putInt16be + get = getInt16be -- Int32s are written as a 4 bytes in big endian format instance Binary Int32 where - put i = put (fromIntegral i :: Word32) - get = liftM fromIntegral (get :: Get Word32) + put = putInt32be + get = getInt32be -- Int64s are written as a 8 bytes in big endian format instance Binary Int64 where - put i = put (fromIntegral i :: Word64) - get = liftM fromIntegral (get :: Get Word64) + put = putInt64be + get = getInt64be ------------------------------------------------------------------------ -- Words are are written as Word64s, that is, 8 bytes in big endian format instance Binary Word where - put i = put (fromIntegral i :: Word64) - get = liftM fromIntegral (get :: Get Word64) + put = putWord64be . fromIntegral + get = liftM fromIntegral getWord64be -- Ints are are written as Int64s, that is, 8 bytes in big endian format instance Binary Int where - put i = put (fromIntegral i :: Int64) - get = liftM fromIntegral (get :: Get Int64) + put = putInt64be . fromIntegral + get = liftM fromIntegral getInt64be ------------------------------------------------------------------------ -- From git at git.haskell.org Tue Feb 2 21:05:20 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Feb 2016 21:05:20 +0000 (UTC) Subject: [commit: packages/binary] master: Change next version to be 0.8.1.0 (13820f4) Message-ID: <20160202210520.07A483A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/binary On branch : master Link : http://git.haskell.org/packages/binary.git/commitdiff/13820f4550d7c2c23cdad970f55c4133a9a3cebf >--------------------------------------------------------------- commit 13820f4550d7c2c23cdad970f55c4133a9a3cebf Author: Lennart Kolmodin Date: Tue Feb 2 20:55:25 2016 +0100 Change next version to be 0.8.1.0 PVP said 0.9.0.0 was not required. >--------------------------------------------------------------- 13820f4550d7c2c23cdad970f55c4133a9a3cebf binary.cabal | 2 +- changelog.md | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/binary.cabal b/binary.cabal index 899fc50..477f933 100644 --- a/binary.cabal +++ b/binary.cabal @@ -1,5 +1,5 @@ name: binary -version: 0.8.0.1 +version: 0.8.1.0 license: BSD3 license-file: LICENSE author: Lennart Kolmodin diff --git a/changelog.md b/changelog.md index 2f02205..e5c0eb6 100644 --- a/changelog.md +++ b/changelog.md @@ -1,7 +1,7 @@ binary ====== -binary-0.9.0.0 +binary-0.8.1.0 -------------- - Add binary instance for `Data.ByteString.Short`. From git at git.haskell.org Tue Feb 2 21:05:22 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Feb 2016 21:05:22 +0000 (UTC) Subject: [commit: packages/binary] master: Define MonadFail instance for Get Monad (a9df926) Message-ID: <20160202210522.102F33A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/binary On branch : master Link : http://git.haskell.org/packages/binary.git/commitdiff/a9df926504a66b8059783727956929b6643dc9fc >--------------------------------------------------------------- commit a9df926504a66b8059783727956929b6643dc9fc Author: Herbert Valerio Riedel Date: Tue Feb 2 21:20:00 2016 +0100 Define MonadFail instance for Get Monad >--------------------------------------------------------------- a9df926504a66b8059783727956929b6643dc9fc binary.cabal | 4 ++-- src/Data/Binary/Get/Internal.hs | 8 ++++++++ 2 files changed, 10 insertions(+), 2 deletions(-) diff --git a/binary.cabal b/binary.cabal index 477f933..a5eeb9c 100644 --- a/binary.cabal +++ b/binary.cabal @@ -53,8 +53,8 @@ library ghc-options: -O2 -Wall -fliberate-case-threshold=1000 - if impl(ghc >= 7.11) - ghc-options: -Wcompat -Wnoncanonical-monad-instances + if impl(ghc >= 8.0) + ghc-options: -Wcompat -Wnoncanonical-monad-instances -Wnoncanonical-monadfail-instances -- Due to circular dependency, we cannot make any of the test-suites or -- benchmark depend on the binary library. Instead, for each test-suite and diff --git a/src/Data/Binary/Get/Internal.hs b/src/Data/Binary/Get/Internal.hs index 10e372f..944a2ce 100644 --- a/src/Data/Binary/Get/Internal.hs +++ b/src/Data/Binary/Get/Internal.hs @@ -48,6 +48,9 @@ import qualified Data.ByteString.Unsafe as B import Control.Applicative import Control.Monad +#if MIN_VERSION_base(4,9,0) +import qualified Control.Monad.Fail as Fail +#endif import Data.Binary.Internal ( accursedUnutterablePerformIO ) @@ -94,6 +97,11 @@ type Success a r = B.ByteString -> a -> Decoder r instance Monad Get where return = pure (>>=) = bindG +#if MIN_VERSION_base(4,9,0) + fail = Fail.fail + +instance Fail.MonadFail Get where +#endif fail = failG bindG :: Get a -> (a -> Get b) -> Get b From git at git.haskell.org Tue Feb 2 21:05:24 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Feb 2016 21:05:24 +0000 (UTC) Subject: [commit: packages/binary] master: Merge pull request #104 from hvr/pr/monadfail-cpp (87b2d4d) Message-ID: <20160202210524.1626E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/binary On branch : master Link : http://git.haskell.org/packages/binary.git/commitdiff/87b2d4d1f5eae08688fb770f8647e5cd453fdd2f >--------------------------------------------------------------- commit 87b2d4d1f5eae08688fb770f8647e5cd453fdd2f Merge: 13820f4 a9df926 Author: Lennart Kolmodin Date: Tue Feb 2 21:44:31 2016 +0100 Merge pull request #104 from hvr/pr/monadfail-cpp Define MonadFail instance for Get Monad >--------------------------------------------------------------- 87b2d4d1f5eae08688fb770f8647e5cd453fdd2f binary.cabal | 4 ++-- src/Data/Binary/Get/Internal.hs | 8 ++++++++ 2 files changed, 10 insertions(+), 2 deletions(-) From git at git.haskell.org Tue Feb 2 21:05:26 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Feb 2016 21:05:26 +0000 (UTC) Subject: [commit: packages/binary] : Bump to version 0.8.2.0 (2afc452) Message-ID: <20160202210526.1D9623A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/binary On branch : Link : http://git.haskell.org/packages/binary.git/commitdiff/2afc452571f8176af84c01e47da91ee371bbefbd >--------------------------------------------------------------- commit 2afc452571f8176af84c01e47da91ee371bbefbd Author: Lennart Kolmodin Date: Tue Feb 2 21:57:25 2016 +0100 Bump to version 0.8.2.0 >--------------------------------------------------------------- 2afc452571f8176af84c01e47da91ee371bbefbd binary.cabal | 2 +- changelog.md | 5 +++++ 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/binary.cabal b/binary.cabal index a5eeb9c..5b01fba 100644 --- a/binary.cabal +++ b/binary.cabal @@ -1,5 +1,5 @@ name: binary -version: 0.8.1.0 +version: 0.8.2.0 license: BSD3 license-file: LICENSE author: Lennart Kolmodin diff --git a/changelog.md b/changelog.md index e5c0eb6..669b5d7 100644 --- a/changelog.md +++ b/changelog.md @@ -1,6 +1,11 @@ binary ====== +binary-0.8.2.0 +-------------- + +- When using GHC >= 8, `Data.Binary.Get.Get` implements MonadFail and delegates its `fail` to `MonadFail.fail`. + binary-0.8.1.0 -------------- From git at git.haskell.org Tue Feb 2 21:06:49 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Feb 2016 21:06:49 +0000 (UTC) Subject: [commit: packages/binary] master's head updated: Bump to version 0.8.2.0 (2afc452) Message-ID: <20160202210649.3795C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/binary Branch 'master' now includes: 2afc452 Bump to version 0.8.2.0 From git at git.haskell.org Tue Feb 2 21:07:48 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Feb 2016 21:07:48 +0000 (UTC) Subject: [commit: packages/binary] tag '0.8.1.0' created Message-ID: <20160202210748.6100F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/binary New tag : 0.8.1.0 Referencing: 68d6ecd8a95cd1f017bfaabbed69f980f0cfd176 From git at git.haskell.org Tue Feb 2 21:08:08 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Feb 2016 21:08:08 +0000 (UTC) Subject: [commit: packages/binary] tag '0.8.0.1' created Message-ID: <20160202210808.9F6C93A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/binary New tag : 0.8.0.1 Referencing: c5291313595194d63d4a53336cb4d13f34a85983 From git at git.haskell.org Tue Feb 2 21:41:55 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Feb 2016 21:41:55 +0000 (UTC) Subject: [commit: ghc] master: Update cabal_macros_boot.h (92c46a4) Message-ID: <20160202214155.CF1973A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/92c46a447e676fc15d014b4d6aa20052ff9ba1d3/ghc >--------------------------------------------------------------- commit 92c46a447e676fc15d014b4d6aa20052ff9ba1d3 Author: Herbert Valerio Riedel Date: Tue Feb 2 22:07:05 2016 +0100 Update cabal_macros_boot.h the MIN_VERSION_bytestring() macro is going to be needed for the upcoming binary update >--------------------------------------------------------------- 92c46a447e676fc15d014b4d6aa20052ff9ba1d3 utils/ghc-cabal/cabal_macros_boot.h | 29 ++++++++++++++++++++--------- 1 file changed, 20 insertions(+), 9 deletions(-) diff --git a/utils/ghc-cabal/cabal_macros_boot.h b/utils/ghc-cabal/cabal_macros_boot.h index e0e18b5..a2da63a 100644 --- a/utils/ghc-cabal/cabal_macros_boot.h +++ b/utils/ghc-cabal/cabal_macros_boot.h @@ -1,27 +1,38 @@ /* defines a few MIN_VERSION_...() macros used by some of the bootstrap packages */ #if __GLASGOW_HASKELL__ >= 711 -/* package base-4.8.1.0 */ +/* package base-4.9.0.0 */ # define MIN_VERSION_base(major1,major2,minor) (\ (major1) < 4 || \ - (major1) == 4 && (major2) < 8 || \ - (major1) == 4 && (major2) == 8 && (minor) <= 1) + (major1) == 4 && (major2) < 9 || \ + (major1) == 4 && (major2) == 9 && (minor) <= 0) +/* package bytestring-0.10.8 */ +# define MIN_VERSION_bytestring(major1,major2,minor) (\ + (major1) < 0 || \ + (major1) == 0 && (major2) < 10 || \ + (major1) == 0 && (major2) == 10 && (minor) <= 8) + #elif __GLASGOW_HASKELL__ >= 709 /* package base-4.8.0.0 */ # define MIN_VERSION_base(major1,major2,minor) (\ (major1) < 4 || \ (major1) == 4 && (major2) < 8 || \ (major1) == 4 && (major2) == 8 && (minor) <= 0) +/* package bytestring-0.10.6 */ +# define MIN_VERSION_bytestring(major1,major2,minor) (\ + (major1) < 0 || \ + (major1) == 0 && (major2) < 10 || \ + (major1) == 0 && (major2) == 10 && (minor) <= 6) + #elif __GLASGOW_HASKELL__ >= 707 /* package base-4.7.0 */ # define MIN_VERSION_base(major1,major2,minor) (\ (major1) < 4 || \ (major1) == 4 && (major2) < 7 || \ (major1) == 4 && (major2) == 7 && (minor) <= 0) -#elif __GLASGOW_HASKELL__ >= 705 -/* package base-4.6.0 */ -# define MIN_VERSION_base(major1,major2,minor) (\ - (major1) < 4 || \ - (major1) == 4 && (major2) < 6 || \ - (major1) == 4 && (major2) == 6 && (minor) <= 0) +/* package bytestring-0.10.4 */ +# define MIN_VERSION_bytestring(major1,major2,minor) (\ + (major1) < 0 || \ + (major1) == 0 && (major2) < 10 || \ + (major1) == 0 && (major2) == 10 && (minor) <= 4) #endif From git at git.haskell.org Tue Feb 2 21:41:58 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Feb 2016 21:41:58 +0000 (UTC) Subject: [commit: ghc] master: Update binary submodule to 0.8.2.0 release (483858e) Message-ID: <20160202214158.9A2E63A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/483858e9aa3efae540bcc496574b9ff02a6e34a9/ghc >--------------------------------------------------------------- commit 483858e9aa3efae540bcc496574b9ff02a6e34a9 Author: Herbert Valerio Riedel Date: Tue Feb 2 22:43:06 2016 +0100 Update binary submodule to 0.8.2.0 release >--------------------------------------------------------------- 483858e9aa3efae540bcc496574b9ff02a6e34a9 libraries/binary | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/binary b/libraries/binary index ff78825..2afc452 160000 --- a/libraries/binary +++ b/libraries/binary @@ -1 +1 @@ -Subproject commit ff78825668cf7ba243e301c070c5dfa0d8c8410a +Subproject commit 2afc452571f8176af84c01e47da91ee371bbefbd From git at git.haskell.org Tue Feb 2 21:44:51 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Feb 2016 21:44:51 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Update cabal_macros_boot.h (12288de) Message-ID: <20160202214451.CEB5F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/12288de0d9456fcb296f4d629f5237236d644870/ghc >--------------------------------------------------------------- commit 12288de0d9456fcb296f4d629f5237236d644870 Author: Herbert Valerio Riedel Date: Tue Feb 2 22:07:05 2016 +0100 Update cabal_macros_boot.h the MIN_VERSION_bytestring() macro is going to be needed for the upcoming binary update (cherry picked from commit 92c46a447e676fc15d014b4d6aa20052ff9ba1d3) >--------------------------------------------------------------- 12288de0d9456fcb296f4d629f5237236d644870 utils/ghc-cabal/cabal_macros_boot.h | 29 ++++++++++++++++++++--------- 1 file changed, 20 insertions(+), 9 deletions(-) diff --git a/utils/ghc-cabal/cabal_macros_boot.h b/utils/ghc-cabal/cabal_macros_boot.h index e0e18b5..a2da63a 100644 --- a/utils/ghc-cabal/cabal_macros_boot.h +++ b/utils/ghc-cabal/cabal_macros_boot.h @@ -1,27 +1,38 @@ /* defines a few MIN_VERSION_...() macros used by some of the bootstrap packages */ #if __GLASGOW_HASKELL__ >= 711 -/* package base-4.8.1.0 */ +/* package base-4.9.0.0 */ # define MIN_VERSION_base(major1,major2,minor) (\ (major1) < 4 || \ - (major1) == 4 && (major2) < 8 || \ - (major1) == 4 && (major2) == 8 && (minor) <= 1) + (major1) == 4 && (major2) < 9 || \ + (major1) == 4 && (major2) == 9 && (minor) <= 0) +/* package bytestring-0.10.8 */ +# define MIN_VERSION_bytestring(major1,major2,minor) (\ + (major1) < 0 || \ + (major1) == 0 && (major2) < 10 || \ + (major1) == 0 && (major2) == 10 && (minor) <= 8) + #elif __GLASGOW_HASKELL__ >= 709 /* package base-4.8.0.0 */ # define MIN_VERSION_base(major1,major2,minor) (\ (major1) < 4 || \ (major1) == 4 && (major2) < 8 || \ (major1) == 4 && (major2) == 8 && (minor) <= 0) +/* package bytestring-0.10.6 */ +# define MIN_VERSION_bytestring(major1,major2,minor) (\ + (major1) < 0 || \ + (major1) == 0 && (major2) < 10 || \ + (major1) == 0 && (major2) == 10 && (minor) <= 6) + #elif __GLASGOW_HASKELL__ >= 707 /* package base-4.7.0 */ # define MIN_VERSION_base(major1,major2,minor) (\ (major1) < 4 || \ (major1) == 4 && (major2) < 7 || \ (major1) == 4 && (major2) == 7 && (minor) <= 0) -#elif __GLASGOW_HASKELL__ >= 705 -/* package base-4.6.0 */ -# define MIN_VERSION_base(major1,major2,minor) (\ - (major1) < 4 || \ - (major1) == 4 && (major2) < 6 || \ - (major1) == 4 && (major2) == 6 && (minor) <= 0) +/* package bytestring-0.10.4 */ +# define MIN_VERSION_bytestring(major1,major2,minor) (\ + (major1) < 0 || \ + (major1) == 0 && (major2) < 10 || \ + (major1) == 0 && (major2) == 10 && (minor) <= 4) #endif From git at git.haskell.org Tue Feb 2 21:44:54 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Feb 2016 21:44:54 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Update binary submodule to 0.8.2.0 release (a90faf3) Message-ID: <20160202214454.8527F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/a90faf3754f9567a26817c581e83c1f124fe1167/ghc >--------------------------------------------------------------- commit a90faf3754f9567a26817c581e83c1f124fe1167 Author: Herbert Valerio Riedel Date: Tue Feb 2 22:43:06 2016 +0100 Update binary submodule to 0.8.2.0 release (cherry picked from commit 483858e9aa3efae540bcc496574b9ff02a6e34a9) >--------------------------------------------------------------- a90faf3754f9567a26817c581e83c1f124fe1167 libraries/binary | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/binary b/libraries/binary index ff78825..2afc452 160000 --- a/libraries/binary +++ b/libraries/binary @@ -1 +1 @@ -Subproject commit ff78825668cf7ba243e301c070c5dfa0d8c8410a +Subproject commit 2afc452571f8176af84c01e47da91ee371bbefbd From git at git.haskell.org Tue Feb 2 22:56:08 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Feb 2016 22:56:08 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Properly track live registers when saving the CCCS. (31c11d0) Message-ID: <20160202225608.CB5B53A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/31c11d06e3a9d3f362e585e2c65d59a331623b2b/ghc >--------------------------------------------------------------- commit 31c11d06e3a9d3f362e585e2c65d59a331623b2b Author: Geoffrey Mainland Date: Thu Jan 28 09:58:37 2016 -0500 Properly track live registers when saving the CCCS. Summary: When saving the CCCS, we now correctly track the set of live registers and pass them to the jump_SAVE_CCCS macro. This is now a variadic macro, but variadic macros are supported by GCC since 3.0 and by all versions of clang, so this should not be a problem. Test Plan: ./validate with the following build options: ``` BuildFlavour = quick-llvm SRC_HC_OPTS_STAGE1 = -fllvm-fill-undef-with-garbage ``` Reviewers: bgamari, simonmar, austin, rwbarton, simonpj Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1864 GHC Trac Issues: #11487 (cherry picked from commit 6544f8de1ed575378f14b82a2eaa06cab58b2d65) >--------------------------------------------------------------- 31c11d06e3a9d3f362e585e2c65d59a331623b2b rts/AutoApply.h | 6 +++--- utils/genapply/Main.hs | 29 ++++++++++++++++++++++++++--- 2 files changed, 29 insertions(+), 6 deletions(-) diff --git a/rts/AutoApply.h b/rts/AutoApply.h index 74af74b..601e35f 100644 --- a/rts/AutoApply.h +++ b/rts/AutoApply.h @@ -78,13 +78,13 @@ // Jump to target, saving CCCS and restoring it on return #if defined(PROFILING) -#define jump_SAVE_CCCS(target) \ +#define jump_SAVE_CCCS(target,...) \ Sp(-1) = CCCS; \ Sp(-2) = stg_restore_cccs_info; \ Sp_adj(-2); \ - jump (target) [R1] + jump (target) [__VA_ARGS__] #else -#define jump_SAVE_CCCS(target) jump (target) [R1] +#define jump_SAVE_CCCS(target,...) jump (target) [__VA_ARGS__] #endif #endif /* APPLY_H */ diff --git a/utils/genapply/Main.hs b/utils/genapply/Main.hs index 10fc1a6..3d28fec 100644 --- a/utils/genapply/Main.hs +++ b/utils/genapply/Main.hs @@ -157,7 +157,28 @@ mkJump :: RegStatus -- Registerised status -> [ArgRep] -- Jump arguments -> Doc mkJump regstatus jump live args = - text "jump" <+> jump <+> brackets (hcat (punctuate comma (map text regs))) + text "jump" <+> jump <+> brackets (hcat (punctuate comma liveRegs)) + where + liveRegs = mkJumpLiveRegs regstatus live args + +-- Make a jump, saving CCCS and restoring it on return +mkJumpSaveCCCS :: RegStatus -- Registerised status + -> Doc -- Jump target + -> [Reg] -- Registers that are definitely live + -> [ArgRep] -- Jump arguments + -> Doc +mkJumpSaveCCCS regstatus jump live args = + text "jump_SAVE_CCCS" <> parens (hcat (punctuate comma (jump : liveRegs))) + where + liveRegs = mkJumpLiveRegs regstatus live args + +-- Calculate live registers for a jump +mkJumpLiveRegs :: RegStatus -- Registerised status + -> [Reg] -- Registers that are definitely live + -> [ArgRep] -- Jump arguments + -> [Doc] +mkJumpLiveRegs regstatus live args = + map text regs where (reg_locs, _, _) = assignRegs regstatus 0 args regs = (nub . sort) (live ++ map fst reg_locs) @@ -318,7 +339,8 @@ genMkPAP regstatus macro jump live ticker disamb else empty, if is_fun_case then mb_tag_node arity else empty, if overflow_regs - then text "jump_SAVE_CCCS" <> parens (text jump) <> semi + then mkJumpSaveCCCS + regstatus (text jump) live (take arity args) <> semi else mkJump regstatus (text jump) live (if no_load_regs then [] else args) <> semi ]) $$ text "}" @@ -741,7 +763,8 @@ genApply regstatus args = -- overwritten by an indirection, so we must enter the original -- info pointer we read, don't read it again, because it might -- not be enterable any more. - text "jump_SAVE_CCCS(%ENTRY_CODE(info));", + mkJumpSaveCCCS + regstatus (text "%ENTRY_CODE(info)") ["R1"] args <> semi, -- see Note [jump_SAVE_CCCS] text "" ]), From git at git.haskell.org Tue Feb 2 22:56:11 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Feb 2016 22:56:11 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Fix some substitution InScopeSets (35d9486) Message-ID: <20160202225611.806AB3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/35d94865a20e430fe57cb2eb6d859cd182ac6f58/ghc >--------------------------------------------------------------- commit 35d94865a20e430fe57cb2eb6d859cd182ac6f58 Author: Richard Eisenberg Date: Mon Jan 25 22:00:47 2016 -0500 Fix some substitution InScopeSets This is relevant to #11371. (cherry picked from commit 2899aa580d633103fc551e36c977720b94f5b41c) >--------------------------------------------------------------- 35d94865a20e430fe57cb2eb6d859cd182ac6f58 compiler/typecheck/TcHsType.hs | 2 +- compiler/typecheck/TcMType.hs | 2 +- compiler/typecheck/TcType.hs | 1 + compiler/types/TyCoRep.hs | 4 ++++ compiler/types/Type.hs | 4 ++-- 5 files changed, 9 insertions(+), 4 deletions(-) diff --git a/compiler/typecheck/TcHsType.hs b/compiler/typecheck/TcHsType.hs index 0a87bf4..e438df5 100644 --- a/compiler/typecheck/TcHsType.hs +++ b/compiler/typecheck/TcHsType.hs @@ -847,7 +847,7 @@ tcInstBinderX :: Maybe (VarEnv Kind) tcInstBinderX mb_kind_info subst binder | Just tv <- binderVar_maybe binder = case lookup_tv tv of - Just ki -> return (extendTCvSubst subst tv ki, ki) + Just ki -> return (extendTCvSubstAndInScope subst tv ki, ki) Nothing -> do { (subst', tv') <- newMetaTyVarX subst tv ; return (subst', mkTyVarTy tv') } diff --git a/compiler/typecheck/TcMType.hs b/compiler/typecheck/TcMType.hs index e5bfca1..3d9e57c 100644 --- a/compiler/typecheck/TcMType.hs +++ b/compiler/typecheck/TcMType.hs @@ -777,7 +777,7 @@ newMetaTyVarX subst tyvar -- See Note [Name of an instantiated type variable] kind = substTyUnchecked subst (tyVarKind tyvar) new_tv = mkTcTyVar name kind details - ; return (extendTCvSubst (extendTCvInScope subst new_tv) tyvar + ; return (extendTCvSubstAndInScope subst tyvar (mkTyVarTy new_tv) , new_tv) } diff --git a/compiler/typecheck/TcType.hs b/compiler/typecheck/TcType.hs index dbe6ba5..aa0ba52 100644 --- a/compiler/typecheck/TcType.hs +++ b/compiler/typecheck/TcType.hs @@ -149,6 +149,7 @@ module TcType ( zipTvSubst, mkTvSubstPrs, notElemTCvSubst, unionTCvSubst, getTvSubstEnv, setTvSubstEnv, getTCvInScope, extendTCvInScope, + extendTCvInScopeList, extendTCvInScopeSet, extendTCvSubstAndInScope, Type.lookupTyVar, Type.extendTCvSubst, Type.substTyVarBndr, extendTCvSubstList, isInScope, mkTCvSubst, zipTyEnv, zipCoEnv, Type.substTy, substTys, substTyWith, substTyWithCoVars, diff --git a/compiler/types/TyCoRep.hs b/compiler/types/TyCoRep.hs index cd84ba2..5d039c4 100644 --- a/compiler/types/TyCoRep.hs +++ b/compiler/types/TyCoRep.hs @@ -1828,7 +1828,11 @@ substTy subst@(TCvSubst in_scope tenv cenv) ty | otherwise = ASSERT2( isValidTCvSubst subst, text "in_scope" <+> ppr in_scope $$ text "tenv" <+> ppr tenv $$ + text "tenvFVs" + <+> ppr (tyCoVarsOfTypes $ varEnvElts tenv) $$ text "cenv" <+> ppr cenv $$ + text "cenvFVs" + <+> ppr (tyCoVarsOfCos $ varEnvElts cenv) $$ text "ty" <+> ppr ty ) ASSERT2( typeFVsInScope, text "in_scope" <+> ppr in_scope $$ diff --git a/compiler/types/Type.hs b/compiler/types/Type.hs index bcf7ef0..d952abb 100644 --- a/compiler/types/Type.hs +++ b/compiler/types/Type.hs @@ -154,8 +154,8 @@ module Type ( notElemTCvSubst, getTvSubstEnv, setTvSubstEnv, zapTCvSubst, getTCvInScope, - extendTCvInScope, extendTCvInScopeList, - extendTCvSubst, extendTCvSubstList, + extendTCvInScope, extendTCvInScopeList, extendTCvInScopeSet, + extendTCvSubst, extendTCvSubstList, extendTCvSubstAndInScope, isInScope, composeTCvSubstEnv, composeTCvSubst, zipTyEnv, zipCoEnv, isEmptyTCvSubst, unionTCvSubst, From git at git.haskell.org Tue Feb 2 22:56:14 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Feb 2016 22:56:14 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Add type signatures. (b8c8d4c) Message-ID: <20160202225614.3A38A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/b8c8d4c015a4b1d86cbe2b8c197d64a34ba0cc1c/ghc >--------------------------------------------------------------- commit b8c8d4c015a4b1d86cbe2b8c197d64a34ba0cc1c Author: Geoffrey Mainland Date: Thu Jan 28 09:58:28 2016 -0500 Add type signatures. (cherry picked from commit 4d0e4fe66892f6700c2bcd4ddcd1d1a837c38a56) >--------------------------------------------------------------- b8c8d4c015a4b1d86cbe2b8c197d64a34ba0cc1c utils/genapply/Main.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/utils/genapply/Main.hs b/utils/genapply/Main.hs index e58a496..97028b3 100644 --- a/utils/genapply/Main.hs +++ b/utils/genapply/Main.hs @@ -580,6 +580,7 @@ argRep V32 = text "V32_" argRep V64 = text "V64_" argRep _ = text "W_" +genApply :: RegStatus -> [ArgRep] -> Doc genApply regstatus args = let fun_ret_label = mkApplyRetName args @@ -778,6 +779,7 @@ genApply regstatus args = -- ----------------------------------------------------------------------------- -- Making a fast unknown application, args are in regs +genApplyFast :: RegStatus -> [ArgRep] -> Doc genApplyFast regstatus args = let fun_fast_label = mkApplyFastName args From git at git.haskell.org Tue Feb 2 22:56:16 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Feb 2016 22:56:16 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Code formatting cleanup. (28ee6ca) Message-ID: <20160202225616.DF0BB3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/28ee6ca5ba18b3e451f0377d77c7e1ef1cfb136a/ghc >--------------------------------------------------------------- commit 28ee6ca5ba18b3e451f0377d77c7e1ef1cfb136a Author: Geoffrey Mainland Date: Thu Jan 28 10:34:53 2016 -0500 Code formatting cleanup. (cherry picked from commit 90f688e892427b1894b6aacb1f8de8d2e41ecb56) >--------------------------------------------------------------- 28ee6ca5ba18b3e451f0377d77c7e1ef1cfb136a utils/genapply/Main.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/utils/genapply/Main.hs b/utils/genapply/Main.hs index 97028b3..10fc1a6 100644 --- a/utils/genapply/Main.hs +++ b/utils/genapply/Main.hs @@ -157,10 +157,10 @@ mkJump :: RegStatus -- Registerised status -> [ArgRep] -- Jump arguments -> Doc mkJump regstatus jump live args = - text "jump " <> jump <+> brackets (hcat (punctuate comma (map text regs))) + text "jump" <+> jump <+> brackets (hcat (punctuate comma (map text regs))) where - (reg_locs, _, _) = assignRegs regstatus 0 args - regs = (nub . sort) (live ++ map fst reg_locs) + (reg_locs, _, _) = assignRegs regstatus 0 args + regs = (nub . sort) (live ++ map fst reg_locs) -- make a ptr/non-ptr bitmap from a list of argument types mkBitmap :: [ArgRep] -> Word32 From git at git.haskell.org Tue Feb 2 22:56:19 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Feb 2016 22:56:19 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Rename "open" subst functions (fdd7ac3) Message-ID: <20160202225619.B50113A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/fdd7ac3a1f8e664c0814c70102c0f057b8a6a4f8/ghc >--------------------------------------------------------------- commit fdd7ac3a1f8e664c0814c70102c0f057b8a6a4f8 Author: Bartosz Nitka Date: Tue Jan 26 11:59:37 2016 -0800 Rename "open" subst functions This is the renaming that @simonpj requested: ``` ? zipOpenTCvSubst -> zipTvSubst (It only deals with tyvars) ? zipOpenTCvSubstCoVars -> zipCvSubst (it only deals with covars) ? zipOpenTCvSubstBinders -> zipTyBinderSubst (it only deals with TyBinders, not covars) ``` plus the `mk` variant. Test Plan: ./validate Reviewers: simonpj, goldfire, austin, bgamari Subscribers: thomie, simonpj Differential Revision: https://phabricator.haskell.org/D1853 GHC Trac Issues: #11371 (cherry picked from commit 5dcae88bd0df440abe78c3d793d21aca6236fc25) >--------------------------------------------------------------- fdd7ac3a1f8e664c0814c70102c0f057b8a6a4f8 compiler/basicTypes/DataCon.hs | 2 +- compiler/basicTypes/MkId.hs | 4 +-- compiler/coreSyn/CoreUtils.hs | 2 +- compiler/deSugar/Check.hs | 2 +- compiler/deSugar/DsExpr.hs | 2 +- compiler/iface/BuildTyCl.hs | 6 ++-- compiler/iface/TcIface.hs | 2 +- compiler/main/InteractiveEval.hs | 6 ++-- compiler/typecheck/TcDeriv.hs | 8 ++--- compiler/typecheck/TcFlatten.hs | 2 +- compiler/typecheck/TcInstDcls.hs | 2 +- compiler/typecheck/TcPat.hs | 4 +-- compiler/typecheck/TcTyDecls.hs | 2 +- compiler/typecheck/TcType.hs | 6 ++-- compiler/types/FamInstEnv.hs | 2 +- compiler/types/OptCoercion.hs | 4 +-- compiler/types/TyCoRep.hs | 70 ++++++++++++++++++---------------------- compiler/types/Type.hs | 10 +++--- 18 files changed, 64 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 fdd7ac3a1f8e664c0814c70102c0f057b8a6a4f8 From git at git.haskell.org Tue Feb 2 22:56:22 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Feb 2016 22:56:22 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Use a correct substitution in tcCheckPatSynDecl (bd811e6) Message-ID: <20160202225622.E67E23A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/bd811e638bccfc4fa4557b79b4d0168807ab36e6/ghc >--------------------------------------------------------------- commit bd811e638bccfc4fa4557b79b4d0168807ab36e6 Author: Bartosz Nitka Date: Tue Feb 2 05:02:23 2016 -0800 Use a correct substitution in tcCheckPatSynDecl The `substTheta` call didn't have the free variables of the `prov_theta` in the `in_scope` set. It should be enough to add `univ_tvs`, as all the `ex_tvs` are already in the domain of the substitution. Test Plan: added a testcase Reviewers: simonpj, bgamari, goldfire, austin Reviewed By: simonpj, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1879 GHC Trac Issues: #11524 (cherry picked from commit 07ed24132ebe62aab15f14a655506decdf252ff9) >--------------------------------------------------------------- bd811e638bccfc4fa4557b79b4d0168807ab36e6 compiler/typecheck/TcPatSyn.hs | 8 +++++++- testsuite/tests/typecheck/should_compile/T11524.hs | 18 ++++++++++++++++++ testsuite/tests/typecheck/should_compile/all.T | 1 + 3 files changed, 26 insertions(+), 1 deletion(-) diff --git a/compiler/typecheck/TcPatSyn.hs b/compiler/typecheck/TcPatSyn.hs index 6e18e93..ed7d22e 100644 --- a/compiler/typecheck/TcPatSyn.hs +++ b/compiler/typecheck/TcPatSyn.hs @@ -254,7 +254,13 @@ tcCheckPatSynDecl PSB{ psb_id = lname@(L _ name), psb_args = details else newMetaSigTyVars ex_tvs -- See the "Existential type variables part of -- Note [Checking against a pattern signature] - ; prov_dicts <- mapM (emitWanted origin) (substTheta subst prov_theta) + ; prov_dicts <- mapM (emitWanted origin) + (substTheta (extendTCvInScopeList subst univ_tvs) prov_theta) + -- Add the free vars of 'prov_theta' to the in_scope set to + -- satisfy the substition invariant. There's no need to + -- add 'ex_tvs' as they are already in the domain of the + -- substitution. + -- See also Note [The substitution invariant] in TyCoRep. ; args' <- zipWithM (tc_arg subst) arg_names arg_tys ; return (ex_tvs', prov_dicts, args') } diff --git a/testsuite/tests/typecheck/should_compile/T11524.hs b/testsuite/tests/typecheck/should_compile/T11524.hs new file mode 100644 index 0000000..d257554 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T11524.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE ExplicitForAll #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE TypeInType #-} + +module T11524 where + +data AType (a :: k) where + AMaybe :: AType Maybe + AInt :: AType Int + AApp :: forall k1 k2 (a :: k1 -> k2) (b :: k1). + AType a -> AType b -> AType (a b) + +pattern PApp :: () => (fun ~ a b) => AType a -> AType b -> AType fun +--pattern PApp :: forall k (fun :: k) k1 (a :: k1 -> k) (b :: k1). +-- () => (fun ~ a b) => AType a -> AType b -> AType fun +pattern PApp fun arg <- AApp fun arg diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index e6f0cfa..b269f58 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -502,3 +502,4 @@ test('RebindHR', normal, compile, ['']) test('RebindNegate', normal, compile, ['']) test('T11397', normal, compile, ['']) test('T11458', normal, compile, ['']) +test('T11524', normal, compile, ['']) From git at git.haskell.org Tue Feb 2 22:56:25 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Feb 2016 22:56:25 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Make TypeError a newtype, add changelog entry (fc5ed86) Message-ID: <20160202225625.96F543A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/fc5ed862ef52efa6e02e291ce441a1300ccc6e9c/ghc >--------------------------------------------------------------- commit fc5ed862ef52efa6e02e291ce441a1300ccc6e9c Author: RyanGlScott Date: Tue Feb 2 09:03:04 2016 -0500 Make TypeError a newtype, add changelog entry Summary: Phab:D866 added the `TypeError` datatype to `Control.Exception` to represent the error that is thrown when `-fdefer-type-errors` is on, but a changelog entry for it was never added. In addition, it should probably be a newtype. Reviewers: austin, hvr, KaneTW, bgamari Reviewed By: KaneTW, bgamari Subscribers: thomie, KaneTW Differential Revision: https://phabricator.haskell.org/D1873 GHC Trac Issues: #10284 (cherry picked from commit a7ad0b91e7dace173ed95f31b221628d50c175e8) >--------------------------------------------------------------- fc5ed862ef52efa6e02e291ce441a1300ccc6e9c docs/users_guide/8.0.1-notes.rst | 8 ++++++++ libraries/base/Control/Exception/Base.hs | 4 +++- libraries/base/changelog.md | 3 +++ 3 files changed, 14 insertions(+), 1 deletion(-) diff --git a/docs/users_guide/8.0.1-notes.rst b/docs/users_guide/8.0.1-notes.rst index 8acd85a..fb293cd 100644 --- a/docs/users_guide/8.0.1-notes.rst +++ b/docs/users_guide/8.0.1-notes.rst @@ -296,6 +296,10 @@ Compiler :ghc-flag:`-this-unit-id` or, if you need compatibility over multiple versions of GHC, :ghc-flag:`-package-name`. +- When :ghc-flag:`-fdefer-type-errors` is enabled and an expression fails to + typecheck, ``Control.Exception.TypeError`` will now be thrown instead of + ``Control.Exception.ErrorCall``. + GHCi ~~~~ @@ -510,6 +514,10 @@ See ``changelog.md`` in the ``base`` package for full release notes. - Enable ``PolyKinds`` in the ``Data.Functor.Const`` module to give ``Const`` the kind ``* -> k -> *`` (see :ghc-ticket:`10039`). +- Add the ``TypeError`` datatype to ``Control.Exception``, which represents the + error that is thrown when an expression fails to typecheck when run using + :ghc-flag:`-fdefer-type-errors`. (see :ghc-ticket:`10284`) + binary ~~~~~~ diff --git a/libraries/base/Control/Exception/Base.hs b/libraries/base/Control/Exception/Base.hs index b609ef2..351771b 100644 --- a/libraries/base/Control/Exception/Base.hs +++ b/libraries/base/Control/Exception/Base.hs @@ -361,7 +361,9 @@ instance Exception NoMethodError -- |An expression that didn't typecheck during compile time was called. -- This is only possible with -fdefer-type-errors. The @String@ gives -- details about the failed type check. -data TypeError = TypeError String +-- +-- @since 4.9.0.0 +newtype TypeError = TypeError String instance Show TypeError where showsPrec _ (TypeError err) = showString err diff --git a/libraries/base/changelog.md b/libraries/base/changelog.md index 8560fe7..7f85f35 100644 --- a/libraries/base/changelog.md +++ b/libraries/base/changelog.md @@ -91,6 +91,9 @@ precision: `log1p`, `expm1`, `log1pexp` and `log1mexp`. These are not available from `Prelude`, but the full class is exported from `Numeric`. + * New `Control.Exception.TypeError` datatype, which is thrown when an + expression fails to typecheck when run using `-fdefer-type-errors` (#10284) + ### New instances * `Alt`, `Dual`, `First`, `Last`, `Product`, and `Sum` now have `Data`, From git at git.haskell.org Tue Feb 2 22:56:28 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Feb 2016 22:56:28 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Use the in_scope set in lint_app (865e746) Message-ID: <20160202225628.4E8D73A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/865e7462dd5171c5ec6c5b7092545fae986261b8/ghc >--------------------------------------------------------------- commit 865e7462dd5171c5ec6c5b7092545fae986261b8 Author: Bartosz Nitka Date: Wed Jan 27 11:59:02 2016 -0800 Use the in_scope set in lint_app This makes the call to `substTy` satisfy the invariant from Note [The substitution invariant] in TyCoRep. Test Plan: ./validate --slow Reviewers: goldfire, austin, bgamari, simonpj Reviewed By: simonpj Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1861 GHC Trac Issues: #11371 (cherry picked from commit 63700a193557ed63a1da18a6a059cb7ec5596796) >--------------------------------------------------------------- 865e7462dd5171c5ec6c5b7092545fae986261b8 compiler/coreSyn/CoreLint.hs | 17 ++++++++++------- 1 file changed, 10 insertions(+), 7 deletions(-) diff --git a/compiler/coreSyn/CoreLint.hs b/compiler/coreSyn/CoreLint.hs index 43dbdaa..7fc386f 100644 --- a/compiler/coreSyn/CoreLint.hs +++ b/compiler/coreSyn/CoreLint.hs @@ -1136,25 +1136,28 @@ lint_app :: SDoc -> LintedKind -> [(LintedType,LintedKind)] -> LintM Kind -- If you edit this function, you may need to update the GHC formalism -- See Note [GHC Formalism] lint_app doc kfn kas - = foldlM go_app kfn kas + = do { in_scope <- getInScope + -- We need the in_scope set to satisfy the invariant in + -- Note [The substitution invariant] in TyCoRep + ; foldlM (go_app in_scope) kfn kas } where fail_msg = vcat [ hang (text "Kind application error in") 2 doc , nest 2 (text "Function kind =" <+> ppr kfn) , nest 2 (text "Arg kinds =" <+> ppr kas) ] - go_app kfn ka + go_app in_scope kfn ka | Just kfn' <- coreView kfn - = go_app kfn' ka + = go_app in_scope kfn' ka - go_app (ForAllTy (Anon kfa) kfb) (_,ka) + go_app _ (ForAllTy (Anon kfa) kfb) (_,ka) = do { unless (ka `eqType` kfa) (addErrL fail_msg) ; return kfb } - go_app (ForAllTy (Named kv _vis) kfn) (ta,ka) + go_app in_scope (ForAllTy (Named kv _vis) kfn) (ta,ka) = do { unless (ka `eqType` tyVarKind kv) (addErrL fail_msg) - ; return (substTyWith [kv] [ta] kfn) } + ; return (substTyWithInScope in_scope [kv] [ta] kfn) } - go_app _ _ = failWithL fail_msg + go_app _ _ _ = failWithL fail_msg {- ********************************************************************* * * From git at git.haskell.org Tue Feb 2 22:56:31 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Feb 2016 22:56:31 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Define CTYPE for more Posix types (9e477d5) Message-ID: <20160202225631.0156D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/9e477d5451c1be9a5093537ea02a694a4575e119/ghc >--------------------------------------------------------------- commit 9e477d5451c1be9a5093537ea02a694a4575e119 Author: Herbert Valerio Riedel Date: Sat Jan 30 18:50:17 2016 +0100 Define CTYPE for more Posix types See also b9f636b3aa962154c1b1515a3acecfbe9071b308 for explaination, as `unix` is slowly migrating to make more use of CApiFFI we need more accurately annotated CTYPES. (cherry picked from commit 6c7760b26133a0490f613895a37ff67045249fc8) >--------------------------------------------------------------- 9e477d5451c1be9a5093537ea02a694a4575e119 libraries/base/System/Posix/Internals.hs | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/libraries/base/System/Posix/Internals.hs b/libraries/base/System/Posix/Internals.hs index 1074a2c..ceac5ff 100644 --- a/libraries/base/System/Posix/Internals.hs +++ b/libraries/base/System/Posix/Internals.hs @@ -62,18 +62,18 @@ puts s = withCAStringLen (s ++ "\n") $ \(p, len) -> do -- --------------------------------------------------------------------------- -- Types -type CFLock = () +data {-# CTYPE "struct flock" #-} CFLock data {-# CTYPE "struct group" #-} CGroup -type CLconv = () -type CPasswd = () -type CSigaction = () +data {-# CTYPE "struct lconv" #-} CLconv +data {-# CTYPE "struct passwd" #-} CPasswd +data {-# CTYPE "struct sigaction" #-} CSigaction data {-# CTYPE "sigset_t" #-} CSigset -type CStat = () -type CTermios = () -type CTm = () -type CTms = () -type CUtimbuf = () -type CUtsname = () +data {-# CTYPE "struct stat" #-} CStat +data {-# CTYPE "struct termios" #-} CTermios +data {-# CTYPE "struct tm" #-} CTm +data {-# CTYPE "struct tms" #-} CTms +data {-# CTYPE "struct utimbuf" #-} CUtimbuf +data {-# CTYPE "struct utsname" #-} CUtsname type FD = CInt From git at git.haskell.org Wed Feb 3 15:47:26 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 3 Feb 2016 15:47:26 +0000 (UTC) Subject: [commit: ghc] master: Allow all RTS options to iserv (db121b2) Message-ID: <20160203154726.B02323A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/db121b2ec4596b99fed9781ec2d055f29e0d5b20/ghc >--------------------------------------------------------------- commit db121b2ec4596b99fed9781ec2d055f29e0d5b20 Author: Simon Marlow Date: Wed Feb 3 07:33:40 2016 -0800 Allow all RTS options to iserv >--------------------------------------------------------------- db121b2ec4596b99fed9781ec2d055f29e0d5b20 iserv/cbits/iservmain.c | 1 + 1 file changed, 1 insertion(+) diff --git a/iserv/cbits/iservmain.c b/iserv/cbits/iservmain.c index f7eb566..daefd35 100644 --- a/iserv/cbits/iservmain.c +++ b/iserv/cbits/iservmain.c @@ -11,6 +11,7 @@ int main (int argc, char *argv[]) // we must retain CAFs for running interpreted code. conf.keep_cafs = 1; + conf.rts_opts_enabled = RtsOptsAll; extern StgClosure ZCMain_main_closure; hs_main(argc, argv, &ZCMain_main_closure, conf); } From git at git.haskell.org Thu Feb 4 09:27:05 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 4 Feb 2016 09:27:05 +0000 (UTC) Subject: [commit: ghc] master: Overhaul the Overhauled Pattern Match Checker (28f951e) Message-ID: <20160204092705.5E4E43A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/28f951edfe50ea5182065144340061ec326781f5/ghc >--------------------------------------------------------------- commit 28f951edfe50ea5182065144340061ec326781f5 Author: George Karachalias Date: Wed Feb 3 19:06:45 2016 +0100 Overhaul the Overhauled Pattern Match Checker Overhaul the Overhauled Pattern Match Checker * Changed the representation of Value Set Abstractions. Instead of using a prefix tree, we now use a list of Value Vector Abstractions. The set of constraints Delta for every Value Vector Abstraction is the oracle state so that we solve everything only once. * Instead of doing everything lazily, we prune at once (and in general everything is much stricter). Hence, an example written with pattern guards is checked in almost the same time as the equivalent with pattern matching. * Do not store the covered and the divergent sets at all. Since what we only need is a yes/no (does this clause cover anything? Does it force any thunk?) We just keep a boolean for each. * Removed flags `-Wtoo-many-guards` and `-ffull-guard-reasoning`. Replaced with `fmax-pmcheck-iterations=n`. Still debatable what should the default `n` be. * When a guard is for sure not going to contribute anything, we treat it as such: The oracle is not called and cases `CGuard`, `UGuard` and `DGuard` from the paper are not happening at all (the generation of a fresh variable, the unfolding of the pattern list etc.). his combined with the above seems to be enough to drop the memory increase for test T783 down to 18.7%. * Do not export function `dsPmWarn` (it is now called directly from within `checkSingle` and `checkMatches`). * Make `PmExprVar` hold a `Name` instead of an `Id`. The term oracle does not handle type information so using `Id` was a waste of time/space. * Added testcases T11195, T11303b (data families) and T11374 The patch addresses at least the following: Trac #11195, #11276, #11303, #11374, #11162 Test Plan: validate Reviewers: goldfire, bgamari, hvr, austin Subscribers: simonpj, thomie Differential Revision: https://phabricator.haskell.org/D1795 >--------------------------------------------------------------- 28f951edfe50ea5182065144340061ec326781f5 compiler/deSugar/Check.hs | 1236 +++++++++----------- compiler/deSugar/DsMonad.hs | 39 +- compiler/deSugar/Match.hs | 16 +- compiler/deSugar/PmExpr.hs | 31 +- compiler/deSugar/TmOracle.hs | 34 +- compiler/ghci/RtClosureInspect.hs | 3 - compiler/main/DynFlags.hs | 12 +- compiler/nativeGen/Dwarf/Constants.hs | 4 - compiler/typecheck/TcRnTypes.hs | 3 +- compiler/types/OptCoercion.hs | 4 +- docs/users_guide/8.0.1-notes.rst | 9 - docs/users_guide/bugs.rst | 10 - docs/users_guide/using-warnings.rst | 34 - libraries/base/Foreign/C/Error.hs | 1 - testsuite/tests/perf/compiler/all.T | 4 +- testsuite/tests/pmcheck/should_compile/T11195.hs | 189 +++ testsuite/tests/pmcheck/should_compile/T11303b.hs | 25 + testsuite/tests/pmcheck/should_compile/T11374.hs | 59 + .../tests/pmcheck/should_compile/T2204.stderr | 6 +- .../tests/pmcheck/should_compile/T9951b.stderr | 6 +- testsuite/tests/pmcheck/should_compile/all.T | 3 + .../tests/pmcheck/should_compile/pmc001.stderr | 12 +- .../tests/pmcheck/should_compile/pmc007.stderr | 12 +- utils/mkUserGuidePart/Options/Warnings.hs | 13 - 24 files changed, 914 insertions(+), 851 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 28f951edfe50ea5182065144340061ec326781f5 From git at git.haskell.org Thu Feb 4 10:14:25 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 4 Feb 2016 10:14:25 +0000 (UTC) Subject: [commit: ghc] master: Fix a few loose ends from D1795 (bbc0ec5) Message-ID: <20160204101425.2A31A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/bbc0ec5733df434878b02f7556a1cc947718a8b1/ghc >--------------------------------------------------------------- commit bbc0ec5733df434878b02f7556a1cc947718a8b1 Author: Ben Gamari Date: Thu Feb 4 10:46:28 2016 +0100 Fix a few loose ends from D1795 George updated the Diff but I didn't noticed until it was too late. >--------------------------------------------------------------- bbc0ec5733df434878b02f7556a1cc947718a8b1 compiler/deSugar/Check.hs | 2 +- compiler/deSugar/DsMonad.hs | 3 --- docs/users_guide/8.0.1-notes.rst | 8 ++++++++ 3 files changed, 9 insertions(+), 4 deletions(-) diff --git a/compiler/deSugar/Check.hs b/compiler/deSugar/Check.hs index a28e39e..5570ce9 100644 --- a/compiler/deSugar/Check.hs +++ b/compiler/deSugar/Check.hs @@ -1272,7 +1272,7 @@ warnPmIters dflags (DsMatchContext kind loc) ctxt = pprMatchContext kind msg is = fsep [ text "Pattern match checker exceeded" , parens (ppr is), text "iterations in", ctxt <> dot - , text "(Use fmax-pmcheck-iterations=n" + , text "(Use -fmax-pmcheck-iterations=n" , text "to set the maximun number of iterations to n)" ] flag_i = wopt Opt_WarnOverlappingPatterns dflags diff --git a/compiler/deSugar/DsMonad.hs b/compiler/deSugar/DsMonad.hs index 3d922f6..0d19ff9 100644 --- a/compiler/deSugar/DsMonad.hs +++ b/compiler/deSugar/DsMonad.hs @@ -362,9 +362,6 @@ addTmCsDs :: Bag SimpleEq -> DsM a -> DsM a addTmCsDs tm_cs = updLclEnv (\env -> env { dsl_tm_cs = unionBags tm_cs (dsl_tm_cs env) }) --- | Check that we have not done more iterations --- than we are supposed to and inrease the counter - -- | Increase the counter for elapsed pattern match check iterations. -- If the current counter is already over the limit, fail incrCheckPmIterDs :: DsM () diff --git a/docs/users_guide/8.0.1-notes.rst b/docs/users_guide/8.0.1-notes.rst index 10eab70..f537c54 100644 --- a/docs/users_guide/8.0.1-notes.rst +++ b/docs/users_guide/8.0.1-notes.rst @@ -287,6 +287,14 @@ Compiler warns in the case of unused term-level patterns. Both flags are implied by :ghc-flag:`-W`. +- Added the :ghc-flag:`-fmax-pmcheck-iterations` to control how many times + the pattern match checker iterates. Since coverage checking is exponential + in the general case, setting a default number of iterations prevents memory + and performance blowups. By default, the number of iterations is set to + 10000000 but it can be set to ``n`` with: ``-fmax-pmcheck-iterations=n``. + If the set number of iterations is exceeded, an informative warning is + issued. + - :ghc-flag:`-this-package-key` has been renamed again (hopefully for the last time!) to :ghc-flag:`-this-unit-id`. The renaming was motivated by the fact that the identifier you pass to GHC here doesn't have much to do with packages: From git at git.haskell.org Thu Feb 4 10:46:36 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 4 Feb 2016 10:46:36 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Allow all RTS options to iserv (ac11de6) Message-ID: <20160204104636.E849C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/ac11de6c4775bb08fbdfbf35536dc39a425508f0/ghc >--------------------------------------------------------------- commit ac11de6c4775bb08fbdfbf35536dc39a425508f0 Author: Simon Marlow Date: Wed Feb 3 07:33:40 2016 -0800 Allow all RTS options to iserv (cherry picked from commit db121b2ec4596b99fed9781ec2d055f29e0d5b20) >--------------------------------------------------------------- ac11de6c4775bb08fbdfbf35536dc39a425508f0 iserv/cbits/iservmain.c | 1 + 1 file changed, 1 insertion(+) diff --git a/iserv/cbits/iservmain.c b/iserv/cbits/iservmain.c index f7eb566..daefd35 100644 --- a/iserv/cbits/iservmain.c +++ b/iserv/cbits/iservmain.c @@ -11,6 +11,7 @@ int main (int argc, char *argv[]) // we must retain CAFs for running interpreted code. conf.keep_cafs = 1; + conf.rts_opts_enabled = RtsOptsAll; extern StgClosure ZCMain_main_closure; hs_main(argc, argv, &ZCMain_main_closure, conf); } From git at git.haskell.org Thu Feb 4 10:46:40 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 4 Feb 2016 10:46:40 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Overhaul the Overhauled Pattern Match Checker (6e23b68) Message-ID: <20160204104640.B46373A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/6e23b68047a2c995562eba173fe9485cae18bff2/ghc >--------------------------------------------------------------- commit 6e23b68047a2c995562eba173fe9485cae18bff2 Author: George Karachalias Date: Wed Feb 3 19:06:45 2016 +0100 Overhaul the Overhauled Pattern Match Checker Overhaul the Overhauled Pattern Match Checker * Changed the representation of Value Set Abstractions. Instead of using a prefix tree, we now use a list of Value Vector Abstractions. The set of constraints Delta for every Value Vector Abstraction is the oracle state so that we solve everything only once. * Instead of doing everything lazily, we prune at once (and in general everything is much stricter). Hence, an example written with pattern guards is checked in almost the same time as the equivalent with pattern matching. * Do not store the covered and the divergent sets at all. Since what we only need is a yes/no (does this clause cover anything? Does it force any thunk?) We just keep a boolean for each. * Removed flags `-Wtoo-many-guards` and `-ffull-guard-reasoning`. Replaced with `fmax-pmcheck-iterations=n`. Still debatable what should the default `n` be. * When a guard is for sure not going to contribute anything, we treat it as such: The oracle is not called and cases `CGuard`, `UGuard` and `DGuard` from the paper are not happening at all (the generation of a fresh variable, the unfolding of the pattern list etc.). his combined with the above seems to be enough to drop the memory increase for test T783 down to 18.7%. * Do not export function `dsPmWarn` (it is now called directly from within `checkSingle` and `checkMatches`). * Make `PmExprVar` hold a `Name` instead of an `Id`. The term oracle does not handle type information so using `Id` was a waste of time/space. * Added testcases T11195, T11303b (data families) and T11374 The patch addresses at least the following: Trac #11195, #11276, #11303, #11374, #11162 Test Plan: validate Reviewers: goldfire, bgamari, hvr, austin Subscribers: simonpj, thomie Differential Revision: https://phabricator.haskell.org/D1795 (cherry picked from commit 28f951edfe50ea5182065144340061ec326781f5) >--------------------------------------------------------------- 6e23b68047a2c995562eba173fe9485cae18bff2 compiler/deSugar/Check.hs | 1236 +++++++++----------- compiler/deSugar/DsMonad.hs | 39 +- compiler/deSugar/Match.hs | 16 +- compiler/deSugar/PmExpr.hs | 31 +- compiler/deSugar/TmOracle.hs | 34 +- compiler/ghci/RtClosureInspect.hs | 3 - compiler/main/DynFlags.hs | 12 +- compiler/nativeGen/Dwarf/Constants.hs | 4 - compiler/typecheck/TcRnTypes.hs | 3 +- compiler/types/OptCoercion.hs | 4 +- docs/users_guide/8.0.1-notes.rst | 9 - docs/users_guide/bugs.rst | 10 - docs/users_guide/using-warnings.rst | 34 - libraries/base/Foreign/C/Error.hs | 1 - testsuite/tests/perf/compiler/all.T | 4 +- testsuite/tests/pmcheck/should_compile/T11195.hs | 189 +++ testsuite/tests/pmcheck/should_compile/T11303b.hs | 25 + testsuite/tests/pmcheck/should_compile/T11374.hs | 59 + .../tests/pmcheck/should_compile/T2204.stderr | 6 +- .../tests/pmcheck/should_compile/T9951b.stderr | 6 +- testsuite/tests/pmcheck/should_compile/all.T | 3 + .../tests/pmcheck/should_compile/pmc001.stderr | 12 +- .../tests/pmcheck/should_compile/pmc007.stderr | 12 +- utils/mkUserGuidePart/Options/Warnings.hs | 13 - 24 files changed, 914 insertions(+), 851 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 6e23b68047a2c995562eba173fe9485cae18bff2 From git at git.haskell.org Thu Feb 4 10:46:43 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 4 Feb 2016 10:46:43 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Fix a few loose ends from D1795 (e971c03) Message-ID: <20160204104643.6344F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/e971c03c3a297c07140583eb9299767695b6a635/ghc >--------------------------------------------------------------- commit e971c03c3a297c07140583eb9299767695b6a635 Author: Ben Gamari Date: Thu Feb 4 10:46:28 2016 +0100 Fix a few loose ends from D1795 George updated the Diff but I didn't noticed until it was too late. (cherry picked from commit bbc0ec5733df434878b02f7556a1cc947718a8b1) >--------------------------------------------------------------- e971c03c3a297c07140583eb9299767695b6a635 compiler/deSugar/Check.hs | 2 +- compiler/deSugar/DsMonad.hs | 3 --- docs/users_guide/8.0.1-notes.rst | 8 ++++++++ 3 files changed, 9 insertions(+), 4 deletions(-) diff --git a/compiler/deSugar/Check.hs b/compiler/deSugar/Check.hs index a28e39e..5570ce9 100644 --- a/compiler/deSugar/Check.hs +++ b/compiler/deSugar/Check.hs @@ -1272,7 +1272,7 @@ warnPmIters dflags (DsMatchContext kind loc) ctxt = pprMatchContext kind msg is = fsep [ text "Pattern match checker exceeded" , parens (ppr is), text "iterations in", ctxt <> dot - , text "(Use fmax-pmcheck-iterations=n" + , text "(Use -fmax-pmcheck-iterations=n" , text "to set the maximun number of iterations to n)" ] flag_i = wopt Opt_WarnOverlappingPatterns dflags diff --git a/compiler/deSugar/DsMonad.hs b/compiler/deSugar/DsMonad.hs index 3d922f6..0d19ff9 100644 --- a/compiler/deSugar/DsMonad.hs +++ b/compiler/deSugar/DsMonad.hs @@ -362,9 +362,6 @@ addTmCsDs :: Bag SimpleEq -> DsM a -> DsM a addTmCsDs tm_cs = updLclEnv (\env -> env { dsl_tm_cs = unionBags tm_cs (dsl_tm_cs env) }) --- | Check that we have not done more iterations --- than we are supposed to and inrease the counter - -- | Increase the counter for elapsed pattern match check iterations. -- If the current counter is already over the limit, fail incrCheckPmIterDs :: DsM () diff --git a/docs/users_guide/8.0.1-notes.rst b/docs/users_guide/8.0.1-notes.rst index fafadc4..fbed330 100644 --- a/docs/users_guide/8.0.1-notes.rst +++ b/docs/users_guide/8.0.1-notes.rst @@ -279,6 +279,14 @@ Compiler warns in the case of unused term-level patterns. Both flags are implied by :ghc-flag:`-W`. +- Added the :ghc-flag:`-fmax-pmcheck-iterations` to control how many times + the pattern match checker iterates. Since coverage checking is exponential + in the general case, setting a default number of iterations prevents memory + and performance blowups. By default, the number of iterations is set to + 10000000 but it can be set to ``n`` with: ``-fmax-pmcheck-iterations=n``. + If the set number of iterations is exceeded, an informative warning is + issued. + - :ghc-flag:`-this-package-key` has been renamed again (hopefully for the last time!) to :ghc-flag:`-this-unit-id`. The renaming was motivated by the fact that the identifier you pass to GHC here doesn't have much to do with packages: From git at git.haskell.org Thu Feb 4 21:10:15 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 4 Feb 2016 21:10:15 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Bump Cabal submodule (e223022) Message-ID: <20160204211015.C58D83A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/e2230228906a1c0fa1f86a0c1aa18d87de3cc49d/ghc >--------------------------------------------------------------- commit e2230228906a1c0fa1f86a0c1aa18d87de3cc49d Author: Ben Gamari Date: Thu Feb 4 17:16:47 2016 +0100 Bump Cabal submodule >--------------------------------------------------------------- e2230228906a1c0fa1f86a0c1aa18d87de3cc49d libraries/Cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/Cabal b/libraries/Cabal index ecdf65a..7aab356 160000 --- a/libraries/Cabal +++ b/libraries/Cabal @@ -1 +1 @@ -Subproject commit ecdf65a3c1e01b798e9d073258a6d1c8ff63a6d8 +Subproject commit 7aab3566e721c30ff5847a21051d5b5047176dc7 From git at git.haskell.org Thu Feb 4 21:26:20 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 4 Feb 2016 21:26:20 +0000 (UTC) Subject: [commit: ghc] master: Remove unused LiveVars and SRT fields of StgCase and StgLetNoEscape (4f9967a) Message-ID: <20160204212620.2E4E63A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4f9967aa3d1f7cfd539d0c173cafac0fe290e26f/ghc >--------------------------------------------------------------- commit 4f9967aa3d1f7cfd539d0c173cafac0fe290e26f Author: ?mer Sinan A?acan Date: Thu Feb 4 16:22:48 2016 -0500 Remove unused LiveVars and SRT fields of StgCase and StgLetNoEscape Also remove the functions and types that became useless after removing the fields: - SRT functions - LiveInfo type and functions - freeVarsToLiveVars - unariseLives and unariseSRT Reviewers: bgamari, simonpj, austin Reviewed By: simonpj Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1880 >--------------------------------------------------------------- 4f9967aa3d1f7cfd539d0c173cafac0fe290e26f compiler/codeGen/StgCmm.hs | 2 +- compiler/codeGen/StgCmmBind.hs | 4 +- compiler/codeGen/StgCmmExpr.hs | 6 +- compiler/main/HscMain.hs | 4 +- compiler/profiling/SCCfinal.hs | 24 ++--- compiler/simplStg/StgStats.hs | 6 +- compiler/simplStg/UnariseStg.hs | 26 ++--- compiler/stgSyn/CoreToStg.hs | 224 ++++++++++------------------------------ compiler/stgSyn/StgLint.hs | 8 +- compiler/stgSyn/StgSyn.hs | 135 +++++++++--------------- 10 files changed, 134 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 4f9967aa3d1f7cfd539d0c173cafac0fe290e26f From git at git.haskell.org Fri Feb 5 13:55:42 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 5 Feb 2016 13:55:42 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Fix the Windows build (53dfaf7) Message-ID: <20160205135542.25E4D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/53dfaf723548001fc4ff0d40793ec1abe5d23dce/ghc >--------------------------------------------------------------- commit 53dfaf723548001fc4ff0d40793ec1abe5d23dce Author: Thomas Miedema Date: Fri Jan 29 05:32:38 2016 +0100 Fix the Windows build >--------------------------------------------------------------- 53dfaf723548001fc4ff0d40793ec1abe5d23dce compiler/ghci/GHCi.hs | 1 + rts/ProfHeap.c | 2 +- rts/Profiling.c | 2 +- 3 files changed, 3 insertions(+), 2 deletions(-) diff --git a/compiler/ghci/GHCi.hs b/compiler/ghci/GHCi.hs index 9a33c68..80aeccf 100644 --- a/compiler/ghci/GHCi.hs +++ b/compiler/ghci/GHCi.hs @@ -75,6 +75,7 @@ import System.Exit import Data.Maybe import GHC.IO.Handle.Types (Handle) #ifdef mingw32_HOST_OS +import Foreign.C import GHC.IO.Handle.FD (fdToHandle) #else import System.Posix as Posix diff --git a/rts/ProfHeap.c b/rts/ProfHeap.c index 23b1f9a..8eea62f 100644 --- a/rts/ProfHeap.c +++ b/rts/ProfHeap.c @@ -515,7 +515,7 @@ fprint_ccs(FILE *fp, CostCentreStack *ccs, nat max_length) return; } - fprintf(fp, "(%ld)", ccs->ccsID); + fprintf(fp, "(%" FMT_Int ")", ccs->ccsID); p = buf; buf_end = buf + max_length + 1; diff --git a/rts/Profiling.c b/rts/Profiling.c index c67b081..4f2606c 100644 --- a/rts/Profiling.c +++ b/rts/Profiling.c @@ -951,7 +951,7 @@ logCCS(CostCentreStack *ccs, nat indent, max_module_len - strlen_utf8(cc->module), ""); fprintf(prof_file, - " %*ld %11" FMT_Word64 " %5.1f %5.1f %5.1f %5.1f", + " %*" FMT_Int "%11" FMT_Word64 " %5.1f %5.1f %5.1f %5.1f", max_id_len, ccs->ccsID, ccs->scc_count, total_prof_ticks == 0 ? 0.0 : ((double)ccs->time_ticks / (double)total_prof_ticks * 100.0), total_alloc == 0 ? 0.0 : ((double)ccs->mem_alloc / (double)total_alloc * 100.0), From git at git.haskell.org Fri Feb 5 14:28:58 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 5 Feb 2016 14:28:58 +0000 (UTC) Subject: [commit: ghc] master: Use default xz compression level (91a56e9) Message-ID: <20160205142858.4A13E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/91a56e9de1e4e0487af7b3610531b81a74205959/ghc >--------------------------------------------------------------- commit 91a56e9de1e4e0487af7b3610531b81a74205959 Author: Ben Gamari Date: Fri Feb 5 13:37:05 2016 +0100 Use default xz compression level -9e is crazy expensive for very little pay-off. See http://smart-cactus.org/~ben/posts/2016-02-04-compression-comparison.html for details. >--------------------------------------------------------------- 91a56e9de1e4e0487af7b3610531b81a74205959 mk/config.mk.in | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/mk/config.mk.in b/mk/config.mk.in index 94ba5d7..e3afde2 100644 --- a/mk/config.mk.in +++ b/mk/config.mk.in @@ -772,7 +772,7 @@ PATCH_CMD = @PatchCmd@ TAR_CMD = @TarCmd@ BZIP2_CMD = bzip2 GZIP_CMD = gzip -XZ_CMD = xz -9e +XZ_CMD = xz # xz is default compression TAR_COMP ?= xz From git at git.haskell.org Fri Feb 5 17:39:05 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 5 Feb 2016 17:39:05 +0000 (UTC) Subject: [commit: ghc] master: GHCi: Fix Windows build (again) (70980b1) Message-ID: <20160205173905.B85C73A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/70980b115e33e32b9730825aeebf20fae1859101/ghc >--------------------------------------------------------------- commit 70980b115e33e32b9730825aeebf20fae1859101 Author: Ben Gamari Date: Fri Feb 5 16:11:01 2016 +0100 GHCi: Fix Windows build (again) GHC.Conc exports Shutdown >--------------------------------------------------------------- 70980b115e33e32b9730825aeebf20fae1859101 compiler/ghci/GHCi.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/ghci/GHCi.hs b/compiler/ghci/GHCi.hs index 80aeccf..7097e66 100644 --- a/compiler/ghci/GHCi.hs +++ b/compiler/ghci/GHCi.hs @@ -81,7 +81,7 @@ import GHC.IO.Handle.FD (fdToHandle) import System.Posix as Posix #endif import System.Process -import GHC.Conc +import GHC.Conc (getNumProcessors, pseq, par) {- Note [Remote GHCi] From git at git.haskell.org Fri Feb 5 17:53:45 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 5 Feb 2016 17:53:45 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: GHCi: Fix Windows build (again) (5b35c55) Message-ID: <20160205175345.E16C93A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/5b35c5509adb1311856faa0bc9767aec9ad5e9b7/ghc >--------------------------------------------------------------- commit 5b35c5509adb1311856faa0bc9767aec9ad5e9b7 Author: Ben Gamari Date: Fri Feb 5 16:11:01 2016 +0100 GHCi: Fix Windows build (again) GHC.Conc exports Shutdown (cherry picked from commit 70980b115e33e32b9730825aeebf20fae1859101) >--------------------------------------------------------------- 5b35c5509adb1311856faa0bc9767aec9ad5e9b7 compiler/ghci/GHCi.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/ghci/GHCi.hs b/compiler/ghci/GHCi.hs index 80aeccf..7097e66 100644 --- a/compiler/ghci/GHCi.hs +++ b/compiler/ghci/GHCi.hs @@ -81,7 +81,7 @@ import GHC.IO.Handle.FD (fdToHandle) import System.Posix as Posix #endif import System.Process -import GHC.Conc +import GHC.Conc (getNumProcessors, pseq, par) {- Note [Remote GHCi] From git at git.haskell.org Sat Feb 6 09:36:03 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 6 Feb 2016 09:36:03 +0000 (UTC) Subject: [commit: ghc] branch 'wip/pretty32' created Message-ID: <20160206093603.E491A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/pretty32 Referencing: d21262e73caa1dcade72790f6639c9e56ffd8211 From git at git.haskell.org Sat Feb 6 09:36:06 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 6 Feb 2016 09:36:06 +0000 (UTC) Subject: [commit: ghc] wip/pretty32: Experimental fix for pretty:32 (d21262e) Message-ID: <20160206093606.911633A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/pretty32 Link : http://ghc.haskell.org/trac/ghc/changeset/d21262e73caa1dcade72790f6639c9e56ffd8211/ghc >--------------------------------------------------------------- commit d21262e73caa1dcade72790f6639c9e56ffd8211 Author: Thomas Miedema Date: Sat Feb 6 10:35:42 2016 +0100 Experimental fix for pretty:32 https://github.com/haskell/pretty/issues/32 >--------------------------------------------------------------- d21262e73caa1dcade72790f6639c9e56ffd8211 compiler/utils/Pretty.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/compiler/utils/Pretty.hs b/compiler/utils/Pretty.hs index 74d69f2..ff70ddf 100644 --- a/compiler/utils/Pretty.hs +++ b/compiler/utils/Pretty.hs @@ -718,13 +718,13 @@ beside :: Doc -> Bool -> RDoc -> RDoc beside NoDoc _ _ = NoDoc beside (p1 `Union` p2) g q = beside p1 g q `union_` beside p2 g q beside Empty _ q = q -beside (Nest k p) g q = nest_ k $! beside p g q +beside (Nest k p) g q = nest_ k $ beside p g q beside p@(Beside p1 g1 q1) g2 q2 - | g1 == g2 = beside p1 g1 $! beside q1 g2 q2 + | g1 == g2 = beside p1 g1 $ beside q1 g2 q2 | otherwise = beside (reduceDoc p) g2 q2 beside p@(Above{}) g q = let !d = reduceDoc p in beside d g q -beside (NilAbove p) g q = nilAbove_ $! beside p g q -beside (TextBeside s sl p) g q = textBeside_ s sl $! rest +beside (NilAbove p) g q = nilAbove_ $ beside p g q +beside (TextBeside s sl p) g q = textBeside_ s sl $ rest where rest = case p of Empty -> nilBeside g q From git at git.haskell.org Sat Feb 6 10:32:31 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 6 Feb 2016 10:32:31 +0000 (UTC) Subject: [commit: ghc] master: Fix @since annotations for renamed pretty{CallStack, SrcLoc} (8aa9f35) Message-ID: <20160206103231.2D9443A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8aa9f35e4c5e14410bc76ab08ef73f1abe700189/ghc >--------------------------------------------------------------- commit 8aa9f35e4c5e14410bc76ab08ef73f1abe700189 Author: Herbert Valerio Riedel Date: Sat Feb 6 11:33:14 2016 +0100 Fix @since annotations for renamed pretty{CallStack,SrcLoc} >--------------------------------------------------------------- 8aa9f35e4c5e14410bc76ab08ef73f1abe700189 libraries/base/GHC/Exception.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/libraries/base/GHC/Exception.hs b/libraries/base/GHC/Exception.hs index 187ff88..ad50cec 100644 --- a/libraries/base/GHC/Exception.hs +++ b/libraries/base/GHC/Exception.hs @@ -202,7 +202,7 @@ showCCSStack stk = "CallStack (from -prof):" : map (" " ++) (reverse stk) -- | Pretty print a 'SrcLoc'. -- --- @since 4.8.1.0 +-- @since 4.9.0.0 prettySrcLoc :: SrcLoc -> String prettySrcLoc SrcLoc {..} = foldr (++) "" @@ -214,7 +214,7 @@ prettySrcLoc SrcLoc {..} -- | Pretty print a 'CallStack'. -- --- @since 4.8.1.0 +-- @since 4.9.0.0 prettyCallStack :: CallStack -> String prettyCallStack = intercalate "\n" . prettyCallStackLines From git at git.haskell.org Sat Feb 6 13:45:53 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 6 Feb 2016 13:45:53 +0000 (UTC) Subject: [commit: ghc] master: Add a derived `Show SrcLoc` instance (38af3d1) Message-ID: <20160206134553.280543A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/38af3d1db2889423a12a2232b9d52181bba23d75/ghc >--------------------------------------------------------------- commit 38af3d1db2889423a12a2232b9d52181bba23d75 Author: Eric Seidel Date: Sat Feb 6 14:16:53 2016 +0100 Add a derived `Show SrcLoc` instance Test Plan: ``` ghci> import GHC.Stack ghci> SrcLoc "f" "b" "c" 1 2 3 4 SrcLoc {srcLocPackage = "f", srcLocModule = "b", srcLocFile = "c", srcLocStartLine = 1, srcLocStartCol = 2, srcLocEndLine = 3, srcLocEndCol = 4} ``` Reviewers: austin, hvr, bgamari Reviewed By: bgamari Subscribers: thomie Projects: #ghc Differential Revision: https://phabricator.haskell.org/D1886 GHC Trac Issues: #11510 >--------------------------------------------------------------- 38af3d1db2889423a12a2232b9d52181bba23d75 libraries/base/GHC/Show.hs | 3 +++ testsuite/tests/ghci.debugger/scripts/break006.stderr | 4 ++-- testsuite/tests/ghci.debugger/scripts/print019.stderr | 2 +- .../tests/overloadedlists/should_fail/overloadedlistsfail01.stderr | 2 +- testsuite/tests/typecheck/should_compile/holes2.stderr | 2 +- testsuite/tests/typecheck/should_fail/tcfail133.stderr | 2 +- 6 files changed, 9 insertions(+), 6 deletions(-) diff --git a/libraries/base/GHC/Show.hs b/libraries/base/GHC/Show.hs index 4322aff..a3807bb 100644 --- a/libraries/base/GHC/Show.hs +++ b/libraries/base/GHC/Show.hs @@ -52,6 +52,7 @@ module GHC.Show import GHC.Base import GHC.List ((!!), foldr1, break) import GHC.Num +import GHC.Stack.Types -- | The @shows@ functions return a function that prepends the -- output 'String' to an existing 'String'. This allows constant-time @@ -204,6 +205,8 @@ instance Show TrName where instance Show Module where showsPrec _ (Module p m) = shows p . (':' :) . shows m +deriving instance Show SrcLoc + -------------------------------------------------------------- -- Show instances for the first few tuple -------------------------------------------------------------- diff --git a/testsuite/tests/ghci.debugger/scripts/break006.stderr b/testsuite/tests/ghci.debugger/scripts/break006.stderr index 3b57eb3..b04dd16 100644 --- a/testsuite/tests/ghci.debugger/scripts/break006.stderr +++ b/testsuite/tests/ghci.debugger/scripts/break006.stderr @@ -10,7 +10,7 @@ instance Show Ordering -- Defined in ?GHC.Show? instance Show Integer -- Defined in ?GHC.Show? ...plus 23 others - ...plus 19 instance involving out-of-scope typess + ...plus 20 instance involving out-of-scope typess (use -fprint-potential-instances to see them all) ? In a stmt of an interactive GHCi command: print it @@ -25,6 +25,6 @@ instance Show Ordering -- Defined in ?GHC.Show? instance Show Integer -- Defined in ?GHC.Show? ...plus 23 others - ...plus 19 instance involving out-of-scope typess + ...plus 20 instance involving out-of-scope typess (use -fprint-potential-instances to see them all) ? In a stmt of an interactive GHCi command: print it diff --git a/testsuite/tests/ghci.debugger/scripts/print019.stderr b/testsuite/tests/ghci.debugger/scripts/print019.stderr index 0dcc854..428abb1 100644 --- a/testsuite/tests/ghci.debugger/scripts/print019.stderr +++ b/testsuite/tests/ghci.debugger/scripts/print019.stderr @@ -9,6 +9,6 @@ instance Show Ordering -- Defined in ?GHC.Show? instance Show Integer -- Defined in ?GHC.Show? ...plus 30 others - ...plus 8 instance involving out-of-scope typess + ...plus 9 instance involving out-of-scope typess (use -fprint-potential-instances to see them all) ? In a stmt of an interactive GHCi command: print it diff --git a/testsuite/tests/overloadedlists/should_fail/overloadedlistsfail01.stderr b/testsuite/tests/overloadedlists/should_fail/overloadedlistsfail01.stderr index 7a43f4f..9a72957 100644 --- a/testsuite/tests/overloadedlists/should_fail/overloadedlistsfail01.stderr +++ b/testsuite/tests/overloadedlists/should_fail/overloadedlistsfail01.stderr @@ -8,7 +8,7 @@ overloadedlistsfail01.hs:5:8: error: instance Show Integer -- Defined in ?GHC.Show? instance Show a => Show (Maybe a) -- Defined in ?GHC.Show? ...plus 22 others - ...plus four instance involving out-of-scope typess + ...plus five instance involving out-of-scope typess (use -fprint-potential-instances to see them all) ? In the expression: print [1] In an equation for ?main?: main = print [1] diff --git a/testsuite/tests/typecheck/should_compile/holes2.stderr b/testsuite/tests/typecheck/should_compile/holes2.stderr index 5541689..f10ea95 100644 --- a/testsuite/tests/typecheck/should_compile/holes2.stderr +++ b/testsuite/tests/typecheck/should_compile/holes2.stderr @@ -8,7 +8,7 @@ holes2.hs:3:5: warning: instance Show Integer -- Defined in ?GHC.Show? instance Show a => Show (Maybe a) -- Defined in ?GHC.Show? ...plus 22 others - ...plus three instance involving out-of-scope typess + ...plus four instance involving out-of-scope typess (use -fprint-potential-instances to see them all) ? In the expression: show _ In an equation for ?f?: f = show _ diff --git a/testsuite/tests/typecheck/should_fail/tcfail133.stderr b/testsuite/tests/typecheck/should_fail/tcfail133.stderr index a178f02..d8795ea 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail133.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail133.stderr @@ -12,7 +12,7 @@ tcfail133.hs:68:7: error: instance (Show a, Show b, Number a, Digit b) => Show (a :@ b) -- Defined at tcfail133.hs:11:54 ...plus 25 others - ...plus three instance involving out-of-scope typess + ...plus four instance involving out-of-scope typess (use -fprint-potential-instances to see them all) ? In the expression: show $ add (One :@ Zero) (One :@ One) In an equation for ?foo?: From git at git.haskell.org Sat Feb 6 14:15:22 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 6 Feb 2016 14:15:22 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Add a derived `Show SrcLoc` instance (bffb7af) Message-ID: <20160206141522.6FFD73A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/bffb7afbde197763b5897b16efb02f5ec4833828/ghc >--------------------------------------------------------------- commit bffb7afbde197763b5897b16efb02f5ec4833828 Author: Eric Seidel Date: Sat Feb 6 14:16:53 2016 +0100 Add a derived `Show SrcLoc` instance Test Plan: ``` ghci> import GHC.Stack ghci> SrcLoc "f" "b" "c" 1 2 3 4 SrcLoc {srcLocPackage = "f", srcLocModule = "b", srcLocFile = "c", srcLocStartLine = 1, srcLocStartCol = 2, srcLocEndLine = 3, srcLocEndCol = 4} ``` Reviewers: austin, hvr, bgamari Reviewed By: bgamari Subscribers: thomie Projects: #ghc Differential Revision: https://phabricator.haskell.org/D1886 GHC Trac Issues: #11510 (cherry picked from commit 38af3d1db2889423a12a2232b9d52181bba23d75) >--------------------------------------------------------------- bffb7afbde197763b5897b16efb02f5ec4833828 libraries/base/GHC/Show.hs | 3 +++ testsuite/tests/ghci.debugger/scripts/break006.stderr | 4 ++-- testsuite/tests/ghci.debugger/scripts/print019.stderr | 2 +- .../tests/overloadedlists/should_fail/overloadedlistsfail01.stderr | 2 +- testsuite/tests/typecheck/should_compile/holes2.stderr | 2 +- testsuite/tests/typecheck/should_fail/tcfail133.stderr | 2 +- 6 files changed, 9 insertions(+), 6 deletions(-) diff --git a/libraries/base/GHC/Show.hs b/libraries/base/GHC/Show.hs index 4322aff..a3807bb 100644 --- a/libraries/base/GHC/Show.hs +++ b/libraries/base/GHC/Show.hs @@ -52,6 +52,7 @@ module GHC.Show import GHC.Base import GHC.List ((!!), foldr1, break) import GHC.Num +import GHC.Stack.Types -- | The @shows@ functions return a function that prepends the -- output 'String' to an existing 'String'. This allows constant-time @@ -204,6 +205,8 @@ instance Show TrName where instance Show Module where showsPrec _ (Module p m) = shows p . (':' :) . shows m +deriving instance Show SrcLoc + -------------------------------------------------------------- -- Show instances for the first few tuple -------------------------------------------------------------- diff --git a/testsuite/tests/ghci.debugger/scripts/break006.stderr b/testsuite/tests/ghci.debugger/scripts/break006.stderr index 3b57eb3..b04dd16 100644 --- a/testsuite/tests/ghci.debugger/scripts/break006.stderr +++ b/testsuite/tests/ghci.debugger/scripts/break006.stderr @@ -10,7 +10,7 @@ instance Show Ordering -- Defined in ?GHC.Show? instance Show Integer -- Defined in ?GHC.Show? ...plus 23 others - ...plus 19 instance involving out-of-scope typess + ...plus 20 instance involving out-of-scope typess (use -fprint-potential-instances to see them all) ? In a stmt of an interactive GHCi command: print it @@ -25,6 +25,6 @@ instance Show Ordering -- Defined in ?GHC.Show? instance Show Integer -- Defined in ?GHC.Show? ...plus 23 others - ...plus 19 instance involving out-of-scope typess + ...plus 20 instance involving out-of-scope typess (use -fprint-potential-instances to see them all) ? In a stmt of an interactive GHCi command: print it diff --git a/testsuite/tests/ghci.debugger/scripts/print019.stderr b/testsuite/tests/ghci.debugger/scripts/print019.stderr index 0dcc854..428abb1 100644 --- a/testsuite/tests/ghci.debugger/scripts/print019.stderr +++ b/testsuite/tests/ghci.debugger/scripts/print019.stderr @@ -9,6 +9,6 @@ instance Show Ordering -- Defined in ?GHC.Show? instance Show Integer -- Defined in ?GHC.Show? ...plus 30 others - ...plus 8 instance involving out-of-scope typess + ...plus 9 instance involving out-of-scope typess (use -fprint-potential-instances to see them all) ? In a stmt of an interactive GHCi command: print it diff --git a/testsuite/tests/overloadedlists/should_fail/overloadedlistsfail01.stderr b/testsuite/tests/overloadedlists/should_fail/overloadedlistsfail01.stderr index 7a43f4f..9a72957 100644 --- a/testsuite/tests/overloadedlists/should_fail/overloadedlistsfail01.stderr +++ b/testsuite/tests/overloadedlists/should_fail/overloadedlistsfail01.stderr @@ -8,7 +8,7 @@ overloadedlistsfail01.hs:5:8: error: instance Show Integer -- Defined in ?GHC.Show? instance Show a => Show (Maybe a) -- Defined in ?GHC.Show? ...plus 22 others - ...plus four instance involving out-of-scope typess + ...plus five instance involving out-of-scope typess (use -fprint-potential-instances to see them all) ? In the expression: print [1] In an equation for ?main?: main = print [1] diff --git a/testsuite/tests/typecheck/should_compile/holes2.stderr b/testsuite/tests/typecheck/should_compile/holes2.stderr index 5541689..f10ea95 100644 --- a/testsuite/tests/typecheck/should_compile/holes2.stderr +++ b/testsuite/tests/typecheck/should_compile/holes2.stderr @@ -8,7 +8,7 @@ holes2.hs:3:5: warning: instance Show Integer -- Defined in ?GHC.Show? instance Show a => Show (Maybe a) -- Defined in ?GHC.Show? ...plus 22 others - ...plus three instance involving out-of-scope typess + ...plus four instance involving out-of-scope typess (use -fprint-potential-instances to see them all) ? In the expression: show _ In an equation for ?f?: f = show _ diff --git a/testsuite/tests/typecheck/should_fail/tcfail133.stderr b/testsuite/tests/typecheck/should_fail/tcfail133.stderr index a178f02..d8795ea 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail133.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail133.stderr @@ -12,7 +12,7 @@ tcfail133.hs:68:7: error: instance (Show a, Show b, Number a, Digit b) => Show (a :@ b) -- Defined at tcfail133.hs:11:54 ...plus 25 others - ...plus three instance involving out-of-scope typess + ...plus four instance involving out-of-scope typess (use -fprint-potential-instances to see them all) ? In the expression: show $ add (One :@ Zero) (One :@ One) In an equation for ?foo?: From git at git.haskell.org Sat Feb 6 14:15:25 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 6 Feb 2016 14:15:25 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Fix @since annotations for renamed pretty{CallStack, SrcLoc} (82cb529) Message-ID: <20160206141525.11F683A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/82cb5292480e78366072f36009c4a5b38f653eca/ghc >--------------------------------------------------------------- commit 82cb5292480e78366072f36009c4a5b38f653eca Author: Herbert Valerio Riedel Date: Sat Feb 6 11:33:14 2016 +0100 Fix @since annotations for renamed pretty{CallStack,SrcLoc} (cherry picked from commit 8aa9f35e4c5e14410bc76ab08ef73f1abe700189) >--------------------------------------------------------------- 82cb5292480e78366072f36009c4a5b38f653eca libraries/base/GHC/Exception.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/libraries/base/GHC/Exception.hs b/libraries/base/GHC/Exception.hs index 187ff88..ad50cec 100644 --- a/libraries/base/GHC/Exception.hs +++ b/libraries/base/GHC/Exception.hs @@ -202,7 +202,7 @@ showCCSStack stk = "CallStack (from -prof):" : map (" " ++) (reverse stk) -- | Pretty print a 'SrcLoc'. -- --- @since 4.8.1.0 +-- @since 4.9.0.0 prettySrcLoc :: SrcLoc -> String prettySrcLoc SrcLoc {..} = foldr (++) "" @@ -214,7 +214,7 @@ prettySrcLoc SrcLoc {..} -- | Pretty print a 'CallStack'. -- --- @since 4.8.1.0 +-- @since 4.9.0.0 prettyCallStack :: CallStack -> String prettyCallStack = intercalate "\n" . prettyCallStackLines From git at git.haskell.org Sat Feb 6 14:15:27 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 6 Feb 2016 14:15:27 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Use default xz compression level (ddb3dc7) Message-ID: <20160206141527.AB83C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/ddb3dc7e63133263c16f02d536b713b2fabc4e67/ghc >--------------------------------------------------------------- commit ddb3dc7e63133263c16f02d536b713b2fabc4e67 Author: Ben Gamari Date: Fri Feb 5 13:37:05 2016 +0100 Use default xz compression level -9e is crazy expensive for very little pay-off. See http://smart-cactus.org/~ben/posts/2016-02-04-compression-comparison.html for details. (cherry picked from commit 91a56e9de1e4e0487af7b3610531b81a74205959) >--------------------------------------------------------------- ddb3dc7e63133263c16f02d536b713b2fabc4e67 mk/config.mk.in | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/mk/config.mk.in b/mk/config.mk.in index d2c042d..ce134e1 100644 --- a/mk/config.mk.in +++ b/mk/config.mk.in @@ -779,7 +779,7 @@ PATCH_CMD = @PatchCmd@ TAR_CMD = @TarCmd@ BZIP2_CMD = bzip2 GZIP_CMD = gzip -XZ_CMD = xz -9e +XZ_CMD = xz # xz is default compression TAR_COMP ?= xz From git at git.haskell.org Sat Feb 6 16:09:28 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 6 Feb 2016 16:09:28 +0000 (UTC) Subject: [commit: ghc] master: Add test for #11516 (b49d509) Message-ID: <20160206160928.1579E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b49d509b336cb74f506555eada8830d754c4b7ba/ghc >--------------------------------------------------------------- commit b49d509b336cb74f506555eada8830d754c4b7ba Author: Ben Gamari Date: Sat Feb 6 15:16:15 2016 +0100 Add test for #11516 >--------------------------------------------------------------- b49d509b336cb74f506555eada8830d754c4b7ba testsuite/tests/typecheck/should_compile/T11516.hs | 11 +++++++++++ testsuite/tests/typecheck/should_compile/all.T | 1 + 2 files changed, 12 insertions(+) diff --git a/testsuite/tests/typecheck/should_compile/T11516.hs b/testsuite/tests/typecheck/should_compile/T11516.hs new file mode 100644 index 0000000..3b19a99 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T11516.hs @@ -0,0 +1,11 @@ +{-# language PolyKinds #-} +{-# language FlexibleContexts #-} +{-# language ConstraintKinds #-} +{-# language FlexibleInstances #-} +{-# language FunctionalDependencies #-} + +import GHC.Exts (Constraint) + +class R?ki (p :: i -> i -> *) +class (R?ki p) => Varpi p q f | f -> p q +instance Varpi () () f => Varpi (->) (->) (Either f) where diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index b269f58..e4b1e41 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -502,4 +502,5 @@ test('RebindHR', normal, compile, ['']) test('RebindNegate', normal, compile, ['']) test('T11397', normal, compile, ['']) test('T11458', normal, compile, ['']) +test('T11516', expect_broken(11516), compile, ['']) test('T11524', normal, compile, ['']) From git at git.haskell.org Sat Feb 6 18:32:32 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 6 Feb 2016 18:32:32 +0000 (UTC) Subject: [commit: ghc] wip/rae: Make exactTyCoVarsOfTypes closed over kinds. (3f1f8a8) Message-ID: <20160206183232.F1FCB3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/3f1f8a88b04d73c26516515aef806ca05a5a99e0/ghc >--------------------------------------------------------------- commit 3f1f8a88b04d73c26516515aef806ca05a5a99e0 Author: Richard Eisenberg Date: Thu Jan 28 17:39:03 2016 -0500 Make exactTyCoVarsOfTypes closed over kinds. >--------------------------------------------------------------- 3f1f8a88b04d73c26516515aef806ca05a5a99e0 compiler/typecheck/TcType.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/typecheck/TcType.hs b/compiler/typecheck/TcType.hs index 63c06af..7395257 100644 --- a/compiler/typecheck/TcType.hs +++ b/compiler/typecheck/TcType.hs @@ -750,7 +750,7 @@ exactTyCoVarsOfType ty = go ty where go ty | Just ty' <- coreView ty = go ty' -- This is the key line - go (TyVarTy tv) = unitVarSet tv + go (TyVarTy tv) = unitVarSet tv `unionVarSet` go (tyVarKind tv) go (TyConApp _ tys) = exactTyCoVarsOfTypes tys go (LitTy {}) = emptyVarSet go (AppTy fun arg) = go fun `unionVarSet` go arg From git at git.haskell.org Sat Feb 6 18:32:35 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 6 Feb 2016 18:32:35 +0000 (UTC) Subject: [commit: ghc] wip/rae: Existentials should be specified. (a061157) Message-ID: <20160206183235.A45933A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/a061157a3a28c039777c4d4d07872e450af974d7/ghc >--------------------------------------------------------------- commit a061157a3a28c039777c4d4d07872e450af974d7 Author: Richard Eisenberg Date: Fri Jan 29 13:09:42 2016 -0500 Existentials should be specified. This addresses point (2) from #11513. >--------------------------------------------------------------- a061157a3a28c039777c4d4d07872e450af974d7 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 0626836..fd25c79 100644 --- a/compiler/basicTypes/DataCon.hs +++ b/compiler/basicTypes/DataCon.hs @@ -768,7 +768,7 @@ mkDataCon name declared_infix prom_info tag = assoc "mkDataCon" (tyConDataCons rep_tycon `zip` [fIRST_TAG..]) con rep_arg_tys = dataConRepArgTys con - rep_ty = mkSpecForAllTys univ_tvs $ mkInvForAllTys ex_tvs $ + rep_ty = mkSpecForAllTys univ_tvs $ mkSpecForAllTys ex_tvs $ mkFunTys rep_arg_tys $ mkTyConApp rep_tycon (mkTyVarTys univ_tvs) From git at git.haskell.org Sat Feb 6 18:32:38 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 6 Feb 2016 18:32:38 +0000 (UTC) Subject: [commit: ghc] wip/rae: Add missing kind cast to pure unifier. (cb443db) Message-ID: <20160206183238.4F1083A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/cb443db7dc666f9ef23bfbfa577ecfac89f02df7/ghc >--------------------------------------------------------------- commit cb443db7dc666f9ef23bfbfa577ecfac89f02df7 Author: Richard Eisenberg Date: Sat Jan 30 16:49:22 2016 -0500 Add missing kind cast to pure unifier. >--------------------------------------------------------------- cb443db7dc666f9ef23bfbfa577ecfac89f02df7 compiler/types/Unify.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/types/Unify.hs b/compiler/types/Unify.hs index 60cc249..183ef47 100644 --- a/compiler/types/Unify.hs +++ b/compiler/types/Unify.hs @@ -790,7 +790,7 @@ uVar tv1 ty kco -- this is because the range of the subst is the target -- type, not the template type. So, just check for -- normal type equality. - guard (ty' `eqType` ty) } + guard ((ty' `mkCastTy` kco) `eqType` ty) } Nothing -> uUnrefined tv1 ty ty kco } -- No, continue uUnrefined :: TyVar -- variable to be unified From git at git.haskell.org Sat Feb 6 18:32:41 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 6 Feb 2016 18:32:41 +0000 (UTC) Subject: [commit: ghc] wip/rae: Remove extraneous fundeps on (~) (6b5f28f) Message-ID: <20160206183241.09E473A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/6b5f28fba0ab79e5a90beaf006b9d26ae06dd1fc/ghc >--------------------------------------------------------------- commit 6b5f28fba0ab79e5a90beaf006b9d26ae06dd1fc Author: Richard Eisenberg Date: Thu Feb 4 18:31:25 2016 -0500 Remove extraneous fundeps on (~) >--------------------------------------------------------------- 6b5f28fba0ab79e5a90beaf006b9d26ae06dd1fc libraries/base/Data/Type/Equality.hs | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/libraries/base/Data/Type/Equality.hs b/libraries/base/Data/Type/Equality.hs index 75d2a6c..e7363d2 100644 --- a/libraries/base/Data/Type/Equality.hs +++ b/libraries/base/Data/Type/Equality.hs @@ -54,7 +54,7 @@ import Data.Type.Bool -- | Lifted, homogeneous equality. By lifted, we mean that it can be -- bogus (deferred type error). By homogeneous, the two types @a@ -- and @b@ must have the same kind. -class a ~~ b => (a :: k) ~ (b :: k) | a -> b, b -> a +class a ~~ b => (a :: k) ~ (b :: k) -- See Note [The equality types story] in TysPrim -- NB: All this class does is to wrap its superclass, which is -- the "real", inhomogeneous equality; this is needed when @@ -62,6 +62,10 @@ class a ~~ b => (a :: k) ~ (b :: k) | a -> b, b -> a -- NB: Not exported, as (~) is magical syntax. That's also why there's -- no fixity. + -- It's tempting to put functional dependencies on (~), but it's not + -- necessary because the functional-depedency coverage check looks + -- through superclasses, and (~#) is handled in that check. + instance {-# INCOHERENT #-} a ~~ b => a ~ b -- See Note [The equality types story] in TysPrim -- If we have a Wanted (t1 ~ t2), we want to immediately From git at git.haskell.org Sat Feb 6 18:32:43 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 6 Feb 2016 18:32:43 +0000 (UTC) Subject: [commit: ghc] wip/rae: Address #11471 by putting RuntimeRep in kinds. (beed34f) Message-ID: <20160206183243.E56E23A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/beed34fbb6f82b8c951773612757fe9e750c7c52/ghc >--------------------------------------------------------------- commit beed34fbb6f82b8c951773612757fe9e750c7c52 Author: Richard Eisenberg Date: Thu Feb 4 10:42:56 2016 -0500 Address #11471 by putting RuntimeRep in kinds. See Note [TYPE] in TysPrim. There are still some outstanding pieces in #11471 though, so this doesn't actually nail the bug. >--------------------------------------------------------------- beed34fbb6f82b8c951773612757fe9e750c7c52 compiler/basicTypes/DataCon.hs | 9 +- compiler/basicTypes/MkId.hs | 29 ++--- compiler/basicTypes/PatSyn.hs | 4 +- compiler/coreSyn/CoreLint.hs | 4 +- compiler/coreSyn/CorePrep.hs | 2 +- compiler/coreSyn/MkCore.hs | 20 ++-- compiler/deSugar/DsBinds.hs | 2 +- compiler/deSugar/DsUtils.hs | 4 +- compiler/ghci/RtClosureInspect.hs | 4 +- compiler/iface/BinIface.hs | 2 +- compiler/iface/BuildTyCl.hs | 2 +- compiler/iface/IfaceEnv.hs | 2 +- compiler/iface/IfaceType.hs | 25 +++-- compiler/iface/TcIface.hs | 4 +- compiler/prelude/PrelNames.hs | 27 ++++- compiler/prelude/PrimOp.hs | 2 +- compiler/prelude/TysPrim.hs | 123 ++++++++++++++------- compiler/prelude/TysWiredIn.hs | 213 ++++++++++++++++++++++++++++++++---- compiler/prelude/TysWiredIn.hs-boot | 21 +++- compiler/typecheck/TcBinds.hs | 2 +- compiler/typecheck/TcCanonical.hs | 2 - compiler/typecheck/TcExpr.hs | 12 +- compiler/typecheck/TcHsSyn.hs | 4 +- compiler/typecheck/TcHsType.hs | 29 ++--- compiler/typecheck/TcInstDcls.hs | 2 +- compiler/typecheck/TcMType.hs | 26 ++--- compiler/typecheck/TcPat.hs | 4 +- compiler/typecheck/TcPatSyn.hs | 18 +-- compiler/typecheck/TcRnDriver.hs | 2 +- compiler/typecheck/TcSMonad.hs | 6 +- compiler/typecheck/TcSimplify.hs | 22 ++-- compiler/typecheck/TcType.hs | 4 +- compiler/typecheck/TcTypeable.hs | 1 - compiler/types/Kind.hs | 31 ++---- compiler/types/TyCoRep.hs | 56 ++++++---- compiler/types/TyCon.hs | 121 +++++++++++--------- compiler/types/Type.hs | 74 ++++++++----- compiler/utils/Util.hs | 16 +++ compiler/vectorise/Vectorise/Exp.hs | 2 +- libraries/base/Data/Data.hs | 2 +- libraries/base/GHC/Err.hs | 8 +- libraries/base/GHC/Exts.hs | 4 +- libraries/ghc-prim/GHC/Types.hs | 73 ++++++++++-- utils/genprimopcode/Main.hs | 2 +- 44 files changed, 689 insertions(+), 333 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 beed34fbb6f82b8c951773612757fe9e750c7c52 From git at git.haskell.org Sat Feb 6 18:32:47 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 6 Feb 2016 18:32:47 +0000 (UTC) Subject: [commit: ghc] wip/rae's head updated: Address #11471 by putting RuntimeRep in kinds. (beed34f) Message-ID: <20160206183247.246693A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/rae' now includes: 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 3f1f8a8 Make exactTyCoVarsOfTypes closed over kinds. a061157 Existentials should be specified. cb443db Add missing kind cast to pure unifier. 6b5f28f Remove extraneous fundeps on (~) beed34f Address #11471 by putting RuntimeRep in kinds. From git at git.haskell.org Sun Feb 7 01:08:07 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 7 Feb 2016 01:08:07 +0000 (UTC) Subject: [commit: ghc] master: Revert "Remove unused LiveVars and SRT fields of StgCase and StgLetNoEscape" (5d73fb6) Message-ID: <20160207010807.697EA3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5d73fb617d541e08e52fc395bdcf45a7c5a2e87e/ghc >--------------------------------------------------------------- commit 5d73fb617d541e08e52fc395bdcf45a7c5a2e87e Author: ?mer Sinan A?acan Date: Sat Feb 6 20:09:27 2016 -0500 Revert "Remove unused LiveVars and SRT fields of StgCase and StgLetNoEscape" This reverts commit 4f9967aa3d1f7cfd539d0c173cafac0fe290e26f. >--------------------------------------------------------------- 5d73fb617d541e08e52fc395bdcf45a7c5a2e87e compiler/codeGen/StgCmm.hs | 2 +- compiler/codeGen/StgCmmBind.hs | 4 +- compiler/codeGen/StgCmmExpr.hs | 6 +- compiler/main/HscMain.hs | 4 +- compiler/profiling/SCCfinal.hs | 24 ++--- compiler/simplStg/StgStats.hs | 6 +- compiler/simplStg/UnariseStg.hs | 26 +++-- compiler/stgSyn/CoreToStg.hs | 224 ++++++++++++++++++++++++++++++---------- compiler/stgSyn/StgLint.hs | 8 +- compiler/stgSyn/StgSyn.hs | 135 +++++++++++++++--------- 10 files changed, 305 insertions(+), 134 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 5d73fb617d541e08e52fc395bdcf45a7c5a2e87e From git at git.haskell.org Sun Feb 7 15:00:21 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 7 Feb 2016 15:00:21 +0000 (UTC) Subject: [commit: ghc] master: hp2ps: mark local functions as 'static' (72545c7) Message-ID: <20160207150021.642D83A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/72545c75556c4404048036ce7e07a447fd199cd5/ghc >--------------------------------------------------------------- commit 72545c75556c4404048036ce7e07a447fd199cd5 Author: Sergei Trofimovich Date: Sun Feb 7 09:29:55 2016 +0000 hp2ps: mark local functions as 'static' Found by uselex.rb: fonttab: [R]: exported from: ./utils/hp2ps/dist/build/Dimensions.o GetString: [R]: exported from: ./utils/hp2ps/dist/build/HpFile.o thestring: [R]: exported from: ./utils/hp2ps/dist/build/HpFile.o auxfp: [R]: exported from: ./utils/hp2ps/dist/build/Main.o dflag: [R]: exported from: ./utils/hp2ps/dist/build/Main.o filter: [R]: exported from: ./utils/hp2ps/dist/build/Main.o iflag: [R]: exported from: ./utils/hp2ps/dist/build/Main.o mflag: [R]: exported from: ./utils/hp2ps/dist/build/Main.o pflag: [R]: exported from: ./utils/hp2ps/dist/build/Main.o psfile: [R]: exported from: ./utils/hp2ps/dist/build/Main.o tflag: [R]: exported from: ./utils/hp2ps/dist/build/Main.o OrderOf: [R]: exported from: ./utils/hp2ps/dist/build/Reorder.o Signed-off-by: Sergei Trofimovich >--------------------------------------------------------------- 72545c75556c4404048036ce7e07a447fd199cd5 utils/hp2ps/Dimensions.c | 2 +- utils/hp2ps/HpFile.c | 4 +++- utils/hp2ps/HpFile.h | 2 -- utils/hp2ps/Main.c | 16 ++++++++-------- utils/hp2ps/Main.h | 4 ---- utils/hp2ps/Reorder.c | 2 +- utils/hp2ps/Reorder.h | 1 - 7 files changed, 13 insertions(+), 18 deletions(-) diff --git a/utils/hp2ps/Dimensions.c b/utils/hp2ps/Dimensions.c index a13ca33..f8e5c85 100644 --- a/utils/hp2ps/Dimensions.c +++ b/utils/hp2ps/Dimensions.c @@ -87,7 +87,7 @@ KeyWidth(void) */ -floatish fonttab[] = { +static floatish fonttab[] = { /* 20 (' ') = */ 3.0, /* 21 ('!') = */ 1.0, /* 22 ('"') = */ 1.0, diff --git a/utils/hp2ps/HpFile.c b/utils/hp2ps/HpFile.c index 12ef8d6..deef582 100644 --- a/utils/hp2ps/HpFile.c +++ b/utils/hp2ps/HpFile.c @@ -18,7 +18,7 @@ double atof PROTO((const char *)); #define N_SAMPLES 500 /* start size of the sample table */ char *theident; -char *thestring; +static char *thestring; int theinteger; floatish thefloatish; int ch; /* last character read */ @@ -39,6 +39,8 @@ static void GetHpTok PROTO((FILE *, int)); /* forward */ static struct entry *GetEntry PROTO((char *)); /* forward */ +static void GetString PROTO((FILE *)); /* forward */ + static void MakeIdentTable PROTO((void)); /* forward */ char *jobstring; diff --git a/utils/hp2ps/HpFile.h b/utils/hp2ps/HpFile.h index 1c43f73..6e01d1e 100644 --- a/utils/hp2ps/HpFile.h +++ b/utils/hp2ps/HpFile.h @@ -44,7 +44,6 @@ struct entry { }; extern char *theident; -extern char *thestring; extern int theinteger; extern floatish thefloatish; extern int ch; @@ -65,7 +64,6 @@ struct entry *MakeEntry PROTO((char *)); token GetNumber PROTO((FILE *)); void GetIdent PROTO((FILE *)); -void GetString PROTO((FILE *)); boolish IsIdChar PROTO((int)); /* int is a "char" from getc */ extern char *jobstring; diff --git a/utils/hp2ps/Main.c b/utils/hp2ps/Main.c index 88f9b08..7731d4c 100644 --- a/utils/hp2ps/Main.c +++ b/utils/hp2ps/Main.c @@ -16,26 +16,26 @@ #include "Error.h" #include "Utilities.h" -boolish pflag = 0; /* read auxiliary file */ +static boolish pflag = 0; /* read auxiliary file */ boolish eflag = 0; /* scaled EPSF */ -boolish dflag = 0; /* sort by standard deviation */ -int iflag = 0; /* sort by identifier (3-way flag) */ +static boolish dflag = 0; /* sort by standard deviation */ +static int iflag = 0; /* sort by identifier (3-way flag) */ boolish gflag = 0; /* output suitable for previewer */ boolish yflag = 0; /* ignore marks */ boolish bflag = 0; /* use a big title box */ boolish sflag = 0; /* use a small title box */ -int mflag = 0; /* max no. of bands displayed (default 20) */ -boolish tflag = 0; /* ignored threshold specified */ +static int mflag = 0; /* max no. of bands displayed (default 20) */ +static boolish tflag = 0; /* ignored threshold specified */ boolish cflag = 0; /* colour output */ -boolish filter; /* true when running as a filter */ +static boolish filter; /* true when running as a filter */ boolish multipageflag = 0; /* true when the output should be 2 pages - key and profile */ static floatish WidthInPoints PROTO((char *)); /* forward */ static FILE *Fp PROTO((char *, char **, char *, char *)); /* forward */ char *hpfile; -char *psfile; +static char *psfile; char *auxfile; char *programname; @@ -45,7 +45,7 @@ static char *baseName; /* "basename" is a std C library name (sigh) */ FILE* hpfp; FILE* psfp; -FILE* auxfp; +static FILE* auxfp; floatish xrange = 0.0; floatish yrange = 0.0; diff --git a/utils/hp2ps/Main.h b/utils/hp2ps/Main.h index 0d0d75f..7a8626b 100644 --- a/utils/hp2ps/Main.h +++ b/utils/hp2ps/Main.h @@ -60,8 +60,6 @@ extern boolish gflag; extern boolish yflag; extern boolish bflag; extern boolish sflag; -extern int mflag; -extern boolish tflag; extern boolish cflag; extern boolish multipageflag; @@ -69,11 +67,9 @@ extern boolish multipageflag; extern char *programname; extern char *hpfile; -extern char *psfile; extern char *auxfile; extern FILE *hpfp; extern FILE *psfp; -extern FILE *auxfp; #endif /* MAIN_H */ diff --git a/utils/hp2ps/Reorder.c b/utils/hp2ps/Reorder.c index 2a7fb98..144b3f9 100644 --- a/utils/hp2ps/Reorder.c +++ b/utils/hp2ps/Reorder.c @@ -43,7 +43,7 @@ OrderFor(char *ident, int order) * Otherwise, return 0 which is the minimum ordering value. */ -int +static int OrderOf(char *ident) { int i; diff --git a/utils/hp2ps/Reorder.h b/utils/hp2ps/Reorder.h index 089ef75..ec3ec98 100644 --- a/utils/hp2ps/Reorder.h +++ b/utils/hp2ps/Reorder.h @@ -2,7 +2,6 @@ #define REORDER_H void Reorder PROTO((void)); -int OrderOf PROTO((char *)); void OrderFor PROTO((char *, int)); #endif /* REORDER_H */ From git at git.haskell.org Sun Feb 7 15:00:24 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 7 Feb 2016 15:00:24 +0000 (UTC) Subject: [commit: ghc] master: unlit: mark local functions as 'static' (f1f5837) Message-ID: <20160207150024.163843A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f1f583799af4e1d14c9c1e95605b30ea5a71c76d/ghc >--------------------------------------------------------------- commit f1f583799af4e1d14c9c1e95605b30ea5a71c76d Author: Sergei Trofimovich Date: Sun Feb 7 09:10:54 2016 +0000 unlit: mark local functions as 'static' Found by uselex.rb: complain: [R]: exported from: ./utils/unlit/dist/build/unlit.o egetc: [R]: exported from: ./utils/unlit/dist/build/unlit.o myputc: [R]: exported from: ./utils/unlit/dist/build/unlit.o readline: [R]: exported from: ./utils/unlit/dist/build/unlit.o unlit: [R]: exported from: ./utils/unlit/dist/build/unlit.o writeerror: [R]: exported from: ./utils/unlit/dist/build/unlit.o Signed-off-by: Sergei Trofimovich >--------------------------------------------------------------- f1f583799af4e1d14c9c1e95605b30ea5a71c76d utils/unlit/unlit.c | 13 ++++++------- 1 file changed, 6 insertions(+), 7 deletions(-) diff --git a/utils/unlit/unlit.c b/utils/unlit/unlit.c index 4ae64d3..c0e3b98 100644 --- a/utils/unlit/unlit.c +++ b/utils/unlit/unlit.c @@ -91,7 +91,7 @@ static char *ofilename = NULL; * if noisy is not set. */ -void complain(char *file, int lin, char *what) +static void complain(char *file, int lin, char *what) { if (noisy) { if (file) @@ -101,7 +101,7 @@ void complain(char *file, int lin, char *what) } } -void writeerror(void) +static void writeerror(void) { if (!strcmp(ofilename,"-")) { fprintf(stderr, CANNOTWRITESTDOUT); @@ -111,7 +111,7 @@ void writeerror(void) exit(1); } -void myputc(char c, FILE *ostream) +static void myputc(char c, FILE *ostream) { if (putc(c,ostream) == EOF) { writeerror(); @@ -121,8 +121,7 @@ void myputc(char c, FILE *ostream) #define TABPOS 8 /* As getc, but does TAB expansion */ -int -egetc(FILE *istream) +static int egetc(FILE *istream) { static int spleft = 0; static int linepos = 0; @@ -171,7 +170,7 @@ egetc(FILE *istream) * stream. */ -line readline(FILE *istream, FILE *ostream) { +static line readline(FILE *istream, FILE *ostream) { int c, c1; char buf[100]; int i; @@ -246,7 +245,7 @@ line readline(FILE *istream, FILE *ostream) { * - there should be at least one DEFN line in a script. */ -void unlit(char *file, FILE *istream, FILE *ostream) +static void unlit(char *file, FILE *istream, FILE *ostream) { line last, this=START; int linesread=0; From git at git.haskell.org Sun Feb 7 15:00:26 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 7 Feb 2016 15:00:26 +0000 (UTC) Subject: [commit: ghc] master: testsuite: ignore *.prof.normalised files (f3923d5) Message-ID: <20160207150026.BE1EC3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f3923d56274b4cbf55c664eefc535ec8483dc5d9/ghc >--------------------------------------------------------------- commit f3923d56274b4cbf55c664eefc535ec8483dc5d9 Author: Sergei Trofimovich Date: Sun Feb 7 15:00:47 2016 +0000 testsuite: ignore *.prof.normalised files Signed-off-by: Sergei Trofimovich >--------------------------------------------------------------- f3923d56274b4cbf55c664eefc535ec8483dc5d9 testsuite/.gitignore | 2 ++ 1 file changed, 2 insertions(+) diff --git a/testsuite/.gitignore b/testsuite/.gitignore index e8e4114..8926e4e 100644 --- a/testsuite/.gitignore +++ b/testsuite/.gitignore @@ -39,6 +39,8 @@ Thumbs.db *.stderr-ws-32.normalised *.interp.stdout *.interp.stderr +*.prof.normalised +*.prof.sample.normalised *.run.stdout *.run.stderr From git at git.haskell.org Sun Feb 7 17:39:08 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 7 Feb 2016 17:39:08 +0000 (UTC) Subject: [commit: ghc] wip/rae: Existentials should be specified. (16aecbe) Message-ID: <20160207173908.471DE3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/16aecbe2492053ee8b16f43c6d634152b691b550/ghc >--------------------------------------------------------------- commit 16aecbe2492053ee8b16f43c6d634152b691b550 Author: Richard Eisenberg Date: Fri Jan 29 13:09:42 2016 -0500 Existentials should be specified. This addresses point (2) from #11513. >--------------------------------------------------------------- 16aecbe2492053ee8b16f43c6d634152b691b550 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 0626836..fd25c79 100644 --- a/compiler/basicTypes/DataCon.hs +++ b/compiler/basicTypes/DataCon.hs @@ -768,7 +768,7 @@ mkDataCon name declared_infix prom_info tag = assoc "mkDataCon" (tyConDataCons rep_tycon `zip` [fIRST_TAG..]) con rep_arg_tys = dataConRepArgTys con - rep_ty = mkSpecForAllTys univ_tvs $ mkInvForAllTys ex_tvs $ + rep_ty = mkSpecForAllTys univ_tvs $ mkSpecForAllTys ex_tvs $ mkFunTys rep_arg_tys $ mkTyConApp rep_tycon (mkTyVarTys univ_tvs) From git at git.haskell.org Sun Feb 7 17:39:10 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 7 Feb 2016 17:39:10 +0000 (UTC) Subject: [commit: ghc] wip/rae: Add missing kind cast to pure unifier. (55d5bab) Message-ID: <20160207173910.F06EF3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/55d5bab9f9da972027e71a50772273bfdc657a7c/ghc >--------------------------------------------------------------- commit 55d5bab9f9da972027e71a50772273bfdc657a7c Author: Richard Eisenberg Date: Sat Jan 30 16:49:22 2016 -0500 Add missing kind cast to pure unifier. >--------------------------------------------------------------- 55d5bab9f9da972027e71a50772273bfdc657a7c compiler/types/Unify.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/types/Unify.hs b/compiler/types/Unify.hs index 60cc249..183ef47 100644 --- a/compiler/types/Unify.hs +++ b/compiler/types/Unify.hs @@ -790,7 +790,7 @@ uVar tv1 ty kco -- this is because the range of the subst is the target -- type, not the template type. So, just check for -- normal type equality. - guard (ty' `eqType` ty) } + guard ((ty' `mkCastTy` kco) `eqType` ty) } Nothing -> uUnrefined tv1 ty ty kco } -- No, continue uUnrefined :: TyVar -- variable to be unified From git at git.haskell.org Sun Feb 7 17:39:13 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 7 Feb 2016 17:39:13 +0000 (UTC) Subject: [commit: ghc] wip/rae: Make exactTyCoVarsOfTypes closed over kinds. (1f39775) Message-ID: <20160207173913.9E11B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/1f397759af1665dc6b37db2699289c3a485583c1/ghc >--------------------------------------------------------------- commit 1f397759af1665dc6b37db2699289c3a485583c1 Author: Richard Eisenberg Date: Thu Jan 28 17:39:03 2016 -0500 Make exactTyCoVarsOfTypes closed over kinds. >--------------------------------------------------------------- 1f397759af1665dc6b37db2699289c3a485583c1 compiler/typecheck/TcType.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/typecheck/TcType.hs b/compiler/typecheck/TcType.hs index 63c06af..7395257 100644 --- a/compiler/typecheck/TcType.hs +++ b/compiler/typecheck/TcType.hs @@ -750,7 +750,7 @@ exactTyCoVarsOfType ty = go ty where go ty | Just ty' <- coreView ty = go ty' -- This is the key line - go (TyVarTy tv) = unitVarSet tv + go (TyVarTy tv) = unitVarSet tv `unionVarSet` go (tyVarKind tv) go (TyConApp _ tys) = exactTyCoVarsOfTypes tys go (LitTy {}) = emptyVarSet go (AppTy fun arg) = go fun `unionVarSet` go arg From git at git.haskell.org Sun Feb 7 17:39:16 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 7 Feb 2016 17:39:16 +0000 (UTC) Subject: [commit: ghc] wip/rae: Remove extraneous fundeps on (~) (f2efb3e) Message-ID: <20160207173916.684CA3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/f2efb3ea557e3429b005bd513693595303f5d400/ghc >--------------------------------------------------------------- commit f2efb3ea557e3429b005bd513693595303f5d400 Author: Richard Eisenberg Date: Thu Feb 4 18:31:25 2016 -0500 Remove extraneous fundeps on (~) >--------------------------------------------------------------- f2efb3ea557e3429b005bd513693595303f5d400 libraries/base/Data/Type/Equality.hs | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/libraries/base/Data/Type/Equality.hs b/libraries/base/Data/Type/Equality.hs index 75d2a6c..e7363d2 100644 --- a/libraries/base/Data/Type/Equality.hs +++ b/libraries/base/Data/Type/Equality.hs @@ -54,7 +54,7 @@ import Data.Type.Bool -- | Lifted, homogeneous equality. By lifted, we mean that it can be -- bogus (deferred type error). By homogeneous, the two types @a@ -- and @b@ must have the same kind. -class a ~~ b => (a :: k) ~ (b :: k) | a -> b, b -> a +class a ~~ b => (a :: k) ~ (b :: k) -- See Note [The equality types story] in TysPrim -- NB: All this class does is to wrap its superclass, which is -- the "real", inhomogeneous equality; this is needed when @@ -62,6 +62,10 @@ class a ~~ b => (a :: k) ~ (b :: k) | a -> b, b -> a -- NB: Not exported, as (~) is magical syntax. That's also why there's -- no fixity. + -- It's tempting to put functional dependencies on (~), but it's not + -- necessary because the functional-depedency coverage check looks + -- through superclasses, and (~#) is handled in that check. + instance {-# INCOHERENT #-} a ~~ b => a ~ b -- See Note [The equality types story] in TysPrim -- If we have a Wanted (t1 ~ t2), we want to immediately From git at git.haskell.org Sun Feb 7 17:39:19 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 7 Feb 2016 17:39:19 +0000 (UTC) Subject: [commit: ghc] wip/rae: Address #11471 by putting RuntimeRep in kinds. (2b70ed7) Message-ID: <20160207173919.68D9C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/2b70ed7aadc198ffc09ee53f267c04d3ec9c55d3/ghc >--------------------------------------------------------------- commit 2b70ed7aadc198ffc09ee53f267c04d3ec9c55d3 Author: Richard Eisenberg Date: Thu Feb 4 10:42:56 2016 -0500 Address #11471 by putting RuntimeRep in kinds. See Note [TYPE] in TysPrim. There are still some outstanding pieces in #11471 though, so this doesn't actually nail the bug. >--------------------------------------------------------------- 2b70ed7aadc198ffc09ee53f267c04d3ec9c55d3 compiler/basicTypes/DataCon.hs | 9 +- compiler/basicTypes/MkId.hs | 29 +-- compiler/basicTypes/PatSyn.hs | 4 +- compiler/coreSyn/CoreLint.hs | 4 +- compiler/coreSyn/CorePrep.hs | 2 +- compiler/coreSyn/MkCore.hs | 20 +- compiler/deSugar/DsBinds.hs | 2 +- compiler/deSugar/DsUtils.hs | 4 +- compiler/ghci/RtClosureInspect.hs | 6 +- compiler/iface/BinIface.hs | 2 +- compiler/iface/BuildTyCl.hs | 2 +- compiler/iface/IfaceEnv.hs | 2 +- compiler/iface/IfaceType.hs | 25 +-- compiler/iface/TcIface.hs | 4 +- compiler/main/InteractiveEval.hs | 2 +- compiler/prelude/PrelNames.hs | 27 ++- compiler/prelude/PrimOp.hs | 2 +- compiler/prelude/TysPrim.hs | 123 ++++++++---- compiler/prelude/TysWiredIn.hs | 216 +++++++++++++++++++-- compiler/prelude/TysWiredIn.hs-boot | 21 +- compiler/typecheck/TcBinds.hs | 2 +- compiler/typecheck/TcCanonical.hs | 2 - compiler/typecheck/TcErrors.hs | 19 +- compiler/typecheck/TcExpr.hs | 12 +- compiler/typecheck/TcHsSyn.hs | 4 +- compiler/typecheck/TcHsType.hs | 29 +-- compiler/typecheck/TcInstDcls.hs | 2 +- compiler/typecheck/TcMType.hs | 26 +-- compiler/typecheck/TcPat.hs | 4 +- compiler/typecheck/TcPatSyn.hs | 18 +- compiler/typecheck/TcRnDriver.hs | 2 +- compiler/typecheck/TcSMonad.hs | 6 +- compiler/typecheck/TcSimplify.hs | 22 +-- compiler/typecheck/TcType.hs | 4 +- compiler/typecheck/TcTypeable.hs | 1 - compiler/types/Kind.hs | 31 ++- compiler/types/TyCoRep.hs | 56 +++--- compiler/types/TyCon.hs | 121 +++++++----- compiler/types/Type.hs | 74 ++++--- compiler/utils/Util.hs | 16 ++ compiler/vectorise/Vectorise/Exp.hs | 2 +- libraries/base/Data/Data.hs | 2 +- libraries/base/Data/Typeable/Internal.hs | 29 ++- libraries/base/GHC/Err.hs | 8 +- libraries/base/GHC/Exts.hs | 4 +- libraries/base/tests/T11334.hs | 4 +- libraries/ghc-prim/GHC/Types.hs | 73 +++++-- .../tests/deSugar/should_compile/T2431.stderr | 6 +- testsuite/tests/dependent/should_compile/T11405.hs | 2 +- .../tests/dependent/should_fail/TypeSkolEscape.hs | 2 +- .../dependent/should_fail/TypeSkolEscape.stderr | 10 +- testsuite/tests/ghci/scripts/T7627.stdout | 8 +- .../tests/indexed-types/should_run/T11465a.hs | 2 +- .../tests/simplCore/should_compile/T7360.stderr | 4 +- .../tests/simplCore/should_compile/T9400.stderr | 6 +- .../simplCore/should_compile/spec-inline.stderr | 6 +- .../typecheck/should_run/KindInvariant.stderr | 3 +- testsuite/tests/typecheck/should_run/TypeOf.hs | 2 +- testsuite/tests/typecheck/should_run/TypeOf.stdout | 2 +- utils/genprimopcode/Main.hs | 2 +- 60 files changed, 750 insertions(+), 384 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 2b70ed7aadc198ffc09ee53f267c04d3ec9c55d3 From git at git.haskell.org Sun Feb 7 17:39:21 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 7 Feb 2016 17:39:21 +0000 (UTC) Subject: [commit: ghc] wip/rae's head updated: Address #11471 by putting RuntimeRep in kinds. (2b70ed7) Message-ID: <20160207173921.9DF7F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/rae' now includes: 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 1f39775 Make exactTyCoVarsOfTypes closed over kinds. 16aecbe Existentials should be specified. 55d5bab Add missing kind cast to pure unifier. f2efb3e Remove extraneous fundeps on (~) 2b70ed7 Address #11471 by putting RuntimeRep in kinds. From git at git.haskell.org Sun Feb 7 18:12:36 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 7 Feb 2016 18:12:36 +0000 (UTC) Subject: [commit: ghc] master: mkDocs: Update for xz (1060301) Message-ID: <20160207181236.5BAD63A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/10603015d9b03531a688d77e25dffce4738f4818/ghc >--------------------------------------------------------------- commit 10603015d9b03531a688d77e25dffce4738f4818 Author: Ben Gamari Date: Sun Feb 7 10:40:02 2016 -0500 mkDocs: Update for xz Fixes #11419. >--------------------------------------------------------------- 10603015d9b03531a688d77e25dffce4738f4818 distrib/mkDocs/mkDocs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/distrib/mkDocs/mkDocs b/distrib/mkDocs/mkDocs index 472bbe9..e06ea6a 100755 --- a/distrib/mkDocs/mkDocs +++ b/distrib/mkDocs/mkDocs @@ -21,14 +21,14 @@ WINDOWS_BINDIST=`realpath "$2"` mkdir docs cd docs INST=`pwd`/inst -tar -jxf "$LINUX_BINDIST" +tar -Jxf "$LINUX_BINDIST" mv ghc* linux cd linux ./configure --prefix="$INST" make install cd .. [ "$NO_CLEAN" -eq 0 ] && rm -r linux -tar -jxf "$WINDOWS_BINDIST" +tar -Jxf "$WINDOWS_BINDIST" mv ghc* windows cd inst/share/doc/ghc/html/libraries mv ../../../../../../windows/doc/html/libraries/Win32-* . @@ -36,7 +36,7 @@ sh gen_contents_index cd .. for i in haddock libraries users_guide do - tar -jcf ../../../../../$i.html.tar.bz2 $i + tar -Jcf ../../../../../$i.html.tar.xz $i done mv index.html ../../../../.. cd .. From git at git.haskell.org Sun Feb 7 18:12:39 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 7 Feb 2016 18:12:39 +0000 (UTC) Subject: [commit: ghc] master: mkDocs: Fix fallout from c5f4f95c64006a9f (c96acf3) Message-ID: <20160207181239.026A23A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c96acf366119eeb683dc413e84610bfc168e1106/ghc >--------------------------------------------------------------- commit c96acf366119eeb683dc413e84610bfc168e1106 Author: Ben Gamari Date: Sun Feb 7 10:40:31 2016 -0500 mkDocs: Fix fallout from c5f4f95c64006a9f Fixes #11419 >--------------------------------------------------------------- c96acf366119eeb683dc413e84610bfc168e1106 distrib/mkDocs/mkDocs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/distrib/mkDocs/mkDocs b/distrib/mkDocs/mkDocs index e06ea6a..fbb0a6f 100755 --- a/distrib/mkDocs/mkDocs +++ b/distrib/mkDocs/mkDocs @@ -30,7 +30,7 @@ cd .. [ "$NO_CLEAN" -eq 0 ] && rm -r linux tar -Jxf "$WINDOWS_BINDIST" mv ghc* windows -cd inst/share/doc/ghc/html/libraries +cd inst/share/doc/ghc*/html/libraries mv ../../../../../../windows/doc/html/libraries/Win32-* . sh gen_contents_index cd .. From git at git.haskell.org Sun Feb 7 18:13:27 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 7 Feb 2016 18:13:27 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: mkDocs: Fix fallout from c5f4f95c64006a9f (9d1ebfb) Message-ID: <20160207181327.69F073A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/9d1ebfbe689f9e4ba97b84b080bca71a38340709/ghc >--------------------------------------------------------------- commit 9d1ebfbe689f9e4ba97b84b080bca71a38340709 Author: Ben Gamari Date: Sun Feb 7 10:40:31 2016 -0500 mkDocs: Fix fallout from c5f4f95c64006a9f Fixes #11419 (cherry picked from commit c96acf366119eeb683dc413e84610bfc168e1106) >--------------------------------------------------------------- 9d1ebfbe689f9e4ba97b84b080bca71a38340709 distrib/mkDocs/mkDocs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/distrib/mkDocs/mkDocs b/distrib/mkDocs/mkDocs index e06ea6a..fbb0a6f 100755 --- a/distrib/mkDocs/mkDocs +++ b/distrib/mkDocs/mkDocs @@ -30,7 +30,7 @@ cd .. [ "$NO_CLEAN" -eq 0 ] && rm -r linux tar -Jxf "$WINDOWS_BINDIST" mv ghc* windows -cd inst/share/doc/ghc/html/libraries +cd inst/share/doc/ghc*/html/libraries mv ../../../../../../windows/doc/html/libraries/Win32-* . sh gen_contents_index cd .. From git at git.haskell.org Sun Feb 7 18:13:30 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 7 Feb 2016 18:13:30 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: mkDocs: Update for xz (d041dad) Message-ID: <20160207181330.176733A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/d041dadccf01a9d7254c1b313c1a1f803fd9e497/ghc >--------------------------------------------------------------- commit d041dadccf01a9d7254c1b313c1a1f803fd9e497 Author: Ben Gamari Date: Sun Feb 7 10:40:02 2016 -0500 mkDocs: Update for xz Fixes #11419. (cherry picked from commit 10603015d9b03531a688d77e25dffce4738f4818) >--------------------------------------------------------------- d041dadccf01a9d7254c1b313c1a1f803fd9e497 distrib/mkDocs/mkDocs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/distrib/mkDocs/mkDocs b/distrib/mkDocs/mkDocs index 472bbe9..e06ea6a 100755 --- a/distrib/mkDocs/mkDocs +++ b/distrib/mkDocs/mkDocs @@ -21,14 +21,14 @@ WINDOWS_BINDIST=`realpath "$2"` mkdir docs cd docs INST=`pwd`/inst -tar -jxf "$LINUX_BINDIST" +tar -Jxf "$LINUX_BINDIST" mv ghc* linux cd linux ./configure --prefix="$INST" make install cd .. [ "$NO_CLEAN" -eq 0 ] && rm -r linux -tar -jxf "$WINDOWS_BINDIST" +tar -Jxf "$WINDOWS_BINDIST" mv ghc* windows cd inst/share/doc/ghc/html/libraries mv ../../../../../../windows/doc/html/libraries/Win32-* . @@ -36,7 +36,7 @@ sh gen_contents_index cd .. for i in haddock libraries users_guide do - tar -jcf ../../../../../$i.html.tar.bz2 $i + tar -Jcf ../../../../../$i.html.tar.xz $i done mv index.html ../../../../.. cd .. From git at git.haskell.org Sun Feb 7 18:14:12 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 7 Feb 2016 18:14:12 +0000 (UTC) Subject: [commit: ghc] master: validate: enable -DDEBUG in stage 1 by default (66fa0ed) Message-ID: <20160207181412.4586E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/66fa0ed7087588b9c1577f44836f712f093089c1/ghc >--------------------------------------------------------------- commit 66fa0ed7087588b9c1577f44836f712f093089c1 Author: ?mer Sinan A?acan Date: Sun Feb 7 13:14:44 2016 -0500 validate: enable -DDEBUG in stage 1 by default Since the whole point of validation is to test the compiler, assertions should be enabled at least for some part of the build. Previously assertions were only enabled (1) in stage 2 compiler (2) when "slow" setting is used. With this patch we enable assertions in stage 1 compiler in all settings, to test them on (1) the compiler itself (2) the libraries, even with the "fast" setting. This will make "fast" setting slower, but the difference should be quite modest - I didn't realize a significant difference in validation times. Reviewers: bgamari, austin, thomie Reviewed By: thomie Differential Revision: https://phabricator.haskell.org/D1890 >--------------------------------------------------------------- 66fa0ed7087588b9c1577f44836f712f093089c1 mk/flavours/validate.mk | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/mk/flavours/validate.mk b/mk/flavours/validate.mk index 1a636fa..cb38bd5 100644 --- a/mk/flavours/validate.mk +++ b/mk/flavours/validate.mk @@ -1,6 +1,6 @@ SRC_HC_OPTS = -O0 -H64m SRC_HC_OPTS_STAGE1 = -fllvm-fill-undef-with-garbage # See Trac 11487 -GhcStage1HcOpts = -O +GhcStage1HcOpts = -O -DDEBUG GhcStage2HcOpts = -O -dcore-lint GhcLibHcOpts = -O -dcore-lint BUILD_PROF_LIBS = NO From git at git.haskell.org Sun Feb 7 19:06:44 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 7 Feb 2016 19:06:44 +0000 (UTC) Subject: [commit: ghc] wip/rae: Add missing kind cast to pure unifier. (707ecea) Message-ID: <20160207190644.52C2F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/707ecea784ebd6998d30095d69381ce66edb3c9c/ghc >--------------------------------------------------------------- commit 707ecea784ebd6998d30095d69381ce66edb3c9c Author: Richard Eisenberg Date: Sat Jan 30 16:49:22 2016 -0500 Add missing kind cast to pure unifier. >--------------------------------------------------------------- 707ecea784ebd6998d30095d69381ce66edb3c9c compiler/types/Unify.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/types/Unify.hs b/compiler/types/Unify.hs index 60cc249..183ef47 100644 --- a/compiler/types/Unify.hs +++ b/compiler/types/Unify.hs @@ -790,7 +790,7 @@ uVar tv1 ty kco -- this is because the range of the subst is the target -- type, not the template type. So, just check for -- normal type equality. - guard (ty' `eqType` ty) } + guard ((ty' `mkCastTy` kco) `eqType` ty) } Nothing -> uUnrefined tv1 ty ty kco } -- No, continue uUnrefined :: TyVar -- variable to be unified From git at git.haskell.org Sun Feb 7 19:06:47 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 7 Feb 2016 19:06:47 +0000 (UTC) Subject: [commit: ghc] wip/rae: Existentials should be specified. (de50032) Message-ID: <20160207190647.253BC3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/de50032cd5d8d0fb6a9dd0b30ba1942b6390bdb9/ghc >--------------------------------------------------------------- commit de50032cd5d8d0fb6a9dd0b30ba1942b6390bdb9 Author: Richard Eisenberg Date: Fri Jan 29 13:09:42 2016 -0500 Existentials should be specified. This addresses point (2) from #11513. >--------------------------------------------------------------- de50032cd5d8d0fb6a9dd0b30ba1942b6390bdb9 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 0626836..fd25c79 100644 --- a/compiler/basicTypes/DataCon.hs +++ b/compiler/basicTypes/DataCon.hs @@ -768,7 +768,7 @@ mkDataCon name declared_infix prom_info tag = assoc "mkDataCon" (tyConDataCons rep_tycon `zip` [fIRST_TAG..]) con rep_arg_tys = dataConRepArgTys con - rep_ty = mkSpecForAllTys univ_tvs $ mkInvForAllTys ex_tvs $ + rep_ty = mkSpecForAllTys univ_tvs $ mkSpecForAllTys ex_tvs $ mkFunTys rep_arg_tys $ mkTyConApp rep_tycon (mkTyVarTys univ_tvs) From git at git.haskell.org Sun Feb 7 19:06:49 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 7 Feb 2016 19:06:49 +0000 (UTC) Subject: [commit: ghc] wip/rae: Make exactTyCoVarsOfTypes closed over kinds. (ee0ff94) Message-ID: <20160207190649.C931C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/ee0ff94c82ba39a627cb3dea894a25f391dce647/ghc >--------------------------------------------------------------- commit ee0ff94c82ba39a627cb3dea894a25f391dce647 Author: Richard Eisenberg Date: Thu Jan 28 17:39:03 2016 -0500 Make exactTyCoVarsOfTypes closed over kinds. >--------------------------------------------------------------- ee0ff94c82ba39a627cb3dea894a25f391dce647 compiler/typecheck/TcType.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/typecheck/TcType.hs b/compiler/typecheck/TcType.hs index 63c06af..7395257 100644 --- a/compiler/typecheck/TcType.hs +++ b/compiler/typecheck/TcType.hs @@ -750,7 +750,7 @@ exactTyCoVarsOfType ty = go ty where go ty | Just ty' <- coreView ty = go ty' -- This is the key line - go (TyVarTy tv) = unitVarSet tv + go (TyVarTy tv) = unitVarSet tv `unionVarSet` go (tyVarKind tv) go (TyConApp _ tys) = exactTyCoVarsOfTypes tys go (LitTy {}) = emptyVarSet go (AppTy fun arg) = go fun `unionVarSet` go arg From git at git.haskell.org Sun Feb 7 19:06:52 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 7 Feb 2016 19:06:52 +0000 (UTC) Subject: [commit: ghc] wip/rae: Address #11471 by putting RuntimeRep in kinds. (a9f7670) Message-ID: <20160207190652.BAA6E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/a9f7670a4dc9d405c54854f59a131f65bfd0bb45/ghc >--------------------------------------------------------------- commit a9f7670a4dc9d405c54854f59a131f65bfd0bb45 Author: Richard Eisenberg Date: Thu Feb 4 10:42:56 2016 -0500 Address #11471 by putting RuntimeRep in kinds. See Note [TYPE] in TysPrim. There are still some outstanding pieces in #11471 though, so this doesn't actually nail the bug. >--------------------------------------------------------------- a9f7670a4dc9d405c54854f59a131f65bfd0bb45 compiler/basicTypes/DataCon.hs | 9 +- compiler/basicTypes/MkId.hs | 29 +-- compiler/basicTypes/PatSyn.hs | 4 +- compiler/coreSyn/CoreLint.hs | 4 +- compiler/coreSyn/CorePrep.hs | 2 +- compiler/coreSyn/MkCore.hs | 20 +- compiler/deSugar/DsBinds.hs | 2 +- compiler/deSugar/DsUtils.hs | 4 +- compiler/ghci/RtClosureInspect.hs | 6 +- compiler/iface/BinIface.hs | 2 +- compiler/iface/BuildTyCl.hs | 2 +- compiler/iface/IfaceEnv.hs | 2 +- compiler/iface/IfaceType.hs | 25 +-- compiler/iface/TcIface.hs | 4 +- compiler/main/InteractiveEval.hs | 2 +- compiler/prelude/PrelNames.hs | 27 ++- compiler/prelude/PrimOp.hs | 2 +- compiler/prelude/TysPrim.hs | 123 ++++++++---- compiler/prelude/TysWiredIn.hs | 216 +++++++++++++++++++-- compiler/prelude/TysWiredIn.hs-boot | 21 +- compiler/typecheck/TcBinds.hs | 2 +- compiler/typecheck/TcCanonical.hs | 2 - compiler/typecheck/TcErrors.hs | 25 ++- compiler/typecheck/TcExpr.hs | 12 +- compiler/typecheck/TcHsSyn.hs | 4 +- compiler/typecheck/TcHsType.hs | 29 +-- compiler/typecheck/TcInstDcls.hs | 2 +- compiler/typecheck/TcMType.hs | 26 +-- compiler/typecheck/TcPat.hs | 4 +- compiler/typecheck/TcPatSyn.hs | 18 +- compiler/typecheck/TcRnDriver.hs | 2 +- compiler/typecheck/TcSMonad.hs | 6 +- compiler/typecheck/TcSimplify.hs | 22 +-- compiler/typecheck/TcType.hs | 4 +- compiler/typecheck/TcTypeable.hs | 1 - compiler/types/Kind.hs | 31 ++- compiler/types/TyCoRep.hs | 56 +++--- compiler/types/TyCon.hs | 121 +++++++----- compiler/types/Type.hs | 74 ++++--- compiler/utils/Util.hs | 16 ++ compiler/vectorise/Vectorise/Exp.hs | 2 +- libraries/base/Data/Data.hs | 2 +- libraries/base/Data/Typeable/Internal.hs | 29 ++- libraries/base/GHC/Err.hs | 8 +- libraries/base/GHC/Exts.hs | 4 +- libraries/base/tests/T11334.hs | 4 +- libraries/ghc-prim/GHC/Types.hs | 73 +++++-- .../tests/deSugar/should_compile/T2431.stderr | 6 +- testsuite/tests/dependent/should_compile/T11405.hs | 2 +- .../tests/dependent/should_fail/TypeSkolEscape.hs | 2 +- .../dependent/should_fail/TypeSkolEscape.stderr | 10 +- testsuite/tests/ghci/scripts/T7627.stdout | 8 +- .../tests/indexed-types/should_run/T11465a.hs | 2 +- .../tests/simplCore/should_compile/T7360.stderr | 4 +- .../tests/simplCore/should_compile/T9400.stderr | 6 +- .../simplCore/should_compile/spec-inline.stderr | 6 +- .../typecheck/should_run/KindInvariant.stderr | 3 +- testsuite/tests/typecheck/should_run/TypeOf.hs | 2 +- testsuite/tests/typecheck/should_run/TypeOf.stdout | 2 +- utils/genprimopcode/Main.hs | 2 +- 60 files changed, 757 insertions(+), 383 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 a9f7670a4dc9d405c54854f59a131f65bfd0bb45 From git at git.haskell.org Sun Feb 7 19:06:55 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 7 Feb 2016 19:06:55 +0000 (UTC) Subject: [commit: ghc] wip/rae: Remove extraneous fundeps on (~) (cc8ef3c) Message-ID: <20160207190655.61DFB3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/cc8ef3c124f73319e19a3a379fc9f0c20a6e268a/ghc >--------------------------------------------------------------- commit cc8ef3c124f73319e19a3a379fc9f0c20a6e268a Author: Richard Eisenberg Date: Thu Feb 4 18:31:25 2016 -0500 Remove extraneous fundeps on (~) >--------------------------------------------------------------- cc8ef3c124f73319e19a3a379fc9f0c20a6e268a libraries/base/Data/Type/Equality.hs | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/libraries/base/Data/Type/Equality.hs b/libraries/base/Data/Type/Equality.hs index 75d2a6c..e7363d2 100644 --- a/libraries/base/Data/Type/Equality.hs +++ b/libraries/base/Data/Type/Equality.hs @@ -54,7 +54,7 @@ import Data.Type.Bool -- | Lifted, homogeneous equality. By lifted, we mean that it can be -- bogus (deferred type error). By homogeneous, the two types @a@ -- and @b@ must have the same kind. -class a ~~ b => (a :: k) ~ (b :: k) | a -> b, b -> a +class a ~~ b => (a :: k) ~ (b :: k) -- See Note [The equality types story] in TysPrim -- NB: All this class does is to wrap its superclass, which is -- the "real", inhomogeneous equality; this is needed when @@ -62,6 +62,10 @@ class a ~~ b => (a :: k) ~ (b :: k) | a -> b, b -> a -- NB: Not exported, as (~) is magical syntax. That's also why there's -- no fixity. + -- It's tempting to put functional dependencies on (~), but it's not + -- necessary because the functional-depedency coverage check looks + -- through superclasses, and (~#) is handled in that check. + instance {-# INCOHERENT #-} a ~~ b => a ~ b -- See Note [The equality types story] in TysPrim -- If we have a Wanted (t1 ~ t2), we want to immediately From git at git.haskell.org Sun Feb 7 19:06:57 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 7 Feb 2016 19:06:57 +0000 (UTC) Subject: [commit: ghc] wip/rae's head updated: Address #11471 by putting RuntimeRep in kinds. (a9f7670) Message-ID: <20160207190657.8C90F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/rae' now includes: 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 ee0ff94 Make exactTyCoVarsOfTypes closed over kinds. de50032 Existentials should be specified. 707ecea Add missing kind cast to pure unifier. cc8ef3c Remove extraneous fundeps on (~) a9f7670 Address #11471 by putting RuntimeRep in kinds. From git at git.haskell.org Sun Feb 7 20:28:12 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 7 Feb 2016 20:28:12 +0000 (UTC) Subject: [commit: ghc] master: rts: drop unused calcLiveBlocks, calcLiveWords (7362809) Message-ID: <20160207202812.762E63A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7362809b4e934d7d2024cf72ffddab7de0eab24b/ghc >--------------------------------------------------------------- commit 7362809b4e934d7d2024cf72ffddab7de0eab24b Author: Sergei Trofimovich Date: Sun Feb 7 15:55:44 2016 +0000 rts: drop unused calcLiveBlocks, calcLiveWords Use of these helper functions was removed by commit 18896fa2b06844407fd1e0d3f85cd3db97a96ff4 Author: Simon Marlow Date: Wed Feb 2 15:49:55 2011 +0000 Noticed by uselex.rb: calcLiveBlocks: [R]: exported from: ./rts/dist/build/sm/Storage.o calcLiveWords: [R]: exported from: ./rts/dist/build/sm/Storage.o Signed-off-by: Sergei Trofimovich >--------------------------------------------------------------- 7362809b4e934d7d2024cf72ffddab7de0eab24b rts/sm/Storage.c | 26 -------------------------- rts/sm/Storage.h | 3 --- 2 files changed, 29 deletions(-) diff --git a/rts/sm/Storage.c b/rts/sm/Storage.c index 65f5b70..c815b99 100644 --- a/rts/sm/Storage.c +++ b/rts/sm/Storage.c @@ -1204,32 +1204,6 @@ W_ gcThreadLiveBlocks (nat i, nat g) return blocks; } -// Return an accurate count of the live data in the heap, excluding -// generation 0. -W_ calcLiveWords (void) -{ - nat g; - W_ live; - - live = 0; - for (g = 0; g < RtsFlags.GcFlags.generations; g++) { - live += genLiveWords(&generations[g]); - } - return live; -} - -W_ calcLiveBlocks (void) -{ - nat g; - W_ live; - - live = 0; - for (g = 0; g < RtsFlags.GcFlags.generations; g++) { - live += genLiveBlocks(&generations[g]); - } - return live; -} - /* Determine which generation will be collected next, and approximate * the maximum amount of memory that will be required to do the GC, * taking into account data that will be copied, and the space needed diff --git a/rts/sm/Storage.h b/rts/sm/Storage.h index d0094b6..3dd3ec0 100644 --- a/rts/sm/Storage.h +++ b/rts/sm/Storage.h @@ -124,9 +124,6 @@ W_ gcThreadLiveBlocks (nat i, nat g); W_ genLiveWords (generation *gen); W_ genLiveBlocks (generation *gen); -W_ calcLiveBlocks (void); -W_ calcLiveWords (void); - /* ---------------------------------------------------------------------------- Storage manager internal APIs and globals ------------------------------------------------------------------------- */ From git at git.haskell.org Sun Feb 7 20:28:15 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 7 Feb 2016 20:28:15 +0000 (UTC) Subject: [commit: ghc] master: rts: mark scavenge_mutable_list as static (9e43c7f) Message-ID: <20160207202815.2E4B63A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9e43c7f01ee8ffb96f5ff8a29444409dde188216/ghc >--------------------------------------------------------------- commit 9e43c7f01ee8ffb96f5ff8a29444409dde188216 Author: Sergei Trofimovich Date: Sun Feb 7 16:08:56 2016 +0000 rts: mark scavenge_mutable_list as static Noticed by uselex.rb: scavenge_mutable_list: [R]: exported from: ./rts/dist/build/sm/Scav.o scavenge_mutable_list1: [R]: exported from: ./rts/dist/build/sm/Scav.thr_o Signed-off-by: Sergei Trofimovich >--------------------------------------------------------------- 9e43c7f01ee8ffb96f5ff8a29444409dde188216 rts/sm/Scav.c | 2 +- rts/sm/Scav.h | 2 -- 2 files changed, 1 insertion(+), 3 deletions(-) diff --git a/rts/sm/Scav.c b/rts/sm/Scav.c index 15d2b7b..953f055 100644 --- a/rts/sm/Scav.c +++ b/rts/sm/Scav.c @@ -1555,7 +1555,7 @@ scavenge_one(StgPtr p) remove non-mutable objects from the mutable list at this point. -------------------------------------------------------------------------- */ -void +static void scavenge_mutable_list(bdescr *bd, generation *gen) { StgPtr p, q; diff --git a/rts/sm/Scav.h b/rts/sm/Scav.h index 725d27c..ddd7d6d 100644 --- a/rts/sm/Scav.h +++ b/rts/sm/Scav.h @@ -17,12 +17,10 @@ #include "BeginPrivate.h" void scavenge_loop (void); -void scavenge_mutable_list (bdescr *bd, generation *gen); void scavenge_capability_mut_lists (Capability *cap); #ifdef THREADED_RTS void scavenge_loop1 (void); -void scavenge_mutable_list1 (bdescr *bd, generation *gen); void scavenge_capability_mut_Lists1 (Capability *cap); #endif From git at git.haskell.org Sun Feb 7 20:28:17 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 7 Feb 2016 20:28:17 +0000 (UTC) Subject: [commit: ghc] master: rts: mark 'copied' as static (4f283a6) Message-ID: <20160207202817.E10483A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4f283a6f84e76b3e8e1041eab1bbb9f8c63ce3fd/ghc >--------------------------------------------------------------- commit 4f283a6f84e76b3e8e1041eab1bbb9f8c63ce3fd Author: Sergei Trofimovich Date: Sun Feb 7 16:41:06 2016 +0000 rts: mark 'copied' as static Noticed by uselex.rb: copied: [R]: exported from: ./rts/dist/build/sm/GC.o Signed-off-by: Sergei Trofimovich >--------------------------------------------------------------- 4f283a6f84e76b3e8e1041eab1bbb9f8c63ce3fd rts/sm/GC.c | 2 +- rts/sm/GC.h | 2 -- 2 files changed, 1 insertion(+), 3 deletions(-) diff --git a/rts/sm/GC.c b/rts/sm/GC.c index 95d9951..d861db9 100644 --- a/rts/sm/GC.c +++ b/rts/sm/GC.c @@ -129,7 +129,7 @@ StgWord8 the_gc_thread[sizeof(gc_thread) + 64 * sizeof(gen_workspace)]; nat n_gc_threads; // For stats: -long copied; // *words* copied & scavenged during this GC +static long copied; // *words* copied & scavenged during this GC rtsBool work_stealing; diff --git a/rts/sm/GC.h b/rts/sm/GC.h index 5744eb9..2953d9e 100644 --- a/rts/sm/GC.h +++ b/rts/sm/GC.h @@ -34,8 +34,6 @@ extern bdescr *mark_stack_bd; extern bdescr *mark_stack_top_bd; extern StgPtr mark_sp; -extern long copied; - extern rtsBool work_stealing; #ifdef DEBUG From git at git.haskell.org Sun Feb 7 20:28:20 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 7 Feb 2016 20:28:20 +0000 (UTC) Subject: [commit: ghc] master: rts: drop unused getThreadCPUTime (256c1b3) Message-ID: <20160207202820.9A9333A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/256c1b3922ffed686e80c051d3d59ed8581993be/ghc >--------------------------------------------------------------- commit 256c1b3922ffed686e80c051d3d59ed8581993be Author: Sergei Trofimovich Date: Sun Feb 7 16:59:03 2016 +0000 rts: drop unused getThreadCPUTime Use of this helper function was removed in: commit 3c9fc104337a142fe4f375d30d7a6b81d55a70c1 Author: Brian Brooks Date: Thu Jul 10 02:55:33 2014 -0500 Avoid unnecessary clock_gettime() syscalls in GC stats. Noticed by uselex.rb: getThreadCPUTime: [R]: exported from: ./rts/dist/build/posix/GetTime.p_o Signed-off-by: Sergei Trofimovich >--------------------------------------------------------------- 256c1b3922ffed686e80c051d3d59ed8581993be rts/GetTime.h | 1 - rts/posix/GetTime.c | 30 ------------------------------ rts/win32/GetTime.c | 13 ------------- 3 files changed, 44 deletions(-) diff --git a/rts/GetTime.h b/rts/GetTime.h index 32c3754..4aaddd0 100644 --- a/rts/GetTime.h +++ b/rts/GetTime.h @@ -14,7 +14,6 @@ void initializeTimer (void); Time getProcessCPUTime (void); -Time getThreadCPUTime (void); Time getProcessElapsedTime (void); void getProcessTimes (Time *user, Time *elapsed); diff --git a/rts/posix/GetTime.c b/rts/posix/GetTime.c index def78a4..24d0d50 100644 --- a/rts/posix/GetTime.c +++ b/rts/posix/GetTime.c @@ -171,36 +171,6 @@ void getProcessTimes(Time *user, Time *elapsed) #endif // HAVE_TIMES -Time getThreadCPUTime(void) -{ -#if !defined(BE_CONSERVATIVE) && \ - defined(HAVE_CLOCK_GETTIME) && \ - defined(_SC_CPUTIME) && \ - defined(CLOCK_PROCESS_CPUTIME_ID) && \ - defined(HAVE_SYSCONF) - { - static int checked_sysconf = 0; - static int sysconf_result = 0; - - if (!checked_sysconf) { - sysconf_result = sysconf(_SC_THREAD_CPUTIME); - checked_sysconf = 1; - } - if (sysconf_result != -1) { - // clock_gettime() gives us per-thread CPU time. It isn't - // reliable on Linux, but it's the best we have. - struct timespec ts; - int res; - res = clock_gettime(CLOCK_THREAD_CPUTIME_ID, &ts); - if (res == 0) { - return SecondsToTime(ts.tv_sec) + NSToTime(ts.tv_nsec); - } - } - } -#endif - return getProcessCPUTime(); -} - void getUnixEpochTime(StgWord64 *sec, StgWord32 *nsec) { #if defined(HAVE_GETTIMEOFDAY) diff --git a/rts/win32/GetTime.c b/rts/win32/GetTime.c index 3600839..6a45248 100644 --- a/rts/win32/GetTime.c +++ b/rts/win32/GetTime.c @@ -100,19 +100,6 @@ getProcessElapsedTime(void) return NSToTime(getMonotonicNSec()); } -Time -getThreadCPUTime(void) -{ - FILETIME creationTime, exitTime, userTime, kernelTime = {0,0}; - - if (!GetThreadTimes(GetCurrentThread(), &creationTime, - &exitTime, &kernelTime, &userTime)) { - return 0; - } - - return fileTimeToRtsTime(userTime); -} - void getUnixEpochTime(StgWord64 *sec, StgWord32 *nsec) { From git at git.haskell.org Sun Feb 7 20:28:23 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 7 Feb 2016 20:28:23 +0000 (UTC) Subject: [commit: ghc] master: rts: mark 'wakeBlockingQueue' as static (3dbd836) Message-ID: <20160207202823.5A3863A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3dbd836ea2e9ddf417ed473bcff98fe29e40395a/ghc >--------------------------------------------------------------- commit 3dbd836ea2e9ddf417ed473bcff98fe29e40395a Author: Sergei Trofimovich Date: Sun Feb 7 17:14:37 2016 +0000 rts: mark 'wakeBlockingQueue' as static Noticed by uselex.rb: wakeBlockingQueue: [R]: exported from: ./rts/dist/build/Threads.o Signed-off-by: Sergei Trofimovich >--------------------------------------------------------------- 3dbd836ea2e9ddf417ed473bcff98fe29e40395a rts/Threads.c | 2 +- rts/Threads.h | 1 - 2 files changed, 1 insertion(+), 2 deletions(-) diff --git a/rts/Threads.c b/rts/Threads.c index 203a248..bf30ab8 100644 --- a/rts/Threads.c +++ b/rts/Threads.c @@ -359,7 +359,7 @@ migrateThread (Capability *from, StgTSO *tso, Capability *to) wakes up all the threads on the specified queue. ------------------------------------------------------------------------- */ -void +static void wakeBlockingQueue(Capability *cap, StgBlockingQueue *bq) { MessageBlackHole *msg; diff --git a/rts/Threads.h b/rts/Threads.h index 6d26610..01c493e 100644 --- a/rts/Threads.h +++ b/rts/Threads.h @@ -17,7 +17,6 @@ StgTSO * unblockOne (Capability *cap, StgTSO *tso); StgTSO * unblockOne_ (Capability *cap, StgTSO *tso, rtsBool allow_migrate); void checkBlockingQueues (Capability *cap, StgTSO *tso); -void wakeBlockingQueue (Capability *cap, StgBlockingQueue *bq); void tryWakeupThread (Capability *cap, StgTSO *tso); void migrateThread (Capability *from, StgTSO *tso, Capability *to); From git at git.haskell.org Sun Feb 7 20:28:26 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 7 Feb 2016 20:28:26 +0000 (UTC) Subject: [commit: ghc] master: rts: drop unused mut_user_time_during_heap_census (8abc7e7) Message-ID: <20160207202826.0C7873A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8abc7e76ecd9bdd31ace27ed24b3d42522d2f189/ghc >--------------------------------------------------------------- commit 8abc7e76ecd9bdd31ace27ed24b3d42522d2f189 Author: Sergei Trofimovich Date: Sun Feb 7 17:23:36 2016 +0000 rts: drop unused mut_user_time_during_heap_census Was never used looking at history available in git. While at it marked 'mut_user_time_during_RP' as 'static'. Noticed by uselex.rb: mut_user_time_during_heap_census: [R]: exported from: ./rts/dist/build/Stats.p_o Signed-off-by: Sergei Trofimovich >--------------------------------------------------------------- 8abc7e76ecd9bdd31ace27ed24b3d42522d2f189 rts/Stats.c | 7 +------ rts/Stats.h | 5 ----- 2 files changed, 1 insertion(+), 11 deletions(-) diff --git a/rts/Stats.c b/rts/Stats.c index 4c06b18..25074ea 100644 --- a/rts/Stats.c +++ b/rts/Stats.c @@ -105,17 +105,12 @@ mut_user_time( void ) mut_user_time_during_RP() returns the MUT time during retainer profiling. The same is for mut_user_time_during_HC(); */ -double +static double mut_user_time_during_RP( void ) { return TimeToSecondsDbl(RP_start_time - GC_tot_cpu - RP_tot_time); } -double -mut_user_time_during_heap_census( void ) -{ - return TimeToSecondsDbl(HC_start_time - GC_tot_cpu - RP_tot_time); -} #endif /* PROFILING */ /* --------------------------------------------------------------------------- diff --git a/rts/Stats.h b/rts/Stats.h index b7ced97..5897a3b 100644 --- a/rts/Stats.h +++ b/rts/Stats.h @@ -59,11 +59,6 @@ void initStats1(void); double mut_user_time_until(Time t); double mut_user_time(void); -#ifdef PROFILING -double mut_user_time_during_RP(void); -double mut_user_time_during_heap_census(void); -#endif /* PROFILING */ - void statDescribeGens( void ); Time stat_getElapsedGCTime(void); From git at git.haskell.org Sun Feb 7 20:28:28 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 7 Feb 2016 20:28:28 +0000 (UTC) Subject: [commit: ghc] master: rts: mark 'removeFromRunQueue' as static (39cba20) Message-ID: <20160207202828.B221E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/39cba209ac99c94ec6cdbc880d475e606eb8c5da/ghc >--------------------------------------------------------------- commit 39cba209ac99c94ec6cdbc880d475e606eb8c5da Author: Sergei Trofimovich Date: Sun Feb 7 17:33:02 2016 +0000 rts: mark 'removeFromRunQueue' as static Noticed by uselex.rb: removeFromRunQueue: [R]: exported from: ./rts/dist/build/Schedule.o Signed-off-by: Sergei Trofimovich >--------------------------------------------------------------- 39cba209ac99c94ec6cdbc880d475e606eb8c5da rts/Schedule.c | 2 +- rts/Schedule.h | 3 +-- 2 files changed, 2 insertions(+), 3 deletions(-) diff --git a/rts/Schedule.c b/rts/Schedule.c index e3dd881..89c5cde 100644 --- a/rts/Schedule.c +++ b/rts/Schedule.c @@ -557,7 +557,7 @@ run_thread: * Run queue operations * -------------------------------------------------------------------------- */ -void +static void removeFromRunQueue (Capability *cap, StgTSO *tso) { if (tso->block_info.prev == END_TSO_QUEUE) { diff --git a/rts/Schedule.h b/rts/Schedule.h index eb5135b..67e2fdc 100644 --- a/rts/Schedule.h +++ b/rts/Schedule.h @@ -187,8 +187,7 @@ peekRunQueue (Capability *cap) return cap->run_queue_hd; } -void removeFromRunQueue (Capability *cap, StgTSO *tso); -extern void promoteInRunQueue (Capability *cap, StgTSO *tso); +void promoteInRunQueue (Capability *cap, StgTSO *tso); /* Add a thread to the end of the blocked queue. */ From git at git.haskell.org Sun Feb 7 20:28:31 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 7 Feb 2016 20:28:31 +0000 (UTC) Subject: [commit: ghc] master: rts: mark 'setProgName' as static (7a48865) Message-ID: <20160207202831.658973A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7a488653715c991dc6f548828cfde47c2eac7845/ghc >--------------------------------------------------------------- commit 7a488653715c991dc6f548828cfde47c2eac7845 Author: Sergei Trofimovich Date: Sun Feb 7 17:36:55 2016 +0000 rts: mark 'setProgName' as static Noticed by uselex.rb: setProgName: [R]: exported from: ./rts/dist/build/RtsFlags.o Signed-off-by: Sergei Trofimovich >--------------------------------------------------------------- 7a488653715c991dc6f548828cfde47c2eac7845 rts/RtsFlags.c | 1 + rts/RtsFlags.h | 1 - 2 files changed, 1 insertion(+), 1 deletion(-) diff --git a/rts/RtsFlags.c b/rts/RtsFlags.c index 46d1409..3d0d7a4 100644 --- a/rts/RtsFlags.c +++ b/rts/RtsFlags.c @@ -112,6 +112,7 @@ static void errorUsage (void) GNU_ATTRIBUTE(__noreturn__); static char * copyArg (char *arg); static char ** copyArgv (int argc, char *argv[]); static void freeArgv (int argc, char *argv[]); +static void setProgName (char *argv[]); static void errorRtsOptsDisabled (const char *s); diff --git a/rts/RtsFlags.h b/rts/RtsFlags.h index 79ebd36..af60bcf 100644 --- a/rts/RtsFlags.h +++ b/rts/RtsFlags.h @@ -16,7 +16,6 @@ void initRtsFlagsDefaults (void); void setupRtsFlags (int *argc, char *argv[], RtsConfig rtsConfig); -void setProgName (char *argv[]); void freeRtsArgs (void); extern RtsConfig rtsConfig; From git at git.haskell.org Sun Feb 7 20:28:34 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 7 Feb 2016 20:28:34 +0000 (UTC) Subject: [commit: ghc] master: rts: drop unused 'traverseAllRetainerSet' (a49c9d4) Message-ID: <20160207202834.1D62C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a49c9d4ef61f4394b63b9a66b804054f03231c76/ghc >--------------------------------------------------------------- commit a49c9d4ef61f4394b63b9a66b804054f03231c76 Author: Sergei Trofimovich Date: Sun Feb 7 17:55:56 2016 +0000 rts: drop unused 'traverseAllRetainerSet' While at is mark 'printRetainer' as 'static'. Noticed by uselex.rb: printRetainer: [R]: exported from: ./rts/dist/build/RetainerSet.p_o traverseAllRetainerSet: [R]: exported from: ./rts/dist/build/RetainerSet.p_o Signed-off-by: Sergei Trofimovich >--------------------------------------------------------------- a49c9d4ef61f4394b63b9a66b804054f03231c76 docs/storage-mgt/rp.tex | 2 -- rts/RetainerSet.c | 22 +++------------------- rts/RetainerSet.h | 8 -------- 3 files changed, 3 insertions(+), 29 deletions(-) diff --git a/docs/storage-mgt/rp.tex b/docs/storage-mgt/rp.tex index 0d841b9..c6de489 100644 --- a/docs/storage-mgt/rp.tex +++ b/docs/storage-mgt/rp.tex @@ -510,8 +510,6 @@ set is created. Otherwise, a new retainer set is created. is created. Otherwise, a new retainer set is created. \item[@rtsBool isMember(retainer r, retainerSet *rs)@] returns a boolean value indicating whether @r@ is a member of @rs at . -\item[@void traverseAllRetainerSet(void (*f)(retainerSet *))@] invokes the function - at f@ on every retainer set created. \item[@void printRetainerSetShort(FILE *, retainerSet *)@] prints a single retainer set. \item[@void outputRetainerSet(FILE *, nat *allCost, nat *numSet)@] prints all diff --git a/rts/RetainerSet.c b/rts/RetainerSet.c index 234532a..4057e2e 100644 --- a/rts/RetainerSet.c +++ b/rts/RetainerSet.c @@ -215,42 +215,26 @@ addElement(retainer r, RetainerSet *rs) } /* ----------------------------------------------------------------------------- - * Call f() for each retainer set. - * -------------------------------------------------------------------------- */ -void -traverseAllRetainerSet(void (*f)(RetainerSet *)) -{ - int i; - RetainerSet *rs; - - (*f)(&rs_MANY); - for (i = 0; i < HASH_TABLE_SIZE; i++) - for (rs = hashTable[i]; rs != NULL; rs = rs->link) - (*f)(rs); -} - - -/* ----------------------------------------------------------------------------- * printRetainer() prints the full information on a given retainer, * not a retainer set. * -------------------------------------------------------------------------- */ #if defined(RETAINER_SCHEME_INFO) // Retainer scheme 1: retainer = info table -void +static void printRetainer(FILE *f, retainer itbl) { fprintf(f, "%s[%s]", GET_PROF_DESC(itbl), itbl->prof.closure_type); } #elif defined(RETAINER_SCHEME_CCS) // Retainer scheme 2: retainer = cost centre stack -void +static void printRetainer(FILE *f, retainer ccs) { fprintCCS(f, ccs); } #elif defined(RETAINER_SCHEME_CC) // Retainer scheme 3: retainer = cost centre -void +static void printRetainer(FILE *f, retainer cc) { fprintf(f,"%s.%s", cc->module, cc->label); diff --git a/rts/RetainerSet.h b/rts/RetainerSet.h index 086629d..ea9fabb 100644 --- a/rts/RetainerSet.h +++ b/rts/RetainerSet.h @@ -160,9 +160,6 @@ isMember(retainer r, RetainerSet *rs) // Finds or creates a retainer set augmented with a new retainer. RetainerSet *addElement(retainer, RetainerSet *); -// Call f() for each retainer set. -void traverseAllRetainerSet(void (*f)(RetainerSet *)); - #ifdef SECOND_APPROACH // Prints a single retainer set. void printRetainerSetShort(FILE *, RetainerSet *, nat); @@ -194,11 +191,6 @@ void outputAllRetainerSet(FILE *); #define hashKeySingleton(r) ((StgWord)(r)) #define hashKeyAddElement(r, s) (hashKeySingleton((r)) + (s)->hashKey) -// Prints the full information on a given retainer. -// Note: This function is not part of retainerSet interface, but this is -// the best place to define it. -void printRetainer(FILE *, retainer); - #include "EndPrivate.h" #endif /* PROFILING */ From git at git.haskell.org Sun Feb 7 20:28:36 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 7 Feb 2016 20:28:36 +0000 (UTC) Subject: [commit: ghc] master: rts: mark 'blockedThrowTo' as static (c358567) Message-ID: <20160207202836.C79DB3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c358567b9c84ffe77b505d0043d405f14312a95f/ghc >--------------------------------------------------------------- commit c358567b9c84ffe77b505d0043d405f14312a95f Author: Sergei Trofimovich Date: Sun Feb 7 17:58:59 2016 +0000 rts: mark 'blockedThrowTo' as static Noticed by uselex.rb: blockedThrowTo: [R]: exported from: ./rts/dist/build/RaiseAsync.o Signed-off-by: Sergei Trofimovich >--------------------------------------------------------------- c358567b9c84ffe77b505d0043d405f14312a95f rts/RaiseAsync.c | 3 +++ rts/RaiseAsync.h | 3 --- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/rts/RaiseAsync.c b/rts/RaiseAsync.c index 267707c..a0a81cf 100644 --- a/rts/RaiseAsync.c +++ b/rts/RaiseAsync.c @@ -23,6 +23,9 @@ #include "win32/IOManager.h" #endif +static void blockedThrowTo (Capability *cap, + StgTSO *target, MessageThrowTo *msg); + static void removeFromQueues(Capability *cap, StgTSO *tso); static void removeFromMVarBlockedQueue (StgTSO *tso); diff --git a/rts/RaiseAsync.h b/rts/RaiseAsync.h index 1f939d4..b5dba46 100644 --- a/rts/RaiseAsync.h +++ b/rts/RaiseAsync.h @@ -16,9 +16,6 @@ #include "BeginPrivate.h" -void blockedThrowTo (Capability *cap, - StgTSO *target, MessageThrowTo *msg); - StgTSO* raiseAsync (Capability *cap, StgTSO *tso, StgClosure *exception, From git at git.haskell.org Sun Feb 7 20:28:39 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 7 Feb 2016 20:28:39 +0000 (UTC) Subject: [commit: ghc] master: rts: mark 'ccs_mutex' and 'prof_arena' as static (e1ca583) Message-ID: <20160207202839.720053A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e1ca583855fc26f1e1a3a4e7fd6c54d302b4625c/ghc >--------------------------------------------------------------- commit e1ca583855fc26f1e1a3a4e7fd6c54d302b4625c Author: Sergei Trofimovich Date: Sun Feb 7 18:00:00 2016 +0000 rts: mark 'ccs_mutex' and 'prof_arena' as static Noticed by uselex.rb: ccs_mutex: [R]: exported from: ./rts/dist/build/Profiling.thr_p_o prof_arena: [R]: exported from: ./rts/dist/build/Profiling.p_o Signed-off-by: Sergei Trofimovich >--------------------------------------------------------------- e1ca583855fc26f1e1a3a4e7fd6c54d302b4625c rts/Profiling.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/rts/Profiling.c b/rts/Profiling.c index 4f2606c..5dca8c0 100644 --- a/rts/Profiling.c +++ b/rts/Profiling.c @@ -29,7 +29,7 @@ /* * Profiling allocation arena. */ -Arena *prof_arena; +static Arena *prof_arena; /* * Global variables used to assign unique IDs to cc's, ccs's, and @@ -59,7 +59,7 @@ CostCentre *CC_LIST = NULL; CostCentreStack *CCS_LIST = NULL; #ifdef THREADED_RTS -Mutex ccs_mutex; +static Mutex ccs_mutex; #endif /* From git at git.haskell.org Sun Feb 7 20:28:42 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 7 Feb 2016 20:28:42 +0000 (UTC) Subject: [commit: ghc] master: rts: drop unused 'traceEventThreadRunnable' (0e51109) Message-ID: <20160207202842.1A8353A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/0e51109d010c474f60f7b3209e399c115c7bcec7/ghc >--------------------------------------------------------------- commit 0e51109d010c474f60f7b3209e399c115c7bcec7 Author: Sergei Trofimovich Date: Sun Feb 7 18:16:10 2016 +0000 rts: drop unused 'traceEventThreadRunnable' Not used since: commit f361281c89fbce42865d8b8b27b0957205366186 Author: Simon Marlow Date: Wed Dec 7 11:32:35 2011 +0000 Do not emit the THREAD_RUNNABLE event; it has no useful semantic content Noticed by uselex.rb: traceEventThreadRunnable: [R]: exported from: ./rts/dist/build/Inlines.o Signed-off-by: Sergei Trofimovich >--------------------------------------------------------------- 0e51109d010c474f60f7b3209e399c115c7bcec7 rts/Trace.h | 11 ----------- 1 file changed, 11 deletions(-) diff --git a/rts/Trace.h b/rts/Trace.h index 2c11a9f..e0d6f20 100644 --- a/rts/Trace.h +++ b/rts/Trace.h @@ -517,17 +517,6 @@ INLINE_HEADER void traceEventStopThread(Capability *cap STG_UNUSED, (EventThreadStatus)status, (EventThreadID)info); } -// needs to be EXTERN_INLINE as it is used in another EXTERN_INLINE function -EXTERN_INLINE void traceEventThreadRunnable(Capability *cap STG_UNUSED, - StgTSO *tso STG_UNUSED); - -EXTERN_INLINE void traceEventThreadRunnable(Capability *cap STG_UNUSED, - StgTSO *tso STG_UNUSED) -{ - traceSchedEvent(cap, EVENT_THREAD_RUNNABLE, tso, 0); - dtraceThreadRunnable((EventCapNo)cap->no, (EventThreadID)tso->id); -} - INLINE_HEADER void traceEventMigrateThread(Capability *cap STG_UNUSED, StgTSO *tso STG_UNUSED, nat new_cap STG_UNUSED) From git at git.haskell.org Sun Feb 7 20:28:44 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 7 Feb 2016 20:28:44 +0000 (UTC) Subject: [commit: ghc] master: rts: mark 'shutdownCapability' as static (0a2bd9c) Message-ID: <20160207202844.BA5DA3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/0a2bd9ccf423dd635677926c1238aab5d3d4b1cb/ghc >--------------------------------------------------------------- commit 0a2bd9ccf423dd635677926c1238aab5d3d4b1cb Author: Sergei Trofimovich Date: Sun Feb 7 18:39:33 2016 +0000 rts: mark 'shutdownCapability' as static Noticed by uselex.rb: last_free_capability: [R]: exported from: ./rts/dist/build/Capability.o shutdownCapability: [R]: exported from: ./rts/dist/build/Capability.o Signed-off-by: Sergei Trofimovich >--------------------------------------------------------------- 0a2bd9ccf423dd635677926c1238aab5d3d4b1cb rts/Capability.c | 4 ++-- rts/Capability.h | 10 ---------- 2 files changed, 2 insertions(+), 12 deletions(-) diff --git a/rts/Capability.c b/rts/Capability.c index 45ee2c8..a2078e5 100644 --- a/rts/Capability.c +++ b/rts/Capability.c @@ -51,7 +51,7 @@ Capability **capabilities = NULL; // an in-call has a chance of quickly finding a free Capability. // Maintaining a global free list of Capabilities would require global // locking, so we don't do that. -Capability *last_free_capability = NULL; +static Capability *last_free_capability = NULL; /* * Indicates that the RTS wants to synchronise all the Capabilities @@ -937,7 +937,7 @@ tryGrabCapability (Capability *cap, Task *task) * * ------------------------------------------------------------------------- */ -void +static void shutdownCapability (Capability *cap USED_IF_THREADS, Task *task USED_IF_THREADS, rtsBool safe USED_IF_THREADS) diff --git a/rts/Capability.h b/rts/Capability.h index fb9f0aa..561d369 100644 --- a/rts/Capability.h +++ b/rts/Capability.h @@ -224,11 +224,6 @@ INLINE_HEADER void releaseCapability_ (Capability* cap STG_UNUSED, // extern Capability **capabilities; -// The Capability that was last free. Used as a good guess for where -// to assign new threads. -// -extern Capability *last_free_capability; - // // Indicates that the RTS wants to synchronise all the Capabilities // for some reason. All Capabilities should stop and return to the @@ -304,11 +299,6 @@ extern void grabCapability (Capability **pCap); #endif /* !THREADED_RTS */ -// Waits for a capability to drain of runnable threads and workers, -// and then acquires it. Used at shutdown time. -// -void shutdownCapability (Capability *cap, Task *task, rtsBool wait_foreign); - // Shut down all capabilities. // void shutdownCapabilities(Task *task, rtsBool wait_foreign); From git at git.haskell.org Sun Feb 7 22:13:27 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 7 Feb 2016 22:13:27 +0000 (UTC) Subject: [commit: ghc] master: Fix haddocks for TypeError (c0a0ee3) Message-ID: <20160207221327.9F1433A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c0a0ee362348d71d9bf58633858577f36e353cfb/ghc >--------------------------------------------------------------- commit c0a0ee362348d71d9bf58633858577f36e353cfb Author: Ben Gamari Date: Sun Feb 7 22:40:24 2016 +0100 Fix haddocks for TypeError >--------------------------------------------------------------- c0a0ee362348d71d9bf58633858577f36e353cfb libraries/base/GHC/TypeLits.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/libraries/base/GHC/TypeLits.hs b/libraries/base/GHC/TypeLits.hs index a51ba91..c32eebb 100644 --- a/libraries/base/GHC/TypeLits.hs +++ b/libraries/base/GHC/TypeLits.hs @@ -221,24 +221,24 @@ infixl 6 :<>: -- For instance, it can be used as a constraint, e.g. to provide a better error -- message for a non-existant instance, -- --- @@ +-- @ -- -- in a context -- instance TypeError (Text "Cannot 'Show' functions." :$$: -- Text "Perhaps there is a missing argument?") -- => Show (a -> b) where -- showsPrec = error "unreachable" --- @@ +-- @ -- -- It can also be placed on the right-hand side of a type-level function -- to provide an error for an invalid case, -- --- @@ +-- @ -- type family ByteSize x where -- ByteSize Word16 = 2 -- ByteSize Word8 = 1 -- ByteSize a = TypeError (Text "The type " :<>: ShowType a :<>: -- Text " is not exportable.") --- @@ +-- @ -- -- @since 4.9.0.0 type family TypeError (a :: ErrorMessage) :: b where From git at git.haskell.org Sun Feb 7 22:39:33 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 7 Feb 2016 22:39:33 +0000 (UTC) Subject: [commit: ghc] master: Bump haddock submodule (b3e9452) Message-ID: <20160207223933.34BE23A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b3e9452d94025e70cd2173553a3260c3856cda39/ghc >--------------------------------------------------------------- commit b3e9452d94025e70cd2173553a3260c3856cda39 Author: Ben Gamari Date: Sun Feb 7 23:39:49 2016 +0100 Bump haddock submodule >--------------------------------------------------------------- b3e9452d94025e70cd2173553a3260c3856cda39 utils/haddock | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/utils/haddock b/utils/haddock index 8269b34..57a5dcf 160000 --- a/utils/haddock +++ b/utils/haddock @@ -1 +1 @@ -Subproject commit 8269b349dd04f7561f9fe6c9e4ba514d3a7d21ab +Subproject commit 57a5dcfd3d2a7e01229a2c3a79b1f99cd95d5de1 From git at git.haskell.org Sun Feb 7 22:40:03 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 7 Feb 2016 22:40:03 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Fix haddocks for TypeError (25eb907) Message-ID: <20160207224003.BE8B33A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/25eb907b4031b7d2fa0347fc7f929c93e61cea3c/ghc >--------------------------------------------------------------- commit 25eb907b4031b7d2fa0347fc7f929c93e61cea3c Author: Ben Gamari Date: Sun Feb 7 22:40:24 2016 +0100 Fix haddocks for TypeError (cherry picked from commit c0a0ee362348d71d9bf58633858577f36e353cfb) >--------------------------------------------------------------- 25eb907b4031b7d2fa0347fc7f929c93e61cea3c libraries/base/GHC/TypeLits.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/libraries/base/GHC/TypeLits.hs b/libraries/base/GHC/TypeLits.hs index a51ba91..c32eebb 100644 --- a/libraries/base/GHC/TypeLits.hs +++ b/libraries/base/GHC/TypeLits.hs @@ -221,24 +221,24 @@ infixl 6 :<>: -- For instance, it can be used as a constraint, e.g. to provide a better error -- message for a non-existant instance, -- --- @@ +-- @ -- -- in a context -- instance TypeError (Text "Cannot 'Show' functions." :$$: -- Text "Perhaps there is a missing argument?") -- => Show (a -> b) where -- showsPrec = error "unreachable" --- @@ +-- @ -- -- It can also be placed on the right-hand side of a type-level function -- to provide an error for an invalid case, -- --- @@ +-- @ -- type family ByteSize x where -- ByteSize Word16 = 2 -- ByteSize Word8 = 1 -- ByteSize a = TypeError (Text "The type " :<>: ShowType a :<>: -- Text " is not exportable.") --- @@ +-- @ -- -- @since 4.9.0.0 type family TypeError (a :: ErrorMessage) :: b where From git at git.haskell.org Sun Feb 7 22:40:06 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 7 Feb 2016 22:40:06 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Bump haddock submodule (4206af6) Message-ID: <20160207224006.69E0E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/4206af6ebb00ef9d0b6c22a5456b0401a53b7181/ghc >--------------------------------------------------------------- commit 4206af6ebb00ef9d0b6c22a5456b0401a53b7181 Author: Ben Gamari Date: Sun Feb 7 23:41:02 2016 +0100 Bump haddock submodule >--------------------------------------------------------------- 4206af6ebb00ef9d0b6c22a5456b0401a53b7181 utils/haddock | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/utils/haddock b/utils/haddock index 695cb7f..af205d2 160000 --- a/utils/haddock +++ b/utils/haddock @@ -1 +1 @@ -Subproject commit 695cb7fecc511e51ceded125dbba276a89a4d86b +Subproject commit af205d20bf3502b41e4fd34b1c991d5014388004 From git at git.haskell.org Mon Feb 8 09:05:59 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 8 Feb 2016 09:05:59 +0000 (UTC) Subject: [commit: ghc] master: Remove unused export from TcUnify (8263d09) Message-ID: <20160208090559.0FF713A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8263d09e256d367f9a136fcc73d981879526a329/ghc >--------------------------------------------------------------- commit 8263d09e256d367f9a136fcc73d981879526a329 Author: Simon Peyton Jones Date: Thu Jan 28 22:43:38 2016 +0000 Remove unused export from TcUnify ..namely buildImplication. Plus white space in TcDeriv >--------------------------------------------------------------- 8263d09e256d367f9a136fcc73d981879526a329 compiler/typecheck/TcDeriv.hs | 4 ++-- compiler/typecheck/TcUnify.hs | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/compiler/typecheck/TcDeriv.hs b/compiler/typecheck/TcDeriv.hs index 7946bb5..b7af112 100644 --- a/compiler/typecheck/TcDeriv.hs +++ b/compiler/typecheck/TcDeriv.hs @@ -1882,8 +1882,8 @@ simplifyDeriv pred tvs theta -- generated instance declaration ; defer <- goptM Opt_DeferTypeErrors ; (implic, _) <- buildImplicationFor tclvl skol_info tvs_skols [] unsolved - -- The buildImplication is just to bind the skolems, in - -- case they are mentioned in error messages + -- The buildImplicationFor is just to bind the skolems, + -- in case they are mentioned in error messages -- See Trac #11347 ; unless defer (reportAllUnsolved (mkImplicWC implic)) diff --git a/compiler/typecheck/TcUnify.hs b/compiler/typecheck/TcUnify.hs index 8d0f797..e25ff21 100644 --- a/compiler/typecheck/TcUnify.hs +++ b/compiler/typecheck/TcUnify.hs @@ -13,7 +13,7 @@ module TcUnify ( tcWrapResult, tcWrapResultO, tcSkolemise, tcSkolemiseET, tcSubTypeHR, tcSubType, tcSubTypeO, tcSubType_NC, tcSubTypeDS, tcSubTypeDS_O, tcSubTypeDS_NC, tcSubTypeDS_NC_O, tcSubTypeET, tcSubTypeET_NC, - checkConstraints, buildImplication, buildImplicationFor, + checkConstraints, buildImplicationFor, -- Various unifications unifyType_, unifyType, unifyTheta, unifyKind, noThing, From git at git.haskell.org Mon Feb 8 09:06:01 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 8 Feb 2016 09:06:01 +0000 (UTC) Subject: [commit: ghc] master: Allow foralls in instance decls (2cf3cac) Message-ID: <20160208090601.CF3633A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2cf3cac6a05879c27fa82b12dd34cce39a262402/ghc >--------------------------------------------------------------- commit 2cf3cac6a05879c27fa82b12dd34cce39a262402 Author: Simon Peyton Jones Date: Mon Feb 8 09:05:12 2016 +0000 Allow foralls in instance decls This patch finally makes it possible to have explicit foralls in an instance decl instance forall (a :: *). Eq a => Eq [a] where ... This is useful to allow kind signatures or indeed explicicit kind for-alls; see Trac #11519 I thought it would be really easy, because an instance declaration already contains an actual HsSigType, so all the syntactic baggage is there. But in fact it turned out that instance declarations were kind-checked a little differently, because the body kind of the forall is 'Constraint' rather than '*'. So I fixed that. There a slight kludge (see Note [Body kind of a HsQualTy], but it's still a significant improvement. I also did the usual other round of refactoring, improved a few error messages, tidied up comments etc. The only significant aspect of all that was * Kill mkNakedSpecSigmaTy, mkNakedPhiTy, mkNakedFunTy These function names suggest that they do something complicated, but acutally they do nothing. So I killed them. * Swap the arg order of mkNamedBinder, just so that it is convenient to say 'map (mkNamedBinder Invisible) tvs' * I had to improve isPredTy, to deal with (illegal) types like (Eq a => Eq [a]) => blah See Note [isPeredTy complications] in Type.hs Still to come: user manual documentation for the instance-decl change. >--------------------------------------------------------------- 2cf3cac6a05879c27fa82b12dd34cce39a262402 compiler/hsSyn/HsTypes.hs | 301 +++++++++++++-------- compiler/hsSyn/HsUtils.hs | 65 ----- compiler/rename/RnSource.hs | 3 +- compiler/typecheck/TcBinds.hs | 4 +- compiler/typecheck/TcHsType.hs | 126 ++++----- compiler/typecheck/TcInstDcls.hs | 3 +- compiler/typecheck/TcType.hs | 25 +- compiler/typecheck/TcValidity.hs | 23 +- compiler/types/Coercion.hs | 2 +- compiler/types/TyCoRep.hs | 3 +- compiler/types/Type.hs | 74 +++-- testsuite/tests/gadt/T3163.stderr | 6 +- .../indexed-types/should_fail/SimpleFail15.stderr | 7 +- .../tests/indexed-types/should_fail/T10899.stderr | 4 +- .../tests/indexed-types/should_fail/T9357.stderr | 2 +- .../tests/rename/should_fail/rnfail026.stderr | 4 +- .../tests/typecheck/should_fail/T11355.stderr | 2 +- testsuite/tests/typecheck/should_fail/T2538.stderr | 20 +- testsuite/tests/typecheck/should_fail/T5957.stderr | 7 +- testsuite/tests/typecheck/should_fail/T7019.stderr | 8 +- .../tests/typecheck/should_fail/T7019a.stderr | 9 +- testsuite/tests/typecheck/should_fail/T7809.stderr | 7 +- testsuite/tests/typecheck/should_fail/T8806.stderr | 10 - testsuite/tests/typecheck/should_fail/T9196.stderr | 15 +- .../tests/typecheck/should_fail/tcfail088.stderr | 6 +- .../tests/typecheck/should_fail/tcfail127.stderr | 7 +- .../tests/typecheck/should_fail/tcfail184.stderr | 11 +- .../tests/typecheck/should_fail/tcfail195.stderr | 6 +- .../tests/typecheck/should_fail/tcfail196.stderr | 3 +- .../tests/typecheck/should_fail/tcfail197.stderr | 2 +- 30 files changed, 386 insertions(+), 379 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 2cf3cac6a05879c27fa82b12dd34cce39a262402 From git at git.haskell.org Mon Feb 8 10:13:39 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 8 Feb 2016 10:13:39 +0000 (UTC) Subject: [commit: ghc] master: Fix SimpleFail12 error output (20f90ea) Message-ID: <20160208101339.F0F153A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/20f90ea394e3c2a6f0bb0a4ebf493a258c01da98/ghc >--------------------------------------------------------------- commit 20f90ea394e3c2a6f0bb0a4ebf493a258c01da98 Author: Simon Peyton Jones Date: Mon Feb 8 10:13:28 2016 +0000 Fix SimpleFail12 error output I missed this on my previous commit, somehow 2cf3ca Allow foralls in instance decls Apologies. >--------------------------------------------------------------- 20f90ea394e3c2a6f0bb0a4ebf493a258c01da98 testsuite/tests/indexed-types/should_fail/SimpleFail12.stderr | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail12.stderr b/testsuite/tests/indexed-types/should_fail/SimpleFail12.stderr index a402623..ca6c11b 100644 --- a/testsuite/tests/indexed-types/should_fail/SimpleFail12.stderr +++ b/testsuite/tests/indexed-types/should_fail/SimpleFail12.stderr @@ -1,4 +1,4 @@ -SimpleFail12.hs:8:15: - Illegal polymorphic or qualified type: forall a1. [a1] - In the type instance declaration for ?C? +SimpleFail12.hs:8:15: error: + ? Illegal polymorphic type: forall a. [a] + ? In the type instance declaration for ?C? From git at git.haskell.org Mon Feb 8 12:13:38 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 8 Feb 2016 12:13:38 +0000 (UTC) Subject: [commit: ghc] master: user-guide: Add cross-reference for -XUnicodeSyntax (e2b66a0) Message-ID: <20160208121338.5EAE83A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e2b66a0ef0a0d8ff5cdb681edd8309954ef0a08a/ghc >--------------------------------------------------------------- commit e2b66a0ef0a0d8ff5cdb681edd8309954ef0a08a Author: Ben Gamari Date: Mon Feb 8 00:13:50 2016 +0100 user-guide: Add cross-reference for -XUnicodeSyntax >--------------------------------------------------------------- e2b66a0ef0a0d8ff5cdb681edd8309954ef0a08a docs/users_guide/using.rst | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/docs/users_guide/using.rst b/docs/users_guide/using.rst index 3b192ef..47fdd29 100644 --- a/docs/users_guide/using.rst +++ b/docs/users_guide/using.rst @@ -671,7 +671,7 @@ See also the ``--help``, ``--version``, ``--numeric-version``, and MkT :: forall (k :: BOX) (a :: k). T k a When :ghc-flag:`-fprint-unicode-syntax` is enabled, GHC prints type - signatures using the unicode symbols from the ``-XUnicodeSyntax`` + signatures using the unicode symbols from the :ghc-flag:`-XUnicodeSyntax` extension. .. code-block:: none From git at git.haskell.org Mon Feb 8 12:13:56 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 8 Feb 2016 12:13:56 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: user-guide: Add cross-reference for -XUnicodeSyntax (b3086e6) Message-ID: <20160208121356.B7A263A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/b3086e69251878bd93d8b741fc08becad6f20145/ghc >--------------------------------------------------------------- commit b3086e69251878bd93d8b741fc08becad6f20145 Author: Ben Gamari Date: Mon Feb 8 00:13:50 2016 +0100 user-guide: Add cross-reference for -XUnicodeSyntax (cherry picked from commit 6cebfdb44c9d2f893a5049b44489015fd5381342) >--------------------------------------------------------------- b3086e69251878bd93d8b741fc08becad6f20145 docs/users_guide/using.rst | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/docs/users_guide/using.rst b/docs/users_guide/using.rst index 3b192ef..47fdd29 100644 --- a/docs/users_guide/using.rst +++ b/docs/users_guide/using.rst @@ -671,7 +671,7 @@ See also the ``--help``, ``--version``, ``--numeric-version``, and MkT :: forall (k :: BOX) (a :: k). T k a When :ghc-flag:`-fprint-unicode-syntax` is enabled, GHC prints type - signatures using the unicode symbols from the ``-XUnicodeSyntax`` + signatures using the unicode symbols from the :ghc-flag:`-XUnicodeSyntax` extension. .. code-block:: none From git at git.haskell.org Mon Feb 8 15:07:29 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 8 Feb 2016 15:07:29 +0000 (UTC) Subject: [commit: ghc] master: Add Edward Kmett's example as a test case (4e65301) Message-ID: <20160208150729.7EAEF3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4e6530122ab458211add07a7167d077eba3eea21/ghc >--------------------------------------------------------------- commit 4e6530122ab458211add07a7167d077eba3eea21 Author: Simon Peyton Jones Date: Mon Feb 1 13:59:11 2016 +0000 Add Edward Kmett's example as a test case This is a more stressful example of T11480. >--------------------------------------------------------------- 4e6530122ab458211add07a7167d077eba3eea21 testsuite/tests/polykinds/T11480b.hs | 196 +++++++++++++++++++++++++++++++++++ testsuite/tests/polykinds/all.T | 1 + 2 files changed, 197 insertions(+) diff --git a/testsuite/tests/polykinds/T11480b.hs b/testsuite/tests/polykinds/T11480b.hs new file mode 100644 index 0000000..12802e8 --- /dev/null +++ b/testsuite/tests/polykinds/T11480b.hs @@ -0,0 +1,196 @@ +{-# language KindSignatures #-} +{-# language PolyKinds #-} +{-# language DataKinds #-} +{-# language TypeFamilies #-} +{-# language RankNTypes #-} +{-# language NoImplicitPrelude #-} +{-# language FlexibleContexts #-} +{-# language MultiParamTypeClasses #-} +{-# language GADTs #-} +{-# language ConstraintKinds #-} +{-# language FlexibleInstances #-} +{-# language TypeOperators #-} +{-# language ScopedTypeVariables #-} +{-# language DefaultSignatures #-} +{-# language FunctionalDependencies #-} +{-# language UndecidableSuperClasses #-} + +-- This code, supplied by Edward Kmett, uses UndecidableSuperClasses along +-- with a bunch of other stuff, so it's a useful stress test. +-- See Trac #11480 comment:12. + +module T11480b where + +import GHC.Types (Constraint) +import Data.Type.Equality as Equality +import Data.Type.Coercion as Coercion +import qualified Prelude +import Prelude (Either(..)) + +newtype Y (p :: i -> j -> *) (a :: j) (b :: i) = Y { getY :: p b a } + +type family Op (p :: i -> j -> *) :: j -> i -> * where + Op (Y p) = p + Op p = Y p + +class Vacuous (p :: i -> i -> *) (a :: i) +instance Vacuous p a + +data Dict (p :: Constraint) where + Dict :: p => Dict p + +class Functor (Op p) (Nat p (->)) p => Category (p :: i -> i -> *) where + type Ob p :: i -> Constraint + type Ob p = Vacuous p + + id :: Ob p a => p a a + (.) :: p b c -> p a b -> p a c + + source :: p a b -> Dict (Ob p a) + default source :: (Ob p ~ Vacuous p) => p a b -> Dict (Ob p a) + source _ = Dict + + target :: p a b -> Dict (Ob p b) + default target :: (Ob p ~ Vacuous p) => p a b -> Dict (Ob p b) + target _ = Dict + + op :: p b a -> Op p a b + default op :: Op p ~ Y p => p b a -> Op p a b + op = Y + + unop :: Op p b a -> p a b + default unop :: Op p ~ Y p => Op p b a -> p a b + unop = getY + +class (Category p, Category q) => Functor (p :: i -> i -> *) (q :: j -> j -> *) (f :: i -> j) | f -> p q where + fmap :: p a b -> q (f a) (f b) + +data Nat (p :: i -> i -> *) (q :: j -> j -> *) (f :: i -> j) (g :: i -> j) where + Nat :: (Functor p q f, Functor p q g) => { runNat :: forall a. Ob p a => q (f a) (g a) } -> Nat p q f g + +instance (Category p, Category q) => Category (Nat p q) where + type Ob (Nat p q) = Functor p q + id = Nat id1 where + id1 :: forall f x. (Functor p q f, Ob p x) => q (f x) (f x) + id1 = id \\ (ob :: Ob p x :- Ob q (f x)) + Nat f . Nat g = Nat (f . g) + source Nat{} = Dict + target Nat{} = Dict + +ob :: forall p q f a. Functor p q f => Ob p a :- Ob q (f a) +ob = Sub (case source (fmap (id :: p a a) :: q (f a) (f a)) of Dict -> Dict) + +instance (Category p, Category q) => Functor (Y (Nat p q)) (Nat (Nat p q) (->)) (Nat p q) where + fmap (Y f) = Nat (. f) + +instance (Category p, Category q) => Functor (Nat p q) (->) (Nat p q f) where + fmap = (.) + +contramap :: Functor p q f => Op p b a -> q (f a) (f b) +contramap = fmap . unop + +instance Category (->) where + id = Prelude.id + (.) = (Prelude..) + +instance Functor (->) (->) ((->) e) where + fmap = (.) + +instance Functor (Y (->)) (Nat (->) (->)) (->) where + fmap (Y f) = Nat (. f) + +instance (Category p, Op p ~ Y p) => Category (Y p) where + type Ob (Y p) = Ob p + id = Y id + Y f . Y g = Y (g . f) + source (Y f) = target f + target (Y f) = source f + unop = Y + op = getY + +instance (Category p, Op p ~ Y p) => Functor (Y p) (->) (Y p a) where + fmap = (.) + +instance (Category p, Op p ~ Y p) => Functor p (Nat (Y p) (->)) (Y p) where + fmap f = Nat (. Y f) + +-------------------------------------------------------------------------------- +-- * Constraints +-------------------------------------------------------------------------------- + +infixl 1 \\ -- comment required for cpp +(\\) :: a => (b => r) -> (a :- b) -> r +r \\ Sub Dict = r + +newtype p :- q = Sub (p => Dict q) + +instance Functor (:-) (->) Dict where + fmap p Dict = case p of + Sub q -> q + +instance Category (:-) where + id = Sub Dict + f . g = Sub (Dict \\ f \\ g) + +instance Functor (:-) (->) ((:-) e) where + fmap = (.) + +instance Functor (Y (:-)) (Nat (:-) (->)) (:-) where + fmap (Y f) = Nat (. f) + +-------------------------------------------------------------------------------- +-- * Common Functors +-------------------------------------------------------------------------------- + +instance Functor (->) (->) ((,) e) where + fmap f ~(a,b) = (a, f b) + +instance Functor (->) (->) (Either e) where + fmap _ (Left a) = Left a + fmap f (Right b) = Right (f b) + +instance Functor (->) (->) [] where + fmap = Prelude.fmap + +instance Functor (->) (->) Prelude.Maybe where + fmap = Prelude.fmap + +instance Functor (->) (->) Prelude.IO where + fmap = Prelude.fmap + +instance Functor (->) (Nat (->) (->)) (,) where + fmap f = Nat (\(a,b) -> (f a, b)) + +instance Functor (->) (Nat (->) (->)) Either where + fmap f0 = Nat (go f0) where + go :: (a -> b) -> Either a c -> Either b c + go f (Left a) = Left (f a) + go _ (Right b) = Right b + +-------------------------------------------------------------------------------- +-- * Type Equality +-------------------------------------------------------------------------------- + +instance Category (:~:) where + id = Refl + (.) = Prelude.flip Equality.trans + +instance Functor (Y (:~:)) (Nat (:~:) (->)) (:~:) where + fmap (Y f) = Nat (. f) + +instance Functor (:~:) (->) ((:~:) e) where + fmap = (.) + +-------------------------------------------------------------------------------- +-- * Type Coercions +-------------------------------------------------------------------------------- + +instance Category Coercion where + id = Coercion + (.) = Prelude.flip Coercion.trans + +instance Functor (Y Coercion) (Nat Coercion (->)) Coercion where + fmap (Y f) = Nat (. f) + +instance Functor Coercion (->) (Coercion e) where + fmap = (.) diff --git a/testsuite/tests/polykinds/all.T b/testsuite/tests/polykinds/all.T index 69c5ba0..5fc689d 100644 --- a/testsuite/tests/polykinds/all.T +++ b/testsuite/tests/polykinds/all.T @@ -135,3 +135,4 @@ test('T11255', normal, compile, ['']) test('T11459', normal, compile_fail, ['']) test('T11466', normal, compile_fail, ['']) test('T11480a', normal, compile, ['']) +test('T11480b', normal, compile, ['']) From git at git.haskell.org Mon Feb 8 15:07:32 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 8 Feb 2016 15:07:32 +0000 (UTC) Subject: [commit: ghc] master: Comments only, on the invariants of GlobalRdrEnv (6036cb6) Message-ID: <20160208150732.415E93A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6036cb6f67892e445bb3150850365dc7c7d64a40/ghc >--------------------------------------------------------------- commit 6036cb6f67892e445bb3150850365dc7c7d64a40 Author: Simon Peyton Jones Date: Mon Feb 1 14:01:34 2016 +0000 Comments only, on the invariants of GlobalRdrEnv >--------------------------------------------------------------- 6036cb6f67892e445bb3150850365dc7c7d64a40 compiler/basicTypes/RdrName.hs | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/compiler/basicTypes/RdrName.hs b/compiler/basicTypes/RdrName.hs index 62771e9..62f473e 100644 --- a/compiler/basicTypes/RdrName.hs +++ b/compiler/basicTypes/RdrName.hs @@ -416,6 +416,13 @@ type GlobalRdrEnv = OccEnv [GlobalRdrElt] -- happens only when type-checking a [d| ... |] Template -- Haskell quotation; see this note in RnNames -- Note [Top-level Names in Template Haskell decl quotes] +-- +-- INVARIANT 3: If the GlobalRdrEnv maps [occ -> gre], then +-- greOccName gre = occ +-- +-- NB: greOccName gre is usually the same as +-- nameOccName (gre_name gre), but not always in the +-- case of record seectors; see greOccName -- | An element of the 'GlobalRdrEnv' data GlobalRdrElt From git at git.haskell.org Mon Feb 8 15:07:34 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 8 Feb 2016 15:07:34 +0000 (UTC) Subject: [commit: ghc] master: Add comments to TcCoercibleFail (a96c4e7) Message-ID: <20160208150734.ECC2E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a96c4e7ca391ff3003d5debf187e7d177131f2fe/ghc >--------------------------------------------------------------- commit a96c4e7ca391ff3003d5debf187e7d177131f2fe Author: Simon Peyton Jones Date: Thu Feb 4 13:00:22 2016 +0000 Add comments to TcCoercibleFail Flag up the problem highlighted in Trac #11518 comment:15 >--------------------------------------------------------------- a96c4e7ca391ff3003d5debf187e7d177131f2fe testsuite/tests/typecheck/should_fail/TcCoercibleFail.hs | 7 +++++++ testsuite/tests/typecheck/should_fail/TcCoercibleFail.stderr | 6 +++--- 2 files changed, 10 insertions(+), 3 deletions(-) diff --git a/testsuite/tests/typecheck/should_fail/TcCoercibleFail.hs b/testsuite/tests/typecheck/should_fail/TcCoercibleFail.hs index c102da5..833609d 100644 --- a/testsuite/tests/typecheck/should_fail/TcCoercibleFail.hs +++ b/testsuite/tests/typecheck/should_fail/TcCoercibleFail.hs @@ -20,9 +20,16 @@ foo4 = coerce $ one :: Down Int newtype Void = Void Void foo5 = coerce :: Void -> () + +------------------------------------ +-- This next one generates an exponentally big type as it +-- tries to unwrap. See comment:15 in Trac #11518 +-- Adding asserions that force the types can make us +-- run out of space. newtype VoidBad a = VoidBad (VoidBad (a,a)) foo5' = coerce :: (VoidBad ()) -> () +------------------------------------ -- This shoul fail with a context stack overflow newtype Fix f = Fix (f (Fix f)) foo6 = coerce :: Fix (Either Int) -> Fix (Either Age) diff --git a/testsuite/tests/typecheck/should_fail/TcCoercibleFail.stderr b/testsuite/tests/typecheck/should_fail/TcCoercibleFail.stderr index 32dac6a..8c0df32 100644 --- a/testsuite/tests/typecheck/should_fail/TcCoercibleFail.stderr +++ b/testsuite/tests/typecheck/should_fail/TcCoercibleFail.stderr @@ -37,14 +37,14 @@ TcCoercibleFail.hs:21:8: error: ? In the expression: coerce :: Void -> () In an equation for ?foo5?: foo5 = coerce :: Void -> () -TcCoercibleFail.hs:24:9: error: +TcCoercibleFail.hs:30:9: error: ? Couldn't match representation of type ?VoidBad ()? with that of ?()? arising from a use of ?coerce? ? In the expression: coerce :: (VoidBad ()) -> () In an equation for ?foo5'?: foo5' = coerce :: (VoidBad ()) -> () -TcCoercibleFail.hs:28:8: error: +TcCoercibleFail.hs:35:8: error: ? Reduction stack overflow; size = 201 When simplifying the following type: Coercible (Fix (Either Int)) (Fix (Either Age)) @@ -56,7 +56,7 @@ TcCoercibleFail.hs:28:8: error: In an equation for ?foo6?: foo6 = coerce :: Fix (Either Int) -> Fix (Either Age) -TcCoercibleFail.hs:29:8: error: +TcCoercibleFail.hs:36:8: error: ? Couldn't match representation of type ?Either Int (Fix (Either Int))? with that of ?()? From git at git.haskell.org Mon Feb 8 15:07:37 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 8 Feb 2016 15:07:37 +0000 (UTC) Subject: [commit: ghc] master: White space and comments only (ee11a84) Message-ID: <20160208150737.B2FC13A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ee11a84c7b980b3485d52d5a5d0190b827660fb0/ghc >--------------------------------------------------------------- commit ee11a84c7b980b3485d52d5a5d0190b827660fb0 Author: Simon Peyton Jones Date: Thu Feb 4 13:02:17 2016 +0000 White space and comments only >--------------------------------------------------------------- ee11a84c7b980b3485d52d5a5d0190b827660fb0 compiler/main/TidyPgm.hs | 13 ++++++++----- compiler/typecheck/TcMType.hs | 2 +- 2 files changed, 9 insertions(+), 6 deletions(-) diff --git a/compiler/main/TidyPgm.hs b/compiler/main/TidyPgm.hs index 59cb201..c524bdf 100644 --- a/compiler/main/TidyPgm.hs +++ b/compiler/main/TidyPgm.hs @@ -1275,7 +1275,7 @@ tidyTopIdInfo dflags rhs_tidy_env name orig_rhs tidy_rhs idinfo show_unfold caf_ {- ************************************************************************ * * -\subsection{Figuring out CafInfo for an expression} + Figuring out CafInfo for an expression * * ************************************************************************ @@ -1332,7 +1332,7 @@ cafRefsE p (Lit lit) = cafRefsL p lit cafRefsE p (App f a) = cafRefsE p f || cafRefsE p a cafRefsE p (Lam _ e) = cafRefsE p e cafRefsE p (Let b e) = cafRefsEs p (rhssOfBind b) || cafRefsE p e -cafRefsE p (Case e _bndr _ alts) = cafRefsE p e || cafRefsEs p (rhssOfAlts alts) +cafRefsE p (Case e _ _ alts) = cafRefsE p e || cafRefsEs p (rhssOfAlts alts) cafRefsE p (Tick _n e) = cafRefsE p e cafRefsE p (Cast e _co) = cafRefsE p e cafRefsE _ (Type _) = False @@ -1355,10 +1355,13 @@ cafRefsV (subst, _) id | Just id' <- lookupVarEnv subst id = mayHaveCafRefs (idCafInfo id') | otherwise = False + {- ------------------------------------------------------------------------------- --- Old, dead, type-trimming code -------------------------------------------------------------------------------- +************************************************************************ +* * + Old, dead, type-trimming code +* * +************************************************************************ We used to try to "trim off" the constructors of data types that are not exported, to reduce the size of interface files, at least without diff --git a/compiler/typecheck/TcMType.hs b/compiler/typecheck/TcMType.hs index 143a392..adb4e5a 100644 --- a/compiler/typecheck/TcMType.hs +++ b/compiler/typecheck/TcMType.hs @@ -152,8 +152,8 @@ newEvVar :: TcPredType -> TcRnIf gbl lcl EvVar newEvVar ty = do { name <- newSysName (predTypeOccName ty) ; return (mkLocalIdOrCoVar name ty) } --- deals with both equality and non-equality predicates newWanted :: CtOrigin -> Maybe TypeOrKind -> PredType -> TcM CtEvidence +-- Deals with both equality and non-equality predicates newWanted orig t_or_k pty = do loc <- getCtLocM orig t_or_k d <- if isEqPred pty then HoleDest <$> newCoercionHole From git at git.haskell.org Mon Feb 8 15:07:40 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 8 Feb 2016 15:07:40 +0000 (UTC) Subject: [commit: ghc] master: Document and improve superclass expansion (8871737) Message-ID: <20160208150740.766523A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8871737db588b1cb8f7d33d60c5af80b85b2422d/ghc >--------------------------------------------------------------- commit 8871737db588b1cb8f7d33d60c5af80b85b2422d Author: Simon Peyton Jones Date: Mon Feb 8 13:14:02 2016 +0000 Document and improve superclass expansion When investigating Trac #11523 I found that superclass expansion was a little over-aggressive; we were sort of unrolling each loop twice. This patch corrects that, and adds explanatory comments. >--------------------------------------------------------------- 8871737db588b1cb8f7d33d60c5af80b85b2422d compiler/typecheck/TcCanonical.hs | 45 ++++++++++++++++++++++++++++----------- compiler/typecheck/TcRnTypes.hs | 3 ++- 2 files changed, 34 insertions(+), 14 deletions(-) diff --git a/compiler/typecheck/TcCanonical.hs b/compiler/typecheck/TcCanonical.hs index 5dc35ac..75996f8 100644 --- a/compiler/typecheck/TcCanonical.hs +++ b/compiler/typecheck/TcCanonical.hs @@ -366,21 +366,37 @@ mkGivensWithSuperClasses :: CtLoc -> [EvId] -> TcS [Ct] -- From a given EvId, make its Ct, plus the Ct's of its superclasses -- See Note [The superclass story] -- The loop-breaking here follows Note [Expanding superclasses] in TcType +-- +-- Example: class D a => C a +-- class C [a] => D a +-- makeGivensWithSuperClasses (C x) will return (C x, D x, C[x]) +-- i.e. up to and including the first repetition of C mkGivensWithSuperClasses loc ev_ids = concatMapM go ev_ids where - go ev_id = mk_superclasses emptyNameSet $ - CtGiven { ctev_evar = ev_id - , ctev_pred = evVarPred ev_id - , ctev_loc = loc } + go ev_id = mk_superclasses emptyNameSet this_ev + where + this_ev = CtGiven { ctev_evar = ev_id + , ctev_pred = evVarPred ev_id + , ctev_loc = loc } makeSuperClasses :: [Ct] -> TcS [Ct] -- Returns strict superclasses, transitively, see Note [The superclasses story] -- See Note [The superclass story] -- The loop-breaking here follows Note [Expanding superclasses] in TcType +-- Specifically, for an incoming (C t) constraint, we return all of (C t)'s +-- superclasses, up to /and including/ the first repetition of C +-- +-- Example: class D a => C a +-- class C [a] => D a +-- makeSuperClasses (C x) will return (D x, C [x]) +-- +-- NB: the incoming constraints have had their cc_pend_sc flag already +-- flipped to False, by isPendingScDict, so we are /obliged/ to at +-- least produce the immediate superclasses makeSuperClasses cts = concatMapM go cts where go (CDictCan { cc_ev = ev, cc_class = cls, cc_tyargs = tys }) - = mk_strict_superclasses emptyNameSet ev cls tys + = mk_strict_superclasses (unitNameSet (className cls)) ev cls tys go ct = pprPanic "makeSuperClasses" (ppr ct) mk_superclasses :: NameSet -> CtEvidence -> TcS [Ct] @@ -393,13 +409,13 @@ mk_superclasses rec_clss ev = return [mkNonCanonical ev] mk_superclasses_of :: NameSet -> CtEvidence -> Class -> [Type] -> TcS [Ct] --- Return this class constraint, plus its superclasses +-- Always return this class constraint, +-- and expand its superclasses mk_superclasses_of rec_clss ev cls tys - | loop_found - = return [this_ct] - | otherwise - = do { sc_cts <- mk_strict_superclasses rec_clss' ev cls tys - ; return (this_ct : sc_cts) } + | loop_found = return [this_ct] -- cc_pend_sc of this_ct = True + | otherwise = do { sc_cts <- mk_strict_superclasses rec_clss' ev cls tys + ; return (this_ct : sc_cts) } + -- cc_pend_sc of this_ct = False where cls_nm = className cls loop_found = cls_nm `elemNameSet` rec_clss @@ -407,15 +423,19 @@ mk_superclasses_of rec_clss ev cls tys | otherwise = rec_clss `extendNameSet` cls_nm this_ct = CDictCan { cc_ev = ev, cc_class = cls, cc_tyargs = tys , cc_pend_sc = loop_found } + -- NB: If there is a loop, we cut off, so we have not + -- added the superclasses, hence cc_pend_sc = True mk_strict_superclasses :: NameSet -> CtEvidence -> Class -> [Type] -> TcS [Ct] +-- Always return the immediate superclasses of (cls tys); +-- and expand their superclasses, provided none of them are in rec_clss +-- nor are repeated mk_strict_superclasses rec_clss ev cls tys | CtGiven { ctev_evar = evar, ctev_loc = loc } <- ev = do { sc_evs <- newGivenEvVars (mk_given_loc loc) (mkEvScSelectors (EvId evar) cls tys) ; concatMapM (mk_superclasses rec_clss) sc_evs } - | isEmptyVarSet (tyCoVarsOfTypes tys) = return [] -- Wanteds with no variables yield no deriveds. -- See Note [Improvement from Ground Wanteds] @@ -445,7 +465,6 @@ mk_strict_superclasses rec_clss ev cls tys = loc -- is only used for Givens, but does no harm - {- ************************************************************************ * * diff --git a/compiler/typecheck/TcRnTypes.hs b/compiler/typecheck/TcRnTypes.hs index 151e370..0474f74 100644 --- a/compiler/typecheck/TcRnTypes.hs +++ b/compiler/typecheck/TcRnTypes.hs @@ -1366,7 +1366,7 @@ data Ct cc_class :: Class, cc_tyargs :: [Xi], -- cc_tyargs are function-free, hence Xi cc_pend_sc :: Bool -- True <=> (a) cc_class has superclasses - -- (b) we have not yet added those + -- (b) we have not (yet) added those -- superclasses as Givens -- NB: cc_pend_sc is used for G/W/D. For W/D the reason -- we need superclasses is to expose possible improvement @@ -1769,6 +1769,7 @@ isUserTypeErrorCt ct = case getUserTypeErrorMsg ct of _ -> False isPendingScDict :: Ct -> Maybe Ct +-- Says whether cc_pend_sc is True, AND if so flips the flag isPendingScDict ct@(CDictCan { cc_pend_sc = True }) = Just (ct { cc_pend_sc = False }) isPendingScDict _ = Nothing From git at git.haskell.org Mon Feb 8 15:07:43 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 8 Feb 2016 15:07:43 +0000 (UTC) Subject: [commit: ghc] master: Comment out some traceFlat calls (e72665b) Message-ID: <20160208150743.427953A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e72665b547b89c114af9a8988048c2a4c47c2052/ghc >--------------------------------------------------------------- commit e72665b547b89c114af9a8988048c2a4c47c2052 Author: Simon Peyton Jones Date: Mon Feb 8 13:17:15 2016 +0000 Comment out some traceFlat calls They were excessively verbose. I've commented them out rather than deleting so that they can easily be restored. >--------------------------------------------------------------- e72665b547b89c114af9a8988048c2a4c47c2052 compiler/typecheck/TcFlatten.hs | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/compiler/typecheck/TcFlatten.hs b/compiler/typecheck/TcFlatten.hs index 0ab946b..76a339d 100644 --- a/compiler/typecheck/TcFlatten.hs +++ b/compiler/typecheck/TcFlatten.hs @@ -913,9 +913,9 @@ flatten_one (TyVarTy tv) ; role <- getRole ; case mb_yes of FTRCasted tv' kco -> -- Done - do { traceFlat "flattenTyVar1" - (pprTvBndr tv' $$ - ppr kco <+> dcolon <+> ppr (coercionKind kco)) + do { -- traceFlat "flattenTyVar1" + -- (pprTvBndr tv' $$ + -- ppr kco <+> dcolon <+> ppr (coercionKind kco)) ; return (ty', mkReflCo role ty `mkCoherenceLeftCo` mkSymCo kco) } where @@ -924,7 +924,7 @@ flatten_one (TyVarTy tv) FTRFollowed ty1 co1 -- Recur -> do { (ty2, co2) <- flatten_one ty1 - ; traceFlat "flattenTyVar2" (ppr tv $$ ppr ty2) + -- ; traceFlat "flattenTyVar2" (ppr tv $$ ppr ty2) ; return (ty2, co2 `mkTransCo` co1) } } flatten_one (AppTy ty1 ty2) @@ -1340,10 +1340,10 @@ flatten_tyvar3 tv <- setMode FM_SubstOnly $ flattenKinds $ flatten_one kind - ; traceFlat "flattenTyVarFinal" - (vcat [ ppr tv <+> dcolon <+> ppr (tyVarKind tv) - , ppr _new_kind - , ppr kind_co <+> dcolon <+> ppr (coercionKind kind_co) ]) +-- ; traceFlat "flattenTyVarFinal" +-- (vcat [ ppr tv <+> dcolon <+> ppr (tyVarKind tv) +-- , ppr _new_kind +-- , ppr kind_co <+> dcolon <+> ppr (coercionKind kind_co) ]) ; let Pair _ orig_kind = coercionKind kind_co -- orig_kind might be zonked ; return (FTRCasted (setTyVarKind tv orig_kind) kind_co) } From git at git.haskell.org Mon Feb 8 15:07:45 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 8 Feb 2016 15:07:45 +0000 (UTC) Subject: [commit: ghc] master: Improve tracing in TcInteract (7212968) Message-ID: <20160208150745.F39BD3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/72129686a319406e0c317619d1ba521a7f5b25f3/ghc >--------------------------------------------------------------- commit 72129686a319406e0c317619d1ba521a7f5b25f3 Author: Simon Peyton Jones Date: Mon Feb 8 13:18:35 2016 +0000 Improve tracing in TcInteract >--------------------------------------------------------------- 72129686a319406e0c317619d1ba521a7f5b25f3 compiler/typecheck/TcInteract.hs | 17 ++++++++++------- compiler/typecheck/TcSMonad.hs | 11 +++++++++-- 2 files changed, 19 insertions(+), 9 deletions(-) diff --git a/compiler/typecheck/TcInteract.hs b/compiler/typecheck/TcInteract.hs index 86cc8b3..b7a96d9 100644 --- a/compiler/typecheck/TcInteract.hs +++ b/compiler/typecheck/TcInteract.hs @@ -137,8 +137,11 @@ solveSimpleGivens givens | null givens -- Shortcut for common case = return emptyCts | otherwise - = do { go givens - ; takeGivenInsolubles } + = do { traceTcS "solveSimpleGivens {" (ppr givens) + ; go givens + ; given_insols <- takeGivenInsolubles + ; traceTcS "End solveSimpleGivens }" (text "Insoluble:" <+> pprCts given_insols) + ; return given_insols } where go givens = do { solveSimples (listToBag givens) ; new_givens <- runTcPluginsGiven @@ -149,10 +152,10 @@ solveSimpleWanteds :: Cts -> TcS WantedConstraints -- NB: 'simples' may contain /derived/ equalities, floated -- out from a nested implication. So don't discard deriveds! solveSimpleWanteds simples - = do { traceTcS "solveSimples {" (ppr simples) + = do { traceTcS "solveSimpleWanteds {" (ppr simples) ; dflags <- getDynFlags ; (n,wc) <- go 1 (solverIterations dflags) (emptyWC { wc_simple = simples }) - ; traceTcS "solveSimples end }" $ + ; traceTcS "solveSimpleWanteds end }" $ vcat [ text "iterations =" <+> ppr n , text "residual =" <+> ppr wc ] ; return wc } @@ -375,10 +378,10 @@ runSolverPipeline :: [(String,SimplifierStage)] -- The pipeline -> TcS () -- Run this item down the pipeline, leaving behind new work and inerts runSolverPipeline pipeline workItem - = do { initial_is <- getTcSInerts + = do { wl <- getWorkList ; traceTcS "Start solver pipeline {" $ - vcat [ text "work item = " <+> ppr workItem - , text "inerts = " <+> ppr initial_is] + vcat [ text "work item =" <+> ppr workItem + , text "rest of worklist =" <+> ppr wl ] ; bumpStepCountTcS -- One step for each constraint processed ; final_res <- run_pipeline pipeline (ContinueWith workItem) diff --git a/compiler/typecheck/TcSMonad.hs b/compiler/typecheck/TcSMonad.hs index a6cf019..5f7abdd 100644 --- a/compiler/typecheck/TcSMonad.hs +++ b/compiler/typecheck/TcSMonad.hs @@ -10,7 +10,7 @@ module TcSMonad ( appendWorkList, selectNextWorkItem, workListSize, workListWantedCount, - updWorkListTcS, + getWorkList, updWorkListTcS, -- The TcS monad TcS, runTcS, runTcSDeriveds, runTcSWithEvBinds, @@ -150,6 +150,7 @@ import Unique import UniqFM import Maybes +import StaticFlags( opt_PprStyle_Debug ) import TrieMap import Control.Monad #if __GLASGOW_HASKELL__ > 710 @@ -283,6 +284,10 @@ selectWorkItem wl@(WL { wl_eqs = eqs, wl_funeqs = feqs | ct:cts <- rest = Just (ct, wl { wl_rest = cts }) | otherwise = Nothing +getWorkList :: TcS WorkList +getWorkList = do { wl_var <- getTcSWorkListRef + ; wrapTcS (TcM.readTcRef wl_var) } + selectDerivedWorkItem :: WorkList -> Maybe (Ct, WorkList) selectDerivedWorkItem wl@(WL { wl_deriv = ders }) | ev:evs <- ders = Just (mkNonCanonical ev, wl { wl_deriv = evs }) @@ -324,7 +329,9 @@ instance Outputable WorkList where , ppUnless (null ders) $ text "Derived =" <+> vcat (map ppr ders) , ppUnless (isEmptyBag implics) $ - text "Implics =" <+> vcat (map ppr (bagToList implics)) + if opt_PprStyle_Debug -- Typically we only want the work list for this level + then text "Implics =" <+> vcat (map ppr (bagToList implics)) + else text "(Implics omitted)" ]) From git at git.haskell.org Mon Feb 8 15:07:48 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 8 Feb 2016 15:07:48 +0000 (UTC) Subject: [commit: ghc] master: Improve error messages for recursive superclasses (d6b68be) Message-ID: <20160208150748.E899A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d6b68be1100203aa13755457f89ee4bbb0297473/ghc >--------------------------------------------------------------- commit d6b68be1100203aa13755457f89ee4bbb0297473 Author: Simon Peyton Jones Date: Mon Feb 8 13:31:11 2016 +0000 Improve error messages for recursive superclasses If we fail to typecheck by blowing the constraint simplifier iteration limit, we want to see the limit-blowing meessage. Previously it was being suppressed by the type /error/, which suppress the iteration-limit /warning/. Solution: make the iteration-limit message into an error. >--------------------------------------------------------------- d6b68be1100203aa13755457f89ee4bbb0297473 compiler/typecheck/TcSMonad.hs | 7 ++++--- compiler/typecheck/TcSimplify.hs | 26 ++++++++++++++++++-------- 2 files changed, 22 insertions(+), 11 deletions(-) diff --git a/compiler/typecheck/TcSMonad.hs b/compiler/typecheck/TcSMonad.hs index 5f7abdd..edcedf7 100644 --- a/compiler/typecheck/TcSMonad.hs +++ b/compiler/typecheck/TcSMonad.hs @@ -14,7 +14,7 @@ module TcSMonad ( -- The TcS monad TcS, runTcS, runTcSDeriveds, runTcSWithEvBinds, - failTcS, warnTcS, + failTcS, warnTcS, addErrTcS, runTcSEqualities, nestTcS, nestImplicTcS, @@ -2322,10 +2322,11 @@ wrapWarnTcS :: TcM a -> TcS a -- There's no static check; it's up to the user wrapWarnTcS = wrapTcS -failTcS, panicTcS :: SDoc -> TcS a -warnTcS :: SDoc -> TcS () +failTcS, panicTcS :: SDoc -> TcS a +warnTcS, addErrTcS :: SDoc -> TcS () failTcS = wrapTcS . TcM.failWith warnTcS = wrapTcS . TcM.addWarn +addErrTcS = wrapTcS . TcM.addErr panicTcS doc = pprPanic "TcCanonical" doc traceTcS :: String -> SDoc -> TcS () diff --git a/compiler/typecheck/TcSimplify.hs b/compiler/typecheck/TcSimplify.hs index 479893a..379e17f 100644 --- a/compiler/typecheck/TcSimplify.hs +++ b/compiler/typecheck/TcSimplify.hs @@ -545,8 +545,8 @@ simplifyInfer rhs_tclvl apply_mr sigs name_taus wanteds -- again later. All we want here are the predicates over which to -- quantify. -- - -- If any meta-tyvar unifications take place (unlikely), we'll - -- pick that up later. + -- If any meta-tyvar unifications take place (unlikely), + -- we'll pick that up later. -- See Note [Promote _and_ default when inferring] ; let def_tyvar tv @@ -558,9 +558,10 @@ simplifyInfer rhs_tclvl apply_mr sigs name_taus wanteds ; WC { wc_simple = simples } <- setTcLevel rhs_tclvl $ runTcSDeriveds $ - solveSimpleWanteds $ mapBag toDerivedCt quant_cand - -- NB: we don't want evidence, so used - -- Derived constraints + solveSimpleWanteds $ + mapBag toDerivedCt quant_cand + -- NB: we don't want evidence, + -- so use Derived constraints ; simples <- TcM.zonkSimples simples @@ -961,7 +962,7 @@ This only half-works, but then let-generalisation only half-works. -} simplifyWantedsTcM :: [CtEvidence] -> TcM WantedConstraints --- Zonk the input constraints, and simplify them +-- Solve the specified Wanted constraints -- Discard the evidence binds -- Discards all Derived stuff in result -- Postcondition: fully zonked and unflattened constraints @@ -1018,7 +1019,11 @@ simpl_loop n limit floated_eqs no_new_scs = return wc -- Done! | n `intGtLimit` limit - = do { warnTcS (hang (text "solveWanteds: too many iterations" + = do { -- Add an error (not a warning) if we blow the limit, + -- Typically if we blow the limit we are going to report some other error + -- (an unsolved constraint), and we don't want that error to suppress + -- the iteration limit warning! + addErrTcS (hang (text "solveWanteds: too many iterations" <+> parens (text "limit =" <+> ppr limit)) 2 (vcat [ text "Unsolved:" <+> ppr wc , ppUnless (isEmptyBag floated_eqs) $ @@ -1030,7 +1035,12 @@ simpl_loop n limit floated_eqs no_new_scs ; return wc } | otherwise - = do { traceTcS "simpl_loop, iteration" (int n) + = do { let n_floated = lengthBag floated_eqs + ; csTraceTcS $ + text "simpl_loop iteration=" <> int n + <+> (parens $ hsep [ text "no new scs =" <+> ppr no_new_scs <> comma + , int n_floated <+> text "floated eqs" <> comma + , int (lengthBag simples) <+> text "simples to solve" ]) -- solveSimples may make progress if either float_eqs hold ; (unifs1, wc1) <- reportUnifications $ From git at git.haskell.org Mon Feb 8 15:07:51 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 8 Feb 2016 15:07:51 +0000 (UTC) Subject: [commit: ghc] master: Use runTcSDeriveds for simplifyDefault (f79b9ec) Message-ID: <20160208150751.B07D03A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f79b9ec98ac1ea1d6ce1995a29e2a24737518e77/ghc >--------------------------------------------------------------- commit f79b9ec98ac1ea1d6ce1995a29e2a24737518e77 Author: Simon Peyton Jones Date: Mon Feb 8 13:36:31 2016 +0000 Use runTcSDeriveds for simplifyDefault This is a small refactoring, no change in behaviour. >--------------------------------------------------------------- f79b9ec98ac1ea1d6ce1995a29e2a24737518e77 compiler/typecheck/TcSimplify.hs | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/compiler/typecheck/TcSimplify.hs b/compiler/typecheck/TcSimplify.hs index 379e17f..8a57877 100644 --- a/compiler/typecheck/TcSimplify.hs +++ b/compiler/typecheck/TcSimplify.hs @@ -396,13 +396,14 @@ simplifyDefault :: ThetaType -- Wanted; has no type variables in it -> TcM () -- Succeeds if the constraint is soluble simplifyDefault theta = do { traceTc "simplifyInteractive" empty - ; wanted <- newWanteds DefaultOrigin theta - ; unsolved <- simplifyWantedsTcM wanted - + ; loc <- getCtLocM DefaultOrigin Nothing + ; let wanted = [ CtDerived { ctev_pred = pred + , ctev_loc = loc } + | pred <- theta ] + ; unsolved <- runTcSDeriveds (solveWanteds (mkSimpleWC wanted)) ; traceTc "reportUnsolved {" empty ; reportAllUnsolved unsolved ; traceTc "reportUnsolved }" empty - ; return () } ------------------ From git at git.haskell.org Mon Feb 8 15:07:54 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 8 Feb 2016 15:07:54 +0000 (UTC) Subject: [commit: ghc] master: A small, local refactoring of TcSimplify.usefulToFloat (6252b70) Message-ID: <20160208150754.65ACD3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6252b70a2fc61ff90c7abc93d2e9f05cf60ab47e/ghc >--------------------------------------------------------------- commit 6252b70a2fc61ff90c7abc93d2e9f05cf60ab47e Author: Simon Peyton Jones Date: Mon Feb 8 13:38:09 2016 +0000 A small, local refactoring of TcSimplify.usefulToFloat >--------------------------------------------------------------- 6252b70a2fc61ff90c7abc93d2e9f05cf60ab47e compiler/typecheck/TcSimplify.hs | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/compiler/typecheck/TcSimplify.hs b/compiler/typecheck/TcSimplify.hs index 8a57877..b992ef7 100644 --- a/compiler/typecheck/TcSimplify.hs +++ b/compiler/typecheck/TcSimplify.hs @@ -1760,12 +1760,12 @@ floatEqualities skols no_given_eqs , wanteds { wc_simple = remaining_simples } ) } where skol_set = mkVarSet skols - (float_eqs, remaining_simples) = partitionBag (usefulToFloat is_useful) simples - is_useful pred = tyCoVarsOfType pred `disjointVarSet` skol_set + (float_eqs, remaining_simples) = partitionBag (usefulToFloat skol_set) simples -usefulToFloat :: (TcPredType -> Bool) -> Ct -> Bool -usefulToFloat is_useful_pred ct -- The constraint is un-flattened and de-canonicalised - = is_meta_var_eq pred && is_useful_pred pred +usefulToFloat :: VarSet -> Ct -> Bool +usefulToFloat skol_set ct -- The constraint is un-flattened and de-canonicalised + = is_meta_var_eq pred && + (tyCoVarsOfType pred `disjointVarSet` skol_set) where pred = ctPred ct From git at git.haskell.org Mon Feb 8 15:07:57 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 8 Feb 2016 15:07:57 +0000 (UTC) Subject: [commit: ghc] master: Fix a nasty superclass expansion bug (43e02d1) Message-ID: <20160208150757.89D443A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/43e02d1270701a1043be67f078cf2b1a85047feb/ghc >--------------------------------------------------------------- commit 43e02d1270701a1043be67f078cf2b1a85047feb Author: Simon Peyton Jones Date: Mon Feb 8 14:41:08 2016 +0000 Fix a nasty superclass expansion bug This patch fixes Trac #11523. * The basic problem was that TcRnTypes.superClassesMightHelp was returning True of a Derived constraint, and that led to us expanding Given superclasses, which produced the same Derived constraint again, and so on infinitely. We really want to do this only if there are unsolve /Wanted/ contraints! * On the way I made TcSMonad.getUnsolvedInerts a bit more discriminating about which Derived equalities it returns; see Note [Unsolved Derived equalities] in TcSMonad * Lots of new comments in TcSMonad. >--------------------------------------------------------------- 43e02d1270701a1043be67f078cf2b1a85047feb compiler/typecheck/TcRnTypes.hs | 58 +++++++----- compiler/typecheck/TcSMonad.hs | 102 +++++++++++++-------- testsuite/tests/polykinds/T11523.hs | 89 ++++++++++++++++++ testsuite/tests/polykinds/all.T | 1 + testsuite/tests/typecheck/should_fail/T5853.stderr | 22 ++--- 5 files changed, 199 insertions(+), 73 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 43e02d1270701a1043be67f078cf2b1a85047feb From git at git.haskell.org Mon Feb 8 15:26:42 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 8 Feb 2016 15:26:42 +0000 (UTC) Subject: [commit: ghc] master: release notes: Note new two-step allocator (5a58634) Message-ID: <20160208152642.3C3863A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5a58634ec6f79af175685d97f4051cb5532d4b22/ghc >--------------------------------------------------------------- commit 5a58634ec6f79af175685d97f4051cb5532d4b22 Author: Ben Gamari Date: Mon Feb 8 15:51:55 2016 +0100 release notes: Note new two-step allocator >--------------------------------------------------------------- 5a58634ec6f79af175685d97f4051cb5532d4b22 docs/users_guide/8.0.1-notes.rst | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/docs/users_guide/8.0.1-notes.rst b/docs/users_guide/8.0.1-notes.rst index f537c54..fe3ab69 100644 --- a/docs/users_guide/8.0.1-notes.rst +++ b/docs/users_guide/8.0.1-notes.rst @@ -409,6 +409,13 @@ Template Haskell Runtime system ~~~~~~~~~~~~~~ +- We have a shiny new two-step memory allocator for 64-bit platforms (see + :ghc-ticket:`9706`). In addition to simplifying the runtime system's + implementation this may significantly improve garbage collector performance. + Note, however, that Haskell processes will have an apparent virtual memory + footprint of a terabyte or so. Don't worry though, most of this amount is merely + mapped but uncommitted address space which is not backed by physical memory. + - Support for performance monitoring with PAPI has been dropped. - :rts-flag:`-maxN?x? <-maxN>` flag added to complement :rts-flag:`-N`. It will From git at git.haskell.org Mon Feb 8 17:47:20 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 8 Feb 2016 17:47:20 +0000 (UTC) Subject: [commit: ghc] master: Some tiding up in TcGenDeriv (96d4514) Message-ID: <20160208174720.8ECA53A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/96d451450923a80b043b5314c5eaaa9d0eab7c56/ghc >--------------------------------------------------------------- commit 96d451450923a80b043b5314c5eaaa9d0eab7c56 Author: Simon Peyton Jones Date: Mon Feb 8 15:29:12 2016 +0000 Some tiding up in TcGenDeriv ..around newtype deriving instances. See esp the new Note [Newtype-deriving instances] No change in behaviour >--------------------------------------------------------------- 96d451450923a80b043b5314c5eaaa9d0eab7c56 compiler/typecheck/TcClassDcl.hs | 5 +- compiler/typecheck/TcGenDeriv.hs | 103 ++++++++++++++++++++++++++------------- compiler/typecheck/TcType.hs | 21 +++++++- 3 files changed, 91 insertions(+), 38 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 96d451450923a80b043b5314c5eaaa9d0eab7c56 From git at git.haskell.org Mon Feb 8 17:47:23 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 8 Feb 2016 17:47:23 +0000 (UTC) Subject: [commit: ghc] master: Test Trac #11552 (c9ac9de) Message-ID: <20160208174723.B87DD3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c9ac9de78254fb6bf463fd6370be7a7214b3e649/ghc >--------------------------------------------------------------- commit c9ac9de78254fb6bf463fd6370be7a7214b3e649 Author: Simon Peyton Jones Date: Mon Feb 8 17:38:26 2016 +0000 Test Trac #11552 >--------------------------------------------------------------- c9ac9de78254fb6bf463fd6370be7a7214b3e649 testsuite/tests/typecheck/should_compile/T11552.hs | 21 +++++++++++++++++++++ testsuite/tests/typecheck/should_compile/all.T | 1 + 2 files changed, 22 insertions(+) diff --git a/testsuite/tests/typecheck/should_compile/T11552.hs b/testsuite/tests/typecheck/should_compile/T11552.hs new file mode 100644 index 0000000..1c5a54b --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T11552.hs @@ -0,0 +1,21 @@ +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module T11552 where + +newtype MaybeT m a = + MaybeT { runMaybeT :: m (Maybe a) } + +instance (Functor m) => Functor (MaybeT m) where + fmap f (MaybeT ma) = + MaybeT $ (fmap . fmap) f ma + +instance forall f . (Applicative f) => Applicative (MaybeT f) where + pure :: a -> MaybeT f a + pure x = MaybeT (pure (pure x)) + + (<*>) :: forall a b . Applicative f => MaybeT f (a -> b) -> MaybeT f a -> MaybeT f b + (MaybeT fab) <*> (MaybeT mma) = + let fab' :: f (Maybe (a -> b)) + fab' = fab + in MaybeT $ undefined diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index e4b1e41..c547d6c 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -504,3 +504,4 @@ test('T11397', normal, compile, ['']) test('T11458', normal, compile, ['']) test('T11516', expect_broken(11516), compile, ['']) test('T11524', normal, compile, ['']) +test('T11552', normal, compile, ['']) From git at git.haskell.org Mon Feb 8 17:47:26 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 8 Feb 2016 17:47:26 +0000 (UTC) Subject: [commit: ghc] master: Define tyConRolesRepresentational and use it (489a9a3) Message-ID: <20160208174726.7B09B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/489a9a3beeeae3d150761ef863b4757eba0b02d9/ghc >--------------------------------------------------------------- commit 489a9a3beeeae3d150761ef863b4757eba0b02d9 Author: Simon Peyton Jones Date: Mon Feb 8 17:41:58 2016 +0000 Define tyConRolesRepresentational and use it tyConRolesRepresentational is just a version of tyConRolesX, but specialised for a Representational argument. Saves a bit of extra argument passing and pattern matching, and tyConRolesX was often called when we knew the argument role was Representational. Rather to my surprise this made the compiler allocate 5% less for tests T9872{b,c,d}. At least I think it's this commit. Good thing, regardless. >--------------------------------------------------------------- 489a9a3beeeae3d150761ef863b4757eba0b02d9 compiler/typecheck/TcFlatten.hs | 2 +- compiler/types/Coercion.hs | 17 ++++++++++------- compiler/types/OptCoercion.hs | 4 ++-- testsuite/tests/perf/compiler/all.T | 9 ++++++--- 4 files changed, 19 insertions(+), 13 deletions(-) diff --git a/compiler/typecheck/TcFlatten.hs b/compiler/typecheck/TcFlatten.hs index 76a339d..169232e 100644 --- a/compiler/typecheck/TcFlatten.hs +++ b/compiler/typecheck/TcFlatten.hs @@ -1035,7 +1035,7 @@ flatten_ty_con_app tc tys ; let role = eqRelRole eq_rel ; (xis, cos) <- case eq_rel of NomEq -> flatten_many_nom tys - ReprEq -> flatten_many (tyConRolesX role tc) tys + ReprEq -> flatten_many (tyConRolesRepresentational tc) tys ; return (mkTyConApp tc xis, mkTyConAppCo role tc cos) } {- diff --git a/compiler/types/Coercion.hs b/compiler/types/Coercion.hs index c8e48c0..2989bce 100644 --- a/compiler/types/Coercion.hs +++ b/compiler/types/Coercion.hs @@ -53,7 +53,7 @@ module Coercion ( splitAppCo_maybe, splitForAllCo_maybe, - nthRole, tyConRolesX, setNominalRole_maybe, + nthRole, tyConRolesX, tyConRolesRepresentational, setNominalRole_maybe, pickLR, @@ -609,7 +609,7 @@ mkAppCo (TyConAppCo r tc args) arg = case r of Nominal -> TyConAppCo Nominal tc (args ++ [arg]) Representational -> TyConAppCo Representational tc (args ++ [arg']) - where new_role = (tyConRolesX Representational tc) !! (length args) + where new_role = (tyConRolesRepresentational tc) !! (length args) arg' = downgradeRole new_role Nominal arg Phantom -> TyConAppCo Phantom tc (args ++ [toPhantomCo arg]) mkAppCo co arg = AppCo co arg @@ -670,13 +670,13 @@ mkTransAppCo r1 co1 ty1a ty1b r2 co2 ty2a ty2b r3 , nextRole ty1b == r2 = (mkAppCo co1_repr (mkNomReflCo ty2a)) `mkTransCo` (mkTyConAppCo Representational tc1b - (zipWith mkReflCo (tyConRolesX Representational tc1b) tys1b + (zipWith mkReflCo (tyConRolesRepresentational tc1b) tys1b ++ [co2])) | Just (tc1a, tys1a) <- splitTyConApp_maybe ty1a , nextRole ty1a == r2 = (mkTyConAppCo Representational tc1a - (zipWith mkReflCo (tyConRolesX Representational tc1a) tys1a + (zipWith mkReflCo (tyConRolesRepresentational tc1a) tys1a ++ [co2])) `mkTransCo` (mkAppCo co1_repr (mkNomReflCo ty2b)) @@ -1053,20 +1053,23 @@ toPhantomCo co -- Convert args to a TyConAppCo Nominal to the same TyConAppCo Representational applyRoles :: TyCon -> [Coercion] -> [Coercion] applyRoles tc cos - = zipWith (\r -> downgradeRole r Nominal) (tyConRolesX Representational tc) cos + = zipWith (\r -> downgradeRole r Nominal) (tyConRolesRepresentational tc) cos -- the Role parameter is the Role of the TyConAppCo -- defined here because this is intimiately concerned with the implementation -- of TyConAppCo tyConRolesX :: Role -> TyCon -> [Role] -tyConRolesX Representational tc = tyConRoles tc ++ repeat Nominal +tyConRolesX Representational tc = tyConRolesRepresentational tc tyConRolesX role _ = repeat role +tyConRolesRepresentational :: TyCon -> [Role] +tyConRolesRepresentational tc = tyConRoles tc ++ repeat Nominal + nthRole :: Role -> TyCon -> Int -> Role nthRole Nominal _ _ = Nominal nthRole Phantom _ _ = Phantom nthRole Representational tc n - = (tyConRolesX Representational tc) `getNth` n + = (tyConRolesRepresentational tc) `getNth` n ltRole :: Role -> Role -> Bool -- Is one role "less" than another? diff --git a/compiler/types/OptCoercion.hs b/compiler/types/OptCoercion.hs index fc6da62..210fc22 100644 --- a/compiler/types/OptCoercion.hs +++ b/compiler/types/OptCoercion.hs @@ -180,7 +180,7 @@ opt_co4 env sym rep r g@(TyConAppCo _r tc cos) (True, Nominal) -> mkTyConAppCo Representational tc (zipWith3 (opt_co3 env sym) - (map Just (tyConRolesX Representational tc)) + (map Just (tyConRolesRepresentational tc)) (repeat Nominal) cos) (False, Nominal) -> @@ -189,7 +189,7 @@ opt_co4 env sym rep r g@(TyConAppCo _r tc cos) -- must use opt_co2 here, because some roles may be P -- See Note [Optimising coercion optimisation] mkTyConAppCo r tc (zipWith (opt_co2 env sym) - (tyConRolesX r tc) -- the current roles + (tyConRolesRepresentational tc) -- the current roles cos) (_, Phantom) -> pprPanic "opt_co4 sees a phantom!" (ppr g) diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T index 7699aff..44b3e75 100644 --- a/testsuite/tests/perf/compiler/all.T +++ b/testsuite/tests/perf/compiler/all.T @@ -673,11 +673,12 @@ test('T9872a', test('T9872b', [ only_ways(['normal']), compiler_stats_num_field('bytes allocated', - [(wordsize(64), 5199926080, 5), + [(wordsize(64), 4918990352, 5), # 2014-12-10 6483306280 Initally created # 2014-12-16 6892251912 Flattener parameterized over roles # 2014-12-18 3480212048 Reduce type families even more eagerly # 2015-12-11 5199926080 TypeInType (see #11196) + # 2016-02-08 4918990352 Improved a bit by tyConRolesRepresentational (wordsize(32), 1700000000, 5) ]), ], @@ -686,11 +687,12 @@ test('T9872b', test('T9872c', [ only_ways(['normal']), compiler_stats_num_field('bytes allocated', - [(wordsize(64), 4723613784, 5), + [(wordsize(64), 4454071184, 5), # 2014-12-10 5495850096 Initally created # 2014-12-16 5842024784 Flattener parameterized over roles # 2014-12-18 2963554096 Reduce type families even more eagerly # 2015-12-11 4723613784 TypeInType (see #11196) + # 2016-02-08 4454071184 Improved a bit by tyConRolesRepresentational (wordsize(32), 1500000000, 5) ]), ], @@ -699,11 +701,12 @@ test('T9872c', test('T9872d', [ only_ways(['normal']), compiler_stats_num_field('bytes allocated', - [(wordsize(64), 566134504, 5), + [(wordsize(64), 534693648, 5), # 2014-12-18 796071864 Initally created # 2014-12-18 739189056 Reduce type families even more eagerly # 2015-01-07 687562440 TrieMap leaf compression # 2015-03-17 726679784 tweak to solver; probably flattens more + # 2016-02-08 534693648 Improved a bit by tyConRolesRepresentational (wordsize(32), 59651432, 5) # some date 328810212 # 2015-07-11 350369584 From git at git.haskell.org Mon Feb 8 17:47:29 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 8 Feb 2016 17:47:29 +0000 (UTC) Subject: [commit: ghc] master: Define mkTvSubst, and use it (fac0efc) Message-ID: <20160208174729.53CAB3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/fac0efc3f7a583a3b5b903b5c78e4f8455e95e17/ghc >--------------------------------------------------------------- commit fac0efc3f7a583a3b5b903b5c78e4f8455e95e17 Author: Simon Peyton Jones Date: Mon Feb 8 17:36:52 2016 +0000 Define mkTvSubst, and use it mkTvSubst :: InScopeSet -> TvSubstEnv -> TCvSubst produces a TCvSubst with an empty CvSubstEnv >--------------------------------------------------------------- fac0efc3f7a583a3b5b903b5c78e4f8455e95e17 compiler/typecheck/TcDeriv.hs | 4 +--- compiler/typecheck/TcGenDeriv.hs | 6 ++---- compiler/typecheck/TcInstDcls.hs | 4 +--- compiler/typecheck/TcType.hs | 2 +- compiler/types/FamInstEnv.hs | 3 +-- compiler/types/TyCoRep.hs | 16 +++++++++++----- compiler/types/Unify.hs | 18 ++++++++---------- 7 files changed, 25 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 fac0efc3f7a583a3b5b903b5c78e4f8455e95e17 From git at git.haskell.org Mon Feb 8 21:58:44 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 8 Feb 2016 21:58:44 +0000 (UTC) Subject: [commit: ghc] master: Remove unused LiveVars and SRT fields of StgCase (023fc92) Message-ID: <20160208215844.7A8123A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/023fc92f6f98a8bd003ce20083d3682aec865cb5/ghc >--------------------------------------------------------------- commit 023fc92f6f98a8bd003ce20083d3682aec865cb5 Author: ?mer Sinan A?acan Date: Mon Feb 8 16:18:23 2016 -0500 Remove unused LiveVars and SRT fields of StgCase We also need to update `stgBindHasCafRefs` assertion with this change, as we no longer have the pre-computed SRT, LiveVars etc. We rename it to `topStgBindHasCafRefs` and implement it like this: A non-updatable top-level binding may refer to a CAF by referring to a top-level definition with CAFs. A top-level definition may have CAFs if it's updatable. At this point (because this is done after TidyPgm) top-level Ids (whether imported or defined in this module) are GlobalIds, so the top-levelness test is easy. (see also comments in the code) Reviewers: bgamari, simonpj, austin Reviewed By: simonpj Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1889 GHC Trac Issues: #11550 >--------------------------------------------------------------- 023fc92f6f98a8bd003ce20083d3682aec865cb5 compiler/codeGen/StgCmm.hs | 2 +- compiler/codeGen/StgCmmBind.hs | 4 +- compiler/codeGen/StgCmmExpr.hs | 6 +- compiler/main/HscMain.hs | 4 +- compiler/profiling/SCCfinal.hs | 24 ++--- compiler/simplStg/StgStats.hs | 6 +- compiler/simplStg/UnariseStg.hs | 26 ++--- compiler/stgSyn/CoreToStg.hs | 226 ++++++++++------------------------------ compiler/stgSyn/StgLint.hs | 8 +- compiler/stgSyn/StgSyn.hs | 170 ++++++++++++++---------------- 10 files changed, 164 insertions(+), 312 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 023fc92f6f98a8bd003ce20083d3682aec865cb5 From git at git.haskell.org Tue Feb 9 10:01:11 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 9 Feb 2016 10:01:11 +0000 (UTC) Subject: [commit: ghc] master: Print * has Unicode star with -fprint-unicode-syntax (da19c13) Message-ID: <20160209100111.23BCE3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/da19c136f3e8e73a3713acb5e5802e0f28db8efd/ghc >--------------------------------------------------------------- commit da19c136f3e8e73a3713acb5e5802e0f28db8efd Author: Ben Gamari Date: Mon Feb 8 16:29:04 2016 +0100 Print * has Unicode star with -fprint-unicode-syntax Reviewers: austin, thomie Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1893 >--------------------------------------------------------------- da19c136f3e8e73a3713acb5e5802e0f28db8efd compiler/main/DynFlags.hs | 5 ++++- compiler/types/TyCoRep.hs | 3 ++- compiler/utils/Outputable.hs | 1 + 3 files changed, 7 insertions(+), 2 deletions(-) diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 992f47d..0fa7434 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -1817,7 +1817,10 @@ lang_set dflags lang = extensionFlags = flattenExtensionFlags lang (extensions dflags) } --- | Check whether to use unicode syntax for output +-- | An internal helper to check whether to use unicode syntax for output. +-- +-- Note: You should very likely be using 'Outputable.unicodeSyntax' instead +-- of this function. useUnicodeSyntax :: DynFlags -> Bool useUnicodeSyntax = gopt Opt_PrintUnicodeSyntax diff --git a/compiler/types/TyCoRep.hs b/compiler/types/TyCoRep.hs index bf61a13..6a13213 100644 --- a/compiler/types/TyCoRep.hs +++ b/compiler/types/TyCoRep.hs @@ -2648,7 +2648,8 @@ pprTyTcApp p tc tys | tc `hasKey` tYPETyConKey , [TyConApp lev_tc []] <- tys - = if | lev_tc `hasKey` liftedDataConKey -> char '*' + = if | lev_tc `hasKey` liftedDataConKey -> + unicodeSyntax (char '?') (char '*') | lev_tc `hasKey` unliftedDataConKey -> char '#' | otherwise -> ppr_deflt diff --git a/compiler/utils/Outputable.hs b/compiler/utils/Outputable.hs index bf0cc90..259b554 100644 --- a/compiler/utils/Outputable.hs +++ b/compiler/utils/Outputable.hs @@ -35,6 +35,7 @@ module Outputable ( fsep, fcat, hang, hangNotEmpty, punctuate, ppWhen, ppUnless, speakNth, speakN, speakNOf, plural, isOrAre, doOrDoes, + unicodeSyntax, coloured, PprColour, colType, colCoerc, colDataCon, colBinder, bold, keyword, From git at git.haskell.org Tue Feb 9 10:01:13 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 9 Feb 2016 10:01:13 +0000 (UTC) Subject: [commit: ghc] master: testsuite: Un-break T5642 (16cf460) Message-ID: <20160209100113.DE4FF3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/16cf460ca6c4aa1ccb05703743f61242ee90c53f/ghc >--------------------------------------------------------------- commit 16cf460ca6c4aa1ccb05703743f61242ee90c53f Author: Ben Gamari Date: Mon Feb 8 17:44:44 2016 +0100 testsuite: Un-break T5642 This was largely fixed by the re-rework of the pattern match checker. Resolves #5642. >--------------------------------------------------------------- 16cf460ca6c4aa1ccb05703743f61242ee90c53f testsuite/tests/perf/compiler/all.T | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T index 44b3e75..776e062 100644 --- a/testsuite/tests/perf/compiler/all.T +++ b/testsuite/tests/perf/compiler/all.T @@ -522,7 +522,7 @@ test('T5321FD', test('T5642', [ only_ways(['normal']), - skip, # See Trac #11163 + normal, compiler_stats_num_field('bytes allocated', [(wordsize(32), 641085256, 10), # sample from x86/Linux @@ -530,7 +530,7 @@ test('T5642', # 2014-09-03: 753045568 # 2014-12-10: 641085256 Improvements in constraints solver - (wordsize(64), 1071915072, 10)]) + (wordsize(64), 950004816, 10)]) # prev: 1300000000 # 2014-07-17: 1358833928 (general round of updates) # 2014-08-07: 1402242360 (caused by 1fc60ea) @@ -543,6 +543,7 @@ test('T5642', # 2014-12-10: 1282916024 Improvements in constraints solver # 2015-10-28: 1412808976 Emit Typeable at definition site # 2015-11-22: 1071915072 Use TypeLits in the metadata encoding + # 2016-02-08: 950004816 Pattern match checker re-rework ], compile,['-O']) From git at git.haskell.org Tue Feb 9 14:41:09 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 9 Feb 2016 14:41:09 +0000 (UTC) Subject: [commit: ghc] master: Fix the removal of unnecessary stack checks (4ec6141) Message-ID: <20160209144109.61AFB3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4ec61411930495fc109be27993c176fd7aaf486d/ghc >--------------------------------------------------------------- commit 4ec61411930495fc109be27993c176fd7aaf486d Author: Jonas Scholl Date: Tue Feb 9 11:06:00 2016 +0100 Fix the removal of unnecessary stack checks The module CmmLayoutStack removes stack checks if a function does not use stack space. However, it can only recognize checks of the form Sp < SpLim. However, these checks get sometimes rewritten to Sp >= SpLim (with both branches swapped), so we better recognize these checks too. Test Plan: ./validate Reviewers: austin, bgamari, simonpj Reviewed By: simonpj Subscribers: simonpj, thomie Differential Revision: https://phabricator.haskell.org/D1881 GHC Trac Issues: #11533 >--------------------------------------------------------------- 4ec61411930495fc109be27993c176fd7aaf486d compiler/cmm/CmmLayoutStack.hs | 27 +++++++++++++++++++++------ 1 file changed, 21 insertions(+), 6 deletions(-) diff --git a/compiler/cmm/CmmLayoutStack.hs b/compiler/cmm/CmmLayoutStack.hs index 5fea0e7..25a0ad6 100644 --- a/compiler/cmm/CmmLayoutStack.hs +++ b/compiler/cmm/CmmLayoutStack.hs @@ -855,18 +855,26 @@ areaToSp dflags _ sp_hwm _ (CmmLit CmmHighStackMark) -- Replace CmmHighStackMark with the number of bytes of stack used, -- the sp_hwm. See Note [Stack usage] in StgCmmHeap -areaToSp dflags _ _ _ (CmmMachOp (MO_U_Lt _) - [CmmMachOp (MO_Sub _) - [ CmmRegOff (CmmGlobal Sp) x_off - , CmmLit (CmmInt y_lit _)], - CmmReg (CmmGlobal SpLim)]) - | fromIntegral x_off >= y_lit +areaToSp dflags _ _ _ (CmmMachOp (MO_U_Lt _) args) + | falseStackCheck args = zeroExpr dflags +areaToSp dflags _ _ _ (CmmMachOp (MO_U_Ge _) args) + | falseStackCheck args + = mkIntExpr dflags 1 -- Replace a stack-overflow test that cannot fail with a no-op -- See Note [Always false stack check] areaToSp _ _ _ _ other = other +-- | Determine whether a stack check cannot fail. +falseStackCheck :: [CmmExpr] -> Bool +falseStackCheck [ CmmMachOp (MO_Sub _) + [ CmmRegOff (CmmGlobal Sp) x_off + , CmmLit (CmmInt y_lit _)] + , CmmReg (CmmGlobal SpLim)] + = fromIntegral x_off >= y_lit +falseStackCheck _ = False + -- Note [Always false stack check] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -- We can optimise stack checks of the form @@ -879,11 +887,18 @@ areaToSp _ _ _ _ other = other -- A subsequent sinking pass will later drop the dead code. -- Optimising this away depends on knowing that SpLim <= Sp, so it is -- really the job of the stack layout algorithm, hence we do it now. +-- +-- The control flow optimiser may negate a conditional to increase +-- the likelihood of a fallthrough if the branch is not taken. But +-- not every conditional is inverted as the control flow optimiser +-- places some requirements on the predecessors of both branch targets. +-- So we better look for the inverted comparison too. optStackCheck :: CmmNode O C -> CmmNode O C optStackCheck n = -- Note [Always false stack check] case n of CmmCondBranch (CmmLit (CmmInt 0 _)) _true false _ -> CmmBranch false + CmmCondBranch (CmmLit (CmmInt _ _)) true _false _ -> CmmBranch true other -> other From git at git.haskell.org Tue Feb 9 14:41:12 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 9 Feb 2016 14:41:12 +0000 (UTC) Subject: [commit: ghc] master: Early error when crosscompiling + haddock/docs (04fb781) Message-ID: <20160209144112.171083A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/04fb7813ab489b1d70a73351836950825b2ce4f7/ghc >--------------------------------------------------------------- commit 04fb7813ab489b1d70a73351836950825b2ce4f7 Author: Thomas Miedema Date: Tue Feb 9 11:06:13 2016 +0100 Early error when crosscompiling + haddock/docs When CrossCompiling=YES or Stage1Only=YES, building the haddocks and the User's Guide should be skipped, because haddock and mkUserGuidePart depend on the GHC API. See Note [No stage2 packages when CrossCompiling or Stage1Only] for details. There are several places in the build system where the variables HADDOCK_DOCS and BUILD_SPHINX_* are checked. Instead of also checking for the variables CrossCompiling or Stage1Only in all those places, `make` will now exit with a nice error message when the user requests the impossible. Reviewers: rwbarton, austin, bgamari Reviewed By: bgamari Differential Revision: https://phabricator.haskell.org/D1882 >--------------------------------------------------------------- 04fb7813ab489b1d70a73351836950825b2ce4f7 ghc.mk | 23 +++++++++++++++++++---- mk/flavours/bench-cross.mk | 1 - mk/flavours/bench-llvm.mk | 1 - mk/flavours/bench.mk | 1 - mk/flavours/devel1.mk | 1 - mk/flavours/devel2.mk | 1 - mk/flavours/perf-cross.mk | 1 - mk/flavours/perf-llvm.mk | 1 - mk/flavours/perf.mk | 1 - mk/flavours/prof.mk | 1 - mk/flavours/quick-cross.mk | 1 - mk/flavours/quick-llvm.mk | 1 - mk/flavours/quick.mk | 1 - mk/flavours/quickest.mk | 1 - mk/flavours/validate.mk | 1 - 15 files changed, 19 insertions(+), 18 deletions(-) diff --git a/ghc.mk b/ghc.mk index 8257cf0..8f4aaba 100644 --- a/ghc.mk +++ b/ghc.mk @@ -195,6 +195,24 @@ $(error HSCOLOUR_SRCS=YES, but HSCOLOUR_CMD is empty. \ endif endif +ifeq "$(HADDOCK_DOCS)" "YES" +ifneq "$(CrossCompiling) $(Stage1Only)" "NO NO" +$(error Can not build haddock docs when CrossCompiling or Stage1Only. \ + Set HADDOCK_DOCS=NO in your mk/build.mk file. \ + See Note [No stage2 packages when CrossCompiling or Stage1Only]) +endif +endif + +ifneq "$(BUILD_SPHINX_HTML) $(BUILD_SPHINX_PDF)" "NO NO" +# The User's Guide requires mkUserGuidePart, which uses the GHC API. +ifneq "$(CrossCompiling) $(Stage1Only)" "NO NO" +$(error Can not build User's Guide when CrossCompiling or Stage1Only. \ + Set BUILD_SPHINX_HTML=NO, BUILD_SPHINX_PDF=NO in your \ + mk/build.mk file. \ + See Note [No stage2 packages when CrossCompiling or Stage1Only]) +endif +endif + endif # CLEANING # ----------------------------------------------------------------------------- @@ -691,7 +709,7 @@ ifeq "$(HADDOCK_DOCS)" "NO" BUILD_DIRS := $(filter-out utils/haddock,$(BUILD_DIRS)) BUILD_DIRS := $(filter-out utils/haddock/doc,$(BUILD_DIRS)) endif -ifeq "$(BUILD_SPHINX_HTML) $(BUILD_SPHINX_PDF)" "NO NO NO" +ifeq "$(BUILD_SPHINX_HTML) $(BUILD_SPHINX_PDF)" "NO NO" # Don't to build this little utility if we're not building the User's Guide. BUILD_DIRS := $(filter-out utils/mkUserGuidePart,$(BUILD_DIRS)) endif @@ -711,11 +729,8 @@ endif ifneq "$(CrossCompiling) $(Stage1Only)" "NO NO" # See Note [No stage2 packages when CrossCompiling or Stage1Only]. # See Note [Stage1Only vs stage=1] in mk/config.mk.in. -BUILD_DIRS := $(filter-out utils/haddock,$(BUILD_DIRS)) -BUILD_DIRS := $(filter-out utils/haddock/doc,$(BUILD_DIRS)) BUILD_DIRS := $(filter-out utils/ghctags,$(BUILD_DIRS)) BUILD_DIRS := $(filter-out utils/check-api-annotations,$(BUILD_DIRS)) -BUILD_DIRS := $(filter-out utils/mkUserGuidePart,$(BUILD_DIRS)) endif endif # CLEANING diff --git a/mk/flavours/bench-cross.mk b/mk/flavours/bench-cross.mk index 69447a2..15b359e 100644 --- a/mk/flavours/bench-cross.mk +++ b/mk/flavours/bench-cross.mk @@ -6,7 +6,6 @@ BUILD_PROF_LIBS = NO SplitObjs = NO HADDOCK_DOCS = NO BUILD_SPHINX_HTML = NO -BUILD_SPHINX_PS = NO BUILD_SPHINX_PDF = NO BUILD_MAN = NO diff --git a/mk/flavours/bench-llvm.mk b/mk/flavours/bench-llvm.mk index e07c1f3..2da8ddb 100644 --- a/mk/flavours/bench-llvm.mk +++ b/mk/flavours/bench-llvm.mk @@ -6,6 +6,5 @@ BUILD_PROF_LIBS = NO SplitObjs = NO HADDOCK_DOCS = NO BUILD_SPHINX_HTML = NO -BUILD_SPHINX_PS = NO BUILD_SPHINX_PDF = NO BUILD_MAN = NO diff --git a/mk/flavours/bench.mk b/mk/flavours/bench.mk index 1368c47..ad77219 100644 --- a/mk/flavours/bench.mk +++ b/mk/flavours/bench.mk @@ -6,6 +6,5 @@ BUILD_PROF_LIBS = NO SplitObjs = NO HADDOCK_DOCS = NO BUILD_SPHINX_HTML = NO -BUILD_SPHINX_PS = NO BUILD_SPHINX_PDF = NO BUILD_MAN = NO diff --git a/mk/flavours/devel1.mk b/mk/flavours/devel1.mk index 8489c0f..ea730c9 100644 --- a/mk/flavours/devel1.mk +++ b/mk/flavours/devel1.mk @@ -6,7 +6,6 @@ BUILD_PROF_LIBS = NO SplitObjs = NO HADDOCK_DOCS = NO BUILD_SPHINX_HTML = NO -BUILD_SPHINX_PS = NO BUILD_SPHINX_PDF = NO BUILD_MAN = NO diff --git a/mk/flavours/devel2.mk b/mk/flavours/devel2.mk index 1f073ed..c86624a 100644 --- a/mk/flavours/devel2.mk +++ b/mk/flavours/devel2.mk @@ -6,7 +6,6 @@ BUILD_PROF_LIBS = NO SplitObjs = NO HADDOCK_DOCS = NO BUILD_SPHINX_HTML = NO -BUILD_SPHINX_PS = NO BUILD_SPHINX_PDF = NO BUILD_MAN = NO diff --git a/mk/flavours/perf-cross.mk b/mk/flavours/perf-cross.mk index 9540f8c..669b51a 100644 --- a/mk/flavours/perf-cross.mk +++ b/mk/flavours/perf-cross.mk @@ -6,7 +6,6 @@ BUILD_PROF_LIBS = YES #SplitObjs HADDOCK_DOCS = NO BUILD_SPHINX_HTML = NO -BUILD_SPHINX_PS = NO BUILD_SPHINX_PDF = NO BUILD_MAN = NO diff --git a/mk/flavours/perf-llvm.mk b/mk/flavours/perf-llvm.mk index 4a93d6b..cd3d4f4 100644 --- a/mk/flavours/perf-llvm.mk +++ b/mk/flavours/perf-llvm.mk @@ -6,5 +6,4 @@ BUILD_PROF_LIBS = YES #SplitObjs #HADDOCK_DOCS #BUILD_SPHINX_HTML -#BUILD_SPHINX_PS #BUILD_SPHINX_PDF diff --git a/mk/flavours/perf.mk b/mk/flavours/perf.mk index c94b860..06fcc24 100644 --- a/mk/flavours/perf.mk +++ b/mk/flavours/perf.mk @@ -6,5 +6,4 @@ BUILD_PROF_LIBS = YES #SplitObjs #HADDOCK_DOCS #BUILD_SPHINX_HTML -#BUILD_SPHINX_PS #BUILD_SPHINX_PDF diff --git a/mk/flavours/prof.mk b/mk/flavours/prof.mk index 684ffb0..67f89e6 100644 --- a/mk/flavours/prof.mk +++ b/mk/flavours/prof.mk @@ -6,7 +6,6 @@ BUILD_PROF_LIBS = YES SplitObjs = NO HADDOCK_DOCS = NO BUILD_SPHINX_HTML = NO -BUILD_SPHINX_PS = NO BUILD_SPHINX_PDF = NO BUILD_MAN = NO diff --git a/mk/flavours/quick-cross.mk b/mk/flavours/quick-cross.mk index b10dbc5..92347ca 100644 --- a/mk/flavours/quick-cross.mk +++ b/mk/flavours/quick-cross.mk @@ -6,7 +6,6 @@ BUILD_PROF_LIBS = NO SplitObjs = NO HADDOCK_DOCS = NO BUILD_SPHINX_HTML = NO -BUILD_SPHINX_PS = NO BUILD_SPHINX_PDF = NO BUILD_MAN = NO diff --git a/mk/flavours/quick-llvm.mk b/mk/flavours/quick-llvm.mk index 84a8034..0a63f5f 100644 --- a/mk/flavours/quick-llvm.mk +++ b/mk/flavours/quick-llvm.mk @@ -6,6 +6,5 @@ BUILD_PROF_LIBS = NO SplitObjs = NO HADDOCK_DOCS = NO BUILD_SPHINX_HTML = NO -BUILD_SPHINX_PS = NO BUILD_SPHINX_PDF = NO BUILD_MAN = NO diff --git a/mk/flavours/quick.mk b/mk/flavours/quick.mk index 0e045ae..9f1e2e2 100644 --- a/mk/flavours/quick.mk +++ b/mk/flavours/quick.mk @@ -6,6 +6,5 @@ BUILD_PROF_LIBS = NO SplitObjs = NO HADDOCK_DOCS = NO BUILD_SPHINX_HTML = NO -BUILD_SPHINX_PS = NO BUILD_SPHINX_PDF = NO BUILD_MAN = NO diff --git a/mk/flavours/quickest.mk b/mk/flavours/quickest.mk index ba95632..69c0385 100644 --- a/mk/flavours/quickest.mk +++ b/mk/flavours/quickest.mk @@ -6,6 +6,5 @@ BUILD_PROF_LIBS = NO SplitObjs = NO HADDOCK_DOCS = NO BUILD_SPHINX_HTML = NO -BUILD_SPHINX_PS = NO BUILD_SPHINX_PDF = NO BUILD_MAN = NO diff --git a/mk/flavours/validate.mk b/mk/flavours/validate.mk index cb38bd5..1d18641 100644 --- a/mk/flavours/validate.mk +++ b/mk/flavours/validate.mk @@ -7,7 +7,6 @@ BUILD_PROF_LIBS = NO SplitObjs = NO HADDOCK_DOCS = YES BUILD_SPHINX_HTML = YES -BUILD_SPHINX_PS = NO BUILD_SPHINX_PDF = NO ifeq "$(ValidateHpc)" "YES" From git at git.haskell.org Tue Feb 9 14:41:14 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 9 Feb 2016 14:41:14 +0000 (UTC) Subject: [commit: ghc] master: Unset GREP_OPTIONS in build system (bfec4a6) Message-ID: <20160209144114.BF2AA3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/bfec4a6aade005b6dbd170645d4f2d062cee1d92/ghc >--------------------------------------------------------------- commit bfec4a6aade005b6dbd170645d4f2d062cee1d92 Author: Ben Gamari Date: Tue Feb 9 11:06:27 2016 +0100 Unset GREP_OPTIONS in build system Test Plan: GREP_OPTIONS=--blah ./validate Reviewers: austin, thomie Reviewed By: thomie Differential Revision: https://phabricator.haskell.org/D1887 GHC Trac Issues: #11530 >--------------------------------------------------------------- bfec4a6aade005b6dbd170645d4f2d062cee1d92 Makefile | 7 +++++++ boot | 3 +++ ghc.mk | 2 +- 3 files changed, 11 insertions(+), 1 deletion(-) diff --git a/Makefile b/Makefile index 6be584f..82ab2f7 100644 --- a/Makefile +++ b/Makefile @@ -18,6 +18,13 @@ MAKEFLAGS += --no-builtin-rules .SUFFIXES: + +# ----------------------------------------------------------------------------- +# Sanitize environment + +# See Trac #11530 +export GREP_OPTIONS := + ifneq "$(filter maintainer-clean distclean clean clean_% help,$(MAKECMDGOALS))" "" -include mk/config.mk else diff --git a/boot b/boot index 18d43aa..45f5bf0 100755 --- a/boot +++ b/boot @@ -11,6 +11,9 @@ my %required_tag; my $validate; my $curdir; +# See Trac #11530 +$ENV{GREP_OPTIONS} = ''; + $required_tag{"-"} = 1; $validate = 0; diff --git a/ghc.mk b/ghc.mk index 8f4aaba..4034a92 100644 --- a/ghc.mk +++ b/ghc.mk @@ -92,7 +92,7 @@ $(error Your make does not support abspath. You need GNU make >= 3.81) endif ################################################## - +# ----------------------------------------------------------------------------- # Catch make if it runs away into an infinite loop ifeq "$(MAKE_RESTARTS)" "" else ifeq "$(MAKE_RESTARTS)" "1" From git at git.haskell.org Tue Feb 9 14:41:17 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 9 Feb 2016 14:41:17 +0000 (UTC) Subject: [commit: ghc] master: Restore derived Eq instance for SrcLoc (1f894f2) Message-ID: <20160209144117.7819D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1f894f298d8f90a4a49196fcda44a696e16ab769/ghc >--------------------------------------------------------------- commit 1f894f298d8f90a4a49196fcda44a696e16ab769 Author: RyanGlScott Date: Tue Feb 9 11:06:34 2016 +0100 Restore derived Eq instance for SrcLoc GHC 7.10.2 and 7.10.3 had a derived `Eq` instance for `SrcLoc`, but it seems to have been removed (see 6740d70d95cb81cea3859ff847afc61ec439db4f) during GHC 8.0 development. Reviewers: hvr, austin, gridaphobe, bgamari Reviewed By: gridaphobe, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1894 >--------------------------------------------------------------- 1f894f298d8f90a4a49196fcda44a696e16ab769 libraries/base/GHC/Stack/Types.hs | 3 ++- testsuite/tests/typecheck/should_fail/T5095.stderr | 2 +- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/libraries/base/GHC/Stack/Types.hs b/libraries/base/GHC/Stack/Types.hs index fb92522..35dfcb0 100644 --- a/libraries/base/GHC/Stack/Types.hs +++ b/libraries/base/GHC/Stack/Types.hs @@ -47,6 +47,7 @@ import cycle, which imports ?Data.Maybe? (libraries/base/Data/Maybe.hs) -} +import GHC.Classes (Eq) import GHC.Types -- Make implicit dependency known to build system @@ -205,4 +206,4 @@ data SrcLoc = SrcLoc , srcLocStartCol :: Int , srcLocEndLine :: Int , srcLocEndCol :: Int - } + } deriving Eq diff --git a/testsuite/tests/typecheck/should_fail/T5095.stderr b/testsuite/tests/typecheck/should_fail/T5095.stderr index c284cda..d5f86c0 100644 --- a/testsuite/tests/typecheck/should_fail/T5095.stderr +++ b/testsuite/tests/typecheck/should_fail/T5095.stderr @@ -7,7 +7,7 @@ T5095.hs:9:9: error: -- Defined in ?Data.Either? instance Eq Ordering -- Defined in ?GHC.Classes? ...plus 24 others - ...plus 13 instance involving out-of-scope typess + ...plus 14 instance involving out-of-scope typess (use -fprint-potential-instances to see them all) (The choice depends on the instantiation of ?a? To pick the first instance above, use IncoherentInstances From git at git.haskell.org Tue Feb 9 14:41:20 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 9 Feb 2016 14:41:20 +0000 (UTC) Subject: [commit: ghc] master: TcErrors: Fix plural form of "instance" error (c8702e3) Message-ID: <20160209144120.4532B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c8702e3092250b89f60ad3fe7c71c627e5f388f6/ghc >--------------------------------------------------------------- commit c8702e3092250b89f60ad3fe7c71c627e5f388f6 Author: Ben Gamari Date: Tue Feb 9 14:39:39 2016 +0100 TcErrors: Fix plural form of "instance" error Previously "types" was inappropriately made plural instead of "instance", instance Eq Ordering -- Defined in ?GHC.Classes? ...plus 24 others ...plus 13 instance involving out-of-scope typess >--------------------------------------------------------------- c8702e3092250b89f60ad3fe7c71c627e5f388f6 compiler/typecheck/TcErrors.hs | 4 ++-- testsuite/tests/annotations/should_fail/annfail10.stderr | 4 ++-- testsuite/tests/ghci.debugger/scripts/break006.stderr | 4 ++-- testsuite/tests/ghci.debugger/scripts/print019.stderr | 2 +- .../overloadedlists/should_fail/overloadedlistsfail01.stderr | 2 +- testsuite/tests/quotes/TH_localname.stderr | 2 +- testsuite/tests/typecheck/should_compile/holes2.stderr | 2 +- testsuite/tests/typecheck/should_fail/T10971b.stderr | 8 ++++---- testsuite/tests/typecheck/should_fail/T5095.stderr | 2 +- testsuite/tests/typecheck/should_fail/tcfail072.stderr | 4 ++-- testsuite/tests/typecheck/should_fail/tcfail133.stderr | 2 +- 11 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 c8702e3092250b89f60ad3fe7c71c627e5f388f6 From git at git.haskell.org Tue Feb 9 14:41:23 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 9 Feb 2016 14:41:23 +0000 (UTC) Subject: [commit: ghc] master: TcPatSyn: Fix spelling of "pattern" in error message (99cb627) Message-ID: <20160209144123.05A8F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/99cb627a45afacde5f86799671c53baf81daee41/ghc >--------------------------------------------------------------- commit 99cb627a45afacde5f86799671c53baf81daee41 Author: Ben Gamari Date: Tue Feb 9 14:42:01 2016 +0100 TcPatSyn: Fix spelling of "pattern" in error message >--------------------------------------------------------------- 99cb627a45afacde5f86799671c53baf81daee41 compiler/typecheck/TcPatSyn.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/typecheck/TcPatSyn.hs b/compiler/typecheck/TcPatSyn.hs index f3aaa23..6a59f71 100644 --- a/compiler/typecheck/TcPatSyn.hs +++ b/compiler/typecheck/TcPatSyn.hs @@ -362,7 +362,7 @@ addPatSynCtxt (L loc name) thing_inside wrongNumberOfParmsErr :: Name -> Arity -> Arity -> SDoc wrongNumberOfParmsErr name decl_arity ty_arity - = hang (text "Patten synonym" <+> quotes (ppr name) <+> ptext (sLit "has") + = hang (text "Pattern synonym" <+> quotes (ppr name) <+> ptext (sLit "has") <+> speakNOf decl_arity (text "argument")) 2 (text "but its type signature has" <+> speakN ty_arity) From git at git.haskell.org Tue Feb 9 17:50:35 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 9 Feb 2016 17:50:35 +0000 (UTC) Subject: [commit: ghc] master: DynFlags: drop tracking of '-#include' flags (7953b27) Message-ID: <20160209175035.54CFB3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7953b27cdc331d97f605ae17f0c514f3e386023d/ghc >--------------------------------------------------------------- commit 7953b27cdc331d97f605ae17f0c514f3e386023d Author: Sergei Trofimovich Date: Sun Jan 3 12:07:10 2016 +0000 DynFlags: drop tracking of '-#include' flags GHC does not use passed paramaters anywhere for this deprecated option. Signed-off-by: Sergei Trofimovich >--------------------------------------------------------------- 7953b27cdc331d97f605ae17f0c514f3e386023d compiler/main/DynFlags.hs | 8 +------- 1 file changed, 1 insertion(+), 7 deletions(-) diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 0fa7434..3cd72bf 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -665,7 +665,6 @@ data DynFlags = DynFlags { historySize :: Int, - cmdlineHcIncludes :: [String], -- ^ @\-\#includes@ importPaths :: [FilePath], mainModIs :: Module, mainFunIs :: Maybe String, @@ -1453,7 +1452,6 @@ defaultDynFlags mySettings = enableTimeStats = False, ghcHeapSize = Nothing, - cmdlineHcIncludes = [], importPaths = ["."], mainModIs = mAIN, mainFunIs = Nothing, @@ -2247,8 +2245,7 @@ dynamic_flags = [ , defFlag "cpp" (NoArg (setExtensionFlag LangExt.Cpp)) , defFlag "F" (NoArg (setGeneralFlag Opt_Pp)) , defFlag "#include" - (HasArg (\s -> do - addCmdlineHCInclude s + (HasArg (\_s -> do addWarn ("-#include and INCLUDE pragmas are " ++ "deprecated: They no longer have any effect"))) , defFlag "v" (OptIntSuffix setVerbosity) @@ -3856,9 +3853,6 @@ setVerbosity mb_n = upd (\dfs -> dfs{ verbosity = mb_n `orElse` 3 }) setDebugLevel :: Maybe Int -> DynP () setDebugLevel mb_n = upd (\dfs -> dfs{ debugLevel = mb_n `orElse` 2 }) -addCmdlineHCInclude :: String -> DynP () -addCmdlineHCInclude a = upd (\s -> s{cmdlineHcIncludes = a : cmdlineHcIncludes s}) - data PkgConfRef = GlobalPkgConf | UserPkgConf From git at git.haskell.org Wed Feb 10 10:19:33 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 10 Feb 2016 10:19:33 +0000 (UTC) Subject: [commit: ghc] master: Expand users' guide TH declaration groups section (#9813) (93e2c8f) Message-ID: <20160210101933.1496A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/93e2c8fff902c12fd22d907f7648d847ebfd2146/ghc >--------------------------------------------------------------- commit 93e2c8fff902c12fd22d907f7648d847ebfd2146 Author: Owen Stephens Date: Wed Feb 10 10:18:41 2016 +0100 Expand users' guide TH declaration groups section (#9813) Reviewers: austin, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1899 >--------------------------------------------------------------- 93e2c8fff902c12fd22d907f7648d847ebfd2146 docs/users_guide/glasgow_exts.rst | 78 ++++++++++++++++++++++++++++----------- 1 file changed, 57 insertions(+), 21 deletions(-) diff --git a/docs/users_guide/glasgow_exts.rst b/docs/users_guide/glasgow_exts.rst index c09d0ef..774805b 100644 --- a/docs/users_guide/glasgow_exts.rst +++ b/docs/users_guide/glasgow_exts.rst @@ -9599,8 +9599,9 @@ The :ghc-flag:`-XTemplateHaskellQuotes` extension is considered safe under *declaration groups*. A *declaration group* is the group of declarations created by a top-level declaration splice, plus those following it, down to but not including the next top-level - declaration splice. The first declaration group in a module includes - all top-level definitions down to but not including the first + declaration splice. N.B. only top-level splices delimit declaration + groups, not expression splices. The first declaration group in a module + includes all top-level definitions down to but not including the first top-level declaration splice. Each declaration group is mutually recursive only within the group. @@ -9625,38 +9626,73 @@ The :ghc-flag:`-XTemplateHaskellQuotes` extension is considered safe under import ... f x = x + $(th1 4) + h y = k y y $(blah1) + [qq|blah|] - k x y = x + y + + k x y z = x + y + z + $(th2 10) + w z = $(blah2) - In this example + In this example, a ``reify`` inside... + + 1. The splice ``$(th1 ...)`` would see the definition of ``f`` - the + splice is top-level and thus all definitions in the previous + declaration group are visible (that is, all definitions in the module + up-to, but not including, the splice itself). - 1. The body of ``h`` would be unable to refer to the function ``w``. + 2. The splice ``$(blah1)`` cannot refer to the function ``w`` - ``w`` is + part of a later declaration group, and thus invisible, similarly, + ``$(blah1)`` cannot see the definition of ``h`` (since it is part of + the same declaration group as ``$(blah1)``. However, the splice + ``$(blah1)`` can see the definition of ``f`` (since it is in the + immediately preceding declaration group). + + 3. The splice ``$(th2 ...)`` would see the definition of ``f``, all the + bindings created by ``$(th1 ...)``, the definition of ``h`` and all + bindings created by ``[qq|blah|]`` (they are all in previous + declaration groups). + + 4. The body of ``h`` *can* refer to the function ``k`` appearing on the + other side of the declaration quasiquoter, as quasiquoters do not + cause a declaration group to be broken up. + + 5. The ``qq`` quasiquoter would be able to see the definition of ``f`` + from the preceding declaration group, but not the definitions of + ``h`` or ``k``, or any definitions from subsequent declaration + groups. + + 6. The splice ``$(blah2)`` would see the same definitions as the splice + ``$(th2 ...)`` (but *not* any bindings it creates). + + Note that since an expression splice is unable to refer to declarations + in the same declaration group, we can introduce a top-level (empty) + splice to break up the declaration group :: + + module M where - A ``reify`` inside the splice ``$(th1 ..)`` would see the - definition of ``f``. + data D = C1 | C2 - 2. A ``reify`` inside the splice ``$(blah1)`` would see the - definition of ``f``, but would not see the definition of ``h``. + f1 = $(th1 ...) - 3. A ``reify`` inside the splice ``$(th2..)`` would see the - definition of ``f``, all the bindings created by ``$(th1..)``, and - the definition of ``h``. + $(return []) - 4. A ``reify`` inside the splice ``$(blah2)`` would see the same - definitions as the splice ``$(th2...)``. + f2 = $(th2 ...) - 5. The body of ``h`` *is* able to refer to the function ``k`` - appearing on the other side of the declaration quasiquoter, as - quasiquoters never cause a declaration group to be broken up. + Here - A ``reify`` inside the ``qq`` quasiquoter would be able to see the - definition of ``f`` from the preceding declaration group, but not - the definitions of ``h`` or ``k``, or any definitions from - subsequent declaration groups. + 1. The splice ``$(th1 ...)`` *cannot* refer to ``D`` - it is in the same + declaration group. + 2. The declaration group containing ``D`` is terminated by the empty + top-level declaration splice ``$(return [])`` (recall, ``Q`` is a + Monad, so we may simply ``return`` the empty list of declarations). + 3. Since the declaration group containing ``D`` is in the previous + declaration group, the splice ``$(th2 ...)`` *can* refer to ``D``. - Expression quotations accept most Haskell language constructs. However, there are some GHC-specific extensions which expression From git at git.haskell.org Wed Feb 10 10:19:36 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 10 Feb 2016 10:19:36 +0000 (UTC) Subject: [commit: ghc] master: add Template Haskell regression test for #9022. (2f9931e) Message-ID: <20160210101936.A3EA23A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2f9931e3536caa65e40f63f76be5f0d966180411/ghc >--------------------------------------------------------------- commit 2f9931e3536caa65e40f63f76be5f0d966180411 Author: Dominik Bollmann Date: Wed Feb 10 10:18:29 2016 +0100 add Template Haskell regression test for #9022. The bug itself has already been fixed in #10734, so this only adds another regression test (as given in the ticket). Test Plan: ./validate Reviewers: goldfire, austin, thomie, bgamari Reviewed By: bgamari Differential Revision: https://phabricator.haskell.org/D1898 GHC Trac Issues: #9022 >--------------------------------------------------------------- 2f9931e3536caa65e40f63f76be5f0d966180411 testsuite/tests/th/T9022.hs | 20 ++++++++++++++++++++ testsuite/tests/th/T9022.stdout | 2 ++ testsuite/tests/th/all.T | 1 + 3 files changed, 23 insertions(+) diff --git a/testsuite/tests/th/T9022.hs b/testsuite/tests/th/T9022.hs new file mode 100644 index 0000000..fc61691 --- /dev/null +++ b/testsuite/tests/th/T9022.hs @@ -0,0 +1,20 @@ +module Main where + +import Language.Haskell.TH + +main = putStrLn $ pprint foo + +foo :: Dec +foo = barD + where + barD = FunD ( mkName "bar" ) + [ Clause manyArgs (NormalB barBody) [] ] + + barBody = DoE [letxStmt, retxStmt] + letxStmt = LetS [ ValD (VarP xName) (NormalB $ LitE $ IntegerL 5) [] ] + retxStmt = NoBindS $ AppE returnVarE xVarE + xName = mkName "x" + returnVarE = VarE $ mkName "return" + xVarE = VarE xName + manyArgs = map argP [0..9] + argP n = VarP $ mkName $ "arg" ++ show n diff --git a/testsuite/tests/th/T9022.stdout b/testsuite/tests/th/T9022.stdout new file mode 100644 index 0000000..66c6afc --- /dev/null +++ b/testsuite/tests/th/T9022.stdout @@ -0,0 +1,2 @@ +bar arg0 arg1 arg2 arg3 arg4 arg5 arg6 arg7 arg8 arg9 = do {let {x = 5}; + return x} diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T index 3d040b6..c0c975f 100644 --- a/testsuite/tests/th/all.T +++ b/testsuite/tests/th/all.T @@ -399,3 +399,4 @@ test('T11345', normal, compile_and_run, ['-v0 -dsuppress-uniques']) test('TH_finalizer', normal, compile, ['-v0']) test('T10603', normal, compile, ['-ddump-splices -dsuppress-uniques']) test('T11452', normal, compile_fail, ['-v0']) +test('T9022', normal, compile_and_run, ['-v0']) From git at git.haskell.org Wed Feb 10 10:19:39 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 10 Feb 2016 10:19:39 +0000 (UTC) Subject: [commit: ghc] master: Error early when you register with too old a version of Cabal. (d80caca) Message-ID: <20160210101939.507743A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d80caca10d7c2fa1c9ee8ef6bcafac365d02ff3d/ghc >--------------------------------------------------------------- commit d80caca10d7c2fa1c9ee8ef6bcafac365d02ff3d Author: Edward Z. Yang Date: Wed Feb 10 11:09:53 2016 +0100 Error early when you register with too old a version of Cabal. On the GHC 8.0 RCs, multiple users reported a very strange error whereby GHC would complain that the symbols names recorded in interface files did not match the expected name. The reason for this is that they were using an old version of Cabal which chose symbol names differently from the installed package ID ('id' field) which the package was to be installed with; GHC 8.0 now mandates that these coincides. This change adds a test to ghc-pkg to make sure that 'id' and 'key' (which is how Cabal previously reported what the symbol name was supposed to be) match; if they don't match or key is missing, we assume that the Cabal was too old. Bikeshed points: - Should we offer more information about how to upgrade Cabal correctly (i.e. specify a version?) - Should we allow for a missing 'key'? If we allow for 'key' to be missing, we lose the ability to detect Cabal from GHC 7.8 or earlier being used. If we require it to be specified, then it will not be possible for Cabal to deprecate the (unused) field and remove it without having BC for 8.0. Signed-off-by: Edward Z. Yang Test Plan: validate Reviewers: austin, bgamari, hvr Reviewed By: hvr Subscribers: bergmark, thomie Differential Revision: https://phabricator.haskell.org/D1892 GHC Trac Issues: #11558 >--------------------------------------------------------------- d80caca10d7c2fa1c9ee8ef6bcafac365d02ff3d testsuite/tests/cabal/T1750A.pkg | 1 + testsuite/tests/cabal/T1750B.pkg | 1 + testsuite/tests/ghci/linking/Makefile | 6 +++--- utils/ghc-pkg/Main.hs | 3 +++ 4 files changed, 8 insertions(+), 3 deletions(-) diff --git a/testsuite/tests/cabal/T1750A.pkg b/testsuite/tests/cabal/T1750A.pkg index 9bda51e..be290f2 100644 --- a/testsuite/tests/cabal/T1750A.pkg +++ b/testsuite/tests/cabal/T1750A.pkg @@ -1,4 +1,5 @@ name: T1750A version: 1 id: T1750A-1-XXX +key: T1750A-1-XXX depends: T1750B-1-XXX diff --git a/testsuite/tests/cabal/T1750B.pkg b/testsuite/tests/cabal/T1750B.pkg index 479ce70..6fc7091 100644 --- a/testsuite/tests/cabal/T1750B.pkg +++ b/testsuite/tests/cabal/T1750B.pkg @@ -1,4 +1,5 @@ name: T1750B version: 1 id: T1750B-1-XXX +key: T1750B-1-XXX depends: T1750A-1-XXX diff --git a/testsuite/tests/ghci/linking/Makefile b/testsuite/tests/ghci/linking/Makefile index c833454..1267650 100644 --- a/testsuite/tests/ghci/linking/Makefile +++ b/testsuite/tests/ghci/linking/Makefile @@ -64,7 +64,7 @@ ghcilink004 : echo 'name: test' >>$(PKG004) echo 'version: 1.0' >>$(PKG004) echo 'id: test-XXX' >>$(PKG004) - echo 'key: test-1.0' >>$(PKG004) + echo 'key: test-XXX' >>$(PKG004) echo 'library-dirs: $${pkgroot}' >>$(PKG004) echo 'extra-libraries: foo' >>$(PKG004) '$(GHC_PKG)' init $(LOCAL_PKGCONF004) @@ -92,7 +92,7 @@ ghcilink005 : echo 'name: test' >>$(PKG005) echo 'version: 1.0' >>$(PKG005) echo 'id: test-XXX' >>$(PKG005) - echo 'key: test-1.0' >>$(PKG005) + echo 'key: test-XXX' >>$(PKG005) echo 'library-dirs: $${pkgroot}' >>$(PKG005) echo 'extra-libraries: foo' >>$(PKG005) '$(GHC_PKG)' init $(LOCAL_PKGCONF005) @@ -117,7 +117,7 @@ ghcilink006 : echo "name: test" >>$(PKG006) echo "version: 1.0" >>$(PKG006) echo "id: test-XXX" >>$(PKG006) - echo "key: test-1.0" >>$(PKG006) + echo "key: test-XXX" >>$(PKG006) ifeq "$(WINDOWS)" "YES" echo "extra-libraries: stdc++-6" >>$(PKG006) else diff --git a/utils/ghc-pkg/Main.hs b/utils/ghc-pkg/Main.hs index af65eee..e000a8f 100644 --- a/utils/ghc-pkg/Main.hs +++ b/utils/ghc-pkg/Main.hs @@ -1626,6 +1626,9 @@ checkUnitId :: InstalledPackageInfo -> PackageDBStack -> Bool checkUnitId ipi db_stack update = do let uid = installedUnitId ipi when (null (display uid)) $ verror CannotForce "missing id field" + when (display uid /= compatPackageKey ipi) $ + verror CannotForce $ "installed package info from too old version of Cabal " + ++ "(key field does not match id field)" let dups = [ p | p <- allPackagesInStack db_stack, installedUnitId p == uid ] when (not update && not (null dups)) $ From git at git.haskell.org Wed Feb 10 14:21:10 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 10 Feb 2016 14:21:10 +0000 (UTC) Subject: [commit: ghc] master: docs: add newline after '.. ghc-flag::' (c57d019) Message-ID: <20160210142110.528613A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c57d019c2ab1055a854cc30752561e3bbcc6bc13/ghc >--------------------------------------------------------------- commit c57d019c2ab1055a854cc30752561e3bbcc6bc13 Author: Sergei Trofimovich Date: Wed Feb 10 14:10:03 2016 +0000 docs: add newline after '.. ghc-flag::' Noticed when looked through sphinx warnings: docs/users_guide/safe_haskell.rst:4: SEVERE: Duplicate ID: "ghc-flag-Issue" Signed-off-by: Sergei Trofimovich >--------------------------------------------------------------- c57d019c2ab1055a854cc30752561e3bbcc6bc13 docs/users_guide/safe_haskell.rst | 3 +++ 1 file changed, 3 insertions(+) diff --git a/docs/users_guide/safe_haskell.rst b/docs/users_guide/safe_haskell.rst index c92062b..3914820 100644 --- a/docs/users_guide/safe_haskell.rst +++ b/docs/users_guide/safe_haskell.rst @@ -697,16 +697,19 @@ And one general flag: And three warning flags: .. ghc-flag:: -Wunsafe + Issue a warning if the module being compiled is regarded to be unsafe. Should be used to check the safety type of modules when using safe inference. .. ghc-flag:: -Wsafe + Issue a warning if the module being compiled is regarded to be safe. Should be used to check the safety type of modules when using safe inference. .. ghc-flag:: -Wtrustworthy-safe + Issue a warning if the module being compiled is marked as -XTrustworthy but it could instead be marked as -XSafe , a more informative bound. Can be used to detect once a Safe Haskell From git at git.haskell.org Wed Feb 10 14:21:12 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 10 Feb 2016 14:21:12 +0000 (UTC) Subject: [commit: ghc] master: mkUserGuide: fix option wrapping in a table (a824972) Message-ID: <20160210142112.F39473A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a8249726585a04b46400c9b074a85097c6488bb1/ghc >--------------------------------------------------------------- commit a8249726585a04b46400c9b074a85097c6488bb1 Author: Sergei Trofimovich Date: Wed Feb 10 14:12:03 2016 +0000 mkUserGuide: fix option wrapping in a table Noticed as a sphinx warning: docs/users_guide/flags-warnings.gen.rst:97: WARNING: Inline interpreted text or phrase reference start-string without end-string. Which pointed to broken table. Before the patch table looked like: | :ghc-flag:`-Wno-unticked-promoted-constructors | | ` | After the patch long link is on a single line: | :ghc-flag:`-Wno-unticked-promoted-constructors` | Signed-off-by: Sergei Trofimovich >--------------------------------------------------------------- a8249726585a04b46400c9b074a85097c6488bb1 utils/mkUserGuidePart/Main.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/utils/mkUserGuidePart/Main.hs b/utils/mkUserGuidePart/Main.hs index 41e8e40..57edc94 100644 --- a/utils/mkUserGuidePart/Main.hs +++ b/utils/mkUserGuidePart/Main.hs @@ -48,7 +48,7 @@ whatGlasgowExtsDoes = unlines -- the users guide. flagsTable :: [Flag] -> ReST flagsTable theFlags = - table [50, 100, 30, 50] + table [50, 100, 30, 55] ["Flag", "Description", "Static/Dynamic", "Reverse"] (map flagRow theFlags) where From git at git.haskell.org Wed Feb 10 14:32:47 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 10 Feb 2016 14:32:47 +0000 (UTC) Subject: [commit: ghc] master: Wrap solveEqualities in checkNoErrs (b565830) Message-ID: <20160210143247.4A4923A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b565830dda0994d5d67617039db3310f81e831c8/ghc >--------------------------------------------------------------- commit b565830dda0994d5d67617039db3310f81e831c8 Author: Simon Peyton Jones Date: Wed Feb 10 14:32:22 2016 +0000 Wrap solveEqualities in checkNoErrs This simple change fixes Trac #11563, #11520, #11516, #11399. See esp the comments in #11520. See Note [Fail fast on kind errors] in TcSimplify Merge to 8.0 branch >--------------------------------------------------------------- b565830dda0994d5d67617039db3310f81e831c8 compiler/typecheck/TcSimplify.hs | 24 ++++++++++-- compiler/typecheck/TcTyClsDecls.hs | 6 +-- testsuite/tests/polykinds/T11399.hs | 7 ++++ testsuite/tests/polykinds/T11399.stderr | 9 +++++ .../should_compile => polykinds}/T11516.hs | 0 testsuite/tests/polykinds/T11516.stderr | 5 +++ testsuite/tests/polykinds/T11520.hs | 16 ++++++++ testsuite/tests/polykinds/T11520.stderr | 6 +++ testsuite/tests/polykinds/all.T | 3 ++ .../tests/rename/should_fail/rnfail026.stderr | 4 -- testsuite/tests/typecheck/should_compile/all.T | 1 - testsuite/tests/typecheck/should_fail/T11563.hs | 5 +++ .../tests/typecheck/should_fail/T11563.stderr | 6 +++ testsuite/tests/typecheck/should_fail/T2994.stderr | 44 ++++++++-------------- testsuite/tests/typecheck/should_fail/T3540.stderr | 12 ------ testsuite/tests/typecheck/should_fail/all.T | 1 + 16 files changed, 96 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 b565830dda0994d5d67617039db3310f81e831c8 From git at git.haskell.org Wed Feb 10 17:12:45 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 10 Feb 2016 17:12:45 +0000 (UTC) Subject: [commit: ghc] master: Replace mkTvSubstPrs (a `zip` b) with zipTvSubst a b (d27da53) Message-ID: <20160210171245.1AA583A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d27da53652a6ba01c91856859a4be674fe3c835d/ghc >--------------------------------------------------------------- commit d27da53652a6ba01c91856859a4be674fe3c835d Author: Bartosz Nitka Date: Wed Feb 10 08:12:44 2016 -0800 Replace mkTvSubstPrs (a `zip` b) with zipTvSubst a b It's just a small cleanup. There should be no change in behaviour. Test Plan: ./validate --slow Reviewers: austin, bgamari, simonpj Reviewed By: simonpj Subscribers: thomie, simonmar Differential Revision: https://phabricator.haskell.org/D1901 >--------------------------------------------------------------- d27da53652a6ba01c91856859a4be674fe3c835d compiler/basicTypes/MkId.hs | 2 +- compiler/deSugar/DsExpr.hs | 2 +- compiler/typecheck/TcPat.hs | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/compiler/basicTypes/MkId.hs b/compiler/basicTypes/MkId.hs index 8aaa005..7dfc0b0 100644 --- a/compiler/basicTypes/MkId.hs +++ b/compiler/basicTypes/MkId.hs @@ -563,7 +563,7 @@ mkDataConRep dflags fam_envs wrap_name mb_bangs data_con mk_boxer :: [Boxer] -> DataConBoxer mk_boxer boxers = DCB (\ ty_args src_vars -> do { let (ex_vars, term_vars) = splitAtList ex_tvs src_vars - subst1 = mkTvSubstPrs (univ_tvs `zip` ty_args) + subst1 = zipTvSubst univ_tvs ty_args subst2 = extendTCvSubstList subst1 ex_tvs (mkTyVarTys ex_vars) ; (rep_ids, binds) <- go subst2 boxers term_vars diff --git a/compiler/deSugar/DsExpr.hs b/compiler/deSugar/DsExpr.hs index 6d4b0d9..9219d7e 100644 --- a/compiler/deSugar/DsExpr.hs +++ b/compiler/deSugar/DsExpr.hs @@ -623,7 +623,7 @@ dsExpr expr@(RecordUpd { rupd_expr = record_expr, rupd_flds = fields mk_alt upd_fld_env con = do { let (univ_tvs, ex_tvs, eq_spec, prov_theta, _req_theta, arg_tys, _) = conLikeFullSig con - subst = mkTvSubstPrs (univ_tvs `zip` in_inst_tys) + subst = zipTvSubst univ_tvs in_inst_tys -- I'm not bothering to clone the ex_tvs ; eqs_vars <- mapM newPredVarDs (substTheta subst (eqSpecPreds eq_spec)) diff --git a/compiler/typecheck/TcPat.hs b/compiler/typecheck/TcPat.hs index 2dddd6b..4d1d09a 100644 --- a/compiler/typecheck/TcPat.hs +++ b/compiler/typecheck/TcPat.hs @@ -1011,7 +1011,7 @@ addDataConStupidTheta data_con inst_tys -- The origin should always report "occurrence of C" -- even when C occurs in a pattern stupid_theta = dataConStupidTheta data_con - tenv = mkTvSubstPrs (dataConUnivTyVars data_con `zip` inst_tys) + tenv = zipTvSubst (dataConUnivTyVars data_con) inst_tys -- NB: inst_tys can be longer than the univ tyvars -- because the constructor might have existentials inst_theta = substTheta tenv stupid_theta From git at git.haskell.org Thu Feb 11 09:05:41 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 11 Feb 2016 09:05:41 +0000 (UTC) Subject: [commit: ghc] branch 'wip/js-hoopl-cleanup' created Message-ID: <20160211090541.97F433A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/js-hoopl-cleanup Referencing: a1931b9f28b1b44cc67b1666719db5ff46ee19ef From git at git.haskell.org Thu Feb 11 09:05:44 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 11 Feb 2016 09:05:44 +0000 (UTC) Subject: [commit: ghc] wip/js-hoopl-cleanup: Remove joinInFacts (5e40c8e) Message-ID: <20160211090544.55B923A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/js-hoopl-cleanup Link : http://ghc.haskell.org/trac/ghc/changeset/5e40c8e9fa7c726cda6e74686838a4199224509a/ghc >--------------------------------------------------------------- commit 5e40c8e9fa7c726cda6e74686838a4199224509a Author: Jan Stolarek Date: Mon Jan 18 19:40:28 2016 +0100 Remove joinInFacts >--------------------------------------------------------------- 5e40c8e9fa7c726cda6e74686838a4199224509a compiler/cmm/Hoopl/Dataflow.hs | 27 +++++++-------------------- 1 file changed, 7 insertions(+), 20 deletions(-) diff --git a/compiler/cmm/Hoopl/Dataflow.hs b/compiler/cmm/Hoopl/Dataflow.hs index 1e3adf4..ed86fdd 100644 --- a/compiler/cmm/Hoopl/Dataflow.hs +++ b/compiler/cmm/Hoopl/Dataflow.hs @@ -200,8 +200,7 @@ arfGraph pass at FwdPass { fp_lattice = lattice, (Block n C x -> f -> UniqSM (DG f n C x, Fact x f)) -> (Block n C x -> Fact C f -> UniqSM (DG f n C x, Fact x f)) arfx arf thing fb = - arf thing $ fromJust $ lookupFact (entryLabel thing) $ joinInFacts lattice fb - -- joinInFacts adds debugging information + arf thing $ fromJust $ lookupFact (entryLabel thing) fb -- Outgoing factbase is restricted to Labels *not* in @@ -210,21 +209,12 @@ arfGraph pass at FwdPass { fp_lattice = lattice, body entries blockmap init_fbase = fixpoint Fwd lattice do_block entries blockmap init_fbase where - lattice = fp_lattice pass do_block :: forall x . Block n C x -> FactBase f -> UniqSM (DG f n C x, Fact x f) do_block b fb = block b entryFact where entryFact = getFact lattice (entryLabel b) fb --- Join all the incoming facts with bottom. --- We know the results _shouldn't change_, but the transfer --- functions might, for example, generate some debugging traces. -joinInFacts :: DataflowLattice f -> FactBase f -> FactBase f -joinInFacts (lattice @ DataflowLattice {fact_bot = bot, fact_join = fj}) fb = - mkFactBase lattice $ map botJoin $ mapToList fb - where botJoin (l, f) = (l, snd $ fj l (OldFact bot) (NewFact f)) - forwardBlockList :: (NonLocal n) => [Label] -> Body n -> [Block n C C] -- This produces a list of blocks in order suitable for forward analysis, @@ -255,7 +245,7 @@ analyzeFwd FwdPass { fp_lattice = lattice, where body :: [Label] -> Fact C f -> Fact C f body entries f - = fixpointAnal Fwd lattice do_block entries blockmap f + = fixpointAnal Fwd (fact_join lattice) do_block entries blockmap f where do_block :: forall x . Block n C x -> FactBase f -> Fact x f do_block b fb = block b entryFact @@ -297,7 +287,7 @@ analyzeFwdBlocks FwdPass { fp_lattice = lattice, where body :: [Label] -> Fact C f -> Fact C f body entries f - = fixpointAnal Fwd lattice do_block entries blockmap f + = fixpointAnal Fwd (fact_join lattice) do_block entries blockmap f where do_block :: forall x . Block n C x -> FactBase f -> Fact x f do_block b fb = block b entryFact @@ -339,7 +329,7 @@ analyzeBwd BwdPass { bp_lattice = lattice, where body :: [Label] -> Fact C f -> Fact C f body entries f - = fixpointAnal Bwd lattice do_block entries blockmap f + = fixpointAnal Bwd (fact_join lattice) do_block entries blockmap f where do_block :: forall x . Block n C x -> Fact x f -> FactBase f do_block b fb = mapSingleton (entryLabel b) (block b fb) @@ -461,10 +451,8 @@ arbGraph pass at BwdPass { bp_lattice = lattice, -> (Block n C x -> Fact x f -> UniqSM (DG f n C x, Fact C f)) arbx arb thing f = do { (rg, f) <- arb thing f - ; let fb = joinInFacts (bp_lattice pass) $ - mapSingleton (entryLabel thing) f + ; let fb = mapSingleton (entryLabel thing) f ; return (rg, fb) } - -- joinInFacts adds debugging information -- Outgoing factbase is restricted to Labels *not* in -- in the Body; the facts for Labels *in* @@ -501,14 +489,13 @@ data Direction = Fwd | Bwd -- fixpointAnal :: forall n f. NonLocal n => Direction - -> DataflowLattice f + -> JoinFun f -> (Block n C C -> Fact C f -> Fact C f) -> [Label] -> LabelMap (Block n C C) -> Fact C f -> FactBase f -fixpointAnal direction DataflowLattice{ fact_bot = _, fact_join = join } - do_block entries blockmap init_fbase +fixpointAnal direction join do_block entries blockmap init_fbase = loop start init_fbase where blocks = sortBlocks direction entries blockmap From git at git.haskell.org Thu Feb 11 09:05:47 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 11 Feb 2016 09:05:47 +0000 (UTC) Subject: [commit: ghc] wip/js-hoopl-cleanup: Simplify forward analysis (a6a35cf) Message-ID: <20160211090547.039C83A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/js-hoopl-cleanup Link : http://ghc.haskell.org/trac/ghc/changeset/a6a35cfa2cae604e3e62434f483c97a13aa4f19c/ghc >--------------------------------------------------------------- commit a6a35cfa2cae604e3e62434f483c97a13aa4f19c Author: Jan Stolarek Date: Mon Jan 18 20:47:06 2016 +0100 Simplify forward analysis >--------------------------------------------------------------- a6a35cfa2cae604e3e62434f483c97a13aa4f19c compiler/cmm/Hoopl/Dataflow.hs | 22 +++++++++------------- 1 file changed, 9 insertions(+), 13 deletions(-) diff --git a/compiler/cmm/Hoopl/Dataflow.hs b/compiler/cmm/Hoopl/Dataflow.hs index dbcc783..50a3426 100644 --- a/compiler/cmm/Hoopl/Dataflow.hs +++ b/compiler/cmm/Hoopl/Dataflow.hs @@ -270,26 +270,22 @@ analyzeFwd FwdPass { fp_lattice = lattice, -- | if the graph being analyzed is open at the entry, there must -- be no other entry point, or all goes horribly wrong... analyzeFwdBlocks - :: forall n f e . NonLocal n => + :: forall n f. NonLocal n => FwdPass UniqSM n f - -> MaybeC e [Label] - -> Graph n e C -> Fact e f + -> MaybeC C [Label] + -> Graph n C C -> Fact C f -> FactBase f analyzeFwdBlocks FwdPass { fp_lattice = lattice, fp_transfer = FwdTransfer3 (ftr, _, ltr) } - entries g in_fact = graph g in_fact + (JustC entries) + (GMany NothingO blockmap NothingO) in_fact + = body entries in_fact where - graph :: Graph n e C -> Fact e f -> FactBase f - graph (GMany entry blockmap NothingO) - = case (entries, entry) of - (NothingC, JustO entry) -> block entry `cat` body (successors entry) - (JustC entries, NothingO) -> body entries - where - body :: [Label] -> Fact C f -> Fact C f - body entries f + body :: [Label] -> Fact C f -> Fact C f + body entries f = fixpointAnal Fwd (fact_join lattice) do_block entries blockmap f where - do_block :: forall x . Block n C x -> FactBase f -> Fact x f + do_block :: Block n C C -> FactBase f -> Fact C f do_block b fb = block b entryFact where entryFact = getFact (entryLabel b) fb From git at git.haskell.org Thu Feb 11 09:05:52 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 11 Feb 2016 09:05:52 +0000 (UTC) Subject: [commit: ghc] wip/js-hoopl-cleanup: Simplify backwards analysis (7070269) Message-ID: <20160211090552.68F3C3A301@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/js-hoopl-cleanup Link : http://ghc.haskell.org/trac/ghc/changeset/7070269d6ecb3148e2e7998dbe5012cdf242e4fb/ghc >--------------------------------------------------------------- commit 7070269d6ecb3148e2e7998dbe5012cdf242e4fb Author: Jan Stolarek Date: Mon Jan 18 20:43:08 2016 +0100 Simplify backwards analysis >--------------------------------------------------------------- 7070269d6ecb3148e2e7998dbe5012cdf242e4fb compiler/cmm/Hoopl/Dataflow.hs | 29 ++++++++++++----------------- 1 file changed, 12 insertions(+), 17 deletions(-) diff --git a/compiler/cmm/Hoopl/Dataflow.hs b/compiler/cmm/Hoopl/Dataflow.hs index e69a7b0..dbcc783 100644 --- a/compiler/cmm/Hoopl/Dataflow.hs +++ b/compiler/cmm/Hoopl/Dataflow.hs @@ -312,26 +312,21 @@ analyzeFwdBlocks FwdPass { fp_lattice = lattice, -- | if the graph being analyzed is open at the entry, there must -- be no other entry point, or all goes horribly wrong... analyzeBwd - :: forall n f e . NonLocal n => + :: forall n f. NonLocal n => BwdPass UniqSM n f - -> MaybeC e [Label] - -> Graph n e C -> Fact C f + -> MaybeC C [Label] + -> Graph n C C -> FactBase f -> FactBase f -analyzeBwd BwdPass { bp_lattice = lattice, +analyzeBwd BwdPass { bp_lattice = lattice, bp_transfer = BwdTransfer3 (ftr, mtr, ltr) } - entries g in_fact = graph g in_fact - where - graph :: Graph n e C -> Fact C f -> FactBase f - graph (GMany entry blockmap NothingO) - = case (entries, entry) of - (NothingC, JustO entry) -> body (successors entry) - (JustC entries, NothingO) -> body entries - where - body :: [Label] -> Fact C f -> Fact C f - body entries f + (JustC entries) + (GMany NothingO blockmap NothingO) in_fact = body entries in_fact + where + body :: [Label] -> FactBase f -> FactBase f + body entries f = fixpointAnal Bwd (fact_join lattice) do_block entries blockmap f where - do_block :: forall x . Block n C x -> Fact x f -> FactBase f + do_block :: Block n C C -> FactBase f -> FactBase f do_block b fb = mapSingleton (entryLabel b) (block b fb) -- NB. eta-expand block, GHC can't do this by itself. See #5809. @@ -360,8 +355,8 @@ analyzeBwd BwdPass { bp_lattice = lattice, analyzeAndRewriteBwd :: NonLocal n => BwdPass UniqSM n f - -> MaybeC e [Label] -> Graph n e x -> Fact x f - -> UniqSM (Graph n e x, FactBase f, MaybeO e f) + -> MaybeC C [Label] -> Graph n C x -> Fact x f + -> UniqSM (Graph n C x, FactBase f, MaybeO C f) analyzeAndRewriteBwd pass entries g f = do (rg, fout) <- arbGraph pass (fmap targetLabels entries) g f let (g', fb) = normalizeGraph rg From git at git.haskell.org Thu Feb 11 09:05:49 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 11 Feb 2016 09:05:49 +0000 (UTC) Subject: [commit: ghc] wip/js-hoopl-cleanup: Specialize getFact and forward analysis (853c694) Message-ID: <20160211090549.AE91D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/js-hoopl-cleanup Link : http://ghc.haskell.org/trac/ghc/changeset/853c694e035b66fb2a41454db2298337bd7324e2/ghc >--------------------------------------------------------------- commit 853c694e035b66fb2a41454db2298337bd7324e2 Author: Jan Stolarek Date: Mon Jan 18 20:35:20 2016 +0100 Specialize getFact and forward analysis >--------------------------------------------------------------- 853c694e035b66fb2a41454db2298337bd7324e2 compiler/cmm/Hoopl/Dataflow.hs | 51 +++++++++++++++++++++--------------------- 1 file changed, 26 insertions(+), 25 deletions(-) diff --git a/compiler/cmm/Hoopl/Dataflow.hs b/compiler/cmm/Hoopl/Dataflow.hs index ed86fdd..e69a7b0 100644 --- a/compiler/cmm/Hoopl/Dataflow.hs +++ b/compiler/cmm/Hoopl/Dataflow.hs @@ -39,6 +39,8 @@ import UniqSupply import Data.Maybe import Data.Array +import Panic + import Compiler.Hoopl hiding ( mkBRewrite3, mkFRewrite3, noFwdRewrite, noBwdRewrite , analyzeAndRewriteBwd, analyzeAndRewriteFwd @@ -100,11 +102,11 @@ mkBRewrite3 f m l = BwdRewrite3 (lift f, lift m, lift l) -- | if the graph being analyzed is open at the entry, there must -- be no other entry point, or all goes horribly wrong... analyzeAndRewriteFwd - :: forall n f e x . NonLocal n => + :: forall n f x . NonLocal n => FwdPass UniqSM n f - -> MaybeC e [Label] - -> Graph n e x -> Fact e f - -> UniqSM (Graph n e x, FactBase f, MaybeO x f) + -> MaybeC C [Label] + -> Graph n C x -> Fact C f + -> UniqSM (Graph n C x, FactBase f, MaybeO x f) analyzeAndRewriteFwd pass entries g f = do (rg, fout) <- arfGraph pass (fmap targetLabels entries) g f let (g', fb) = normalizeGraph rg @@ -207,13 +209,12 @@ arfGraph pass at FwdPass { fp_lattice = lattice, -- in the Body; the facts for Labels *in* -- the Body are in the 'DG f n C C' body entries blockmap init_fbase - = fixpoint Fwd lattice do_block entries blockmap init_fbase + = fixpoint Fwd (fact_join lattice) do_block entries blockmap init_fbase where do_block :: forall x . Block n C x -> FactBase f -> UniqSM (DG f n C x, Fact x f) do_block b fb = block b entryFact - where entryFact = getFact lattice (entryLabel b) fb - + where entryFact = getFact (entryLabel b) fb forwardBlockList :: (NonLocal n) => [Label] -> Body n -> [Block n C C] @@ -228,28 +229,27 @@ forwardBlockList entries blks = postorder_dfs_from blks entries -- | if the graph being analyzed is open at the entry, there must -- be no other entry point, or all goes horribly wrong... analyzeFwd - :: forall n f e . NonLocal n => + :: forall n f . NonLocal n => FwdPass UniqSM n f - -> MaybeC e [Label] - -> Graph n e C -> Fact e f + -> MaybeC C [Label] + -> Graph n C C -> FactBase f -> FactBase f analyzeFwd FwdPass { fp_lattice = lattice, fp_transfer = FwdTransfer3 (ftr, mtr, ltr) } entries g in_fact = graph g in_fact where - graph :: Graph n e C -> Fact e f -> FactBase f + graph :: Graph n C C -> Fact C f -> FactBase f graph (GMany entry blockmap NothingO) = case (entries, entry) of - (NothingC, JustO entry) -> block entry `cat` body (successors entry) (JustC entries, NothingO) -> body entries where - body :: [Label] -> Fact C f -> Fact C f + body :: [Label] -> FactBase f -> FactBase f body entries f = fixpointAnal Fwd (fact_join lattice) do_block entries blockmap f where do_block :: forall x . Block n C x -> FactBase f -> Fact x f do_block b fb = block b entryFact - where entryFact = getFact lattice (entryLabel b) fb + where entryFact = getFact (entryLabel b) fb -- NB. eta-expand block, GHC can't do this by itself. See #5809. block :: forall e x . Block n e x -> f -> Fact x f @@ -291,7 +291,7 @@ analyzeFwdBlocks FwdPass { fp_lattice = lattice, where do_block :: forall x . Block n C x -> FactBase f -> Fact x f do_block b fb = block b entryFact - where entryFact = getFact lattice (entryLabel b) fb + where entryFact = getFact (entryLabel b) fb -- NB. eta-expand block, GHC can't do this by itself. See #5809. block :: forall e x . Block n e x -> f -> Fact x f @@ -458,7 +458,7 @@ arbGraph pass at BwdPass { bp_lattice = lattice, -- in the Body; the facts for Labels *in* -- the Body are in the 'DG f n C C' body entries blockmap init_fbase - = fixpoint Bwd (bp_lattice pass) do_block entries blockmap init_fbase + = fixpoint Bwd (fact_join lattice) do_block entries blockmap init_fbase where do_block :: forall x. Block n C x -> Fact x f -> UniqSM (DG f n C x, LabelMap f) do_block b f = do (g, f) <- block b f @@ -532,14 +532,13 @@ fixpointAnal direction join do_block entries blockmap init_fbase -- fixpoint :: forall n f. NonLocal n => Direction - -> DataflowLattice f + -> JoinFun f -> (Block n C C -> Fact C f -> UniqSM (DG f n C C, Fact C f)) -> [Label] -> LabelMap (Block n C C) -> (Fact C f -> UniqSM (DG f n C C, Fact C f)) -fixpoint direction DataflowLattice{ fact_bot = _, fact_join = join } - do_block entries blockmap init_fbase +fixpoint direction join do_block entries blockmap init_fbase = do -- trace ("fixpoint: " ++ show (case direction of Fwd -> True; Bwd -> False) ++ " " ++ show (mapKeys blockmap) ++ show entries ++ " " ++ show (mapKeys init_fbase)) $ return() (fbase, newblocks) <- loop start init_fbase mapEmpty @@ -783,8 +782,10 @@ class ShapeLifter e x where instance ShapeLifter C O where singletonDG f n = gUnitCO (DBlock f (BlockCO n BNil)) - fwdEntryFact n f = mapSingleton (entryLabel n) f - bwdEntryFact lat n fb = getFact lat (entryLabel n) fb + fwdEntryFact b f = mapSingleton (entryLabel b) f + bwdEntryFact lat b fb = case lookupFact (entryLabel b) fb of + Just f -> f + Nothing -> fact_bot lat ftransfer (FwdTransfer3 (ft, _, _)) n f = ft n f btransfer (BwdTransfer3 (bt, _, _)) n f = bt n f frewrite (FwdRewrite3 (fr, _, _)) n f = fr n f @@ -826,10 +827,10 @@ instance ShapeLifter O C where -} -- Fact lookup: the fact `orelse` bottom -getFact :: DataflowLattice f -> Label -> FactBase f -> f -getFact lat l fb = case lookupFact l fb of Just f -> f - Nothing -> fact_bot lat - +getFact :: Label -> FactBase f -> f +getFact l fb = case lookupFact l fb of + Just f -> f + Nothing -> panic "getFact" {- Note [Respects fuel] From git at git.haskell.org Thu Feb 11 09:05:55 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 11 Feb 2016 09:05:55 +0000 (UTC) Subject: [commit: ghc] wip/js-hoopl-cleanup: Siplify forward analysis (e7a7a62) Message-ID: <20160211090555.22A3A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/js-hoopl-cleanup Link : http://ghc.haskell.org/trac/ghc/changeset/e7a7a6270d28536ceca3696eff99e7c6fa32ddab/ghc >--------------------------------------------------------------- commit e7a7a6270d28536ceca3696eff99e7c6fa32ddab Author: Jan Stolarek Date: Mon Jan 18 21:04:09 2016 +0100 Siplify forward analysis >--------------------------------------------------------------- e7a7a6270d28536ceca3696eff99e7c6fa32ddab compiler/cmm/Hoopl/Dataflow.hs | 12 ++++-------- 1 file changed, 4 insertions(+), 8 deletions(-) diff --git a/compiler/cmm/Hoopl/Dataflow.hs b/compiler/cmm/Hoopl/Dataflow.hs index 50a3426..6507d7e 100644 --- a/compiler/cmm/Hoopl/Dataflow.hs +++ b/compiler/cmm/Hoopl/Dataflow.hs @@ -236,15 +236,11 @@ analyzeFwd -> FactBase f analyzeFwd FwdPass { fp_lattice = lattice, fp_transfer = FwdTransfer3 (ftr, mtr, ltr) } - entries g in_fact = graph g in_fact + (JustC entries) (GMany NothingO blockmap NothingO) in_fact + = body entries in_fact where - graph :: Graph n C C -> Fact C f -> FactBase f - graph (GMany entry blockmap NothingO) - = case (entries, entry) of - (JustC entries, NothingO) -> body entries - where - body :: [Label] -> FactBase f -> FactBase f - body entries f + body :: [Label] -> FactBase f -> FactBase f + body entries f = fixpointAnal Fwd (fact_join lattice) do_block entries blockmap f where do_block :: forall x . Block n C x -> FactBase f -> Fact x f From git at git.haskell.org Thu Feb 11 09:05:57 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 11 Feb 2016 09:05:57 +0000 (UTC) Subject: [commit: ghc] wip/js-hoopl-cleanup: Simplify backwards analysis (3135172) Message-ID: <20160211090557.D40853A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/js-hoopl-cleanup Link : http://ghc.haskell.org/trac/ghc/changeset/31351724ddea0a42792ae7e5a9a4e60a94108734/ghc >--------------------------------------------------------------- commit 31351724ddea0a42792ae7e5a9a4e60a94108734 Author: Jan Stolarek Date: Mon Jan 18 21:24:15 2016 +0100 Simplify backwards analysis >--------------------------------------------------------------- 31351724ddea0a42792ae7e5a9a4e60a94108734 compiler/cmm/CmmUtils.hs | 4 +--- compiler/cmm/Hoopl/Dataflow.hs | 15 ++++++--------- 2 files changed, 7 insertions(+), 12 deletions(-) diff --git a/compiler/cmm/CmmUtils.hs b/compiler/cmm/CmmUtils.hs index ef24923..018e8ea 100644 --- a/compiler/cmm/CmmUtils.hs +++ b/compiler/cmm/CmmUtils.hs @@ -588,8 +588,6 @@ dataflowAnalFwdBlocks :: NonLocal n => -> FwdPass UniqSM n f -> UniqSM (BlockEnv f) dataflowAnalFwdBlocks (CmmGraph {g_entry=entry, g_graph=graph}) facts fwd = do --- (graph, facts, NothingO) <- analyzeAndRewriteFwd fwd (JustC [entry]) graph (mkFactBase (fp_lattice fwd) facts) --- return facts return (analyzeFwdBlocks fwd entry graph (mkFactBase (fp_lattice fwd) facts)) dataflowAnalBwd :: NonLocal n => @@ -597,7 +595,7 @@ dataflowAnalBwd :: NonLocal n => -> BwdPass UniqSM n f -> BlockEnv f dataflowAnalBwd (CmmGraph {g_entry=entry, g_graph=graph}) facts bwd = - analyzeBwd bwd (JustC [entry]) graph (mkFactBase (bp_lattice bwd) facts) + analyzeBwd bwd entry graph (mkFactBase (bp_lattice bwd) facts) dataflowPassBwd :: NonLocal n => GenCmmGraph n -> [(BlockId, f)] diff --git a/compiler/cmm/Hoopl/Dataflow.hs b/compiler/cmm/Hoopl/Dataflow.hs index 6b38608..660617f 100644 --- a/compiler/cmm/Hoopl/Dataflow.hs +++ b/compiler/cmm/Hoopl/Dataflow.hs @@ -296,20 +296,17 @@ analyzeFwdBlocks FwdPass { fp_lattice = lattice, analyzeBwd :: forall n f. NonLocal n => BwdPass UniqSM n f - -> MaybeC C [Label] + -> Label -> Graph n C C -> FactBase f -> FactBase f analyzeBwd BwdPass { bp_lattice = lattice, bp_transfer = BwdTransfer3 (ftr, mtr, ltr) } - (JustC entries) - (GMany NothingO blockmap NothingO) in_fact = body entries in_fact + entry + (GMany NothingO blockmap NothingO) in_fact + = fixpointAnal Bwd (fact_join lattice) do_block [entry] blockmap in_fact where - body :: [Label] -> FactBase f -> FactBase f - body entries f - = fixpointAnal Bwd (fact_join lattice) do_block entries blockmap f - where - do_block :: Block n C C -> FactBase f -> FactBase f - do_block b fb = mapSingleton (entryLabel b) (block b fb) + do_block :: Block n C C -> FactBase f -> FactBase f + do_block b fb = mapSingleton (entryLabel b) (block b fb) -- NB. eta-expand block, GHC can't do this by itself. See #5809. block :: forall e x . Block n e x -> Fact x f -> f From git at git.haskell.org Thu Feb 11 09:06:00 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 11 Feb 2016 09:06:00 +0000 (UTC) Subject: [commit: ghc] wip/js-hoopl-cleanup: Simplify fwd analysis (52bcb77) Message-ID: <20160211090600.917413A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/js-hoopl-cleanup Link : http://ghc.haskell.org/trac/ghc/changeset/52bcb77c18743bf871d06f3b5365d93e6e11ec8d/ghc >--------------------------------------------------------------- commit 52bcb77c18743bf871d06f3b5365d93e6e11ec8d Author: Jan Stolarek Date: Mon Jan 18 21:20:58 2016 +0100 Simplify fwd analysis >--------------------------------------------------------------- 52bcb77c18743bf871d06f3b5365d93e6e11ec8d compiler/cmm/CmmUtils.hs | 4 ++-- compiler/cmm/Hoopl/Dataflow.hs | 30 ++++++++++-------------------- 2 files changed, 12 insertions(+), 22 deletions(-) diff --git a/compiler/cmm/CmmUtils.hs b/compiler/cmm/CmmUtils.hs index dca57dc..ef24923 100644 --- a/compiler/cmm/CmmUtils.hs +++ b/compiler/cmm/CmmUtils.hs @@ -581,7 +581,7 @@ dataflowAnalFwd :: NonLocal n => -> FwdPass UniqSM n f -> BlockEnv f dataflowAnalFwd (CmmGraph {g_entry=entry, g_graph=graph}) facts fwd = - analyzeFwd fwd (JustC [entry]) graph (mkFactBase (fp_lattice fwd) facts) + analyzeFwd fwd entry graph (mkFactBase (fp_lattice fwd) facts) dataflowAnalFwdBlocks :: NonLocal n => GenCmmGraph n -> [(BlockId, f)] @@ -590,7 +590,7 @@ dataflowAnalFwdBlocks :: NonLocal n => dataflowAnalFwdBlocks (CmmGraph {g_entry=entry, g_graph=graph}) facts fwd = do -- (graph, facts, NothingO) <- analyzeAndRewriteFwd fwd (JustC [entry]) graph (mkFactBase (fp_lattice fwd) facts) -- return facts - return (analyzeFwdBlocks fwd (JustC [entry]) graph (mkFactBase (fp_lattice fwd) facts)) + return (analyzeFwdBlocks fwd entry graph (mkFactBase (fp_lattice fwd) facts)) dataflowAnalBwd :: NonLocal n => GenCmmGraph n -> [(BlockId, f)] diff --git a/compiler/cmm/Hoopl/Dataflow.hs b/compiler/cmm/Hoopl/Dataflow.hs index 6507d7e..6b38608 100644 --- a/compiler/cmm/Hoopl/Dataflow.hs +++ b/compiler/cmm/Hoopl/Dataflow.hs @@ -231,21 +231,16 @@ forwardBlockList entries blks = postorder_dfs_from blks entries analyzeFwd :: forall n f . NonLocal n => FwdPass UniqSM n f - -> MaybeC C [Label] + -> Label -> Graph n C C -> FactBase f -> FactBase f analyzeFwd FwdPass { fp_lattice = lattice, fp_transfer = FwdTransfer3 (ftr, mtr, ltr) } - (JustC entries) (GMany NothingO blockmap NothingO) in_fact - = body entries in_fact + entry (GMany NothingO blockmap NothingO) in_fact + = fixpointAnal Fwd (fact_join lattice) do_block [entry] blockmap in_fact where - body :: [Label] -> FactBase f -> FactBase f - body entries f - = fixpointAnal Fwd (fact_join lattice) do_block entries blockmap f - where - do_block :: forall x . Block n C x -> FactBase f -> Fact x f - do_block b fb = block b entryFact - where entryFact = getFact (entryLabel b) fb + do_block :: forall x . Block n C x -> FactBase f -> Fact x f + do_block b fb = block b (getFact (entryLabel b) fb) -- NB. eta-expand block, GHC can't do this by itself. See #5809. block :: forall e x . Block n e x -> f -> Fact x f @@ -268,22 +263,17 @@ analyzeFwd FwdPass { fp_lattice = lattice, analyzeFwdBlocks :: forall n f. NonLocal n => FwdPass UniqSM n f - -> MaybeC C [Label] + -> Label -> Graph n C C -> Fact C f -> FactBase f analyzeFwdBlocks FwdPass { fp_lattice = lattice, fp_transfer = FwdTransfer3 (ftr, _, ltr) } - (JustC entries) + entry (GMany NothingO blockmap NothingO) in_fact - = body entries in_fact + = fixpointAnal Fwd (fact_join lattice) do_block [entry] blockmap in_fact where - body :: [Label] -> Fact C f -> Fact C f - body entries f - = fixpointAnal Fwd (fact_join lattice) do_block entries blockmap f - where - do_block :: Block n C C -> FactBase f -> Fact C f - do_block b fb = block b entryFact - where entryFact = getFact (entryLabel b) fb + do_block :: Block n C C -> FactBase f -> Fact C f + do_block b fb = block b (getFact (entryLabel b) fb) -- NB. eta-expand block, GHC can't do this by itself. See #5809. block :: forall e x . Block n e x -> f -> Fact x f From git at git.haskell.org Thu Feb 11 09:06:03 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 11 Feb 2016 09:06:03 +0000 (UTC) Subject: [commit: ghc] wip/js-hoopl-cleanup: Simplify fixpointAnal (274c3e5) Message-ID: <20160211090603.43CFC3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/js-hoopl-cleanup Link : http://ghc.haskell.org/trac/ghc/changeset/274c3e5ecaf93659cf1ab86c6b9f429d14737ecc/ghc >--------------------------------------------------------------- commit 274c3e5ecaf93659cf1ab86c6b9f429d14737ecc Author: Jan Stolarek Date: Mon Jan 18 21:26:41 2016 +0100 Simplify fixpointAnal >--------------------------------------------------------------- 274c3e5ecaf93659cf1ab86c6b9f429d14737ecc compiler/cmm/Hoopl/Dataflow.hs | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/compiler/cmm/Hoopl/Dataflow.hs b/compiler/cmm/Hoopl/Dataflow.hs index 660617f..6a75efa 100644 --- a/compiler/cmm/Hoopl/Dataflow.hs +++ b/compiler/cmm/Hoopl/Dataflow.hs @@ -237,7 +237,7 @@ analyzeFwd analyzeFwd FwdPass { fp_lattice = lattice, fp_transfer = FwdTransfer3 (ftr, mtr, ltr) } entry (GMany NothingO blockmap NothingO) in_fact - = fixpointAnal Fwd (fact_join lattice) do_block [entry] blockmap in_fact + = fixpointAnal Fwd (fact_join lattice) do_block entry blockmap in_fact where do_block :: forall x . Block n C x -> FactBase f -> Fact x f do_block b fb = block b (getFact (entryLabel b) fb) @@ -270,7 +270,7 @@ analyzeFwdBlocks FwdPass { fp_lattice = lattice, fp_transfer = FwdTransfer3 (ftr, _, ltr) } entry (GMany NothingO blockmap NothingO) in_fact - = fixpointAnal Fwd (fact_join lattice) do_block [entry] blockmap in_fact + = fixpointAnal Fwd (fact_join lattice) do_block entry blockmap in_fact where do_block :: Block n C C -> FactBase f -> Fact C f do_block b fb = block b (getFact (entryLabel b) fb) @@ -303,7 +303,7 @@ analyzeBwd BwdPass { bp_lattice = lattice, bp_transfer = BwdTransfer3 (ftr, mtr, ltr) } entry (GMany NothingO blockmap NothingO) in_fact - = fixpointAnal Bwd (fact_join lattice) do_block [entry] blockmap in_fact + = fixpointAnal Bwd (fact_join lattice) do_block entry blockmap in_fact where do_block :: Block n C C -> FactBase f -> FactBase f do_block b fb = mapSingleton (entryLabel b) (block b fb) @@ -465,14 +465,14 @@ fixpointAnal :: forall n f. NonLocal n => Direction -> JoinFun f -> (Block n C C -> Fact C f -> Fact C f) - -> [Label] + -> Label -> LabelMap (Block n C C) -> Fact C f -> FactBase f -fixpointAnal direction join do_block entries blockmap init_fbase +fixpointAnal direction join do_block entry blockmap init_fbase = loop start init_fbase where - blocks = sortBlocks direction entries blockmap + blocks = sortBlocks direction [entry] blockmap n = length blocks block_arr = {-# SCC "block_arr" #-} listArray (0,n-1) blocks start = {-# SCC "start" #-} [0..n-1] From git at git.haskell.org Thu Feb 11 09:06:05 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 11 Feb 2016 09:06:05 +0000 (UTC) Subject: [commit: ghc] wip/js-hoopl-cleanup: Remove dead code (00c6e03) Message-ID: <20160211090605.F2EF23A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/js-hoopl-cleanup Link : http://ghc.haskell.org/trac/ghc/changeset/00c6e03ca16bdbf3ee8ad70854960a7a8ab95dbe/ghc >--------------------------------------------------------------- commit 00c6e03ca16bdbf3ee8ad70854960a7a8ab95dbe Author: Jan Stolarek Date: Tue Jan 19 17:56:08 2016 +0100 Remove dead code >--------------------------------------------------------------- 00c6e03ca16bdbf3ee8ad70854960a7a8ab95dbe compiler/cmm/Hoopl/Dataflow.hs | 7 ------- 1 file changed, 7 deletions(-) diff --git a/compiler/cmm/Hoopl/Dataflow.hs b/compiler/cmm/Hoopl/Dataflow.hs index 6a75efa..1517c68 100644 --- a/compiler/cmm/Hoopl/Dataflow.hs +++ b/compiler/cmm/Hoopl/Dataflow.hs @@ -514,9 +514,7 @@ fixpoint :: forall n f. NonLocal n fixpoint direction join do_block entries blockmap init_fbase = do - -- trace ("fixpoint: " ++ show (case direction of Fwd -> True; Bwd -> False) ++ " " ++ show (mapKeys blockmap) ++ show entries ++ " " ++ show (mapKeys init_fbase)) $ return() (fbase, newblocks) <- loop start init_fbase mapEmpty - -- trace ("fixpoint DONE: " ++ show (mapKeys fbase) ++ show (mapKeys newblocks)) $ return() return (GMany NothingO newblocks NothingO, mapDeleteList (mapKeys blockmap) fbase) -- The successors of the Graph are the the Labels @@ -539,16 +537,11 @@ fixpoint direction join do_block entries blockmap init_fbase loop (ix:todo) fbase !newblocks = do let blk = block_arr ! ix - -- trace ("analysing: " ++ show (entryLabel blk)) $ return () (rg, out_facts) <- do_block blk fbase let !(todo', fbase') = mapFoldWithKey (updateFact join dep_blocks) (todo,fbase) out_facts - -- trace ("fbase': " ++ show (mapKeys fbase')) $ return () - -- trace ("changed: " ++ show changed) $ return () - -- trace ("to analyse: " ++ show to_analyse) $ return () - let newblocks' = case rg of GMany _ blks _ -> mapUnion blks newblocks From git at git.haskell.org Thu Feb 11 09:06:08 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 11 Feb 2016 09:06:08 +0000 (UTC) Subject: [commit: ghc] wip/js-hoopl-cleanup: Comment cleanup (a1931b9) Message-ID: <20160211090608.B11CA3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/js-hoopl-cleanup Link : http://ghc.haskell.org/trac/ghc/changeset/a1931b9f28b1b44cc67b1666719db5ff46ee19ef/ghc >--------------------------------------------------------------- commit a1931b9f28b1b44cc67b1666719db5ff46ee19ef Author: Jan Stolarek Date: Thu Feb 11 10:05:03 2016 +0100 Comment cleanup >--------------------------------------------------------------- a1931b9f28b1b44cc67b1666719db5ff46ee19ef compiler/cmm/Hoopl/Dataflow.hs | 8 -------- 1 file changed, 8 deletions(-) diff --git a/compiler/cmm/Hoopl/Dataflow.hs b/compiler/cmm/Hoopl/Dataflow.hs index 1517c68..191ff11 100644 --- a/compiler/cmm/Hoopl/Dataflow.hs +++ b/compiler/cmm/Hoopl/Dataflow.hs @@ -226,8 +226,6 @@ forwardBlockList entries blks = postorder_dfs_from blks entries -- Forward Analysis only ---------------------------------------------------------------- --- | if the graph being analyzed is open at the entry, there must --- be no other entry point, or all goes horribly wrong... analyzeFwd :: forall n f . NonLocal n => FwdPass UniqSM n f @@ -258,8 +256,6 @@ analyzeFwd FwdPass { fp_lattice = lattice, cat :: forall f1 f2 f3 . (f1 -> f2) -> (f2 -> f3) -> (f1 -> f3) cat ft1 ft2 = \f -> ft2 $! ft1 f --- | if the graph being analyzed is open at the entry, there must --- be no other entry point, or all goes horribly wrong... analyzeFwdBlocks :: forall n f. NonLocal n => FwdPass UniqSM n f @@ -291,8 +287,6 @@ analyzeFwdBlocks FwdPass { fp_lattice = lattice, -- Backward Analysis only ---------------------------------------------------------------- --- | if the graph being analyzed is open at the entry, there must --- be no other entry point, or all goes horribly wrong... analyzeBwd :: forall n f. NonLocal n => BwdPass UniqSM n f @@ -329,8 +323,6 @@ analyzeBwd BwdPass { bp_lattice = lattice, ----------------------------------------------------------------------------- --- | if the graph being analyzed is open at the exit, I don't --- quite understand the implications of possible other exits analyzeAndRewriteBwd :: NonLocal n => BwdPass UniqSM n f From git at git.haskell.org Thu Feb 11 10:38:46 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 11 Feb 2016 10:38:46 +0000 (UTC) Subject: [commit: ghc] master: Always do eta-reduction (8500855) Message-ID: <20160211103846.A022A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/850085555a1103810d57f0d9835f4d525fd8ec00/ghc >--------------------------------------------------------------- commit 850085555a1103810d57f0d9835f4d525fd8ec00 Author: Simon Peyton Jones Date: Thu Feb 11 10:38:33 2016 +0000 Always do eta-reduction See Note [Eta-reduction in -O0] in DynFlags. Bottom line: doing eta reduction unconditionally is benign, and removes an ASSERT failure (Trac #11562). >--------------------------------------------------------------- 850085555a1103810d57f0d9835f4d525fd8ec00 compiler/main/DynFlags.hs | 17 ++++++++++- testsuite/tests/simplCore/should_compile/T11562.hs | 35 ++++++++++++++++++++++ testsuite/tests/simplCore/should_compile/all.T | 1 + 3 files changed, 52 insertions(+), 1 deletion(-) diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 3cd72bf..5425b89 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -3457,6 +3457,7 @@ impliedXFlags optLevelFlags :: [([Int], GeneralFlag)] optLevelFlags -- see Note [Documenting optimisation flags] = [ ([0,1,2], Opt_DoLambdaEtaExpansion) + , ([0,1,2], Opt_DoEtaReduction) -- See Note [Eta-reduction in -O0] , ([0,1,2], Opt_DmdTxDictSel) , ([0,1,2], Opt_LlvmTBAA) , ([0,1,2], Opt_VectorisationAvoidance) @@ -3473,7 +3474,6 @@ optLevelFlags -- see Note [Documenting optimisation flags] , ([1,2], Opt_CmmElimCommonBlocks) , ([1,2], Opt_CmmSink) , ([1,2], Opt_CSE) - , ([1,2], Opt_DoEtaReduction) , ([1,2], Opt_EnableRewriteRules) -- Off for -O0; see Note [Scoping for Builtin rules] -- in PrelRules , ([1,2], Opt_FloatIn) @@ -3495,6 +3495,21 @@ optLevelFlags -- see Note [Documenting optimisation flags] -- Static Argument Transformation needs investigation. See #9374 ] +{- Note [Eta-reduction in -O0] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Trac #11562 showed an example which tripped an ASSERT in CoreToStg; a +function was marked as MayHaveCafRefs when in fact it obviously +didn't. Reason was: + * Eta reduction wasn't happening in the simplifier, but it was + happening in CorePrep, on + $fBla = MkDict (/\a. K a) + * Result: rhsIsStatic told TidyPgm that $fBla might have CAF refs + but the eta-reduced version (MkDict K) obviously doesn't +Simple solution: just let the simplifier do eta-reduction even in -O0. +After all, CorePrep does it unconditionally! Not a big deal, but +removes an assertion failure. -} + + -- ----------------------------------------------------------------------------- -- Standard sets of warning options diff --git a/testsuite/tests/simplCore/should_compile/T11562.hs b/testsuite/tests/simplCore/should_compile/T11562.hs new file mode 100644 index 0000000..873e1af --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T11562.hs @@ -0,0 +1,35 @@ +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE Rank2Types #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE NoImplicitPrelude #-} + +-- Trac #11562 reported an ASSERT error +-- It only showed up /without/ -O, and obviously +-- with a compiler built with -DDEBUG + +module T11562 where +import qualified GHC.Types as C (Constraint) + +class Category (cat :: k -> k -> *) where + id :: cat a a + (.) :: cat b c -> cat a b -> cat a c + +data Dict :: C.Constraint -> * where + Dict :: a => Dict a + +newtype C2D a b = Sub (a => Dict b) + +instance Category C2D where + id = Sub Dict + f . g = Sub (sub (sub Dict f) g) + +sub :: a => (b => r) -> (C2D a b) -> r +sub r (Sub Dict) = r + +{- +$ inplace/bin/ghc-stage2 -fforce-recomp -c C.hs -O0 + +WARNING: file compiler/stgSyn/CoreToStg.hs, line 250 + $fCategoryConstraint:- True False +-} diff --git a/testsuite/tests/simplCore/should_compile/all.T b/testsuite/tests/simplCore/should_compile/all.T index 2ea15f6..803e344 100644 --- a/testsuite/tests/simplCore/should_compile/all.T +++ b/testsuite/tests/simplCore/should_compile/all.T @@ -229,3 +229,4 @@ test('T11155', run_command, ['$MAKE -s --no-print-directory T11155']) test('T11232', normal, compile, ['-O2']) +test('T11562', normal, compile, ['-O2']) From git at git.haskell.org Thu Feb 11 10:59:17 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 11 Feb 2016 10:59:17 +0000 (UTC) Subject: [commit: ghc] master: Comments about ru_auto (62d1888) Message-ID: <20160211105917.EDA9A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/62d1888ff45bd817409be2c3eacdc86cfef4bed8/ghc >--------------------------------------------------------------- commit 62d1888ff45bd817409be2c3eacdc86cfef4bed8 Author: Simon Peyton Jones Date: Thu Feb 11 11:00:24 2016 +0000 Comments about ru_auto ...following a question from Conal >--------------------------------------------------------------- 62d1888ff45bd817409be2c3eacdc86cfef4bed8 compiler/coreSyn/CoreSyn.hs | 13 +++++++------ compiler/main/TidyPgm.hs | 16 +++++++++------- 2 files changed, 16 insertions(+), 13 deletions(-) diff --git a/compiler/coreSyn/CoreSyn.hs b/compiler/coreSyn/CoreSyn.hs index c725dc3..f06097a 100644 --- a/compiler/coreSyn/CoreSyn.hs +++ b/compiler/coreSyn/CoreSyn.hs @@ -864,15 +864,16 @@ data CoreRule -- See Note [OccInfo in unfoldings and rules] -- Locality - ru_auto :: Bool, -- ^ @True@ <=> this rule is auto-generated - -- @False@ <=> generated at the users behest - -- Main effect: reporting of orphan-hood + ru_auto :: Bool, -- ^ @True@ <=> this rule is auto-generated + -- (notably by Specialise or SpecConstr) + -- @False@ <=> generated at the users behest + -- See Note [Trimming auto-rules] in TidyPgm + -- for the sole purpose of this field. - ru_origin :: !Module, -- ^ 'Module' the rule was defined in, used + ru_origin :: !Module, -- ^ 'Module' the rule was defined in, used -- to test if we should see an orphan rule. - ru_orphan :: !IsOrphan, - -- ^ Whether or not the rule is an orphan. + ru_orphan :: !IsOrphan, -- ^ Whether or not the rule is an orphan. ru_local :: Bool -- ^ @True@ iff the fn at the head of the rule is -- defined in the same module as the rule diff --git a/compiler/main/TidyPgm.hs b/compiler/main/TidyPgm.hs index c524bdf..63f4c26 100644 --- a/compiler/main/TidyPgm.hs +++ b/compiler/main/TidyPgm.hs @@ -887,9 +887,13 @@ reference to f_spec except from the RULE. Now that RULE *might* be useful to an importing module, but that is purely speculative, and meanwhile the code is taking up space and -codegen time. So is seeems better to drop the binding for f_spec if -the auto-generated rule is the *only* reason that it is being kept -alive. +codegen time. I found that binary sizes jumped by 6-10% when I +started to specialise INLINE functions (again, Note [Inline +specialisations] in Specialise). + +So it seeems better to drop the binding for f_spec, and the rule +itself, if the auto-generated rule is the *only* reason that it is +being kept alive. (The RULE still might have been useful in the past; that is, it was the right thing to have generated it in the first place. See Note @@ -902,12 +906,10 @@ So findExternalRules does this: * Remove all auto rules that mention bindings that have been removed (this is done by filtering by keep_rule) -So if a binding is kept alive for some *other* reason (e.g. f_spec is +NB: if a binding is kept alive for some *other* reason (e.g. f_spec is called in the final code), we keep the rule too. -I found that binary sizes jumped by 6-10% when I started to specialise -INLINE functions (again, Note [Inline specialisations] in Specialise). -Adding trimAutoRules removed all this bloat. +This stuff is the only reason for the ru_auto field in a Rule. -} findExternalRules :: Bool -- Omit pragmas From git at git.haskell.org Thu Feb 11 14:55:42 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 11 Feb 2016 14:55:42 +0000 (UTC) Subject: [commit: ghc] master: Ignore untracked in nofib (023bf8d) Message-ID: <20160211145542.7E4D93A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/023bf8d402652f63de9622e00276cb7b6cb4b261/ghc >--------------------------------------------------------------- commit 023bf8d402652f63de9622e00276cb7b6cb4b261 Author: Simon Marlow Date: Wed Feb 10 22:23:14 2016 +0000 Ignore untracked in nofib >--------------------------------------------------------------- 023bf8d402652f63de9622e00276cb7b6cb4b261 .gitmodules | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.gitmodules b/.gitmodules index 73ce0d1..783c568 100644 --- a/.gitmodules +++ b/.gitmodules @@ -106,7 +106,7 @@ [submodule "nofib"] path = nofib url = ../nofib.git - ignore = none + ignore = untracked [submodule "utils/hsc2hs"] path = utils/hsc2hs url = ../hsc2hs.git From git at git.haskell.org Thu Feb 11 14:55:45 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 11 Feb 2016 14:55:45 +0000 (UTC) Subject: [commit: ghc] master: sizeExpr: fix a bug in the size calculation (51a3392) Message-ID: <20160211145545.3CCA03A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/51a33924fc118d9b6c1db556c75c0d010ef95e18/ghc >--------------------------------------------------------------- commit 51a33924fc118d9b6c1db556c75c0d010ef95e18 Author: Simon Marlow Date: Wed Feb 10 09:19:34 2016 +0000 sizeExpr: fix a bug in the size calculation There were two bugs here: * We weren't ignoring Cast in size_up_app * An application of a non-variable wasn't being charged correct The result was that some things looked too cheap. In my case I had things like ((f x) `cast` ...) y which was given size 21 instead of 30, and this had knock-on effects elsewhere that caused some large code bloat. Test Plan: * nofib runs (todo) * validate Reviewers: simonpj, austin, bgamari, erikd Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1900 GHC Trac Issues: #11564 >--------------------------------------------------------------- 51a33924fc118d9b6c1db556c75c0d010ef95e18 compiler/coreSyn/CoreUnfold.hs | 18 +++++++++++++++--- 1 file changed, 15 insertions(+), 3 deletions(-) diff --git a/compiler/coreSyn/CoreUnfold.hs b/compiler/coreSyn/CoreUnfold.hs index 48cdb5e..a03b427 100644 --- a/compiler/coreSyn/CoreUnfold.hs +++ b/compiler/coreSyn/CoreUnfold.hs @@ -578,13 +578,18 @@ sizeExpr dflags bOMB_OUT_SIZE top_args expr 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 other args voids = size_up other `addSizeN` (length 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` + 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 + -- size of the lhs itself. ------------ size_up_call :: Id -> [CoreExpr] -> Int -> ExprSize size_up_call fun val_args voids = case idDetails fun of - FCallId _ -> sizeN (10 * (1 + length val_args)) + FCallId _ -> sizeN (callSize (length val_args) voids) DataConWorkId dc -> conSize dc (length val_args) PrimOpId op -> primOpSize op (length val_args) ClassOpId _ -> classOpSize dflags top_args val_args @@ -657,6 +662,13 @@ classOpSize dflags top_args (arg1 : other_args) -> unitBag (dict, ufDictDiscount dflags) _other -> emptyBag +-- | The size of a function call +callSize + :: Int -- ^ number of value args + -> Int -- ^ number of value args that are void + -> Int +callSize n_val_args voids = 10 * (1 + n_val_args - voids) + funSize :: DynFlags -> [Id] -> Id -> Int -> Int -> ExprSize -- Size for functions that are not constructors or primops -- Note [Function applications] @@ -667,7 +679,7 @@ funSize dflags top_args fun n_val_args voids where some_val_args = n_val_args > 0 - size | some_val_args = 10 * (1 + n_val_args - voids) + size | some_val_args = callSize n_val_args voids | otherwise = 0 -- The 1+ is for the function itself -- Add 1 for each non-trivial arg; From git at git.haskell.org Thu Feb 11 15:00:01 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 11 Feb 2016 15:00:01 +0000 (UTC) Subject: [commit: ghc] master: compiler: Do not suggest nor complete deprecated flags fix trac issue #11454 (46af683) Message-ID: <20160211150001.E84703A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/46af6835ac68d104ee56c29afdfa523c165db2fb/ghc >--------------------------------------------------------------- commit 46af6835ac68d104ee56c29afdfa523c165db2fb Author: Nikita Kartashov Date: Thu Feb 11 11:58:30 2016 +0100 compiler: Do not suggest nor complete deprecated flags fix trac issue #11454 Previously, all flags were present in user suggest and completion. This commit removes the deprecated ones from there. It is done by saving deprecation info at the moment of flag definition. Reviewers: rwbarton, austin, bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie Differential Revision: https://phabricator.haskell.org/D1883 >--------------------------------------------------------------- 46af6835ac68d104ee56c29afdfa523c165db2fb compiler/main/DynFlags.hs | 1317 ++++++++++++++++++++++++++------------------- ghc/GHCi/UI.hs | 4 +- ghc/Main.hs | 2 +- 3 files changed, 775 insertions(+), 548 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 46af6835ac68d104ee56c29afdfa523c165db2fb From git at git.haskell.org Thu Feb 11 15:29:50 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 11 Feb 2016 15:29:50 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Add test for #11516 (2c44209) Message-ID: <20160211152950.C8F603A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/2c44209199e67e15055de55d69d4052a554b2957/ghc >--------------------------------------------------------------- commit 2c44209199e67e15055de55d69d4052a554b2957 Author: Ben Gamari Date: Sat Feb 6 15:16:15 2016 +0100 Add test for #11516 (cherry picked from commit b49d509b336cb74f506555eada8830d754c4b7ba) >--------------------------------------------------------------- 2c44209199e67e15055de55d69d4052a554b2957 testsuite/tests/typecheck/should_compile/T11516.hs | 11 +++++++++++ testsuite/tests/typecheck/should_compile/all.T | 1 + 2 files changed, 12 insertions(+) diff --git a/testsuite/tests/typecheck/should_compile/T11516.hs b/testsuite/tests/typecheck/should_compile/T11516.hs new file mode 100644 index 0000000..3b19a99 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T11516.hs @@ -0,0 +1,11 @@ +{-# language PolyKinds #-} +{-# language FlexibleContexts #-} +{-# language ConstraintKinds #-} +{-# language FlexibleInstances #-} +{-# language FunctionalDependencies #-} + +import GHC.Exts (Constraint) + +class R?ki (p :: i -> i -> *) +class (R?ki p) => Varpi p q f | f -> p q +instance Varpi () () f => Varpi (->) (->) (Either f) where diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index b269f58..e4b1e41 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -502,4 +502,5 @@ test('RebindHR', normal, compile, ['']) test('RebindNegate', normal, compile, ['']) test('T11397', normal, compile, ['']) test('T11458', normal, compile, ['']) +test('T11516', expect_broken(11516), compile, ['']) test('T11524', normal, compile, ['']) From git at git.haskell.org Thu Feb 11 15:29:53 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 11 Feb 2016 15:29:53 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Remove unused export from TcUnify (194820d) Message-ID: <20160211152953.7D31F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/194820d1147daa6cdaa1aab678784ab984b08d6e/ghc >--------------------------------------------------------------- commit 194820d1147daa6cdaa1aab678784ab984b08d6e Author: Simon Peyton Jones Date: Thu Jan 28 22:43:38 2016 +0000 Remove unused export from TcUnify ..namely buildImplication. Plus white space in TcDeriv (cherry picked from commit 8263d09e256d367f9a136fcc73d981879526a329) >--------------------------------------------------------------- 194820d1147daa6cdaa1aab678784ab984b08d6e compiler/typecheck/TcDeriv.hs | 4 ++-- compiler/typecheck/TcUnify.hs | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/compiler/typecheck/TcDeriv.hs b/compiler/typecheck/TcDeriv.hs index 84c7f71..6dbd12b 100644 --- a/compiler/typecheck/TcDeriv.hs +++ b/compiler/typecheck/TcDeriv.hs @@ -1882,8 +1882,8 @@ simplifyDeriv pred tvs theta -- generated instance declaration ; defer <- goptM Opt_DeferTypeErrors ; (implic, _) <- buildImplicationFor tclvl skol_info tvs_skols [] unsolved - -- The buildImplication is just to bind the skolems, in - -- case they are mentioned in error messages + -- The buildImplicationFor is just to bind the skolems, + -- in case they are mentioned in error messages -- See Trac #11347 ; unless defer (reportAllUnsolved (mkImplicWC implic)) diff --git a/compiler/typecheck/TcUnify.hs b/compiler/typecheck/TcUnify.hs index 8d0f797..e25ff21 100644 --- a/compiler/typecheck/TcUnify.hs +++ b/compiler/typecheck/TcUnify.hs @@ -13,7 +13,7 @@ module TcUnify ( tcWrapResult, tcWrapResultO, tcSkolemise, tcSkolemiseET, tcSubTypeHR, tcSubType, tcSubTypeO, tcSubType_NC, tcSubTypeDS, tcSubTypeDS_O, tcSubTypeDS_NC, tcSubTypeDS_NC_O, tcSubTypeET, tcSubTypeET_NC, - checkConstraints, buildImplication, buildImplicationFor, + checkConstraints, buildImplicationFor, -- Various unifications unifyType_, unifyType, unifyTheta, unifyKind, noThing, From git at git.haskell.org Thu Feb 11 15:29:56 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 11 Feb 2016 15:29:56 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Document and improve superclass expansion (e02a57d) Message-ID: <20160211152956.47B343A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/e02a57dd0e4847fdbe97b7b97badc471516d70dc/ghc >--------------------------------------------------------------- commit e02a57dd0e4847fdbe97b7b97badc471516d70dc Author: Simon Peyton Jones Date: Mon Feb 8 13:14:02 2016 +0000 Document and improve superclass expansion When investigating Trac #11523 I found that superclass expansion was a little over-aggressive; we were sort of unrolling each loop twice. This patch corrects that, and adds explanatory comments. (cherry picked from commit 8871737db588b1cb8f7d33d60c5af80b85b2422d) >--------------------------------------------------------------- e02a57dd0e4847fdbe97b7b97badc471516d70dc compiler/typecheck/TcCanonical.hs | 45 ++++++++++++++++++++++++++++----------- compiler/typecheck/TcRnTypes.hs | 3 ++- 2 files changed, 34 insertions(+), 14 deletions(-) diff --git a/compiler/typecheck/TcCanonical.hs b/compiler/typecheck/TcCanonical.hs index ff84664..eda59f2 100644 --- a/compiler/typecheck/TcCanonical.hs +++ b/compiler/typecheck/TcCanonical.hs @@ -372,21 +372,37 @@ mkGivensWithSuperClasses :: CtLoc -> [EvId] -> TcS [Ct] -- From a given EvId, make its Ct, plus the Ct's of its superclasses -- See Note [The superclass story] -- The loop-breaking here follows Note [Expanding superclasses] in TcType +-- +-- Example: class D a => C a +-- class C [a] => D a +-- makeGivensWithSuperClasses (C x) will return (C x, D x, C[x]) +-- i.e. up to and including the first repetition of C mkGivensWithSuperClasses loc ev_ids = concatMapM go ev_ids where - go ev_id = mk_superclasses emptyNameSet $ - CtGiven { ctev_evar = ev_id - , ctev_pred = evVarPred ev_id - , ctev_loc = loc } + go ev_id = mk_superclasses emptyNameSet this_ev + where + this_ev = CtGiven { ctev_evar = ev_id + , ctev_pred = evVarPred ev_id + , ctev_loc = loc } makeSuperClasses :: [Ct] -> TcS [Ct] -- Returns strict superclasses, transitively, see Note [The superclasses story] -- See Note [The superclass story] -- The loop-breaking here follows Note [Expanding superclasses] in TcType +-- Specifically, for an incoming (C t) constraint, we return all of (C t)'s +-- superclasses, up to /and including/ the first repetition of C +-- +-- Example: class D a => C a +-- class C [a] => D a +-- makeSuperClasses (C x) will return (D x, C [x]) +-- +-- NB: the incoming constraints have had their cc_pend_sc flag already +-- flipped to False, by isPendingScDict, so we are /obliged/ to at +-- least produce the immediate superclasses makeSuperClasses cts = concatMapM go cts where go (CDictCan { cc_ev = ev, cc_class = cls, cc_tyargs = tys }) - = mk_strict_superclasses emptyNameSet ev cls tys + = mk_strict_superclasses (unitNameSet (className cls)) ev cls tys go ct = pprPanic "makeSuperClasses" (ppr ct) mk_superclasses :: NameSet -> CtEvidence -> TcS [Ct] @@ -399,13 +415,13 @@ mk_superclasses rec_clss ev = return [mkNonCanonical ev] mk_superclasses_of :: NameSet -> CtEvidence -> Class -> [Type] -> TcS [Ct] --- Return this class constraint, plus its superclasses +-- Always return this class constraint, +-- and expand its superclasses mk_superclasses_of rec_clss ev cls tys - | loop_found - = return [this_ct] - | otherwise - = do { sc_cts <- mk_strict_superclasses rec_clss' ev cls tys - ; return (this_ct : sc_cts) } + | loop_found = return [this_ct] -- cc_pend_sc of this_ct = True + | otherwise = do { sc_cts <- mk_strict_superclasses rec_clss' ev cls tys + ; return (this_ct : sc_cts) } + -- cc_pend_sc of this_ct = False where cls_nm = className cls loop_found = cls_nm `elemNameSet` rec_clss @@ -413,15 +429,19 @@ mk_superclasses_of rec_clss ev cls tys | otherwise = rec_clss `extendNameSet` cls_nm this_ct = CDictCan { cc_ev = ev, cc_class = cls, cc_tyargs = tys , cc_pend_sc = loop_found } + -- NB: If there is a loop, we cut off, so we have not + -- added the superclasses, hence cc_pend_sc = True mk_strict_superclasses :: NameSet -> CtEvidence -> Class -> [Type] -> TcS [Ct] +-- Always return the immediate superclasses of (cls tys); +-- and expand their superclasses, provided none of them are in rec_clss +-- nor are repeated mk_strict_superclasses rec_clss ev cls tys | CtGiven { ctev_evar = evar, ctev_loc = loc } <- ev = do { sc_evs <- newGivenEvVars (mk_given_loc loc) (mkEvScSelectors (EvId evar) cls tys) ; concatMapM (mk_superclasses rec_clss) sc_evs } - | isEmptyVarSet (tyCoVarsOfTypes tys) = return [] -- Wanteds with no variables yield no deriveds. -- See Note [Improvement from Ground Wanteds] @@ -451,7 +471,6 @@ mk_strict_superclasses rec_clss ev cls tys = loc -- is only used for Givens, but does no harm - {- ************************************************************************ * * diff --git a/compiler/typecheck/TcRnTypes.hs b/compiler/typecheck/TcRnTypes.hs index a9bdaf5..b44e9fc 100644 --- a/compiler/typecheck/TcRnTypes.hs +++ b/compiler/typecheck/TcRnTypes.hs @@ -1366,7 +1366,7 @@ data Ct cc_class :: Class, cc_tyargs :: [Xi], -- cc_tyargs are function-free, hence Xi cc_pend_sc :: Bool -- True <=> (a) cc_class has superclasses - -- (b) we have not yet added those + -- (b) we have not (yet) added those -- superclasses as Givens -- NB: cc_pend_sc is used for G/W/D. For W/D the reason -- we need superclasses is to expose possible improvement @@ -1769,6 +1769,7 @@ isUserTypeErrorCt ct = case getUserTypeErrorMsg ct of _ -> False isPendingScDict :: Ct -> Maybe Ct +-- Says whether cc_pend_sc is True, AND if so flips the flag isPendingScDict ct@(CDictCan { cc_pend_sc = True }) = Just (ct { cc_pend_sc = False }) isPendingScDict _ = Nothing From git at git.haskell.org Thu Feb 11 15:29:59 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 11 Feb 2016 15:29:59 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Improve error messages for recursive superclasses (4916993) Message-ID: <20160211152959.3A5F83A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/4916993c5adf241bf9382f948349a2177423482a/ghc >--------------------------------------------------------------- commit 4916993c5adf241bf9382f948349a2177423482a Author: Simon Peyton Jones Date: Mon Feb 8 13:31:11 2016 +0000 Improve error messages for recursive superclasses If we fail to typecheck by blowing the constraint simplifier iteration limit, we want to see the limit-blowing meessage. Previously it was being suppressed by the type /error/, which suppress the iteration-limit /warning/. Solution: make the iteration-limit message into an error. (cherry picked from commit d6b68be1100203aa13755457f89ee4bbb0297473) >--------------------------------------------------------------- 4916993c5adf241bf9382f948349a2177423482a compiler/typecheck/TcSMonad.hs | 7 ++++--- compiler/typecheck/TcSimplify.hs | 26 ++++++++++++++++++-------- 2 files changed, 22 insertions(+), 11 deletions(-) diff --git a/compiler/typecheck/TcSMonad.hs b/compiler/typecheck/TcSMonad.hs index aa16a80..ad7822b 100644 --- a/compiler/typecheck/TcSMonad.hs +++ b/compiler/typecheck/TcSMonad.hs @@ -14,7 +14,7 @@ module TcSMonad ( -- The TcS monad TcS, runTcS, runTcSDeriveds, runTcSWithEvBinds, - failTcS, warnTcS, + failTcS, warnTcS, addErrTcS, runTcSEqualities, nestTcS, nestImplicTcS, @@ -2316,10 +2316,11 @@ wrapWarnTcS :: TcM a -> TcS a -- There's no static check; it's up to the user wrapWarnTcS = wrapTcS -failTcS, panicTcS :: SDoc -> TcS a -warnTcS :: SDoc -> TcS () +failTcS, panicTcS :: SDoc -> TcS a +warnTcS, addErrTcS :: SDoc -> TcS () failTcS = wrapTcS . TcM.failWith warnTcS = wrapTcS . TcM.addWarn +addErrTcS = wrapTcS . TcM.addErr panicTcS doc = pprPanic "TcCanonical" doc traceTcS :: String -> SDoc -> TcS () diff --git a/compiler/typecheck/TcSimplify.hs b/compiler/typecheck/TcSimplify.hs index 8804655..5716f91 100644 --- a/compiler/typecheck/TcSimplify.hs +++ b/compiler/typecheck/TcSimplify.hs @@ -560,8 +560,8 @@ simplifyInfer rhs_tclvl apply_mr sigs name_taus wanteds -- again later. All we want here are the predicates over which to -- quantify. -- - -- If any meta-tyvar unifications take place (unlikely), we'll - -- pick that up later. + -- If any meta-tyvar unifications take place (unlikely), + -- we'll pick that up later. -- See Note [Promote _and_ default when inferring] ; let def_tyvar tv @@ -573,9 +573,10 @@ simplifyInfer rhs_tclvl apply_mr sigs name_taus wanteds ; WC { wc_simple = simples } <- setTcLevel rhs_tclvl $ runTcSDeriveds $ - solveSimpleWanteds $ mapBag toDerivedCt quant_cand - -- NB: we don't want evidence, so used - -- Derived constraints + solveSimpleWanteds $ + mapBag toDerivedCt quant_cand + -- NB: we don't want evidence, + -- so use Derived constraints ; simples <- TcM.zonkSimples simples @@ -976,7 +977,7 @@ This only half-works, but then let-generalisation only half-works. -} simplifyWantedsTcM :: [CtEvidence] -> TcM WantedConstraints --- Zonk the input constraints, and simplify them +-- Solve the specified Wanted constraints -- Discard the evidence binds -- Discards all Derived stuff in result -- Postcondition: fully zonked and unflattened constraints @@ -1033,7 +1034,11 @@ simpl_loop n limit floated_eqs no_new_scs = return wc -- Done! | n `intGtLimit` limit - = do { warnTcS (hang (text "solveWanteds: too many iterations" + = do { -- Add an error (not a warning) if we blow the limit, + -- Typically if we blow the limit we are going to report some other error + -- (an unsolved constraint), and we don't want that error to suppress + -- the iteration limit warning! + addErrTcS (hang (text "solveWanteds: too many iterations" <+> parens (text "limit =" <+> ppr limit)) 2 (vcat [ text "Unsolved:" <+> ppr wc , ppUnless (isEmptyBag floated_eqs) $ @@ -1045,7 +1050,12 @@ simpl_loop n limit floated_eqs no_new_scs ; return wc } | otherwise - = do { traceTcS "simpl_loop, iteration" (int n) + = do { let n_floated = lengthBag floated_eqs + ; csTraceTcS $ + text "simpl_loop iteration=" <> int n + <+> (parens $ hsep [ text "no new scs =" <+> ppr no_new_scs <> comma + , int n_floated <+> text "floated eqs" <> comma + , int (lengthBag simples) <+> text "simples to solve" ]) -- solveSimples may make progress if either float_eqs hold ; (unifs1, wc1) <- reportUnifications $ From git at git.haskell.org Thu Feb 11 15:30:02 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 11 Feb 2016 15:30:02 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Fix a nasty superclass expansion bug (aa830b1) Message-ID: <20160211153002.5E3CC3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/aa830b1e709bb65353045e27f163ace4752da265/ghc >--------------------------------------------------------------- commit aa830b1e709bb65353045e27f163ace4752da265 Author: Simon Peyton Jones Date: Mon Feb 8 14:41:08 2016 +0000 Fix a nasty superclass expansion bug This patch fixes Trac #11523. * The basic problem was that TcRnTypes.superClassesMightHelp was returning True of a Derived constraint, and that led to us expanding Given superclasses, which produced the same Derived constraint again, and so on infinitely. We really want to do this only if there are unsolve /Wanted/ contraints! * On the way I made TcSMonad.getUnsolvedInerts a bit more discriminating about which Derived equalities it returns; see Note [Unsolved Derived equalities] in TcSMonad * Lots of new comments in TcSMonad. (cherry picked from commit 43e02d1270701a1043be67f078cf2b1a85047feb) >--------------------------------------------------------------- aa830b1e709bb65353045e27f163ace4752da265 compiler/typecheck/TcRnTypes.hs | 58 +++++++----- compiler/typecheck/TcSMonad.hs | 102 +++++++++++++-------- testsuite/tests/polykinds/T11523.hs | 89 ++++++++++++++++++ testsuite/tests/polykinds/all.T | 1 + testsuite/tests/typecheck/should_fail/T5853.stderr | 22 ++--- 5 files changed, 199 insertions(+), 73 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 aa830b1e709bb65353045e27f163ace4752da265 From git at git.haskell.org Thu Feb 11 15:30:05 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 11 Feb 2016 15:30:05 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: release notes: Note new two-step allocator (2bda32e) Message-ID: <20160211153005.1DFA03A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/2bda32e19ee58ab3df74d8e05e674a490a6687d7/ghc >--------------------------------------------------------------- commit 2bda32e19ee58ab3df74d8e05e674a490a6687d7 Author: Ben Gamari Date: Mon Feb 8 15:51:55 2016 +0100 release notes: Note new two-step allocator (cherry picked from commit 5a58634ec6f79af175685d97f4051cb5532d4b22) >--------------------------------------------------------------- 2bda32e19ee58ab3df74d8e05e674a490a6687d7 docs/users_guide/8.0.1-notes.rst | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/docs/users_guide/8.0.1-notes.rst b/docs/users_guide/8.0.1-notes.rst index fbed330..2af8a34 100644 --- a/docs/users_guide/8.0.1-notes.rst +++ b/docs/users_guide/8.0.1-notes.rst @@ -396,6 +396,13 @@ Template Haskell Runtime system ~~~~~~~~~~~~~~ +- We have a shiny new two-step memory allocator for 64-bit platforms (see + :ghc-ticket:`9706`). In addition to simplifying the runtime system's + implementation this may significantly improve garbage collector performance. + Note, however, that Haskell processes will have an apparent virtual memory + footprint of a terabyte or so. Don't worry though, most of this amount is merely + mapped but uncommitted address space which is not backed by physical memory. + - Support for performance monitoring with PAPI has been dropped. - :rts-flag:`-maxN?x? <-maxN>` flag added to complement :rts-flag:`-N`. It will From git at git.haskell.org Thu Feb 11 15:30:07 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 11 Feb 2016 15:30:07 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Print * has Unicode star with -fprint-unicode-syntax (3b3be92) Message-ID: <20160211153007.C62193A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/3b3be9266d387581c906fc403e15da09ff3202b8/ghc >--------------------------------------------------------------- commit 3b3be9266d387581c906fc403e15da09ff3202b8 Author: Ben Gamari Date: Mon Feb 8 16:29:04 2016 +0100 Print * has Unicode star with -fprint-unicode-syntax Reviewers: austin, thomie Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1893 (cherry picked from commit da19c136f3e8e73a3713acb5e5802e0f28db8efd) >--------------------------------------------------------------- 3b3be9266d387581c906fc403e15da09ff3202b8 compiler/main/DynFlags.hs | 5 ++++- compiler/types/TyCoRep.hs | 3 ++- compiler/utils/Outputable.hs | 1 + 3 files changed, 7 insertions(+), 2 deletions(-) diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 3d80370..5f7f7ca 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -1813,7 +1813,10 @@ lang_set dflags lang = extensionFlags = flattenExtensionFlags lang (extensions dflags) } --- | Check whether to use unicode syntax for output +-- | An internal helper to check whether to use unicode syntax for output. +-- +-- Note: You should very likely be using 'Outputable.unicodeSyntax' instead +-- of this function. useUnicodeSyntax :: DynFlags -> Bool useUnicodeSyntax = gopt Opt_PrintUnicodeSyntax diff --git a/compiler/types/TyCoRep.hs b/compiler/types/TyCoRep.hs index 5d039c4..bff5603 100644 --- a/compiler/types/TyCoRep.hs +++ b/compiler/types/TyCoRep.hs @@ -2455,7 +2455,8 @@ pprTyTcApp p tc tys | tc `hasKey` tYPETyConKey , [TyConApp lev_tc []] <- tys - = if | lev_tc `hasKey` liftedDataConKey -> char '*' + = if | lev_tc `hasKey` liftedDataConKey -> + unicodeSyntax (char '?') (char '*') | lev_tc `hasKey` unliftedDataConKey -> char '#' | otherwise -> ppr_deflt diff --git a/compiler/utils/Outputable.hs b/compiler/utils/Outputable.hs index 1abb1c5..3ada62b 100644 --- a/compiler/utils/Outputable.hs +++ b/compiler/utils/Outputable.hs @@ -35,6 +35,7 @@ module Outputable ( fsep, fcat, hang, hangNotEmpty, punctuate, ppWhen, ppUnless, speakNth, speakN, speakNOf, plural, isOrAre, doOrDoes, + unicodeSyntax, coloured, PprColour, colType, colCoerc, colDataCon, colBinder, bold, keyword, From git at git.haskell.org Thu Feb 11 15:30:10 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 11 Feb 2016 15:30:10 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: testsuite: Un-break T5642 (a29dc1d) Message-ID: <20160211153010.7A14B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/a29dc1dcc7020539b603651da9a4a8f376604dd7/ghc >--------------------------------------------------------------- commit a29dc1dcc7020539b603651da9a4a8f376604dd7 Author: Ben Gamari Date: Mon Feb 8 17:44:44 2016 +0100 testsuite: Un-break T5642 This was largely fixed by the re-rework of the pattern match checker. Resolves #5642. (cherry picked from commit 16cf460ca6c4aa1ccb05703743f61242ee90c53f) >--------------------------------------------------------------- a29dc1dcc7020539b603651da9a4a8f376604dd7 testsuite/tests/perf/compiler/all.T | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T index 7699aff..25ebac5 100644 --- a/testsuite/tests/perf/compiler/all.T +++ b/testsuite/tests/perf/compiler/all.T @@ -522,7 +522,7 @@ test('T5321FD', test('T5642', [ only_ways(['normal']), - skip, # See Trac #11163 + normal, compiler_stats_num_field('bytes allocated', [(wordsize(32), 641085256, 10), # sample from x86/Linux @@ -530,7 +530,7 @@ test('T5642', # 2014-09-03: 753045568 # 2014-12-10: 641085256 Improvements in constraints solver - (wordsize(64), 1071915072, 10)]) + (wordsize(64), 950004816, 10)]) # prev: 1300000000 # 2014-07-17: 1358833928 (general round of updates) # 2014-08-07: 1402242360 (caused by 1fc60ea) @@ -543,6 +543,7 @@ test('T5642', # 2014-12-10: 1282916024 Improvements in constraints solver # 2015-10-28: 1412808976 Emit Typeable at definition site # 2015-11-22: 1071915072 Use TypeLits in the metadata encoding + # 2016-02-08: 950004816 Pattern match checker re-rework ], compile,['-O']) From git at git.haskell.org Thu Feb 11 15:30:13 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 11 Feb 2016 15:30:13 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Early error when crosscompiling + haddock/docs (16c5445) Message-ID: <20160211153013.4CA6C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/16c544590c12f8728b6e0e971f335d0642115f68/ghc >--------------------------------------------------------------- commit 16c544590c12f8728b6e0e971f335d0642115f68 Author: Thomas Miedema Date: Tue Feb 9 11:06:13 2016 +0100 Early error when crosscompiling + haddock/docs When CrossCompiling=YES or Stage1Only=YES, building the haddocks and the User's Guide should be skipped, because haddock and mkUserGuidePart depend on the GHC API. See Note [No stage2 packages when CrossCompiling or Stage1Only] for details. There are several places in the build system where the variables HADDOCK_DOCS and BUILD_SPHINX_* are checked. Instead of also checking for the variables CrossCompiling or Stage1Only in all those places, `make` will now exit with a nice error message when the user requests the impossible. Reviewers: rwbarton, austin, bgamari Reviewed By: bgamari Differential Revision: https://phabricator.haskell.org/D1882 (cherry picked from commit 04fb7813ab489b1d70a73351836950825b2ce4f7) >--------------------------------------------------------------- 16c544590c12f8728b6e0e971f335d0642115f68 ghc.mk | 23 +++++++++++++++++++---- mk/flavours/bench-cross.mk | 1 - mk/flavours/bench-llvm.mk | 1 - mk/flavours/bench.mk | 1 - mk/flavours/devel1.mk | 1 - mk/flavours/devel2.mk | 1 - mk/flavours/perf-cross.mk | 1 - mk/flavours/perf-llvm.mk | 1 - mk/flavours/perf.mk | 1 - mk/flavours/prof.mk | 1 - mk/flavours/quick-cross.mk | 1 - mk/flavours/quick-llvm.mk | 1 - mk/flavours/quick.mk | 1 - mk/flavours/quickest.mk | 1 - mk/flavours/validate.mk | 1 - 15 files changed, 19 insertions(+), 18 deletions(-) diff --git a/ghc.mk b/ghc.mk index b044d9e..cbac891 100644 --- a/ghc.mk +++ b/ghc.mk @@ -195,6 +195,24 @@ $(error HSCOLOUR_SRCS=YES, but HSCOLOUR_CMD is empty. \ endif endif +ifeq "$(HADDOCK_DOCS)" "YES" +ifneq "$(CrossCompiling) $(Stage1Only)" "NO NO" +$(error Can not build haddock docs when CrossCompiling or Stage1Only. \ + Set HADDOCK_DOCS=NO in your mk/build.mk file. \ + See Note [No stage2 packages when CrossCompiling or Stage1Only]) +endif +endif + +ifneq "$(BUILD_SPHINX_HTML) $(BUILD_SPHINX_PDF)" "NO NO" +# The User's Guide requires mkUserGuidePart, which uses the GHC API. +ifneq "$(CrossCompiling) $(Stage1Only)" "NO NO" +$(error Can not build User's Guide when CrossCompiling or Stage1Only. \ + Set BUILD_SPHINX_HTML=NO, BUILD_SPHINX_PDF=NO in your \ + mk/build.mk file. \ + See Note [No stage2 packages when CrossCompiling or Stage1Only]) +endif +endif + endif # CLEANING # ----------------------------------------------------------------------------- @@ -693,7 +711,7 @@ ifeq "$(HADDOCK_DOCS)" "NO" BUILD_DIRS := $(filter-out utils/haddock,$(BUILD_DIRS)) BUILD_DIRS := $(filter-out utils/haddock/doc,$(BUILD_DIRS)) endif -ifeq "$(BUILD_SPHINX_HTML) $(BUILD_SPHINX_PDF)" "NO NO NO" +ifeq "$(BUILD_SPHINX_HTML) $(BUILD_SPHINX_PDF)" "NO NO" # Don't to build this little utility if we're not building the User's Guide. BUILD_DIRS := $(filter-out utils/mkUserGuidePart,$(BUILD_DIRS)) endif @@ -713,11 +731,8 @@ endif ifneq "$(CrossCompiling) $(Stage1Only)" "NO NO" # See Note [No stage2 packages when CrossCompiling or Stage1Only]. # See Note [Stage1Only vs stage=1] in mk/config.mk.in. -BUILD_DIRS := $(filter-out utils/haddock,$(BUILD_DIRS)) -BUILD_DIRS := $(filter-out utils/haddock/doc,$(BUILD_DIRS)) BUILD_DIRS := $(filter-out utils/ghctags,$(BUILD_DIRS)) BUILD_DIRS := $(filter-out utils/check-api-annotations,$(BUILD_DIRS)) -BUILD_DIRS := $(filter-out utils/mkUserGuidePart,$(BUILD_DIRS)) endif endif # CLEANING diff --git a/mk/flavours/bench-cross.mk b/mk/flavours/bench-cross.mk index 69447a2..15b359e 100644 --- a/mk/flavours/bench-cross.mk +++ b/mk/flavours/bench-cross.mk @@ -6,7 +6,6 @@ BUILD_PROF_LIBS = NO SplitObjs = NO HADDOCK_DOCS = NO BUILD_SPHINX_HTML = NO -BUILD_SPHINX_PS = NO BUILD_SPHINX_PDF = NO BUILD_MAN = NO diff --git a/mk/flavours/bench-llvm.mk b/mk/flavours/bench-llvm.mk index e07c1f3..2da8ddb 100644 --- a/mk/flavours/bench-llvm.mk +++ b/mk/flavours/bench-llvm.mk @@ -6,6 +6,5 @@ BUILD_PROF_LIBS = NO SplitObjs = NO HADDOCK_DOCS = NO BUILD_SPHINX_HTML = NO -BUILD_SPHINX_PS = NO BUILD_SPHINX_PDF = NO BUILD_MAN = NO diff --git a/mk/flavours/bench.mk b/mk/flavours/bench.mk index 1368c47..ad77219 100644 --- a/mk/flavours/bench.mk +++ b/mk/flavours/bench.mk @@ -6,6 +6,5 @@ BUILD_PROF_LIBS = NO SplitObjs = NO HADDOCK_DOCS = NO BUILD_SPHINX_HTML = NO -BUILD_SPHINX_PS = NO BUILD_SPHINX_PDF = NO BUILD_MAN = NO diff --git a/mk/flavours/devel1.mk b/mk/flavours/devel1.mk index 8489c0f..ea730c9 100644 --- a/mk/flavours/devel1.mk +++ b/mk/flavours/devel1.mk @@ -6,7 +6,6 @@ BUILD_PROF_LIBS = NO SplitObjs = NO HADDOCK_DOCS = NO BUILD_SPHINX_HTML = NO -BUILD_SPHINX_PS = NO BUILD_SPHINX_PDF = NO BUILD_MAN = NO diff --git a/mk/flavours/devel2.mk b/mk/flavours/devel2.mk index 1f073ed..c86624a 100644 --- a/mk/flavours/devel2.mk +++ b/mk/flavours/devel2.mk @@ -6,7 +6,6 @@ BUILD_PROF_LIBS = NO SplitObjs = NO HADDOCK_DOCS = NO BUILD_SPHINX_HTML = NO -BUILD_SPHINX_PS = NO BUILD_SPHINX_PDF = NO BUILD_MAN = NO diff --git a/mk/flavours/perf-cross.mk b/mk/flavours/perf-cross.mk index 9540f8c..669b51a 100644 --- a/mk/flavours/perf-cross.mk +++ b/mk/flavours/perf-cross.mk @@ -6,7 +6,6 @@ BUILD_PROF_LIBS = YES #SplitObjs HADDOCK_DOCS = NO BUILD_SPHINX_HTML = NO -BUILD_SPHINX_PS = NO BUILD_SPHINX_PDF = NO BUILD_MAN = NO diff --git a/mk/flavours/perf-llvm.mk b/mk/flavours/perf-llvm.mk index 4a93d6b..cd3d4f4 100644 --- a/mk/flavours/perf-llvm.mk +++ b/mk/flavours/perf-llvm.mk @@ -6,5 +6,4 @@ BUILD_PROF_LIBS = YES #SplitObjs #HADDOCK_DOCS #BUILD_SPHINX_HTML -#BUILD_SPHINX_PS #BUILD_SPHINX_PDF diff --git a/mk/flavours/perf.mk b/mk/flavours/perf.mk index c94b860..06fcc24 100644 --- a/mk/flavours/perf.mk +++ b/mk/flavours/perf.mk @@ -6,5 +6,4 @@ BUILD_PROF_LIBS = YES #SplitObjs #HADDOCK_DOCS #BUILD_SPHINX_HTML -#BUILD_SPHINX_PS #BUILD_SPHINX_PDF diff --git a/mk/flavours/prof.mk b/mk/flavours/prof.mk index 684ffb0..67f89e6 100644 --- a/mk/flavours/prof.mk +++ b/mk/flavours/prof.mk @@ -6,7 +6,6 @@ BUILD_PROF_LIBS = YES SplitObjs = NO HADDOCK_DOCS = NO BUILD_SPHINX_HTML = NO -BUILD_SPHINX_PS = NO BUILD_SPHINX_PDF = NO BUILD_MAN = NO diff --git a/mk/flavours/quick-cross.mk b/mk/flavours/quick-cross.mk index b10dbc5..92347ca 100644 --- a/mk/flavours/quick-cross.mk +++ b/mk/flavours/quick-cross.mk @@ -6,7 +6,6 @@ BUILD_PROF_LIBS = NO SplitObjs = NO HADDOCK_DOCS = NO BUILD_SPHINX_HTML = NO -BUILD_SPHINX_PS = NO BUILD_SPHINX_PDF = NO BUILD_MAN = NO diff --git a/mk/flavours/quick-llvm.mk b/mk/flavours/quick-llvm.mk index 84a8034..0a63f5f 100644 --- a/mk/flavours/quick-llvm.mk +++ b/mk/flavours/quick-llvm.mk @@ -6,6 +6,5 @@ BUILD_PROF_LIBS = NO SplitObjs = NO HADDOCK_DOCS = NO BUILD_SPHINX_HTML = NO -BUILD_SPHINX_PS = NO BUILD_SPHINX_PDF = NO BUILD_MAN = NO diff --git a/mk/flavours/quick.mk b/mk/flavours/quick.mk index 0e045ae..9f1e2e2 100644 --- a/mk/flavours/quick.mk +++ b/mk/flavours/quick.mk @@ -6,6 +6,5 @@ BUILD_PROF_LIBS = NO SplitObjs = NO HADDOCK_DOCS = NO BUILD_SPHINX_HTML = NO -BUILD_SPHINX_PS = NO BUILD_SPHINX_PDF = NO BUILD_MAN = NO diff --git a/mk/flavours/quickest.mk b/mk/flavours/quickest.mk index ba95632..69c0385 100644 --- a/mk/flavours/quickest.mk +++ b/mk/flavours/quickest.mk @@ -6,6 +6,5 @@ BUILD_PROF_LIBS = NO SplitObjs = NO HADDOCK_DOCS = NO BUILD_SPHINX_HTML = NO -BUILD_SPHINX_PS = NO BUILD_SPHINX_PDF = NO BUILD_MAN = NO diff --git a/mk/flavours/validate.mk b/mk/flavours/validate.mk index 94892d4..9e05901 100644 --- a/mk/flavours/validate.mk +++ b/mk/flavours/validate.mk @@ -6,7 +6,6 @@ BUILD_PROF_LIBS = NO SplitObjs = NO HADDOCK_DOCS = YES BUILD_SPHINX_HTML = YES -BUILD_SPHINX_PS = NO BUILD_SPHINX_PDF = NO ifeq "$(ValidateHpc)" "YES" From git at git.haskell.org Thu Feb 11 15:30:15 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 11 Feb 2016 15:30:15 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Unset GREP_OPTIONS in build system (ac0732f) Message-ID: <20160211153015.F26C03A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/ac0732ff36280b99f53a30ee6ecf0ce2e5eee60a/ghc >--------------------------------------------------------------- commit ac0732ff36280b99f53a30ee6ecf0ce2e5eee60a Author: Ben Gamari Date: Tue Feb 9 11:06:27 2016 +0100 Unset GREP_OPTIONS in build system Test Plan: GREP_OPTIONS=--blah ./validate Reviewers: austin, thomie Reviewed By: thomie Differential Revision: https://phabricator.haskell.org/D1887 GHC Trac Issues: #11530 (cherry picked from commit bfec4a6aade005b6dbd170645d4f2d062cee1d92) >--------------------------------------------------------------- ac0732ff36280b99f53a30ee6ecf0ce2e5eee60a Makefile | 7 +++++++ boot | 3 +++ ghc.mk | 2 +- 3 files changed, 11 insertions(+), 1 deletion(-) diff --git a/Makefile b/Makefile index 6be584f..82ab2f7 100644 --- a/Makefile +++ b/Makefile @@ -18,6 +18,13 @@ MAKEFLAGS += --no-builtin-rules .SUFFIXES: + +# ----------------------------------------------------------------------------- +# Sanitize environment + +# See Trac #11530 +export GREP_OPTIONS := + ifneq "$(filter maintainer-clean distclean clean clean_% help,$(MAKECMDGOALS))" "" -include mk/config.mk else diff --git a/boot b/boot index 18d43aa..45f5bf0 100755 --- a/boot +++ b/boot @@ -11,6 +11,9 @@ my %required_tag; my $validate; my $curdir; +# See Trac #11530 +$ENV{GREP_OPTIONS} = ''; + $required_tag{"-"} = 1; $validate = 0; diff --git a/ghc.mk b/ghc.mk index cbac891..5e4ecc6 100644 --- a/ghc.mk +++ b/ghc.mk @@ -92,7 +92,7 @@ $(error Your make does not support abspath. You need GNU make >= 3.81) endif ################################################## - +# ----------------------------------------------------------------------------- # Catch make if it runs away into an infinite loop ifeq "$(MAKE_RESTARTS)" "" else ifeq "$(MAKE_RESTARTS)" "1" From git at git.haskell.org Thu Feb 11 15:30:18 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 11 Feb 2016 15:30:18 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Restore derived Eq instance for SrcLoc (b11b357) Message-ID: <20160211153018.AC5183A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/b11b3571cbd8447f69ec1d3d16f0f3fe1b976c8e/ghc >--------------------------------------------------------------- commit b11b3571cbd8447f69ec1d3d16f0f3fe1b976c8e Author: RyanGlScott Date: Tue Feb 9 11:06:34 2016 +0100 Restore derived Eq instance for SrcLoc GHC 7.10.2 and 7.10.3 had a derived `Eq` instance for `SrcLoc`, but it seems to have been removed (see 6740d70d95cb81cea3859ff847afc61ec439db4f) during GHC 8.0 development. Reviewers: hvr, austin, gridaphobe, bgamari Reviewed By: gridaphobe, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1894 (cherry picked from commit 1f894f298d8f90a4a49196fcda44a696e16ab769) >--------------------------------------------------------------- b11b3571cbd8447f69ec1d3d16f0f3fe1b976c8e libraries/base/GHC/Stack/Types.hs | 3 ++- testsuite/tests/typecheck/should_fail/T5095.stderr | 2 +- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/libraries/base/GHC/Stack/Types.hs b/libraries/base/GHC/Stack/Types.hs index fb92522..35dfcb0 100644 --- a/libraries/base/GHC/Stack/Types.hs +++ b/libraries/base/GHC/Stack/Types.hs @@ -47,6 +47,7 @@ import cycle, which imports ?Data.Maybe? (libraries/base/Data/Maybe.hs) -} +import GHC.Classes (Eq) import GHC.Types -- Make implicit dependency known to build system @@ -205,4 +206,4 @@ data SrcLoc = SrcLoc , srcLocStartCol :: Int , srcLocEndLine :: Int , srcLocEndCol :: Int - } + } deriving Eq diff --git a/testsuite/tests/typecheck/should_fail/T5095.stderr b/testsuite/tests/typecheck/should_fail/T5095.stderr index c284cda..d5f86c0 100644 --- a/testsuite/tests/typecheck/should_fail/T5095.stderr +++ b/testsuite/tests/typecheck/should_fail/T5095.stderr @@ -7,7 +7,7 @@ T5095.hs:9:9: error: -- Defined in ?Data.Either? instance Eq Ordering -- Defined in ?GHC.Classes? ...plus 24 others - ...plus 13 instance involving out-of-scope typess + ...plus 14 instance involving out-of-scope typess (use -fprint-potential-instances to see them all) (The choice depends on the instantiation of ?a? To pick the first instance above, use IncoherentInstances From git at git.haskell.org Thu Feb 11 15:30:21 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 11 Feb 2016 15:30:21 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: TcErrors: Fix plural form of "instance" error (503acfa) Message-ID: <20160211153021.73FA53A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/503acfae6b0eda3b38a0d048cc5678bec07e40d4/ghc >--------------------------------------------------------------- commit 503acfae6b0eda3b38a0d048cc5678bec07e40d4 Author: Ben Gamari Date: Tue Feb 9 14:39:39 2016 +0100 TcErrors: Fix plural form of "instance" error Previously "types" was inappropriately made plural instead of "instance", instance Eq Ordering -- Defined in ?GHC.Classes? ...plus 24 others ...plus 13 instance involving out-of-scope typess (cherry picked from commit c8702e3092250b89f60ad3fe7c71c627e5f388f6) >--------------------------------------------------------------- 503acfae6b0eda3b38a0d048cc5678bec07e40d4 compiler/typecheck/TcErrors.hs | 4 ++-- testsuite/tests/annotations/should_fail/annfail10.stderr | 4 ++-- testsuite/tests/ghci.debugger/scripts/break006.stderr | 4 ++-- testsuite/tests/ghci.debugger/scripts/print019.stderr | 2 +- .../overloadedlists/should_fail/overloadedlistsfail01.stderr | 2 +- testsuite/tests/quotes/TH_localname.stderr | 2 +- testsuite/tests/typecheck/should_compile/holes2.stderr | 2 +- testsuite/tests/typecheck/should_fail/T10971b.stderr | 8 ++++---- testsuite/tests/typecheck/should_fail/T5095.stderr | 2 +- testsuite/tests/typecheck/should_fail/tcfail072.stderr | 4 ++-- testsuite/tests/typecheck/should_fail/tcfail133.stderr | 2 +- 11 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 503acfae6b0eda3b38a0d048cc5678bec07e40d4 From git at git.haskell.org Thu Feb 11 15:30:24 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 11 Feb 2016 15:30:24 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: TcPatSyn: Fix spelling of "pattern" in error message (7346013) Message-ID: <20160211153024.234D23A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/7346013945a0d5a3fd18210f41f4d3b147729b48/ghc >--------------------------------------------------------------- commit 7346013945a0d5a3fd18210f41f4d3b147729b48 Author: Ben Gamari Date: Tue Feb 9 14:42:01 2016 +0100 TcPatSyn: Fix spelling of "pattern" in error message (cherry picked from commit 99cb627a45afacde5f86799671c53baf81daee41) >--------------------------------------------------------------- 7346013945a0d5a3fd18210f41f4d3b147729b48 compiler/typecheck/TcPatSyn.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/typecheck/TcPatSyn.hs b/compiler/typecheck/TcPatSyn.hs index ed7d22e..2bd9526 100644 --- a/compiler/typecheck/TcPatSyn.hs +++ b/compiler/typecheck/TcPatSyn.hs @@ -365,7 +365,7 @@ addPatSynCtxt (L loc name) thing_inside wrongNumberOfParmsErr :: Name -> Arity -> Arity -> SDoc wrongNumberOfParmsErr name decl_arity ty_arity - = hang (text "Patten synonym" <+> quotes (ppr name) <+> ptext (sLit "has") + = hang (text "Pattern synonym" <+> quotes (ppr name) <+> ptext (sLit "has") <+> speakNOf decl_arity (text "argument")) 2 (text "but its type signature has" <+> speakN ty_arity) From git at git.haskell.org Thu Feb 11 15:30:26 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 11 Feb 2016 15:30:26 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: DynFlags: drop tracking of '-#include' flags (63e7d45) Message-ID: <20160211153026.D733E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/63e7d45c575b05f5e48df5f7d942f1c6b638774d/ghc >--------------------------------------------------------------- commit 63e7d45c575b05f5e48df5f7d942f1c6b638774d Author: Sergei Trofimovich Date: Sun Jan 3 12:07:10 2016 +0000 DynFlags: drop tracking of '-#include' flags GHC does not use passed paramaters anywhere for this deprecated option. Signed-off-by: Sergei Trofimovich (cherry picked from commit 7953b27cdc331d97f605ae17f0c514f3e386023d) >--------------------------------------------------------------- 63e7d45c575b05f5e48df5f7d942f1c6b638774d compiler/main/DynFlags.hs | 8 +------- 1 file changed, 1 insertion(+), 7 deletions(-) diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 5f7f7ca..86c8468 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -664,7 +664,6 @@ data DynFlags = DynFlags { historySize :: Int, - cmdlineHcIncludes :: [String], -- ^ @\-\#includes@ importPaths :: [FilePath], mainModIs :: Module, mainFunIs :: Maybe String, @@ -1454,7 +1453,6 @@ defaultDynFlags mySettings = enableTimeStats = False, ghcHeapSize = Nothing, - cmdlineHcIncludes = [], importPaths = ["."], mainModIs = mAIN, mainFunIs = Nothing, @@ -2243,8 +2241,7 @@ dynamic_flags = [ , defFlag "cpp" (NoArg (setExtensionFlag LangExt.Cpp)) , defFlag "F" (NoArg (setGeneralFlag Opt_Pp)) , defFlag "#include" - (HasArg (\s -> do - addCmdlineHCInclude s + (HasArg (\_s -> do addWarn ("-#include and INCLUDE pragmas are " ++ "deprecated: They no longer have any effect"))) , defFlag "v" (OptIntSuffix setVerbosity) @@ -3851,9 +3848,6 @@ setVerbosity mb_n = upd (\dfs -> dfs{ verbosity = mb_n `orElse` 3 }) setDebugLevel :: Maybe Int -> DynP () setDebugLevel mb_n = upd (\dfs -> dfs{ debugLevel = mb_n `orElse` 2 }) -addCmdlineHCInclude :: String -> DynP () -addCmdlineHCInclude a = upd (\s -> s{cmdlineHcIncludes = a : cmdlineHcIncludes s}) - data PkgConfRef = GlobalPkgConf | UserPkgConf From git at git.haskell.org Thu Feb 11 15:30:29 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 11 Feb 2016 15:30:29 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Expand users' guide TH declaration groups section (#9813) (a67c8d5) Message-ID: <20160211153029.8AFBA3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/a67c8d5cc4e4b2f71ca1d60793c6b7c388b6739a/ghc >--------------------------------------------------------------- commit a67c8d5cc4e4b2f71ca1d60793c6b7c388b6739a Author: Owen Stephens Date: Wed Feb 10 10:18:41 2016 +0100 Expand users' guide TH declaration groups section (#9813) Reviewers: austin, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1899 (cherry picked from commit 93e2c8fff902c12fd22d907f7648d847ebfd2146) >--------------------------------------------------------------- a67c8d5cc4e4b2f71ca1d60793c6b7c388b6739a docs/users_guide/glasgow_exts.rst | 78 ++++++++++++++++++++++++++++----------- 1 file changed, 57 insertions(+), 21 deletions(-) diff --git a/docs/users_guide/glasgow_exts.rst b/docs/users_guide/glasgow_exts.rst index fbd20e2..43b9fb6 100644 --- a/docs/users_guide/glasgow_exts.rst +++ b/docs/users_guide/glasgow_exts.rst @@ -9599,8 +9599,9 @@ The :ghc-flag:`-XTemplateHaskellQuotes` extension is considered safe under *declaration groups*. A *declaration group* is the group of declarations created by a top-level declaration splice, plus those following it, down to but not including the next top-level - declaration splice. The first declaration group in a module includes - all top-level definitions down to but not including the first + declaration splice. N.B. only top-level splices delimit declaration + groups, not expression splices. The first declaration group in a module + includes all top-level definitions down to but not including the first top-level declaration splice. Each declaration group is mutually recursive only within the group. @@ -9625,38 +9626,73 @@ The :ghc-flag:`-XTemplateHaskellQuotes` extension is considered safe under import ... f x = x + $(th1 4) + h y = k y y $(blah1) + [qq|blah|] - k x y = x + y + + k x y z = x + y + z + $(th2 10) + w z = $(blah2) - In this example + In this example, a ``reify`` inside... + + 1. The splice ``$(th1 ...)`` would see the definition of ``f`` - the + splice is top-level and thus all definitions in the previous + declaration group are visible (that is, all definitions in the module + up-to, but not including, the splice itself). - 1. The body of ``h`` would be unable to refer to the function ``w``. + 2. The splice ``$(blah1)`` cannot refer to the function ``w`` - ``w`` is + part of a later declaration group, and thus invisible, similarly, + ``$(blah1)`` cannot see the definition of ``h`` (since it is part of + the same declaration group as ``$(blah1)``. However, the splice + ``$(blah1)`` can see the definition of ``f`` (since it is in the + immediately preceding declaration group). + + 3. The splice ``$(th2 ...)`` would see the definition of ``f``, all the + bindings created by ``$(th1 ...)``, the definition of ``h`` and all + bindings created by ``[qq|blah|]`` (they are all in previous + declaration groups). + + 4. The body of ``h`` *can* refer to the function ``k`` appearing on the + other side of the declaration quasiquoter, as quasiquoters do not + cause a declaration group to be broken up. + + 5. The ``qq`` quasiquoter would be able to see the definition of ``f`` + from the preceding declaration group, but not the definitions of + ``h`` or ``k``, or any definitions from subsequent declaration + groups. + + 6. The splice ``$(blah2)`` would see the same definitions as the splice + ``$(th2 ...)`` (but *not* any bindings it creates). + + Note that since an expression splice is unable to refer to declarations + in the same declaration group, we can introduce a top-level (empty) + splice to break up the declaration group :: + + module M where - A ``reify`` inside the splice ``$(th1 ..)`` would see the - definition of ``f``. + data D = C1 | C2 - 2. A ``reify`` inside the splice ``$(blah1)`` would see the - definition of ``f``, but would not see the definition of ``h``. + f1 = $(th1 ...) - 3. A ``reify`` inside the splice ``$(th2..)`` would see the - definition of ``f``, all the bindings created by ``$(th1..)``, and - the definition of ``h``. + $(return []) - 4. A ``reify`` inside the splice ``$(blah2)`` would see the same - definitions as the splice ``$(th2...)``. + f2 = $(th2 ...) - 5. The body of ``h`` *is* able to refer to the function ``k`` - appearing on the other side of the declaration quasiquoter, as - quasiquoters never cause a declaration group to be broken up. + Here - A ``reify`` inside the ``qq`` quasiquoter would be able to see the - definition of ``f`` from the preceding declaration group, but not - the definitions of ``h`` or ``k``, or any definitions from - subsequent declaration groups. + 1. The splice ``$(th1 ...)`` *cannot* refer to ``D`` - it is in the same + declaration group. + 2. The declaration group containing ``D`` is terminated by the empty + top-level declaration splice ``$(return [])`` (recall, ``Q`` is a + Monad, so we may simply ``return`` the empty list of declarations). + 3. Since the declaration group containing ``D`` is in the previous + declaration group, the splice ``$(th2 ...)`` *can* refer to ``D``. - Expression quotations accept most Haskell language constructs. However, there are some GHC-specific extensions which expression From git at git.haskell.org Thu Feb 11 15:30:32 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 11 Feb 2016 15:30:32 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Error early when you register with too old a version of Cabal. (7fc4300) Message-ID: <20160211153032.3BD053A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/7fc4300200a9e287d693e2df936e0fc9549de0a3/ghc >--------------------------------------------------------------- commit 7fc4300200a9e287d693e2df936e0fc9549de0a3 Author: Edward Z. Yang Date: Wed Feb 10 11:09:53 2016 +0100 Error early when you register with too old a version of Cabal. On the GHC 8.0 RCs, multiple users reported a very strange error whereby GHC would complain that the symbols names recorded in interface files did not match the expected name. The reason for this is that they were using an old version of Cabal which chose symbol names differently from the installed package ID ('id' field) which the package was to be installed with; GHC 8.0 now mandates that these coincides. This change adds a test to ghc-pkg to make sure that 'id' and 'key' (which is how Cabal previously reported what the symbol name was supposed to be) match; if they don't match or key is missing, we assume that the Cabal was too old. Bikeshed points: - Should we offer more information about how to upgrade Cabal correctly (i.e. specify a version?) - Should we allow for a missing 'key'? If we allow for 'key' to be missing, we lose the ability to detect Cabal from GHC 7.8 or earlier being used. If we require it to be specified, then it will not be possible for Cabal to deprecate the (unused) field and remove it without having BC for 8.0. Signed-off-by: Edward Z. Yang Test Plan: validate Reviewers: austin, bgamari, hvr Reviewed By: hvr Subscribers: bergmark, thomie Differential Revision: https://phabricator.haskell.org/D1892 GHC Trac Issues: #11558 (cherry picked from commit d80caca10d7c2fa1c9ee8ef6bcafac365d02ff3d) >--------------------------------------------------------------- 7fc4300200a9e287d693e2df936e0fc9549de0a3 testsuite/tests/cabal/T1750A.pkg | 1 + testsuite/tests/cabal/T1750B.pkg | 1 + testsuite/tests/ghci/linking/Makefile | 6 +++--- utils/ghc-pkg/Main.hs | 3 +++ 4 files changed, 8 insertions(+), 3 deletions(-) diff --git a/testsuite/tests/cabal/T1750A.pkg b/testsuite/tests/cabal/T1750A.pkg index 9bda51e..be290f2 100644 --- a/testsuite/tests/cabal/T1750A.pkg +++ b/testsuite/tests/cabal/T1750A.pkg @@ -1,4 +1,5 @@ name: T1750A version: 1 id: T1750A-1-XXX +key: T1750A-1-XXX depends: T1750B-1-XXX diff --git a/testsuite/tests/cabal/T1750B.pkg b/testsuite/tests/cabal/T1750B.pkg index 479ce70..6fc7091 100644 --- a/testsuite/tests/cabal/T1750B.pkg +++ b/testsuite/tests/cabal/T1750B.pkg @@ -1,4 +1,5 @@ name: T1750B version: 1 id: T1750B-1-XXX +key: T1750B-1-XXX depends: T1750A-1-XXX diff --git a/testsuite/tests/ghci/linking/Makefile b/testsuite/tests/ghci/linking/Makefile index c833454..1267650 100644 --- a/testsuite/tests/ghci/linking/Makefile +++ b/testsuite/tests/ghci/linking/Makefile @@ -64,7 +64,7 @@ ghcilink004 : echo 'name: test' >>$(PKG004) echo 'version: 1.0' >>$(PKG004) echo 'id: test-XXX' >>$(PKG004) - echo 'key: test-1.0' >>$(PKG004) + echo 'key: test-XXX' >>$(PKG004) echo 'library-dirs: $${pkgroot}' >>$(PKG004) echo 'extra-libraries: foo' >>$(PKG004) '$(GHC_PKG)' init $(LOCAL_PKGCONF004) @@ -92,7 +92,7 @@ ghcilink005 : echo 'name: test' >>$(PKG005) echo 'version: 1.0' >>$(PKG005) echo 'id: test-XXX' >>$(PKG005) - echo 'key: test-1.0' >>$(PKG005) + echo 'key: test-XXX' >>$(PKG005) echo 'library-dirs: $${pkgroot}' >>$(PKG005) echo 'extra-libraries: foo' >>$(PKG005) '$(GHC_PKG)' init $(LOCAL_PKGCONF005) @@ -117,7 +117,7 @@ ghcilink006 : echo "name: test" >>$(PKG006) echo "version: 1.0" >>$(PKG006) echo "id: test-XXX" >>$(PKG006) - echo "key: test-1.0" >>$(PKG006) + echo "key: test-XXX" >>$(PKG006) ifeq "$(WINDOWS)" "YES" echo "extra-libraries: stdc++-6" >>$(PKG006) else diff --git a/utils/ghc-pkg/Main.hs b/utils/ghc-pkg/Main.hs index 31f6e53..af3032d 100644 --- a/utils/ghc-pkg/Main.hs +++ b/utils/ghc-pkg/Main.hs @@ -1612,6 +1612,9 @@ checkUnitId :: InstalledPackageInfo -> PackageDBStack -> Bool checkUnitId ipi db_stack update = do let uid = installedUnitId ipi when (null (display uid)) $ verror CannotForce "missing id field" + when (display uid /= compatPackageKey ipi) $ + verror CannotForce $ "installed package info from too old version of Cabal " + ++ "(key field does not match id field)" let dups = [ p | p <- allPackagesInStack db_stack, installedUnitId p == uid ] when (not update && not (null dups)) $ From git at git.haskell.org Thu Feb 11 15:30:35 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 11 Feb 2016 15:30:35 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: compiler: Do not suggest nor complete deprecated flags fix trac issue #11454 (9b0ffd4) Message-ID: <20160211153035.055BF3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/9b0ffd4cbd57afd3b7ee2581cacf0943e744ad9b/ghc >--------------------------------------------------------------- commit 9b0ffd4cbd57afd3b7ee2581cacf0943e744ad9b Author: Nikita Kartashov Date: Thu Feb 11 11:58:30 2016 +0100 compiler: Do not suggest nor complete deprecated flags fix trac issue #11454 Previously, all flags were present in user suggest and completion. This commit removes the deprecated ones from there. It is done by saving deprecation info at the moment of flag definition. Reviewers: rwbarton, austin, bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie Differential Revision: https://phabricator.haskell.org/D1883 (cherry picked from commit 46af6835ac68d104ee56c29afdfa523c165db2fb) >--------------------------------------------------------------- 9b0ffd4cbd57afd3b7ee2581cacf0943e744ad9b compiler/main/DynFlags.hs | 1317 ++++++++++++++++++++++++++------------------- ghc/GHCi/UI.hs | 4 +- ghc/Main.hs | 2 +- 3 files changed, 775 insertions(+), 548 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 9b0ffd4cbd57afd3b7ee2581cacf0943e744ad9b From git at git.haskell.org Thu Feb 11 16:23:06 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 11 Feb 2016 16:23:06 +0000 (UTC) Subject: [commit: ghc] master: Another batch of typo fixes in non-code (efba41e) Message-ID: <20160211162306.051643A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/efba41e2b3b42b7f83e9832b1102f6585cd4ca44/ghc >--------------------------------------------------------------- commit efba41e2b3b42b7f83e9832b1102f6585cd4ca44 Author: Gabor Greif Date: Thu Feb 11 12:38:21 2016 +0100 Another batch of typo fixes in non-code >--------------------------------------------------------------- efba41e2b3b42b7f83e9832b1102f6585cd4ca44 compiler/basicTypes/Demand.hs | 2 +- compiler/codeGen/StgCmmClosure.hs | 2 +- compiler/deSugar/DsUtils.hs | 2 +- compiler/main/TidyPgm.hs | 2 +- compiler/prelude/TysWiredIn.hs | 2 +- compiler/simplCore/Simplify.hs | 2 +- compiler/simplCore/simplifier.tib | 2 +- compiler/specialise/Specialise.hs | 2 +- compiler/stranal/DmdAnal.hs | 2 +- compiler/typecheck/TcSMonad.hs | 2 +- testsuite/tests/concurrent/should_run/conc025.hs | 2 +- testsuite/tests/gadt/gadt15.hs | 2 +- testsuite/tests/primops/should_run/T7689.hs | 2 +- testsuite/tests/programs/andy_cherry/andy_cherry.stdout | 2 +- testsuite/tests/programs/andy_cherry/mygames.pgn | 2 +- testsuite/tests/safeHaskell/safeLanguage/Makefile | 2 +- testsuite/tests/stranal/should_compile/syn.hs | 2 +- 17 files changed, 17 insertions(+), 17 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 efba41e2b3b42b7f83e9832b1102f6585cd4ca44 From git at git.haskell.org Thu Feb 11 17:42:21 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 11 Feb 2016 17:42:21 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Fix the removal of unnecessary stack checks (d0b4ead) Message-ID: <20160211174221.D95F13A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/d0b4eade3410a09459c4c101546f58e06f9aebcc/ghc >--------------------------------------------------------------- commit d0b4eade3410a09459c4c101546f58e06f9aebcc Author: Jonas Scholl Date: Tue Feb 9 11:06:00 2016 +0100 Fix the removal of unnecessary stack checks The module CmmLayoutStack removes stack checks if a function does not use stack space. However, it can only recognize checks of the form Sp < SpLim. However, these checks get sometimes rewritten to Sp >= SpLim (with both branches swapped), so we better recognize these checks too. Test Plan: ./validate Reviewers: austin, bgamari, simonpj Reviewed By: simonpj Subscribers: simonpj, thomie Differential Revision: https://phabricator.haskell.org/D1881 GHC Trac Issues: #11533 (cherry picked from commit 4ec61411930495fc109be27993c176fd7aaf486d) >--------------------------------------------------------------- d0b4eade3410a09459c4c101546f58e06f9aebcc compiler/cmm/CmmLayoutStack.hs | 27 +++++++++++++++++++++------ 1 file changed, 21 insertions(+), 6 deletions(-) diff --git a/compiler/cmm/CmmLayoutStack.hs b/compiler/cmm/CmmLayoutStack.hs index cf96156..f55d76a 100644 --- a/compiler/cmm/CmmLayoutStack.hs +++ b/compiler/cmm/CmmLayoutStack.hs @@ -856,18 +856,26 @@ areaToSp dflags _ sp_hwm _ (CmmLit CmmHighStackMark) -- Replace CmmHighStackMark with the number of bytes of stack used, -- the sp_hwm. See Note [Stack usage] in StgCmmHeap -areaToSp dflags _ _ _ (CmmMachOp (MO_U_Lt _) - [CmmMachOp (MO_Sub _) - [ CmmRegOff (CmmGlobal Sp) x_off - , CmmLit (CmmInt y_lit _)], - CmmReg (CmmGlobal SpLim)]) - | fromIntegral x_off >= y_lit +areaToSp dflags _ _ _ (CmmMachOp (MO_U_Lt _) args) + | falseStackCheck args = zeroExpr dflags +areaToSp dflags _ _ _ (CmmMachOp (MO_U_Ge _) args) + | falseStackCheck args + = mkIntExpr dflags 1 -- Replace a stack-overflow test that cannot fail with a no-op -- See Note [Always false stack check] areaToSp _ _ _ _ other = other +-- | Determine whether a stack check cannot fail. +falseStackCheck :: [CmmExpr] -> Bool +falseStackCheck [ CmmMachOp (MO_Sub _) + [ CmmRegOff (CmmGlobal Sp) x_off + , CmmLit (CmmInt y_lit _)] + , CmmReg (CmmGlobal SpLim)] + = fromIntegral x_off >= y_lit +falseStackCheck _ = False + -- Note [Always false stack check] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -- We can optimise stack checks of the form @@ -880,11 +888,18 @@ areaToSp _ _ _ _ other = other -- A subsequent sinking pass will later drop the dead code. -- Optimising this away depends on knowing that SpLim <= Sp, so it is -- really the job of the stack layout algorithm, hence we do it now. +-- +-- The control flow optimiser may negate a conditional to increase +-- the likelihood of a fallthrough if the branch is not taken. But +-- not every conditional is inverted as the control flow optimiser +-- places some requirements on the predecessors of both branch targets. +-- So we better look for the inverted comparison too. optStackCheck :: CmmNode O C -> CmmNode O C optStackCheck n = -- Note [Always false stack check] case n of CmmCondBranch (CmmLit (CmmInt 0 _)) _true false _ -> CmmBranch false + CmmCondBranch (CmmLit (CmmInt _ _)) true _false _ -> CmmBranch true other -> other From git at git.haskell.org Thu Feb 11 17:42:25 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 11 Feb 2016 17:42:25 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Wrap solveEqualities in checkNoErrs (d0010d7) Message-ID: <20160211174225.C08D53A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/d0010d749f80b405f991e88e0e953a21d54a744d/ghc >--------------------------------------------------------------- commit d0010d749f80b405f991e88e0e953a21d54a744d Author: Simon Peyton Jones Date: Wed Feb 10 14:32:22 2016 +0000 Wrap solveEqualities in checkNoErrs This simple change fixes Trac #11563, #11520, #11516, #11399. See esp the comments in #11520. See Note [Fail fast on kind errors] in TcSimplify Merge to 8.0 branch (cherry picked from commit b565830dda0994d5d67617039db3310f81e831c8) >--------------------------------------------------------------- d0010d749f80b405f991e88e0e953a21d54a744d compiler/typecheck/TcSimplify.hs | 24 ++++++++++-- compiler/typecheck/TcTyClsDecls.hs | 6 +-- testsuite/tests/polykinds/T11399.hs | 7 ++++ testsuite/tests/polykinds/T11399.stderr | 9 +++++ .../should_compile => polykinds}/T11516.hs | 0 testsuite/tests/polykinds/T11516.stderr | 5 +++ testsuite/tests/polykinds/T11520.hs | 16 ++++++++ testsuite/tests/polykinds/T11520.stderr | 6 +++ testsuite/tests/polykinds/all.T | 3 ++ .../tests/rename/should_fail/rnfail026.stderr | 4 -- testsuite/tests/typecheck/should_compile/all.T | 1 - testsuite/tests/typecheck/should_fail/T11563.hs | 5 +++ .../tests/typecheck/should_fail/T11563.stderr | 6 +++ testsuite/tests/typecheck/should_fail/T2994.stderr | 44 ++++++++-------------- testsuite/tests/typecheck/should_fail/T3540.stderr | 12 ------ testsuite/tests/typecheck/should_fail/all.T | 1 + 16 files changed, 96 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 d0010d749f80b405f991e88e0e953a21d54a744d From git at git.haskell.org Thu Feb 11 17:44:12 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 11 Feb 2016 17:44:12 +0000 (UTC) Subject: [commit: ghc] master: Build the substitution correctly in piResultTy (dbf72db) Message-ID: <20160211174412.EC15C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/dbf72dbc6e49b3db7f2337a7a41e95c1d0169163/ghc >--------------------------------------------------------------- commit dbf72dbc6e49b3db7f2337a7a41e95c1d0169163 Author: Bartosz Nitka Date: Thu Feb 11 09:44:53 2016 -0800 Build the substitution correctly in piResultTy This fixes a bug where piResultTy created substitutions that would violate both of the invariants in Note [The substitution invariant]. Test Plan: ./validate --slow Reviewers: goldfire, simonpj, austin, bgamari Reviewed By: simonpj, bgamari Subscribers: simonmar, thomie Differential Revision: https://phabricator.haskell.org/D1855 GHC Trac Issues: #11371 >--------------------------------------------------------------- dbf72dbc6e49b3db7f2337a7a41e95c1d0169163 compiler/types/Type.hs | 26 ++++++++++++++++++++------ 1 file changed, 20 insertions(+), 6 deletions(-) diff --git a/compiler/types/Type.hs b/compiler/types/Type.hs index 67365e3..a649700 100644 --- a/compiler/types/Type.hs +++ b/compiler/types/Type.hs @@ -801,15 +801,29 @@ funResultTy ty = piResultTy ty (pprPanic "funResultTy" (ppr ty)) -- | Essentially 'funResultTy' on kinds handling pi-types too piResultTy :: Type -> Type -> Type -piResultTy ty arg | Just ty' <- coreView ty = piResultTy ty' arg -piResultTy (ForAllTy (Anon _) res) _ = res -piResultTy (ForAllTy (Named tv _) res) arg = substTyWithUnchecked [tv] [arg] res -piResultTy ty arg = pprPanic "piResultTy" - (ppr ty $$ ppr arg) +piResultTy ty arg = piResultTys ty [arg] -- | Fold 'piResultTy' over many types piResultTys :: Type -> [Type] -> Type -piResultTys = foldl piResultTy +piResultTys ty args = go empty_subst ty args + where + empty_subst = mkEmptyTCvSubst (mkInScopeSet $ tyCoVarsOfTypes (ty:args)) + -- The free vars of 'ty' and 'args' need to be in scope to satisfy the + -- invariant in Note [The substitution invariant] in TyCoRep. + + go subst ty [] = substTy subst ty + go subst ty args@(arg:args') + | Just (bndr, res) <- splitPiTy_maybe ty + = case bndr of + Anon _ -> go subst res args' + Named tv _ -> go (extendTCvSubst subst tv arg) res args' + + | Just tv <- getTyVar_maybe ty + -- Deals with piResultTys (forall a. a) [forall b.b, Int] + = go empty_subst (substTyVar subst tv) args + + | otherwise + = panic "piResultTys" funArgTy :: Type -> Type -- ^ Extract the function argument type and panic if that is not possible From git at git.haskell.org Fri Feb 12 02:04:53 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 12 Feb 2016 02:04:53 +0000 (UTC) Subject: [commit: ghc] master: Add test for #11319 (b7dfbb4) Message-ID: <20160212020453.C43F23A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b7dfbb45b6ac7849dbb7cf414d507fd65d1e7ed4/ghc >--------------------------------------------------------------- commit b7dfbb45b6ac7849dbb7cf414d507fd65d1e7ed4 Author: Reid Barton Date: Thu Feb 11 21:04:17 2016 -0500 Add test for #11319 >--------------------------------------------------------------- b7dfbb45b6ac7849dbb7cf414d507fd65d1e7ed4 testsuite/tests/typecheck/should_compile/T11319.hs | 6 ++++++ testsuite/tests/typecheck/should_compile/all.T | 1 + 2 files changed, 7 insertions(+) diff --git a/testsuite/tests/typecheck/should_compile/T11319.hs b/testsuite/tests/typecheck/should_compile/T11319.hs new file mode 100644 index 0000000..5f09d22 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T11319.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE ImpredicativeTypes #-} + +module T11319 where + +f :: Monad m => m (Maybe a) +f = return Nothing diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index 9584c84..f7c5644 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -500,6 +500,7 @@ test('T11462', test('T11480', normal, compile, ['']) test('RebindHR', normal, compile, ['']) test('RebindNegate', normal, compile, ['']) +test('T11319', expect_broken(11319), compile, ['']) test('T11397', normal, compile, ['']) test('T11458', normal, compile, ['']) test('T11524', normal, compile, ['']) From git at git.haskell.org Fri Feb 12 09:04:07 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 12 Feb 2016 09:04:07 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Bump haddock submodule (23ee5ce) Message-ID: <20160212090407.6B6A53A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/23ee5ce7afff22a9bc2d92586fb663fe9d0dd99b/ghc >--------------------------------------------------------------- commit 23ee5ce7afff22a9bc2d92586fb663fe9d0dd99b Author: Ben Gamari Date: Thu Feb 11 18:55:28 2016 +0100 Bump haddock submodule Most notably switch Haddock documentation to ReStuctured Text >--------------------------------------------------------------- 23ee5ce7afff22a9bc2d92586fb663fe9d0dd99b utils/haddock | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/utils/haddock b/utils/haddock index af205d2..6a6029f 160000 --- a/utils/haddock +++ b/utils/haddock @@ -1 +1 @@ -Subproject commit af205d20bf3502b41e4fd34b1c991d5014388004 +Subproject commit 6a6029f1fc7b2cfeea8e231c8806d293d6644004 From git at git.haskell.org Fri Feb 12 09:51:06 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 12 Feb 2016 09:51:06 +0000 (UTC) Subject: [commit: ghc] master: Revert "sizeExpr: fix a bug in the size calculation" (8da6a16) Message-ID: <20160212095106.79F203A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8da6a162416d448309ced16b00f54a32b5ee750b/ghc >--------------------------------------------------------------- commit 8da6a162416d448309ced16b00f54a32b5ee750b Author: Simon Marlow Date: Fri Feb 12 09:52:21 2016 +0000 Revert "sizeExpr: fix a bug in the size calculation" This reverts commit 51a33924fc118d9b6c1db556c75c0d010ef95e18. >--------------------------------------------------------------- 8da6a162416d448309ced16b00f54a32b5ee750b compiler/coreSyn/CoreUnfold.hs | 18 +++--------------- 1 file changed, 3 insertions(+), 15 deletions(-) diff --git a/compiler/coreSyn/CoreUnfold.hs b/compiler/coreSyn/CoreUnfold.hs index a03b427..48cdb5e 100644 --- a/compiler/coreSyn/CoreUnfold.hs +++ b/compiler/coreSyn/CoreUnfold.hs @@ -578,18 +578,13 @@ sizeExpr dflags bOMB_OUT_SIZE top_args expr 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` - 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 - -- size of the lhs itself. + size_up_app other args voids = size_up other `addSizeN` (length args - voids) ------------ size_up_call :: Id -> [CoreExpr] -> Int -> ExprSize size_up_call fun val_args voids = case idDetails fun of - FCallId _ -> sizeN (callSize (length val_args) voids) + FCallId _ -> sizeN (10 * (1 + length val_args)) DataConWorkId dc -> conSize dc (length val_args) PrimOpId op -> primOpSize op (length val_args) ClassOpId _ -> classOpSize dflags top_args val_args @@ -662,13 +657,6 @@ classOpSize dflags top_args (arg1 : other_args) -> unitBag (dict, ufDictDiscount dflags) _other -> emptyBag --- | The size of a function call -callSize - :: Int -- ^ number of value args - -> Int -- ^ number of value args that are void - -> Int -callSize n_val_args voids = 10 * (1 + n_val_args - voids) - funSize :: DynFlags -> [Id] -> Id -> Int -> Int -> ExprSize -- Size for functions that are not constructors or primops -- Note [Function applications] @@ -679,7 +667,7 @@ funSize dflags top_args fun n_val_args voids where some_val_args = n_val_args > 0 - size | some_val_args = callSize n_val_args voids + size | some_val_args = 10 * (1 + n_val_args - voids) | otherwise = 0 -- The 1+ is for the function itself -- Add 1 for each non-trivial arg; From git at git.haskell.org Fri Feb 12 12:23:35 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 12 Feb 2016 12:23:35 +0000 (UTC) Subject: [commit: ghc] branch 'wip/typeable-unwired' created Message-ID: <20160212122335.9001D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/typeable-unwired Referencing: 065e7b43106afcd4ab733b19b17dcc10490c3af7 From git at git.haskell.org Fri Feb 12 12:23:38 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 12 Feb 2016 12:23:38 +0000 (UTC) Subject: [commit: ghc] wip/typeable-unwired: Attempt to unwire Typeable representation types (d9281e1) Message-ID: <20160212122338.4DCCD3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/typeable-unwired Link : http://ghc.haskell.org/trac/ghc/changeset/d9281e12d2607c9c34011735b7dcf812a8b35af5/ghc >--------------------------------------------------------------- commit d9281e12d2607c9c34011735b7dcf812a8b35af5 Author: Ben Gamari Date: Sat Jan 30 17:22:53 2016 +0100 Attempt to unwire Typeable representation types >--------------------------------------------------------------- d9281e12d2607c9c34011735b7dcf812a8b35af5 compiler/prelude/PrelNames.hs | 22 +++++++ compiler/prelude/TysWiredIn.hs | 62 +----------------- compiler/typecheck/TcRnDriver.hs | 21 +++--- compiler/typecheck/TcTypeable.hs | 135 ++++++++++++++++++++++++--------------- libraries/ghc-prim/GHC/Types.hs | 2 +- 5 files changed, 117 insertions(+), 125 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 d9281e12d2607c9c34011735b7dcf812a8b35af5 From git at git.haskell.org Fri Feb 12 12:23:40 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 12 Feb 2016 12:23:40 +0000 (UTC) Subject: [commit: ghc] wip/typeable-unwired: Move TypeRep declarations (065e7b4) Message-ID: <20160212122340.F2E323A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/typeable-unwired Link : http://ghc.haskell.org/trac/ghc/changeset/065e7b43106afcd4ab733b19b17dcc10490c3af7/ghc >--------------------------------------------------------------- commit 065e7b43106afcd4ab733b19b17dcc10490c3af7 Author: Ben Gamari Date: Fri Feb 12 12:40:59 2016 +0100 Move TypeRep declarations >--------------------------------------------------------------- 065e7b43106afcd4ab733b19b17dcc10490c3af7 libraries/ghc-prim/GHC/Types.hs | 90 ++++++++++++++++++++--------------------- 1 file changed, 45 insertions(+), 45 deletions(-) diff --git a/libraries/ghc-prim/GHC/Types.hs b/libraries/ghc-prim/GHC/Types.hs index a1aea0b..cad321a 100644 --- a/libraries/ghc-prim/GHC/Types.hs +++ b/libraries/ghc-prim/GHC/Types.hs @@ -43,6 +43,51 @@ import GHC.Prim infixr 5 : +{- ********************************************************************* +* * + Runtime representation of TyCon +* * +********************************************************************* -} + +{- Note [Runtime representation of modules and tycons] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We generate a binding for M.$modName and M.$tcT for every module M and +data type T. Things to think about + + - We want them to be economical on space; ideally pure data with no thunks. + + - We do this for every module (except this module GHC.Types), so we can't + depend on anything else (eg string unpacking code) + +That's why we have these terribly low-level repesentations. The TrName +type lets us use the TrNameS constructor when allocating static data; +but we also need TrNameD for the case where we are deserialising a TyCon +or Module (for example when deserialising a TypeRep), in which case we +can't conveniently come up with an Addr#. +-} + +#include "MachDeps.h" + +data Module = Module + TrName -- Package name + TrName -- Module name + +data TrName + = TrNameS Addr# -- Static + | TrNameD [Char] -- Dynamic + +#if WORD_SIZE_IN_BITS < 64 +data TyCon = TyCon + Word64# Word64# -- Fingerprint + Module -- Module in which this is defined + TrName -- Type constructor name +#else +data TyCon = TyCon + Word# Word# + Module + TrName +#endif + -- Take note: All types defined here must have associated type representations -- defined in Data.Typeable.Internal. -- See Note [Representation of types defined in GHC.Types] below. @@ -341,48 +386,3 @@ data SPEC = SPEC | SPEC2 -- is the kind of 'Lifted' and 'Unlifted'. @*@ is a synonym for @TYPE Lifted@ -- and @#@ is a synonym for @TYPE Unlifted at . data Levity = Lifted | Unlifted - -{- ********************************************************************* -* * - Runtime representation of TyCon -* * -********************************************************************* -} - -{- Note [Runtime representation of modules and tycons] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -We generate a binding for M.$modName and M.$tcT for every module M and -data type T. Things to think about - - - We want them to be economical on space; ideally pure data with no thunks. - - - We do this for every module (except this module GHC.Types), so we can't - depend on anything else (eg string unpacking code) - -That's why we have these terribly low-level repesentations. The TrName -type lets us use the TrNameS constructor when allocating static data; -but we also need TrNameD for the case where we are deserialising a TyCon -or Module (for example when deserialising a TypeRep), in which case we -can't conveniently come up with an Addr#. --} - -#include "MachDeps.h" - -data Module = Module - TrName -- Package name - TrName -- Module name - -data TrName - = TrNameS Addr# -- Static - | TrNameD [Char] -- Dynamic - -#if WORD_SIZE_IN_BITS < 64 -data TyCon = TyCon - Word64# Word64# -- Fingerprint - Module -- Module in which this is defined - TrName -- Type constructor name -#else -data TyCon = TyCon - Word# Word# - Module - TrName -#endif From git at git.haskell.org Fri Feb 12 12:33:11 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 12 Feb 2016 12:33:11 +0000 (UTC) Subject: [commit: ghc] wip/typeable-unwired: Generate trModule after typechecking types (e405eb1) Message-ID: <20160212123311.769DF3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/typeable-unwired Link : http://ghc.haskell.org/trac/ghc/changeset/e405eb1541c9e8a9ff3be21bb1036b00665def17/ghc >--------------------------------------------------------------- commit e405eb1541c9e8a9ff3be21bb1036b00665def17 Author: Ben Gamari Date: Fri Feb 12 13:34:28 2016 +0100 Generate trModule after typechecking types >--------------------------------------------------------------- e405eb1541c9e8a9ff3be21bb1036b00665def17 compiler/typecheck/TcRnDriver.hs | 22 ++++++++++++---------- 1 file changed, 12 insertions(+), 10 deletions(-) diff --git a/compiler/typecheck/TcRnDriver.hs b/compiler/typecheck/TcRnDriver.hs index b483b84..f40c941 100644 --- a/compiler/typecheck/TcRnDriver.hs +++ b/compiler/typecheck/TcRnDriver.hs @@ -471,21 +471,23 @@ tcRnSrcDecls :: Bool -- False => no 'module M(..) where' header at all -- Returns the variables free in the decls -- Reason: solely to report unused imports and bindings tcRnSrcDecls explicit_mod_hdr decls - = do { -- Create a binding for $trModule - -- Do this before processing any data type declarations, - -- which need tcg_tr_module to be initialised - ; tcg_env <- mkModIdBindings - ; tcg_env <- setGblEnv tcg_env mkPrimTypeableBinds - - -- Do all the declarations - ; ((tcg_env, tcl_env), lie) <- setGblEnv tcg_env $ - captureConstraints $ + = do { -- Do all the declarations + ((tcg_env, tcl_env), lie) <- captureConstraints $ do { (tcg_env, tcl_env) <- tc_rn_src_decls decls ; ; tcg_env <- setEnvs (tcg_env, tcl_env) $ checkMain explicit_mod_hdr ; return (tcg_env, tcl_env) } ; setEnvs (tcg_env, tcl_env) $ do { + ; traceTc "Tc9" empty + + -- Create a binding for $trModule + -- Do this before processing any data type declarations, + -- which need tcg_tr_module to be initialised + ; tcg_env <- mkModIdBindings + ; tcg_env <- setGblEnv tcg_env mkPrimTypeableBinds + ; setGblEnv tcg_env $ do { + #ifdef GHCI ; finishTH #endif /* GHCI */ @@ -544,7 +546,7 @@ tcRnSrcDecls explicit_mod_hdr decls ; setGlobalTypeEnv tcg_env' final_type_env - } } + } } } tc_rn_src_decls :: [LHsDecl RdrName] -> TcM (TcGblEnv, TcLclEnv) From git at git.haskell.org Fri Feb 12 12:33:14 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 12 Feb 2016 12:33:14 +0000 (UTC) Subject: [commit: ghc] wip/typeable-unwired: Attempt to unwire Typeable representation types (a9936bf) Message-ID: <20160212123314.3133D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/typeable-unwired Link : http://ghc.haskell.org/trac/ghc/changeset/a9936bf03580c7d8768a581c7d1e006d22cd3dc0/ghc >--------------------------------------------------------------- commit a9936bf03580c7d8768a581c7d1e006d22cd3dc0 Author: Ben Gamari Date: Sat Jan 30 17:22:53 2016 +0100 Attempt to unwire Typeable representation types >--------------------------------------------------------------- a9936bf03580c7d8768a581c7d1e006d22cd3dc0 compiler/prelude/PrelNames.hs | 22 +++++++ compiler/prelude/TysWiredIn.hs | 62 +----------------- compiler/typecheck/TcTypeable.hs | 135 ++++++++++++++++++++++++--------------- libraries/ghc-prim/GHC/Types.hs | 2 +- 4 files changed, 106 insertions(+), 115 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 a9936bf03580c7d8768a581c7d1e006d22cd3dc0 From git at git.haskell.org Fri Feb 12 13:19:17 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 12 Feb 2016 13:19:17 +0000 (UTC) Subject: [commit: ghc] wip/typeable-unwired: Move TyCon generation out of tcAddImplicits (29a47ea) Message-ID: <20160212131917.0CEF63A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/typeable-unwired Link : http://ghc.haskell.org/trac/ghc/changeset/29a47ea6ba125b1e609408edc4ab28d8a858d49f/ghc >--------------------------------------------------------------- commit 29a47ea6ba125b1e609408edc4ab28d8a858d49f Author: Ben Gamari Date: Fri Feb 12 14:11:41 2016 +0100 Move TyCon generation out of tcAddImplicits >--------------------------------------------------------------- 29a47ea6ba125b1e609408edc4ab28d8a858d49f compiler/typecheck/TcRnDriver.hs | 7 ++++++- compiler/typecheck/TcTyDecls.hs | 6 +----- 2 files changed, 7 insertions(+), 6 deletions(-) diff --git a/compiler/typecheck/TcRnDriver.hs b/compiler/typecheck/TcRnDriver.hs index f40c941..8d0d6ce 100644 --- a/compiler/typecheck/TcRnDriver.hs +++ b/compiler/typecheck/TcRnDriver.hs @@ -71,7 +71,7 @@ import TcType import MkIface import TcSimplify import TcTyClsDecls -import TcTypeable( mkModIdBindings, mkPrimTypeableBinds ) +import TcTypeable( mkModIdBindings, mkTypeableBinds, mkPrimTypeableBinds ) import LoadIface import TidyPgm ( mkBootModDetailsTc ) import RnNames @@ -485,7 +485,12 @@ tcRnSrcDecls explicit_mod_hdr decls -- Do this before processing any data type declarations, -- which need tcg_tr_module to be initialised ; tcg_env <- mkModIdBindings + -- Now we can generate the TyCon representations ; tcg_env <- setGblEnv tcg_env mkPrimTypeableBinds + ; tcg_env <- setGblEnv tcg_env $ + let tycons = typeEnvTyCons $ tcg_type_env tcg_env + in mkTypeableBinds tycons + ; setGblEnv tcg_env $ do { #ifdef GHCI diff --git a/compiler/typecheck/TcTyDecls.hs b/compiler/typecheck/TcTyDecls.hs index 314e20c..dce33d3 100644 --- a/compiler/typecheck/TcTyDecls.hs +++ b/compiler/typecheck/TcTyDecls.hs @@ -30,7 +30,6 @@ module TcTyDecls( import TcRnMonad import TcEnv -import TcTypeable( mkTypeableBinds ) import TcBinds( tcRecSelBinds ) import TyCoRep( Type(..), TyBinder(..), delBinderVar ) import TcType @@ -863,10 +862,7 @@ tcAddImplicits tycons do { traceTc "tcAddImplicits" $ vcat [ text "tycons" <+> ppr tycons , text "implicits" <+> ppr implicit_things ] - ; gbl_env <- mkTypeableBinds tycons - ; gbl_env <- setGblEnv gbl_env $ - tcRecSelBinds (mkRecSelBinds tycons) - ; return gbl_env } + ; tcRecSelBinds (mkRecSelBinds tycons) } where implicit_things = concatMap implicitTyConThings tycons def_meth_ids = mkDefaultMethodIds tycons From git at git.haskell.org Fri Feb 12 14:24:30 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 12 Feb 2016 14:24:30 +0000 (UTC) Subject: [commit: ghc] master: Add IsList instance for CallStack, restore Show instance for CallStack (be3d7f6) Message-ID: <20160212142430.C21693A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/be3d7f661968a7b8c6751c0be3bf23e703b32c3e/ghc >--------------------------------------------------------------- commit be3d7f661968a7b8c6751c0be3bf23e703b32c3e Author: RyanGlScott Date: Fri Feb 12 09:24:38 2016 -0500 Add IsList instance for CallStack, restore Show instance for CallStack Summary: Ties up loose ends from D1894. GHC 7.10.2 and 7.10.3 featured a `Show` instance for `CallStack`, but since it was derived, it broke encapsulation. This adds a `Show` instance which displays the `CallStack` as if it were a `[(String, SrcLoc)]`. To ensure that the output of `Show` is technically a valid Haskell term, we also add a corresponding `IsList CallStack` instance. Reviewers: gridaphobe, austin, hvr, bgamari Reviewed By: gridaphobe, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1903 >--------------------------------------------------------------- be3d7f661968a7b8c6751c0be3bf23e703b32c3e libraries/base/GHC/Exception.hs | 4 ++-- libraries/base/GHC/Exts.hs | 9 +++++++++ libraries/base/GHC/Show.hs | 3 +++ libraries/base/GHC/Stack.hs | 4 ++-- libraries/base/GHC/Stack/Types.hs | 9 ++++++++- libraries/base/changelog.md | 9 ++++++++- 6 files changed, 32 insertions(+), 6 deletions(-) diff --git a/libraries/base/GHC/Exception.hs b/libraries/base/GHC/Exception.hs index ad50cec..be9e6f9 100644 --- a/libraries/base/GHC/Exception.hs +++ b/libraries/base/GHC/Exception.hs @@ -28,8 +28,8 @@ module GHC.Exception , divZeroException, overflowException, ratioZeroDenomException , errorCallException, errorCallWithCallStackException -- re-export CallStack and SrcLoc from GHC.Types - , CallStack, getCallStack, prettyCallStack, prettyCallStackLines - , showCCSStack + , CallStack, fromCallSiteList, getCallStack, prettyCallStack + , prettyCallStackLines, showCCSStack , SrcLoc(..), prettySrcLoc ) where diff --git a/libraries/base/GHC/Exts.hs b/libraries/base/GHC/Exts.hs index dc943e0..31e70eb 100755 --- a/libraries/base/GHC/Exts.hs +++ b/libraries/base/GHC/Exts.hs @@ -191,3 +191,12 @@ instance IsList Version where type (Item Version) = Int fromList = makeVersion toList = versionBranch + +-- | Be aware that 'fromList . toList = id' only for unfrozen 'CallStack's, +-- since 'toList' removes frozenness information. +-- +-- @since 4.9.0.0 +instance IsList CallStack where + type (Item CallStack) = (String, SrcLoc) + fromList = fromCallSiteList + toList = getCallStack diff --git a/libraries/base/GHC/Show.hs b/libraries/base/GHC/Show.hs index a3807bb..72a7320 100644 --- a/libraries/base/GHC/Show.hs +++ b/libraries/base/GHC/Show.hs @@ -205,6 +205,9 @@ instance Show TrName where instance Show Module where showsPrec _ (Module p m) = shows p . (':' :) . shows m +instance Show CallStack where + showsPrec _ = shows . getCallStack + deriving instance Show SrcLoc -------------------------------------------------------------- diff --git a/libraries/base/GHC/Stack.hs b/libraries/base/GHC/Stack.hs index 477dcdc..5f2034e 100644 --- a/libraries/base/GHC/Stack.hs +++ b/libraries/base/GHC/Stack.hs @@ -25,8 +25,8 @@ module GHC.Stack ( -- * HasCallStack call stacks CallStack, HasCallStack, callStack, emptyCallStack, freezeCallStack, - getCallStack, popCallStack, prettyCallStack, pushCallStack, - withFrozenCallStack, + fromCallSiteList, getCallStack, popCallStack, prettyCallStack, + pushCallStack, withFrozenCallStack, -- * Source locations SrcLoc(..), prettySrcLoc, diff --git a/libraries/base/GHC/Stack/Types.hs b/libraries/base/GHC/Stack/Types.hs index 35dfcb0..1fead13 100644 --- a/libraries/base/GHC/Stack/Types.hs +++ b/libraries/base/GHC/Stack/Types.hs @@ -28,7 +28,8 @@ module GHC.Stack.Types ( -- * Implicit call stacks CallStack(..), HasCallStack, - emptyCallStack, freezeCallStack, getCallStack, pushCallStack, + emptyCallStack, freezeCallStack, fromCallSiteList, + getCallStack, pushCallStack, -- * Source locations SrcLoc(..) @@ -148,6 +149,12 @@ getCallStack stk = case stk of PushCallStack cs stk' -> cs : getCallStack stk' FreezeCallStack stk' -> getCallStack stk' +-- | Convert a list of call-sites to a 'CallStack'. +-- +-- @since 4.9.0.0 +fromCallSiteList :: [([Char], SrcLoc)] -> CallStack +fromCallSiteList (c:cs) = PushCallStack c (fromCallSiteList cs) +fromCallSiteList [] = EmptyCallStack -- Note [Definition of CallStack] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ diff --git a/libraries/base/changelog.md b/libraries/base/changelog.md index 7f85f35..7f2f2d3 100644 --- a/libraries/base/changelog.md +++ b/libraries/base/changelog.md @@ -13,7 +13,9 @@ * New `GHC.Generics.packageName` operation - * New `GHC.Stack.CallStack` data type + * Redesigned `GHC.Stack.CallStack` data type. As a result, `CallStack`'s + `Show` instance produces different output, and `CallStack` no longer has an + `Eq` instance. * New `GHC.Generics.packageName` operation @@ -26,6 +28,9 @@ * New `GHC.Stack.Types.pushCallStack` function pushes a call-site onto a `CallStack` + * New `GHC.Stack.Types.fromCallSiteList` function creates a `CallStack` from + a list of call-sites (i.e., `[(String, SrcLoc)]`) + * `GHC.SrcLoc` has been removed * `GHC.Stack.showCallStack` and `GHC.SrcLoc.showSrcLoc` are now called @@ -133,6 +138,8 @@ * Add `MonadPlus IO` and `Alternative IO` instances (previously orphans in `transformers`) (#10755) + * `CallStack` now has an `IsList` instance + ### Generalizations * Generalize `Debug.Trace.{traceM, traceShowM}` from `Monad` to `Applicative` From git at git.haskell.org Fri Feb 12 14:52:38 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 12 Feb 2016 14:52:38 +0000 (UTC) Subject: [commit: ghc] master: Revert "Build the substitution correctly in piResultTy" (f3b9db3) Message-ID: <20160212145238.C73F63A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f3b9db31e099836420fbf88eaa36f6fe3d6b85b5/ghc >--------------------------------------------------------------- commit f3b9db31e099836420fbf88eaa36f6fe3d6b85b5 Author: Bartosz Nitka Date: Fri Feb 12 06:38:29 2016 -0800 Revert "Build the substitution correctly in piResultTy" This reverts commit dbf72dbc6e49b3db7f2337a7a41e95c1d0169163. This commit introduced performance regressions: https://ghc.haskell.org/trac/ghc/ticket/11371#comment:27, I will push it again after I fix it. Test Plan: revert Reviewers: simonpj, bgamari, simonmar, austin, goldfire, thomie Differential Revision: https://phabricator.haskell.org/D1907 >--------------------------------------------------------------- f3b9db31e099836420fbf88eaa36f6fe3d6b85b5 compiler/types/Type.hs | 26 ++++++-------------------- 1 file changed, 6 insertions(+), 20 deletions(-) diff --git a/compiler/types/Type.hs b/compiler/types/Type.hs index a649700..67365e3 100644 --- a/compiler/types/Type.hs +++ b/compiler/types/Type.hs @@ -801,29 +801,15 @@ funResultTy ty = piResultTy ty (pprPanic "funResultTy" (ppr ty)) -- | Essentially 'funResultTy' on kinds handling pi-types too piResultTy :: Type -> Type -> Type -piResultTy ty arg = piResultTys ty [arg] +piResultTy ty arg | Just ty' <- coreView ty = piResultTy ty' arg +piResultTy (ForAllTy (Anon _) res) _ = res +piResultTy (ForAllTy (Named tv _) res) arg = substTyWithUnchecked [tv] [arg] res +piResultTy ty arg = pprPanic "piResultTy" + (ppr ty $$ ppr arg) -- | Fold 'piResultTy' over many types piResultTys :: Type -> [Type] -> Type -piResultTys ty args = go empty_subst ty args - where - empty_subst = mkEmptyTCvSubst (mkInScopeSet $ tyCoVarsOfTypes (ty:args)) - -- The free vars of 'ty' and 'args' need to be in scope to satisfy the - -- invariant in Note [The substitution invariant] in TyCoRep. - - go subst ty [] = substTy subst ty - go subst ty args@(arg:args') - | Just (bndr, res) <- splitPiTy_maybe ty - = case bndr of - Anon _ -> go subst res args' - Named tv _ -> go (extendTCvSubst subst tv arg) res args' - - | Just tv <- getTyVar_maybe ty - -- Deals with piResultTys (forall a. a) [forall b.b, Int] - = go empty_subst (substTyVar subst tv) args - - | otherwise - = panic "piResultTys" +piResultTys = foldl piResultTy funArgTy :: Type -> Type -- ^ Extract the function argument type and panic if that is not possible From git at git.haskell.org Fri Feb 12 17:35:38 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 12 Feb 2016 17:35:38 +0000 (UTC) Subject: [commit: ghc] master: Improve pretty-printing of HsWrappers (d084624) Message-ID: <20160212173538.A24AA3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d0846243747213218cba856d5c322016bd3e6d9e/ghc >--------------------------------------------------------------- commit d0846243747213218cba856d5c322016bd3e6d9e Author: Simon Peyton Jones Date: Fri Feb 12 13:42:55 2016 +0000 Improve pretty-printing of HsWrappers Reduces un-neede parens. Also -fprint-typechecker-elaboration now makes type applications and casts in expressions also appear. (Previously those were confusingly controlled by -fprint-explicit-coercions.) >--------------------------------------------------------------- d0846243747213218cba856d5c322016bd3e6d9e compiler/hsSyn/HsExpr.hs | 40 +++++++++++++---------- compiler/hsSyn/HsPat.hs | 22 ++++++++----- compiler/typecheck/TcEvidence.hs | 40 ++++++++++++----------- compiler/typecheck/TcExpr.hs | 6 ++-- compiler/typecheck/TcSplice.hs | 2 +- testsuite/tests/roles/should_compile/T8958.stderr | 10 +++--- 6 files changed, 64 insertions(+), 56 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 d0846243747213218cba856d5c322016bd3e6d9e From git at git.haskell.org Fri Feb 12 17:35:41 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 12 Feb 2016 17:35:41 +0000 (UTC) Subject: [commit: ghc] master: User manual improvments (6cf9b06) Message-ID: <20160212173541.819133A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6cf9b06fd193867bf4964eff4317479b9e25fca5/ghc >--------------------------------------------------------------- commit 6cf9b06fd193867bf4964eff4317479b9e25fca5 Author: Simon Peyton Jones Date: Fri Feb 12 14:38:22 2016 +0000 User manual improvments - Document that you can use 'forall' in instance decls - Change the sections a bit, so that big sections (like lexically scoped type variables, pattern synonyms, implicit parameters) become more visible >--------------------------------------------------------------- 6cf9b06fd193867bf4964eff4317479b9e25fca5 docs/users_guide/glasgow_exts.rst | 6894 +++++++++++++++++++------------------ 1 file changed, 3453 insertions(+), 3441 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 6cf9b06fd193867bf4964eff4317479b9e25fca5 From git at git.haskell.org Fri Feb 12 17:35:44 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 12 Feb 2016 17:35:44 +0000 (UTC) Subject: [commit: ghc] master: Beef up tc124 (1251518) Message-ID: <20160212173544.3AB343A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/125151870de63de4a227afc2c1e38802009bc7e5/ghc >--------------------------------------------------------------- commit 125151870de63de4a227afc2c1e38802009bc7e5 Author: Simon Peyton Jones Date: Fri Feb 12 13:41:39 2016 +0000 Beef up tc124 Makes it a slightly more stringent test of record pattern bindings >--------------------------------------------------------------- 125151870de63de4a227afc2c1e38802009bc7e5 testsuite/tests/typecheck/should_compile/tc124.hs | 14 ++++++++++---- 1 file changed, 10 insertions(+), 4 deletions(-) diff --git a/testsuite/tests/typecheck/should_compile/tc124.hs b/testsuite/tests/typecheck/should_compile/tc124.hs index 658b29c..a832cd3 100644 --- a/testsuite/tests/typecheck/should_compile/tc124.hs +++ b/testsuite/tests/typecheck/should_compile/tc124.hs @@ -7,13 +7,19 @@ module Foo where -data T = T { t1 :: forall a. a -> a , t2 :: forall a b. a->b->b } +data T = T { t1 :: forall a. a -> a + , t2 :: forall b c. b->c->c } -- Test pattern bindings for polymorphic fields -f :: T -> (Int,Char) -f t = let T { t1 = my_t1 } = t +f :: T -> (Int,Char, Char) +f t = let T { t1 = my_t1, t2 = my_t2 } = t in - (my_t1 3, my_t1 'c') + (my_t1 3, my_t1 'c', my_t2 2 'c') + +f2 :: T -> (Int,Char, Char) +f2 t = let T { t1 = my_t1, t2 = my_t2 } = t + in + (my_t1 3, my_t1 'c', my_t2 2 'c') -- Test record update with polymorphic fields g :: T -> T From git at git.haskell.org Fri Feb 12 17:35:46 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 12 Feb 2016 17:35:46 +0000 (UTC) Subject: [commit: ghc] master: Minor refactoring to tauifyMultipleMatches (24305be) Message-ID: <20160212173546.ED6643A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/24305bead969fdf85be8b8f4a42cd88ad21a7e16/ghc >--------------------------------------------------------------- commit 24305bead969fdf85be8b8f4a42cd88ad21a7e16 Author: Simon Peyton Jones Date: Fri Feb 12 13:44:44 2016 +0000 Minor refactoring to tauifyMultipleMatches No change in behaviour >--------------------------------------------------------------- 24305bead969fdf85be8b8f4a42cd88ad21a7e16 compiler/typecheck/TcMType.hs | 7 +++++++ compiler/typecheck/TcMatches.hs | 24 ++++++++---------------- 2 files changed, 15 insertions(+), 16 deletions(-) diff --git a/compiler/typecheck/TcMType.hs b/compiler/typecheck/TcMType.hs index adb4e5a..e4c8b4b 100644 --- a/compiler/typecheck/TcMType.hs +++ b/compiler/typecheck/TcMType.hs @@ -32,6 +32,7 @@ module TcMType ( ExpType(..), ExpSigmaType, ExpRhoType, mkCheckExpType, newOpenInferExpType, readExpType, readExpType_maybe, writeExpType, expTypeToType, checkingExpType_maybe, checkingExpType, + tauifyExpType, -------------------------------- -- Creating fresh type variables for pm checking @@ -386,6 +387,12 @@ checkingExpType :: String -> ExpType -> TcType checkingExpType _ (Check ty) = ty checkingExpType err et = pprPanic "checkingExpType" (text err $$ ppr et) +tauifyExpType :: ExpType -> TcM ExpType +-- ^ Turn a (Infer hole) type into a (Check alpha), +-- where alpha is a fresh unificaiton variable +tauifyExpType exp_ty = do { ty <- expTypeToType exp_ty + ; return (Check ty) } + -- | Extracts the expected type if there is one, or generates a new -- TauTv if there isn't. expTypeToType :: ExpType -> TcM TcType diff --git a/compiler/typecheck/TcMatches.hs b/compiler/typecheck/TcMatches.hs index e7da8ad..5f3bc5b 100644 --- a/compiler/typecheck/TcMatches.hs +++ b/compiler/typecheck/TcMatches.hs @@ -90,9 +90,7 @@ tcMatchesFun fun_name matches exp_ty <- matchExpectedFunTys herald arity exp_rho $ \ pat_tys rhs_ty -> -- See Note [Case branches must never infer a non-tau type] - do { rhs_ty : pat_tys - <- mapM (tauifyMultipleMatches matches) - (rhs_ty : pat_tys) + do { rhs_ty:pat_tys <- tauifyMultipleMatches matches (rhs_ty:pat_tys) ; tcMatches match_ctxt pat_tys rhs_ty matches } ; return (wrap_fun, matches') } ; return (wrap_gen <.> wrap_fun, group) } @@ -117,7 +115,7 @@ tcMatchesCase :: (Outputable (body Name)) => -- wrapper goes from MatchGroup's ty to expected ty tcMatchesCase ctxt scrut_ty matches res_ty - = do { res_ty <- tauifyMultipleMatches matches res_ty + = do { [res_ty] <- tauifyMultipleMatches matches [res_ty] ; tcMatches ctxt [mkCheckExpType scrut_ty] res_ty matches } tcMatchLambda :: SDoc -- see Note [Herald for matchExpectedFunTys] in TcUnify @@ -130,8 +128,7 @@ tcMatchLambda herald match_ctxt match res_ty = do { ((match', pat_tys), wrap) <- matchExpectedFunTys herald n_pats res_ty $ \ pat_tys rhs_ty -> - do { rhs_ty : pat_tys <- mapM (tauifyMultipleMatches match) - (rhs_ty : pat_tys) + do { rhs_ty:pat_tys <- tauifyMultipleMatches match (rhs_ty:pat_tys) ; match' <- tcMatches match_ctxt pat_tys rhs_ty match ; pat_tys <- mapM readExpType pat_tys ; return (match', pat_tys) } @@ -192,16 +189,11 @@ still gets assigned a polytype. -- expected type into TauTvs. -- See Note [Case branches must never infer a non-tau type] tauifyMultipleMatches :: MatchGroup id body - -> ExpType - -> TcM ExpType -tauifyMultipleMatches group exp_ty - | isSingletonMatchGroup group - = return exp_ty - - | otherwise - = mkCheckExpType <$> expTypeToType exp_ty - -- NB: This also ensures that an empty match still fills in the - -- ExpType + -> [ExpType] -> TcM [ExpType] +tauifyMultipleMatches group exp_tys + | isSingletonMatchGroup group = return exp_tys + | otherwise = mapM tauifyExpType exp_tys + -- NB: In the empty-match case, this ensures we fill in the ExpType -- | Type-check a MatchGroup. If there are multiple RHSs, the expected type -- must already be tauified. From git at git.haskell.org Fri Feb 12 17:35:49 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 12 Feb 2016 17:35:49 +0000 (UTC) Subject: [commit: ghc] master: Simplify AbsBinds wrapping (c6485d5) Message-ID: <20160212173549.F059C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c6485d5e6daec20c8ff66d6e721d3e0a5f3156ac/ghc >--------------------------------------------------------------- commit c6485d5e6daec20c8ff66d6e721d3e0a5f3156ac Author: Simon Peyton Jones Date: Fri Feb 12 13:36:17 2016 +0000 Simplify AbsBinds wrapping In poking Trac #11414 I found myself sinking into the abe_inst_wrap swamp. What is this strange thing? (It turned out that #11414 was breaking because of it.) Thrillingly, I found a way to sweep it away again, putting the deep instantation into tcMonoBinds instead of mkExport; and it turned out that the fun_co_fn field of FunBind was already there ready to receive exactly this wrapper. Hooray. Result * Death to abe_inst_wrap * Death to mbi_orig * Death to the plumbing in tcPolyInfer that did the deep instantiation I did find that I had to re-engineer the treatment of instance type signatures (again), but the result looks more modular and robust to me. And #11414 is fixed. >--------------------------------------------------------------- c6485d5e6daec20c8ff66d6e721d3e0a5f3156ac compiler/deSugar/DsBinds.hs | 54 ++++---- compiler/hsSyn/HsBinds.hs | 38 +----- compiler/typecheck/TcBinds.hs | 187 ++++++++++----------------- compiler/typecheck/TcClassDcl.hs | 1 - compiler/typecheck/TcHsSyn.hs | 5 +- compiler/typecheck/TcInstDcls.hs | 151 +++++++++++---------- testsuite/tests/deSugar/should_compile/all.T | 2 +- 7 files changed, 186 insertions(+), 252 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 c6485d5e6daec20c8ff66d6e721d3e0a5f3156ac From git at git.haskell.org Fri Feb 12 17:46:17 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 12 Feb 2016 17:46:17 +0000 (UTC) Subject: [commit: ghc] master: testsuite: tweak error messages for new Show instance (f37bb54) Message-ID: <20160212174617.2EB723A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f37bb548157dae1e8c59d054c488b905c0f5abe0/ghc >--------------------------------------------------------------- commit f37bb548157dae1e8c59d054c488b905c0f5abe0 Author: Sergei Trofimovich Date: Fri Feb 12 17:43:18 2016 +0000 testsuite: tweak error messages for new Show instance be3d7f661968a7b8c6751c0be3bf23e703b32c3e added Show instance for Callstack. That made a couple of error messages to drift as: instance Show Ordering -- Defined in ?GHC.Show? instance Show Integer -- Defined in ?GHC.Show? ...plus 23 others - ...plus 20 instances involving out-of-scope types + ...plus 21 instances involving out-of-scope types Signed-off-by: Sergei Trofimovich >--------------------------------------------------------------- f37bb548157dae1e8c59d054c488b905c0f5abe0 testsuite/tests/ghci.debugger/scripts/break006.stderr | 4 ++-- testsuite/tests/ghci.debugger/scripts/print019.stderr | 2 +- .../tests/overloadedlists/should_fail/overloadedlistsfail01.stderr | 4 ++-- testsuite/tests/typecheck/should_compile/holes2.stderr | 2 +- testsuite/tests/typecheck/should_fail/tcfail133.stderr | 2 +- 5 files changed, 7 insertions(+), 7 deletions(-) diff --git a/testsuite/tests/ghci.debugger/scripts/break006.stderr b/testsuite/tests/ghci.debugger/scripts/break006.stderr index 68fa3bd..79656bc 100644 --- a/testsuite/tests/ghci.debugger/scripts/break006.stderr +++ b/testsuite/tests/ghci.debugger/scripts/break006.stderr @@ -10,7 +10,7 @@ instance Show Ordering -- Defined in ?GHC.Show? instance Show Integer -- Defined in ?GHC.Show? ...plus 23 others - ...plus 20 instances involving out-of-scope types + ...plus 21 instances involving out-of-scope types (use -fprint-potential-instances to see them all) ? In a stmt of an interactive GHCi command: print it @@ -25,6 +25,6 @@ instance Show Ordering -- Defined in ?GHC.Show? instance Show Integer -- Defined in ?GHC.Show? ...plus 23 others - ...plus 20 instances involving out-of-scope types + ...plus 21 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/ghci.debugger/scripts/print019.stderr b/testsuite/tests/ghci.debugger/scripts/print019.stderr index e9f9d53..2282681 100644 --- a/testsuite/tests/ghci.debugger/scripts/print019.stderr +++ b/testsuite/tests/ghci.debugger/scripts/print019.stderr @@ -9,6 +9,6 @@ instance Show Ordering -- Defined in ?GHC.Show? instance Show Integer -- Defined in ?GHC.Show? ...plus 30 others - ...plus 9 instances involving out-of-scope types + ...plus 10 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/overloadedlists/should_fail/overloadedlistsfail01.stderr b/testsuite/tests/overloadedlists/should_fail/overloadedlistsfail01.stderr index 56934ab..0faaaec 100644 --- a/testsuite/tests/overloadedlists/should_fail/overloadedlistsfail01.stderr +++ b/testsuite/tests/overloadedlists/should_fail/overloadedlistsfail01.stderr @@ -8,7 +8,7 @@ overloadedlistsfail01.hs:5:8: error: instance Show Integer -- Defined in ?GHC.Show? instance Show a => Show (Maybe a) -- Defined in ?GHC.Show? ...plus 22 others - ...plus five instances involving out-of-scope types + ...plus six instances involving out-of-scope types (use -fprint-potential-instances to see them all) ? In the expression: print [1] In an equation for ?main?: main = print [1] @@ -19,7 +19,7 @@ overloadedlistsfail01.hs:5:14: error: Probable fix: use a type annotation to specify what ?a0? should be. These potential instances exist: instance GHC.Exts.IsList [a] -- Defined in ?GHC.Exts? - ...plus one instance involving out-of-scope types + ...plus two instances involving out-of-scope types (use -fprint-potential-instances to see them all) ? In the first argument of ?print?, namely ?[1]? In the expression: print [1] diff --git a/testsuite/tests/typecheck/should_compile/holes2.stderr b/testsuite/tests/typecheck/should_compile/holes2.stderr index 00fb9ff..08d1b46 100644 --- a/testsuite/tests/typecheck/should_compile/holes2.stderr +++ b/testsuite/tests/typecheck/should_compile/holes2.stderr @@ -8,7 +8,7 @@ holes2.hs:3:5: warning: instance Show Integer -- Defined in ?GHC.Show? instance Show a => Show (Maybe a) -- Defined in ?GHC.Show? ...plus 22 others - ...plus four instances involving out-of-scope types + ...plus five instances involving out-of-scope types (use -fprint-potential-instances to see them all) ? In the expression: show _ In an equation for ?f?: f = show _ diff --git a/testsuite/tests/typecheck/should_fail/tcfail133.stderr b/testsuite/tests/typecheck/should_fail/tcfail133.stderr index 0fb4973..72dc14e 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail133.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail133.stderr @@ -12,7 +12,7 @@ tcfail133.hs:68:7: error: instance (Show a, Show b, Number a, Digit b) => Show (a :@ b) -- Defined at tcfail133.hs:11:54 ...plus 25 others - ...plus four instances involving out-of-scope types + ...plus five instances involving out-of-scope types (use -fprint-potential-instances to see them all) ? In the expression: show $ add (One :@ Zero) (One :@ One) In an equation for ?foo?: From git at git.haskell.org Sun Feb 14 19:51:32 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 14 Feb 2016 19:51:32 +0000 (UTC) Subject: [commit: ghc] master: renamer discards name location for HsRecField (cd4a7d0) Message-ID: <20160214195132.1B8B73A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/cd4a7d07890fa53c455c14f22c2d30c22b64a396/ghc >--------------------------------------------------------------- commit cd4a7d07890fa53c455c14f22c2d30c22b64a396 Author: Alan Zimmerman Date: Sun Feb 14 21:43:55 2016 +0200 renamer discards name location for HsRecField When renaming a HsVar it can be converted to a HsRecField. In the process the location of the enclosed name is converted to a noLoc Closes #11576 >--------------------------------------------------------------- cd4a7d07890fa53c455c14f22c2d30c22b64a396 compiler/rename/RnExpr.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/compiler/rename/RnExpr.hs b/compiler/rename/RnExpr.hs index e88f1e0..69b8d6e 100644 --- a/compiler/rename/RnExpr.hs +++ b/compiler/rename/RnExpr.hs @@ -108,8 +108,9 @@ rnExpr (HsVar (L l v)) | otherwise -> finishHsVar (L l name) ; - Just (Right [f]) -> return (HsRecFld (ambiguousFieldOcc f) - , unitFV (selectorFieldOcc f)) ; + Just (Right [f@(FieldOcc (L _ fn) s)]) -> + return (HsRecFld (ambiguousFieldOcc (FieldOcc (L l fn) s)) + , unitFV (selectorFieldOcc f)) ; Just (Right fs@(_:_:_)) -> return (HsRecFld (Ambiguous (L l v) PlaceHolder) , mkFVs (map selectorFieldOcc fs)); From git at git.haskell.org Sun Feb 14 22:19:05 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 14 Feb 2016 22:19:05 +0000 (UTC) Subject: [commit: packages/directory] tag 'v1.2.5.1' created Message-ID: <20160214221905.6C0713A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/directory New tag : v1.2.5.1 Referencing: 9f56591bcfa874cc89e181df95c11d4599fda9a8 From git at git.haskell.org Sun Feb 14 22:19:07 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 14 Feb 2016 22:19:07 +0000 (UTC) Subject: [commit: packages/directory] master: Relax upper bound to allow new time-1.6 release (5696798) Message-ID: <20160214221907.72BE83A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/directory On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5696798a0adbf3401688f223fe64a4aa6378e87b/directory >--------------------------------------------------------------- commit 5696798a0adbf3401688f223fe64a4aa6378e87b Author: Herbert Valerio Riedel Date: Sun Dec 20 10:12:05 2015 +0100 Relax upper bound to allow new time-1.6 release NB: We don't need a `directory` patch-level release right away, we can wait till GHC 8.0.1 final gets cut in 2 months. >--------------------------------------------------------------- 5696798a0adbf3401688f223fe64a4aa6378e87b directory.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/directory.cabal b/directory.cabal index 30fcce8..d112a77 100644 --- a/directory.cabal +++ b/directory.cabal @@ -60,7 +60,7 @@ Library build-depends: base >= 4.5 && < 4.10, - time >= 1.4 && < 1.6, + time >= 1.4 && < 1.7, filepath >= 1.3 && < 1.5 if os(windows) build-depends: Win32 >= 2.2.2 && < 2.4 From git at git.haskell.org Sun Feb 14 22:19:09 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 14 Feb 2016 22:19:09 +0000 (UTC) Subject: [commit: packages/directory] master: Improve error message of getCurrentDirectory when cwd no longer exists (dccac6b) Message-ID: <20160214221909.7A6803A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/directory On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/dccac6b66068d7f6aba4743ee9b18e360867712e/directory >--------------------------------------------------------------- commit dccac6b66068d7f6aba4743ee9b18e360867712e Author: Phil Ruffwind Date: Sun Jan 3 15:58:36 2016 -0500 Improve error message of getCurrentDirectory when cwd no longer exists Fixes #39. >--------------------------------------------------------------- dccac6b66068d7f6aba4743ee9b18e360867712e System/Directory.hs | 19 ++++++++++++++++--- 1 file changed, 16 insertions(+), 3 deletions(-) diff --git a/System/Directory.hs b/System/Directory.hs index 511b7c4..d67a249 100644 --- a/System/Directory.hs +++ b/System/Directory.hs @@ -1070,11 +1070,17 @@ listDirectory path = -- #ifdef __GLASGOW_HASKELL__ getCurrentDirectory :: IO FilePath -getCurrentDirectory = do +getCurrentDirectory = + modifyIOError (`ioeSetLocation` "getCurrentDirectory") $ + specializeErrorString + "Current working directory no longer exists" + isDoesNotExistError + getCwd + where #ifdef mingw32_HOST_OS - Win32.getCurrentDirectory + getCwd = Win32.getCurrentDirectory #else - Posix.getWorkingDirectory + getCwd = Posix.getWorkingDirectory #endif -- | Change the working directory to the given path. @@ -1499,6 +1505,13 @@ tryIOErrorType check action = do Right val -> return (Right val) #endif +specializeErrorString :: String -> (IOError -> Bool) -> IO a -> IO a +specializeErrorString str errType action = do + mx <- tryIOErrorType errType action + case mx of + Left e -> ioError (ioeSetErrorString e str) + Right x -> return x + -- | Obtain the path to a special directory for storing user-specific -- application data (traditional Unix location). Except for backward -- compatibility reasons, newer applications may prefer the the From git at git.haskell.org Sun Feb 14 22:19:11 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 14 Feb 2016 22:19:11 +0000 (UTC) Subject: [commit: packages/directory] master: Fix trailing path sep behavior of canonicalizePath and makeAbsolute (67c18f0) Message-ID: <20160214221911.82A823A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/directory On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/67c18f0be0f3f94d0deed1aa13a4423e816fb13d/directory >--------------------------------------------------------------- commit 67c18f0be0f3f94d0deed1aa13a4423e816fb13d Author: Phil Ruffwind Date: Mon Feb 8 06:54:53 2016 -0500 Fix trailing path sep behavior of canonicalizePath and makeAbsolute It used to be that `canonicalizePath "."` returned a path without a trailing slash, but now it does. This is due to the use of `normalise` in `makeAbsolute`, which adds extra slashes whenever `.` gets stripped out at the end. This commit restores the original behavior for `canonicalizePath`, and also affects `makeAbsolute` in a similar manner. Fixes #42. >--------------------------------------------------------------- 67c18f0be0f3f94d0deed1aa13a4423e816fb13d System/Directory.hs | 41 ++++++++++++++++++++++++++++------------- changelog.md | 10 ++++++++++ directory.cabal | 2 +- tests/CanonicalizePath.hs | 5 ++++- 4 files changed, 43 insertions(+), 15 deletions(-) diff --git a/System/Directory.hs b/System/Directory.hs index d67a249..0c6e830 100644 --- a/System/Directory.hs +++ b/System/Directory.hs @@ -828,13 +828,13 @@ canonicalizePath = \ path -> modifyIOError ((`ioeSetLocation` "canonicalizePath") . (`ioeSetFileName` path)) $ -- normalise does more stuff, like upper-casing the drive letter - normalise <$> (transform =<< makeAbsolute path) + normalise <$> (transform =<< prependCurrentDirectory path) where #if defined(mingw32_HOST_OS) transform path = Win32.getFullPathName path `catchIOError` \ _ -> return path #else - transform path = copySlash path <$> do + transform path = matchTrailingSeparator path <$> do encoding <- getFileSystemEncoding realpathPrefix encoding (reverse (zip prefixes suffixes)) path where segments = splitPath path @@ -856,25 +856,40 @@ canonicalizePath = \ path -> doesPathExist path = (Posix.getFileStatus path >> return True) `catchIOError` \ _ -> return False - - -- make sure trailing slash is preserved - copySlash path | hasTrailingPathSeparator path = addTrailingPathSeparator - | otherwise = id #endif --- | Make a path absolute by prepending the current directory (if it isn't --- already absolute) and applying 'normalise' to the result. +-- | Convert a (possibly) relative path into an absolute path. This is nearly +-- equivalent to prepending the current directory (if the path isn't already +-- absolute) and then applying 'normalise' to the result. The trailing path +-- separator, if any, is preserved during the process. -- -- If the path is already absolute, the operation never fails. Otherwise, the -- operation may fail with the same exceptions as 'getCurrentDirectory'. -- -- @since 1.2.2.0 makeAbsolute :: FilePath -> IO FilePath -makeAbsolute = (normalise <$>) . absolutize - where absolutize path -- avoid the call to `getCurrentDirectory` if we can - | isRelative path = ( path) . addTrailingPathSeparator <$> - getCurrentDirectory - | otherwise = return path +makeAbsolute path = + modifyIOError ((`ioeSetLocation` "makeAbsolute") . + (`ioeSetFileName` path)) $ + matchTrailingSeparator path . normalise <$> prependCurrentDirectory path + +prependCurrentDirectory :: FilePath -> IO FilePath +prependCurrentDirectory path = + modifyIOError ((`ioeSetLocation` "prependCurrentDirectory") . + (`ioeSetFileName` path)) $ + case path of + "" -> -- avoid trailing path separator + prependCurrentDirectory "." + _ -- avoid the call to `getCurrentDirectory` if we can + | isRelative path -> + ( path) . addTrailingPathSeparator <$> getCurrentDirectory + | otherwise -> + return path + +matchTrailingSeparator :: FilePath -> FilePath -> FilePath +matchTrailingSeparator path + | hasTrailingPathSeparator path = addTrailingPathSeparator + | otherwise = dropTrailingPathSeparator -- | 'makeRelative' the current directory. makeRelativeToCurrentDirectory :: FilePath -> IO FilePath diff --git a/changelog.md b/changelog.md index 13b6af3..6e9e984 100644 --- a/changelog.md +++ b/changelog.md @@ -1,6 +1,16 @@ Changelog for the [`directory`][1] package ========================================== +## 1.2.5.1 (February 2015) + + * Fix the behavior of trailing path separators in `canonicalizePath` as well + as `makeAbsolute` when applied to the current directory; they should now + match the behavior of `canonicalizePath` prior to 1.2.3.0 (when the bug + was introduced) + ([#42](https://github.com/haskell/directory/issues/42)) + + * Set the location in IO errors from `makeAbsolute`. + ## 1.2.5.0 (December 2015) * Add `listDirectory`, which is similar to `getDirectoryContents` diff --git a/directory.cabal b/directory.cabal index d112a77..5a58dcf 100644 --- a/directory.cabal +++ b/directory.cabal @@ -1,5 +1,5 @@ name: directory -version: 1.2.5.0 +version: 1.2.5.1 -- NOTE: Don't forget to update ./changelog.md license: BSD3 license-file: LICENSE diff --git a/tests/CanonicalizePath.hs b/tests/CanonicalizePath.hs index 4d05198..e9d3672 100644 --- a/tests/CanonicalizePath.hs +++ b/tests/CanonicalizePath.hs @@ -2,13 +2,16 @@ module CanonicalizePath where #include "util.inl" import System.Directory -import System.FilePath ((), normalise) +import System.FilePath ((), hasTrailingPathSeparator, normalise) main :: TestEnv -> IO () main _t = do + dot' <- canonicalizePath "./" dot <- canonicalizePath "." nul <- canonicalizePath "" T(expectEq) () dot nul + T(expect) dot (not (hasTrailingPathSeparator dot)) + T(expect) dot' (hasTrailingPathSeparator dot') writeFile "bar" "" bar <- canonicalizePath "bar" From git at git.haskell.org Sun Feb 14 22:19:13 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 14 Feb 2016 22:19:13 +0000 (UTC) Subject: [commit: packages/directory] master: tryIOErrorType needs to be defined on Windows too (7064e39) Message-ID: <20160214221913.897533A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/directory On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7064e39417a1fa8136b45fc858d0c2f47896e3db/directory >--------------------------------------------------------------- commit 7064e39417a1fa8136b45fc858d0c2f47896e3db Author: Phil Ruffwind Date: Tue Feb 9 22:00:08 2016 -0500 tryIOErrorType needs to be defined on Windows too >--------------------------------------------------------------- 7064e39417a1fa8136b45fc858d0c2f47896e3db System/Directory.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/System/Directory.hs b/System/Directory.hs index 0c6e830..4eb6303 100644 --- a/System/Directory.hs +++ b/System/Directory.hs @@ -1509,6 +1509,7 @@ lookupEnv name = do case env of Left _ -> return Nothing Right value -> return (Just value) +#endif -- | Similar to 'try' but only catches a specify kind of 'IOError' as -- specified by the predicate. @@ -1518,7 +1519,6 @@ tryIOErrorType check action = do case result of Left err -> if check err then return (Left err) else ioError err Right val -> return (Right val) -#endif specializeErrorString :: String -> (IOError -> Bool) -> IO a -> IO a specializeErrorString str errType action = do From git at git.haskell.org Sun Feb 14 22:19:15 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 14 Feb 2016 22:19:15 +0000 (UTC) Subject: [commit: packages/directory] master: Documentation improvements (1fc14e8) Message-ID: <20160214221915.91A163A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/directory On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1fc14e8218c08080e17adbc091505dc480aafaa6/directory >--------------------------------------------------------------- commit 1fc14e8218c08080e17adbc091505dc480aafaa6 Author: Phil Ruffwind Date: Wed Feb 10 23:09:52 2016 -0500 Documentation improvements >--------------------------------------------------------------- 1fc14e8218c08080e17adbc091505dc480aafaa6 System/Directory.hs | 70 ++++++++++++++++++++++++++++++++--------------------- 1 file changed, 43 insertions(+), 27 deletions(-) diff --git a/System/Directory.hs b/System/Directory.hs index 4eb6303..18b04ff 100644 --- a/System/Directory.hs +++ b/System/Directory.hs @@ -795,28 +795,27 @@ copyFile fromFPath toFPath = -- | Make a path absolute and remove as many indirections from it as possible. -- Indirections include the two special directories @.@ and @..@, as well as --- any symbolic links. The input path need not point to an existing file or --- directory. +-- any Unix symbolic links. The input path does not have to point to an +-- existing file or directory. -- --- __Note__: if you require only an absolute path, use 'makeAbsolute' instead. --- Most programs need not care about whether a path contains symbolic links. +-- __Note__: if you only need an absolute path, use 'makeAbsolute' instead. +-- Most programs should not worry about whether a path contains symbolic links. -- --- Due to the fact that symbolic links and @..@ are dependent on the state of --- the existing filesystem, the function can only make a conservative, --- best-effort attempt. Nevertheless, if the input path points to an existing --- file or directory, then the output path shall also point to the same file --- or directory. +-- Since symbolic links and the special parent directory (@..@) are dependent +-- on the state of the existing filesystem, the function can only make a +-- conservative attempt by removing symbolic links and @..@ from the longest +-- prefix of the path that still points to an existing file or directory. If +-- the input path points to an existing file or directory, then the output +-- path shall also point to the same file or directory, provided that the +-- relevant parts of the filesystem have not changed in the meantime (the +-- function is not atomic). -- --- Formally, symbolic links and @..@ are removed from the longest prefix of --- the path that still points to an existing file. The function is not --- atomic, therefore concurrent changes in the filesystem may lead to --- incorrect results. +-- Despite the name, the function does not guarantee canonicity of the +-- returned path due to the presence of hard links, mount points, etc. -- --- (Despite the name, the function does not guarantee canonicity of the --- returned path due to the presence of hard links, mount points, etc.) --- --- Similar to 'normalise', an empty path is equivalent to the current --- directory. +-- Similar to 'normalise', passing an empty path is equivalent to passing the +-- current directory. The function preserves the presence or absence of the +-- trailing path separator unless the path refers to the root directory @/@. -- -- /Known bug(s)/: on Windows, the function does not resolve symbolic links. -- @@ -858,10 +857,11 @@ canonicalizePath = \ path -> `catchIOError` \ _ -> return False #endif --- | Convert a (possibly) relative path into an absolute path. This is nearly --- equivalent to prepending the current directory (if the path isn't already --- absolute) and then applying 'normalise' to the result. The trailing path --- separator, if any, is preserved during the process. +-- | Convert a path into an absolute path. If the given path is relative, the +-- current directory is prepended and then the combined result is +-- 'normalise'd. If the path is already absolute, the path is simply +-- 'normalise'd. The function preserves the presence or absence of the +-- trailing path separator unless the path refers to the root directory @/@. -- -- If the path is already absolute, the operation never fails. Otherwise, the -- operation may fail with the same exceptions as 'getCurrentDirectory'. @@ -873,6 +873,15 @@ makeAbsolute path = (`ioeSetFileName` path)) $ matchTrailingSeparator path . normalise <$> prependCurrentDirectory path +-- | Convert a path into an absolute path. If the given path is relative, the +-- current directory is prepended. If the path is already absolute, the path +-- is returned unchanged. The function preserves the presence or absence of +-- the trailing path separator. +-- +-- If the path is already absolute, the operation never fails. Otherwise, the +-- operation may fail with the same exceptions as 'getCurrentDirectory'. +-- +-- (internal API) prependCurrentDirectory :: FilePath -> IO FilePath prependCurrentDirectory path = modifyIOError ((`ioeSetLocation` "prependCurrentDirectory") . @@ -886,12 +895,19 @@ prependCurrentDirectory path = | otherwise -> return path +-- | Add or remove the trailing path separator in the second path so as to +-- match its presence in the first path. +-- +-- (internal API) matchTrailingSeparator :: FilePath -> FilePath -> FilePath matchTrailingSeparator path | hasTrailingPathSeparator path = addTrailingPathSeparator | otherwise = dropTrailingPathSeparator --- | 'makeRelative' the current directory. +-- | Construct a path relative to the current directory, similar to +-- 'makeRelative'. +-- +-- The operation may fail with the same exceptions as 'getCurrentDirectory'. makeRelativeToCurrentDirectory :: FilePath -> IO FilePath makeRelativeToCurrentDirectory x = do cur <- getCurrentDirectory @@ -981,6 +997,8 @@ findFilesWith f (d:ds) fileName = do #ifdef __GLASGOW_HASKELL__ -- | Similar to 'listDirectory', but always includes the special entries (@.@ -- and @..@). (This applies to Windows as well.) +-- +-- The operation may fail with the same exceptions as 'listDirectory'. getDirectoryContents :: FilePath -> IO [FilePath] getDirectoryContents path = modifyIOError ((`ioeSetFileName` path) . @@ -1528,10 +1546,8 @@ specializeErrorString str errType action = do Right x -> return x -- | Obtain the path to a special directory for storing user-specific --- application data (traditional Unix location). Except for backward --- compatibility reasons, newer applications may prefer the the --- XDG-conformant location provided by 'getXdgDirectory', which offers a --- more fine-grained hierarchy as well as greater flexibility for the user +-- application data (traditional Unix location). Newer applications may +-- prefer the the XDG-conformant location provided by 'getXdgDirectory' -- (). -- -- The argument is usually the name of the application. Since it will be From git at git.haskell.org Sun Feb 14 22:19:17 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 14 Feb 2016 22:19:17 +0000 (UTC) Subject: [commit: packages/directory] master: Update changelog about error message tweak in getCurrentDirectory (33ce1ca) Message-ID: <20160214221917.970313A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/directory On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/33ce1ca6bef97b60957e4763b046eac9a982ead0/directory >--------------------------------------------------------------- commit 33ce1ca6bef97b60957e4763b046eac9a982ead0 Author: Phil Ruffwind Date: Sun Feb 14 00:18:34 2016 -0500 Update changelog about error message tweak in getCurrentDirectory >--------------------------------------------------------------- 33ce1ca6bef97b60957e4763b046eac9a982ead0 changelog.md | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/changelog.md b/changelog.md index 6e9e984..4a09653 100644 --- a/changelog.md +++ b/changelog.md @@ -3,6 +3,10 @@ Changelog for the [`directory`][1] package ## 1.2.5.1 (February 2015) + * Improve error message of `getCurrentDirectory` when the current working + directory no longer exists + ([#39](https://github.com/haskell/directory/issues/39)) + * Fix the behavior of trailing path separators in `canonicalizePath` as well as `makeAbsolute` when applied to the current directory; they should now match the behavior of `canonicalizePath` prior to 1.2.3.0 (when the bug From git at git.haskell.org Sun Feb 14 22:52:55 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 14 Feb 2016 22:52:55 +0000 (UTC) Subject: [commit: ghc] master: Update directory submodule to v1.2.5.1 release (4bba19a) Message-ID: <20160214225255.8F1B83A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4bba19a56ddf98dc569878ea052e312487122d70/ghc >--------------------------------------------------------------- commit 4bba19a56ddf98dc569878ea052e312487122d70 Author: Herbert Valerio Riedel Date: Sun Feb 14 23:53:37 2016 +0100 Update directory submodule to v1.2.5.1 release >--------------------------------------------------------------- 4bba19a56ddf98dc569878ea052e312487122d70 libraries/directory | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/directory b/libraries/directory index 5696798..33ce1ca 160000 --- a/libraries/directory +++ b/libraries/directory @@ -1 +1 @@ -Subproject commit 5696798a0adbf3401688f223fe64a4aa6378e87b +Subproject commit 33ce1ca6bef97b60957e4763b046eac9a982ead0 From git at git.haskell.org Sun Feb 14 22:54:29 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 14 Feb 2016 22:54:29 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Update directory submodule to v1.2.5.1 release (d977fb8) Message-ID: <20160214225429.C42373A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/d977fb89d624bda57a73737328ce9f58ffec0599/ghc >--------------------------------------------------------------- commit d977fb89d624bda57a73737328ce9f58ffec0599 Author: Herbert Valerio Riedel Date: Sun Feb 14 23:53:37 2016 +0100 Update directory submodule to v1.2.5.1 release (cherry picked from commit 4bba19a56ddf98dc569878ea052e312487122d70) >--------------------------------------------------------------- d977fb89d624bda57a73737328ce9f58ffec0599 libraries/directory | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/directory b/libraries/directory index 5696798..33ce1ca 160000 --- a/libraries/directory +++ b/libraries/directory @@ -1 +1 @@ -Subproject commit 5696798a0adbf3401688f223fe64a4aa6378e87b +Subproject commit 33ce1ca6bef97b60957e4763b046eac9a982ead0 From git at git.haskell.org Mon Feb 15 08:45:49 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 15 Feb 2016 08:45:49 +0000 (UTC) Subject: [commit: ghc] master: Improve error message suppression (18cd712) Message-ID: <20160215084549.2A3453A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/18cd712427182e76d38047860ee3e26799bc3fe2/ghc >--------------------------------------------------------------- commit 18cd712427182e76d38047860ee3e26799bc3fe2 Author: Simon Peyton Jones Date: Mon Feb 15 08:39:23 2016 +0000 Improve error message suppression TcErrors has a system for suppressing some type errors if a more serious one occurs. But there was a crucial missing case, which sometimes resulted in a cascade of irrelevant errors overwhelming the actual cause. This was Trac #11541. The fix is simple. Worth merging to 8.0 >--------------------------------------------------------------- 18cd712427182e76d38047860ee3e26799bc3fe2 compiler/typecheck/TcErrors.hs | 19 ++++++++++++------- .../rename/should_fail/RnStaticPointersFail02.stderr | 6 ------ testsuite/tests/rename/should_fail/mc14.stderr | 14 -------------- .../tests/typecheck/should_compile/T11254.stderr | 10 ---------- testsuite/tests/typecheck/should_fail/mc22.stderr | 12 ------------ testsuite/tests/typecheck/should_fail/mc25.stderr | 11 ----------- 6 files changed, 12 insertions(+), 60 deletions(-) diff --git a/compiler/typecheck/TcErrors.hs b/compiler/typecheck/TcErrors.hs index 2cbf28d..5f2c908 100644 --- a/compiler/typecheck/TcErrors.hs +++ b/compiler/typecheck/TcErrors.hs @@ -304,14 +304,19 @@ reportImplic ctxt implic@(Implic { ic_skols = tvs, ic_given = given , ic_info = info' } ctxt' = ctxt { cec_tidy = env1 , cec_encl = implic' : cec_encl ctxt - , cec_suppress = insoluble -- Suppress inessential errors if there - -- are are insolubles anywhere in the - -- tree rooted here + + , cec_suppress = insoluble || cec_suppress ctxt + -- Suppress inessential errors if there + -- are are insolubles anywhere in the + -- tree rooted here, or we've come across + -- a suppress-worthy constraint higher up (Trac #11541) + , cec_binds = cec_binds ctxt *> m_evb } - -- if cec_binds ctxt is Nothing, that means - -- we're reporting *all* errors. Don't change - -- that behavior just because we're going into - -- an implication. + -- If cec_binds ctxt is Nothing, that means + -- we're reporting *all* errors. Don't change + -- that behavior just because we're going into + -- an implication. + dead_givens = case status of IC_Solved { ics_dead = dead } -> dead _ -> [] diff --git a/testsuite/tests/rename/should_fail/RnStaticPointersFail02.stderr b/testsuite/tests/rename/should_fail/RnStaticPointersFail02.stderr index e596a51..b34f435 100644 --- a/testsuite/tests/rename/should_fail/RnStaticPointersFail02.stderr +++ b/testsuite/tests/rename/should_fail/RnStaticPointersFail02.stderr @@ -1,9 +1,3 @@ -RnStaticPointersFail02.hs:5:5: error: - ? No instance for (Data.Typeable.Internal.Typeable t0) - arising from a static form - ? In the expression: static T - In an equation for ?f?: f = static T - RnStaticPointersFail02.hs:5:12: error: Data constructor not in scope: T diff --git a/testsuite/tests/rename/should_fail/mc14.stderr b/testsuite/tests/rename/should_fail/mc14.stderr index bc7b7df..4182c8f 100644 --- a/testsuite/tests/rename/should_fail/mc14.stderr +++ b/testsuite/tests/rename/should_fail/mc14.stderr @@ -1,16 +1,2 @@ -mc14.hs:14:16: error: - Ambiguous type variable ?t0? arising from a use of ?fmap? - prevents the constraint ?(Functor t0)? from being solved. - Probable fix: use a type annotation to specify what ?t0? should be. - These potential instances exist: - instance Functor IO -- Defined in ?GHC.Base? - instance Functor Maybe -- Defined in ?GHC.Base? - instance Functor ((->) r) -- Defined in ?GHC.Base? - ...plus two others - (use -fprint-potential-instances to see them all) - In the expression: fmap - In a stmt of a monad comprehension: then group using f - In the expression: [() | f <- functions, then group using f] - mc14.hs:14:49: error: Variable not in scope: f :: [a] -> m (t0 a) diff --git a/testsuite/tests/typecheck/should_compile/T11254.stderr b/testsuite/tests/typecheck/should_compile/T11254.stderr index 25cd751..692c72f 100644 --- a/testsuite/tests/typecheck/should_compile/T11254.stderr +++ b/testsuite/tests/typecheck/should_compile/T11254.stderr @@ -4,16 +4,6 @@ T11254.hs:16:10: warning: arising from the superclasses of an instance declaration ? In the instance declaration for ?ID Rational? -T11254.hs:16:10: warning: - ? No instance for (Fractional Int) - arising from the superclasses of an instance declaration - ? In the instance declaration for ?ID Rational? - -T11254.hs:16:10: warning: - ? No instance for (ID Int) - arising from the superclasses of an instance declaration - ? In the instance declaration for ?ID Rational? - T11254.hs:18:12: warning: ? Couldn't match type ?GHC.Real.Ratio Integer? with ?Int? Expected type: Rational -> Frac Rational diff --git a/testsuite/tests/typecheck/should_fail/mc22.stderr b/testsuite/tests/typecheck/should_fail/mc22.stderr index 5e369d7..955ebe5 100644 --- a/testsuite/tests/typecheck/should_fail/mc22.stderr +++ b/testsuite/tests/typecheck/should_fail/mc22.stderr @@ -1,16 +1,4 @@ -mc22.hs:9:9: error: - ? No instance for (Functor t) arising from a use of ?fmap? - Possible fix: - add (Functor t) to the context of - a type expected by the context: - (a -> b) -> t a -> t b - or the inferred type of foo :: [t [Char]] - ? In the expression: fmap - In a stmt of a monad comprehension: then group using take 5 - In the expression: - [x + 1 | x <- ["Hello", "World"], then group using take 5] - mc22.hs:10:26: error: ? Couldn't match type ?a? with ?t a? ?a? is a rigid type variable bound by diff --git a/testsuite/tests/typecheck/should_fail/mc25.stderr b/testsuite/tests/typecheck/should_fail/mc25.stderr index 406f89e..7fdb6ff 100644 --- a/testsuite/tests/typecheck/should_fail/mc25.stderr +++ b/testsuite/tests/typecheck/should_fail/mc25.stderr @@ -1,15 +1,4 @@ -mc25.hs:9:10: error: - ? No instance for (Functor t1) arising from a use of ?fmap? - Possible fix: - add (Functor t1) to the context of - a type expected by the context: - (a -> b) -> t1 a -> t1 b - or the inferred type of z :: [t1 t] - ? In the expression: fmap - In a stmt of a monad comprehension: then group by x using take - In the expression: [x | x <- [1 .. 10], then group by x using take] - mc25.hs:9:46: error: ? Couldn't match type ?a -> t? with ?Int? Expected type: (a -> t) -> [a] -> [t1 a] From git at git.haskell.org Mon Feb 15 08:45:52 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 15 Feb 2016 08:45:52 +0000 (UTC) Subject: [commit: ghc] master: Comments only (bb7f230) Message-ID: <20160215084552.492C93A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/bb7f23084e2a886f5b48442458d33b43c4628b3c/ghc >--------------------------------------------------------------- commit bb7f23084e2a886f5b48442458d33b43c4628b3c Author: Simon Peyton Jones Date: Mon Feb 15 08:46:36 2016 +0000 Comments only >--------------------------------------------------------------- bb7f23084e2a886f5b48442458d33b43c4628b3c compiler/typecheck/TcErrors.hs | 17 +++++++++++++---- compiler/typecheck/TcSimplify.hs | 8 ++++++-- testsuite/tests/typecheck/should_fail/T11541.hs | 8 ++++++++ testsuite/tests/typecheck/should_fail/T11541.stderr | 2 ++ testsuite/tests/typecheck/should_fail/all.T | 1 + 5 files changed, 30 insertions(+), 6 deletions(-) diff --git a/compiler/typecheck/TcErrors.hs b/compiler/typecheck/TcErrors.hs index 5f2c908..e97e3c5 100644 --- a/compiler/typecheck/TcErrors.hs +++ b/compiler/typecheck/TcErrors.hs @@ -134,7 +134,12 @@ reportUnsolved wanted ; getTcEvBinds binds_var } -- | Report *all* unsolved goals as errors, even if -fdefer-type-errors is on +-- However, do not make any evidence bindings, because we don't +-- have any convenient place to put them. -- See Note [Deferring coercion errors to runtime] +-- Used by solveEqualities for kind equalities +-- (see Note [Fail fast on kind errors] in TcSimplify] +-- and for simplifyDefault. reportAllUnsolved :: WantedConstraints -> TcM () reportAllUnsolved wanted = report_unsolved Nothing False TypeError HoleError HoleError wanted @@ -240,11 +245,15 @@ data ReportErrCtxt -- (innermost first) -- ic_skols and givens are tidied, rest are not , cec_tidy :: TidyEnv + , cec_binds :: Maybe EvBindsVar - -- Nothinng <=> Report all errors, including holes; no bindings - -- Just ev <=> make some errors (depending on cec_defer) - -- into warnings, and emit evidence bindings - -- into 'ev' for unsolved constraints + -- Nothing <=> Report all errors, including holes + -- Do not add any evidence bindings, because + -- we have no convenient place to put them + -- See TcErrors.reportAllUnsolved + -- Just ev <=> make some errors (depending on cec_defer) + -- into warnings, and emit evidence bindings + -- into 'ev' for unsolved constraints , cec_errors_as_warns :: Bool -- Turn all errors into warnings -- (except for Holes, which are diff --git a/compiler/typecheck/TcSimplify.hs b/compiler/typecheck/TcSimplify.hs index 8cc9b49..be07358 100644 --- a/compiler/typecheck/TcSimplify.hs +++ b/compiler/typecheck/TcSimplify.hs @@ -188,11 +188,15 @@ defaultCallStacks wanteds solveEqualities is used to solve kind equalities when kind-checking user-written types. If solving fails we should fail outright, rather than just accumulate an error message, for two reasons: + * A kind-bogus type signature may cause a cascade of knock-on errors if we let it pass - * More seriously, if we don't solve a constraint we'll be left - with a type that has a coercion hole in it, something like + * More seriously, we don't have a convenient term-level place to add + deferred bindings for unsolved kind-equality constraints, so we + don't build evidence bindings (by usine reportAllUnsolved). That + means that we'll be left with with a type that has coercion holes + in it, something like |> co-hole where co-hole is not filled in. Eeek! That un-filled-in hole actually causes GHC to crash with "fvProv falls into a hole" diff --git a/testsuite/tests/typecheck/should_fail/T11541.hs b/testsuite/tests/typecheck/should_fail/T11541.hs new file mode 100644 index 0000000..56f41f3 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T11541.hs @@ -0,0 +1,8 @@ +module T11541 where + +g :: Ord k => k -> v -> () +g k v = () + +f x y = + let m = min x y + in g m foo diff --git a/testsuite/tests/typecheck/should_fail/T11541.stderr b/testsuite/tests/typecheck/should_fail/T11541.stderr new file mode 100644 index 0000000..5669c9c --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T11541.stderr @@ -0,0 +1,2 @@ + +T11541.hs:8:12: error: Variable not in scope: foo diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T index bf8d7c7..69df866 100644 --- a/testsuite/tests/typecheck/should_fail/all.T +++ b/testsuite/tests/typecheck/should_fail/all.T @@ -406,3 +406,4 @@ test('T11355', normal, compile_fail, ['']) test('T11464', normal, compile_fail, ['']) test('T11473', expect_broken(11473), compile_fail, ['']) test('T11563', normal, compile_fail, ['']) +test('T11541', normal, compile_fail, ['']) From git at git.haskell.org Mon Feb 15 11:47:31 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 15 Feb 2016 11:47:31 +0000 (UTC) Subject: [commit: ghc] master: Document -dynamic-too (#11488) (160765f) Message-ID: <20160215114731.053623A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/160765f8331cf92e9a34e9062846a949e7b11b1e/ghc >--------------------------------------------------------------- commit 160765f8331cf92e9a34e9062846a949e7b11b1e Author: Simon Marlow Date: Mon Feb 15 11:47:12 2016 +0000 Document -dynamic-too (#11488) >--------------------------------------------------------------- 160765f8331cf92e9a34e9062846a949e7b11b1e docs/users_guide/phases.rst | 14 ++++++++++++++ utils/mkUserGuidePart/Options/CodeGen.hs | 10 ++++++++++ utils/mkUserGuidePart/Options/Linking.hs | 19 ------------------- utils/mkUserGuidePart/Options/RedirectingOutput.hs | 12 ++++++++++++ 4 files changed, 36 insertions(+), 19 deletions(-) diff --git a/docs/users_guide/phases.rst b/docs/users_guide/phases.rst index e9637fa..ed05add 100644 --- a/docs/users_guide/phases.rst +++ b/docs/users_guide/phases.rst @@ -464,6 +464,20 @@ Options affecting code generation Note that using this option when linking causes GHC to link against shared libraries. +.. ghc-flag:: -dynamic-too + + Generates both dynamic and static object files in a single run of + GHC. This option is functionally equivalent to running GHC twice, + the second time adding ``-dynamic -osuf dyn_o -hisuf dyn_hi``. + + Although it is equivalent to running GHC twice, using + ``-dynamic-too`` is more efficient, because the earlier phases of + the compiler up to code generation are performed just once. + + When using ``-dynamic-too``, the options ``-dyno``, ``-dynosuf``, + and ``-dynhisuf`` are the counterparts of ``-o``, ``-osuf``, and + ``-hisuf`` respectively, but applying to the dynamic compilation. + .. _options-linker: Options affecting linking diff --git a/utils/mkUserGuidePart/Options/CodeGen.hs b/utils/mkUserGuidePart/Options/CodeGen.hs index 9939d9e..0a5d6c1 100644 --- a/utils/mkUserGuidePart/Options/CodeGen.hs +++ b/utils/mkUserGuidePart/Options/CodeGen.hs @@ -39,4 +39,14 @@ codegenOptions = "output. If ?n? is omitted level 2 is assumed." , flagType = DynamicFlag } + , flag { flagName = "-dynamic" + , flagDescription = "Build dynamically-linked object files and executables" + , flagType = DynamicFlag + } + , flag { flagName = "-dynamic-too" + , flagDescription = + "Build dynamic object files *as well as* static object files " ++ + "during compilation" + , flagType = DynamicFlag + } ] diff --git a/utils/mkUserGuidePart/Options/Linking.hs b/utils/mkUserGuidePart/Options/Linking.hs index 2348daa..919cc09 100644 --- a/utils/mkUserGuidePart/Options/Linking.hs +++ b/utils/mkUserGuidePart/Options/Linking.hs @@ -21,25 +21,6 @@ linkingOptions = "Generate position-independent code (where available)" , flagType = DynamicFlag } - , flag { flagName = "-dynamic" - , flagDescription = "Use dynamic Haskell libraries (if available)" - , flagType = DynamicFlag - } - , flag { flagName = "-dynamic-too" - , flagDescription = - "Build dynamic object files *as well as* static object files " ++ - "during compilation" - , flagType = DynamicFlag - } - , flag { flagName = "-dyno" - , flagDescription = - "Set the output path for the *dynamically* linked objects" - , flagType = DynamicFlag - } - , flag { flagName = "-dynosuf" - , flagDescription = "Set the output suffix for dynamic object files" - , flagType = DynamicFlag - } , flag { flagName = "-dynload" , flagDescription = "Selects one of a number of modes for finding shared libraries at runtime." diff --git a/utils/mkUserGuidePart/Options/RedirectingOutput.hs b/utils/mkUserGuidePart/Options/RedirectingOutput.hs index 9435e26..62fe99a 100644 --- a/utils/mkUserGuidePart/Options/RedirectingOutput.hs +++ b/utils/mkUserGuidePart/Options/RedirectingOutput.hs @@ -44,4 +44,16 @@ redirectingOutputOptions = , flagDescription = "set output directory" , flagType = DynamicFlag } + , flag { flagName = "-dyno " + , flagDescription = "Set the output filename for dynamic object files (see ``-dynamic-too``)" + , flagType = DynamicFlag + } + , flag { flagName = "-dynosuf " + , flagDescription = "Set the object suffix for dynamic object files (see ``-dynamic-too``)" + , flagType = DynamicFlag + } + , flag { flagName = "-dynhisuf " + , flagDescription = "Set the hi suffix for dynamic object files (see ``-dynamic-too``)" + , flagType = DynamicFlag + } ] From git at git.haskell.org Mon Feb 15 15:38:34 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 15 Feb 2016 15:38:34 +0000 (UTC) Subject: [commit: ghc] wip/rae: Make exactTyCoVarsOfTypes closed over kinds. (cccaccf) Message-ID: <20160215153834.105CD3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/cccaccf702fd704a4795546fbdfa66e61a761e74/ghc >--------------------------------------------------------------- commit cccaccf702fd704a4795546fbdfa66e61a761e74 Author: Richard Eisenberg Date: Thu Jan 28 17:39:03 2016 -0500 Make exactTyCoVarsOfTypes closed over kinds. >--------------------------------------------------------------- cccaccf702fd704a4795546fbdfa66e61a761e74 compiler/typecheck/TcType.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/typecheck/TcType.hs b/compiler/typecheck/TcType.hs index 285f7b7..c542b56 100644 --- a/compiler/typecheck/TcType.hs +++ b/compiler/typecheck/TcType.hs @@ -750,7 +750,7 @@ exactTyCoVarsOfType ty = go ty where go ty | Just ty' <- coreView ty = go ty' -- This is the key line - go (TyVarTy tv) = unitVarSet tv + go (TyVarTy tv) = unitVarSet tv `unionVarSet` go (tyVarKind tv) go (TyConApp _ tys) = exactTyCoVarsOfTypes tys go (LitTy {}) = emptyVarSet go (AppTy fun arg) = go fun `unionVarSet` go arg From git at git.haskell.org Mon Feb 15 15:38:36 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 15 Feb 2016 15:38:36 +0000 (UTC) Subject: [commit: ghc] wip/rae: Existentials should be specified. (6a05ccd) Message-ID: <20160215153836.B77933A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/6a05ccda8d24408242354994c5753689f2cce25b/ghc >--------------------------------------------------------------- commit 6a05ccda8d24408242354994c5753689f2cce25b Author: Richard Eisenberg Date: Fri Jan 29 13:09:42 2016 -0500 Existentials should be specified. This addresses point (2) from #11513. >--------------------------------------------------------------- 6a05ccda8d24408242354994c5753689f2cce25b 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 0626836..fd25c79 100644 --- a/compiler/basicTypes/DataCon.hs +++ b/compiler/basicTypes/DataCon.hs @@ -768,7 +768,7 @@ mkDataCon name declared_infix prom_info tag = assoc "mkDataCon" (tyConDataCons rep_tycon `zip` [fIRST_TAG..]) con rep_arg_tys = dataConRepArgTys con - rep_ty = mkSpecForAllTys univ_tvs $ mkInvForAllTys ex_tvs $ + rep_ty = mkSpecForAllTys univ_tvs $ mkSpecForAllTys ex_tvs $ mkFunTys rep_arg_tys $ mkTyConApp rep_tycon (mkTyVarTys univ_tvs) From git at git.haskell.org Mon Feb 15 15:38:39 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 15 Feb 2016 15:38:39 +0000 (UTC) Subject: [commit: ghc] wip/rae: Add missing kind cast to pure unifier. (9c3027f) Message-ID: <20160215153839.80C243A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/9c3027f4df09ad151d21806a83d32deff91b9da7/ghc >--------------------------------------------------------------- commit 9c3027f4df09ad151d21806a83d32deff91b9da7 Author: Richard Eisenberg Date: Sat Jan 30 16:49:22 2016 -0500 Add missing kind cast to pure unifier. >--------------------------------------------------------------- 9c3027f4df09ad151d21806a83d32deff91b9da7 compiler/types/Unify.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/types/Unify.hs b/compiler/types/Unify.hs index 89b6695..fe77370 100644 --- a/compiler/types/Unify.hs +++ b/compiler/types/Unify.hs @@ -788,7 +788,7 @@ uVar tv1 ty kco -- this is because the range of the subst is the target -- type, not the template type. So, just check for -- normal type equality. - guard (ty' `eqType` ty) } + guard ((ty' `mkCastTy` kco) `eqType` ty) } Nothing -> uUnrefined tv1 ty ty kco } -- No, continue uUnrefined :: TyVar -- variable to be unified From git at git.haskell.org Mon Feb 15 15:38:42 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 15 Feb 2016 15:38:42 +0000 (UTC) Subject: [commit: ghc] wip/rae: Remove extraneous fundeps on (~) (a42444b) Message-ID: <20160215153842.363843A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/a42444babb162e5672dfa052c193b645933e8a2a/ghc >--------------------------------------------------------------- commit a42444babb162e5672dfa052c193b645933e8a2a Author: Richard Eisenberg Date: Thu Feb 4 18:31:25 2016 -0500 Remove extraneous fundeps on (~) >--------------------------------------------------------------- a42444babb162e5672dfa052c193b645933e8a2a libraries/base/Data/Type/Equality.hs | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/libraries/base/Data/Type/Equality.hs b/libraries/base/Data/Type/Equality.hs index 75d2a6c..e7363d2 100644 --- a/libraries/base/Data/Type/Equality.hs +++ b/libraries/base/Data/Type/Equality.hs @@ -54,7 +54,7 @@ import Data.Type.Bool -- | Lifted, homogeneous equality. By lifted, we mean that it can be -- bogus (deferred type error). By homogeneous, the two types @a@ -- and @b@ must have the same kind. -class a ~~ b => (a :: k) ~ (b :: k) | a -> b, b -> a +class a ~~ b => (a :: k) ~ (b :: k) -- See Note [The equality types story] in TysPrim -- NB: All this class does is to wrap its superclass, which is -- the "real", inhomogeneous equality; this is needed when @@ -62,6 +62,10 @@ class a ~~ b => (a :: k) ~ (b :: k) | a -> b, b -> a -- NB: Not exported, as (~) is magical syntax. That's also why there's -- no fixity. + -- It's tempting to put functional dependencies on (~), but it's not + -- necessary because the functional-depedency coverage check looks + -- through superclasses, and (~#) is handled in that check. + instance {-# INCOHERENT #-} a ~~ b => a ~ b -- See Note [The equality types story] in TysPrim -- If we have a Wanted (t1 ~ t2), we want to immediately From git at git.haskell.org Mon Feb 15 15:38:45 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 15 Feb 2016 15:38:45 +0000 (UTC) Subject: [commit: ghc] wip/rae: Fix #11241. (591db54) Message-ID: <20160215153845.83FCF3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/591db54f16d65c7aaa6146097227c0e1557141e2/ghc >--------------------------------------------------------------- commit 591db54f16d65c7aaa6146097227c0e1557141e2 Author: Richard Eisenberg Date: Wed Feb 10 08:35:22 2016 -0500 Fix #11241. When renaming a type, now looks for wildcards in bound variables' kinds. testcase: dependent/should_compile/T11241 >--------------------------------------------------------------- 591db54f16d65c7aaa6146097227c0e1557141e2 compiler/rename/RnTypes.hs | 9 ++++++++- testsuite/tests/dependent/should_compile/T11241.hs | 6 ++++++ testsuite/tests/dependent/should_compile/T11241.stderr | 6 ++++++ testsuite/tests/dependent/should_compile/all.T | 2 +- 4 files changed, 21 insertions(+), 2 deletions(-) diff --git a/compiler/rename/RnTypes.hs b/compiler/rename/RnTypes.hs index 0d7f68c..118a32b 100644 --- a/compiler/rename/RnTypes.hs +++ b/compiler/rename/RnTypes.hs @@ -147,7 +147,9 @@ rnWcSigTy env (L loc hs_ty@(HsForAllTy { hst_bndrs = tvs, hst_body = hs_tau })) Nothing [] tvs $ \ _ tvs' -> do { (hs_tau', fvs) <- rnWcSigTy env hs_tau ; let hs_ty' = HsForAllTy { hst_bndrs = tvs', hst_body = hswc_body hs_tau' } - ; return ( hs_tau' { hswc_body = L loc hs_ty' }, fvs) } + awcs_bndrs = collectAnonWildCardsBndrs tvs' + ; return ( hs_tau' { hswc_wcs = hswc_wcs hs_tau' ++ awcs_bndrs + , hswc_body = L loc hs_ty' }, fvs) } rnWcSigTy env (L loc (HsQualTy { hst_ctxt = hs_ctxt, hst_body = tau })) = do { (hs_ctxt', fvs1) <- rnWcSigContext env hs_ctxt @@ -1043,6 +1045,11 @@ collectAnonWildCards lty = go lty prefix_types_only (HsAppPrefix ty) = Just ty prefix_types_only (HsAppInfix _) = Nothing +collectAnonWildCardsBndrs :: [LHsTyVarBndr Name] -> [Name] +collectAnonWildCardsBndrs ltvs = concatMap (go . unLoc) ltvs + where + go (UserTyVar _) = [] + go (KindedTyVar _ ki) = collectAnonWildCards ki {- ********************************************************* diff --git a/testsuite/tests/dependent/should_compile/T11241.hs b/testsuite/tests/dependent/should_compile/T11241.hs new file mode 100644 index 0000000..47d20d6 --- /dev/null +++ b/testsuite/tests/dependent/should_compile/T11241.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE ExplicitForAll, KindSignatures, PartialTypeSignatures #-} + +module T11241 where + +foo :: forall (a :: _) . a -> a +foo = id diff --git a/testsuite/tests/dependent/should_compile/T11241.stderr b/testsuite/tests/dependent/should_compile/T11241.stderr new file mode 100644 index 0000000..49a39a9 --- /dev/null +++ b/testsuite/tests/dependent/should_compile/T11241.stderr @@ -0,0 +1,6 @@ + +T11241.hs:5:21: warning: + ? Found type wildcard ?_? standing for ?*? + ? In the type signature: + foo :: forall (a :: _). a -> a + ? Relevant bindings include foo :: a -> a (bound at T11241.hs:6:1) diff --git a/testsuite/tests/dependent/should_compile/all.T b/testsuite/tests/dependent/should_compile/all.T index 571a9fb..783fa16 100644 --- a/testsuite/tests/dependent/should_compile/all.T +++ b/testsuite/tests/dependent/should_compile/all.T @@ -16,4 +16,4 @@ test('T9632', normal, compile, ['']) test('dynamic-paper', expect_fail_for(['optasm', 'optllvm']), compile, ['']) test('T11311', normal, compile, ['']) test('T11405', normal, compile, ['']) - +test('T11241', normal, compile, ['']) From git at git.haskell.org Mon Feb 15 15:38:48 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 15 Feb 2016 15:38:48 +0000 (UTC) Subject: [commit: ghc] wip/rae: Use CoercionN and friends in TyCoRep (6092dcb) Message-ID: <20160215153848.619C13A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/6092dcbe6cb6dacbf117f2bd50555eb61183a307/ghc >--------------------------------------------------------------- commit 6092dcbe6cb6dacbf117f2bd50555eb61183a307 Author: Richard Eisenberg Date: Wed Feb 10 08:03:56 2016 -0500 Use CoercionN and friends in TyCoRep >--------------------------------------------------------------- 6092dcbe6cb6dacbf117f2bd50555eb61183a307 compiler/types/Coercion.hs | 7 ------- compiler/types/TyCoRep.hs | 34 +++++++++++++++++++++------------- 2 files changed, 21 insertions(+), 20 deletions(-) diff --git a/compiler/types/Coercion.hs b/compiler/types/Coercion.hs index 2989bce..6546288 100644 --- a/compiler/types/Coercion.hs +++ b/compiler/types/Coercion.hs @@ -127,13 +127,6 @@ import Control.Monad (foldM) import Control.Arrow ( first ) import Data.Function ( on ) ------------------------------------------------------------------ --- These synonyms are very useful as documentation - -type CoercionN = Coercion -- nominal coercion -type CoercionR = Coercion -- representational coercion -type CoercionP = Coercion -- phantom coercion - {- %************************************************************************ %* * diff --git a/compiler/types/TyCoRep.hs b/compiler/types/TyCoRep.hs index 6a13213..b359ba2 100644 --- a/compiler/types/TyCoRep.hs +++ b/compiler/types/TyCoRep.hs @@ -33,6 +33,7 @@ module TyCoRep ( -- Coercions Coercion(..), LeftOrRight(..), UnivCoProvenance(..), CoercionHole(..), + CoercionN, CoercionR, CoercionP, KindCoercion, -- Functions over types mkTyConTy, mkTyVarTy, mkTyVarTys, @@ -213,10 +214,10 @@ data Type | CastTy Type - Coercion -- ^ A kind cast. The coercion is always nominal. - -- INVARIANT: The cast is never refl. - -- INVARIANT: The cast is "pushed down" as far as it - -- can go. See Note [Pushing down casts] + KindCoercion -- ^ A kind cast. The coercion is always nominal. + -- INVARIANT: The cast is never refl. + -- INVARIANT: The cast is "pushed down" as far as it + -- can go. See Note [Pushing down casts] | CoercionTy Coercion -- ^ Injection of a Coercion into a type @@ -592,11 +593,11 @@ data Coercion -- we expand synonyms eagerly -- But it can be a type function - | AppCo Coercion Coercion -- lift AppTy + | AppCo Coercion CoercionN -- lift AppTy -- AppCo :: e -> N -> e -- See Note [Forall coercions] - | ForAllCo TyVar Coercion Coercion + | ForAllCo TyVar KindCoercion Coercion -- ForAllCo :: _ -> N -> e -> e -- These are special @@ -626,15 +627,15 @@ data Coercion -- Using NthCo on a ForAllCo gives an N coercion always -- See Note [NthCo and newtypes] - | LRCo LeftOrRight Coercion -- Decomposes (t_left t_right) + | LRCo LeftOrRight CoercionN -- Decomposes (t_left t_right) -- :: _ -> N -> N - | InstCo Coercion Coercion + | InstCo Coercion CoercionN -- :: e -> N -> e -- See Note [InstCo roles] -- Coherence applies a coercion to the left-hand type of another coercion -- See Note [Coherence] - | CoherenceCo Coercion Coercion + | CoherenceCo Coercion KindCoercion -- :: e -> N -> e -- Extract a kind coercion from a (heterogeneous) type coercion @@ -642,11 +643,16 @@ data Coercion | KindCo Coercion -- :: e -> N - | SubCo Coercion -- Turns a ~N into a ~R + | SubCo CoercionN -- Turns a ~N into a ~R -- :: N -> R deriving (Data.Data, Data.Typeable) +type CoercionN = Coercion -- always nominal +type CoercionR = Coercion -- always representational +type CoercionP = Coercion -- always phantom +type KindCoercion = CoercionN -- always nominal + -- If you edit this type, you may need to update the GHC formalism -- See Note [GHC Formalism] in coreSyn/CoreLint.hs data LeftOrRight = CLeft | CRight @@ -1002,10 +1008,12 @@ role and kind, which is done in the UnivCo constructor. data UnivCoProvenance = UnsafeCoerceProv -- ^ From @unsafeCoerce#@. These are unsound. - | PhantomProv Coercion -- ^ See Note [Phantom coercions] + | PhantomProv KindCoercion -- ^ See Note [Phantom coercions]. Only in Phantom + -- roled coercions - | ProofIrrelProv Coercion -- ^ From the fact that any two coercions are - -- considered equivalent. See Note [ProofIrrelProv] + | ProofIrrelProv KindCoercion -- ^ From the fact that any two coercions are + -- considered equivalent. See Note [ProofIrrelProv]. + -- Can be used in Nominal or Representational coercions | PluginProv String -- ^ From a plugin, which asserts that this coercion -- is sound. The string is for the use of the plugin. From git at git.haskell.org Mon Feb 15 15:38:51 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 15 Feb 2016 15:38:51 +0000 (UTC) Subject: [commit: ghc] wip/rae: Fix #11246. (f0c31a6) Message-ID: <20160215153851.6DC333A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/f0c31a6b54c6a26eae4c1f576ddca04488034ff9/ghc >--------------------------------------------------------------- commit f0c31a6b54c6a26eae4c1f576ddca04488034ff9 Author: Richard Eisenberg Date: Wed Feb 10 09:09:26 2016 -0500 Fix #11246. Previously, the definition of Any was just plain wrong. I'm surprised anything was actually working! >--------------------------------------------------------------- f0c31a6b54c6a26eae4c1f576ddca04488034ff9 compiler/prelude/TysPrim.hs | 2 +- testsuite/tests/typecheck/should_compile/T11246.hs | 5 +++++ testsuite/tests/typecheck/should_compile/all.T | 1 + 3 files changed, 7 insertions(+), 1 deletion(-) diff --git a/compiler/prelude/TysPrim.hs b/compiler/prelude/TysPrim.hs index d1e42d5..26a20c3 100644 --- a/compiler/prelude/TysPrim.hs +++ b/compiler/prelude/TysPrim.hs @@ -920,7 +920,7 @@ anyTy :: Type anyTy = mkTyConTy anyTyCon anyTyCon :: TyCon -anyTyCon = mkFamilyTyCon anyTyConName kind [kKiVar] Nothing +anyTyCon = mkFamilyTyCon anyTyConName kind [] Nothing (ClosedSynFamilyTyCon Nothing) Nothing NotInjective diff --git a/testsuite/tests/typecheck/should_compile/T11246.hs b/testsuite/tests/typecheck/should_compile/T11246.hs new file mode 100644 index 0000000..afe8975 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T11246.hs @@ -0,0 +1,5 @@ +module T11246 where + +import GHC.Exts + +type Key a = Any diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index f7c5644..ec948dd 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -505,3 +505,4 @@ test('T11397', normal, compile, ['']) test('T11458', normal, compile, ['']) test('T11524', normal, compile, ['']) test('T11552', normal, compile, ['']) +test('T11246', normal, compile, ['']) From git at git.haskell.org Mon Feb 15 15:38:54 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 15 Feb 2016 15:38:54 +0000 (UTC) Subject: [commit: ghc] wip/rae: Fix #11313. (604427c) Message-ID: <20160215153854.AA8F33A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/604427c812cd2c6f1b0f0dd9ace699b8f0666527/ghc >--------------------------------------------------------------- commit 604427c812cd2c6f1b0f0dd9ace699b8f0666527 Author: Richard Eisenberg Date: Wed Feb 10 09:38:09 2016 -0500 Fix #11313. Previously, we looked through synonyms when counting arguments, but that's a bit silly. >--------------------------------------------------------------- 604427c812cd2c6f1b0f0dd9ace699b8f0666527 compiler/typecheck/TcMType.hs | 5 +++-- compiler/types/Type.hs | 17 ++++++++++++++++- testsuite/tests/typecheck/should_fail/T11313.hs | 9 +++++++++ testsuite/tests/typecheck/should_fail/T11313.stderr | 6 ++++++ testsuite/tests/typecheck/should_fail/all.T | 1 + 5 files changed, 35 insertions(+), 3 deletions(-) diff --git a/compiler/typecheck/TcMType.hs b/compiler/typecheck/TcMType.hs index e4c8b4b..e4da9aa 100644 --- a/compiler/typecheck/TcMType.hs +++ b/compiler/typecheck/TcMType.hs @@ -1328,13 +1328,14 @@ zonkTidyTcType env ty = do { ty' <- zonkTcType ty -- | Make an 'ErrorThing' storing a type. mkTypeErrorThing :: TcType -> ErrorThing -mkTypeErrorThing ty = ErrorThing ty (Just $ length $ snd $ splitAppTys ty) +mkTypeErrorThing ty = ErrorThing ty (Just $ length $ snd $ repSplitAppTys ty) zonkTidyTcType + -- NB: Use *rep*splitAppTys, else we get #11313 -- | Make an 'ErrorThing' storing a type, with some extra args known about mkTypeErrorThingArgs :: TcType -> Int -> ErrorThing mkTypeErrorThingArgs ty num_args - = ErrorThing ty (Just $ (length $ snd $ splitAppTys ty) + num_args) + = ErrorThing ty (Just $ (length $ snd $ repSplitAppTys ty) + num_args) zonkTidyTcType zonkTidyOrigin :: TidyEnv -> CtOrigin -> TcM (TidyEnv, CtOrigin) diff --git a/compiler/types/Type.hs b/compiler/types/Type.hs index 67365e3..1d6d086 100644 --- a/compiler/types/Type.hs +++ b/compiler/types/Type.hs @@ -21,7 +21,7 @@ module Type ( mkTyVarTy, mkTyVarTys, getTyVar, getTyVar_maybe, repGetTyVar_maybe, getCastedTyVar_maybe, tyVarKind, - mkAppTy, mkAppTys, splitAppTy, splitAppTys, + mkAppTy, mkAppTys, splitAppTy, splitAppTys, repSplitAppTys, splitAppTy_maybe, repSplitAppTy_maybe, tcRepSplitAppTy_maybe, mkFunTy, mkFunTys, splitFunTy, splitFunTy_maybe, @@ -691,6 +691,21 @@ splitAppTys ty = split ty ty [] (TyConApp funTyCon [], [ty1,ty2]) split orig_ty _ args = (orig_ty, args) +-- | Like 'splitAppTys', but doesn't look through type synonyms +repSplitAppTys :: Type -> (Type, [Type]) +repSplitAppTys ty = split ty [] + where + split (AppTy ty arg) args = split ty (arg:args) + split (TyConApp tc tc_args) args + = let n | mightBeUnsaturatedTyCon tc = 0 + | otherwise = tyConArity tc + (tc_args1, tc_args2) = splitAt n tc_args + in + (TyConApp tc tc_args1, tc_args2 ++ args) + split (ForAllTy (Anon ty1) ty2) args = ASSERT( null args ) + (TyConApp funTyCon [], [ty1, ty2]) + split ty args = (ty, args) + {- LitTy ~~~~~ diff --git a/testsuite/tests/typecheck/should_fail/T11313.hs b/testsuite/tests/typecheck/should_fail/T11313.hs new file mode 100644 index 0000000..86ac958 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T11313.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE TypeApplications #-} + +module T11313 where + +import Data.Kind + +x = fmap @ (*) + +-- test error message output, which was quite silly before diff --git a/testsuite/tests/typecheck/should_fail/T11313.stderr b/testsuite/tests/typecheck/should_fail/T11313.stderr new file mode 100644 index 0000000..7a681d1 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T11313.stderr @@ -0,0 +1,6 @@ + +T11313.hs:7:12: error: + ? Expected kind ?* -> *?, but ?*? has kind ?*? + ? In the type ?*? + In the expression: fmap @* + In an equation for ?x?: x = fmap @* diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T index 69df866..7ca4141 100644 --- a/testsuite/tests/typecheck/should_fail/all.T +++ b/testsuite/tests/typecheck/should_fail/all.T @@ -407,3 +407,4 @@ test('T11464', normal, compile_fail, ['']) test('T11473', expect_broken(11473), compile_fail, ['']) test('T11563', normal, compile_fail, ['']) test('T11541', normal, compile_fail, ['']) +test('T11313', normal, compile_fail, ['']) From git at git.haskell.org Mon Feb 15 15:38:57 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 15 Feb 2016 15:38:57 +0000 (UTC) Subject: [commit: ghc] wip/rae's head updated: Fix #11313. (604427c) Message-ID: <20160215153857.354713A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/rae' now includes: 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) cccaccf Make exactTyCoVarsOfTypes closed over kinds. 6a05ccd Existentials should be specified. 9c3027f Add missing kind cast to pure unifier. a42444b Remove extraneous fundeps on (~) 6092dcb Use CoercionN and friends in TyCoRep 591db54 Fix #11241. f0c31a6 Fix #11246. 604427c Fix #11313. From git at git.haskell.org Mon Feb 15 16:20:14 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 15 Feb 2016 16:20:14 +0000 (UTC) Subject: [commit: ghc] master: Tiny refactor; use guards instead of 'if' (f6b98ea) Message-ID: <20160215162014.8666F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f6b98ea75d56e479248643d413676a13f357b705/ghc >--------------------------------------------------------------- commit f6b98ea75d56e479248643d413676a13f357b705 Author: Simon Peyton Jones Date: Mon Feb 15 15:49:41 2016 +0000 Tiny refactor; use guards instead of 'if' >--------------------------------------------------------------- f6b98ea75d56e479248643d413676a13f357b705 compiler/types/Type.hs | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/compiler/types/Type.hs b/compiler/types/Type.hs index 67365e3..1266b66 100644 --- a/compiler/types/Type.hs +++ b/compiler/types/Type.hs @@ -1237,13 +1237,13 @@ mkPiTypesPreferFunTy :: [TyVar] -> Type -> Type mkPiTypesPreferFunTy vars inner_ty = fst $ go vars inner_ty where go :: [TyVar] -> Type -> (Type, VarSet) -- also returns the free vars - go [] ty = (ty, tyCoVarsOfType ty) - go (v:vs) ty - = if v `elemVarSet` fvs - then ( mkForAllTy (Named v Visible) qty - , fvs `delVarSet` v `unionVarSet` kind_vars ) - else ( mkForAllTy (Anon (tyVarKind v)) qty - , fvs `unionVarSet` kind_vars ) + go [] ty = (ty, tyCoVarsOfType ty) + go (v:vs) ty | v `elemVarSet` fvs + = ( mkForAllTy (Named v Visible) qty + , fvs `delVarSet` v `unionVarSet` kind_vars ) + | otherwise + = ( mkForAllTy (Anon (tyVarKind v)) qty + , fvs `unionVarSet` kind_vars ) where (qty, fvs) = go vs ty kind_vars = tyCoVarsOfType $ tyVarKind v From git at git.haskell.org Mon Feb 15 16:20:17 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 15 Feb 2016 16:20:17 +0000 (UTC) Subject: [commit: ghc] master: Comments and white space (0057125) Message-ID: <20160215162017.39FD13A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/005712527af6c68c9fa9681d1f4ade5abd9ece88/ghc >--------------------------------------------------------------- commit 005712527af6c68c9fa9681d1f4ade5abd9ece88 Author: Simon Peyton Jones Date: Mon Feb 15 15:50:24 2016 +0000 Comments and white space >--------------------------------------------------------------- 005712527af6c68c9fa9681d1f4ade5abd9ece88 compiler/coreSyn/CoreLint.hs | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/compiler/coreSyn/CoreLint.hs b/compiler/coreSyn/CoreLint.hs index f094415..6f199ea 100644 --- a/compiler/coreSyn/CoreLint.hs +++ b/compiler/coreSyn/CoreLint.hs @@ -1231,6 +1231,11 @@ lintStarCoercion g lintCoercion :: OutCoercion -> LintM (LintedKind, LintedKind, LintedType, LintedType, Role) -- Check the kind of a coercion term, returning the kind -- Post-condition: the returned OutTypes are lint-free +-- +-- If lintCorecion co = (k1, k2, s1, s2, r) +-- then co :: s1 ~r s2 +-- s1 :: k2 +-- s2 :: k2 -- If you edit this function, you may need to update the GHC formalism -- See Note [GHC Formalism] @@ -1266,7 +1271,7 @@ lintCoercion co@(AppCo co1 co2) | Refl _ (TyConApp {}) <- co1 = failWithL (text "Refl (TyConApp ...) to the left of AppCo:" <+> ppr co) | otherwise - = do { (k1,k2,s1,s2,r1) <- lintCoercion co1 + = do { (k1, k2, s1, s2, r1) <- lintCoercion co1 ; (k'1, k'2, t1, t2, r2) <- lintCoercion co2 ; k3 <- lint_co_app co k1 [(t1,k'1)] ; k4 <- lint_co_app co k2 [(t2,k'2)] @@ -1448,7 +1453,7 @@ lintCoercion co@(AxiomInstCo con ind cos) (empty_subst, empty_subst) (zip3 (ktvs ++ cvs) roles cos) ; let lhs' = substTys subst_l lhs - rhs' = substTy subst_r rhs + rhs' = substTy subst_r rhs ; case checkAxInstCo co of Just bad_branch -> bad_ax $ text "inconsistent with" <+> pprCoAxBranch con bad_branch From git at git.haskell.org Mon Feb 15 16:20:19 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 15 Feb 2016 16:20:19 +0000 (UTC) Subject: [commit: ghc] master: A tiny, outright bug in tcDataFamInstDecl (e2f7d77) Message-ID: <20160215162019.E7C4B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e2f7d777bb7e4c176e01e1c4f8184f115253dee0/ghc >--------------------------------------------------------------- commit e2f7d777bb7e4c176e01e1c4f8184f115253dee0 Author: Simon Peyton Jones Date: Mon Feb 15 15:51:50 2016 +0000 A tiny, outright bug in tcDataFamInstDecl This bug was revealed by Trac #11362. It turns out that in my patch for Trac #11148 (namely 1160dc5), I failed to turn one occurrence of tvs' into full_tvs. Sigh. This is tricky stuff and it cost me several hours to page it back in and figure out what was happening. The result was a CoAxiom whose lhs had rhs had different kinds. Eeek! Anyway it's fixed. I also added an ASSERT, in FamInst.newFamInst, that trips on such bogus CoAxioms. >--------------------------------------------------------------- e2f7d777bb7e4c176e01e1c4f8184f115253dee0 compiler/typecheck/FamInst.hs | 9 ++++++++- compiler/typecheck/TcClassDcl.hs | 3 +-- compiler/typecheck/TcInstDcls.hs | 21 +++++++++++---------- testsuite/tests/polykinds/T6137.hs | 21 +++++++++++++++++++-- 4 files changed, 39 insertions(+), 15 deletions(-) diff --git a/compiler/typecheck/FamInst.hs b/compiler/typecheck/FamInst.hs index e4b2cc3..c38f163 100644 --- a/compiler/typecheck/FamInst.hs +++ b/compiler/typecheck/FamInst.hs @@ -62,7 +62,10 @@ newFamInst :: FamFlavor -> CoAxiom Unbranched -> TcRnIf gbl lcl FamInst -- Freshen the type variables of the FamInst branches -- Called from the vectoriser monad too, hence the rather general type newFamInst flavor axiom@(CoAxiom { co_ax_tc = fam_tc }) - = do { (subst, tvs') <- freshenTyVarBndrs tvs + = ASSERT2( tyCoVarsOfTypes lhs `subVarSet` tcv_set, text "lhs" <+> pp_ax ) + ASSERT2( tyCoVarsOfType rhs `subVarSet` tcv_set, text "rhs" <+> pp_ax ) + ASSERT2( lhs_kind `eqType` rhs_kind, text "kind" <+> pp_ax $$ ppr lhs_kind $$ ppr rhs_kind ) + do { (subst, tvs') <- freshenTyVarBndrs tvs ; (subst, cvs') <- freshenCoVarBndrsX subst cvs ; return (FamInst { fi_fam = tyConName fam_tc , fi_flavor = flavor @@ -73,6 +76,10 @@ newFamInst flavor axiom@(CoAxiom { co_ax_tc = fam_tc }) , fi_rhs = substTy subst rhs , fi_axiom = axiom }) } where + lhs_kind = typeKind (mkTyConApp fam_tc lhs) + rhs_kind = typeKind rhs + tcv_set = mkVarSet (tvs ++ cvs) + pp_ax = pprCoAxiom axiom CoAxBranch { cab_tvs = tvs , cab_cvs = cvs , cab_lhs = lhs diff --git a/compiler/typecheck/TcClassDcl.hs b/compiler/typecheck/TcClassDcl.hs index 40da199..1e84e4c 100644 --- a/compiler/typecheck/TcClassDcl.hs +++ b/compiler/typecheck/TcClassDcl.hs @@ -467,8 +467,7 @@ tcATDefault emit_warn loc inst_subst defined_ats (ATI fam_tc defs) ; traceTc "mk_deflt_at_instance" (vcat [ ppr fam_tc, ppr rhs_ty , pprCoAxiom axiom ]) - ; fam_inst <- ASSERT( tyCoVarsOfType rhs' `subVarSet` tv_set' ) - newFamInst SynFamilyInst axiom + ; fam_inst <- newFamInst SynFamilyInst axiom ; return [fam_inst] } -- No defaults ==> generate a warning diff --git a/compiler/typecheck/TcInstDcls.hs b/compiler/typecheck/TcInstDcls.hs index a94c102..fdc9e8d 100644 --- a/compiler/typecheck/TcInstDcls.hs +++ b/compiler/typecheck/TcInstDcls.hs @@ -671,7 +671,7 @@ tcDataFamInstDecl mb_clsinfo -- (obtained from the pats) are at the end (Trac #11148) orig_res_ty = mkTyConApp fam_tc pats' - ; (rep_tc, fam_inst) <- fixM $ \ ~(rec_rep_tc, _) -> + ; (rep_tc, axiom) <- fixM $ \ ~(rec_rep_tc, _) -> do { data_cons <- tcConDecls new_or_data rec_rep_tc (full_tvs, orig_res_ty) cons @@ -684,23 +684,23 @@ tcDataFamInstDecl mb_clsinfo axiom_name eta_tvs [] fam_tc eta_pats (mkTyConApp rep_tc (mkTyVarTys eta_tvs)) parent = DataFamInstTyCon axiom fam_tc pats' - kind = mkPiTypesPreferFunTy tvs' liftedTypeKind - + rep_tc_kind = mkPiTypesPreferFunTy full_tvs liftedTypeKind -- NB: Use the full_tvs from the pats. See bullet toward -- the end of Note [Data type families] in TyCon - rep_tc = mkAlgTyCon rep_tc_name kind full_tvs - (map (const Nominal) full_tvs) - (fmap unLoc cType) stupid_theta - tc_rhs parent - Recursive gadt_syntax + rep_tc = mkAlgTyCon rep_tc_name + rep_tc_kind + full_tvs + (map (const Nominal) full_tvs) + (fmap unLoc cType) stupid_theta + tc_rhs parent + Recursive gadt_syntax -- We always assume that indexed types are recursive. Why? -- (1) Due to their open nature, we can never be sure that a -- further instance might not introduce a new recursive -- dependency. (2) They are always valid loop breakers as -- they involve a coercion. - ; fam_inst <- newFamInst (DataFamilyInst rep_tc) axiom - ; return (rep_tc, fam_inst) } + ; return (rep_tc, axiom) } -- Remember to check validity; no recursion to worry about here ; checkValidTyCon rep_tc @@ -712,6 +712,7 @@ tcDataFamInstDecl mb_clsinfo , di_preds = preds , di_ctxt = tcMkDataFamInstCtxt decl } + ; fam_inst <- newFamInst (DataFamilyInst rep_tc) axiom ; return (fam_inst, m_deriv_info) } } where eta_reduce :: [Type] -> ([Type], [TyVar]) diff --git a/testsuite/tests/polykinds/T6137.hs b/testsuite/tests/polykinds/T6137.hs index dafe9a2..aac4c1c 100644 --- a/testsuite/tests/polykinds/T6137.hs +++ b/testsuite/tests/polykinds/T6137.hs @@ -17,9 +17,26 @@ data Code i o = F (Code (Sum i o) o) -- An interpretation for `Code` using a data family works: data family In (f :: Code i o) :: (i -> *) -> (o -> *) -data instance In (F f) r o where - MkIn :: In f (Sum1 r (In (F f) r)) o -> In (F f) r o +data instance In (F f) r x where + MkIn :: In f (Sum1 r (In (F f) r)) x -> In (F f) r x + +{- data R:InioFrx o i f r x where + where MkIn :: forall o i (f :: Code (Sum i o) o) (r :: i -> *) (x :: o). + In (Sum i o) o f (Sum1 o i r (In i o ('F i o f) r)) x + -> R:InioFrx o i f r x + + So R:InioFrx :: forall o i. Code i o -> (i -> *) -> o -> * + + data family In i o (f :: Code i o) (a :: i -> *) (b :: o) + + axiom D:R:InioFrx0 :: + forall o i (f :: Code (Sum i o) o). + In i o ('F i o f) = R:InioFrx o i f + + + D:R:InioFrx0 :: R:InioFrx o i f ~ In i o ('F i o f) +-} -- Requires polymorphic recursion data In' (f :: Code i o) :: (i -> *) -> o -> * where MkIn' :: In' g (Sum1 r (In' (F g) r)) t -> In' (F g) r t From git at git.haskell.org Mon Feb 15 18:50:00 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 15 Feb 2016 18:50:00 +0000 (UTC) Subject: [commit: ghc] master: Add a testcase for #11362 (023742e) Message-ID: <20160215185000.6E8803A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/023742e444a415001d86d50a6ec331fe71d50426/ghc >--------------------------------------------------------------- commit 023742e444a415001d86d50a6ec331fe71d50426 Author: Bartosz Nitka Date: Mon Feb 15 09:16:43 2016 -0800 Add a testcase for #11362 This reproduces the issue that I encountered in #11362. Test Plan: this testcase Reviewers: simonpj, bgamari, austin Reviewed By: simonpj Subscribers: thomie, simonmar Differential Revision: https://phabricator.haskell.org/D1917 GHC Trac Issues: #11362 >--------------------------------------------------------------- 023742e444a415001d86d50a6ec331fe71d50426 testsuite/tests/polykinds/T11362.hs | 26 ++++++++++++++++++++++++++ testsuite/tests/polykinds/all.T | 2 ++ 2 files changed, 28 insertions(+) diff --git a/testsuite/tests/polykinds/T11362.hs b/testsuite/tests/polykinds/T11362.hs new file mode 100644 index 0000000..945d68f --- /dev/null +++ b/testsuite/tests/polykinds/T11362.hs @@ -0,0 +1,26 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE GADTs #-} + +module T11362 where +-- this file when compiled with -dunique-increment=-1 made GHC crash + +data Sum a b = L a | R b + +data Sum1 (a :: k1 -> *) (b :: k2 -> *) :: Sum k1 k2 -> * where + LL :: a i -> Sum1 a b (L i) + RR :: b i -> Sum1 a b (R i) + +data Code i o = F (Code (Sum i o) o) + +-- An interpretation for `Code` using a data family works: +data family In (f :: Code i o) :: (i -> *) -> (o -> *) + +data instance In (F f) r o where + MkIn :: In f (Sum1 r (In (F f) r)) o -> In (F f) r o + +-- Requires polymorphic recursion +data In' (f :: Code i o) :: (i -> *) -> o -> * where + MkIn' :: In' g (Sum1 r (In' (F g) r)) t -> In' (F g) r t diff --git a/testsuite/tests/polykinds/all.T b/testsuite/tests/polykinds/all.T index 8187691..b426f0e 100644 --- a/testsuite/tests/polykinds/all.T +++ b/testsuite/tests/polykinds/all.T @@ -139,4 +139,6 @@ test('T11480b', normal, compile, ['']) test('T11523', normal, compile, ['']) test('T11520', normal, compile_fail, ['']) test('T11516', normal, compile_fail, ['']) +test('T11362', normal, compile, ['-dunique-increment=-1']) + # -dunique-increment=-1 doesn't work inside the file test('T11399', normal, compile_fail, ['']) From git at git.haskell.org Mon Feb 15 19:02:16 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 15 Feb 2016 19:02:16 +0000 (UTC) Subject: [commit: ghc] master: Make T11361 actually run with reversed uniques (426a25c) Message-ID: <20160215190216.891843A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/426a25c719f74054758eaaf15daf5760f8d068fb/ghc >--------------------------------------------------------------- commit 426a25c719f74054758eaaf15daf5760f8d068fb Author: Bartosz Nitka Date: Mon Feb 15 09:36:17 2016 -0800 Make T11361 actually run with reversed uniques `-dunique-increment` doesn't work inside the file. Test Plan: I've discovered it doesn't work in D1917. Reviewers: simonpj, bgamari, austin Subscribers: thomie, simonmar Differential Revision: https://phabricator.haskell.org/D1918 GHC Trac Issues: #11361 >--------------------------------------------------------------- 426a25c719f74054758eaaf15daf5760f8d068fb testsuite/tests/indexed-types/should_compile/T11361.hs | 3 +-- testsuite/tests/indexed-types/should_compile/all.T | 3 ++- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/testsuite/tests/indexed-types/should_compile/T11361.hs b/testsuite/tests/indexed-types/should_compile/T11361.hs index 61b412a..7da0062 100644 --- a/testsuite/tests/indexed-types/should_compile/T11361.hs +++ b/testsuite/tests/indexed-types/should_compile/T11361.hs @@ -1,8 +1,7 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} -- this is needed because |FamHelper a x| /< |Fam a x| -{-# OPTIONS_GHC -dinitial-unique=16777000 -dunique-increment=-1 #-} - -- This is what made GHC crash before + -- This file compiled with -dunique-increment=-1 made GHC crash before module T11361 where diff --git a/testsuite/tests/indexed-types/should_compile/all.T b/testsuite/tests/indexed-types/should_compile/all.T index 9fece9c..e97acbf 100644 --- a/testsuite/tests/indexed-types/should_compile/all.T +++ b/testsuite/tests/indexed-types/should_compile/all.T @@ -271,5 +271,6 @@ test('T10318', normal, compile, ['']) test('UnusedTyVarWarnings', normal, compile, ['-Wunused-type-patterns']) test('UnusedTyVarWarningsNamedWCs', normal, compile, ['-Wunused-type-patterns']) test('T11408', normal, compile, ['']) -test('T11361', normal, compile, ['']) +test('T11361', normal, compile, ['-dunique-increment=-1']) + # -dunique-increment=-1 doesn't work inside the file test('T11361a', normal, compile_fail, ['']) From git at git.haskell.org Mon Feb 15 23:31:51 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 15 Feb 2016 23:31:51 +0000 (UTC) Subject: [commit: ghc] master: Rename missing-pat-syn-sigs to missing-pat-syn-signatures (3c39bec) Message-ID: <20160215233151.6C24A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3c39bec12e1abfae911a451d3dfb0039b943819d/ghc >--------------------------------------------------------------- commit 3c39bec12e1abfae911a451d3dfb0039b943819d Author: Matthew Pickering Date: Mon Feb 15 23:33:04 2016 +0000 Rename missing-pat-syn-sigs to missing-pat-syn-signatures >--------------------------------------------------------------- 3c39bec12e1abfae911a451d3dfb0039b943819d compiler/main/DynFlags.hs | 2 +- docs/users_guide/8.0.1-notes.rst | 2 +- docs/users_guide/using-warnings.rst | 4 ++-- testsuite/tests/patsyn/should_fail/T11053.hs | 2 +- testsuite/tests/patsyn/should_fail/all.T | 2 +- 5 files changed, 6 insertions(+), 6 deletions(-) diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index b2c3699..6460b16 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -3223,7 +3223,7 @@ wWarningFlagsDeps = [ flagSpec "unused-type-patterns" Opt_WarnUnusedTypePatterns, flagSpec "warnings-deprecations" Opt_WarnWarningsDeprecations, flagSpec "wrong-do-bind" Opt_WarnWrongDoBind, - flagSpec "missing-pat-syn-sigs" Opt_WarnMissingPatSynSigs, + flagSpec "missing-pat-syn-signatures" Opt_WarnMissingPatSynSigs, flagSpec "unrecognised-warning-flags" Opt_WarnUnrecognisedWarningFlags ] -- | These @-\@ flags can all be reversed with @-no-\@ diff --git a/docs/users_guide/8.0.1-notes.rst b/docs/users_guide/8.0.1-notes.rst index fe3ab69..5bc3e59 100644 --- a/docs/users_guide/8.0.1-notes.rst +++ b/docs/users_guide/8.0.1-notes.rst @@ -268,7 +268,7 @@ Compiler warnings makes sure the definition of ``Semigroup`` as a superclass of ``Monoid`` does not break any code. -- Added the :ghc-flag:`-Wmissing-pat-syn-sigs` flag. When enabled, this will issue +- Added the :ghc-flag:`-Wmissing-pat-syn-signatures` flag. When enabled, this will issue a warning when a pattern synonym definition doesn't have a type signature. It is turned off by default but enabled by :ghc-flag:`-Wall`. diff --git a/docs/users_guide/using-warnings.rst b/docs/users_guide/using-warnings.rst index 7fd2019..5727b82 100644 --- a/docs/users_guide/using-warnings.rst +++ b/docs/users_guide/using-warnings.rst @@ -618,13 +618,13 @@ of ``-W(no-)*``. about any polymorphic local bindings. As part of the warning GHC also reports the inferred type. The option is off by default. -.. ghc-flag:: -Wmissing-pat-syn-sigs +.. ghc-flag:: -Wmissing-pat-syn-signatures .. index:: single: type signatures, missing, pattern synonyms If you would like GHC to check that every pattern synonym has a type - signature, use the :ghc-flag:`-Wmissing-pat-syn-sigs` option. If this option is + signature, use the :ghc-flag:`-Wmissing-pat-syn-signatures` option. If this option is used in conjunction with :ghc-flag:`-Wmissing-exported-sigs` then only exported pattern synonyms must have a type signature. GHC also reports the inferred type. This option is off by default. diff --git a/testsuite/tests/patsyn/should_fail/T11053.hs b/testsuite/tests/patsyn/should_fail/T11053.hs index 33dec45..1ef3026 100644 --- a/testsuite/tests/patsyn/should_fail/T11053.hs +++ b/testsuite/tests/patsyn/should_fail/T11053.hs @@ -1,5 +1,5 @@ {-# LANGUAGE PatternSynonyms #-} --- turn on with -fwarn-missing-pat-syn-sigs +-- turn on with -fwarn-missing-pat-syn-signatures module Foo where diff --git a/testsuite/tests/patsyn/should_fail/all.T b/testsuite/tests/patsyn/should_fail/all.T index fbe5d58..871d623 100644 --- a/testsuite/tests/patsyn/should_fail/all.T +++ b/testsuite/tests/patsyn/should_fail/all.T @@ -26,6 +26,6 @@ test('poly-export-fail2', expect_broken(10653), compile_fail, ['']) test('export-super-class-fail', expect_broken(10653), compile_fail, ['']) test('export-type-synonym', normal, compile_fail, ['']) test('export-ps-rec-sel', normal, compile_fail, ['']) -test('T11053', normal, compile, ['-fwarn-missing-pat-syn-sigs']) +test('T11053', normal, compile, ['-fwarn-missing-pat-syn-signatures']) test('T10426', normal, compile_fail, ['']) test('T11265', normal, compile_fail, ['']) From git at git.haskell.org Tue Feb 16 08:25:45 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 16 Feb 2016 08:25:45 +0000 (UTC) Subject: [commit: packages/stm] master: Don't use only_compiler_types, assume ghc (a92741a) Message-ID: <20160216082545.02E283A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/stm On branch : master Link : http://git.haskell.org/packages/stm.git/commitdiff/a92741a64796eace06bc3c86467a0d036acf6eb9 >--------------------------------------------------------------- commit a92741a64796eace06bc3c86467a0d036acf6eb9 Author: Thomas Miedema Date: Tue Feb 16 09:26:57 2016 +0100 Don't use only_compiler_types, assume ghc >--------------------------------------------------------------- a92741a64796eace06bc3c86467a0d036acf6eb9 tests/all.T | 23 ++++++++++------------- 1 file changed, 10 insertions(+), 13 deletions(-) diff --git a/tests/all.T b/tests/all.T index 0efd7e8..92b641d 100644 --- a/tests/all.T +++ b/tests/all.T @@ -1,23 +1,20 @@ -setTestOpts(reqlib('stm')) - -test('stm046', only_compiler_types(['ghc']), compile_and_run, ['']) +test('stm046', [], compile_and_run, ['']) # Omit GHCi for these two, since they appear to deadlock (23/11/2004 --SDM) test('stm047', - [ only_compiler_types(['ghc']), - omit_ways(['ghci']), - when(compiler_lt('ghc', '6.9'), omit_ways(['ghci', 'threaded2'])) ], + [omit_ways(['ghci']), + when(compiler_lt('ghc', '6.9'), omit_ways(['ghci', 'threaded2']))], compile_and_run, ['']) test('stm048', - [ only_compiler_types(['ghc']), - omit_ways(['ghci']), - when(compiler_lt('ghc', '6.9'), omit_ways(['ghci', 'threaded2'])) ], + [omit_ways(['ghci']), + when(compiler_lt('ghc', '6.9'), omit_ways(['ghci', 'threaded2']))], compile_and_run, ['']) -test('stm049', [ reqlib('random'), only_compiler_types(['ghc']) ], - compile_and_run, ['-package stm']) -test('stm050', [ only_compiler_types(['ghc']), - extra_run_opts('10000') ], compile_and_run, ['-package stm']) +# The above tests don't require 'stm', but the ones below do. +setTestOpts(reqlib('stm')) + +test('stm049', [reqlib('random')], compile_and_run, ['-package stm']) +test('stm050', [extra_run_opts('10000')], compile_and_run, ['-package stm']) # Was failing prof ways due to #1547, but now apparently succeeds: test('stm052', [ reqlib('random'), From git at git.haskell.org Tue Feb 16 10:50:52 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 16 Feb 2016 10:50:52 +0000 (UTC) Subject: [commit: packages/hpc] master: Don't use only_compiler_types, assume ghc (6bfeb4c) Message-ID: <20160216105052.0EA333A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/hpc On branch : master Link : http://git.haskell.org/packages/hpc.git/commitdiff/6bfeb4c73ef44d2074f6edb314b9735bb57b8ef1 >--------------------------------------------------------------- commit 6bfeb4c73ef44d2074f6edb314b9735bb57b8ef1 Author: Thomas Miedema Date: Tue Feb 16 11:47:23 2016 +0100 Don't use only_compiler_types, assume ghc >--------------------------------------------------------------- 6bfeb4c73ef44d2074f6edb314b9735bb57b8ef1 tests/fork/test.T | 4 +--- tests/function/test.T | 4 +--- tests/function2/test.T | 4 +--- tests/ghc_ghci/test.T | 9 ++------- tests/raytrace/test.T | 4 +--- tests/raytrace/tixs/test.T | 4 +--- tests/simple/test.T | 4 +--- tests/simple/tixs/test.T | 4 +--- 8 files changed, 9 insertions(+), 28 deletions(-) diff --git a/tests/fork/test.T b/tests/fork/test.T index 40638fa..cd8b963 100644 --- a/tests/fork/test.T +++ b/tests/fork/test.T @@ -1,6 +1,4 @@ -setTestOpts([only_compiler_types(['ghc']), - omit_ways(['ghci','threaded2']), - when(fast(), skip)]) +setTestOpts([omit_ways(['ghci','threaded2']), when(fast(), skip)]) hpc_prefix = "perl ../hpcrun.pl --clear --exeext={exeext} --hpc={hpc}" diff --git a/tests/function/test.T b/tests/function/test.T index 88bc6b1..15bf7b2 100644 --- a/tests/function/test.T +++ b/tests/function/test.T @@ -1,6 +1,4 @@ -setTestOpts([only_compiler_types(['ghc']), - omit_ways(['ghci']), - when(fast(), skip)]) +setTestOpts([omit_ways(['ghci']), when(fast(), skip)]) hpc_prefix = "perl ../hpcrun.pl --clear --exeext={exeext} --hpc={hpc}" diff --git a/tests/function2/test.T b/tests/function2/test.T index b9362fd..52d78fb 100644 --- a/tests/function2/test.T +++ b/tests/function2/test.T @@ -1,6 +1,4 @@ -setTestOpts([only_compiler_types(['ghc']), - omit_ways(['ghci']), - when(fast(), skip)]) +setTestOpts([omit_ways(['ghci']), when(fast(), skip)]) hpc_prefix = "perl ../hpcrun.pl --clear --exeext={exeext} --hpc={hpc}" diff --git a/tests/ghc_ghci/test.T b/tests/ghc_ghci/test.T index c38dd83..25dfa9b 100644 --- a/tests/ghc_ghci/test.T +++ b/tests/ghc_ghci/test.T @@ -1,10 +1,5 @@ test('hpc_ghc_ghci', [extra_clean(['A.hi', 'A.o', '.hpc/A.mix', '.hpc/']), - only_ways(['normal']), - only_compiler_types(['ghc']), - when(compiler_profiled(), skip), - req_interp], - run_command, - ['$MAKE -s --no-print-directory hpc_ghc_ghci']) - + only_ways(['normal']), when(compiler_profiled(), skip), req_interp], + run_command, ['$MAKE -s --no-print-directory hpc_ghc_ghci']) \ No newline at end of file diff --git a/tests/raytrace/test.T b/tests/raytrace/test.T index d56a000..882fce2 100644 --- a/tests/raytrace/test.T +++ b/tests/raytrace/test.T @@ -1,6 +1,4 @@ -setTestOpts([only_compiler_types(['ghc']), - omit_ways(['ghci']), - when(fast(), skip)]) +setTestOpts([omit_ways(['ghci']), when(fast(), skip)]) hpc_prefix = "perl ../hpcrun.pl --clear --exeext={exeext} --hpc={hpc}" diff --git a/tests/raytrace/tixs/test.T b/tests/raytrace/tixs/test.T index 0a9428e..4d4a6f0 100644 --- a/tests/raytrace/tixs/test.T +++ b/tests/raytrace/tixs/test.T @@ -1,6 +1,4 @@ -setTestOpts([only_compiler_types(['ghc']), - omit_ways(['ghci']), - when(fast(), skip)]) +setTestOpts([omit_ways(['ghci']), when(fast(), skip)]) test('hpc_report_multi_001', normal, run_command, ["{hpc} report hpc_sample --include=Geometry --per-module"]) diff --git a/tests/simple/test.T b/tests/simple/test.T index f416a63..521d7bf 100644 --- a/tests/simple/test.T +++ b/tests/simple/test.T @@ -1,6 +1,4 @@ -setTestOpts([only_compiler_types(['ghc']), - omit_ways(['ghci']), - when(fast(), skip)]) +setTestOpts([omit_ways(['ghci']), when(fast(), skip)]) hpc_prefix = "perl ../hpcrun.pl --clear --exeext={exeext} --hpc={hpc}" diff --git a/tests/simple/tixs/test.T b/tests/simple/tixs/test.T index 71c9ad5..a32b4a9 100644 --- a/tests/simple/tixs/test.T +++ b/tests/simple/tixs/test.T @@ -1,6 +1,4 @@ -setTestOpts([only_compiler_types(['ghc']), - omit_ways(['ghci']), - when(fast(), skip)]) +setTestOpts([omit_ways(['ghci']), when(fast(), skip)]) test('hpc_help', normal, run_command, ["{hpc} help"]) test('hpc_help_help', normal, run_command, ["{hpc} help help"]) From git at git.haskell.org Tue Feb 16 12:50:30 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 16 Feb 2016 12:50:30 +0000 (UTC) Subject: [commit: ghc] master: Add missing newlines at end of file [skip ci] (ed69b21) Message-ID: <20160216125030.B92A63A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ed69b215018fb34d70ed8e11166ce970ff6bfe74/ghc >--------------------------------------------------------------- commit ed69b215018fb34d70ed8e11166ce970ff6bfe74 Author: Thomas Miedema Date: Mon Feb 15 23:20:56 2016 +0100 Add missing newlines at end of file [skip ci] >--------------------------------------------------------------- ed69b215018fb34d70ed8e11166ce970ff6bfe74 testsuite/tests/module/mod48.hs | 0 testsuite/tests/module/mod50.hs | 0 testsuite/tests/module/mod51.hs | 0 testsuite/tests/module/mod52.hs | 0 testsuite/tests/module/mod59.hs | 0 testsuite/tests/module/mod60.hs | 0 testsuite/tests/module/mod61.hs | 0 testsuite/tests/warnings/should_compile/T9178.hs | 0 8 files changed, 0 insertions(+), 0 deletions(-) From git at git.haskell.org Tue Feb 16 12:50:33 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 16 Feb 2016 12:50:33 +0000 (UTC) Subject: [commit: ghc] master: Testsuite: delete only_compiler_types, assume ghc (d066e68) Message-ID: <20160216125033.830463A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d066e68792bd1f3b6c4ce8626872aa78cc5179c1/ghc >--------------------------------------------------------------- commit d066e68792bd1f3b6c4ce8626872aa78cc5179c1 Author: Thomas Miedema Date: Mon Feb 15 23:31:58 2016 +0100 Testsuite: delete only_compiler_types, assume ghc Update submodules stm, hpc and unix. Differential Revision: https://phabricator.haskell.org/D1921 >--------------------------------------------------------------- d066e68792bd1f3b6c4ce8626872aa78cc5179c1 libraries/hpc | 2 +- libraries/stm | 2 +- libraries/unix | 2 +- testsuite/driver/testlib.py | 6 --- testsuite/tests/partial-sigs/should_compile/all.T | 3 +- testsuite/tests/pmcheck/should_compile/all.T | 66 +++++++++++++++-------- 6 files changed, 48 insertions(+), 33 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 d066e68792bd1f3b6c4ce8626872aa78cc5179c1 From git at git.haskell.org Tue Feb 16 13:44:34 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 16 Feb 2016 13:44:34 +0000 (UTC) Subject: [commit: packages/stm] master: stm047 and stm048 seem to work fine with WAY=ghci (ee75600) Message-ID: <20160216134434.78E4F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/stm On branch : master Link : http://git.haskell.org/packages/stm.git/commitdiff/ee756000fc654a105ff3f8a319b904f2df33c65b >--------------------------------------------------------------- commit ee756000fc654a105ff3f8a319b904f2df33c65b Author: Thomas Miedema Date: Tue Feb 16 13:10:02 2016 +0100 stm047 and stm048 seem to work fine with WAY=ghci Also delete compiler_lt. >--------------------------------------------------------------- ee756000fc654a105ff3f8a319b904f2df33c65b tests/all.T | 18 +++--------------- 1 file changed, 3 insertions(+), 15 deletions(-) diff --git a/tests/all.T b/tests/all.T index 92b641d..26000af 100644 --- a/tests/all.T +++ b/tests/all.T @@ -1,14 +1,6 @@ test('stm046', [], compile_and_run, ['']) - -# Omit GHCi for these two, since they appear to deadlock (23/11/2004 --SDM) -test('stm047', - [omit_ways(['ghci']), - when(compiler_lt('ghc', '6.9'), omit_ways(['ghci', 'threaded2']))], - compile_and_run, ['']) -test('stm048', - [omit_ways(['ghci']), - when(compiler_lt('ghc', '6.9'), omit_ways(['ghci', 'threaded2']))], - compile_and_run, ['']) +test('stm047', [], compile_and_run, ['']) +test('stm048', [], compile_and_run, ['']) # The above tests don't require 'stm', but the ones below do. setTestOpts(reqlib('stm')) @@ -16,11 +8,7 @@ setTestOpts(reqlib('stm')) test('stm049', [reqlib('random')], compile_and_run, ['-package stm']) test('stm050', [extra_run_opts('10000')], compile_and_run, ['-package stm']) -# Was failing prof ways due to #1547, but now apparently succeeds: -test('stm052', [ reqlib('random'), - when(compiler_lt('ghc', '6.9'), - expect_broken_for(1547,['profc','profasm'])) ], - compile_and_run, ['-package stm']) +test('stm052', [reqlib('random')], compile_and_run, ['-package stm']) test('stm053', [ reqlib('random'), only_ways(['threaded1','threaded2']), From git at git.haskell.org Tue Feb 16 13:44:59 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 16 Feb 2016 13:44:59 +0000 (UTC) Subject: [commit: packages/hpc] master: Add missing newline at end of file (63adbd0) Message-ID: <20160216134459.982063A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/hpc On branch : master Link : http://git.haskell.org/packages/hpc.git/commitdiff/63adbd0ca8be391358c0313a94d5c1801ceafb55 >--------------------------------------------------------------- commit 63adbd0ca8be391358c0313a94d5c1801ceafb55 Author: Thomas Miedema Date: Tue Feb 16 14:15:58 2016 +0100 Add missing newline at end of file >--------------------------------------------------------------- 63adbd0ca8be391358c0313a94d5c1801ceafb55 tests/ghc_ghci/test.T | 0 1 file changed, 0 insertions(+), 0 deletions(-) From git at git.haskell.org Tue Feb 16 17:12:05 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 16 Feb 2016 17:12:05 +0000 (UTC) Subject: [commit: ghc] wip/rae: Fix #11241. (206bb23) Message-ID: <20160216171205.089ED3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/206bb235c51a36592b200e36082a723ba907df5e/ghc >--------------------------------------------------------------- commit 206bb235c51a36592b200e36082a723ba907df5e Author: Richard Eisenberg Date: Wed Feb 10 08:35:22 2016 -0500 Fix #11241. When renaming a type, now looks for wildcards in bound variables' kinds. testcase: dependent/should_compile/T11241 >--------------------------------------------------------------- 206bb235c51a36592b200e36082a723ba907df5e compiler/rename/RnTypes.hs | 9 ++++++++- testsuite/tests/dependent/should_compile/T11241.hs | 6 ++++++ testsuite/tests/dependent/should_compile/T11241.stderr | 6 ++++++ testsuite/tests/dependent/should_compile/all.T | 2 +- 4 files changed, 21 insertions(+), 2 deletions(-) diff --git a/compiler/rename/RnTypes.hs b/compiler/rename/RnTypes.hs index 0d7f68c..118a32b 100644 --- a/compiler/rename/RnTypes.hs +++ b/compiler/rename/RnTypes.hs @@ -147,7 +147,9 @@ rnWcSigTy env (L loc hs_ty@(HsForAllTy { hst_bndrs = tvs, hst_body = hs_tau })) Nothing [] tvs $ \ _ tvs' -> do { (hs_tau', fvs) <- rnWcSigTy env hs_tau ; let hs_ty' = HsForAllTy { hst_bndrs = tvs', hst_body = hswc_body hs_tau' } - ; return ( hs_tau' { hswc_body = L loc hs_ty' }, fvs) } + awcs_bndrs = collectAnonWildCardsBndrs tvs' + ; return ( hs_tau' { hswc_wcs = hswc_wcs hs_tau' ++ awcs_bndrs + , hswc_body = L loc hs_ty' }, fvs) } rnWcSigTy env (L loc (HsQualTy { hst_ctxt = hs_ctxt, hst_body = tau })) = do { (hs_ctxt', fvs1) <- rnWcSigContext env hs_ctxt @@ -1043,6 +1045,11 @@ collectAnonWildCards lty = go lty prefix_types_only (HsAppPrefix ty) = Just ty prefix_types_only (HsAppInfix _) = Nothing +collectAnonWildCardsBndrs :: [LHsTyVarBndr Name] -> [Name] +collectAnonWildCardsBndrs ltvs = concatMap (go . unLoc) ltvs + where + go (UserTyVar _) = [] + go (KindedTyVar _ ki) = collectAnonWildCards ki {- ********************************************************* diff --git a/testsuite/tests/dependent/should_compile/T11241.hs b/testsuite/tests/dependent/should_compile/T11241.hs new file mode 100644 index 0000000..47d20d6 --- /dev/null +++ b/testsuite/tests/dependent/should_compile/T11241.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE ExplicitForAll, KindSignatures, PartialTypeSignatures #-} + +module T11241 where + +foo :: forall (a :: _) . a -> a +foo = id diff --git a/testsuite/tests/dependent/should_compile/T11241.stderr b/testsuite/tests/dependent/should_compile/T11241.stderr new file mode 100644 index 0000000..49a39a9 --- /dev/null +++ b/testsuite/tests/dependent/should_compile/T11241.stderr @@ -0,0 +1,6 @@ + +T11241.hs:5:21: warning: + ? Found type wildcard ?_? standing for ?*? + ? In the type signature: + foo :: forall (a :: _). a -> a + ? Relevant bindings include foo :: a -> a (bound at T11241.hs:6:1) diff --git a/testsuite/tests/dependent/should_compile/all.T b/testsuite/tests/dependent/should_compile/all.T index 571a9fb..783fa16 100644 --- a/testsuite/tests/dependent/should_compile/all.T +++ b/testsuite/tests/dependent/should_compile/all.T @@ -16,4 +16,4 @@ test('T9632', normal, compile, ['']) test('dynamic-paper', expect_fail_for(['optasm', 'optllvm']), compile, ['']) test('T11311', normal, compile, ['']) test('T11405', normal, compile, ['']) - +test('T11241', normal, compile, ['']) From git at git.haskell.org Tue Feb 16 17:12:08 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 16 Feb 2016 17:12:08 +0000 (UTC) Subject: [commit: ghc] wip/rae: Fix #11313. (5235a5d) Message-ID: <20160216171208.69C883A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/5235a5ddb43fe5b2f428366406e8f7adaff9f713/ghc >--------------------------------------------------------------- commit 5235a5ddb43fe5b2f428366406e8f7adaff9f713 Author: Richard Eisenberg Date: Wed Feb 10 09:38:09 2016 -0500 Fix #11313. Previously, we looked through synonyms when counting arguments, but that's a bit silly. >--------------------------------------------------------------- 5235a5ddb43fe5b2f428366406e8f7adaff9f713 compiler/typecheck/TcMType.hs | 5 +++-- compiler/types/Type.hs | 17 ++++++++++++++++- testsuite/tests/typecheck/should_fail/T11313.hs | 9 +++++++++ testsuite/tests/typecheck/should_fail/T11313.stderr | 6 ++++++ testsuite/tests/typecheck/should_fail/all.T | 1 + 5 files changed, 35 insertions(+), 3 deletions(-) diff --git a/compiler/typecheck/TcMType.hs b/compiler/typecheck/TcMType.hs index e4c8b4b..e4da9aa 100644 --- a/compiler/typecheck/TcMType.hs +++ b/compiler/typecheck/TcMType.hs @@ -1328,13 +1328,14 @@ zonkTidyTcType env ty = do { ty' <- zonkTcType ty -- | Make an 'ErrorThing' storing a type. mkTypeErrorThing :: TcType -> ErrorThing -mkTypeErrorThing ty = ErrorThing ty (Just $ length $ snd $ splitAppTys ty) +mkTypeErrorThing ty = ErrorThing ty (Just $ length $ snd $ repSplitAppTys ty) zonkTidyTcType + -- NB: Use *rep*splitAppTys, else we get #11313 -- | Make an 'ErrorThing' storing a type, with some extra args known about mkTypeErrorThingArgs :: TcType -> Int -> ErrorThing mkTypeErrorThingArgs ty num_args - = ErrorThing ty (Just $ (length $ snd $ splitAppTys ty) + num_args) + = ErrorThing ty (Just $ (length $ snd $ repSplitAppTys ty) + num_args) zonkTidyTcType zonkTidyOrigin :: TidyEnv -> CtOrigin -> TcM (TidyEnv, CtOrigin) diff --git a/compiler/types/Type.hs b/compiler/types/Type.hs index 67365e3..1d6d086 100644 --- a/compiler/types/Type.hs +++ b/compiler/types/Type.hs @@ -21,7 +21,7 @@ module Type ( mkTyVarTy, mkTyVarTys, getTyVar, getTyVar_maybe, repGetTyVar_maybe, getCastedTyVar_maybe, tyVarKind, - mkAppTy, mkAppTys, splitAppTy, splitAppTys, + mkAppTy, mkAppTys, splitAppTy, splitAppTys, repSplitAppTys, splitAppTy_maybe, repSplitAppTy_maybe, tcRepSplitAppTy_maybe, mkFunTy, mkFunTys, splitFunTy, splitFunTy_maybe, @@ -691,6 +691,21 @@ splitAppTys ty = split ty ty [] (TyConApp funTyCon [], [ty1,ty2]) split orig_ty _ args = (orig_ty, args) +-- | Like 'splitAppTys', but doesn't look through type synonyms +repSplitAppTys :: Type -> (Type, [Type]) +repSplitAppTys ty = split ty [] + where + split (AppTy ty arg) args = split ty (arg:args) + split (TyConApp tc tc_args) args + = let n | mightBeUnsaturatedTyCon tc = 0 + | otherwise = tyConArity tc + (tc_args1, tc_args2) = splitAt n tc_args + in + (TyConApp tc tc_args1, tc_args2 ++ args) + split (ForAllTy (Anon ty1) ty2) args = ASSERT( null args ) + (TyConApp funTyCon [], [ty1, ty2]) + split ty args = (ty, args) + {- LitTy ~~~~~ diff --git a/testsuite/tests/typecheck/should_fail/T11313.hs b/testsuite/tests/typecheck/should_fail/T11313.hs new file mode 100644 index 0000000..86ac958 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T11313.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE TypeApplications #-} + +module T11313 where + +import Data.Kind + +x = fmap @ (*) + +-- test error message output, which was quite silly before diff --git a/testsuite/tests/typecheck/should_fail/T11313.stderr b/testsuite/tests/typecheck/should_fail/T11313.stderr new file mode 100644 index 0000000..7a681d1 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T11313.stderr @@ -0,0 +1,6 @@ + +T11313.hs:7:12: error: + ? Expected kind ?* -> *?, but ?*? has kind ?*? + ? In the type ?*? + In the expression: fmap @* + In an equation for ?x?: x = fmap @* diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T index 69df866..7ca4141 100644 --- a/testsuite/tests/typecheck/should_fail/all.T +++ b/testsuite/tests/typecheck/should_fail/all.T @@ -407,3 +407,4 @@ test('T11464', normal, compile_fail, ['']) test('T11473', expect_broken(11473), compile_fail, ['']) test('T11563', normal, compile_fail, ['']) test('T11541', normal, compile_fail, ['']) +test('T11313', normal, compile_fail, ['']) From git at git.haskell.org Tue Feb 16 17:12:11 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 16 Feb 2016 17:12:11 +0000 (UTC) Subject: [commit: ghc] wip/rae: Fix #11246. (20d9c3a) Message-ID: <20160216171211.87FB13A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/20d9c3aa303f954dccc1e2865e1e87775750660c/ghc >--------------------------------------------------------------- commit 20d9c3aa303f954dccc1e2865e1e87775750660c Author: Richard Eisenberg Date: Wed Feb 10 09:09:26 2016 -0500 Fix #11246. We have to instantiate any invisible arguments to type families right away. This is now done in tcTyCon in TcHsType. testcase: typecheck/should_compile/T11246 >--------------------------------------------------------------- 20d9c3aa303f954dccc1e2865e1e87775750660c compiler/typecheck/TcHsType.hs | 47 ++++++++++++++-------- compiler/typecheck/TcTyClsDecls.hs | 47 +++++++++++++--------- compiler/types/TyCon.hs | 10 +++-- testsuite/tests/typecheck/should_compile/T11246.hs | 5 +++ testsuite/tests/typecheck/should_compile/all.T | 1 + 5 files changed, 72 insertions(+), 38 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 20d9c3aa303f954dccc1e2865e1e87775750660c From git at git.haskell.org Tue Feb 16 20:41:45 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 16 Feb 2016 20:41:45 +0000 (UTC) Subject: [commit: ghc] wip/rae: Fix #11313. (550353d) Message-ID: <20160216204145.DBEC83A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/550353d306e32553b19d2b0f882fdc832d2ca357/ghc >--------------------------------------------------------------- commit 550353d306e32553b19d2b0f882fdc832d2ca357 Author: Richard Eisenberg Date: Wed Feb 10 09:38:09 2016 -0500 Fix #11313. Previously, we looked through synonyms when counting arguments, but that's a bit silly. >--------------------------------------------------------------- 550353d306e32553b19d2b0f882fdc832d2ca357 compiler/typecheck/TcMType.hs | 5 +- compiler/typecheck/TcTyClsDecls.hs | 55 ++++++++++++---------- compiler/types/TyCon.hs | 7 ++- compiler/types/Type.hs | 17 ++++++- testsuite/tests/typecheck/should_fail/T11313.hs | 9 ++++ .../tests/typecheck/should_fail/T11313.stderr | 6 +++ testsuite/tests/typecheck/should_fail/all.T | 1 + 7 files changed, 71 insertions(+), 29 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 550353d306e32553b19d2b0f882fdc832d2ca357 From git at git.haskell.org Tue Feb 16 22:13:13 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 16 Feb 2016 22:13:13 +0000 (UTC) Subject: [commit: ghc] master: Bump haddock submodule (c8df3f1) Message-ID: <20160216221313.65DA33A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c8df3f1e708c57fd1e3846a5a34464cec4ddc891/ghc >--------------------------------------------------------------- commit c8df3f1e708c57fd1e3846a5a34464cec4ddc891 Author: Ben Gamari Date: Fri Feb 12 10:04:48 2016 +0100 Bump haddock submodule >--------------------------------------------------------------- c8df3f1e708c57fd1e3846a5a34464cec4ddc891 utils/haddock | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/utils/haddock b/utils/haddock index 57a5dcf..e18d166 160000 --- a/utils/haddock +++ b/utils/haddock @@ -1 +1 @@ -Subproject commit 57a5dcfd3d2a7e01229a2c3a79b1f99cd95d5de1 +Subproject commit e18d166b39cdc8c6672b626b4b840c1c383a9685 From git at git.haskell.org Tue Feb 16 22:13:16 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 16 Feb 2016 22:13:16 +0000 (UTC) Subject: [commit: ghc] master: Make bootstrapping more robust (525a304) Message-ID: <20160216221316.173B03A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/525a304f8c010ce73f1456e507aca668eb4917ac/ghc >--------------------------------------------------------------- commit 525a304f8c010ce73f1456e507aca668eb4917ac Author: Herbert Valerio Riedel Date: Tue Feb 16 22:41:29 2016 +0100 Make bootstrapping more robust Starting with GHC 8.0 we rely on GHC's native cabal macro generation. As a side-effect, this limits the packages in scope when compiling `ghc-cabal` for all bootstrapping GHCs. Reviewers: ezyang, austin, thomie, bgamari Reviewed By: thomie, bgamari Differential Revision: https://phabricator.haskell.org/D1897 GHC Trac Issues: #11413 >--------------------------------------------------------------- 525a304f8c010ce73f1456e507aca668eb4917ac utils/ghc-cabal/cabal_macros_boot.h | 4 +++- utils/ghc-cabal/ghc.mk | 16 ++++++++++++++++ 2 files changed, 19 insertions(+), 1 deletion(-) diff --git a/utils/ghc-cabal/cabal_macros_boot.h b/utils/ghc-cabal/cabal_macros_boot.h index a2da63a..3b130e8 100644 --- a/utils/ghc-cabal/cabal_macros_boot.h +++ b/utils/ghc-cabal/cabal_macros_boot.h @@ -1,6 +1,8 @@ /* defines a few MIN_VERSION_...() macros used by some of the bootstrap packages */ -#if __GLASGOW_HASKELL__ >= 711 +#if __GLASGOW_HASKELL__ >= 800 +/* macros are generated accurately by GHC on the fly */ +#elif __GLASGOW_HASKELL__ >= 711 /* package base-4.9.0.0 */ # define MIN_VERSION_base(major1,major2,minor) (\ (major1) < 4 || \ diff --git a/utils/ghc-cabal/ghc.mk b/utils/ghc-cabal/ghc.mk index 49a2ba3..c06a011 100644 --- a/utils/ghc-cabal/ghc.mk +++ b/utils/ghc-cabal/ghc.mk @@ -18,6 +18,20 @@ CABAL_DOTTED_VERSION := $(shell grep "^version:" libraries/Cabal/Cabal/Cabal.cab CABAL_VERSION := $(subst .,$(comma),$(CABAL_DOTTED_VERSION)) CABAL_CONSTRAINT := --constraint="Cabal == $(CABAL_DOTTED_VERSION)" +# Starting with GHC 8.0 we make use of GHC's native ability to +# generate MIN_VERSION_() CPP macros (rather than relying on +# the fragile `cabal_macros_boot.h` hack). The generation of those +# macros is triggered by `-hide-all-packages`, so we have to explicitly +# enumerate all packages we need in scope. In order to simplify the logic, +# we pass `-hide-all-packages` also to GHCs < 8, and we include +# `cabal_macros_boot.h` also for GHC >= 8 (in which case it becomes a +# dummy include that doesn't contribute any macro definitions). +ifeq "$(Windows_Host)" "YES" +CABAL_BUILD_DEPS := base array time containers bytestring deepseq process pretty directory Win32 +else +CABAL_BUILD_DEPS := base array time containers bytestring deepseq process pretty directory unix +endif + ghc-cabal_DIST_BINARY_NAME = ghc-cabal$(exeext0) ghc-cabal_DIST_BINARY = utils/ghc-cabal/dist/build/tmp/$(ghc-cabal_DIST_BINARY_NAME) ghc-cabal_INPLACE = inplace/bin/$(ghc-cabal_DIST_BINARY_NAME) @@ -34,6 +48,8 @@ $(ghc-cabal_DIST_BINARY): utils/ghc-cabal/Main.hs $(TOUCH_DEP) | $$(dir $$@)/. b "$(GHC)" $(SRC_HC_OPTS) \ $(addprefix -optc, $(SRC_CC_OPTS) $(CONF_CC_OPTS_STAGE0)) \ $(addprefix -optl, $(SRC_LD_OPTS) $(CONF_LD_OPTS_STAGE0)) \ + -hide-all-packages \ + $(addprefix -package , $(CABAL_BUILD_DEPS)) \ --make utils/ghc-cabal/Main.hs -o $@ \ -no-user-$(GHC_PACKAGE_DB_FLAG) \ -Wall -fno-warn-unused-imports -fno-warn-warnings-deprecations \ From git at git.haskell.org Tue Feb 16 22:13:19 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 16 Feb 2016 22:13:19 +0000 (UTC) Subject: [commit: ghc] master: Improved error message about exported type operators. (693a54e) Message-ID: <20160216221319.5D4B13A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/693a54ea7ac6bdd229e0a297fc023d25263077b9/ghc >--------------------------------------------------------------- commit 693a54ea7ac6bdd229e0a297fc023d25263077b9 Author: Ulya Trofimovich Date: Tue Feb 16 22:41:50 2016 +0100 Improved error message about exported type operators. There is ambiguty between (1) type constructors and (2) data constructors in export lists, e.g. '%%' can stand for both of them. This ambiguity is resolved in favor of (2). If the exported data constructor is not in scope, but type constructor with the same name is in scope, GHC should suggest adding 'type' keyword to resolve ambiguity in favor of (1) and enabling 'TypeOperators' extension. The patch only extends the error message. See Trac #11432. Test Plan: `make test` Reviewers: simonpj, bgamari, austin Reviewed By: simonpj Subscribers: mpickering, thomie, goldfire, kosmikus Differential Revision: https://phabricator.haskell.org/D1902 GHC Trac Issues: #11432 >--------------------------------------------------------------- 693a54ea7ac6bdd229e0a297fc023d25263077b9 compiler/rename/RnEnv.hs | 23 ++++++++++++++++++++++- compiler/rename/RnNames.hs | 4 ++-- testsuite/tests/module/T11432.hs | 9 +++++++++ testsuite/tests/module/T11432.stderr | 10 ++++++++++ testsuite/tests/module/all.T | 1 + testsuite/tests/module/mod89.stderr | 0 6 files changed, 44 insertions(+), 3 deletions(-) diff --git a/compiler/rename/RnEnv.hs b/compiler/rename/RnEnv.hs index 868712b..5d74d7c 100644 --- a/compiler/rename/RnEnv.hs +++ b/compiler/rename/RnEnv.hs @@ -13,7 +13,7 @@ module RnEnv ( lookupLocalOccRn_maybe, lookupInfoOccRn, lookupLocalOccThLvl_maybe, lookupTypeOccRn, lookupKindOccRn, - lookupGlobalOccRn, lookupGlobalOccRn_maybe, + lookupGlobalOccRn, lookupGlobalOccRnExport, lookupGlobalOccRn_maybe, lookupOccRn_overloaded, lookupGlobalOccRn_overloaded, reportUnboundName, unknownNameSuggestions, addNameClashErrRn, @@ -853,6 +853,27 @@ lookupGlobalOccRn rdr_name Nothing -> do { traceRn (text "lookupGlobalOccRn" <+> ppr rdr_name) ; unboundName WL_Global rdr_name } } +-- like lookupGlobalOccRn but suggests adding 'type' keyword +-- to export type constructors mistaken for data constructors +lookupGlobalOccRnExport :: RdrName -> RnM Name +lookupGlobalOccRnExport rdr_name + = do { mb_name <- lookupGlobalOccRn_maybe rdr_name + ; case mb_name of + Just n -> return n + Nothing -> do { env <- getGlobalRdrEnv + ; let tycon = setOccNameSpace tcClsName (rdrNameOcc rdr_name) + msg = case lookupOccEnv env tycon of + Just (gre : _) -> make_msg gre + _ -> Outputable.empty + make_msg gre = hang + (hsep [text "Note: use", + quotes (text "type"), + text "keyword to export type constructor", + quotes (ppr (gre_name gre))]) + 2 (vcat [pprNameProvenance gre, + text "(requires TypeOperators extension)"]) + ; unboundNameX WL_Global rdr_name msg } } + lookupInfoOccRn :: RdrName -> RnM [Name] -- lookupInfoOccRn is intended for use in GHCi's ":info" command -- It finds all the GREs that RdrName could mean, not complaining diff --git a/compiler/rename/RnNames.hs b/compiler/rename/RnNames.hs index 7f89025..d8e08e2 100644 --- a/compiler/rename/RnNames.hs +++ b/compiler/rename/RnNames.hs @@ -1346,7 +1346,7 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod lookup_ie_with :: IE RdrName -> Located RdrName -> [Located RdrName] -> RnM (Located Name, [Located Name], [Name], [FieldLabel]) lookup_ie_with ie (L l rdr) sub_rdrs - = do name <- lookupGlobalOccRn rdr + = do name <- lookupGlobalOccRnExport rdr let gres = findChildren kids_env name mchildren = lookupChildren (map classifyGRE (gres ++ pat_syns)) sub_rdrs @@ -1366,7 +1366,7 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod lookup_ie_all :: IE RdrName -> Located RdrName -> RnM (Located Name, [Name], [FieldLabel]) lookup_ie_all ie (L l rdr) = - do name <- lookupGlobalOccRn rdr + do name <- lookupGlobalOccRnExport rdr let gres = findChildren kids_env name (non_flds, flds) = classifyGREs gres addUsedKids rdr gres diff --git a/testsuite/tests/module/T11432.hs b/testsuite/tests/module/T11432.hs new file mode 100644 index 0000000..408935d --- /dev/null +++ b/testsuite/tests/module/T11432.hs @@ -0,0 +1,9 @@ +{- +We expect to get a suggestion to add 'type' keyword +and enable TypeOperators extension. +-} + +{-# LANGUAGE TypeOperators #-} +module T11432 ((-.->)(..)) where + +newtype (f -.-> g) a = Fn { apFn :: f a -> g a } diff --git a/testsuite/tests/module/T11432.stderr b/testsuite/tests/module/T11432.stderr new file mode 100644 index 0000000..bf2a58b --- /dev/null +++ b/testsuite/tests/module/T11432.stderr @@ -0,0 +1,10 @@ + +T11432.hs:7:16: + Not in scope: ?-.->? + Note: use ?type? keyword to export type constructor ?-.->? + defined at T11432.hs:9:1 + (requires TypeOperators extension) + +T11432.hs:7:16: + The export item ?(-.->)(..)? + attempts to export constructors or class methods that are not visible here diff --git a/testsuite/tests/module/all.T b/testsuite/tests/module/all.T index cd1bdac..e6446fe 100644 --- a/testsuite/tests/module/all.T +++ b/testsuite/tests/module/all.T @@ -347,3 +347,4 @@ test('T9061', normal, compile, ['']) test('T9997', normal, compile, ['']) test('T10233', extra_clean(['T01233a.hi', 'T01233a.o']), multimod_compile, ['T10233', '-v0']) +test('T11432', normal, compile_fail, ['']) From git at git.haskell.org Tue Feb 16 22:13:22 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 16 Feb 2016 22:13:22 +0000 (UTC) Subject: [commit: ghc] master: Fix two wrong uses of "data constructor" in error msgs (af5a0e5) Message-ID: <20160216221322.12BAE3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/af5a0e5004cfb1e041280fd7c16f2c1bfee67961/ghc >--------------------------------------------------------------- commit af5a0e5004cfb1e041280fd7c16f2c1bfee67961 Author: Rik Steenkamp Date: Tue Feb 16 22:42:08 2016 +0100 Fix two wrong uses of "data constructor" in error msgs Replace `NoDataKinds :: PromotionErr` by `NoDataKindsTC` and `NoDataKindsDC` (just like there is `NoTypeInTypeTC` and `NoTypeInTypeDC`). This allows for a correct error message when a kind signature contains a type constructor and `-XDataKinds` is not specified. Apply a small fix to `TcError.hs` where instead of "data constructor" we should say "pattern synonym". Reviewers: austin, goldfire, bgamari Reviewed By: bgamari Subscribers: goldfire, thomie Differential Revision: https://phabricator.haskell.org/D1909 >--------------------------------------------------------------- af5a0e5004cfb1e041280fd7c16f2c1bfee67961 compiler/typecheck/TcErrors.hs | 6 ++++-- compiler/typecheck/TcHsType.hs | 9 +++++---- compiler/typecheck/TcRnTypes.hs | 9 ++++++--- 3 files changed, 15 insertions(+), 9 deletions(-) diff --git a/compiler/typecheck/TcErrors.hs b/compiler/typecheck/TcErrors.hs index e97e3c5..1fb2094 100644 --- a/compiler/typecheck/TcErrors.hs +++ b/compiler/typecheck/TcErrors.hs @@ -39,6 +39,7 @@ import NameSet import Bag import ErrUtils ( ErrMsg, errDoc, pprLocErrMsg ) import BasicTypes +import ConLike ( ConLike(..) ) import Util import FastString import Outputable @@ -1839,8 +1840,9 @@ mk_dict_err ctxt (ct, (matches, unifiers, unsafe_overlapped)) | orig <- origs ] ] ] | otherwise = [] - ppr_skol (PatSkol dc _) = text "the data constructor" <+> quotes (ppr dc) - ppr_skol skol_info = ppr skol_info + ppr_skol (PatSkol (RealDataCon dc) _) = text "the data constructor" <+> quotes (ppr dc) + ppr_skol (PatSkol (PatSynCon ps) _) = text "the pattern synonym" <+> quotes (ppr ps) + ppr_skol skol_info = ppr skol_info extra_note | any isFunTy (filterOutInvisibleTypes (classTyCon clas) tys) = text "(maybe you haven't applied a function to enough arguments?)" diff --git a/compiler/typecheck/TcHsType.hs b/compiler/typecheck/TcHsType.hs index f5537b6..d04ee97 100644 --- a/compiler/typecheck/TcHsType.hs +++ b/compiler/typecheck/TcHsType.hs @@ -987,7 +987,7 @@ tcTyVar mode name -- Could be a tyvar, a tycon, or a datacon ATcTyCon tc_tc -> do { data_kinds <- xoptM LangExt.DataKinds ; unless (isTypeLevel (mode_level mode) || data_kinds) $ - promotionErr name NoDataKinds + promotionErr name NoDataKindsTC ; tc <- get_loopy_tc name tc_tc ; return (mkNakedTyConApp tc [], tyConKind tc_tc) } -- mkNakedTyConApp: see Note [Type-checking inside the knot] @@ -1001,7 +1001,7 @@ tcTyVar mode name -- Could be a tyvar, a tycon, or a datacon ; unless (isTypeLevel (mode_level mode) || data_kinds || isKindTyCon tc) $ - promotionErr name NoDataKinds + promotionErr name NoDataKindsTC ; unless (isTypeLevel (mode_level mode) || type_in_type || isLegacyPromotableTyCon tc) $ @@ -1011,7 +1011,7 @@ tcTyVar mode name -- Could be a tyvar, a tycon, or a datacon AGlobal (AConLike (RealDataCon dc)) -> do { data_kinds <- xoptM LangExt.DataKinds ; unless (data_kinds || specialPromotedDc dc) $ - promotionErr name NoDataKinds + promotionErr name NoDataKindsDC ; type_in_type <- xoptM LangExt.TypeInType ; unless ( type_in_type || ( isTypeLevel (mode_level mode) && @@ -2142,7 +2142,8 @@ promotionErr name err where reason = case err of FamDataConPE -> text "it comes from a data family instance" - NoDataKinds -> text "Perhaps you intended to use DataKinds" + NoDataKindsTC -> text "Perhaps you intended to use DataKinds" + NoDataKindsDC -> text "Perhaps you intended to use DataKinds" NoTypeInTypeTC -> text "Perhaps you intended to use TypeInType" NoTypeInTypeDC -> text "Perhaps you intended to use TypeInType" PatSynPE -> text "Pattern synonyms cannot be promoted" diff --git a/compiler/typecheck/TcRnTypes.hs b/compiler/typecheck/TcRnTypes.hs index 7d7f265..0810ac8 100644 --- a/compiler/typecheck/TcRnTypes.hs +++ b/compiler/typecheck/TcRnTypes.hs @@ -905,7 +905,8 @@ data PromotionErr | RecDataConPE -- Data constructor in a recursive loop -- See Note [ARecDataCon: recusion and promoting data constructors] in TcTyClsDecls - | NoDataKinds -- -XDataKinds not enabled + | NoDataKindsTC -- -XDataKinds not enabled (for a tycon) + | NoDataKindsDC -- -XDataKinds not enabled (for a datacon) | NoTypeInTypeTC -- -XTypeInType not enabled (for a tycon) | NoTypeInTypeDC -- -XTypeInType not enabled (for a datacon) @@ -925,7 +926,8 @@ instance Outputable PromotionErr where ppr PatSynPE = text "PatSynPE" ppr FamDataConPE = text "FamDataConPE" ppr RecDataConPE = text "RecDataConPE" - ppr NoDataKinds = text "NoDataKinds" + ppr NoDataKindsTC = text "NoDataKindsTC" + ppr NoDataKindsDC = text "NoDataKindsDC" ppr NoTypeInTypeTC = text "NoTypeInTypeTC" ppr NoTypeInTypeDC = text "NoTypeInTypeDC" @@ -942,7 +944,8 @@ pprPECategory TyConPE = text "Type constructor" pprPECategory PatSynPE = text "Pattern synonym" pprPECategory FamDataConPE = text "Data constructor" pprPECategory RecDataConPE = text "Data constructor" -pprPECategory NoDataKinds = text "Data constructor" +pprPECategory NoDataKindsTC = text "Type constructor" +pprPECategory NoDataKindsDC = text "Data constructor" pprPECategory NoTypeInTypeTC = text "Type constructor" pprPECategory NoTypeInTypeDC = text "Data constructor" From git at git.haskell.org Tue Feb 16 22:13:24 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 16 Feb 2016 22:13:24 +0000 (UTC) Subject: [commit: ghc] master: PowerPC: Improve float register assignment. (3116003) Message-ID: <20160216221324.BB50C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/31160036c71f6f913623ea5c889ec3963d49768c/ghc >--------------------------------------------------------------- commit 31160036c71f6f913623ea5c889ec3963d49768c Author: Peter Trommler Date: Tue Feb 16 22:44:25 2016 +0100 PowerPC: Improve float register assignment. On Linux assign F5 and F6 and D3 through D6 to caller-saved registers. Fixes #11273 Test Plan: validate on powerpc (I validated on powerpc64) Reviewers: bgamari, erikd, austin Reviewed By: erikd, austin Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1914 GHC Trac Issues: #11273 >--------------------------------------------------------------- 31160036c71f6f913623ea5c889ec3963d49768c includes/stg/MachRegs.h | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/includes/stg/MachRegs.h b/includes/stg/MachRegs.h index ce4ebf4..ab1a421 100644 --- a/includes/stg/MachRegs.h +++ b/includes/stg/MachRegs.h @@ -332,9 +332,15 @@ the stack. See Note [Overlapping global registers] for implications. #define REG_F2 fr15 #define REG_F3 fr16 #define REG_F4 fr17 - -#define REG_D1 fr18 -#define REG_D2 fr19 +#define REG_F5 fr18 +#define REG_F6 fr19 + +#define REG_D1 fr20 +#define REG_D2 fr21 +#define REG_D3 fr22 +#define REG_D4 fr23 +#define REG_D5 fr24 +#define REG_D6 fr25 #endif From git at git.haskell.org Tue Feb 16 22:13:27 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 16 Feb 2016 22:13:27 +0000 (UTC) Subject: [commit: ghc] master: Fix typos (49c5cb4) Message-ID: <20160216221327.851223A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/49c5cb40f049f0a868fa310a240a31b571f40491/ghc >--------------------------------------------------------------- commit 49c5cb40f049f0a868fa310a240a31b571f40491 Author: Rik Steenkamp Date: Tue Feb 16 22:44:42 2016 +0100 Fix typos Reviewers: bgamari, austin Reviewed By: austin Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1915 >--------------------------------------------------------------- 49c5cb40f049f0a868fa310a240a31b571f40491 compiler/basicTypes/OccName.hs | 8 ++++---- compiler/basicTypes/PatSyn.hs | 8 ++++---- compiler/basicTypes/Unique.hs | 2 +- compiler/basicTypes/VarEnv.hs | 2 +- compiler/basicTypes/VarSet.hs | 2 +- compiler/hsSyn/HsBinds.hs | 2 +- compiler/typecheck/TcErrors.hs | 2 +- compiler/typecheck/TcPatSyn.hs | 12 ++++++------ compiler/typecheck/TcRnTypes.hs | 10 +++++----- compiler/types/TyCoRep.hs | 2 +- docs/users_guide/glasgow_exts.rst | 10 +++++----- testsuite/tests/monadfail/MonadFailWarnings.stderr | 8 ++++---- testsuite/tests/wcompat-warnings/WCompatWarningsOn.stderr | 2 +- 13 files changed, 35 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 49c5cb40f049f0a868fa310a240a31b571f40491 From git at git.haskell.org Tue Feb 16 22:13:31 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 16 Feb 2016 22:13:31 +0000 (UTC) Subject: [commit: ghc] master: Suggest candidate instances in error message (5fc06b9) Message-ID: <20160216221331.110D23A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5fc06b97b320e98febaa925085dac03e5b01fc5a/ghc >--------------------------------------------------------------- commit 5fc06b97b320e98febaa925085dac03e5b01fc5a Author: Yuras Shumovich Date: Tue Feb 16 22:45:13 2016 +0100 Suggest candidate instances in error message See Trac #9611. In "No instance..." error message we suggest instances for other types with the same occ name. It is usefull e.g. when we have two different versions of the same package installed. Test Plan: typecheck/should_fail/tcfail224 Reviewers: austin, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1919 GHC Trac Issues: #9611 >--------------------------------------------------------------- 5fc06b97b320e98febaa925085dac03e5b01fc5a compiler/typecheck/TcErrors.hs | 29 ++++++++++++++++++---- testsuite/tests/typecheck/should_fail/all.T | 1 + testsuite/tests/typecheck/should_fail/tcfail224.hs | 8 ++++++ .../tests/typecheck/should_fail/tcfail224.stderr | 7 ++++++ 4 files changed, 40 insertions(+), 5 deletions(-) diff --git a/compiler/typecheck/TcErrors.hs b/compiler/typecheck/TcErrors.hs index 7fcf574..c340e7c 100644 --- a/compiler/typecheck/TcErrors.hs +++ b/compiler/typecheck/TcErrors.hs @@ -1764,7 +1764,13 @@ mk_dict_err :: ReportErrCtxt -> (Ct, ClsInstLookupResult) mk_dict_err ctxt (ct, (matches, unifiers, unsafe_overlapped)) | null matches -- No matches but perhaps several unifiers = do { (ctxt, binds_msg, ct) <- relevantBindings True ctxt ct - ; return (ctxt, cannot_resolve_msg ct binds_msg) } + ; instEnvs <- tcGetInstEnvs + ; let candidate_insts = case tys of + -- find data types with the same occ name, see #9611 + [ty] -> filter (is_candidate_inst ty) + (classInstances instEnvs clas) + _ -> [] + ; return (ctxt, cannot_resolve_msg ct candidate_insts binds_msg) } | null unsafe_overlapped -- Some matches => overlap errors = return (ctxt, overlap_msg) @@ -1780,15 +1786,28 @@ mk_dict_err ctxt (ct, (matches, unifiers, unsafe_overlapped)) givens = getUserGivens ctxt all_tyvars = all isTyVarTy tys - - cannot_resolve_msg :: Ct -> SDoc -> SDoc - cannot_resolve_msg ct binds_msg + is_candidate_inst ty inst + | [other_ty] <- is_tys inst + , Just (tc1, _) <- tcSplitTyConApp_maybe ty + , Just (tc2, _) <- tcSplitTyConApp_maybe other_ty + = let n1 = tyConName tc1 + n2 = tyConName tc2 + different_names = n1 /= n2 + same_occ_names = nameOccName n1 == nameOccName n2 + in different_names && same_occ_names + | otherwise = False + + cannot_resolve_msg :: Ct -> [ClsInst] -> SDoc -> SDoc + cannot_resolve_msg ct candidate_insts binds_msg = vcat [ no_inst_msg , nest 2 extra_note , vcat (pp_givens givens) , ppWhen (has_ambig_tvs && not (null unifiers && null givens)) (vcat [ ppUnless lead_with_ambig ambig_msg, binds_msg, potential_msg ]) - , show_fixes (add_to_ctxt_fixes has_ambig_tvs ++ drv_fixes) ] + , show_fixes (add_to_ctxt_fixes has_ambig_tvs ++ drv_fixes) + , ppWhen (not (null candidate_insts)) + (hang (text "There are instances for similar types:") + 2 (vcat (map ppr candidate_insts))) ] where orig = ctOrigin ct -- See Note [Highlighting ambiguous type variables] diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T index 69df866..24ce95c 100644 --- a/testsuite/tests/typecheck/should_fail/all.T +++ b/testsuite/tests/typecheck/should_fail/all.T @@ -247,6 +247,7 @@ test('tcfail220', normal, multimod_compile_fail, ['tcfail220.hsig', '-sig-of "Sh test('tcfail221', normal, multimod_compile_fail, ['tcfail221.hsig', '-sig-of "ShouldFail is base:Prelude"']) test('tcfail222', normal, multimod_compile_fail, ['tcfail222.hsig', '-sig-of "ShouldFail is base:Data.STRef"']) test('tcfail223', normal, compile_fail, ['']) +test('tcfail224', normal, compile_fail, ['']) test('SilentParametersOverlapping', normal, compile, ['']) test('FailDueToGivenOverlapping', normal, compile_fail, ['']) diff --git a/testsuite/tests/typecheck/should_fail/tcfail224.hs b/testsuite/tests/typecheck/should_fail/tcfail224.hs new file mode 100644 index 0000000..d2bddb1 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/tcfail224.hs @@ -0,0 +1,8 @@ +module Foo where + +import Prelude hiding( Int ) + +data Int = Int + +f :: Int +f = 3 diff --git a/testsuite/tests/typecheck/should_fail/tcfail224.stderr b/testsuite/tests/typecheck/should_fail/tcfail224.stderr new file mode 100644 index 0000000..70088e2 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/tcfail224.stderr @@ -0,0 +1,7 @@ + +tcfail224.hs:8:5: error: + ? No instance for (Num Int) arising from the literal ?3? + There are instances for similar types: + instance Num GHC.Types.Int -- Defined in ?GHC.Num? + ? In the expression: 3 + In an equation for ?f?: f = 3 From git at git.haskell.org Tue Feb 16 22:13:33 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 16 Feb 2016 22:13:33 +0000 (UTC) Subject: [commit: ghc] master: Remove documentation for -Wlazy-unlifted-bindings (ad30c76) Message-ID: <20160216221333.CE90B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ad30c760f55205174b3b3472bbcd85fc51fb65d0/ghc >--------------------------------------------------------------- commit ad30c760f55205174b3b3472bbcd85fc51fb65d0 Author: Ben Gamari Date: Tue Feb 16 22:45:33 2016 +0100 Remove documentation for -Wlazy-unlifted-bindings This flag was supposed to be removed in 7.10. This finally resolves Trac #8022. Test Plan: Read it Reviewers: austin Reviewed By: austin Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1922 GHC Trac Issues: #8022 >--------------------------------------------------------------- ad30c760f55205174b3b3472bbcd85fc51fb65d0 docs/users_guide/using-warnings.rst | 4 ---- utils/mkUserGuidePart/Options/Warnings.hs | 7 ------- 2 files changed, 11 deletions(-) diff --git a/docs/users_guide/using-warnings.rst b/docs/users_guide/using-warnings.rst index 5727b82..e71ae92 100644 --- a/docs/users_guide/using-warnings.rst +++ b/docs/users_guide/using-warnings.rst @@ -371,10 +371,6 @@ of ``-W(no-)*``. Causes a warning to be emitted if an enumeration is empty, e.g. ``[5 .. 3]``. -.. ghc-flag:: -Wlazy-unlifted-bindings - - This flag is a no-op, and will be removed in GHC 7.10. - .. ghc-flag:: -Wduplicate-constraints .. index:: diff --git a/utils/mkUserGuidePart/Options/Warnings.hs b/utils/mkUserGuidePart/Options/Warnings.hs index de5e159..37597f8 100644 --- a/utils/mkUserGuidePart/Options/Warnings.hs +++ b/utils/mkUserGuidePart/Options/Warnings.hs @@ -117,13 +117,6 @@ warningsOptions = , flagType = DynamicFlag , flagReverse = "-Wno-incomplete-record-updates" } - , flag { flagName = "-Wlazy-unlifted-bindings" - , flagDescription = - "*(deprecated)* warn when a pattern binding looks lazy but "++ - "must be strict" - , flagType = DynamicFlag - , flagReverse = "-Wno-lazy-unlifted-bindings" - } , flag { flagName = "-Wmissing-fields" , flagDescription = "warn when fields of a record are uninitialised" , flagType = DynamicFlag From git at git.haskell.org Tue Feb 16 22:13:36 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 16 Feb 2016 22:13:36 +0000 (UTC) Subject: [commit: ghc] master: DynFlags: Don't panic on incompatible Safe Haskell flags (2b906af) Message-ID: <20160216221336.8AB333A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2b906af0dab01c30c28792d39161e01449b85cb0/ghc >--------------------------------------------------------------- commit 2b906af0dab01c30c28792d39161e01449b85cb0 Author: Ben Gamari Date: Tue Feb 16 22:45:57 2016 +0100 DynFlags: Don't panic on incompatible Safe Haskell flags We just return an arbitrary value since we are destined to fail due to the error anyways. Fixes #11580. Test Plan: Needs to be tested Reviewers: austin Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1925 GHC Trac Issues: #11580 >--------------------------------------------------------------- 2b906af0dab01c30c28792d39161e01449b85cb0 compiler/main/DynFlags.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 6460b16..52da300 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -1886,7 +1886,7 @@ combineSafeFlags :: SafeHaskellMode -> SafeHaskellMode -> DynP SafeHaskellMode combineSafeFlags a b | a == Sf_None = return b | b == Sf_None = return a | a == b = return a - | otherwise = addErr errm >> return (panic errm) + | otherwise = addErr errm >> pure a where errm = "Incompatible Safe Haskell flags! (" ++ show a ++ ", " ++ show b ++ ")" From git at git.haskell.org Wed Feb 17 14:03:28 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 17 Feb 2016 14:03:28 +0000 (UTC) Subject: [commit: ghc] master: Testsuite: delete compiler_lt/le/gt/ge setup functions (6f25fb3) Message-ID: <20160217140328.593D93A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6f25fb32d16f716c8e0da4ba950f2ff90b272108/ghc >--------------------------------------------------------------- commit 6f25fb32d16f716c8e0da4ba950f2ff90b272108 Author: Thomas Miedema Date: Tue Feb 16 14:17:35 2016 +0100 Testsuite: delete compiler_lt/le/gt/ge setup functions Since we're not consisently keeping track of which tests should pass with which compiler versions, there is no point in keeping these functions. Update submodules containers, hpc and stm. >--------------------------------------------------------------- 6f25fb32d16f716c8e0da4ba950f2ff90b272108 libraries/containers | 2 +- libraries/hpc | 2 +- libraries/stm | 2 +- testsuite/driver/testlib.py | 20 -------------------- testsuite/tests/codeGen/should_run/all.T | 5 +---- testsuite/tests/deSugar/should_run/all.T | 9 +++------ testsuite/tests/ghc-api/show-srcspan/all.T | 0 testsuite/tests/ghci.debugger/scripts/all.T | 2 +- testsuite/tests/ghci/should_fail/all.T | 0 testsuite/tests/indexed-types/should_run/all.T | 0 testsuite/tests/parser/should_compile/all.T | 4 ++-- testsuite/tests/parser/should_fail/all.T | 4 ++-- testsuite/tests/parser/should_run/all.T | 6 +++--- testsuite/tests/partial-sigs/should_fail/all.T | 0 testsuite/tests/plugins/all.T | 1 - testsuite/tests/pmcheck/should_compile/all.T | 0 testsuite/tests/rebindable/all.T | 0 testsuite/tests/rename/should_fail/all.T | 9 +++------ testsuite/tests/rts/all.T | 10 ++-------- testsuite/tests/simplCore/should_fail/all.T | 0 testsuite/tests/th/all.T | 9 ++------- testsuite/tests/typecheck/should_compile/all.T | 8 ++++---- testsuite/tests/typecheck/should_fail/all.T | 21 +++++++++------------ testsuite/tests/typecheck/should_run/all.T | 4 ++-- 24 files changed, 37 insertions(+), 81 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 6f25fb32d16f716c8e0da4ba950f2ff90b272108 From git at git.haskell.org Wed Feb 17 14:36:55 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 17 Feb 2016 14:36:55 +0000 (UTC) Subject: [commit: ghc] master: Simplify the defn of coreViewOneStarKind (21b4228) Message-ID: <20160217143655.A3DEB3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/21b4228d750198bdcac8d68d13892cc960d6881f/ghc >--------------------------------------------------------------- commit 21b4228d750198bdcac8d68d13892cc960d6881f Author: Simon Peyton Jones Date: Wed Feb 17 14:36:49 2016 +0000 Simplify the defn of coreViewOneStarKind I discussed it with Richard, but this version is much simmpler and more efficient. >--------------------------------------------------------------- 21b4228d750198bdcac8d68d13892cc960d6881f compiler/types/Type.hs | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/compiler/types/Type.hs b/compiler/types/Type.hs index 1266b66..36da3a1 100644 --- a/compiler/types/Type.hs +++ b/compiler/types/Type.hs @@ -311,12 +311,11 @@ coreView _ = Nothing -- | Like 'coreView', but it also "expands" @Constraint@ to become -- @TYPE Lifted at . coreViewOneStarKind :: Type -> Maybe Type -coreViewOneStarKind = go Nothing - where - go _ t | Just t' <- coreView t = go (Just t') t' - go _ (TyConApp tc []) | isStarKindSynonymTyCon tc = go (Just t') t' - where t' = liftedTypeKind - go res _ = res +coreViewOneStarKind ty + | Just ty' <- coreView ty = Just ty' + | TyConApp tc [] <- ty + , isStarKindSynonymTyCon tc = Just liftedTypeKind + | otherwise = Nothing ----------------------------------------------- expandTypeSynonyms :: Type -> Type From git at git.haskell.org Wed Feb 17 14:36:58 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 17 Feb 2016 14:36:58 +0000 (UTC) Subject: [commit: ghc] master: Small refactor and comments (4c6e95e) Message-ID: <20160217143658.574723A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4c6e95e4f92516a925fd2a1bce0c0f8b5b9cbd17/ghc >--------------------------------------------------------------- commit 4c6e95e4f92516a925fd2a1bce0c0f8b5b9cbd17 Author: Simon Peyton Jones Date: Wed Feb 17 14:37:42 2016 +0000 Small refactor and comments Related to the fix to Trac #9611 >--------------------------------------------------------------- 4c6e95e4f92516a925fd2a1bce0c0f8b5b9cbd17 compiler/typecheck/TcErrors.hs | 34 +++++++++++++++++++++++++--------- 1 file changed, 25 insertions(+), 9 deletions(-) diff --git a/compiler/typecheck/TcErrors.hs b/compiler/typecheck/TcErrors.hs index c340e7c..2140a79 100644 --- a/compiler/typecheck/TcErrors.hs +++ b/compiler/typecheck/TcErrors.hs @@ -1764,12 +1764,7 @@ mk_dict_err :: ReportErrCtxt -> (Ct, ClsInstLookupResult) mk_dict_err ctxt (ct, (matches, unifiers, unsafe_overlapped)) | null matches -- No matches but perhaps several unifiers = do { (ctxt, binds_msg, ct) <- relevantBindings True ctxt ct - ; instEnvs <- tcGetInstEnvs - ; let candidate_insts = case tys of - -- find data types with the same occ name, see #9611 - [ty] -> filter (is_candidate_inst ty) - (classInstances instEnvs clas) - _ -> [] + ; candidate_insts <- get_candidate_instances ; return (ctxt, cannot_resolve_msg ct candidate_insts binds_msg) } | null unsafe_overlapped -- Some matches => overlap errors @@ -1786,7 +1781,16 @@ mk_dict_err ctxt (ct, (matches, unifiers, unsafe_overlapped)) givens = getUserGivens ctxt all_tyvars = all isTyVarTy tys - is_candidate_inst ty inst + get_candidate_instances :: TcM [ClsInst] + -- See Note [Report candidate instances] + get_candidate_instances + | [ty] <- tys -- Only try for single-parameter classes + = do { instEnvs <- tcGetInstEnvs + ; return (filter (is_candidate_inst ty) + (classInstances instEnvs clas)) } + | otherwise = return [] + + is_candidate_inst ty inst -- See Note [Report candidate instances] | [other_ty] <- is_tys inst , Just (tc1, _) <- tcSplitTyConApp_maybe ty , Just (tc2, _) <- tcSplitTyConApp_maybe other_ty @@ -1808,6 +1812,7 @@ mk_dict_err ctxt (ct, (matches, unifiers, unsafe_overlapped)) , ppWhen (not (null candidate_insts)) (hang (text "There are instances for similar types:") 2 (vcat (map ppr candidate_insts))) ] + -- See Note [Report candidate instances] where orig = ctOrigin ct -- See Note [Highlighting ambiguous type variables] @@ -1952,8 +1957,19 @@ mk_dict_err ctxt (ct, (matches, unifiers, unsafe_overlapped)) ] ] -{- Note [Highlighting ambiguous type variables] ------------------------------------------------ +{- Note [Report candidate instances] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +If we have an unsolved (Num Int), where `Int` is not the Prelude Int, +but comes from some other module, then it may be helpful to point out +that there are some similarly named instances elsewhere. So we get +something like + No instance for (Num Int) arising from the literal ?3? + There are instances for similar types: + instance Num GHC.Types.Int -- Defined in ?GHC.Num? +Discussion in Trac #9611. + +Note [Highlighting ambiguous type variables] +~------------------------------------------- When we encounter ambiguous type variables (i.e. type variables that remain metavariables after type inference), we need a few more conditions before we can reason that *ambiguity* prevents constraints From git at git.haskell.org Wed Feb 17 14:37:01 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 17 Feb 2016 14:37:01 +0000 (UTC) Subject: [commit: ghc] master: Comments only (34c9523) Message-ID: <20160217143701.08F4F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/34c95239fd0e59f3b6226590381c5f0599e6c703/ghc >--------------------------------------------------------------- commit 34c95239fd0e59f3b6226590381c5f0599e6c703 Author: Simon Peyton Jones Date: Wed Feb 17 09:20:41 2016 +0000 Comments only >--------------------------------------------------------------- 34c95239fd0e59f3b6226590381c5f0599e6c703 compiler/typecheck/TcDeriv.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/typecheck/TcDeriv.hs b/compiler/typecheck/TcDeriv.hs index 20e8fab..56772f2 100644 --- a/compiler/typecheck/TcDeriv.hs +++ b/compiler/typecheck/TcDeriv.hs @@ -641,7 +641,7 @@ deriveTyData tvs tc tc_args deriv_pred -- (c) The type class args, or remaining tycon args, -- do not mention any of the dropped type variables -- newtype T a s = ... deriving( ST s ) - -- newtype K a a = ... deriving( Monad ) + -- newtype instance K a a = ... deriving( Monad ) ; spec <- mkEqnHelp Nothing tkvs cls final_cls_tys tc final_tc_args Nothing From git at git.haskell.org Wed Feb 17 18:16:07 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 17 Feb 2016 18:16:07 +0000 (UTC) Subject: [commit: ghc] wip/rae: Make exactTyCoVarsOfTypes closed over kinds. (b962bcc) Message-ID: <20160217181607.0EDBE3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/b962bcc609cf3239d61ba281ca0eccc3cd89d99d/ghc >--------------------------------------------------------------- commit b962bcc609cf3239d61ba281ca0eccc3cd89d99d Author: Richard Eisenberg Date: Thu Jan 28 17:39:03 2016 -0500 Make exactTyCoVarsOfTypes closed over kinds. >--------------------------------------------------------------- b962bcc609cf3239d61ba281ca0eccc3cd89d99d compiler/typecheck/TcType.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/typecheck/TcType.hs b/compiler/typecheck/TcType.hs index 285f7b7..c542b56 100644 --- a/compiler/typecheck/TcType.hs +++ b/compiler/typecheck/TcType.hs @@ -750,7 +750,7 @@ exactTyCoVarsOfType ty = go ty where go ty | Just ty' <- coreView ty = go ty' -- This is the key line - go (TyVarTy tv) = unitVarSet tv + go (TyVarTy tv) = unitVarSet tv `unionVarSet` go (tyVarKind tv) go (TyConApp _ tys) = exactTyCoVarsOfTypes tys go (LitTy {}) = emptyVarSet go (AppTy fun arg) = go fun `unionVarSet` go arg From git at git.haskell.org Wed Feb 17 18:16:09 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 17 Feb 2016 18:16:09 +0000 (UTC) Subject: [commit: ghc] wip/rae: Existentials should be specified. (90f3561) Message-ID: <20160217181609.B86243A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/90f35612f16ff9cb2466cc936f12e748402abb85/ghc >--------------------------------------------------------------- commit 90f35612f16ff9cb2466cc936f12e748402abb85 Author: Richard Eisenberg Date: Fri Jan 29 13:09:42 2016 -0500 Existentials should be specified. This addresses point (2) from #11513. >--------------------------------------------------------------- 90f35612f16ff9cb2466cc936f12e748402abb85 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 0626836..fd25c79 100644 --- a/compiler/basicTypes/DataCon.hs +++ b/compiler/basicTypes/DataCon.hs @@ -768,7 +768,7 @@ mkDataCon name declared_infix prom_info tag = assoc "mkDataCon" (tyConDataCons rep_tycon `zip` [fIRST_TAG..]) con rep_arg_tys = dataConRepArgTys con - rep_ty = mkSpecForAllTys univ_tvs $ mkInvForAllTys ex_tvs $ + rep_ty = mkSpecForAllTys univ_tvs $ mkSpecForAllTys ex_tvs $ mkFunTys rep_arg_tys $ mkTyConApp rep_tycon (mkTyVarTys univ_tvs) From git at git.haskell.org Wed Feb 17 18:16:13 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 17 Feb 2016 18:16:13 +0000 (UTC) Subject: [commit: ghc] wip/rae: Fix #11241. (43468fe) Message-ID: <20160217181613.1E94F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/43468fe386571564a4bdfc35cbaeab4199259318/ghc >--------------------------------------------------------------- commit 43468fe386571564a4bdfc35cbaeab4199259318 Author: Richard Eisenberg Date: Wed Feb 10 08:35:22 2016 -0500 Fix #11241. When renaming a type, now looks for wildcards in bound variables' kinds. testcase: dependent/should_compile/T11241 >--------------------------------------------------------------- 43468fe386571564a4bdfc35cbaeab4199259318 compiler/rename/RnTypes.hs | 9 ++++++++- testsuite/tests/dependent/should_compile/T11241.hs | 6 ++++++ testsuite/tests/dependent/should_compile/T11241.stderr | 6 ++++++ testsuite/tests/dependent/should_compile/all.T | 2 +- 4 files changed, 21 insertions(+), 2 deletions(-) diff --git a/compiler/rename/RnTypes.hs b/compiler/rename/RnTypes.hs index 0d7f68c..118a32b 100644 --- a/compiler/rename/RnTypes.hs +++ b/compiler/rename/RnTypes.hs @@ -147,7 +147,9 @@ rnWcSigTy env (L loc hs_ty@(HsForAllTy { hst_bndrs = tvs, hst_body = hs_tau })) Nothing [] tvs $ \ _ tvs' -> do { (hs_tau', fvs) <- rnWcSigTy env hs_tau ; let hs_ty' = HsForAllTy { hst_bndrs = tvs', hst_body = hswc_body hs_tau' } - ; return ( hs_tau' { hswc_body = L loc hs_ty' }, fvs) } + awcs_bndrs = collectAnonWildCardsBndrs tvs' + ; return ( hs_tau' { hswc_wcs = hswc_wcs hs_tau' ++ awcs_bndrs + , hswc_body = L loc hs_ty' }, fvs) } rnWcSigTy env (L loc (HsQualTy { hst_ctxt = hs_ctxt, hst_body = tau })) = do { (hs_ctxt', fvs1) <- rnWcSigContext env hs_ctxt @@ -1043,6 +1045,11 @@ collectAnonWildCards lty = go lty prefix_types_only (HsAppPrefix ty) = Just ty prefix_types_only (HsAppInfix _) = Nothing +collectAnonWildCardsBndrs :: [LHsTyVarBndr Name] -> [Name] +collectAnonWildCardsBndrs ltvs = concatMap (go . unLoc) ltvs + where + go (UserTyVar _) = [] + go (KindedTyVar _ ki) = collectAnonWildCards ki {- ********************************************************* diff --git a/testsuite/tests/dependent/should_compile/T11241.hs b/testsuite/tests/dependent/should_compile/T11241.hs new file mode 100644 index 0000000..47d20d6 --- /dev/null +++ b/testsuite/tests/dependent/should_compile/T11241.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE ExplicitForAll, KindSignatures, PartialTypeSignatures #-} + +module T11241 where + +foo :: forall (a :: _) . a -> a +foo = id diff --git a/testsuite/tests/dependent/should_compile/T11241.stderr b/testsuite/tests/dependent/should_compile/T11241.stderr new file mode 100644 index 0000000..49a39a9 --- /dev/null +++ b/testsuite/tests/dependent/should_compile/T11241.stderr @@ -0,0 +1,6 @@ + +T11241.hs:5:21: warning: + ? Found type wildcard ?_? standing for ?*? + ? In the type signature: + foo :: forall (a :: _). a -> a + ? Relevant bindings include foo :: a -> a (bound at T11241.hs:6:1) diff --git a/testsuite/tests/dependent/should_compile/all.T b/testsuite/tests/dependent/should_compile/all.T index 571a9fb..783fa16 100644 --- a/testsuite/tests/dependent/should_compile/all.T +++ b/testsuite/tests/dependent/should_compile/all.T @@ -16,4 +16,4 @@ test('T9632', normal, compile, ['']) test('dynamic-paper', expect_fail_for(['optasm', 'optllvm']), compile, ['']) test('T11311', normal, compile, ['']) test('T11405', normal, compile, ['']) - +test('T11241', normal, compile, ['']) From git at git.haskell.org Wed Feb 17 18:16:15 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 17 Feb 2016 18:16:15 +0000 (UTC) Subject: [commit: ghc] wip/rae: Add missing kind cast to pure unifier. (aff5bb4) Message-ID: <20160217181615.C9E433A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/aff5bb47b70450bb1e3e4ac3c18ea35d13f9ac7c/ghc >--------------------------------------------------------------- commit aff5bb47b70450bb1e3e4ac3c18ea35d13f9ac7c Author: Richard Eisenberg Date: Sat Jan 30 16:49:22 2016 -0500 Add missing kind cast to pure unifier. >--------------------------------------------------------------- aff5bb47b70450bb1e3e4ac3c18ea35d13f9ac7c compiler/types/Unify.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/types/Unify.hs b/compiler/types/Unify.hs index 89b6695..fe77370 100644 --- a/compiler/types/Unify.hs +++ b/compiler/types/Unify.hs @@ -788,7 +788,7 @@ uVar tv1 ty kco -- this is because the range of the subst is the target -- type, not the template type. So, just check for -- normal type equality. - guard (ty' `eqType` ty) } + guard ((ty' `mkCastTy` kco) `eqType` ty) } Nothing -> uUnrefined tv1 ty ty kco } -- No, continue uUnrefined :: TyVar -- variable to be unified From git at git.haskell.org Wed Feb 17 18:16:18 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 17 Feb 2016 18:16:18 +0000 (UTC) Subject: [commit: ghc] wip/rae: Remove extraneous fundeps on (~) (7d8031b) Message-ID: <20160217181618.7B5D23A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/7d8031ba3d36a9378a40834aa3e3817d8f7f310f/ghc >--------------------------------------------------------------- commit 7d8031ba3d36a9378a40834aa3e3817d8f7f310f Author: Richard Eisenberg Date: Thu Feb 4 18:31:25 2016 -0500 Remove extraneous fundeps on (~) >--------------------------------------------------------------- 7d8031ba3d36a9378a40834aa3e3817d8f7f310f libraries/base/Data/Type/Equality.hs | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/libraries/base/Data/Type/Equality.hs b/libraries/base/Data/Type/Equality.hs index 75d2a6c..e7363d2 100644 --- a/libraries/base/Data/Type/Equality.hs +++ b/libraries/base/Data/Type/Equality.hs @@ -54,7 +54,7 @@ import Data.Type.Bool -- | Lifted, homogeneous equality. By lifted, we mean that it can be -- bogus (deferred type error). By homogeneous, the two types @a@ -- and @b@ must have the same kind. -class a ~~ b => (a :: k) ~ (b :: k) | a -> b, b -> a +class a ~~ b => (a :: k) ~ (b :: k) -- See Note [The equality types story] in TysPrim -- NB: All this class does is to wrap its superclass, which is -- the "real", inhomogeneous equality; this is needed when @@ -62,6 +62,10 @@ class a ~~ b => (a :: k) ~ (b :: k) | a -> b, b -> a -- NB: Not exported, as (~) is magical syntax. That's also why there's -- no fixity. + -- It's tempting to put functional dependencies on (~), but it's not + -- necessary because the functional-depedency coverage check looks + -- through superclasses, and (~#) is handled in that check. + instance {-# INCOHERENT #-} a ~~ b => a ~ b -- See Note [The equality types story] in TysPrim -- If we have a Wanted (t1 ~ t2), we want to immediately From git at git.haskell.org Wed Feb 17 18:16:21 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 17 Feb 2016 18:16:21 +0000 (UTC) Subject: [commit: ghc] wip/rae: Use CoercionN and friends in TyCoRep (6f952f5) Message-ID: <20160217181621.37A613A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/6f952f58bc4d592265134e4e13af46da9c56560f/ghc >--------------------------------------------------------------- commit 6f952f58bc4d592265134e4e13af46da9c56560f Author: Richard Eisenberg Date: Wed Feb 10 08:03:56 2016 -0500 Use CoercionN and friends in TyCoRep >--------------------------------------------------------------- 6f952f58bc4d592265134e4e13af46da9c56560f compiler/types/Coercion.hs | 7 ------- compiler/types/TyCoRep.hs | 34 +++++++++++++++++++++------------- 2 files changed, 21 insertions(+), 20 deletions(-) diff --git a/compiler/types/Coercion.hs b/compiler/types/Coercion.hs index 2989bce..6546288 100644 --- a/compiler/types/Coercion.hs +++ b/compiler/types/Coercion.hs @@ -127,13 +127,6 @@ import Control.Monad (foldM) import Control.Arrow ( first ) import Data.Function ( on ) ------------------------------------------------------------------ --- These synonyms are very useful as documentation - -type CoercionN = Coercion -- nominal coercion -type CoercionR = Coercion -- representational coercion -type CoercionP = Coercion -- phantom coercion - {- %************************************************************************ %* * diff --git a/compiler/types/TyCoRep.hs b/compiler/types/TyCoRep.hs index f72c37f..3930e5e 100644 --- a/compiler/types/TyCoRep.hs +++ b/compiler/types/TyCoRep.hs @@ -33,6 +33,7 @@ module TyCoRep ( -- Coercions Coercion(..), LeftOrRight(..), UnivCoProvenance(..), CoercionHole(..), + CoercionN, CoercionR, CoercionP, KindCoercion, -- Functions over types mkTyConTy, mkTyVarTy, mkTyVarTys, @@ -213,10 +214,10 @@ data Type | CastTy Type - Coercion -- ^ A kind cast. The coercion is always nominal. - -- INVARIANT: The cast is never refl. - -- INVARIANT: The cast is "pushed down" as far as it - -- can go. See Note [Pushing down casts] + KindCoercion -- ^ A kind cast. The coercion is always nominal. + -- INVARIANT: The cast is never refl. + -- INVARIANT: The cast is "pushed down" as far as it + -- can go. See Note [Pushing down casts] | CoercionTy Coercion -- ^ Injection of a Coercion into a type @@ -592,11 +593,11 @@ data Coercion -- we expand synonyms eagerly -- But it can be a type function - | AppCo Coercion Coercion -- lift AppTy + | AppCo Coercion CoercionN -- lift AppTy -- AppCo :: e -> N -> e -- See Note [Forall coercions] - | ForAllCo TyVar Coercion Coercion + | ForAllCo TyVar KindCoercion Coercion -- ForAllCo :: _ -> N -> e -> e -- These are special @@ -626,15 +627,15 @@ data Coercion -- Using NthCo on a ForAllCo gives an N coercion always -- See Note [NthCo and newtypes] - | LRCo LeftOrRight Coercion -- Decomposes (t_left t_right) + | LRCo LeftOrRight CoercionN -- Decomposes (t_left t_right) -- :: _ -> N -> N - | InstCo Coercion Coercion + | InstCo Coercion CoercionN -- :: e -> N -> e -- See Note [InstCo roles] -- Coherence applies a coercion to the left-hand type of another coercion -- See Note [Coherence] - | CoherenceCo Coercion Coercion + | CoherenceCo Coercion KindCoercion -- :: e -> N -> e -- Extract a kind coercion from a (heterogeneous) type coercion @@ -642,11 +643,16 @@ data Coercion | KindCo Coercion -- :: e -> N - | SubCo Coercion -- Turns a ~N into a ~R + | SubCo CoercionN -- Turns a ~N into a ~R -- :: N -> R deriving (Data.Data, Data.Typeable) +type CoercionN = Coercion -- always nominal +type CoercionR = Coercion -- always representational +type CoercionP = Coercion -- always phantom +type KindCoercion = CoercionN -- always nominal + -- If you edit this type, you may need to update the GHC formalism -- See Note [GHC Formalism] in coreSyn/CoreLint.hs data LeftOrRight = CLeft | CRight @@ -1002,10 +1008,12 @@ role and kind, which is done in the UnivCo constructor. data UnivCoProvenance = UnsafeCoerceProv -- ^ From @unsafeCoerce#@. These are unsound. - | PhantomProv Coercion -- ^ See Note [Phantom coercions] + | PhantomProv KindCoercion -- ^ See Note [Phantom coercions]. Only in Phantom + -- roled coercions - | ProofIrrelProv Coercion -- ^ From the fact that any two coercions are - -- considered equivalent. See Note [ProofIrrelProv] + | ProofIrrelProv KindCoercion -- ^ From the fact that any two coercions are + -- considered equivalent. See Note [ProofIrrelProv]. + -- Can be used in Nominal or Representational coercions | PluginProv String -- ^ From a plugin, which asserts that this coercion -- is sound. The string is for the use of the plugin. From git at git.haskell.org Wed Feb 17 18:16:24 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 17 Feb 2016 18:16:24 +0000 (UTC) Subject: [commit: ghc] wip/rae: Fix #11246. (489e6ab) Message-ID: <20160217181624.503F43A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/489e6ab5990f0f37624f14d6bf3f0025476513a1/ghc >--------------------------------------------------------------- commit 489e6ab5990f0f37624f14d6bf3f0025476513a1 Author: Richard Eisenberg Date: Wed Feb 10 09:09:26 2016 -0500 Fix #11246. We have to instantiate any invisible arguments to type families right away. This is now done in tcTyCon in TcHsType. testcase: typecheck/should_compile/T11246 >--------------------------------------------------------------- 489e6ab5990f0f37624f14d6bf3f0025476513a1 compiler/typecheck/TcHsType.hs | 47 ++++++++++++++-------- compiler/typecheck/TcTyClsDecls.hs | 47 +++++++++++++--------- compiler/types/TyCon.hs | 10 +++-- testsuite/tests/typecheck/should_compile/T11246.hs | 5 +++ testsuite/tests/typecheck/should_compile/all.T | 1 + 5 files changed, 72 insertions(+), 38 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 489e6ab5990f0f37624f14d6bf3f0025476513a1 From git at git.haskell.org Wed Feb 17 18:16:27 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 17 Feb 2016 18:16:27 +0000 (UTC) Subject: [commit: ghc] wip/rae: Fix #11313. (a615215) Message-ID: <20160217181627.CCAC43A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/a6152159c9f14fc9cf0e86caff532906abd49b73/ghc >--------------------------------------------------------------- commit a6152159c9f14fc9cf0e86caff532906abd49b73 Author: Richard Eisenberg Date: Wed Feb 10 09:38:09 2016 -0500 Fix #11313. Previously, we looked through synonyms when counting arguments, but that's a bit silly. >--------------------------------------------------------------- a6152159c9f14fc9cf0e86caff532906abd49b73 compiler/typecheck/TcMType.hs | 5 +- compiler/typecheck/TcTyClsDecls.hs | 55 ++++++++++++---------- compiler/types/TyCon.hs | 7 ++- compiler/types/Type.hs | 17 ++++++- testsuite/tests/typecheck/should_fail/T11313.hs | 9 ++++ .../tests/typecheck/should_fail/T11313.stderr | 6 +++ testsuite/tests/typecheck/should_fail/all.T | 1 + 7 files changed, 71 insertions(+), 29 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 a6152159c9f14fc9cf0e86caff532906abd49b73 From git at git.haskell.org Wed Feb 17 18:16:30 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 17 Feb 2016 18:16:30 +0000 (UTC) Subject: [commit: ghc] wip/rae's head updated: Fix #11313. (a615215) Message-ID: <20160217181630.18D153A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/rae' now includes: 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. From git at git.haskell.org Wed Feb 17 19:51:08 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 17 Feb 2016 19:51:08 +0000 (UTC) Subject: [commit: ghc] master's head updated: Fix #11313. (a615215) Message-ID: <20160217195108.3A7C73A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'master' now includes: 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. From git at git.haskell.org Wed Feb 17 20:02:49 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 17 Feb 2016 20:02:49 +0000 (UTC) Subject: [commit: ghc] master: Derive Eq and Ord instance for SrcLoc and RealSrcLoc (67d2226) Message-ID: <20160217200249.7FAE53A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/67d22261da840c5ba90414496457b583df0a3911/ghc >--------------------------------------------------------------- commit 67d22261da840c5ba90414496457b583df0a3911 Author: Gabriel Gonzalez Date: Wed Feb 17 10:59:09 2016 +0100 Derive Eq and Ord instance for SrcLoc and RealSrcLoc The Eq and Ord instance were previously hand-written and this change updates them to be automatically derived by the compiler. The derived behavior should be equivalent to the original. Reviewers: hvr, austin, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1913 >--------------------------------------------------------------- 67d22261da840c5ba90414496457b583df0a3911 compiler/basicTypes/SrcLoc.hs | 30 ++---------------------------- 1 file changed, 2 insertions(+), 28 deletions(-) diff --git a/compiler/basicTypes/SrcLoc.hs b/compiler/basicTypes/SrcLoc.hs index 04f7ec9..2726f41 100644 --- a/compiler/basicTypes/SrcLoc.hs +++ b/compiler/basicTypes/SrcLoc.hs @@ -105,11 +105,12 @@ data RealSrcLoc = SrcLoc FastString -- A precise location (file name) {-# UNPACK #-} !Int -- line number, begins at 1 {-# UNPACK #-} !Int -- column number, begins at 1 + deriving (Eq, Ord) data SrcLoc = RealSrcLoc {-# UNPACK #-}!RealSrcLoc | UnhelpfulLoc FastString -- Just a general indication - deriving Show + deriving (Eq, Ord, Show) {- ************************************************************************ @@ -164,36 +165,9 @@ advanceSrcLoc (SrcLoc f l c) _ = SrcLoc f l (c + 1) ************************************************************************ -} --- SrcLoc is an instance of Ord so that we can sort error messages easily -instance Eq SrcLoc where - loc1 == loc2 = case loc1 `cmpSrcLoc` loc2 of - EQ -> True - _other -> False - -instance Eq RealSrcLoc where - loc1 == loc2 = case loc1 `cmpRealSrcLoc` loc2 of - EQ -> True - _other -> False - -instance Ord SrcLoc where - compare = cmpSrcLoc - -instance Ord RealSrcLoc where - compare = cmpRealSrcLoc - sortLocated :: [Located a] -> [Located a] sortLocated things = sortBy (comparing getLoc) things -cmpSrcLoc :: SrcLoc -> SrcLoc -> Ordering -cmpSrcLoc (UnhelpfulLoc s1) (UnhelpfulLoc s2) = s1 `compare` s2 -cmpSrcLoc (UnhelpfulLoc _) (RealSrcLoc _) = GT -cmpSrcLoc (RealSrcLoc _) (UnhelpfulLoc _) = LT -cmpSrcLoc (RealSrcLoc l1) (RealSrcLoc l2) = (l1 `compare` l2) - -cmpRealSrcLoc :: RealSrcLoc -> RealSrcLoc -> Ordering -cmpRealSrcLoc (SrcLoc s1 l1 c1) (SrcLoc s2 l2 c2) - = (s1 `compare` s2) `thenCmp` (l1 `compare` l2) `thenCmp` (c1 `compare` c2) - instance Outputable RealSrcLoc where ppr (SrcLoc src_path src_line src_col) = hcat [ pprFastFilePath src_path <> colon From git at git.haskell.org Wed Feb 17 20:02:52 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 17 Feb 2016 20:02:52 +0000 (UTC) Subject: [commit: ghc] master: Remove superfluous code when deriving Foldable/Traversable (a82956d) Message-ID: <20160217200252.E51BA3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a82956df5b34175410e0feb9e2febe7d39b60b49/ghc >--------------------------------------------------------------- commit a82956df5b34175410e0feb9e2febe7d39b60b49 Author: RyanGlScott Date: Wed Feb 17 12:06:17 2016 +0100 Remove superfluous code when deriving Foldable/Traversable Currently, `-XDeriveFoldable` and `-XDeriveTraversable` generate unnecessary `mempty` and `pure` expressions when it traverses of an argument of a constructor whose type does not mention the last type parameter. Not only is this inefficient, but it prevents `Traversable` from being derivable for datatypes with unlifted arguments (see Trac #11174). The solution to this problem is to adopt a slight change to the algorithms for `-XDeriveFoldable` and `-XDeriveTraversable`, which is described in [this wiki page](https://ghc.haskell.org/trac/ghc/wiki/Commentary/Compiler/DeriveFu nctor#Proposal:alternativestrategyforderivingFoldableandTraversable). The wiki page also describes why we don't apply the same changes to the algorithm for `-XDeriveFunctor`. This is techincally a breaking change for users of `-XDeriveFoldable` and `-XDeriveTraversable`, since if someone was using a law-breaking `Monoid` instance with a derived `Foldable` instance (i.e., one where `x <> mempty` does not equal `x`) or a law-breaking `Applicative` instance with a derived `Traversable` instance, then the new generated code could result in different behavior. I suspect the number of scenarios like this is very small, and the onus really should be on those users to fix up their `Monoid`/`Applicative` instances. Fixes #11174. Test Plan: ./validate Reviewers: hvr, simonpj, austin, bgamari Reviewed By: simonpj, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1908 GHC Trac Issues: #11174 >--------------------------------------------------------------- a82956df5b34175410e0feb9e2febe7d39b60b49 compiler/typecheck/TcGenDeriv.hs | 478 ++++++++++++++++++---- compiler/utils/Util.hs | 19 +- docs/users_guide/8.0.1-notes.rst | 5 +- docs/users_guide/glasgow_exts.rst | 24 +- testsuite/tests/deriving/should_compile/T11174.hs | 14 + testsuite/tests/deriving/should_compile/all.T | 1 + 6 files changed, 445 insertions(+), 96 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 a82956df5b34175410e0feb9e2febe7d39b60b49 From git at git.haskell.org Wed Feb 17 20:02:55 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 17 Feb 2016 20:02:55 +0000 (UTC) Subject: [commit: ghc] master: users-guide: Fix typos (525b54c) Message-ID: <20160217200255.9539C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/525b54c469941c636fd45591e5f382cb3b44756c/ghc >--------------------------------------------------------------- commit 525b54c469941c636fd45591e5f382cb3b44756c Author: Mark Christiaens Date: Wed Feb 17 14:04:42 2016 +0100 users-guide: Fix typos Reviewers: austin, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1927 GHC Trac Issues: #11590 >--------------------------------------------------------------- 525b54c469941c636fd45591e5f382cb3b44756c docs/users_guide/packages.rst | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/docs/users_guide/packages.rst b/docs/users_guide/packages.rst index 89eb257..c9e2ea4 100644 --- a/docs/users_guide/packages.rst +++ b/docs/users_guide/packages.rst @@ -231,17 +231,17 @@ The GHC command line options that control packages are: .. ghc-flag:: -trust ?pkg? This option causes the install package ?pkg? to be both exposed and - trusted by GHC. This command functions in the in a very similar way + trusted by GHC. This command functions in a very similar way to the :ghc-flag:`-package` command but in addition sets the selected - packaged to be trusted by GHC, regardless of the contents of the + packages to be trusted by GHC, regardless of the contents of the package database. (see :ref:`safe-haskell`). .. ghc-flag:: -distrust ?pkg? This option causes the install package ?pkg? to be both exposed and - distrusted by GHC. This command functions in the in a very similar + distrusted by GHC. This command functions in a very similar way to the :ghc-flag:`-package` command but in addition sets the selected - packaged to be distrusted by GHC, regardless of the contents of the + packages to be distrusted by GHC, regardless of the contents of the package database. (see :ref:`safe-haskell`). .. ghc-flag:: -distrust-all From git at git.haskell.org Wed Feb 17 21:11:15 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 17 Feb 2016 21:11:15 +0000 (UTC) Subject: [commit: ghc] branch 'wip/transformers-0.5.2' created Message-ID: <20160217211115.181583A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/transformers-0.5.2 Referencing: 8bc7c37af4090f7050c9fe5e664a248224e85d62 From git at git.haskell.org Wed Feb 17 21:11:17 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 17 Feb 2016 21:11:17 +0000 (UTC) Subject: [commit: ghc] wip/transformers-0.5.2: Update transformer submodule to v0.5.2.0 release (8bc7c37) Message-ID: <20160217211117.C6A853A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/transformers-0.5.2 Link : http://ghc.haskell.org/trac/ghc/changeset/8bc7c37af4090f7050c9fe5e664a248224e85d62/ghc >--------------------------------------------------------------- commit 8bc7c37af4090f7050c9fe5e664a248224e85d62 Author: Herbert Valerio Riedel Date: Wed Feb 17 18:23:08 2016 +0100 Update transformer submodule to v0.5.2.0 release Most notably, this update pulls in documentation improvements and several INLINE pragmas. >--------------------------------------------------------------- 8bc7c37af4090f7050c9fe5e664a248224e85d62 libraries/transformers | 2 +- mk/warnings.mk | 1 + 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/libraries/transformers b/libraries/transformers index a2f7dd0..10348c4 160000 --- a/libraries/transformers +++ b/libraries/transformers @@ -1 +1 @@ -Subproject commit a2f7dd057a0ee0c6cb206609594d7a07d26a1861 +Subproject commit 10348c4bbf60debbfc82463e1035aca1cb7b51bc diff --git a/mk/warnings.mk b/mk/warnings.mk index 10c0935..63388fb 100644 --- a/mk/warnings.mk +++ b/mk/warnings.mk @@ -104,6 +104,7 @@ libraries/dph/dph-lifted-common-install_EXTRA_HC_OPTS += -Wwarn libraries/transformers_dist-boot_EXTRA_HC_OPTS += -fno-warn-unused-matches -fno-warn-unused-imports libraries/transformers_dist-install_EXTRA_HC_OPTS += -Wno-unused-matches -Wno-unused-imports libraries/transformers_dist-install_EXTRA_HC_OPTS += -Wno-redundant-constraints +libraries/transformers_dist-install_EXTRA_HC_OPTS += -Wno-orphans # Turn of trustworthy-safe warning libraries/base_dist-install_EXTRA_HC_OPTS += -Wno-trustworthy-safe From git at git.haskell.org Wed Feb 17 21:21:31 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 17 Feb 2016 21:21:31 +0000 (UTC) Subject: [commit: ghc] master: Comments only (#11513) (0c420cb) Message-ID: <20160217212131.7D94F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/0c420cb6fdf25a6779785e18d88c9ca9d3695af1/ghc >--------------------------------------------------------------- commit 0c420cb6fdf25a6779785e18d88c9ca9d3695af1 Author: Richard Eisenberg Date: Wed Feb 17 16:22:22 2016 -0500 Comments only (#11513) >--------------------------------------------------------------- 0c420cb6fdf25a6779785e18d88c9ca9d3695af1 compiler/basicTypes/DataCon.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/compiler/basicTypes/DataCon.hs b/compiler/basicTypes/DataCon.hs index fd25c79..8552205 100644 --- a/compiler/basicTypes/DataCon.hs +++ b/compiler/basicTypes/DataCon.hs @@ -768,6 +768,8 @@ mkDataCon name declared_infix prom_info tag = assoc "mkDataCon" (tyConDataCons rep_tycon `zip` [fIRST_TAG..]) con rep_arg_tys = dataConRepArgTys con + -- NB: This type is user-facing for datatypes that don't need wrappers; + -- so it's important to use mkSpecForAllTys rep_ty = mkSpecForAllTys univ_tvs $ mkSpecForAllTys ex_tvs $ mkFunTys rep_arg_tys $ mkTyConApp rep_tycon (mkTyVarTys univ_tvs) From git at git.haskell.org Thu Feb 18 09:15:17 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Feb 2016 09:15:17 +0000 (UTC) Subject: [commit: ghc] master: Fix thinko that crept into D1908 (27842ec) Message-ID: <20160218091517.6B0DD3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/27842ec190cf46b6e494520761af41847837dc86/ghc >--------------------------------------------------------------- commit 27842ec190cf46b6e494520761af41847837dc86 Author: Ben Gamari Date: Wed Feb 17 21:18:00 2016 +0100 Fix thinko that crept into D1908 RyanGlScott updated the Diff only after I had merged it. >--------------------------------------------------------------- 27842ec190cf46b6e494520761af41847837dc86 compiler/typecheck/TcGenDeriv.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/typecheck/TcGenDeriv.hs b/compiler/typecheck/TcGenDeriv.hs index 577b3dc..34e9d11 100644 --- a/compiler/typecheck/TcGenDeriv.hs +++ b/compiler/typecheck/TcGenDeriv.hs @@ -1806,7 +1806,7 @@ only Foldable instances are not possible for function types at all. Given (data T a = T a a (T a) deriving Foldable), we get: instance Foldable T where - foldr f z (T1 x1 x2 x3) = + foldr f z (T x1 x2 x3) = $(foldr 'a 'a) x1 ( $(foldr 'a 'a) x2 ( $(foldr 'a '(T a)) x3 z ) ) -XDeriveFoldable is different from -XDeriveFunctor in that it filters out From git at git.haskell.org Thu Feb 18 12:02:27 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Feb 2016 12:02:27 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Document -dynamic-too (#11488) (acefdeb) Message-ID: <20160218120227.7B70A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/acefdeb33d059a0e64e627f5f681e4160e72fb47/ghc >--------------------------------------------------------------- commit acefdeb33d059a0e64e627f5f681e4160e72fb47 Author: Simon Marlow Date: Mon Feb 15 11:47:12 2016 +0000 Document -dynamic-too (#11488) (cherry picked from commit 160765f8331cf92e9a34e9062846a949e7b11b1e) >--------------------------------------------------------------- acefdeb33d059a0e64e627f5f681e4160e72fb47 docs/users_guide/phases.rst | 14 ++++++++++++++ utils/mkUserGuidePart/Options/CodeGen.hs | 10 ++++++++++ utils/mkUserGuidePart/Options/Linking.hs | 19 ------------------- utils/mkUserGuidePart/Options/RedirectingOutput.hs | 12 ++++++++++++ 4 files changed, 36 insertions(+), 19 deletions(-) diff --git a/docs/users_guide/phases.rst b/docs/users_guide/phases.rst index e9637fa..ed05add 100644 --- a/docs/users_guide/phases.rst +++ b/docs/users_guide/phases.rst @@ -464,6 +464,20 @@ Options affecting code generation Note that using this option when linking causes GHC to link against shared libraries. +.. ghc-flag:: -dynamic-too + + Generates both dynamic and static object files in a single run of + GHC. This option is functionally equivalent to running GHC twice, + the second time adding ``-dynamic -osuf dyn_o -hisuf dyn_hi``. + + Although it is equivalent to running GHC twice, using + ``-dynamic-too`` is more efficient, because the earlier phases of + the compiler up to code generation are performed just once. + + When using ``-dynamic-too``, the options ``-dyno``, ``-dynosuf``, + and ``-dynhisuf`` are the counterparts of ``-o``, ``-osuf``, and + ``-hisuf`` respectively, but applying to the dynamic compilation. + .. _options-linker: Options affecting linking diff --git a/utils/mkUserGuidePart/Options/CodeGen.hs b/utils/mkUserGuidePart/Options/CodeGen.hs index 9939d9e..0a5d6c1 100644 --- a/utils/mkUserGuidePart/Options/CodeGen.hs +++ b/utils/mkUserGuidePart/Options/CodeGen.hs @@ -39,4 +39,14 @@ codegenOptions = "output. If ?n? is omitted level 2 is assumed." , flagType = DynamicFlag } + , flag { flagName = "-dynamic" + , flagDescription = "Build dynamically-linked object files and executables" + , flagType = DynamicFlag + } + , flag { flagName = "-dynamic-too" + , flagDescription = + "Build dynamic object files *as well as* static object files " ++ + "during compilation" + , flagType = DynamicFlag + } ] diff --git a/utils/mkUserGuidePart/Options/Linking.hs b/utils/mkUserGuidePart/Options/Linking.hs index 2348daa..919cc09 100644 --- a/utils/mkUserGuidePart/Options/Linking.hs +++ b/utils/mkUserGuidePart/Options/Linking.hs @@ -21,25 +21,6 @@ linkingOptions = "Generate position-independent code (where available)" , flagType = DynamicFlag } - , flag { flagName = "-dynamic" - , flagDescription = "Use dynamic Haskell libraries (if available)" - , flagType = DynamicFlag - } - , flag { flagName = "-dynamic-too" - , flagDescription = - "Build dynamic object files *as well as* static object files " ++ - "during compilation" - , flagType = DynamicFlag - } - , flag { flagName = "-dyno" - , flagDescription = - "Set the output path for the *dynamically* linked objects" - , flagType = DynamicFlag - } - , flag { flagName = "-dynosuf" - , flagDescription = "Set the output suffix for dynamic object files" - , flagType = DynamicFlag - } , flag { flagName = "-dynload" , flagDescription = "Selects one of a number of modes for finding shared libraries at runtime." diff --git a/utils/mkUserGuidePart/Options/RedirectingOutput.hs b/utils/mkUserGuidePart/Options/RedirectingOutput.hs index 9435e26..62fe99a 100644 --- a/utils/mkUserGuidePart/Options/RedirectingOutput.hs +++ b/utils/mkUserGuidePart/Options/RedirectingOutput.hs @@ -44,4 +44,16 @@ redirectingOutputOptions = , flagDescription = "set output directory" , flagType = DynamicFlag } + , flag { flagName = "-dyno " + , flagDescription = "Set the output filename for dynamic object files (see ``-dynamic-too``)" + , flagType = DynamicFlag + } + , flag { flagName = "-dynosuf " + , flagDescription = "Set the object suffix for dynamic object files (see ``-dynamic-too``)" + , flagType = DynamicFlag + } + , flag { flagName = "-dynhisuf " + , flagDescription = "Set the hi suffix for dynamic object files (see ``-dynamic-too``)" + , flagType = DynamicFlag + } ] From git at git.haskell.org Thu Feb 18 12:02:30 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Feb 2016 12:02:30 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Use CoercionN and friends in TyCoRep (3b80156) Message-ID: <20160218120230.31CAF3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/3b80156c4c921a44f917d0e666e4f74137fbffb4/ghc >--------------------------------------------------------------- commit 3b80156c4c921a44f917d0e666e4f74137fbffb4 Author: Richard Eisenberg Date: Wed Feb 10 08:03:56 2016 -0500 Use CoercionN and friends in TyCoRep (cherry picked from commit 6f952f58bc4d592265134e4e13af46da9c56560f) >--------------------------------------------------------------- 3b80156c4c921a44f917d0e666e4f74137fbffb4 compiler/types/Coercion.hs | 7 ------- compiler/types/TyCoRep.hs | 34 +++++++++++++++++++++------------- 2 files changed, 21 insertions(+), 20 deletions(-) diff --git a/compiler/types/Coercion.hs b/compiler/types/Coercion.hs index 3adec4e..7a14160 100644 --- a/compiler/types/Coercion.hs +++ b/compiler/types/Coercion.hs @@ -133,13 +133,6 @@ import Control.Monad (foldM) import Control.Arrow ( first ) import Data.Function ( on ) ------------------------------------------------------------------ --- These synonyms are very useful as documentation - -type CoercionN = Coercion -- nominal coercion -type CoercionR = Coercion -- representational coercion -type CoercionP = Coercion -- phantom coercion - {- %************************************************************************ %* * diff --git a/compiler/types/TyCoRep.hs b/compiler/types/TyCoRep.hs index 0971b77..5bef692 100644 --- a/compiler/types/TyCoRep.hs +++ b/compiler/types/TyCoRep.hs @@ -33,6 +33,7 @@ module TyCoRep ( -- Coercions Coercion(..), LeftOrRight(..), UnivCoProvenance(..), CoercionHole(..), + CoercionN, CoercionR, CoercionP, KindCoercion, -- Functions over types mkTyConTy, mkTyVarTy, mkTyVarTys, @@ -207,10 +208,10 @@ data Type | CastTy Type - Coercion -- ^ A kind cast. The coercion is always nominal. - -- INVARIANT: The cast is never refl. - -- INVARIANT: The cast is "pushed down" as far as it - -- can go. See Note [Pushing down casts] + KindCoercion -- ^ A kind cast. The coercion is always nominal. + -- INVARIANT: The cast is never refl. + -- INVARIANT: The cast is "pushed down" as far as it + -- can go. See Note [Pushing down casts] | CoercionTy Coercion -- ^ Injection of a Coercion into a type @@ -573,11 +574,11 @@ data Coercion -- we expand synonyms eagerly -- But it can be a type function - | AppCo Coercion Coercion -- lift AppTy + | AppCo Coercion CoercionN -- lift AppTy -- AppCo :: e -> N -> e -- See Note [Forall coercions] - | ForAllCo TyVar Coercion Coercion + | ForAllCo TyVar KindCoercion Coercion -- ForAllCo :: _ -> N -> e -> e -- These are special @@ -607,15 +608,15 @@ data Coercion -- Using NthCo on a ForAllCo gives an N coercion always -- See Note [NthCo and newtypes] - | LRCo LeftOrRight Coercion -- Decomposes (t_left t_right) + | LRCo LeftOrRight CoercionN -- Decomposes (t_left t_right) -- :: _ -> N -> N - | InstCo Coercion Coercion + | InstCo Coercion CoercionN -- :: e -> N -> e -- See Note [InstCo roles] -- Coherence applies a coercion to the left-hand type of another coercion -- See Note [Coherence] - | CoherenceCo Coercion Coercion + | CoherenceCo Coercion KindCoercion -- :: e -> N -> e -- Extract a kind coercion from a (heterogeneous) type coercion @@ -623,11 +624,16 @@ data Coercion | KindCo Coercion -- :: e -> N - | SubCo Coercion -- Turns a ~N into a ~R + | SubCo CoercionN -- Turns a ~N into a ~R -- :: N -> R deriving (Data.Data, Data.Typeable) +type CoercionN = Coercion -- always nominal +type CoercionR = Coercion -- always representational +type CoercionP = Coercion -- always phantom +type KindCoercion = CoercionN -- always nominal + -- If you edit this type, you may need to update the GHC formalism -- See Note [GHC Formalism] in coreSyn/CoreLint.hs data LeftOrRight = CLeft | CRight @@ -983,10 +989,12 @@ role and kind, which is done in the UnivCo constructor. data UnivCoProvenance = UnsafeCoerceProv -- ^ From @unsafeCoerce#@. These are unsound. - | PhantomProv Coercion -- ^ See Note [Phantom coercions] + | PhantomProv KindCoercion -- ^ See Note [Phantom coercions]. Only in Phantom + -- roled coercions - | ProofIrrelProv Coercion -- ^ From the fact that any two coercions are - -- considered equivalent. See Note [ProofIrrelProv] + | ProofIrrelProv KindCoercion -- ^ From the fact that any two coercions are + -- considered equivalent. See Note [ProofIrrelProv]. + -- Can be used in Nominal or Representational coercions | PluginProv String -- ^ From a plugin, which asserts that this coercion -- is sound. The string is for the use of the plugin. From git at git.haskell.org Thu Feb 18 12:02:33 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Feb 2016 12:02:33 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: s/unLifted/unlifted for consistency (8a66958) Message-ID: <20160218120233.10A0C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/8a669585de331111d642d826b6a5a9182e70a753/ghc >--------------------------------------------------------------- commit 8a669585de331111d642d826b6a5a9182e70a753 Author: ?mer Sinan A?acan Date: Wed Jan 27 13:15:15 2016 +0100 s/unLifted/unlifted for consistency This was causing trouble as we had to remember when to use "unLifted" and when to use "unlifted". "unlifted" is used instead of "unLifted" as it's a single word. Reviewers: austin, hvr, goldfire, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1852 (cherry picked from commit 4faa1a63d0496fd511d2d139622dbf7ef2ce4655) >--------------------------------------------------------------- 8a669585de331111d642d826b6a5a9182e70a753 compiler/basicTypes/Demand.hs | 4 ++-- compiler/codeGen/StgCmmClosure.hs | 10 +++++----- compiler/codeGen/StgCmmExpr.hs | 2 +- compiler/codeGen/StgCmmTicky.hs | 2 +- compiler/coreSyn/CoreLint.hs | 14 +++++++------- compiler/coreSyn/CorePrep.hs | 4 ++-- compiler/coreSyn/CoreSubst.hs | 2 +- compiler/coreSyn/CoreUnfold.hs | 4 ++-- compiler/coreSyn/CoreUtils.hs | 4 ++-- compiler/deSugar/Coverage.hs | 2 +- compiler/deSugar/DsCCall.hs | 2 +- compiler/deSugar/DsExpr.hs | 8 ++++---- compiler/deSugar/DsForeign.hs | 2 +- compiler/ghci/ByteCodeGen.hs | 6 +++--- compiler/simplCore/FloatIn.hs | 6 +++--- compiler/simplCore/SetLevels.hs | 8 ++++---- compiler/simplCore/SimplEnv.hs | 2 +- compiler/simplCore/Simplify.hs | 10 +++++----- compiler/specialise/Specialise.hs | 2 +- compiler/stgSyn/CoreToStg.hs | 4 ++-- compiler/stgSyn/StgLint.hs | 8 ++++---- compiler/stranal/WwLib.hs | 6 +++--- compiler/typecheck/TcBinds.hs | 2 +- compiler/typecheck/TcDeriv.hs | 4 ++-- compiler/typecheck/TcGenDeriv.hs | 12 ++++++------ compiler/typecheck/TcGenGenerics.hs | 2 +- compiler/typecheck/TcPat.hs | 2 +- compiler/typecheck/TcPatSyn.hs | 2 +- compiler/typecheck/TcRnDriver.hs | 2 +- compiler/typecheck/TcSplice.hs | 2 +- compiler/typecheck/TcType.hs | 10 +++++----- compiler/typecheck/TcValidity.hs | 4 ++-- compiler/types/TyCon.hs | 16 ++++++++-------- compiler/types/Type.hs | 18 +++++++++--------- compiler/vectorise/Vectorise/Type/Classify.hs | 2 +- 35 files changed, 95 insertions(+), 95 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 8a669585de331111d642d826b6a5a9182e70a753 From git at git.haskell.org Thu Feb 18 12:02:35 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Feb 2016 12:02:35 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: DynFlags: Don't panic on incompatible Safe Haskell flags (ad6a7a3) Message-ID: <20160218120235.D19EA3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/ad6a7a3c65e6083417230521e28cb3ed831bf184/ghc >--------------------------------------------------------------- commit ad6a7a3c65e6083417230521e28cb3ed831bf184 Author: Ben Gamari Date: Tue Feb 16 22:45:57 2016 +0100 DynFlags: Don't panic on incompatible Safe Haskell flags We just return an arbitrary value since we are destined to fail due to the error anyways. Fixes #11580. Test Plan: Needs to be tested Reviewers: austin Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1925 GHC Trac Issues: #11580 (cherry picked from commit 2b906af0dab01c30c28792d39161e01449b85cb0) >--------------------------------------------------------------- ad6a7a3c65e6083417230521e28cb3ed831bf184 compiler/main/DynFlags.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index d280f02..c02e0d3 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -1882,7 +1882,7 @@ combineSafeFlags :: SafeHaskellMode -> SafeHaskellMode -> DynP SafeHaskellMode combineSafeFlags a b | a == Sf_None = return b | b == Sf_None = return a | a == b = return a - | otherwise = addErr errm >> return (panic errm) + | otherwise = addErr errm >> pure a where errm = "Incompatible Safe Haskell flags! (" ++ show a ++ ", " ++ show b ++ ")" From git at git.haskell.org Thu Feb 18 12:02:38 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Feb 2016 12:02:38 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Fix two wrong uses of "data constructor" in error msgs (f3fe3c5) Message-ID: <20160218120238.87DA63A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/f3fe3c5e2cc417e8c8724de4468b22de670e413e/ghc >--------------------------------------------------------------- commit f3fe3c5e2cc417e8c8724de4468b22de670e413e Author: Rik Steenkamp Date: Tue Feb 16 22:42:08 2016 +0100 Fix two wrong uses of "data constructor" in error msgs Replace `NoDataKinds :: PromotionErr` by `NoDataKindsTC` and `NoDataKindsDC` (just like there is `NoTypeInTypeTC` and `NoTypeInTypeDC`). This allows for a correct error message when a kind signature contains a type constructor and `-XDataKinds` is not specified. Apply a small fix to `TcError.hs` where instead of "data constructor" we should say "pattern synonym". Reviewers: austin, goldfire, bgamari Reviewed By: bgamari Subscribers: goldfire, thomie Differential Revision: https://phabricator.haskell.org/D1909 (cherry picked from commit af5a0e5004cfb1e041280fd7c16f2c1bfee67961) >--------------------------------------------------------------- f3fe3c5e2cc417e8c8724de4468b22de670e413e compiler/typecheck/TcErrors.hs | 6 ++++-- compiler/typecheck/TcHsType.hs | 9 +++++---- compiler/typecheck/TcRnTypes.hs | 9 ++++++--- 3 files changed, 15 insertions(+), 9 deletions(-) diff --git a/compiler/typecheck/TcErrors.hs b/compiler/typecheck/TcErrors.hs index 1985147..0d8057d 100644 --- a/compiler/typecheck/TcErrors.hs +++ b/compiler/typecheck/TcErrors.hs @@ -39,6 +39,7 @@ import NameSet import Bag import ErrUtils ( ErrMsg, errDoc, pprLocErrMsg ) import BasicTypes +import ConLike ( ConLike(..) ) import Util import FastString import Outputable @@ -1833,8 +1834,9 @@ mk_dict_err ctxt (ct, (matches, unifiers, unsafe_overlapped)) | orig <- origs ] ] ] | otherwise = [] - ppr_skol (PatSkol dc _) = text "the data constructor" <+> quotes (ppr dc) - ppr_skol skol_info = ppr skol_info + ppr_skol (PatSkol (RealDataCon dc) _) = text "the data constructor" <+> quotes (ppr dc) + ppr_skol (PatSkol (PatSynCon ps) _) = text "the pattern synonym" <+> quotes (ppr ps) + ppr_skol skol_info = ppr skol_info extra_note | any isFunTy (filterOutInvisibleTypes (classTyCon clas) tys) = text "(maybe you haven't applied a function to enough arguments?)" diff --git a/compiler/typecheck/TcHsType.hs b/compiler/typecheck/TcHsType.hs index f5537b6..d04ee97 100644 --- a/compiler/typecheck/TcHsType.hs +++ b/compiler/typecheck/TcHsType.hs @@ -987,7 +987,7 @@ tcTyVar mode name -- Could be a tyvar, a tycon, or a datacon ATcTyCon tc_tc -> do { data_kinds <- xoptM LangExt.DataKinds ; unless (isTypeLevel (mode_level mode) || data_kinds) $ - promotionErr name NoDataKinds + promotionErr name NoDataKindsTC ; tc <- get_loopy_tc name tc_tc ; return (mkNakedTyConApp tc [], tyConKind tc_tc) } -- mkNakedTyConApp: see Note [Type-checking inside the knot] @@ -1001,7 +1001,7 @@ tcTyVar mode name -- Could be a tyvar, a tycon, or a datacon ; unless (isTypeLevel (mode_level mode) || data_kinds || isKindTyCon tc) $ - promotionErr name NoDataKinds + promotionErr name NoDataKindsTC ; unless (isTypeLevel (mode_level mode) || type_in_type || isLegacyPromotableTyCon tc) $ @@ -1011,7 +1011,7 @@ tcTyVar mode name -- Could be a tyvar, a tycon, or a datacon AGlobal (AConLike (RealDataCon dc)) -> do { data_kinds <- xoptM LangExt.DataKinds ; unless (data_kinds || specialPromotedDc dc) $ - promotionErr name NoDataKinds + promotionErr name NoDataKindsDC ; type_in_type <- xoptM LangExt.TypeInType ; unless ( type_in_type || ( isTypeLevel (mode_level mode) && @@ -2142,7 +2142,8 @@ promotionErr name err where reason = case err of FamDataConPE -> text "it comes from a data family instance" - NoDataKinds -> text "Perhaps you intended to use DataKinds" + NoDataKindsTC -> text "Perhaps you intended to use DataKinds" + NoDataKindsDC -> text "Perhaps you intended to use DataKinds" NoTypeInTypeTC -> text "Perhaps you intended to use TypeInType" NoTypeInTypeDC -> text "Perhaps you intended to use TypeInType" PatSynPE -> text "Pattern synonyms cannot be promoted" diff --git a/compiler/typecheck/TcRnTypes.hs b/compiler/typecheck/TcRnTypes.hs index 35d434e..38fc5c9 100644 --- a/compiler/typecheck/TcRnTypes.hs +++ b/compiler/typecheck/TcRnTypes.hs @@ -905,7 +905,8 @@ data PromotionErr | RecDataConPE -- Data constructor in a recursive loop -- See Note [ARecDataCon: recusion and promoting data constructors] in TcTyClsDecls - | NoDataKinds -- -XDataKinds not enabled + | NoDataKindsTC -- -XDataKinds not enabled (for a tycon) + | NoDataKindsDC -- -XDataKinds not enabled (for a datacon) | NoTypeInTypeTC -- -XTypeInType not enabled (for a tycon) | NoTypeInTypeDC -- -XTypeInType not enabled (for a datacon) @@ -925,7 +926,8 @@ instance Outputable PromotionErr where ppr PatSynPE = text "PatSynPE" ppr FamDataConPE = text "FamDataConPE" ppr RecDataConPE = text "RecDataConPE" - ppr NoDataKinds = text "NoDataKinds" + ppr NoDataKindsTC = text "NoDataKindsTC" + ppr NoDataKindsDC = text "NoDataKindsDC" ppr NoTypeInTypeTC = text "NoTypeInTypeTC" ppr NoTypeInTypeDC = text "NoTypeInTypeDC" @@ -942,7 +944,8 @@ pprPECategory TyConPE = text "Type constructor" pprPECategory PatSynPE = text "Pattern synonym" pprPECategory FamDataConPE = text "Data constructor" pprPECategory RecDataConPE = text "Data constructor" -pprPECategory NoDataKinds = text "Data constructor" +pprPECategory NoDataKindsTC = text "Type constructor" +pprPECategory NoDataKindsDC = text "Data constructor" pprPECategory NoTypeInTypeTC = text "Type constructor" pprPECategory NoTypeInTypeDC = text "Data constructor" From git at git.haskell.org Thu Feb 18 12:02:41 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Feb 2016 12:02:41 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Simplify AbsBinds wrapping (c4e51c8) Message-ID: <20160218120241.4E23A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/c4e51c89dc3eeb8d7ab2e8f20db6ad17b66ddcda/ghc >--------------------------------------------------------------- commit c4e51c89dc3eeb8d7ab2e8f20db6ad17b66ddcda Author: Simon Peyton Jones Date: Fri Feb 12 13:36:17 2016 +0000 Simplify AbsBinds wrapping In poking Trac #11414 I found myself sinking into the abe_inst_wrap swamp. What is this strange thing? (It turned out that #11414 was breaking because of it.) Thrillingly, I found a way to sweep it away again, putting the deep instantation into tcMonoBinds instead of mkExport; and it turned out that the fun_co_fn field of FunBind was already there ready to receive exactly this wrapper. Hooray. Result * Death to abe_inst_wrap * Death to mbi_orig * Death to the plumbing in tcPolyInfer that did the deep instantiation I did find that I had to re-engineer the treatment of instance type signatures (again), but the result looks more modular and robust to me. And #11414 is fixed. (cherry picked from commit c6485d5e6daec20c8ff66d6e721d3e0a5f3156ac) >--------------------------------------------------------------- c4e51c89dc3eeb8d7ab2e8f20db6ad17b66ddcda compiler/deSugar/DsBinds.hs | 54 ++++---- compiler/hsSyn/HsBinds.hs | 38 +----- compiler/typecheck/TcBinds.hs | 187 ++++++++++----------------- compiler/typecheck/TcClassDcl.hs | 1 - compiler/typecheck/TcHsSyn.hs | 5 +- compiler/typecheck/TcInstDcls.hs | 151 +++++++++++---------- testsuite/tests/deSugar/should_compile/all.T | 2 +- 7 files changed, 186 insertions(+), 252 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 c4e51c89dc3eeb8d7ab2e8f20db6ad17b66ddcda From git at git.haskell.org Thu Feb 18 12:02:44 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Feb 2016 12:02:44 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Add IsList instance for CallStack, restore Show instance for CallStack (80beb40) Message-ID: <20160218120244.02EAA3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/80beb40ed79b2941189f07ae6164e535003f9bf5/ghc >--------------------------------------------------------------- commit 80beb40ed79b2941189f07ae6164e535003f9bf5 Author: RyanGlScott Date: Fri Feb 12 09:24:38 2016 -0500 Add IsList instance for CallStack, restore Show instance for CallStack Summary: Ties up loose ends from D1894. GHC 7.10.2 and 7.10.3 featured a `Show` instance for `CallStack`, but since it was derived, it broke encapsulation. This adds a `Show` instance which displays the `CallStack` as if it were a `[(String, SrcLoc)]`. To ensure that the output of `Show` is technically a valid Haskell term, we also add a corresponding `IsList CallStack` instance. Reviewers: gridaphobe, austin, hvr, bgamari Reviewed By: gridaphobe, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1903 (cherry picked from commit be3d7f661968a7b8c6751c0be3bf23e703b32c3e) >--------------------------------------------------------------- 80beb40ed79b2941189f07ae6164e535003f9bf5 libraries/base/GHC/Exception.hs | 4 ++-- libraries/base/GHC/Exts.hs | 9 +++++++++ libraries/base/GHC/Show.hs | 3 +++ libraries/base/GHC/Stack.hs | 4 ++-- libraries/base/GHC/Stack/Types.hs | 9 ++++++++- libraries/base/changelog.md | 9 ++++++++- 6 files changed, 32 insertions(+), 6 deletions(-) diff --git a/libraries/base/GHC/Exception.hs b/libraries/base/GHC/Exception.hs index ad50cec..be9e6f9 100644 --- a/libraries/base/GHC/Exception.hs +++ b/libraries/base/GHC/Exception.hs @@ -28,8 +28,8 @@ module GHC.Exception , divZeroException, overflowException, ratioZeroDenomException , errorCallException, errorCallWithCallStackException -- re-export CallStack and SrcLoc from GHC.Types - , CallStack, getCallStack, prettyCallStack, prettyCallStackLines - , showCCSStack + , CallStack, fromCallSiteList, getCallStack, prettyCallStack + , prettyCallStackLines, showCCSStack , SrcLoc(..), prettySrcLoc ) where diff --git a/libraries/base/GHC/Exts.hs b/libraries/base/GHC/Exts.hs index dc943e0..31e70eb 100755 --- a/libraries/base/GHC/Exts.hs +++ b/libraries/base/GHC/Exts.hs @@ -191,3 +191,12 @@ instance IsList Version where type (Item Version) = Int fromList = makeVersion toList = versionBranch + +-- | Be aware that 'fromList . toList = id' only for unfrozen 'CallStack's, +-- since 'toList' removes frozenness information. +-- +-- @since 4.9.0.0 +instance IsList CallStack where + type (Item CallStack) = (String, SrcLoc) + fromList = fromCallSiteList + toList = getCallStack diff --git a/libraries/base/GHC/Show.hs b/libraries/base/GHC/Show.hs index a3807bb..72a7320 100644 --- a/libraries/base/GHC/Show.hs +++ b/libraries/base/GHC/Show.hs @@ -205,6 +205,9 @@ instance Show TrName where instance Show Module where showsPrec _ (Module p m) = shows p . (':' :) . shows m +instance Show CallStack where + showsPrec _ = shows . getCallStack + deriving instance Show SrcLoc -------------------------------------------------------------- diff --git a/libraries/base/GHC/Stack.hs b/libraries/base/GHC/Stack.hs index 477dcdc..5f2034e 100644 --- a/libraries/base/GHC/Stack.hs +++ b/libraries/base/GHC/Stack.hs @@ -25,8 +25,8 @@ module GHC.Stack ( -- * HasCallStack call stacks CallStack, HasCallStack, callStack, emptyCallStack, freezeCallStack, - getCallStack, popCallStack, prettyCallStack, pushCallStack, - withFrozenCallStack, + fromCallSiteList, getCallStack, popCallStack, prettyCallStack, + pushCallStack, withFrozenCallStack, -- * Source locations SrcLoc(..), prettySrcLoc, diff --git a/libraries/base/GHC/Stack/Types.hs b/libraries/base/GHC/Stack/Types.hs index 35dfcb0..1fead13 100644 --- a/libraries/base/GHC/Stack/Types.hs +++ b/libraries/base/GHC/Stack/Types.hs @@ -28,7 +28,8 @@ module GHC.Stack.Types ( -- * Implicit call stacks CallStack(..), HasCallStack, - emptyCallStack, freezeCallStack, getCallStack, pushCallStack, + emptyCallStack, freezeCallStack, fromCallSiteList, + getCallStack, pushCallStack, -- * Source locations SrcLoc(..) @@ -148,6 +149,12 @@ getCallStack stk = case stk of PushCallStack cs stk' -> cs : getCallStack stk' FreezeCallStack stk' -> getCallStack stk' +-- | Convert a list of call-sites to a 'CallStack'. +-- +-- @since 4.9.0.0 +fromCallSiteList :: [([Char], SrcLoc)] -> CallStack +fromCallSiteList (c:cs) = PushCallStack c (fromCallSiteList cs) +fromCallSiteList [] = EmptyCallStack -- Note [Definition of CallStack] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ diff --git a/libraries/base/changelog.md b/libraries/base/changelog.md index 7f85f35..7f2f2d3 100644 --- a/libraries/base/changelog.md +++ b/libraries/base/changelog.md @@ -13,7 +13,9 @@ * New `GHC.Generics.packageName` operation - * New `GHC.Stack.CallStack` data type + * Redesigned `GHC.Stack.CallStack` data type. As a result, `CallStack`'s + `Show` instance produces different output, and `CallStack` no longer has an + `Eq` instance. * New `GHC.Generics.packageName` operation @@ -26,6 +28,9 @@ * New `GHC.Stack.Types.pushCallStack` function pushes a call-site onto a `CallStack` + * New `GHC.Stack.Types.fromCallSiteList` function creates a `CallStack` from + a list of call-sites (i.e., `[(String, SrcLoc)]`) + * `GHC.SrcLoc` has been removed * `GHC.Stack.showCallStack` and `GHC.SrcLoc.showSrcLoc` are now called @@ -133,6 +138,8 @@ * Add `MonadPlus IO` and `Alternative IO` instances (previously orphans in `transformers`) (#10755) + * `CallStack` now has an `IsList` instance + ### Generalizations * Generalize `Debug.Trace.{traceM, traceShowM}` from `Monad` to `Applicative` From git at git.haskell.org Thu Feb 18 12:02:46 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Feb 2016 12:02:46 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Add missing newlines at end of file [skip ci] (8655068) Message-ID: <20160218120246.ACD3B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/8655068ae1f7ff0be0f787719f2b9a2e839cf8b4/ghc >--------------------------------------------------------------- commit 8655068ae1f7ff0be0f787719f2b9a2e839cf8b4 Author: Thomas Miedema Date: Mon Feb 15 23:20:56 2016 +0100 Add missing newlines at end of file [skip ci] (cherry picked from commit ed69b215018fb34d70ed8e11166ce970ff6bfe74) >--------------------------------------------------------------- 8655068ae1f7ff0be0f787719f2b9a2e839cf8b4 testsuite/tests/module/mod48.hs | 0 testsuite/tests/module/mod50.hs | 0 testsuite/tests/module/mod51.hs | 0 testsuite/tests/module/mod52.hs | 0 testsuite/tests/module/mod59.hs | 0 testsuite/tests/module/mod60.hs | 0 testsuite/tests/module/mod61.hs | 0 testsuite/tests/warnings/should_compile/T9178.hs | 0 8 files changed, 0 insertions(+), 0 deletions(-) From git at git.haskell.org Thu Feb 18 12:02:49 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Feb 2016 12:02:49 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Rename missing-pat-syn-sigs to missing-pat-syn-signatures (c64c1e4) Message-ID: <20160218120249.B107C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/c64c1e416fe201b645c61b90e41bc929cdee32bd/ghc >--------------------------------------------------------------- commit c64c1e416fe201b645c61b90e41bc929cdee32bd Author: Matthew Pickering Date: Mon Feb 15 23:33:04 2016 +0000 Rename missing-pat-syn-sigs to missing-pat-syn-signatures (cherry picked from commit 3c39bec12e1abfae911a451d3dfb0039b943819d) >--------------------------------------------------------------- c64c1e416fe201b645c61b90e41bc929cdee32bd compiler/main/DynFlags.hs | 2 +- docs/users_guide/8.0.1-notes.rst | 2 +- docs/users_guide/using-warnings.rst | 4 ++-- testsuite/tests/patsyn/should_fail/T11053.hs | 2 +- testsuite/tests/patsyn/should_fail/all.T | 2 +- 5 files changed, 6 insertions(+), 6 deletions(-) diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index bed5f18..d280f02 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -3219,7 +3219,7 @@ wWarningFlagsDeps = [ flagSpec "unused-type-patterns" Opt_WarnUnusedTypePatterns, flagSpec "warnings-deprecations" Opt_WarnWarningsDeprecations, flagSpec "wrong-do-bind" Opt_WarnWrongDoBind, - flagSpec "missing-pat-syn-sigs" Opt_WarnMissingPatSynSigs, + flagSpec "missing-pat-syn-signatures" Opt_WarnMissingPatSynSigs, flagSpec "unrecognised-warning-flags" Opt_WarnUnrecognisedWarningFlags ] -- | These @-\@ flags can all be reversed with @-no-\@ diff --git a/docs/users_guide/8.0.1-notes.rst b/docs/users_guide/8.0.1-notes.rst index 2af8a34..81c30f9 100644 --- a/docs/users_guide/8.0.1-notes.rst +++ b/docs/users_guide/8.0.1-notes.rst @@ -260,7 +260,7 @@ Compiler warnings makes sure the definition of ``Semigroup`` as a superclass of ``Monoid`` does not break any code. -- Added the :ghc-flag:`-Wmissing-pat-syn-sigs` flag. When enabled, this will issue +- Added the :ghc-flag:`-Wmissing-pat-syn-signatures` flag. When enabled, this will issue a warning when a pattern synonym definition doesn't have a type signature. It is turned off by default but enabled by :ghc-flag:`-Wall`. diff --git a/docs/users_guide/using-warnings.rst b/docs/users_guide/using-warnings.rst index 7fd2019..5727b82 100644 --- a/docs/users_guide/using-warnings.rst +++ b/docs/users_guide/using-warnings.rst @@ -618,13 +618,13 @@ of ``-W(no-)*``. about any polymorphic local bindings. As part of the warning GHC also reports the inferred type. The option is off by default. -.. ghc-flag:: -Wmissing-pat-syn-sigs +.. ghc-flag:: -Wmissing-pat-syn-signatures .. index:: single: type signatures, missing, pattern synonyms If you would like GHC to check that every pattern synonym has a type - signature, use the :ghc-flag:`-Wmissing-pat-syn-sigs` option. If this option is + signature, use the :ghc-flag:`-Wmissing-pat-syn-signatures` option. If this option is used in conjunction with :ghc-flag:`-Wmissing-exported-sigs` then only exported pattern synonyms must have a type signature. GHC also reports the inferred type. This option is off by default. diff --git a/testsuite/tests/patsyn/should_fail/T11053.hs b/testsuite/tests/patsyn/should_fail/T11053.hs index 33dec45..1ef3026 100644 --- a/testsuite/tests/patsyn/should_fail/T11053.hs +++ b/testsuite/tests/patsyn/should_fail/T11053.hs @@ -1,5 +1,5 @@ {-# LANGUAGE PatternSynonyms #-} --- turn on with -fwarn-missing-pat-syn-sigs +-- turn on with -fwarn-missing-pat-syn-signatures module Foo where diff --git a/testsuite/tests/patsyn/should_fail/all.T b/testsuite/tests/patsyn/should_fail/all.T index fbe5d58..871d623 100644 --- a/testsuite/tests/patsyn/should_fail/all.T +++ b/testsuite/tests/patsyn/should_fail/all.T @@ -26,6 +26,6 @@ test('poly-export-fail2', expect_broken(10653), compile_fail, ['']) test('export-super-class-fail', expect_broken(10653), compile_fail, ['']) test('export-type-synonym', normal, compile_fail, ['']) test('export-ps-rec-sel', normal, compile_fail, ['']) -test('T11053', normal, compile, ['-fwarn-missing-pat-syn-sigs']) +test('T11053', normal, compile, ['-fwarn-missing-pat-syn-signatures']) test('T10426', normal, compile_fail, ['']) test('T11265', normal, compile_fail, ['']) From git at git.haskell.org Thu Feb 18 12:02:53 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Feb 2016 12:02:53 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Improved error message about exported type operators. (d2744a3) Message-ID: <20160218120253.0F03E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/d2744a3eb6457aa4043986c20685b9ecf8953612/ghc >--------------------------------------------------------------- commit d2744a3eb6457aa4043986c20685b9ecf8953612 Author: Ulya Trofimovich Date: Tue Feb 16 22:41:50 2016 +0100 Improved error message about exported type operators. There is ambiguty between (1) type constructors and (2) data constructors in export lists, e.g. '%%' can stand for both of them. This ambiguity is resolved in favor of (2). If the exported data constructor is not in scope, but type constructor with the same name is in scope, GHC should suggest adding 'type' keyword to resolve ambiguity in favor of (1) and enabling 'TypeOperators' extension. The patch only extends the error message. See Trac #11432. Test Plan: `make test` Reviewers: simonpj, bgamari, austin Reviewed By: simonpj Subscribers: mpickering, thomie, goldfire, kosmikus Differential Revision: https://phabricator.haskell.org/D1902 GHC Trac Issues: #11432 (cherry picked from commit 693a54ea7ac6bdd229e0a297fc023d25263077b9) >--------------------------------------------------------------- d2744a3eb6457aa4043986c20685b9ecf8953612 compiler/rename/RnEnv.hs | 23 ++++++++++++++++++++++- compiler/rename/RnNames.hs | 4 ++-- testsuite/tests/module/T11432.hs | 9 +++++++++ testsuite/tests/module/T11432.stderr | 10 ++++++++++ testsuite/tests/module/all.T | 1 + testsuite/tests/module/mod89.stderr | 0 6 files changed, 44 insertions(+), 3 deletions(-) diff --git a/compiler/rename/RnEnv.hs b/compiler/rename/RnEnv.hs index 868712b..5d74d7c 100644 --- a/compiler/rename/RnEnv.hs +++ b/compiler/rename/RnEnv.hs @@ -13,7 +13,7 @@ module RnEnv ( lookupLocalOccRn_maybe, lookupInfoOccRn, lookupLocalOccThLvl_maybe, lookupTypeOccRn, lookupKindOccRn, - lookupGlobalOccRn, lookupGlobalOccRn_maybe, + lookupGlobalOccRn, lookupGlobalOccRnExport, lookupGlobalOccRn_maybe, lookupOccRn_overloaded, lookupGlobalOccRn_overloaded, reportUnboundName, unknownNameSuggestions, addNameClashErrRn, @@ -853,6 +853,27 @@ lookupGlobalOccRn rdr_name Nothing -> do { traceRn (text "lookupGlobalOccRn" <+> ppr rdr_name) ; unboundName WL_Global rdr_name } } +-- like lookupGlobalOccRn but suggests adding 'type' keyword +-- to export type constructors mistaken for data constructors +lookupGlobalOccRnExport :: RdrName -> RnM Name +lookupGlobalOccRnExport rdr_name + = do { mb_name <- lookupGlobalOccRn_maybe rdr_name + ; case mb_name of + Just n -> return n + Nothing -> do { env <- getGlobalRdrEnv + ; let tycon = setOccNameSpace tcClsName (rdrNameOcc rdr_name) + msg = case lookupOccEnv env tycon of + Just (gre : _) -> make_msg gre + _ -> Outputable.empty + make_msg gre = hang + (hsep [text "Note: use", + quotes (text "type"), + text "keyword to export type constructor", + quotes (ppr (gre_name gre))]) + 2 (vcat [pprNameProvenance gre, + text "(requires TypeOperators extension)"]) + ; unboundNameX WL_Global rdr_name msg } } + lookupInfoOccRn :: RdrName -> RnM [Name] -- lookupInfoOccRn is intended for use in GHCi's ":info" command -- It finds all the GREs that RdrName could mean, not complaining diff --git a/compiler/rename/RnNames.hs b/compiler/rename/RnNames.hs index 7f89025..d8e08e2 100644 --- a/compiler/rename/RnNames.hs +++ b/compiler/rename/RnNames.hs @@ -1346,7 +1346,7 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod lookup_ie_with :: IE RdrName -> Located RdrName -> [Located RdrName] -> RnM (Located Name, [Located Name], [Name], [FieldLabel]) lookup_ie_with ie (L l rdr) sub_rdrs - = do name <- lookupGlobalOccRn rdr + = do name <- lookupGlobalOccRnExport rdr let gres = findChildren kids_env name mchildren = lookupChildren (map classifyGRE (gres ++ pat_syns)) sub_rdrs @@ -1366,7 +1366,7 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod lookup_ie_all :: IE RdrName -> Located RdrName -> RnM (Located Name, [Name], [FieldLabel]) lookup_ie_all ie (L l rdr) = - do name <- lookupGlobalOccRn rdr + do name <- lookupGlobalOccRnExport rdr let gres = findChildren kids_env name (non_flds, flds) = classifyGREs gres addUsedKids rdr gres diff --git a/testsuite/tests/module/T11432.hs b/testsuite/tests/module/T11432.hs new file mode 100644 index 0000000..408935d --- /dev/null +++ b/testsuite/tests/module/T11432.hs @@ -0,0 +1,9 @@ +{- +We expect to get a suggestion to add 'type' keyword +and enable TypeOperators extension. +-} + +{-# LANGUAGE TypeOperators #-} +module T11432 ((-.->)(..)) where + +newtype (f -.-> g) a = Fn { apFn :: f a -> g a } diff --git a/testsuite/tests/module/T11432.stderr b/testsuite/tests/module/T11432.stderr new file mode 100644 index 0000000..bf2a58b --- /dev/null +++ b/testsuite/tests/module/T11432.stderr @@ -0,0 +1,10 @@ + +T11432.hs:7:16: + Not in scope: ?-.->? + Note: use ?type? keyword to export type constructor ?-.->? + defined at T11432.hs:9:1 + (requires TypeOperators extension) + +T11432.hs:7:16: + The export item ?(-.->)(..)? + attempts to export constructors or class methods that are not visible here diff --git a/testsuite/tests/module/all.T b/testsuite/tests/module/all.T index cd1bdac..e6446fe 100644 --- a/testsuite/tests/module/all.T +++ b/testsuite/tests/module/all.T @@ -347,3 +347,4 @@ test('T9061', normal, compile, ['']) test('T9997', normal, compile, ['']) test('T10233', extra_clean(['T01233a.hi', 'T01233a.o']), multimod_compile, ['T10233', '-v0']) +test('T11432', normal, compile_fail, ['']) From git at git.haskell.org Thu Feb 18 12:02:56 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Feb 2016 12:02:56 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Suggest candidate instances in error message (a938c7a) Message-ID: <20160218120256.819033A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/a938c7ad62ccdd6ff4ea15df5ae2ddb8050a04df/ghc >--------------------------------------------------------------- commit a938c7ad62ccdd6ff4ea15df5ae2ddb8050a04df Author: Yuras Shumovich Date: Tue Feb 16 22:45:13 2016 +0100 Suggest candidate instances in error message See Trac #9611. In "No instance..." error message we suggest instances for other types with the same occ name. It is usefull e.g. when we have two different versions of the same package installed. Test Plan: typecheck/should_fail/tcfail224 Reviewers: austin, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1919 GHC Trac Issues: #9611 (cherry picked from commit 5fc06b97b320e98febaa925085dac03e5b01fc5a) >--------------------------------------------------------------- a938c7ad62ccdd6ff4ea15df5ae2ddb8050a04df compiler/typecheck/TcErrors.hs | 29 ++++++++++++++++++---- testsuite/tests/typecheck/should_fail/all.T | 1 + testsuite/tests/typecheck/should_fail/tcfail224.hs | 8 ++++++ .../tests/typecheck/should_fail/tcfail224.stderr | 7 ++++++ 4 files changed, 40 insertions(+), 5 deletions(-) diff --git a/compiler/typecheck/TcErrors.hs b/compiler/typecheck/TcErrors.hs index dd2098f..072af83 100644 --- a/compiler/typecheck/TcErrors.hs +++ b/compiler/typecheck/TcErrors.hs @@ -1758,7 +1758,13 @@ mk_dict_err :: ReportErrCtxt -> (Ct, ClsInstLookupResult) mk_dict_err ctxt (ct, (matches, unifiers, unsafe_overlapped)) | null matches -- No matches but perhaps several unifiers = do { (ctxt, binds_msg, ct) <- relevantBindings True ctxt ct - ; return (ctxt, cannot_resolve_msg ct binds_msg) } + ; instEnvs <- tcGetInstEnvs + ; let candidate_insts = case tys of + -- find data types with the same occ name, see #9611 + [ty] -> filter (is_candidate_inst ty) + (classInstances instEnvs clas) + _ -> [] + ; return (ctxt, cannot_resolve_msg ct candidate_insts binds_msg) } | null unsafe_overlapped -- Some matches => overlap errors = return (ctxt, overlap_msg) @@ -1774,15 +1780,28 @@ mk_dict_err ctxt (ct, (matches, unifiers, unsafe_overlapped)) givens = getUserGivens ctxt all_tyvars = all isTyVarTy tys - - cannot_resolve_msg :: Ct -> SDoc -> SDoc - cannot_resolve_msg ct binds_msg + is_candidate_inst ty inst + | [other_ty] <- is_tys inst + , Just (tc1, _) <- tcSplitTyConApp_maybe ty + , Just (tc2, _) <- tcSplitTyConApp_maybe other_ty + = let n1 = tyConName tc1 + n2 = tyConName tc2 + different_names = n1 /= n2 + same_occ_names = nameOccName n1 == nameOccName n2 + in different_names && same_occ_names + | otherwise = False + + cannot_resolve_msg :: Ct -> [ClsInst] -> SDoc -> SDoc + cannot_resolve_msg ct candidate_insts binds_msg = vcat [ no_inst_msg , nest 2 extra_note , vcat (pp_givens givens) , ppWhen (has_ambig_tvs && not (null unifiers && null givens)) (vcat [ ppUnless lead_with_ambig ambig_msg, binds_msg, potential_msg ]) - , show_fixes (add_to_ctxt_fixes has_ambig_tvs ++ drv_fixes) ] + , show_fixes (add_to_ctxt_fixes has_ambig_tvs ++ drv_fixes) + , ppWhen (not (null candidate_insts)) + (hang (text "There are instances for similar types:") + 2 (vcat (map ppr candidate_insts))) ] where orig = ctOrigin ct -- See Note [Highlighting ambiguous type variables] diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T index bf8d7c7..c51287e 100644 --- a/testsuite/tests/typecheck/should_fail/all.T +++ b/testsuite/tests/typecheck/should_fail/all.T @@ -247,6 +247,7 @@ test('tcfail220', normal, multimod_compile_fail, ['tcfail220.hsig', '-sig-of "Sh test('tcfail221', normal, multimod_compile_fail, ['tcfail221.hsig', '-sig-of "ShouldFail is base:Prelude"']) test('tcfail222', normal, multimod_compile_fail, ['tcfail222.hsig', '-sig-of "ShouldFail is base:Data.STRef"']) test('tcfail223', normal, compile_fail, ['']) +test('tcfail224', normal, compile_fail, ['']) test('SilentParametersOverlapping', normal, compile, ['']) test('FailDueToGivenOverlapping', normal, compile_fail, ['']) diff --git a/testsuite/tests/typecheck/should_fail/tcfail224.hs b/testsuite/tests/typecheck/should_fail/tcfail224.hs new file mode 100644 index 0000000..d2bddb1 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/tcfail224.hs @@ -0,0 +1,8 @@ +module Foo where + +import Prelude hiding( Int ) + +data Int = Int + +f :: Int +f = 3 diff --git a/testsuite/tests/typecheck/should_fail/tcfail224.stderr b/testsuite/tests/typecheck/should_fail/tcfail224.stderr new file mode 100644 index 0000000..70088e2 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/tcfail224.stderr @@ -0,0 +1,7 @@ + +tcfail224.hs:8:5: error: + ? No instance for (Num Int) arising from the literal ?3? + There are instances for similar types: + instance Num GHC.Types.Int -- Defined in ?GHC.Num? + ? In the expression: 3 + In an equation for ?f?: f = 3 From git at git.haskell.org Thu Feb 18 12:02:59 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Feb 2016 12:02:59 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: User manual improvments (c0e380f) Message-ID: <20160218120259.58A263A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/c0e380f2a0c5f476d2aabc55a98f237c3b5c3021/ghc >--------------------------------------------------------------- commit c0e380f2a0c5f476d2aabc55a98f237c3b5c3021 Author: Simon Peyton Jones Date: Fri Feb 12 14:38:22 2016 +0000 User manual improvments - Document that you can use 'forall' in instance decls - Change the sections a bit, so that big sections (like lexically scoped type variables, pattern synonyms, implicit parameters) become more visible >--------------------------------------------------------------- c0e380f2a0c5f476d2aabc55a98f237c3b5c3021 docs/users_guide/glasgow_exts.rst | 6898 +++++++++++++++++++------------------ 1 file changed, 3455 insertions(+), 3443 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 c0e380f2a0c5f476d2aabc55a98f237c3b5c3021 From git at git.haskell.org Thu Feb 18 12:03:02 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Feb 2016 12:03:02 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Fix #11241. (314e148) Message-ID: <20160218120302.C8E6B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/314e1489022e3022b4b348c43a8fa6688807c0c7/ghc >--------------------------------------------------------------- commit 314e1489022e3022b4b348c43a8fa6688807c0c7 Author: Richard Eisenberg Date: Wed Feb 10 08:35:22 2016 -0500 Fix #11241. When renaming a type, now looks for wildcards in bound variables' kinds. testcase: dependent/should_compile/T11241 (cherry picked from commit 43468fe386571564a4bdfc35cbaeab4199259318) >--------------------------------------------------------------- 314e1489022e3022b4b348c43a8fa6688807c0c7 compiler/rename/RnTypes.hs | 9 ++++++++- testsuite/tests/dependent/should_compile/T11241.hs | 6 ++++++ testsuite/tests/dependent/should_compile/T11241.stderr | 6 ++++++ testsuite/tests/dependent/should_compile/all.T | 2 +- 4 files changed, 21 insertions(+), 2 deletions(-) diff --git a/compiler/rename/RnTypes.hs b/compiler/rename/RnTypes.hs index 79f973f..3597560 100644 --- a/compiler/rename/RnTypes.hs +++ b/compiler/rename/RnTypes.hs @@ -151,7 +151,9 @@ rnWcSigTy env (L loc hs_ty@(HsForAllTy { hst_bndrs = tvs, hst_body = hs_tau })) Nothing [] tvs $ \ _ tvs' -> do { (hs_tau', fvs) <- rnWcSigTy env hs_tau ; let hs_ty' = HsForAllTy { hst_bndrs = tvs', hst_body = hswc_body hs_tau' } - ; return ( hs_tau' { hswc_body = L loc hs_ty' }, fvs) } + awcs_bndrs = collectAnonWildCardsBndrs tvs' + ; return ( hs_tau' { hswc_wcs = hswc_wcs hs_tau' ++ awcs_bndrs + , hswc_body = L loc hs_ty' }, fvs) } rnWcSigTy env (L loc (HsQualTy { hst_ctxt = hs_ctxt, hst_body = tau })) = do { (hs_ctxt', fvs1) <- rnWcSigContext env hs_ctxt @@ -1047,6 +1049,11 @@ collectAnonWildCards lty = go lty prefix_types_only (HsAppPrefix ty) = Just ty prefix_types_only (HsAppInfix _) = Nothing +collectAnonWildCardsBndrs :: [LHsTyVarBndr Name] -> [Name] +collectAnonWildCardsBndrs ltvs = concatMap (go . unLoc) ltvs + where + go (UserTyVar _) = [] + go (KindedTyVar _ ki) = collectAnonWildCards ki {- ********************************************************* diff --git a/testsuite/tests/dependent/should_compile/T11241.hs b/testsuite/tests/dependent/should_compile/T11241.hs new file mode 100644 index 0000000..47d20d6 --- /dev/null +++ b/testsuite/tests/dependent/should_compile/T11241.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE ExplicitForAll, KindSignatures, PartialTypeSignatures #-} + +module T11241 where + +foo :: forall (a :: _) . a -> a +foo = id diff --git a/testsuite/tests/dependent/should_compile/T11241.stderr b/testsuite/tests/dependent/should_compile/T11241.stderr new file mode 100644 index 0000000..49a39a9 --- /dev/null +++ b/testsuite/tests/dependent/should_compile/T11241.stderr @@ -0,0 +1,6 @@ + +T11241.hs:5:21: warning: + ? Found type wildcard ?_? standing for ?*? + ? In the type signature: + foo :: forall (a :: _). a -> a + ? Relevant bindings include foo :: a -> a (bound at T11241.hs:6:1) diff --git a/testsuite/tests/dependent/should_compile/all.T b/testsuite/tests/dependent/should_compile/all.T index 4509072..b5e6e07 100644 --- a/testsuite/tests/dependent/should_compile/all.T +++ b/testsuite/tests/dependent/should_compile/all.T @@ -13,4 +13,4 @@ test('T9632', normal, compile, ['']) test('dynamic-paper', normal, compile, ['']) test('T11311', normal, compile, ['']) test('T11405', normal, compile, ['']) - +test('T11241', normal, compile, ['']) From git at git.haskell.org Thu Feb 18 12:03:05 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Feb 2016 12:03:05 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Remove extraneous fundeps on (~) (e1631b3) Message-ID: <20160218120305.869A93A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/e1631b3b58b7440d3d5a8bf72f1490df635792fb/ghc >--------------------------------------------------------------- commit e1631b3b58b7440d3d5a8bf72f1490df635792fb Author: Richard Eisenberg Date: Thu Feb 4 18:31:25 2016 -0500 Remove extraneous fundeps on (~) (cherry picked from commit 7d8031ba3d36a9378a40834aa3e3817d8f7f310f) >--------------------------------------------------------------- e1631b3b58b7440d3d5a8bf72f1490df635792fb libraries/base/Data/Type/Equality.hs | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/libraries/base/Data/Type/Equality.hs b/libraries/base/Data/Type/Equality.hs index 75d2a6c..e7363d2 100644 --- a/libraries/base/Data/Type/Equality.hs +++ b/libraries/base/Data/Type/Equality.hs @@ -54,7 +54,7 @@ import Data.Type.Bool -- | Lifted, homogeneous equality. By lifted, we mean that it can be -- bogus (deferred type error). By homogeneous, the two types @a@ -- and @b@ must have the same kind. -class a ~~ b => (a :: k) ~ (b :: k) | a -> b, b -> a +class a ~~ b => (a :: k) ~ (b :: k) -- See Note [The equality types story] in TysPrim -- NB: All this class does is to wrap its superclass, which is -- the "real", inhomogeneous equality; this is needed when @@ -62,6 +62,10 @@ class a ~~ b => (a :: k) ~ (b :: k) | a -> b, b -> a -- NB: Not exported, as (~) is magical syntax. That's also why there's -- no fixity. + -- It's tempting to put functional dependencies on (~), but it's not + -- necessary because the functional-depedency coverage check looks + -- through superclasses, and (~#) is handled in that check. + instance {-# INCOHERENT #-} a ~~ b => a ~ b -- See Note [The equality types story] in TysPrim -- If we have a Wanted (t1 ~ t2), we want to immediately From git at git.haskell.org Thu Feb 18 12:03:08 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Feb 2016 12:03:08 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Beef up tc124 (9edad91) Message-ID: <20160218120308.5097D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/9edad915db098c4d9a042af48e55d6cdd084a668/ghc >--------------------------------------------------------------- commit 9edad915db098c4d9a042af48e55d6cdd084a668 Author: Simon Peyton Jones Date: Fri Feb 12 13:41:39 2016 +0000 Beef up tc124 Makes it a slightly more stringent test of record pattern bindings (cherry picked from commit 125151870de63de4a227afc2c1e38802009bc7e5) >--------------------------------------------------------------- 9edad915db098c4d9a042af48e55d6cdd084a668 testsuite/tests/typecheck/should_compile/tc124.hs | 14 ++++++++++---- 1 file changed, 10 insertions(+), 4 deletions(-) diff --git a/testsuite/tests/typecheck/should_compile/tc124.hs b/testsuite/tests/typecheck/should_compile/tc124.hs index 658b29c..a832cd3 100644 --- a/testsuite/tests/typecheck/should_compile/tc124.hs +++ b/testsuite/tests/typecheck/should_compile/tc124.hs @@ -7,13 +7,19 @@ module Foo where -data T = T { t1 :: forall a. a -> a , t2 :: forall a b. a->b->b } +data T = T { t1 :: forall a. a -> a + , t2 :: forall b c. b->c->c } -- Test pattern bindings for polymorphic fields -f :: T -> (Int,Char) -f t = let T { t1 = my_t1 } = t +f :: T -> (Int,Char, Char) +f t = let T { t1 = my_t1, t2 = my_t2 } = t in - (my_t1 3, my_t1 'c') + (my_t1 3, my_t1 'c', my_t2 2 'c') + +f2 :: T -> (Int,Char, Char) +f2 t = let T { t1 = my_t1, t2 = my_t2 } = t + in + (my_t1 3, my_t1 'c', my_t2 2 'c') -- Test record update with polymorphic fields g :: T -> T From git at git.haskell.org Thu Feb 18 12:03:11 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Feb 2016 12:03:11 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Existentials should be specified. (31ab4b6) Message-ID: <20160218120311.1912F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/31ab4b6b40f5f411b2e178df5916ae7e88343079/ghc >--------------------------------------------------------------- commit 31ab4b6b40f5f411b2e178df5916ae7e88343079 Author: Richard Eisenberg Date: Fri Jan 29 13:09:42 2016 -0500 Existentials should be specified. This addresses point (2) from #11513. (cherry picked from commit 90f35612f16ff9cb2466cc936f12e748402abb85) >--------------------------------------------------------------- 31ab4b6b40f5f411b2e178df5916ae7e88343079 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 0626836..fd25c79 100644 --- a/compiler/basicTypes/DataCon.hs +++ b/compiler/basicTypes/DataCon.hs @@ -768,7 +768,7 @@ mkDataCon name declared_infix prom_info tag = assoc "mkDataCon" (tyConDataCons rep_tycon `zip` [fIRST_TAG..]) con rep_arg_tys = dataConRepArgTys con - rep_ty = mkSpecForAllTys univ_tvs $ mkInvForAllTys ex_tvs $ + rep_ty = mkSpecForAllTys univ_tvs $ mkSpecForAllTys ex_tvs $ mkFunTys rep_arg_tys $ mkTyConApp rep_tycon (mkTyVarTys univ_tvs) From git at git.haskell.org Thu Feb 18 12:03:13 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Feb 2016 12:03:13 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Improve error message suppression (0e2b99a) Message-ID: <20160218120313.EA8DF3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/0e2b99affd07d8b46eb2f9f5b130a3a4c450358c/ghc >--------------------------------------------------------------- commit 0e2b99affd07d8b46eb2f9f5b130a3a4c450358c Author: Simon Peyton Jones Date: Mon Feb 15 08:39:23 2016 +0000 Improve error message suppression TcErrors has a system for suppressing some type errors if a more serious one occurs. But there was a crucial missing case, which sometimes resulted in a cascade of irrelevant errors overwhelming the actual cause. This was Trac #11541. The fix is simple. Worth merging to 8.0 (cherry picked from commit 18cd712427182e76d38047860ee3e26799bc3fe2) >--------------------------------------------------------------- 0e2b99affd07d8b46eb2f9f5b130a3a4c450358c compiler/typecheck/TcErrors.hs | 19 ++++++++++++------- .../rename/should_fail/RnStaticPointersFail02.stderr | 6 ------ testsuite/tests/rename/should_fail/mc14.stderr | 14 -------------- .../tests/typecheck/should_compile/T11254.stderr | 10 ---------- testsuite/tests/typecheck/should_fail/mc22.stderr | 12 ------------ testsuite/tests/typecheck/should_fail/mc25.stderr | 11 ----------- 6 files changed, 12 insertions(+), 60 deletions(-) diff --git a/compiler/typecheck/TcErrors.hs b/compiler/typecheck/TcErrors.hs index d447906..1985147 100644 --- a/compiler/typecheck/TcErrors.hs +++ b/compiler/typecheck/TcErrors.hs @@ -307,14 +307,19 @@ reportImplic ctxt implic@(Implic { ic_skols = tvs, ic_given = given , ic_info = info' } ctxt' = ctxt { cec_tidy = env1 , cec_encl = implic' : cec_encl ctxt - , cec_suppress = insoluble -- Suppress inessential errors if there - -- are are insolubles anywhere in the - -- tree rooted here + + , cec_suppress = insoluble || cec_suppress ctxt + -- Suppress inessential errors if there + -- are are insolubles anywhere in the + -- tree rooted here, or we've come across + -- a suppress-worthy constraint higher up (Trac #11541) + , cec_binds = cec_binds ctxt *> m_evb } - -- if cec_binds ctxt is Nothing, that means - -- we're reporting *all* errors. Don't change - -- that behavior just because we're going into - -- an implication. + -- If cec_binds ctxt is Nothing, that means + -- we're reporting *all* errors. Don't change + -- that behavior just because we're going into + -- an implication. + dead_givens = case status of IC_Solved { ics_dead = dead } -> dead _ -> [] diff --git a/testsuite/tests/rename/should_fail/RnStaticPointersFail02.stderr b/testsuite/tests/rename/should_fail/RnStaticPointersFail02.stderr index e596a51..b34f435 100644 --- a/testsuite/tests/rename/should_fail/RnStaticPointersFail02.stderr +++ b/testsuite/tests/rename/should_fail/RnStaticPointersFail02.stderr @@ -1,9 +1,3 @@ -RnStaticPointersFail02.hs:5:5: error: - ? No instance for (Data.Typeable.Internal.Typeable t0) - arising from a static form - ? In the expression: static T - In an equation for ?f?: f = static T - RnStaticPointersFail02.hs:5:12: error: Data constructor not in scope: T diff --git a/testsuite/tests/rename/should_fail/mc14.stderr b/testsuite/tests/rename/should_fail/mc14.stderr index bc7b7df..4182c8f 100644 --- a/testsuite/tests/rename/should_fail/mc14.stderr +++ b/testsuite/tests/rename/should_fail/mc14.stderr @@ -1,16 +1,2 @@ -mc14.hs:14:16: error: - Ambiguous type variable ?t0? arising from a use of ?fmap? - prevents the constraint ?(Functor t0)? from being solved. - Probable fix: use a type annotation to specify what ?t0? should be. - These potential instances exist: - instance Functor IO -- Defined in ?GHC.Base? - instance Functor Maybe -- Defined in ?GHC.Base? - instance Functor ((->) r) -- Defined in ?GHC.Base? - ...plus two others - (use -fprint-potential-instances to see them all) - In the expression: fmap - In a stmt of a monad comprehension: then group using f - In the expression: [() | f <- functions, then group using f] - mc14.hs:14:49: error: Variable not in scope: f :: [a] -> m (t0 a) diff --git a/testsuite/tests/typecheck/should_compile/T11254.stderr b/testsuite/tests/typecheck/should_compile/T11254.stderr index 25cd751..692c72f 100644 --- a/testsuite/tests/typecheck/should_compile/T11254.stderr +++ b/testsuite/tests/typecheck/should_compile/T11254.stderr @@ -4,16 +4,6 @@ T11254.hs:16:10: warning: arising from the superclasses of an instance declaration ? In the instance declaration for ?ID Rational? -T11254.hs:16:10: warning: - ? No instance for (Fractional Int) - arising from the superclasses of an instance declaration - ? In the instance declaration for ?ID Rational? - -T11254.hs:16:10: warning: - ? No instance for (ID Int) - arising from the superclasses of an instance declaration - ? In the instance declaration for ?ID Rational? - T11254.hs:18:12: warning: ? Couldn't match type ?GHC.Real.Ratio Integer? with ?Int? Expected type: Rational -> Frac Rational diff --git a/testsuite/tests/typecheck/should_fail/mc22.stderr b/testsuite/tests/typecheck/should_fail/mc22.stderr index 5e369d7..955ebe5 100644 --- a/testsuite/tests/typecheck/should_fail/mc22.stderr +++ b/testsuite/tests/typecheck/should_fail/mc22.stderr @@ -1,16 +1,4 @@ -mc22.hs:9:9: error: - ? No instance for (Functor t) arising from a use of ?fmap? - Possible fix: - add (Functor t) to the context of - a type expected by the context: - (a -> b) -> t a -> t b - or the inferred type of foo :: [t [Char]] - ? In the expression: fmap - In a stmt of a monad comprehension: then group using take 5 - In the expression: - [x + 1 | x <- ["Hello", "World"], then group using take 5] - mc22.hs:10:26: error: ? Couldn't match type ?a? with ?t a? ?a? is a rigid type variable bound by diff --git a/testsuite/tests/typecheck/should_fail/mc25.stderr b/testsuite/tests/typecheck/should_fail/mc25.stderr index 406f89e..7fdb6ff 100644 --- a/testsuite/tests/typecheck/should_fail/mc25.stderr +++ b/testsuite/tests/typecheck/should_fail/mc25.stderr @@ -1,15 +1,4 @@ -mc25.hs:9:10: error: - ? No instance for (Functor t1) arising from a use of ?fmap? - Possible fix: - add (Functor t1) to the context of - a type expected by the context: - (a -> b) -> t1 a -> t1 b - or the inferred type of z :: [t1 t] - ? In the expression: fmap - In a stmt of a monad comprehension: then group by x using take - In the expression: [x | x <- [1 .. 10], then group by x using take] - mc25.hs:9:46: error: ? Couldn't match type ?a -> t? with ?Int? Expected type: (a -> t) -> [a] -> [t1 a] From git at git.haskell.org Thu Feb 18 12:03:16 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Feb 2016 12:03:16 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Remove documentation for -Wlazy-unlifted-bindings (2a9fce0) Message-ID: <20160218120316.C00123A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/2a9fce0eba4f0ef06de79a458bffbccc87aacac5/ghc >--------------------------------------------------------------- commit 2a9fce0eba4f0ef06de79a458bffbccc87aacac5 Author: Ben Gamari Date: Tue Feb 16 22:45:33 2016 +0100 Remove documentation for -Wlazy-unlifted-bindings This flag was supposed to be removed in 7.10. This finally resolves Trac #8022. Test Plan: Read it Reviewers: austin Reviewed By: austin Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1922 GHC Trac Issues: #8022 (cherry picked from commit ad30c760f55205174b3b3472bbcd85fc51fb65d0) >--------------------------------------------------------------- 2a9fce0eba4f0ef06de79a458bffbccc87aacac5 docs/users_guide/using-warnings.rst | 4 ---- utils/mkUserGuidePart/Options/Warnings.hs | 7 ------- 2 files changed, 11 deletions(-) diff --git a/docs/users_guide/using-warnings.rst b/docs/users_guide/using-warnings.rst index 5727b82..e71ae92 100644 --- a/docs/users_guide/using-warnings.rst +++ b/docs/users_guide/using-warnings.rst @@ -371,10 +371,6 @@ of ``-W(no-)*``. Causes a warning to be emitted if an enumeration is empty, e.g. ``[5 .. 3]``. -.. ghc-flag:: -Wlazy-unlifted-bindings - - This flag is a no-op, and will be removed in GHC 7.10. - .. ghc-flag:: -Wduplicate-constraints .. index:: diff --git a/utils/mkUserGuidePart/Options/Warnings.hs b/utils/mkUserGuidePart/Options/Warnings.hs index de5e159..37597f8 100644 --- a/utils/mkUserGuidePart/Options/Warnings.hs +++ b/utils/mkUserGuidePart/Options/Warnings.hs @@ -117,13 +117,6 @@ warningsOptions = , flagType = DynamicFlag , flagReverse = "-Wno-incomplete-record-updates" } - , flag { flagName = "-Wlazy-unlifted-bindings" - , flagDescription = - "*(deprecated)* warn when a pattern binding looks lazy but "++ - "must be strict" - , flagType = DynamicFlag - , flagReverse = "-Wno-lazy-unlifted-bindings" - } , flag { flagName = "-Wmissing-fields" , flagDescription = "warn when fields of a record are uninitialised" , flagType = DynamicFlag From git at git.haskell.org Thu Feb 18 12:03:19 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Feb 2016 12:03:19 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Fix typos (e091062) Message-ID: <20160218120319.8F4853A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/e091062229e57a8344a165e110641be191d59552/ghc >--------------------------------------------------------------- commit e091062229e57a8344a165e110641be191d59552 Author: Rik Steenkamp Date: Tue Feb 16 22:44:42 2016 +0100 Fix typos Reviewers: bgamari, austin Reviewed By: austin Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1915 (cherry picked from commit 49c5cb40f049f0a868fa310a240a31b571f40491) >--------------------------------------------------------------- e091062229e57a8344a165e110641be191d59552 compiler/basicTypes/OccName.hs | 8 ++++---- compiler/basicTypes/PatSyn.hs | 8 ++++---- compiler/basicTypes/Unique.hs | 2 +- compiler/basicTypes/VarEnv.hs | 2 +- compiler/basicTypes/VarSet.hs | 2 +- compiler/hsSyn/HsBinds.hs | 2 +- compiler/typecheck/TcErrors.hs | 2 +- compiler/typecheck/TcPatSyn.hs | 12 ++++++------ compiler/typecheck/TcRnTypes.hs | 10 +++++----- compiler/types/TyCoRep.hs | 2 +- docs/users_guide/glasgow_exts.rst | 10 +++++----- testsuite/tests/monadfail/MonadFailWarnings.stderr | 8 ++++---- testsuite/tests/wcompat-warnings/WCompatWarningsOn.stderr | 2 +- 13 files changed, 35 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 e091062229e57a8344a165e110641be191d59552 From git at git.haskell.org Thu Feb 18 12:03:22 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Feb 2016 12:03:22 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Improve pretty-printing of HsWrappers (9ea96d5) Message-ID: <20160218120322.5245E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/9ea96d5ff04e018c33def628e394ec55c0416662/ghc >--------------------------------------------------------------- commit 9ea96d5ff04e018c33def628e394ec55c0416662 Author: Simon Peyton Jones Date: Fri Feb 12 13:42:55 2016 +0000 Improve pretty-printing of HsWrappers Reduces un-neede parens. Also -fprint-typechecker-elaboration now makes type applications and casts in expressions also appear. (Previously those were confusingly controlled by -fprint-explicit-coercions.) (cherry picked from commit d0846243747213218cba856d5c322016bd3e6d9e) >--------------------------------------------------------------- 9ea96d5ff04e018c33def628e394ec55c0416662 compiler/hsSyn/HsExpr.hs | 40 +++++++++++++---------- compiler/hsSyn/HsPat.hs | 22 ++++++++----- compiler/typecheck/TcEvidence.hs | 40 ++++++++++++----------- compiler/typecheck/TcExpr.hs | 6 ++-- compiler/typecheck/TcSplice.hs | 2 +- testsuite/tests/roles/should_compile/T8958.stderr | 10 +++--- 6 files changed, 64 insertions(+), 56 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 9ea96d5ff04e018c33def628e394ec55c0416662 From git at git.haskell.org Thu Feb 18 12:03:25 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Feb 2016 12:03:25 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Make exactTyCoVarsOfTypes closed over kinds. (01d0079) Message-ID: <20160218120325.10C5C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/01d00798aae96af9e58e5f115e9dec93bf0c2baf/ghc >--------------------------------------------------------------- commit 01d00798aae96af9e58e5f115e9dec93bf0c2baf Author: Richard Eisenberg Date: Thu Jan 28 17:39:03 2016 -0500 Make exactTyCoVarsOfTypes closed over kinds. (cherry picked from commit b962bcc609cf3239d61ba281ca0eccc3cd89d99d) >--------------------------------------------------------------- 01d00798aae96af9e58e5f115e9dec93bf0c2baf compiler/typecheck/TcType.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/typecheck/TcType.hs b/compiler/typecheck/TcType.hs index a91f407..b52681a 100644 --- a/compiler/typecheck/TcType.hs +++ b/compiler/typecheck/TcType.hs @@ -750,7 +750,7 @@ exactTyCoVarsOfType ty = go ty where go ty | Just ty' <- coreView ty = go ty' -- This is the key line - go (TyVarTy tv) = unitVarSet tv + go (TyVarTy tv) = unitVarSet tv `unionVarSet` go (tyVarKind tv) go (TyConApp _ tys) = exactTyCoVarsOfTypes tys go (LitTy {}) = emptyVarSet go (AppTy fun arg) = go fun `unionVarSet` go arg From git at git.haskell.org Thu Feb 18 12:03:27 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Feb 2016 12:03:27 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Add missing kind cast to pure unifier. (c88cd45) Message-ID: <20160218120327.CAAC73A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/c88cd459c97b0c32221721e75c823c8a7064b0a1/ghc >--------------------------------------------------------------- commit c88cd459c97b0c32221721e75c823c8a7064b0a1 Author: Richard Eisenberg Date: Sat Jan 30 16:49:22 2016 -0500 Add missing kind cast to pure unifier. (cherry picked from commit aff5bb47b70450bb1e3e4ac3c18ea35d13f9ac7c) >--------------------------------------------------------------- c88cd459c97b0c32221721e75c823c8a7064b0a1 compiler/types/Unify.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/types/Unify.hs b/compiler/types/Unify.hs index 271ddb6..2eb38c8 100644 --- a/compiler/types/Unify.hs +++ b/compiler/types/Unify.hs @@ -796,7 +796,7 @@ uVar tv1 ty kco -- this is because the range of the subst is the target -- type, not the template type. So, just check for -- normal type equality. - guard (ty' `eqType` ty) } + guard ((ty' `mkCastTy` kco) `eqType` ty) } Nothing -> uUnrefined tv1 ty ty kco } -- No, continue uUnrefined :: TyVar -- variable to be unified From git at git.haskell.org Thu Feb 18 12:03:30 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Feb 2016 12:03:30 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: A tiny, outright bug in tcDataFamInstDecl (a885f48) Message-ID: <20160218120330.822093A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/a885f485d3a017658a29b7436f875e7d457b0c81/ghc >--------------------------------------------------------------- commit a885f485d3a017658a29b7436f875e7d457b0c81 Author: Simon Peyton Jones Date: Mon Feb 15 15:51:50 2016 +0000 A tiny, outright bug in tcDataFamInstDecl This bug was revealed by Trac #11362. It turns out that in my patch for Trac #11148 (namely 1160dc5), I failed to turn one occurrence of tvs' into full_tvs. Sigh. This is tricky stuff and it cost me several hours to page it back in and figure out what was happening. The result was a CoAxiom whose lhs had rhs had different kinds. Eeek! Anyway it's fixed. I also added an ASSERT, in FamInst.newFamInst, that trips on such bogus CoAxioms. (cherry picked from commit e2f7d777bb7e4c176e01e1c4f8184f115253dee0) >--------------------------------------------------------------- a885f485d3a017658a29b7436f875e7d457b0c81 compiler/typecheck/FamInst.hs | 9 ++++++++- compiler/typecheck/TcClassDcl.hs | 3 +-- compiler/typecheck/TcInstDcls.hs | 21 +++++++++++---------- testsuite/tests/polykinds/T6137.hs | 21 +++++++++++++++++++-- 4 files changed, 39 insertions(+), 15 deletions(-) diff --git a/compiler/typecheck/FamInst.hs b/compiler/typecheck/FamInst.hs index 3b14829..2ff256d 100644 --- a/compiler/typecheck/FamInst.hs +++ b/compiler/typecheck/FamInst.hs @@ -67,7 +67,10 @@ newFamInst :: FamFlavor -> CoAxiom Unbranched -> TcRnIf gbl lcl FamInst -- Freshen the type variables of the FamInst branches -- Called from the vectoriser monad too, hence the rather general type newFamInst flavor axiom@(CoAxiom { co_ax_tc = fam_tc }) - = do { (subst, tvs') <- freshenTyVarBndrs tvs + = ASSERT2( tyCoVarsOfTypes lhs `subVarSet` tcv_set, text "lhs" <+> pp_ax ) + ASSERT2( tyCoVarsOfType rhs `subVarSet` tcv_set, text "rhs" <+> pp_ax ) + ASSERT2( lhs_kind `eqType` rhs_kind, text "kind" <+> pp_ax $$ ppr lhs_kind $$ ppr rhs_kind ) + do { (subst, tvs') <- freshenTyVarBndrs tvs ; (subst, cvs') <- freshenCoVarBndrsX subst cvs ; return (FamInst { fi_fam = tyConName fam_tc , fi_flavor = flavor @@ -78,6 +81,10 @@ newFamInst flavor axiom@(CoAxiom { co_ax_tc = fam_tc }) , fi_rhs = substTy subst rhs , fi_axiom = axiom }) } where + lhs_kind = typeKind (mkTyConApp fam_tc lhs) + rhs_kind = typeKind rhs + tcv_set = mkVarSet (tvs ++ cvs) + pp_ax = pprCoAxiom axiom CoAxBranch { cab_tvs = tvs , cab_cvs = cvs , cab_lhs = lhs diff --git a/compiler/typecheck/TcClassDcl.hs b/compiler/typecheck/TcClassDcl.hs index 9c9d8b5..7fa034c 100644 --- a/compiler/typecheck/TcClassDcl.hs +++ b/compiler/typecheck/TcClassDcl.hs @@ -470,8 +470,7 @@ tcATDefault emit_warn loc inst_subst defined_ats (ATI fam_tc defs) ; traceTc "mk_deflt_at_instance" (vcat [ ppr fam_tc, ppr rhs_ty , pprCoAxiom axiom ]) - ; fam_inst <- ASSERT( tyCoVarsOfType rhs' `subVarSet` tv_set' ) - newFamInst SynFamilyInst axiom + ; fam_inst <- newFamInst SynFamilyInst axiom ; return [fam_inst] } -- No defaults ==> generate a warning diff --git a/compiler/typecheck/TcInstDcls.hs b/compiler/typecheck/TcInstDcls.hs index e78aab9..d27f350 100644 --- a/compiler/typecheck/TcInstDcls.hs +++ b/compiler/typecheck/TcInstDcls.hs @@ -676,7 +676,7 @@ tcDataFamInstDecl mb_clsinfo -- (obtained from the pats) are at the end (Trac #11148) orig_res_ty = mkTyConApp fam_tc pats' - ; (rep_tc, fam_inst) <- fixM $ \ ~(rec_rep_tc, _) -> + ; (rep_tc, axiom) <- fixM $ \ ~(rec_rep_tc, _) -> do { data_cons <- tcConDecls new_or_data rec_rep_tc (full_tvs, orig_res_ty) cons @@ -689,23 +689,23 @@ tcDataFamInstDecl mb_clsinfo axiom_name eta_tvs [] fam_tc eta_pats (mkTyConApp rep_tc (mkTyVarTys eta_tvs)) parent = DataFamInstTyCon axiom fam_tc pats' - kind = mkPiTypesPreferFunTy tvs' liftedTypeKind - + rep_tc_kind = mkPiTypesPreferFunTy full_tvs liftedTypeKind -- NB: Use the full_tvs from the pats. See bullet toward -- the end of Note [Data type families] in TyCon - rep_tc = mkAlgTyCon rep_tc_name kind full_tvs - (map (const Nominal) full_tvs) - (fmap unLoc cType) stupid_theta - tc_rhs parent - Recursive gadt_syntax + rep_tc = mkAlgTyCon rep_tc_name + rep_tc_kind + full_tvs + (map (const Nominal) full_tvs) + (fmap unLoc cType) stupid_theta + tc_rhs parent + Recursive gadt_syntax -- We always assume that indexed types are recursive. Why? -- (1) Due to their open nature, we can never be sure that a -- further instance might not introduce a new recursive -- dependency. (2) They are always valid loop breakers as -- they involve a coercion. - ; fam_inst <- newFamInst (DataFamilyInst rep_tc) axiom - ; return (rep_tc, fam_inst) } + ; return (rep_tc, axiom) } -- Remember to check validity; no recursion to worry about here ; checkValidTyCon rep_tc @@ -717,6 +717,7 @@ tcDataFamInstDecl mb_clsinfo , di_preds = preds , di_ctxt = tcMkDataFamInstCtxt decl } + ; fam_inst <- newFamInst (DataFamilyInst rep_tc) axiom ; return (fam_inst, m_deriv_info) } } where eta_reduce :: [Type] -> ([Type], [TyVar]) diff --git a/testsuite/tests/polykinds/T6137.hs b/testsuite/tests/polykinds/T6137.hs index dafe9a2..aac4c1c 100644 --- a/testsuite/tests/polykinds/T6137.hs +++ b/testsuite/tests/polykinds/T6137.hs @@ -17,9 +17,26 @@ data Code i o = F (Code (Sum i o) o) -- An interpretation for `Code` using a data family works: data family In (f :: Code i o) :: (i -> *) -> (o -> *) -data instance In (F f) r o where - MkIn :: In f (Sum1 r (In (F f) r)) o -> In (F f) r o +data instance In (F f) r x where + MkIn :: In f (Sum1 r (In (F f) r)) x -> In (F f) r x + +{- data R:InioFrx o i f r x where + where MkIn :: forall o i (f :: Code (Sum i o) o) (r :: i -> *) (x :: o). + In (Sum i o) o f (Sum1 o i r (In i o ('F i o f) r)) x + -> R:InioFrx o i f r x + + So R:InioFrx :: forall o i. Code i o -> (i -> *) -> o -> * + + data family In i o (f :: Code i o) (a :: i -> *) (b :: o) + + axiom D:R:InioFrx0 :: + forall o i (f :: Code (Sum i o) o). + In i o ('F i o f) = R:InioFrx o i f + + + D:R:InioFrx0 :: R:InioFrx o i f ~ In i o ('F i o f) +-} -- Requires polymorphic recursion data In' (f :: Code i o) :: (i -> *) -> o -> * where MkIn' :: In' g (Sum1 r (In' (F g) r)) t -> In' (F g) r t From git at git.haskell.org Thu Feb 18 12:03:33 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Feb 2016 12:03:33 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Minor refactoring to tauifyMultipleMatches (4825afe) Message-ID: <20160218120333.3B8C13A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/4825afeca73a7560591c5ddff1eb071ef6d5a182/ghc >--------------------------------------------------------------- commit 4825afeca73a7560591c5ddff1eb071ef6d5a182 Author: Simon Peyton Jones Date: Fri Feb 12 13:44:44 2016 +0000 Minor refactoring to tauifyMultipleMatches No change in behaviour (cherry picked from commit 24305bead969fdf85be8b8f4a42cd88ad21a7e16) >--------------------------------------------------------------- 4825afeca73a7560591c5ddff1eb071ef6d5a182 compiler/typecheck/TcMType.hs | 7 +++++++ compiler/typecheck/TcMatches.hs | 24 ++++++++---------------- 2 files changed, 15 insertions(+), 16 deletions(-) diff --git a/compiler/typecheck/TcMType.hs b/compiler/typecheck/TcMType.hs index 3d9e57c..a79c346 100644 --- a/compiler/typecheck/TcMType.hs +++ b/compiler/typecheck/TcMType.hs @@ -32,6 +32,7 @@ module TcMType ( ExpType(..), ExpSigmaType, ExpRhoType, mkCheckExpType, newOpenInferExpType, readExpType, readExpType_maybe, writeExpType, expTypeToType, checkingExpType_maybe, checkingExpType, + tauifyExpType, -------------------------------- -- Creating fresh type variables for pm checking @@ -386,6 +387,12 @@ checkingExpType :: String -> ExpType -> TcType checkingExpType _ (Check ty) = ty checkingExpType err et = pprPanic "checkingExpType" (text err $$ ppr et) +tauifyExpType :: ExpType -> TcM ExpType +-- ^ Turn a (Infer hole) type into a (Check alpha), +-- where alpha is a fresh unificaiton variable +tauifyExpType exp_ty = do { ty <- expTypeToType exp_ty + ; return (Check ty) } + -- | Extracts the expected type if there is one, or generates a new -- TauTv if there isn't. expTypeToType :: ExpType -> TcM TcType diff --git a/compiler/typecheck/TcMatches.hs b/compiler/typecheck/TcMatches.hs index c1d9048..b918ecf 100644 --- a/compiler/typecheck/TcMatches.hs +++ b/compiler/typecheck/TcMatches.hs @@ -94,9 +94,7 @@ tcMatchesFun fun_name matches exp_ty <- matchExpectedFunTys herald arity exp_rho $ \ pat_tys rhs_ty -> -- See Note [Case branches must never infer a non-tau type] - do { rhs_ty : pat_tys - <- mapM (tauifyMultipleMatches matches) - (rhs_ty : pat_tys) + do { rhs_ty:pat_tys <- tauifyMultipleMatches matches (rhs_ty:pat_tys) ; tcMatches match_ctxt pat_tys rhs_ty matches } ; return (wrap_fun, matches') } ; return (wrap_gen <.> wrap_fun, group) } @@ -121,7 +119,7 @@ tcMatchesCase :: (Outputable (body Name)) => -- wrapper goes from MatchGroup's ty to expected ty tcMatchesCase ctxt scrut_ty matches res_ty - = do { res_ty <- tauifyMultipleMatches matches res_ty + = do { [res_ty] <- tauifyMultipleMatches matches [res_ty] ; tcMatches ctxt [mkCheckExpType scrut_ty] res_ty matches } tcMatchLambda :: SDoc -- see Note [Herald for matchExpectedFunTys] in TcUnify @@ -134,8 +132,7 @@ tcMatchLambda herald match_ctxt match res_ty = do { ((match', pat_tys), wrap) <- matchExpectedFunTys herald n_pats res_ty $ \ pat_tys rhs_ty -> - do { rhs_ty : pat_tys <- mapM (tauifyMultipleMatches match) - (rhs_ty : pat_tys) + do { rhs_ty:pat_tys <- tauifyMultipleMatches match (rhs_ty:pat_tys) ; match' <- tcMatches match_ctxt pat_tys rhs_ty match ; pat_tys <- mapM readExpType pat_tys ; return (match', pat_tys) } @@ -196,16 +193,11 @@ still gets assigned a polytype. -- expected type into TauTvs. -- See Note [Case branches must never infer a non-tau type] tauifyMultipleMatches :: MatchGroup id body - -> ExpType - -> TcM ExpType -tauifyMultipleMatches group exp_ty - | isSingletonMatchGroup group - = return exp_ty - - | otherwise - = mkCheckExpType <$> expTypeToType exp_ty - -- NB: This also ensures that an empty match still fills in the - -- ExpType + -> [ExpType] -> TcM [ExpType] +tauifyMultipleMatches group exp_tys + | isSingletonMatchGroup group = return exp_tys + | otherwise = mapM tauifyExpType exp_tys + -- NB: In the empty-match case, this ensures we fill in the ExpType -- | Type-check a MatchGroup. If there are multiple RHSs, the expected type -- must already be tauified. From git at git.haskell.org Thu Feb 18 12:03:35 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Feb 2016 12:03:35 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Make bootstrapping more robust (287d083) Message-ID: <20160218120335.ECC1B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/287d08343cc757b88f0abf6d42e8cea264dad706/ghc >--------------------------------------------------------------- commit 287d08343cc757b88f0abf6d42e8cea264dad706 Author: Herbert Valerio Riedel Date: Tue Feb 16 22:41:29 2016 +0100 Make bootstrapping more robust Starting with GHC 8.0 we rely on GHC's native cabal macro generation. As a side-effect, this limits the packages in scope when compiling `ghc-cabal` for all bootstrapping GHCs. Reviewers: ezyang, austin, thomie, bgamari Reviewed By: thomie, bgamari Differential Revision: https://phabricator.haskell.org/D1897 GHC Trac Issues: #11413 (cherry picked from commit 525a304f8c010ce73f1456e507aca668eb4917ac) >--------------------------------------------------------------- 287d08343cc757b88f0abf6d42e8cea264dad706 utils/ghc-cabal/cabal_macros_boot.h | 4 +++- utils/ghc-cabal/ghc.mk | 16 ++++++++++++++++ 2 files changed, 19 insertions(+), 1 deletion(-) diff --git a/utils/ghc-cabal/cabal_macros_boot.h b/utils/ghc-cabal/cabal_macros_boot.h index a2da63a..3b130e8 100644 --- a/utils/ghc-cabal/cabal_macros_boot.h +++ b/utils/ghc-cabal/cabal_macros_boot.h @@ -1,6 +1,8 @@ /* defines a few MIN_VERSION_...() macros used by some of the bootstrap packages */ -#if __GLASGOW_HASKELL__ >= 711 +#if __GLASGOW_HASKELL__ >= 800 +/* macros are generated accurately by GHC on the fly */ +#elif __GLASGOW_HASKELL__ >= 711 /* package base-4.9.0.0 */ # define MIN_VERSION_base(major1,major2,minor) (\ (major1) < 4 || \ diff --git a/utils/ghc-cabal/ghc.mk b/utils/ghc-cabal/ghc.mk index 49a2ba3..c06a011 100644 --- a/utils/ghc-cabal/ghc.mk +++ b/utils/ghc-cabal/ghc.mk @@ -18,6 +18,20 @@ CABAL_DOTTED_VERSION := $(shell grep "^version:" libraries/Cabal/Cabal/Cabal.cab CABAL_VERSION := $(subst .,$(comma),$(CABAL_DOTTED_VERSION)) CABAL_CONSTRAINT := --constraint="Cabal == $(CABAL_DOTTED_VERSION)" +# Starting with GHC 8.0 we make use of GHC's native ability to +# generate MIN_VERSION_() CPP macros (rather than relying on +# the fragile `cabal_macros_boot.h` hack). The generation of those +# macros is triggered by `-hide-all-packages`, so we have to explicitly +# enumerate all packages we need in scope. In order to simplify the logic, +# we pass `-hide-all-packages` also to GHCs < 8, and we include +# `cabal_macros_boot.h` also for GHC >= 8 (in which case it becomes a +# dummy include that doesn't contribute any macro definitions). +ifeq "$(Windows_Host)" "YES" +CABAL_BUILD_DEPS := base array time containers bytestring deepseq process pretty directory Win32 +else +CABAL_BUILD_DEPS := base array time containers bytestring deepseq process pretty directory unix +endif + ghc-cabal_DIST_BINARY_NAME = ghc-cabal$(exeext0) ghc-cabal_DIST_BINARY = utils/ghc-cabal/dist/build/tmp/$(ghc-cabal_DIST_BINARY_NAME) ghc-cabal_INPLACE = inplace/bin/$(ghc-cabal_DIST_BINARY_NAME) @@ -34,6 +48,8 @@ $(ghc-cabal_DIST_BINARY): utils/ghc-cabal/Main.hs $(TOUCH_DEP) | $$(dir $$@)/. b "$(GHC)" $(SRC_HC_OPTS) \ $(addprefix -optc, $(SRC_CC_OPTS) $(CONF_CC_OPTS_STAGE0)) \ $(addprefix -optl, $(SRC_LD_OPTS) $(CONF_LD_OPTS_STAGE0)) \ + -hide-all-packages \ + $(addprefix -package , $(CABAL_BUILD_DEPS)) \ --make utils/ghc-cabal/Main.hs -o $@ \ -no-user-$(GHC_PACKAGE_DB_FLAG) \ -Wall -fno-warn-unused-imports -fno-warn-warnings-deprecations \ From git at git.haskell.org Thu Feb 18 12:03:38 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Feb 2016 12:03:38 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Allow foralls in instance decls (28c26d9) Message-ID: <20160218120338.B09AB3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/28c26d9da990e4889f77b562fb76fb79e71f9ef2/ghc >--------------------------------------------------------------- commit 28c26d9da990e4889f77b562fb76fb79e71f9ef2 Author: Simon Peyton Jones Date: Mon Feb 8 09:05:12 2016 +0000 Allow foralls in instance decls This patch finally makes it possible to have explicit foralls in an instance decl instance forall (a :: *). Eq a => Eq [a] where ... This is useful to allow kind signatures or indeed explicicit kind for-alls; see Trac #11519 I thought it would be really easy, because an instance declaration already contains an actual HsSigType, so all the syntactic baggage is there. But in fact it turned out that instance declarations were kind-checked a little differently, because the body kind of the forall is 'Constraint' rather than '*'. So I fixed that. There a slight kludge (see Note [Body kind of a HsQualTy], but it's still a significant improvement. I also did the usual other round of refactoring, improved a few error messages, tidied up comments etc. The only significant aspect of all that was * Kill mkNakedSpecSigmaTy, mkNakedPhiTy, mkNakedFunTy These function names suggest that they do something complicated, but acutally they do nothing. So I killed them. * Swap the arg order of mkNamedBinder, just so that it is convenient to say 'map (mkNamedBinder Invisible) tvs' * I had to improve isPredTy, to deal with (illegal) types like (Eq a => Eq [a]) => blah See Note [isPeredTy complications] in Type.hs Still to come: user manual documentation for the instance-decl change. (cherry picked from commit 2cf3cac6a05879c27fa82b12dd34cce39a262402) >--------------------------------------------------------------- 28c26d9da990e4889f77b562fb76fb79e71f9ef2 compiler/hsSyn/HsTypes.hs | 301 +++++++++++++-------- compiler/hsSyn/HsUtils.hs | 65 ----- compiler/rename/RnSource.hs | 3 +- compiler/typecheck/TcBinds.hs | 4 +- compiler/typecheck/TcHsType.hs | 126 ++++----- compiler/typecheck/TcInstDcls.hs | 3 +- compiler/typecheck/TcType.hs | 25 +- compiler/typecheck/TcValidity.hs | 23 +- compiler/types/Coercion.hs | 2 +- compiler/types/TyCoRep.hs | 3 +- compiler/types/Type.hs | 76 ++++-- testsuite/tests/gadt/T3163.stderr | 6 +- .../tests/ghci.debugger/scripts/break006.stderr | 4 +- .../tests/ghci.debugger/scripts/print019.stderr | 2 +- .../indexed-types/should_fail/SimpleFail12.stderr | 6 +- .../indexed-types/should_fail/SimpleFail15.stderr | 7 +- .../tests/indexed-types/should_fail/T10899.stderr | 4 +- .../tests/indexed-types/should_fail/T9357.stderr | 12 +- .../should_fail/overloadedlistsfail01.stderr | 4 +- .../tests/rename/should_fail/rnfail026.stderr | 2 +- .../tests/typecheck/should_compile/holes2.stderr | 2 +- .../tests/typecheck/should_fail/T11355.stderr | 2 +- testsuite/tests/typecheck/should_fail/T2538.stderr | 20 +- testsuite/tests/typecheck/should_fail/T5957.stderr | 7 +- testsuite/tests/typecheck/should_fail/T7019.stderr | 8 +- .../tests/typecheck/should_fail/T7019a.stderr | 9 +- testsuite/tests/typecheck/should_fail/T7809.stderr | 7 +- testsuite/tests/typecheck/should_fail/T8806.stderr | 10 - testsuite/tests/typecheck/should_fail/T9196.stderr | 15 +- .../tests/typecheck/should_fail/tcfail088.stderr | 6 +- .../tests/typecheck/should_fail/tcfail127.stderr | 7 +- .../tests/typecheck/should_fail/tcfail133.stderr | 2 +- .../tests/typecheck/should_fail/tcfail184.stderr | 11 +- .../tests/typecheck/should_fail/tcfail195.stderr | 6 +- .../tests/typecheck/should_fail/tcfail196.stderr | 3 +- .../tests/typecheck/should_fail/tcfail197.stderr | 2 +- 36 files changed, 401 insertions(+), 394 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 28c26d9da990e4889f77b562fb76fb79e71f9ef2 From git at git.haskell.org Thu Feb 18 12:03:41 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Feb 2016 12:03:41 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: renamer discards name location for HsRecField (62ed152) Message-ID: <20160218120341.6FF0F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/62ed15255135b953e93fec0cf793b16ce1722163/ghc >--------------------------------------------------------------- commit 62ed15255135b953e93fec0cf793b16ce1722163 Author: Alan Zimmerman Date: Sun Feb 14 21:43:55 2016 +0200 renamer discards name location for HsRecField When renaming a HsVar it can be converted to a HsRecField. In the process the location of the enclosed name is converted to a noLoc Closes #11576 (cherry picked from commit cd4a7d07890fa53c455c14f22c2d30c22b64a396) >--------------------------------------------------------------- 62ed15255135b953e93fec0cf793b16ce1722163 compiler/rename/RnExpr.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/compiler/rename/RnExpr.hs b/compiler/rename/RnExpr.hs index e88f1e0..69b8d6e 100644 --- a/compiler/rename/RnExpr.hs +++ b/compiler/rename/RnExpr.hs @@ -108,8 +108,9 @@ rnExpr (HsVar (L l v)) | otherwise -> finishHsVar (L l name) ; - Just (Right [f]) -> return (HsRecFld (ambiguousFieldOcc f) - , unitFV (selectorFieldOcc f)) ; + Just (Right [f@(FieldOcc (L _ fn) s)]) -> + return (HsRecFld (ambiguousFieldOcc (FieldOcc (L l fn) s)) + , unitFV (selectorFieldOcc f)) ; Just (Right fs@(_:_:_)) -> return (HsRecFld (Ambiguous (L l v) PlaceHolder) , mkFVs (map selectorFieldOcc fs)); From git at git.haskell.org Thu Feb 18 12:03:45 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Feb 2016 12:03:45 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Fix #11313. (b2db13a) Message-ID: <20160218120345.057663A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/b2db13a7e7b693419170216ea6f74dc92723a8a9/ghc >--------------------------------------------------------------- commit b2db13a7e7b693419170216ea6f74dc92723a8a9 Author: Richard Eisenberg Date: Wed Feb 10 09:38:09 2016 -0500 Fix #11313. Previously, we looked through synonyms when counting arguments, but that's a bit silly. (cherry picked from commit a6152159c9f14fc9cf0e86caff532906abd49b73) >--------------------------------------------------------------- b2db13a7e7b693419170216ea6f74dc92723a8a9 compiler/typecheck/TcMType.hs | 5 +- compiler/typecheck/TcTyClsDecls.hs | 55 ++++++++++++---------- compiler/types/TyCon.hs | 7 ++- compiler/types/Type.hs | 17 ++++++- testsuite/tests/typecheck/should_fail/T11313.hs | 9 ++++ .../tests/typecheck/should_fail/T11313.stderr | 6 +++ testsuite/tests/typecheck/should_fail/all.T | 1 + 7 files changed, 71 insertions(+), 29 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 b2db13a7e7b693419170216ea6f74dc92723a8a9 From git at git.haskell.org Thu Feb 18 12:03:48 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Feb 2016 12:03:48 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Fix #11246. (6133d58) Message-ID: <20160218120348.392BA3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/6133d58121ce80d3b481eaee2a008c6086aa2f0d/ghc >--------------------------------------------------------------- commit 6133d58121ce80d3b481eaee2a008c6086aa2f0d Author: Richard Eisenberg Date: Wed Feb 10 09:09:26 2016 -0500 Fix #11246. We have to instantiate any invisible arguments to type families right away. This is now done in tcTyCon in TcHsType. testcase: typecheck/should_compile/T11246 (cherry picked from commit 489e6ab5990f0f37624f14d6bf3f0025476513a1) >--------------------------------------------------------------- 6133d58121ce80d3b481eaee2a008c6086aa2f0d compiler/typecheck/TcHsType.hs | 47 ++++++++++++++-------- compiler/typecheck/TcTyClsDecls.hs | 47 +++++++++++++--------- compiler/types/TyCon.hs | 10 +++-- testsuite/tests/typecheck/should_compile/T11246.hs | 5 +++ testsuite/tests/typecheck/should_compile/all.T | 1 + 5 files changed, 72 insertions(+), 38 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 6133d58121ce80d3b481eaee2a008c6086aa2f0d From git at git.haskell.org Thu Feb 18 12:24:06 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Feb 2016 12:24:06 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: users-guide: Fix typos (004dc1c) Message-ID: <20160218122406.ABC7D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/004dc1cb5b1e505ca5f91af3d7b91b70855e3e3c/ghc >--------------------------------------------------------------- commit 004dc1cb5b1e505ca5f91af3d7b91b70855e3e3c Author: Mark Christiaens Date: Wed Feb 17 14:04:42 2016 +0100 users-guide: Fix typos Reviewers: austin, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1927 GHC Trac Issues: #11590 (cherry picked from commit 525b54c469941c636fd45591e5f382cb3b44756c) >--------------------------------------------------------------- 004dc1cb5b1e505ca5f91af3d7b91b70855e3e3c docs/users_guide/packages.rst | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/docs/users_guide/packages.rst b/docs/users_guide/packages.rst index 89eb257..c9e2ea4 100644 --- a/docs/users_guide/packages.rst +++ b/docs/users_guide/packages.rst @@ -231,17 +231,17 @@ The GHC command line options that control packages are: .. ghc-flag:: -trust ?pkg? This option causes the install package ?pkg? to be both exposed and - trusted by GHC. This command functions in the in a very similar way + trusted by GHC. This command functions in a very similar way to the :ghc-flag:`-package` command but in addition sets the selected - packaged to be trusted by GHC, regardless of the contents of the + packages to be trusted by GHC, regardless of the contents of the package database. (see :ref:`safe-haskell`). .. ghc-flag:: -distrust ?pkg? This option causes the install package ?pkg? to be both exposed and - distrusted by GHC. This command functions in the in a very similar + distrusted by GHC. This command functions in a very similar way to the :ghc-flag:`-package` command but in addition sets the selected - packaged to be distrusted by GHC, regardless of the contents of the + packages to be distrusted by GHC, regardless of the contents of the package database. (see :ref:`safe-haskell`). .. ghc-flag:: -distrust-all From git at git.haskell.org Thu Feb 18 12:24:09 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Feb 2016 12:24:09 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Add a testcase for #11362 (77de825) Message-ID: <20160218122409.B9D743A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/77de825300a71be0769f23d70015716672e91ca4/ghc >--------------------------------------------------------------- commit 77de825300a71be0769f23d70015716672e91ca4 Author: Bartosz Nitka Date: Mon Feb 15 09:16:43 2016 -0800 Add a testcase for #11362 This reproduces the issue that I encountered in #11362. Test Plan: this testcase Reviewers: simonpj, bgamari, austin Reviewed By: simonpj Subscribers: thomie, simonmar Differential Revision: https://phabricator.haskell.org/D1917 GHC Trac Issues: #11362 (cherry picked from commit 023742e444a415001d86d50a6ec331fe71d50426) >--------------------------------------------------------------- 77de825300a71be0769f23d70015716672e91ca4 testsuite/tests/polykinds/T11362.hs | 26 ++++++++++++++++++++++++++ testsuite/tests/polykinds/all.T | 2 ++ 2 files changed, 28 insertions(+) diff --git a/testsuite/tests/polykinds/T11362.hs b/testsuite/tests/polykinds/T11362.hs new file mode 100644 index 0000000..945d68f --- /dev/null +++ b/testsuite/tests/polykinds/T11362.hs @@ -0,0 +1,26 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE GADTs #-} + +module T11362 where +-- this file when compiled with -dunique-increment=-1 made GHC crash + +data Sum a b = L a | R b + +data Sum1 (a :: k1 -> *) (b :: k2 -> *) :: Sum k1 k2 -> * where + LL :: a i -> Sum1 a b (L i) + RR :: b i -> Sum1 a b (R i) + +data Code i o = F (Code (Sum i o) o) + +-- An interpretation for `Code` using a data family works: +data family In (f :: Code i o) :: (i -> *) -> (o -> *) + +data instance In (F f) r o where + MkIn :: In f (Sum1 r (In (F f) r)) o -> In (F f) r o + +-- Requires polymorphic recursion +data In' (f :: Code i o) :: (i -> *) -> o -> * where + MkIn' :: In' g (Sum1 r (In' (F g) r)) t -> In' (F g) r t diff --git a/testsuite/tests/polykinds/all.T b/testsuite/tests/polykinds/all.T index a5631a8..4500cfc 100644 --- a/testsuite/tests/polykinds/all.T +++ b/testsuite/tests/polykinds/all.T @@ -138,4 +138,6 @@ test('T11480a', normal, compile, ['']) test('T11523', normal, compile, ['']) test('T11520', normal, compile_fail, ['']) test('T11516', normal, compile_fail, ['']) +test('T11362', normal, compile, ['-dunique-increment=-1']) + # -dunique-increment=-1 doesn't work inside the file test('T11399', normal, compile_fail, ['']) From git at git.haskell.org Thu Feb 18 12:52:31 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Feb 2016 12:52:31 +0000 (UTC) Subject: [commit: ghc] master: (Another) minor refactoring of substitutions (b529255) Message-ID: <20160218125231.E13AC3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b5292557dcf2e3844b4837172230575d40a8917e/ghc >--------------------------------------------------------------- commit b5292557dcf2e3844b4837172230575d40a8917e Author: Simon Peyton Jones Date: Thu Feb 18 11:25:38 2016 +0000 (Another) minor refactoring of substitutions No change in functionality here, but greater clarity: * In FamInstEnv.FlattenEnv, kill off the fi_in_scope field We are already maintaining an in-scope set in the fe_subst field, so it's silly do to it twice. (This isn't strictly connected to the rest of this patch, but the nomenclature changes below affect the same code, so I put them together.) * TyCoRep.extendTCVSubst used to take a TyVar or a CoVar and work out what to do, but in fact we almost always know which of the two we are doing. So: - define extendTvSubst, extendCvSubst - and use them * Similar renamings in TyCoRep: - extendTCvSubstList --> extendTvSubstList - extendTCvSubstBinder --> extendTvSubstBinder - extendTCvSubstAndInScope --> extendTvSubstAndInScope * Add Type.extendTvSubstWithClone, extendCvSubstWithClone * Similar nomenclature changes in Subst, SimplEnv, Specialise * Kill off TyCoRep.substTelescope (never used) >--------------------------------------------------------------- b5292557dcf2e3844b4837172230575d40a8917e compiler/basicTypes/MkId.hs | 4 +- compiler/coreSyn/CoreLint.hs | 2 +- compiler/coreSyn/CoreSubst.hs | 47 +++++++++---------- compiler/coreSyn/CoreUtils.hs | 2 +- compiler/iface/IfaceType.hs | 2 +- compiler/main/GhcPlugins.hs | 2 +- compiler/simplCore/SimplEnv.hs | 20 +++++---- compiler/simplCore/Simplify.hs | 16 +++---- compiler/specialise/Specialise.hs | 12 ++--- compiler/typecheck/Inst.hs | 5 ++- compiler/typecheck/TcClassDcl.hs | 2 +- compiler/typecheck/TcExpr.hs | 2 +- compiler/typecheck/TcHsType.hs | 4 +- compiler/typecheck/TcMType.hs | 47 ++++++++----------- compiler/typecheck/TcSMonad.hs | 2 +- compiler/typecheck/TcTyClsDecls.hs | 4 +- compiler/typecheck/TcType.hs | 5 ++- compiler/types/Coercion.hs | 2 +- compiler/types/FamInstEnv.hs | 29 ++++++------ compiler/types/OptCoercion.hs | 2 +- compiler/types/TyCoRep.hs | 92 +++++++++++++++++++------------------- compiler/types/Type.hs | 7 +-- 22 files changed, 149 insertions(+), 161 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 b5292557dcf2e3844b4837172230575d40a8917e From git at git.haskell.org Thu Feb 18 12:52:35 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Feb 2016 12:52:35 +0000 (UTC) Subject: [commit: ghc] master: Fix desugaring of bang-pattern let-bindings (01449eb) Message-ID: <20160218125235.6A0793A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/01449eb552daa082e46ceaaf8481708ee73dc2ad/ghc >--------------------------------------------------------------- commit 01449eb552daa082e46ceaaf8481708ee73dc2ad Author: Simon Peyton Jones Date: Thu Feb 18 11:05:45 2016 +0000 Fix desugaring of bang-pattern let-bindings When implementing Strict Haskell, the patch 46a03fbe didn't faithfully implement the semantics given in the manual. In particular there was an ad-hoc case in mkSelectorBinds for "strict and no binders" that didn't work. This patch fixes it, curing Trac #11572. Howver it forced me to think about banged let-bindings, and I rather think we do not have quite the right semantics yet, so I've opened Trac #11601. >--------------------------------------------------------------- 01449eb552daa082e46ceaaf8481708ee73dc2ad compiler/deSugar/DsUtils.hs | 49 +- docs/users_guide/glasgow_exts.rst | 3306 +++++++++++----------- testsuite/tests/deSugar/should_run/T11572.hs | 6 + testsuite/tests/deSugar/should_run/T11572.stderr | 4 + testsuite/tests/deSugar/should_run/all.T | 1 + 5 files changed, 1674 insertions(+), 1692 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 01449eb552daa082e46ceaaf8481708ee73dc2ad From git at git.haskell.org Thu Feb 18 12:52:38 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Feb 2016 12:52:38 +0000 (UTC) Subject: [commit: ghc] master: Improve piResultTys and friends (4d031cf) Message-ID: <20160218125238.28D173A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4d031cf91c5eed9b162703daee274bbbe94bdc42/ghc >--------------------------------------------------------------- commit 4d031cf91c5eed9b162703daee274bbbe94bdc42 Author: Simon Peyton Jones Date: Thu Feb 18 11:34:12 2016 +0000 Improve piResultTys and friends Several things here: * Re-implement piResultTys so that its substitution has the correct in-scope set That means paying close attention to performance, since as we discovered in Trac #11371, it's a heavily used function and is often used on ordinary function types, with no foralls to worry about substituting. * Kill off applyTys, which was just the same as piResultTys. * Re-engineer MkCore.mkCoreApps so that it calls piResultTys, rather than repeatedly calling piResultTy. >--------------------------------------------------------------- 4d031cf91c5eed9b162703daee274bbbe94bdc42 compiler/coreSyn/CoreLint.hs | 2 +- compiler/coreSyn/CoreUtils.hs | 6 +- compiler/coreSyn/MkCore.hs | 26 +++---- compiler/iface/BuildTyCl.hs | 2 +- compiler/typecheck/TcClassDcl.hs | 4 +- compiler/typecheck/TcInstDcls.hs | 2 +- compiler/typecheck/TcType.hs | 2 +- compiler/types/Coercion.hs | 9 ++- compiler/types/Type.hs | 149 ++++++++++++++++++++++----------------- 9 files changed, 110 insertions(+), 92 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 4d031cf91c5eed9b162703daee274bbbe94bdc42 From git at git.haskell.org Thu Feb 18 12:52:41 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Feb 2016 12:52:41 +0000 (UTC) Subject: [commit: ghc] master: Take type-function arity into account (a008ead) Message-ID: <20160218125241.4A9BB3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a008eadfaa4816be349b4fefde9b9b9edc1ca359/ghc >--------------------------------------------------------------- commit a008eadfaa4816be349b4fefde9b9b9edc1ca359 Author: Simon Peyton Jones Date: Thu Feb 18 12:52:18 2016 +0000 Take type-function arity into account ...when computing the size of a call on the RHS of a type instance declaration. This came up in Trac #11581. The change is in TcType.tcTyFamInsts which now trims the type arguments in a call. See the comments with that function definition. >--------------------------------------------------------------- a008eadfaa4816be349b4fefde9b9b9edc1ca359 compiler/typecheck/TcType.hs | 14 ++++++++++++-- testsuite/tests/indexed-types/should_compile/T11581.hs | 8 ++++++++ testsuite/tests/indexed-types/should_compile/all.T | 1 + 3 files changed, 21 insertions(+), 2 deletions(-) diff --git a/compiler/typecheck/TcType.hs b/compiler/typecheck/TcType.hs index 8021c75..00b3a0f 100644 --- a/compiler/typecheck/TcType.hs +++ b/compiler/typecheck/TcType.hs @@ -693,13 +693,23 @@ isSigMaybe _ = Nothing -} -- | Finds outermost type-family applications occuring in a type, --- after expanding synonyms. +-- after expanding synonyms. In the list (F, tys) that is returned +-- we guarantee that tys matches F's arity. For example, given +-- type family F a :: * -> * (arity 1) +-- calling tcTyFamInsts on (Maybe (F Int Bool) will return +-- (F, [Int]), not (F, [Int,Bool]) +-- +-- This is important for its use in deciding termination of type +-- instances (see Trac #11581). E.g. +-- type instance G [Int] = ...(F Int )... +-- we don't need to take into account when asking if +-- the calls on the RHS are smaller than the LHS tcTyFamInsts :: Type -> [(TyCon, [Type])] tcTyFamInsts ty | Just exp_ty <- coreView ty = tcTyFamInsts exp_ty tcTyFamInsts (TyVarTy _) = [] tcTyFamInsts (TyConApp tc tys) - | isTypeFamilyTyCon tc = [(tc, tys)] + | isTypeFamilyTyCon tc = [(tc, take (tyConArity tc) tys)] | otherwise = concat (map tcTyFamInsts tys) tcTyFamInsts (LitTy {}) = [] tcTyFamInsts (ForAllTy bndr ty) = tcTyFamInsts (binderType bndr) diff --git a/testsuite/tests/indexed-types/should_compile/T11581.hs b/testsuite/tests/indexed-types/should_compile/T11581.hs new file mode 100644 index 0000000..7815a86 --- /dev/null +++ b/testsuite/tests/indexed-types/should_compile/T11581.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE TypeFamilies #-} + +module T11581 where + +type family F a :: * -> * +type family G a + +type instance G [a] = F a (Int,Bool) diff --git a/testsuite/tests/indexed-types/should_compile/all.T b/testsuite/tests/indexed-types/should_compile/all.T index e97acbf..bee76d2 100644 --- a/testsuite/tests/indexed-types/should_compile/all.T +++ b/testsuite/tests/indexed-types/should_compile/all.T @@ -274,3 +274,4 @@ test('T11408', normal, compile, ['']) test('T11361', normal, compile, ['-dunique-increment=-1']) # -dunique-increment=-1 doesn't work inside the file test('T11361a', normal, compile_fail, ['']) +test('T11581', normal, compile, ['']) From git at git.haskell.org Thu Feb 18 12:57:17 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Feb 2016 12:57:17 +0000 (UTC) Subject: [commit: ghc] wip/transformers-0.5.2: Update transformer submodule to v0.5.2.0 release (5830230) Message-ID: <20160218125717.2B7A83A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/transformers-0.5.2 Link : http://ghc.haskell.org/trac/ghc/changeset/58302309d09f7ef8b774c1946f7a45783e58b3a2/ghc >--------------------------------------------------------------- commit 58302309d09f7ef8b774c1946f7a45783e58b3a2 Author: Herbert Valerio Riedel Date: Wed Feb 17 18:23:08 2016 +0100 Update transformer submodule to v0.5.2.0 release Most notably, this update pulls in documentation improvements and several INLINE pragmas. >--------------------------------------------------------------- 58302309d09f7ef8b774c1946f7a45783e58b3a2 libraries/transformers | 2 +- mk/warnings.mk | 1 + 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/libraries/transformers b/libraries/transformers index a2f7dd0..10348c4 160000 --- a/libraries/transformers +++ b/libraries/transformers @@ -1 +1 @@ -Subproject commit a2f7dd057a0ee0c6cb206609594d7a07d26a1861 +Subproject commit 10348c4bbf60debbfc82463e1035aca1cb7b51bc diff --git a/mk/warnings.mk b/mk/warnings.mk index 10c0935..63388fb 100644 --- a/mk/warnings.mk +++ b/mk/warnings.mk @@ -104,6 +104,7 @@ libraries/dph/dph-lifted-common-install_EXTRA_HC_OPTS += -Wwarn libraries/transformers_dist-boot_EXTRA_HC_OPTS += -fno-warn-unused-matches -fno-warn-unused-imports libraries/transformers_dist-install_EXTRA_HC_OPTS += -Wno-unused-matches -Wno-unused-imports libraries/transformers_dist-install_EXTRA_HC_OPTS += -Wno-redundant-constraints +libraries/transformers_dist-install_EXTRA_HC_OPTS += -Wno-orphans # Turn of trustworthy-safe warning libraries/base_dist-install_EXTRA_HC_OPTS += -Wno-trustworthy-safe From git at git.haskell.org Thu Feb 18 12:57:19 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Feb 2016 12:57:19 +0000 (UTC) Subject: [commit: ghc] wip/transformers-0.5.2's head updated: Update transformer submodule to v0.5.2.0 release (5830230) Message-ID: <20160218125719.6CF843A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/transformers-0.5.2' now includes: 0c420cb Comments only (#11513) 5830230 Update transformer submodule to v0.5.2.0 release From git at git.haskell.org Thu Feb 18 17:08:55 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Feb 2016 17:08:55 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Fix bug where reexports of wired-in packages don't work. (98df0e3) Message-ID: <20160218170855.D5EB63A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/98df0e3ac4f37d3bff65d82d0c3405458e52797b/ghc >--------------------------------------------------------------- commit 98df0e3ac4f37d3bff65d82d0c3405458e52797b Author: Edward Z. Yang Date: Thu Feb 18 13:53:36 2016 +0100 Fix bug where reexports of wired-in packages don't work. Signed-off-by: Edward Z. Yang Test Plan: validate Reviewers: hvr, bgamari, austin Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1926 GHC Trac Issues: #11589 >--------------------------------------------------------------- 98df0e3ac4f37d3bff65d82d0c3405458e52797b compiler/main/Packages.hs | 8 +++++++- testsuite/tests/cabal/cabal09/Main.hs | 2 ++ testsuite/tests/cabal/cabal09/Makefile | 21 +++++++++++++++++++++ testsuite/tests/cabal/{cabal05 => cabal09}/Setup.hs | 0 testsuite/tests/cabal/{cabal03 => cabal09}/all.T | 4 ++-- testsuite/tests/cabal/cabal09/reexport.cabal | 20 ++++++++++++++++++++ 6 files changed, 52 insertions(+), 3 deletions(-) diff --git a/compiler/main/Packages.hs b/compiler/main/Packages.hs index 809c579..18fc01f 100644 --- a/compiler/main/Packages.hs +++ b/compiler/main/Packages.hs @@ -771,8 +771,14 @@ findWiredInPackages dflags pkgs vis_map = do | otherwise = pkg upd_deps pkg = pkg { - depends = map upd_wired_in (depends pkg) + depends = map upd_wired_in (depends pkg), + exposedModules + = map (\(ExposedModule k v) -> + (ExposedModule k (fmap upd_wired_in_mod v))) + (exposedModules pkg) } + upd_wired_in_mod (OriginalModule uid m) + = OriginalModule (upd_wired_in uid) m upd_wired_in key | Just key' <- Map.lookup key wiredInMap = key' | otherwise = key diff --git a/testsuite/tests/cabal/cabal09/Main.hs b/testsuite/tests/cabal/cabal09/Main.hs new file mode 100644 index 0000000..eabafdf --- /dev/null +++ b/testsuite/tests/cabal/cabal09/Main.hs @@ -0,0 +1,2 @@ +import Data.List.NonEmpty +main = return () diff --git a/testsuite/tests/cabal/cabal09/Makefile b/testsuite/tests/cabal/cabal09/Makefile new file mode 100644 index 0000000..e89c2ea --- /dev/null +++ b/testsuite/tests/cabal/cabal09/Makefile @@ -0,0 +1,21 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +SETUP = ./Setup -v0 + +# This test is for package reexports from a wired-in package, +# which had a bug + +cabal09: clean + $(MAKE) clean + '$(TEST_HC)' -v0 --make Setup + $(SETUP) clean + $(SETUP) configure $(CABAL_MINIMAL_BUILD) --with-ghc='$(TEST_HC)' --ghc-options='$(TEST_HC_OPTS)' + $(SETUP) build +ifneq "$(CLEANUP)" "" + $(MAKE) clean +endif + +clean : + $(RM) -r */dist Setup$(exeext) *.o *.hi diff --git a/testsuite/tests/cabal/cabal05/Setup.hs b/testsuite/tests/cabal/cabal09/Setup.hs similarity index 100% copy from testsuite/tests/cabal/cabal05/Setup.hs copy to testsuite/tests/cabal/cabal09/Setup.hs diff --git a/testsuite/tests/cabal/cabal03/all.T b/testsuite/tests/cabal/cabal09/all.T similarity index 61% copy from testsuite/tests/cabal/cabal03/all.T copy to testsuite/tests/cabal/cabal09/all.T index 01d3882..66bdb01 100644 --- a/testsuite/tests/cabal/cabal03/all.T +++ b/testsuite/tests/cabal/cabal09/all.T @@ -3,7 +3,7 @@ if default_testopts.cleanup != '': else: cleanup = '' -test('cabal03', +test('cabal09', ignore_output, run_command, - ['$MAKE -s --no-print-directory cabal03 ' + cleanup]) + ['$MAKE -s --no-print-directory cabal09 ' + cleanup]) diff --git a/testsuite/tests/cabal/cabal09/reexport.cabal b/testsuite/tests/cabal/cabal09/reexport.cabal new file mode 100644 index 0000000..447a3ee --- /dev/null +++ b/testsuite/tests/cabal/cabal09/reexport.cabal @@ -0,0 +1,20 @@ +-- Initial reexport.cabal generated by cabal init. For further +-- documentation, see http://haskell.org/cabal/users-guide/ + +name: reexport +version: 0.1.0.0 +license: BSD3 +author: Edward Z. Yang +maintainer: ezyang at cs.stanford.edu +build-type: Simple +cabal-version: >=1.23 + +library + reexported-modules: Data.List.NonEmpty + build-depends: base >=4.9 && <4.10 + default-language: Haskell2010 + +executable foo + main-is: Main.hs + build-depends: base, reexport + default-language: Haskell2010 From git at git.haskell.org Thu Feb 18 21:40:48 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Feb 2016 21:40:48 +0000 (UTC) Subject: [commit: ghc] master: Unwire Typeable representation types (206a8bf) Message-ID: <20160218214048.E8D913A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/206a8bf4665af216784357f6741ccf5e68dd2495/ghc >--------------------------------------------------------------- commit 206a8bf4665af216784357f6741ccf5e68dd2495 Author: Ben Gamari Date: Thu Feb 18 22:05:02 2016 +0100 Unwire Typeable representation types In order to make this work I needed to shuffle around typechecking a bit such that `TyCon` and friends are available during compilation of GHC.Types. I also did a bit of refactoring of `TcTypeable`. Test Plan: Validate Reviewers: simonpj, austin Subscribers: simonpj, thomie Differential Revision: https://phabricator.haskell.org/D1906 GHC Trac Issues: #11120 >--------------------------------------------------------------- 206a8bf4665af216784357f6741ccf5e68dd2495 compiler/prelude/PrelNames.hs | 22 +++ compiler/prelude/TysWiredIn.hs | 62 +------ compiler/typecheck/TcRnDriver.hs | 20 +-- compiler/typecheck/TcTyDecls.hs | 6 +- compiler/typecheck/TcTypeable.hs | 193 +++++++++++++-------- libraries/ghc-prim/GHC/Types.hs | 2 +- .../tests/deSugar/should_compile/T2431.stderr | 10 +- .../tests/ghci.debugger/scripts/print019.stderr | 2 +- .../tests/roles/should_compile/Roles13.stderr | 60 +++---- .../tests/simplCore/should_compile/T7360.stderr | 104 +++++------ .../tests/simplCore/should_compile/T8274.stdout | 4 +- .../tests/stranal/should_compile/T10694.stdout | 4 +- 12 files changed, 249 insertions(+), 240 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 206a8bf4665af216784357f6741ccf5e68dd2495 From git at git.haskell.org Thu Feb 18 21:41:26 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Feb 2016 21:41:26 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Fix desugaring of bang-pattern let-bindings (d6ea90a) Message-ID: <20160218214126.18DA13A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/d6ea90a213fb32ea0af666dec25697228cc09a26/ghc >--------------------------------------------------------------- commit d6ea90a213fb32ea0af666dec25697228cc09a26 Author: Simon Peyton Jones Date: Thu Feb 18 11:05:45 2016 +0000 Fix desugaring of bang-pattern let-bindings When implementing Strict Haskell, the patch 46a03fbe didn't faithfully implement the semantics given in the manual. In particular there was an ad-hoc case in mkSelectorBinds for "strict and no binders" that didn't work. This patch fixes it, curing Trac #11572. Howver it forced me to think about banged let-bindings, and I rather think we do not have quite the right semantics yet, so I've opened Trac #11601. (cherry picked from commit 01449eb552daa082e46ceaaf8481708ee73dc2ad) >--------------------------------------------------------------- d6ea90a213fb32ea0af666dec25697228cc09a26 compiler/deSugar/DsUtils.hs | 49 +- docs/users_guide/glasgow_exts.rst | 3306 +++++++++++----------- testsuite/tests/deSugar/should_run/T11572.hs | 6 + testsuite/tests/deSugar/should_run/T11572.stderr | 4 + testsuite/tests/deSugar/should_run/all.T | 1 + 5 files changed, 1674 insertions(+), 1692 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 d6ea90a213fb32ea0af666dec25697228cc09a26 From git at git.haskell.org Thu Feb 18 22:11:33 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Feb 2016 22:11:33 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Unwire Typeable representation types (6013321) Message-ID: <20160218221133.DC6BB3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/6013321dd013aeb34f0f1a7f7c1c4cd42683ea6e/ghc >--------------------------------------------------------------- commit 6013321dd013aeb34f0f1a7f7c1c4cd42683ea6e Author: Ben Gamari Date: Thu Feb 18 22:05:02 2016 +0100 Unwire Typeable representation types In order to make this work I needed to shuffle around typechecking a bit such that `TyCon` and friends are available during compilation of GHC.Types. I also did a bit of refactoring of `TcTypeable`. Test Plan: Validate Reviewers: simonpj, austin Subscribers: simonpj, thomie Differential Revision: https://phabricator.haskell.org/D1906 GHC Trac Issues: #11120 (cherry picked from commit 206a8bf4665af216784357f6741ccf5e68dd2495) >--------------------------------------------------------------- 6013321dd013aeb34f0f1a7f7c1c4cd42683ea6e compiler/prelude/PrelNames.hs | 22 +++ compiler/prelude/TysWiredIn.hs | 62 +------ compiler/typecheck/TcRnDriver.hs | 20 +-- compiler/typecheck/TcTyDecls.hs | 6 +- compiler/typecheck/TcTypeable.hs | 193 +++++++++++++-------- libraries/ghc-prim/GHC/Types.hs | 2 +- .../tests/deSugar/should_compile/T2431.stderr | 10 +- .../tests/ghci.debugger/scripts/print019.stderr | 2 +- .../tests/roles/should_compile/Roles13.stderr | 60 +++---- .../tests/simplCore/should_compile/T7360.stderr | 104 +++++------ .../tests/simplCore/should_compile/T8274.stdout | 4 +- .../tests/stranal/should_compile/T10694.stdout | 4 +- 12 files changed, 249 insertions(+), 240 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 6013321dd013aeb34f0f1a7f7c1c4cd42683ea6e From git at git.haskell.org Thu Feb 18 22:11:36 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Feb 2016 22:11:36 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Bump haddock submodule (23baff7) Message-ID: <20160218221136.8F6313A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/23baff798aca5856650508ad0f7727045efe3680/ghc >--------------------------------------------------------------- commit 23baff798aca5856650508ad0f7727045efe3680 Author: Ben Gamari Date: Thu Feb 18 22:49:41 2016 +0100 Bump haddock submodule Fixes GHC #11558 >--------------------------------------------------------------- 23baff798aca5856650508ad0f7727045efe3680 utils/haddock | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/utils/haddock b/utils/haddock index 6a6029f..7dd4e19 160000 --- a/utils/haddock +++ b/utils/haddock @@ -1 +1 @@ -Subproject commit 6a6029f1fc7b2cfeea8e231c8806d293d6644004 +Subproject commit 7dd4e19294ea824800d98af9cd5edd44a7d899b1 From git at git.haskell.org Thu Feb 18 22:15:21 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Feb 2016 22:15:21 +0000 (UTC) Subject: [commit: ghc] master: Bump haddock submodule (0b68cbe) Message-ID: <20160218221521.42F4A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/0b68cbefb60e0ff814beb119bbde9fce6ac99fc7/ghc >--------------------------------------------------------------- commit 0b68cbefb60e0ff814beb119bbde9fce6ac99fc7 Author: Ben Gamari Date: Thu Feb 18 23:16:19 2016 +0100 Bump haddock submodule >--------------------------------------------------------------- 0b68cbefb60e0ff814beb119bbde9fce6ac99fc7 utils/haddock | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/utils/haddock b/utils/haddock index e18d166..23f1420 160000 --- a/utils/haddock +++ b/utils/haddock @@ -1 +1 @@ -Subproject commit e18d166b39cdc8c6672b626b4b840c1c383a9685 +Subproject commit 23f1420c64899fff2fe45a8b797e0d7e8c931c7d From git at git.haskell.org Fri Feb 19 11:56:15 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 19 Feb 2016 11:56:15 +0000 (UTC) Subject: [commit: ghc] master: A few more typos in non-code (8b073f6) Message-ID: <20160219115615.F41123A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8b073f6c5be69e024eb20a2b296c94be54ec82ac/ghc >--------------------------------------------------------------- commit 8b073f6c5be69e024eb20a2b296c94be54ec82ac Author: Gabor Greif Date: Fri Feb 19 12:57:03 2016 +0100 A few more typos in non-code >--------------------------------------------------------------- 8b073f6c5be69e024eb20a2b296c94be54ec82ac compiler/specialise/Specialise.hs | 2 +- libraries/ghc-prim/GHC/Types.hs | 2 +- testsuite/tests/profiling/should_run/T5654b.hs | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/compiler/specialise/Specialise.hs b/compiler/specialise/Specialise.hs index 443998b..a8380d8 100644 --- a/compiler/specialise/Specialise.hs +++ b/compiler/specialise/Specialise.hs @@ -766,7 +766,7 @@ Suppose * Import Lib(foo) into another module M * Call 'foo' at some specialised type in M Then you jolly well expect it to be specialised in M. But what if -'foo' calls another fuction 'Lib.bar'. Then you'd like 'bar' to be +'foo' calls another function 'Lib.bar'. Then you'd like 'bar' to be specialised too. But if 'bar' is not marked INLINEABLE it may well not be specialised. The warning Opt_WarnMissedSpecs warns about this. diff --git a/libraries/ghc-prim/GHC/Types.hs b/libraries/ghc-prim/GHC/Types.hs index a1aea0b..727811b 100644 --- a/libraries/ghc-prim/GHC/Types.hs +++ b/libraries/ghc-prim/GHC/Types.hs @@ -358,7 +358,7 @@ data type T. Things to think about - We do this for every module (except this module GHC.Types), so we can't depend on anything else (eg string unpacking code) -That's why we have these terribly low-level repesentations. The TrName +That's why we have these terribly low-level representations. The TrName type lets us use the TrNameS constructor when allocating static data; but we also need TrNameD for the case where we are deserialising a TyCon or Module (for example when deserialising a TypeRep), in which case we diff --git a/testsuite/tests/profiling/should_run/T5654b.hs b/testsuite/tests/profiling/should_run/T5654b.hs index 2a00abf..a052141 100644 --- a/testsuite/tests/profiling/should_run/T5654b.hs +++ b/testsuite/tests/profiling/should_run/T5654b.hs @@ -1,5 +1,5 @@ -- A variant of T5654 where instead of evaluating directly to a --- funciton, f evaluates to a new PAP. This exposes a slightly +-- function, f evaluates to a new PAP. This exposes a slightly -- different but related bug, where when we create a new PAP by -- applying arguments to an existing PAP, we should take into account -- the stack on the original PAP. From git at git.haskell.org Fri Feb 19 13:09:10 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 19 Feb 2016 13:09:10 +0000 (UTC) Subject: [commit: ghc] master: Delete support for deprecated "-- # ..."-style haddock options (2f733b3) Message-ID: <20160219130910.E225C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2f733b3a4b95a35dfdd43915afec9f0f615edacd/ghc >--------------------------------------------------------------- commit 2f733b3a4b95a35dfdd43915afec9f0f615edacd Author: Thomas Miedema Date: Fri Feb 19 10:27:02 2016 +0100 Delete support for deprecated "-- # ..."-style haddock options A long time ago, you could use `"-- # "` to mean that `--------------------------------------------------------------- 2f733b3a4b95a35dfdd43915afec9f0f615edacd compiler/main/HeaderInfo.hs | 4 ---- compiler/parser/ApiAnnotation.hs | 1 - compiler/parser/Lexer.x | 14 ++------------ 3 files changed, 2 insertions(+), 17 deletions(-) diff --git a/compiler/main/HeaderInfo.hs b/compiler/main/HeaderInfo.hs index 3eef327..600b22c 100644 --- a/compiler/main/HeaderInfo.hs +++ b/compiler/main/HeaderInfo.hs @@ -251,10 +251,6 @@ getOptions' dflags toks = map (L (getLoc open)) ["-haddock-opts", removeSpaces str] ++ parseToks xs parseToks (open:xs) - | ITdocOptionsOld str <- getToken open - = map (L (getLoc open)) ["-haddock-opts", removeSpaces str] - ++ parseToks xs - parseToks (open:xs) | ITlanguage_prag <- getToken open = parseLanguage xs parseToks (comment:xs) -- Skip over comments diff --git a/compiler/parser/ApiAnnotation.hs b/compiler/parser/ApiAnnotation.hs index 73490e4..6d08b00 100644 --- a/compiler/parser/ApiAnnotation.hs +++ b/compiler/parser/ApiAnnotation.hs @@ -292,7 +292,6 @@ data AnnotationComment = | AnnDocCommentNamed String -- ^ something beginning '-- $' | AnnDocSection Int String -- ^ a section heading | AnnDocOptions String -- ^ doc options (prune, ignore-exports, etc) - | AnnDocOptionsOld String -- ^ doc options declared "-- # ..."-style | AnnLineComment String -- ^ comment starting by "--" | AnnBlockComment String -- ^ comment in {- -} deriving (Eq, Ord, Data, Typeable, Show) diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x index 7067fe0..719d886 100644 --- a/compiler/parser/Lexer.x +++ b/compiler/parser/Lexer.x @@ -228,12 +228,12 @@ $tab { warnTab } -- space followed by a Haddock comment symbol (docsym) (in which case we'd -- have a Haddock comment). The rules then munch the rest of the line. -"-- " ~[$docsym \#] .* { lineCommentToken } +"-- " ~$docsym .* { lineCommentToken } "--" [^$symbol \ ] .* { lineCommentToken } -- Next, match Haddock comments if no -haddock flag -"-- " [$docsym \#] .* / { ifExtension (not . haddockEnabled) } { lineCommentToken } +"-- " $docsym .* / { ifExtension (not . haddockEnabled) } { lineCommentToken } -- Now, when we've matched comments that begin with 2 dashes and continue -- with a different character, we need to match comments that begin with three @@ -334,8 +334,6 @@ $tab { warnTab } { "{-#" $whitechar* $pragmachar+ / { known_pragma fileHeaderPrags } { dispatch_pragmas fileHeaderPrags } - - "-- #" { multiline_doc_comment } } <0> { @@ -344,10 +342,6 @@ $tab { warnTab } { nested_comment lexToken } } -<0> { - "-- #" .* { lineCommentToken } -} - <0,option_prags> { "{-#" { warnThen Opt_WarnUnrecognisedPragmas (text "Unrecognised pragma") (nested_comment lexToken) } @@ -732,7 +726,6 @@ data Token | ITdocCommentNamed String -- something beginning '-- $' | ITdocSection Int String -- a section heading | ITdocOptions String -- doc options (prune, ignore-exports, etc) - | ITdocOptionsOld String -- doc options declared "-- # ..."-style | ITlineComment String -- comment starting by "--" | ITblockComment String -- comment in {- -} @@ -1063,7 +1056,6 @@ withLexedDocType lexDocComment = do '^' -> lexDocComment input ITdocCommentPrev False '$' -> lexDocComment input ITdocCommentNamed True '*' -> lexDocSection 1 input - '#' -> lexDocComment input ITdocOptionsOld False _ -> panic "withLexedDocType: Bad doc type" where lexDocSection n input = case alexGetChar' input of @@ -2757,7 +2749,6 @@ commentToAnnotation (L l (ITdocCommentPrev s)) = L l (AnnDocCommentPrev s) commentToAnnotation (L l (ITdocCommentNamed s)) = L l (AnnDocCommentNamed s) commentToAnnotation (L l (ITdocSection n s)) = L l (AnnDocSection n s) commentToAnnotation (L l (ITdocOptions s)) = L l (AnnDocOptions s) -commentToAnnotation (L l (ITdocOptionsOld s)) = L l (AnnDocOptionsOld s) commentToAnnotation (L l (ITlineComment s)) = L l (AnnLineComment s) commentToAnnotation (L l (ITblockComment s)) = L l (AnnBlockComment s) commentToAnnotation _ = panic "commentToAnnotation" @@ -2775,7 +2766,6 @@ isDocComment (ITdocCommentPrev _) = True isDocComment (ITdocCommentNamed _) = True isDocComment (ITdocSection _ _) = True isDocComment (ITdocOptions _) = True -isDocComment (ITdocOptionsOld _) = True isDocComment _ = False {- Note [Warnings in code generated by Alex] From git at git.haskell.org Fri Feb 19 15:54:31 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 19 Feb 2016 15:54:31 +0000 (UTC) Subject: [commit: ghc] master: Modifier letter in middle of identifier is ok (d738e66) Message-ID: <20160219155431.8D0E83A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d738e66450ec09f69211330df05e381bfe996c13/ghc >--------------------------------------------------------------- commit d738e66450ec09f69211330df05e381bfe996c13 Author: Thomas Miedema Date: Fri Feb 19 15:25:40 2016 +0100 Modifier letter in middle of identifier is ok Refactoring only. Cleanup some loose ends from #10196. Initially the idea was to only allow modifier letters at the end of identifiers. Since we later decided to allow modifier letters also in the middle of identifiers (because not doing so would not fix the regression completely), the names `suffix` and `okIdSuffixChar` don't seem appropriate anymore. Remove TODO. Move test from should_fail to should_compile. >--------------------------------------------------------------- d738e66450ec09f69211330df05e381bfe996c13 compiler/basicTypes/Lexeme.hs | 14 +++----------- compiler/parser/Lexer.x | 9 ++++----- testsuite/tests/parser/should_compile/T10196.hs | 5 +++++ testsuite/tests/parser/should_fail/T10196Fail3.hs | 6 ------ testsuite/tests/parser/should_fail/T10196Fail3.stderr | 2 -- testsuite/tests/parser/should_fail/all.T | 1 - 6 files changed, 12 insertions(+), 25 deletions(-) diff --git a/compiler/basicTypes/Lexeme.hs b/compiler/basicTypes/Lexeme.hs index 4b1fe94..9e75376 100644 --- a/compiler/basicTypes/Lexeme.hs +++ b/compiler/basicTypes/Lexeme.hs @@ -28,7 +28,6 @@ module Lexeme ( ) where import FastString -import Util ((<||>)) import Data.Char import qualified Data.Set as Set @@ -183,8 +182,7 @@ okConSymOcc str = all okSymChar str && -- but not worrying about case or clashing with reserved words? okIdOcc :: String -> Bool okIdOcc str - -- TODO. #10196. Only allow modifier letters in the suffix of an identifier. - = let hashes = dropWhile (okIdChar <||> okIdSuffixChar) str in + = let hashes = dropWhile okIdChar str in all (== '#') hashes -- -XMagicHash allows a suffix of hashes -- of course, `all` says "True" to an empty list @@ -194,19 +192,13 @@ okIdChar :: Char -> Bool okIdChar c = case generalCategory c of UppercaseLetter -> True LowercaseLetter -> True - OtherLetter -> True TitlecaseLetter -> True + ModifierLetter -> True -- See #10196 + OtherLetter -> True DecimalNumber -> True OtherNumber -> True _ -> c == '\'' || c == '_' --- | Is this character acceptable in the suffix of an identifier. --- See alexGetByte in Lexer.x -okIdSuffixChar :: Char -> Bool -okIdSuffixChar c = case generalCategory c of - ModifierLetter -> True -- See #10196 - _ -> False - -- | Is this character acceptable in a symbol (after the first char)? -- See alexGetByte in Lexer.x okSymChar :: Char -> Bool diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x index 719d886..5f3bdee 100644 --- a/compiler/parser/Lexer.x +++ b/compiler/parser/Lexer.x @@ -155,9 +155,8 @@ $binit = 0-1 $octit = 0-7 $hexit = [$decdigit A-F a-f] -$suffix = \x07 -- Trick Alex into handling Unicode. See alexGetByte. --- TODO #10196. Only allow modifier letters in the suffix of an identifier. -$idchar = [$small $large $digit $suffix \'] +$modifier = \x07 -- Trick Alex into handling Unicode. See alexGetByte. +$idchar = [$small $large $digit $modifier \'] $pragmachar = [$small $large $digit] @@ -1875,7 +1874,7 @@ alexGetByte (AI loc s) symbol = '\x04' space = '\x05' other_graphic = '\x06' - suffix = '\x07' + modifier = '\x07' adj_c | c <= '\x06' = non_graphic @@ -1892,7 +1891,7 @@ alexGetByte (AI loc s) UppercaseLetter -> upper LowercaseLetter -> lower TitlecaseLetter -> upper - ModifierLetter -> suffix -- see #10196 + ModifierLetter -> modifier -- see #10196 OtherLetter -> lower -- see #1103 NonSpacingMark -> other_graphic SpacingCombiningMark -> other_graphic diff --git a/testsuite/tests/parser/should_compile/T10196.hs b/testsuite/tests/parser/should_compile/T10196.hs index f809118..a29f0c3 100644 --- a/testsuite/tests/parser/should_compile/T10196.hs +++ b/testsuite/tests/parser/should_compile/T10196.hs @@ -11,3 +11,8 @@ f = x? = x? x? = x? in x? + +-- Modifier letters are also allowed in the middle of an identifier. +-- This should not be lexed as 2 separate identifiers. +x?x :: Int +x?x = 1 diff --git a/testsuite/tests/parser/should_fail/T10196Fail3.hs b/testsuite/tests/parser/should_fail/T10196Fail3.hs deleted file mode 100644 index 09b80dd..0000000 --- a/testsuite/tests/parser/should_fail/T10196Fail3.hs +++ /dev/null @@ -1,6 +0,0 @@ -module T10196Fail3 where - --- Modifier letters are not allowed in the middle of an identifier. --- And this should not be lexed as 2 separate identifiers either. -x?x :: Int -x?x = 1 diff --git a/testsuite/tests/parser/should_fail/T10196Fail3.stderr b/testsuite/tests/parser/should_fail/T10196Fail3.stderr deleted file mode 100644 index 6403744..0000000 --- a/testsuite/tests/parser/should_fail/T10196Fail3.stderr +++ /dev/null @@ -1,2 +0,0 @@ - -T10196Fail3.hs:5:2: error: lexical error at character '/7526' diff --git a/testsuite/tests/parser/should_fail/all.T b/testsuite/tests/parser/should_fail/all.T index 21b523a..e6c6f41 100644 --- a/testsuite/tests/parser/should_fail/all.T +++ b/testsuite/tests/parser/should_fail/all.T @@ -91,6 +91,5 @@ test('T8506', normal, compile_fail, ['']) test('T9225', normal, compile_fail, ['']) test('T10196Fail1', normal, compile_fail, ['']) test('T10196Fail2', normal, compile_fail, ['']) -test('T10196Fail3', expect_broken(10196), compile_fail, ['']) test('T10498a', normal, compile_fail, ['']) test('T10498b', normal, compile_fail, ['']) From git at git.haskell.org Fri Feb 19 18:54:03 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 19 Feb 2016 18:54:03 +0000 (UTC) Subject: [commit: ghc] master: Pass -haddock to tests in should_compile_*flag*_nohaddock (c6007fe) Message-ID: <20160219185403.D43243A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c6007fe696e05dd98268a3a814c1c1290573913c/ghc >--------------------------------------------------------------- commit c6007fe696e05dd98268a3a814c1c1290573913c Author: Thomas Miedema Date: Fri Feb 19 17:37:29 2016 +0100 Pass -haddock to tests in should_compile_*flag*_nohaddock should_compile_flag_nohaddock and should_compile_noflag_nohaddock contain the exact same tests. By passing `-haddock` to the tests in should_compile_**flag**_nohaddock, at least they're now testing different things. Add documentation. >--------------------------------------------------------------- c6007fe696e05dd98268a3a814c1c1290573913c .../tests/haddock/should_compile_flag_haddock/all.T | 13 +++++++++++++ .../tests/haddock/should_compile_flag_nohaddock/all.T | 17 +++++++++++++---- .../tests/haddock/should_compile_noflag_haddock/all.T | 13 +++++++++++++ .../haddockSimplUtilsBug.stderr | 0 .../tests/haddock/should_compile_noflag_nohaddock/all.T | 9 +++++++++ 5 files changed, 48 insertions(+), 4 deletions(-) diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/all.T b/testsuite/tests/haddock/should_compile_flag_haddock/all.T index a0d1d7c..344210e 100644 --- a/testsuite/tests/haddock/should_compile_flag_haddock/all.T +++ b/testsuite/tests/haddock/should_compile_flag_haddock/all.T @@ -1,3 +1,12 @@ +# should_compile_flag_haddock. +# +# * flag: we *do* pass the -haddock flag +# +# * haddock: and tests *do* contain haddock annotations +# +# When adding a new test here, think about adding it to the +# should_compile_noflag_haddock directory as well. + test('haddockA001', normal, compile, ['-haddock -ddump-parsed']) test('haddockA002', normal, compile, ['-haddock -ddump-parsed']) test('haddockA003', normal, compile, ['-haddock -ddump-parsed']) @@ -30,6 +39,10 @@ test('haddockA029', normal, compile, ['-haddock -ddump-parsed']) test('haddockA030', normal, compile, ['-haddock -ddump-parsed']) test('haddockA031', normal, compile, ['-haddock -ddump-parsed -XExistentialQuantification']) test('haddockA032', normal, compile, ['-haddock -ddump-parsed']) + +# The tests below this line are not duplicated in +# should_compile_noflag_haddock. + test('haddockA033', normal, compile, ['-haddock -ddump-parsed']) test('haddockA034', normal, compile, ['-haddock -ddump-parsed']) test('T10398', normal, compile, ['-haddock -ddump-parsed']) diff --git a/testsuite/tests/haddock/should_compile_flag_nohaddock/all.T b/testsuite/tests/haddock/should_compile_flag_nohaddock/all.T index 500a7e6..b4c4857 100644 --- a/testsuite/tests/haddock/should_compile_flag_nohaddock/all.T +++ b/testsuite/tests/haddock/should_compile_flag_nohaddock/all.T @@ -1,4 +1,13 @@ -test('haddockB001', normal, compile, ['']) -test('haddockB002', normal, compile, ['']) -test('haddockB003', normal, compile, ['']) -test('haddockB004', normal, compile, ['']) +# should_compile_flag_nohaddock +# +# * flag: we *do* pass the -haddock flag +# +# * nohaddock: but tests do *not* contain haddock annotations +# +# When adding a new test here, think about adding it to the +# should_compile_noflag_nohaddock directory as well. + +test('haddockB001', normal, compile, ['-haddock']) +test('haddockB002', normal, compile, ['-haddock']) +test('haddockB003', normal, compile, ['-haddock']) +test('haddockB004', normal, compile, ['-haddock']) diff --git a/testsuite/tests/haddock/should_compile_noflag_haddock/all.T b/testsuite/tests/haddock/should_compile_noflag_haddock/all.T index 77aed59..c0d62ae 100644 --- a/testsuite/tests/haddock/should_compile_noflag_haddock/all.T +++ b/testsuite/tests/haddock/should_compile_noflag_haddock/all.T @@ -1,3 +1,12 @@ +# should_compile_noflag_haddock +# +# * noflag: we do *not* pass the -haddock flag +# +# * haddock: but tests *do* contain haddock annotations +# +# When adding a new test here, think about adding it to the +# should_compile_flag_haddock directory as well. + test('haddockC001', normal, compile, ['']) test('haddockC002', normal, compile, ['']) test('haddockC003', normal, compile, ['']) @@ -30,4 +39,8 @@ test('haddockC029', normal, compile, ['']) test('haddockC030', normal, compile, ['']) test('haddockC031', normal, compile, ['-XExistentialQuantification']) test('haddockC032', normal, compile, ['']) + +# The tests below this line are not duplicated in +# should_compile_flag_haddock. + test('haddockSimplUtilsBug', normal, compile, ['']) diff --git a/testsuite/tests/haddock/should_compile_noflag_haddock/haddockSimplUtilsBug.stderr b/testsuite/tests/haddock/should_compile_noflag_haddock/haddockSimplUtilsBug.stderr deleted file mode 100644 index e69de29..0000000 diff --git a/testsuite/tests/haddock/should_compile_noflag_nohaddock/all.T b/testsuite/tests/haddock/should_compile_noflag_nohaddock/all.T index 89c205b..1c68255 100644 --- a/testsuite/tests/haddock/should_compile_noflag_nohaddock/all.T +++ b/testsuite/tests/haddock/should_compile_noflag_nohaddock/all.T @@ -1,3 +1,12 @@ +# should_compile_noflag_nohaddock +# +# * noflag: we do *not* pass the -haddock flag +# +# * nohaddock: and tests do *not* contain haddock annotations +# +# When adding a new test here, think about adding it to the +# should_compile_flag_nohaddock directory as well. + test('haddockD001', normal, compile, ['']) test('haddockD002', normal, compile, ['']) test('haddockD003', normal, compile, ['']) From git at git.haskell.org Fri Feb 19 18:57:14 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 19 Feb 2016 18:57:14 +0000 (UTC) Subject: [commit: ghc] master: Docs: no space in `-i⟨dir1⟩:⟨dir2⟩` [skip ci] (a8653c8) Message-ID: <20160219185714.104A83A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a8653c84a6322d10c646b05ea5406a23a4b7ffbb/ghc >--------------------------------------------------------------- commit a8653c84a6322d10c646b05ea5406a23a4b7ffbb Author: Thomas Miedema Date: Fri Feb 19 18:58:03 2016 +0100 Docs: no space in `-i?dir1?:?dir2?` [skip ci] >--------------------------------------------------------------- a8653c84a6322d10c646b05ea5406a23a4b7ffbb utils/mkUserGuidePart/Options/FindingImports.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/utils/mkUserGuidePart/Options/FindingImports.hs b/utils/mkUserGuidePart/Options/FindingImports.hs index 4302055..b976cdb 100644 --- a/utils/mkUserGuidePart/Options/FindingImports.hs +++ b/utils/mkUserGuidePart/Options/FindingImports.hs @@ -4,7 +4,7 @@ import Types findingImportsOptions :: [Flag] findingImportsOptions = - [ flag { flagName = "-i ?dir1?:?dir2?:..." + [ flag { flagName = "-i?dir1?:?dir2?:..." , flagDescription = "add ?dir?, ?dir2?, etc. to import path" , flagType = DynamicSettableFlag } From git at git.haskell.org Sat Feb 20 09:51:38 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 20 Feb 2016 09:51:38 +0000 (UTC) Subject: [commit: ghc] master: Fix a double-free bug in -fexternal-interpreter (2340485) Message-ID: <20160220095138.BFF2D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/234048577efc713a0630c58ebe813dafeaf5deeb/ghc >--------------------------------------------------------------- commit 234048577efc713a0630c58ebe813dafeaf5deeb Author: Simon Marlow Date: Sat Feb 20 07:39:34 2016 +0000 Fix a double-free bug in -fexternal-interpreter Originally I planned to make this reference manually managed, but it looks like at some point I gave it a finalizer on the GHC side, but forgot to remove the manual free here. The result is that ghc-iserv could crash in getStablePtr sometimes when using TH. >--------------------------------------------------------------- 234048577efc713a0630c58ebe813dafeaf5deeb libraries/ghci/GHCi/TH.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/libraries/ghci/GHCi/TH.hs b/libraries/ghci/GHCi/TH.hs index 2c7a501..00601ba 100644 --- a/libraries/ghci/GHCi/TH.hs +++ b/libraries/ghci/GHCi/TH.hs @@ -132,7 +132,6 @@ finishTH pipe rstate = do qstateref <- localRef rstate qstate <- readIORef qstateref _ <- runGHCiQ runModFinalizers qstate { qsPipe = pipe } - freeRemoteRef rstate return () runTH From git at git.haskell.org Sat Feb 20 09:51:41 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 20 Feb 2016 09:51:41 +0000 (UTC) Subject: [commit: ghc] master: Fix a bug in ApplicativeDo (#11612) (3259bf6) Message-ID: <20160220095141.6CBF13A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3259bf658662e7052ae91de2fa27baae8c84b7fa/ghc >--------------------------------------------------------------- commit 3259bf658662e7052ae91de2fa27baae8c84b7fa Author: Simon Marlow Date: Sat Feb 20 07:23:37 2016 +0000 Fix a bug in ApplicativeDo (#11612) In some cases ApplicativeDo would miss some opportunities, due to a wrong calculation of free variables in RnExpr.segments. >--------------------------------------------------------------- 3259bf658662e7052ae91de2fa27baae8c84b7fa compiler/rename/RnExpr.hs | 27 +++++++++++++++++++++------ testsuite/tests/ado/ado001.hs | 12 ++++++++++++ testsuite/tests/ado/ado001.stdout | 1 + 3 files changed, 34 insertions(+), 6 deletions(-) diff --git a/compiler/rename/RnExpr.hs b/compiler/rename/RnExpr.hs index 616f259..9d1200a 100644 --- a/compiler/rename/RnExpr.hs +++ b/compiler/rename/RnExpr.hs @@ -1549,24 +1549,36 @@ segments stmts = map fst $ merge $ reverse $ map reverse $ walk (reverse stmts) _otherwise -> (seg,all_lets) : rest where rest = merge segs - all_lets = all (not . isBindStmt . fst) seg + all_lets = all (isLetStmt . fst) seg + -- walk splits the statement sequence into segments, traversing + -- the sequence from the back to the front, and keeping track of + -- the set of free variables of the current segment. Whenever + -- this set of free variables is empty, we have a complete segment. + walk :: [(ExprLStmt Name, FreeVars)] -> [[(ExprLStmt Name, FreeVars)]] walk [] = [] walk ((stmt,fvs) : stmts) = ((stmt,fvs) : seg) : walk rest - where (seg,rest) = chunter (fvs `intersectNameSet` allvars) stmts + where (seg,rest) = chunter fvs' stmts + (_, fvs') = stmtRefs stmt fvs chunter _ [] = ([], []) chunter vars ((stmt,fvs) : rest) | not (isEmptyNameSet vars) = ((stmt,fvs) : chunk, rest') where (chunk,rest') = chunter vars' rest - evars = fvs `intersectNameSet` allvars - pvars = mkNameSet (collectStmtBinders (unLoc stmt)) + (pvars, evars) = stmtRefs stmt fvs vars' = (vars `minusNameSet` pvars) `unionNameSet` evars chunter _ rest = ([], rest) - isBindStmt (L _ BindStmt{}) = True - isBindStmt _ = False + stmtRefs stmt fvs + | isLetStmt stmt = (pvars, fvs' `minusNameSet` pvars) + | otherwise = (pvars, fvs') + where fvs' = fvs `intersectNameSet` allvars + pvars = mkNameSet (collectStmtBinders (unLoc stmt)) + +isLetStmt :: LStmt a b -> Bool +isLetStmt (L _ LetStmt{}) = True +isLetStmt _ = False -- | Find a "good" place to insert a bind in an indivisible segment. -- This is the only place where we use heuristics. The current @@ -1576,6 +1588,9 @@ splitSegment :: [(ExprLStmt Name, FreeVars)] -> ( [(ExprLStmt Name, FreeVars)] , [(ExprLStmt Name, FreeVars)] ) +splitSegment [one,two] = ([one],[two]) + -- there is no choice when there are only two statements; this just saves + -- some work in a common case. splitSegment stmts | Just (lets,binds,rest) <- slurpIndependentStmts stmts = if not (null lets) diff --git a/testsuite/tests/ado/ado001.hs b/testsuite/tests/ado/ado001.hs index 9f8f8da..e452cdd 100644 --- a/testsuite/tests/ado/ado001.hs +++ b/testsuite/tests/ado/ado001.hs @@ -109,6 +109,17 @@ test10 = do x5 <- e return (const () (x3,x4,x5)) +-- (a | b) +-- This demonstrated a bug in RnExpr.segments (#11612) +test11 :: M () +test11 = do + x1 <- a + let x2 = x1 + x3 <- b + let x4 = c + x5 = x4 + return (const () (x1,x2,x3,x4)) + main = mapM_ run [ test1 , test2 @@ -120,6 +131,7 @@ main = mapM_ run , test8 , test9 , test10 + , test11 ] -- Testing code, prints out the structure of a monad/applicative expression diff --git a/testsuite/tests/ado/ado001.stdout b/testsuite/tests/ado/ado001.stdout index 93e300c..f7c48ca 100644 --- a/testsuite/tests/ado/ado001.stdout +++ b/testsuite/tests/ado/ado001.stdout @@ -8,3 +8,4 @@ a; (b | (c; (d; (e | (f; g))))) a; ((b | c) | d) ((a | (b; c)) | d) | e ((a | b); (c | d)) | e +a | b From git at git.haskell.org Sat Feb 20 09:51:44 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 20 Feb 2016 09:51:44 +0000 (UTC) Subject: [commit: ghc] master: Use a better test for profiling (80d35be) Message-ID: <20160220095144.1B7693A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/80d35be1263b57d9f48bf01372388310ecc3266f/ghc >--------------------------------------------------------------- commit 80d35be1263b57d9f48bf01372388310ecc3266f Author: Simon Marlow Date: Sat Feb 20 08:25:50 2016 +0000 Use a better test for profiling The previous test failed for me because I had GhcRTSWays += thr_debug_p in my validate.mk, which doesn't enable profiling by itself. >--------------------------------------------------------------- 80d35be1263b57d9f48bf01372388310ecc3266f testsuite/tests/plugins/annotation-plugin/Makefile | 2 +- testsuite/tests/plugins/rule-defining-plugin/Makefile | 2 +- testsuite/tests/plugins/simple-plugin/Makefile | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/testsuite/tests/plugins/annotation-plugin/Makefile b/testsuite/tests/plugins/annotation-plugin/Makefile index ad54f75..b6aa220 100644 --- a/testsuite/tests/plugins/annotation-plugin/Makefile +++ b/testsuite/tests/plugins/annotation-plugin/Makefile @@ -13,6 +13,6 @@ package.%: mkdir pkg.$* "$(TEST_HC)" -outputdir pkg.$* --make -v0 -o pkg.$*/setup Setup.hs "$(GHC_PKG)" init pkg.$*/local.package.conf - pkg.$*/setup configure --distdir pkg.$*/dist -v0 $(CABAL_PLUGIN_BUILD) --prefix="$(HERE)/pkg.$*/install" --with-compiler="$(TEST_HC)" $(if $(findstring _p,$(GhcRTSWays)), --enable-library-profiling) --with-hc-pkg="$(GHC_PKG)" --package-db=pkg.$*/local.package.conf + pkg.$*/setup configure --distdir pkg.$*/dist -v0 $(CABAL_PLUGIN_BUILD) --prefix="$(HERE)/pkg.$*/install" --with-compiler="$(TEST_HC)" $(if $(findstring YES,$(HAVE_PROFILING)), --enable-library-profiling) --with-hc-pkg="$(GHC_PKG)" --package-db=pkg.$*/local.package.conf pkg.$*/setup build --distdir pkg.$*/dist -v0 pkg.$*/setup install --distdir pkg.$*/dist -v0 diff --git a/testsuite/tests/plugins/rule-defining-plugin/Makefile b/testsuite/tests/plugins/rule-defining-plugin/Makefile index a78ba1d..1942280 100644 --- a/testsuite/tests/plugins/rule-defining-plugin/Makefile +++ b/testsuite/tests/plugins/rule-defining-plugin/Makefile @@ -13,6 +13,6 @@ package.%: mkdir pkg.$* "$(TEST_HC)" -outputdir pkg.$* --make -v0 -o pkg.$*/setup Setup.hs "$(GHC_PKG)" init pkg.$*/local.package.conf - pkg.$*/setup configure --distdir pkg.$*/dist -v0 $(CABAL_PLUGIN_BUILD) --prefix="$(HERE)/pkg.$*/install" --with-compiler="$(TEST_HC)" --with-hc-pkg="$(GHC_PKG)" --package-db=pkg.$*/local.package.conf $(if $(findstring _p,$(GhcRTSWays)), --enable-library-profiling) + pkg.$*/setup configure --distdir pkg.$*/dist -v0 $(CABAL_PLUGIN_BUILD) --prefix="$(HERE)/pkg.$*/install" --with-compiler="$(TEST_HC)" --with-hc-pkg="$(GHC_PKG)" --package-db=pkg.$*/local.package.conf $(if $(findstring YES,$(HAVE_PROFILING)), --enable-library-profiling) pkg.$*/setup build --distdir pkg.$*/dist -v0 pkg.$*/setup install --distdir pkg.$*/dist -v0 diff --git a/testsuite/tests/plugins/simple-plugin/Makefile b/testsuite/tests/plugins/simple-plugin/Makefile index ed51533..6d9829f 100644 --- a/testsuite/tests/plugins/simple-plugin/Makefile +++ b/testsuite/tests/plugins/simple-plugin/Makefile @@ -15,6 +15,6 @@ package.%: "$(GHC_PKG)" init pkg.$*/local.package.conf - pkg.$*/setup configure --distdir pkg.$*/dist -v0 $(CABAL_PLUGIN_BUILD) --prefix="$(HERE)/pkg.$*/install" --with-compiler="$(TEST_HC)" --with-hc-pkg="$(GHC_PKG)" --package-db=pkg.$*/local.package.conf $(if $(findstring _p,$(GhcRTSWays)), --enable-library-profiling) + pkg.$*/setup configure --distdir pkg.$*/dist -v0 $(CABAL_PLUGIN_BUILD) --prefix="$(HERE)/pkg.$*/install" --with-compiler="$(TEST_HC)" --with-hc-pkg="$(GHC_PKG)" --package-db=pkg.$*/local.package.conf $(if $(findstring YES,$(HAVE_PROFILING)), --enable-library-profiling) pkg.$*/setup build --distdir pkg.$*/dist -v0 pkg.$*/setup install --distdir pkg.$*/dist -v0 From git at git.haskell.org Sat Feb 20 09:51:46 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 20 Feb 2016 09:51:46 +0000 (UTC) Subject: [commit: ghc] master: Refactoring only: use ExprLStmt (6cec905) Message-ID: <20160220095146.C1EF63A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6cec90584deca4b09538e89804648435b284cff0/ghc >--------------------------------------------------------------- commit 6cec90584deca4b09538e89804648435b284cff0 Author: Simon Marlow Date: Sat Feb 20 06:59:10 2016 +0000 Refactoring only: use ExprLStmt >--------------------------------------------------------------- 6cec90584deca4b09538e89804648435b284cff0 compiler/rename/RnExpr.hs | 38 +++++++++++++++++++------------------- 1 file changed, 19 insertions(+), 19 deletions(-) diff --git a/compiler/rename/RnExpr.hs b/compiler/rename/RnExpr.hs index 69b8d6e..616f259 100644 --- a/compiler/rename/RnExpr.hs +++ b/compiler/rename/RnExpr.hs @@ -678,8 +678,8 @@ rnStmtsWithPostProcessing ctxt rnBody ppStmts stmts thing_inside -- | maybe rearrange statements according to the ApplicativeDo transformation postProcessStmtsForApplicativeDo :: HsStmtContext Name - -> [(LStmt Name (LHsExpr Name), FreeVars)] - -> RnM ([LStmt Name (LHsExpr Name)], FreeVars) + -> [(ExprLStmt Name, FreeVars)] + -> RnM ([ExprLStmt Name], FreeVars) postProcessStmtsForApplicativeDo ctxt stmts = do { -- rearrange the statements using ApplicativeStmt if @@ -1430,8 +1430,8 @@ dsDo {(arg_1 | ... | arg_n); stmts} expr = -- Note [ApplicativeDo]. rearrangeForApplicativeDo :: HsStmtContext Name - -> [(LStmt Name (LHsExpr Name), FreeVars)] - -> RnM ([LStmt Name (LHsExpr Name)], FreeVars) + -> [(ExprLStmt Name, FreeVars)] + -> RnM ([ExprLStmt Name], FreeVars) rearrangeForApplicativeDo _ [] = return ([], emptyNameSet) rearrangeForApplicativeDo ctxt stmts0 = do @@ -1445,10 +1445,10 @@ rearrangeForApplicativeDo ctxt stmts0 = do -- | The ApplicativeDo transformation. ado :: HsStmtContext Name - -> [(LStmt Name (LHsExpr Name), FreeVars)] -- ^ input statements - -> [LStmt Name (LHsExpr Name)] -- ^ the "tail" + -> [(ExprLStmt Name, FreeVars)] -- ^ input statements + -> [ExprLStmt Name] -- ^ the "tail" -> FreeVars -- ^ free variables of the tail - -> RnM ( [LStmt Name (LHsExpr Name)] -- ( output statements, + -> RnM ( [ExprLStmt Name] -- ( output statements, , FreeVars ) -- , things we needed -- e.g. <$>, <*>, join ) @@ -1491,10 +1491,10 @@ ado ctxt stmts tail tail_fvs = -- two halves. adoSegment :: HsStmtContext Name - -> [(LStmt Name (LHsExpr Name), FreeVars)] - -> [LStmt Name (LHsExpr Name)] + -> [(ExprLStmt Name, FreeVars)] + -> [ExprLStmt Name] -> FreeVars - -> RnM ( [LStmt Name (LHsExpr Name)], FreeVars ) + -> RnM ( [ExprLStmt Name], FreeVars ) adoSegment ctxt stmts tail tail_fvs = do { -- choose somewhere to put a bind let (before,after) = splitSegment stmts @@ -1509,7 +1509,7 @@ adoSegment ctxt stmts tail tail_fvs adoSegmentArg :: HsStmtContext Name -> FreeVars - -> [(LStmt Name (LHsExpr Name), FreeVars)] + -> [(ExprLStmt Name, FreeVars)] -> RnM (ApplicativeArg Name Name, FreeVars) adoSegmentArg _ _ [(L _ (BindStmt pat exp _ _ _),_)] = return (ApplicativeArgOne pat exp, emptyFVs) @@ -1532,8 +1532,8 @@ adoSegmentArg ctxt tail_fvs stmts = -- | Divide a sequence of statements into segments, where no segment -- depends on any variables defined by a statement in another segment. segments - :: [(LStmt Name (LHsExpr Name), FreeVars)] - -> [[(LStmt Name (LHsExpr Name), FreeVars)]] + :: [(ExprLStmt Name, FreeVars)] + -> [[(ExprLStmt Name, FreeVars)]] segments stmts = map fst $ merge $ reverse $ map reverse $ walk (reverse stmts) where allvars = mkNameSet (concatMap (collectStmtBinders.unLoc.fst) stmts) @@ -1573,9 +1573,9 @@ segments stmts = map fst $ merge $ reverse $ map reverse $ walk (reverse stmts) -- heuristic is to peel off the first group of independent statements -- and put the bind after those. splitSegment - :: [(LStmt Name (LHsExpr Name), FreeVars)] - -> ( [(LStmt Name (LHsExpr Name), FreeVars)] - , [(LStmt Name (LHsExpr Name), FreeVars)] ) + :: [(ExprLStmt Name, FreeVars)] + -> ( [(ExprLStmt Name, FreeVars)] + , [(ExprLStmt Name, FreeVars)] ) splitSegment stmts | Just (lets,binds,rest) <- slurpIndependentStmts stmts = if not (null lets) @@ -1629,8 +1629,8 @@ mkApplicativeStmt :: HsStmtContext Name -> [ApplicativeArg Name Name] -- ^ The args -> Bool -- ^ True <=> need a join - -> [LStmt Name (LHsExpr Name)] -- ^ The body statements - -> RnM ([LStmt Name (LHsExpr Name)], FreeVars) + -> [ExprLStmt Name] -- ^ The body statements + -> RnM ([ExprLStmt Name], FreeVars) mkApplicativeStmt ctxt args need_join body_stmts = do { (fmap_op, fvs1) <- lookupStmtName ctxt fmapName ; (ap_op, fvs2) <- lookupStmtName ctxt apAName @@ -1649,7 +1649,7 @@ mkApplicativeStmt ctxt args need_join body_stmts -- | Given the statements following an ApplicativeStmt, determine whether -- we need a @join@ or not, and remove the @return@ if necessary. -needJoin :: [LStmt Name (LHsExpr Name)] -> (Bool, [LStmt Name (LHsExpr Name)]) +needJoin :: [ExprLStmt Name] -> (Bool, [ExprLStmt Name]) needJoin [] = (False, []) -- we're in an ApplicativeArg needJoin [L loc (LastStmt e _ t)] | Just arg <- isReturnApp e = (False, [L loc (LastStmt arg True t)]) From git at git.haskell.org Sat Feb 20 14:05:16 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 20 Feb 2016 14:05:16 +0000 (UTC) Subject: [commit: ghc] master: Add test (only) to assure that #11535 is fixed (1ef7add) Message-ID: <20160220140516.F41493A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1ef7add01ead4cbe065297f68306d9bc4b456156/ghc >--------------------------------------------------------------- commit 1ef7add01ead4cbe065297f68306d9bc4b456156 Author: Takayuki Muranushi Date: Sat Feb 20 13:28:32 2016 +0100 Add test (only) to assure that #11535 is fixed Ticket #11535 dealt with derived Read instances of infix Unicode value constructors. GHC 7.10.3 used to derive (Read/Show) instances so that `read . show` for values of such types had no parse. The issue has been fixed by other compiler update. This patch adds only tests, so that derived instance of Read/Show for infix Unicode value constructors has correct parse, satisfying Haskell 2010 Specification. Resolves: #11535 Test Plan: `make test TEST=T11535` Reviewers: austin, rwbarton, thomie, bgamari Reviewed By: rwbarton, thomie, bgamari Subscribers: rwbarton, thomie Projects: #ghc Differential Revision: https://phabricator.haskell.org/D1884 GHC Trac Issues: #11535 >--------------------------------------------------------------- 1ef7add01ead4cbe065297f68306d9bc4b456156 testsuite/tests/deriving/should_run/T11535.hs | 28 ++++++++++++++++++++++ .../tests/deriving/should_run/T11535.stdout | 0 testsuite/tests/deriving/should_run/all.T | 1 + 3 files changed, 29 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 1ef7add01ead4cbe065297f68306d9bc4b456156 From git at git.haskell.org Sat Feb 20 15:31:57 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 20 Feb 2016 15:31:57 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Fix a double-free bug in -fexternal-interpreter (892de05) Message-ID: <20160220153157.0E54E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/892de051aaaf9a346dadc74592a9cc375b3223a4/ghc >--------------------------------------------------------------- commit 892de051aaaf9a346dadc74592a9cc375b3223a4 Author: Simon Marlow Date: Sat Feb 20 07:39:34 2016 +0000 Fix a double-free bug in -fexternal-interpreter Originally I planned to make this reference manually managed, but it looks like at some point I gave it a finalizer on the GHC side, but forgot to remove the manual free here. The result is that ghc-iserv could crash in getStablePtr sometimes when using TH. (cherry picked from commit 234048577efc713a0630c58ebe813dafeaf5deeb) >--------------------------------------------------------------- 892de051aaaf9a346dadc74592a9cc375b3223a4 libraries/ghci/GHCi/TH.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/libraries/ghci/GHCi/TH.hs b/libraries/ghci/GHCi/TH.hs index 26a6d9f..34d6fad6 100644 --- a/libraries/ghci/GHCi/TH.hs +++ b/libraries/ghci/GHCi/TH.hs @@ -133,7 +133,6 @@ finishTH pipe rstate = do qstateref <- localRef rstate qstate <- readIORef qstateref _ <- runGHCiQ runModFinalizers qstate { qsPipe = pipe } - freeRemoteRef rstate return () runTH From git at git.haskell.org Sat Feb 20 20:08:57 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 20 Feb 2016 20:08:57 +0000 (UTC) Subject: [commit: ghc] master: unexport MAKEFLAGS when running tests (#11569) (9634e24) Message-ID: <20160220200857.342693A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9634e24519981c32b9c2a6570898b87aa9111405/ghc >--------------------------------------------------------------- commit 9634e24519981c32b9c2a6570898b87aa9111405 Author: Thomas Miedema Date: Sat Feb 20 21:09:12 2016 +0100 unexport MAKEFLAGS when running tests (#11569) >--------------------------------------------------------------- 9634e24519981c32b9c2a6570898b87aa9111405 testsuite/mk/boilerplate.mk | 2 ++ 1 file changed, 2 insertions(+) diff --git a/testsuite/mk/boilerplate.mk b/testsuite/mk/boilerplate.mk index 5f4a3e9..4bae8a1 100644 --- a/testsuite/mk/boilerplate.mk +++ b/testsuite/mk/boilerplate.mk @@ -1,3 +1,5 @@ +unexport MAKEFLAGS # See Trac #11569 + # Eliminate use of the built-in implicit rules, and clear out the default list # of suffixes for suffix rules. Speeds up make quite a bit. Both are needed # for the shortest `make -d` output. From git at git.haskell.org Sat Feb 20 22:20:32 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 20 Feb 2016 22:20:32 +0000 (UTC) Subject: [commit: ghc] master: Add test for #6132: hash bang + CPP (0b00add) Message-ID: <20160220222032.9F4B73A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/0b00add03043804211f567a3d0810114c0274252/ghc >--------------------------------------------------------------- commit 0b00add03043804211f567a3d0810114c0274252 Author: Thomas Miedema Date: Sat Feb 20 23:07:50 2016 +0100 Add test for #6132: hash bang + CPP >--------------------------------------------------------------- 0b00add03043804211f567a3d0810114c0274252 testsuite/tests/runghc/T6132.hs | 15 +++++++++++++++ testsuite/tests/runghc/all.T | 2 ++ 2 files changed, 17 insertions(+) diff --git a/testsuite/tests/runghc/T6132.hs b/testsuite/tests/runghc/T6132.hs new file mode 100644 index 0000000..dbb996b --- /dev/null +++ b/testsuite/tests/runghc/T6132.hs @@ -0,0 +1,15 @@ +#!/usr/bin/env whatever + +{-# LANGUAGE CPP #-} + +module Main where + +-- Compiling a program with CPP that also has a hash bang should work (#6132). +-- Before ghc-7.8, it failed with: +-- +-- error: invalid preprocessing directive #! +-- #!/usr/bin/env runghc + +#if 1 +main = return () +#endif diff --git a/testsuite/tests/runghc/all.T b/testsuite/tests/runghc/all.T index 0403fbc..7c4fad2 100644 --- a/testsuite/tests/runghc/all.T +++ b/testsuite/tests/runghc/all.T @@ -6,3 +6,5 @@ test('T8601', req_interp, run_command, test('T11247', [req_interp, expect_broken(11247)], run_command, ['$MAKE --no-print-directory -s T11247']) + +test('T6132', [], compile, ['']) From git at git.haskell.org Sun Feb 21 01:56:35 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 21 Feb 2016 01:56:35 +0000 (UTC) Subject: [commit: ghc] master: Testsuite: pass '-s --no-print-directory' to MAKE (6e691ca) Message-ID: <20160221015635.BD50A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6e691cacd6484b02df72f3e46a1d2ed0779a3107/ghc >--------------------------------------------------------------- commit 6e691cacd6484b02df72f3e46a1d2ed0779a3107 Author: Thomas Miedema Date: Sun Feb 21 01:50:22 2016 +0100 Testsuite: pass '-s --no-print-directory' to MAKE This seems necessary after 9634e24 (#11569). >--------------------------------------------------------------- 6e691cacd6484b02df72f3e46a1d2ed0779a3107 testsuite/tests/annotations/should_compile/th/Makefile | 4 ++-- testsuite/tests/cabal/cabal01/Makefile | 4 ++-- testsuite/tests/cabal/cabal03/Makefile | 4 ++-- testsuite/tests/cabal/cabal04/Makefile | 4 ++-- testsuite/tests/cabal/cabal05/Makefile | 4 ++-- testsuite/tests/cabal/cabal06/Makefile | 4 ++-- testsuite/tests/cabal/cabal08/Makefile | 4 ++-- testsuite/tests/cabal/sigcabal01/Makefile | 4 ++-- testsuite/tests/driver/T1372/Makefile | 10 +++++----- testsuite/tests/driver/T1959/Makefile | 6 +++--- testsuite/tests/driver/T3007/Makefile | 2 +- testsuite/tests/driver/dynamicToo/dynamicToo004/Makefile | 2 +- testsuite/tests/driver/recomp007/Makefile | 8 ++++---- testsuite/tests/driver/recomp008/Makefile | 6 +++--- testsuite/tests/module/mod175/Makefile | 2 +- testsuite/tests/plugins/annotation-plugin/Makefile | 2 +- testsuite/tests/plugins/rule-defining-plugin/Makefile | 2 +- testsuite/tests/plugins/simple-plugin/Makefile | 2 +- testsuite/tests/rts/Makefile | 4 ++-- testsuite/tests/safeHaskell/check/pkg01/Makefile | 4 ++-- testsuite/tests/safeHaskell/safeLanguage/Makefile | 4 ++-- testsuite/tests/simplCore/should_compile/T7702plugin/Makefile | 2 +- testsuite/tests/typecheck/bug1465/Makefile | 10 +++++----- 23 files changed, 49 insertions(+), 49 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 6e691cacd6484b02df72f3e46a1d2ed0779a3107 From git at git.haskell.org Sun Feb 21 17:35:27 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 21 Feb 2016 17:35:27 +0000 (UTC) Subject: [commit: ghc] master: Build system: fix sed expression (#11537) (f451039) Message-ID: <20160221173527.A30513A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f45103908348fb92ef9a16ab97ced87239a66783/ghc >--------------------------------------------------------------- commit f45103908348fb92ef9a16ab97ced87239a66783 Author: Thomas Miedema Date: Sun Feb 21 12:23:25 2016 +0100 Build system: fix sed expression (#11537) This allows building ghc in '/ghc'. >--------------------------------------------------------------- f45103908348fb92ef9a16ab97ced87239a66783 rules/build-dependencies.mk | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/rules/build-dependencies.mk b/rules/build-dependencies.mk index cdc1edf..8152691 100644 --- a/rules/build-dependencies.mk +++ b/rules/build-dependencies.mk @@ -145,7 +145,7 @@ endef define addCFileDeps $(CPP) $($1_$2_MKDEPENDC_OPTS) $($1_$2_$(firstword $($1_$2_WAYS))_ALL_CC_OPTS) $($(basename $4)_CC_OPTS) -MM -x c $4 -MF $3.bit - $(foreach w,$5,sed -e 's|\\|/|g' -e 's| /$$| \\|' -e "1s|\.o|\.$($w_osuf)|" -e "1s|^|$(dir $4)|" -e "1s|$1/|$1/$2/build/|" -e "1s|$2/build/$2/build|$2/build|g" -e "s|$(TOP)/||g$(CASE_INSENSITIVE_SED)" $3.bit >> $3.tmp &&) true + $(foreach w,$5,sed -e 's|\\|/|g' -e 's| /$$| \\|' -e "1s|\.o|\.$($w_osuf)|" -e "1s|^|$(dir $4)|" -e "1s|$1/|$1/$2/build/|" -e "1s|$2/build/$2/build|$2/build|g" -e "s|^$(TOP)/||g$(CASE_INSENSITIVE_SED)" $3.bit >> $3.tmp &&) true endef ifeq "$(Windows_Host)" "YES" From git at git.haskell.org Sun Feb 21 17:35:30 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 21 Feb 2016 17:35:30 +0000 (UTC) Subject: [commit: ghc] master: Fix GHC.Stats documentation markup (#11619) (bb9cd45) Message-ID: <20160221173530.559B93A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/bb9cd45498b36be1624fbdccb4999bb45a776b4f/ghc >--------------------------------------------------------------- commit bb9cd45498b36be1624fbdccb4999bb45a776b4f Author: Thomas Miedema Date: Sun Feb 21 18:31:00 2016 +0100 Fix GHC.Stats documentation markup (#11619) >--------------------------------------------------------------- bb9cd45498b36be1624fbdccb4999bb45a776b4f libraries/base/GHC/Stats.hsc | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/libraries/base/GHC/Stats.hsc b/libraries/base/GHC/Stats.hsc index 7bcc221..0e501da 100644 --- a/libraries/base/GHC/Stats.hsc +++ b/libraries/base/GHC/Stats.hsc @@ -47,6 +47,7 @@ data GCStats = GCStats , numGcs :: !Int64 -- ^ Number of garbage collections performed , maxBytesUsed :: !Int64 -- ^ Maximum number of live bytes seen so far , numByteUsageSamples :: !Int64 -- ^ Number of byte usage samples taken + -- | Sum of all byte usage samples, can be used with -- 'numByteUsageSamples' to calculate averages with -- arbitrary weighting (if you are sampling this record multiple @@ -57,9 +58,11 @@ data GCStats = GCStats , currentBytesSlop :: !Int64 -- ^ Current number of bytes lost to slop , maxBytesSlop :: !Int64 -- ^ Maximum number of bytes lost to slop at any one time so far , peakMegabytesAllocated :: !Int64 -- ^ Maximum number of megabytes allocated + -- | CPU time spent running mutator threads. This does not include -- any profiling overhead or initialization. , mutatorCpuSeconds :: !Double + -- | Wall clock time spent running mutator threads. This does not -- include initialization. , mutatorWallSeconds :: !Double @@ -67,11 +70,13 @@ data GCStats = GCStats , gcWallSeconds :: !Double -- ^ Wall clock time spent running GC , cpuSeconds :: !Double -- ^ Total CPU time elapsed since program start , wallSeconds :: !Double -- ^ Total wall clock time elapsed since start + -- | Number of bytes copied during GC, minus space held by mutable -- lists held by the capabilities. Can be used with -- 'parMaxBytesCopied' to determine how well parallel GC utilized -- all cores. , parTotBytesCopied :: !Int64 + -- | Sum of number of bytes copied each GC by the most active GC -- thread each GC. The ratio of 'parTotBytesCopied' divided by -- 'parMaxBytesCopied' approaches 1 for a maximally sequential From git at git.haskell.org Mon Feb 22 10:45:09 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 22 Feb 2016 10:45:09 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Revert "Remove extraneous fundeps on (~)" (881b6cc) Message-ID: <20160222104509.821993A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/881b6ccf5c1dbc09d1d16b1b4643e3dec9387047/ghc >--------------------------------------------------------------- commit 881b6ccf5c1dbc09d1d16b1b4643e3dec9387047 Author: Herbert Valerio Riedel Date: Mon Feb 22 00:36:41 2016 +0100 Revert "Remove extraneous fundeps on (~)" This is causing compile-time regressions, see #11608 for more details. This reverts commit e1631b3b58b7440d3d5a8bf72f1490df635792fb. >--------------------------------------------------------------- 881b6ccf5c1dbc09d1d16b1b4643e3dec9387047 libraries/base/Data/Type/Equality.hs | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/libraries/base/Data/Type/Equality.hs b/libraries/base/Data/Type/Equality.hs index e7363d2..75d2a6c 100644 --- a/libraries/base/Data/Type/Equality.hs +++ b/libraries/base/Data/Type/Equality.hs @@ -54,7 +54,7 @@ import Data.Type.Bool -- | Lifted, homogeneous equality. By lifted, we mean that it can be -- bogus (deferred type error). By homogeneous, the two types @a@ -- and @b@ must have the same kind. -class a ~~ b => (a :: k) ~ (b :: k) +class a ~~ b => (a :: k) ~ (b :: k) | a -> b, b -> a -- See Note [The equality types story] in TysPrim -- NB: All this class does is to wrap its superclass, which is -- the "real", inhomogeneous equality; this is needed when @@ -62,10 +62,6 @@ class a ~~ b => (a :: k) ~ (b :: k) -- NB: Not exported, as (~) is magical syntax. That's also why there's -- no fixity. - -- It's tempting to put functional dependencies on (~), but it's not - -- necessary because the functional-depedency coverage check looks - -- through superclasses, and (~#) is handled in that check. - instance {-# INCOHERENT #-} a ~~ b => a ~ b -- See Note [The equality types story] in TysPrim -- If we have a Wanted (t1 ~ t2), we want to immediately From git at git.haskell.org Mon Feb 22 13:32:17 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 22 Feb 2016 13:32:17 +0000 (UTC) Subject: [commit: ghc] master: Docs: -keep-llvm-file(s)/-ddump-llvm imply -fllvm (ed11909) Message-ID: <20160222133217.603933A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ed119096be6739b67d99acfa4c2d43627960f0e3/ghc >--------------------------------------------------------------- commit ed119096be6739b67d99acfa4c2d43627960f0e3 Author: Thomas Miedema Date: Mon Feb 22 14:31:40 2016 +0100 Docs: -keep-llvm-file(s)/-ddump-llvm imply -fllvm This fixes #9917. >--------------------------------------------------------------- ed119096be6739b67d99acfa4c2d43627960f0e3 docs/users_guide/debugging.rst | 2 ++ docs/users_guide/separate_compilation.rst | 5 +++++ utils/mkUserGuidePart/Options/CompilerDebugging.hs | 3 ++- utils/mkUserGuidePart/Options/KeepingIntermediates.hs | 9 +++++---- 4 files changed, 14 insertions(+), 5 deletions(-) diff --git a/docs/users_guide/debugging.rst b/docs/users_guide/debugging.rst index a7bbbb5..a4e2d23 100644 --- a/docs/users_guide/debugging.rst +++ b/docs/users_guide/debugging.rst @@ -144,6 +144,8 @@ Dumping out compiler intermediate structures .. ghc-flag:: -ddump-llvm + :implies: :ghc-flag:`-fllvm` + LLVM code from the :ref:`LLVM code generator ` .. ghc-flag:: -ddump-bcos diff --git a/docs/users_guide/separate_compilation.rst b/docs/users_guide/separate_compilation.rst index afdde83..a2ce5eb 100644 --- a/docs/users_guide/separate_compilation.rst +++ b/docs/users_guide/separate_compilation.rst @@ -334,12 +334,16 @@ The following options are useful for keeping certain intermediate files around, when normally GHC would throw these away after compilation: .. ghc-flag:: -keep-hc-file + -keep-hc-files Keep intermediate ``.hc`` files when doing ``.hs``-to-``.o`` compilations via :ref:`C ` (Note: ``.hc`` files are only generated by :ref:`unregisterised ` compilers). .. ghc-flag:: -keep-llvm-file + -keep-llvm-files + + :implies: :ghc-flag:`-fllvm` Keep intermediate ``.ll`` files when doing ``.hs``-to-``.o`` compilations via :ref:`LLVM ` (Note: ``.ll`` files @@ -347,6 +351,7 @@ around, when normally GHC would throw these away after compilation: to use :ghc-flag:`-fllvm` to force them to be produced). .. ghc-flag:: -keep-s-file + -keep-s-files Keep intermediate ``.s`` files. diff --git a/utils/mkUserGuidePart/Options/CompilerDebugging.hs b/utils/mkUserGuidePart/Options/CompilerDebugging.hs index 6160f01..3f1d899 100644 --- a/utils/mkUserGuidePart/Options/CompilerDebugging.hs +++ b/utils/mkUserGuidePart/Options/CompilerDebugging.hs @@ -55,7 +55,8 @@ compilerDebuggingOptions = , flagType = DynamicFlag } , flag { flagName = "-ddump-llvm" - , flagDescription = "Dump LLVM intermediate code" + , flagDescription = "Dump LLVM intermediate code. "++ + "Implies :ghc-flag:`-fllvm`." , flagType = DynamicFlag } , flag { flagName = "-ddump-occur-anal" diff --git a/utils/mkUserGuidePart/Options/KeepingIntermediates.hs b/utils/mkUserGuidePart/Options/KeepingIntermediates.hs index 9c93aed..dd68de4 100644 --- a/utils/mkUserGuidePart/Options/KeepingIntermediates.hs +++ b/utils/mkUserGuidePart/Options/KeepingIntermediates.hs @@ -5,19 +5,20 @@ import Types keepingIntermediatesOptions :: [Flag] keepingIntermediatesOptions = [ flag { flagName = "-keep-hc-file, -keep-hc-files" - , flagDescription = "retain intermediate ``.hc`` files" + , flagDescription = "Retain intermediate ``.hc`` files." , flagType = DynamicFlag } , flag { flagName = "-keep-llvm-file, -keep-llvm-files" - , flagDescription = "retain intermediate LLVM ``.ll`` files" + , flagDescription = "Retain intermediate LLVM ``.ll`` files. "++ + "Implies :ghc-flag:`-fllvm`." , flagType = DynamicFlag } , flag { flagName = "-keep-s-file, -keep-s-files" - , flagDescription = "retain intermediate ``.s`` files" + , flagDescription = "Retain intermediate ``.s`` files." , flagType = DynamicFlag } , flag { flagName = "-keep-tmp-files" - , flagDescription = "retain all intermediate temporary files" + , flagDescription = "Retain all intermediate temporary files." , flagType = DynamicFlag } ] From git at git.haskell.org Tue Feb 23 09:04:09 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 23 Feb 2016 09:04:09 +0000 (UTC) Subject: [commit: ghc] master: Add missing files (d3cf2a9) Message-ID: <20160223090409.398F83A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d3cf2a9bf8c3780a681273ae46aea0fc8f40374e/ghc >--------------------------------------------------------------- commit d3cf2a9bf8c3780a681273ae46aea0fc8f40374e Author: Simon Marlow Date: Tue Feb 23 09:05:37 2016 +0000 Add missing files >--------------------------------------------------------------- d3cf2a9bf8c3780a681273ae46aea0fc8f40374e testsuite/tests/profiling/should_run/{T5654b.hs => T5654b-O0.hs} | 2 +- testsuite/tests/profiling/should_run/{T5654b.hs => T5654b-O1.hs} | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/testsuite/tests/profiling/should_run/T5654b.hs b/testsuite/tests/profiling/should_run/T5654b-O0.hs similarity index 89% copy from testsuite/tests/profiling/should_run/T5654b.hs copy to testsuite/tests/profiling/should_run/T5654b-O0.hs index a052141..2a00abf 100644 --- a/testsuite/tests/profiling/should_run/T5654b.hs +++ b/testsuite/tests/profiling/should_run/T5654b-O0.hs @@ -1,5 +1,5 @@ -- A variant of T5654 where instead of evaluating directly to a --- function, f evaluates to a new PAP. This exposes a slightly +-- funciton, f evaluates to a new PAP. This exposes a slightly -- different but related bug, where when we create a new PAP by -- applying arguments to an existing PAP, we should take into account -- the stack on the original PAP. diff --git a/testsuite/tests/profiling/should_run/T5654b.hs b/testsuite/tests/profiling/should_run/T5654b-O1.hs similarity index 89% copy from testsuite/tests/profiling/should_run/T5654b.hs copy to testsuite/tests/profiling/should_run/T5654b-O1.hs index a052141..2a00abf 100644 --- a/testsuite/tests/profiling/should_run/T5654b.hs +++ b/testsuite/tests/profiling/should_run/T5654b-O1.hs @@ -1,5 +1,5 @@ -- A variant of T5654 where instead of evaluating directly to a --- function, f evaluates to a new PAP. This exposes a slightly +-- funciton, f evaluates to a new PAP. This exposes a slightly -- different but related bug, where when we create a new PAP by -- applying arguments to an existing PAP, we should take into account -- the stack on the original PAP. From git at git.haskell.org Tue Feb 23 10:53:51 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 23 Feb 2016 10:53:51 +0000 (UTC) Subject: [commit: ghc] branch 'wip/D1934' created Message-ID: <20160223105351.6A3183A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/D1934 Referencing: ed0d72d892b2e70099aaac758343e1e733478c1e From git at git.haskell.org Tue Feb 23 10:53:54 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 23 Feb 2016 10:53:54 +0000 (UTC) Subject: [commit: ghc] wip/D1934: Print which warning-flag controls an emitted warning. (ed0d72d) Message-ID: <20160223105354.695FA3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/D1934 Link : http://ghc.haskell.org/trac/ghc/changeset/ed0d72d892b2e70099aaac758343e1e733478c1e/ghc >--------------------------------------------------------------- commit ed0d72d892b2e70099aaac758343e1e733478c1e Author: Michael Walker Date: Sat Feb 20 09:15:46 2016 +0100 Print which warning-flag controls an emitted warning. Summary: Both gcc and clang tell which warning flag a reported warning can be controlled with, this patch makes ghc do the same. More generally, this allows for annotated compiler output, where an optional annotation is displayed in brackets after the severity. Fixes T10752. Reviewers: austin, hvr, goldfire, bgamari Subscribers: goldfire, thomie Differential Revision: https://phabricator.haskell.org/D1934 >--------------------------------------------------------------- ed0d72d892b2e70099aaac758343e1e733478c1e compiler/coreSyn/CoreLint.hs | 7 +- compiler/deSugar/Coverage.hs | 2 +- compiler/ghci/Debugger.hs | 2 +- compiler/ghci/Linker.hs | 7 +- compiler/iface/BinIface.hs | 4 +- compiler/iface/LoadIface.hs | 3 +- compiler/main/CodeOutput.hs | 2 +- compiler/main/DriverPipeline.hs | 4 +- compiler/main/DynFlags.hs | 11 ++- compiler/main/ErrUtils.hs | 46 ++++++--- compiler/main/ErrUtils.hs-boot | 1 + compiler/main/GhcMake.hs | 12 +-- compiler/main/SysTools.hs | 6 +- compiler/main/TidyPgm.hs | 3 +- compiler/rename/RnBinds.hs | 4 +- compiler/rename/RnEnv.hs | 20 ++-- compiler/rename/RnNames.hs | 80 +++++++++------- compiler/rename/RnSource.hs | 42 +++++--- compiler/rename/RnTypes.hs | 2 +- compiler/simplCore/CoreMonad.hs | 2 +- compiler/simplCore/SimplCore.hs | 3 +- compiler/simplStg/SimplStg.hs | 3 +- compiler/typecheck/Inst.hs | 4 +- compiler/typecheck/TcAnnotations.hs | 2 +- compiler/typecheck/TcBinds.hs | 24 ++--- compiler/typecheck/TcClassDcl.hs | 10 +- compiler/typecheck/TcDeriv.hs | 6 +- compiler/typecheck/TcErrors.hs | 16 ++-- compiler/typecheck/TcExpr.hs | 3 +- compiler/typecheck/TcForeign.hs | 6 +- compiler/typecheck/TcInstDcls.hs | 4 +- compiler/typecheck/TcMatches.hs | 3 +- compiler/typecheck/TcPat.hs | 2 +- compiler/typecheck/TcRnDriver.hs | 7 +- compiler/typecheck/TcRnMonad.hs | 92 ++++++++++++------ compiler/typecheck/TcSMonad.hs | 5 +- compiler/typecheck/TcSimplify.hs | 2 +- compiler/typecheck/TcSplice.hs | 4 +- compiler/typecheck/TcTyClsDecls.hs | 4 +- compiler/typecheck/TcValidity.hs | 5 +- ghc/GHCi/UI.hs | 4 +- .../tests/deSugar/should_compile/ds041.stderr | 10 +- .../tests/deSugar/should_compile/ds053.stderr | 3 +- .../tests/dependent/should_compile/T11241.stderr | 2 +- .../tests/deriving/should_compile/T4966.stderr | 10 +- .../deriving/should_compile/deriving-1935.stderr | 24 ++--- .../tests/deriving/should_compile/drv003.stderr | 16 ++-- .../tests/deriving/should_fail/drvfail006.stderr | 12 ++- .../tests/deriving/should_fail/drvfail008.stderr | 12 ++- testsuite/tests/driver/werror.stderr | 12 ++- testsuite/tests/ffi/should_compile/T1357.stderr | 4 +- .../tests/ghc-api/apirecomp001/apirecomp001.stderr | 12 +-- testsuite/tests/ghci/prog011/prog011.stderr | 7 +- testsuite/tests/ghci/prog011/prog011.stdout | 3 - testsuite/tests/ghci/scripts/T4316.stdout | 2 - testsuite/tests/ghci/scripts/T5820.stderr | 8 +- testsuite/tests/ghci/scripts/T8353.stderr | 6 +- testsuite/tests/ghci/scripts/ghci019.stderr | 2 +- .../haddock/haddock_examples/haddock.Test.stderr | 12 ++- .../indexed-types/should_compile/Class3.stderr | 8 +- .../indexed-types/should_compile/Simple2.stderr | 48 +++++----- .../indexed-types/should_compile/T3023.stderr | 2 +- .../indexed-types/should_compile/T8889.stderr | 2 +- .../should_compile/UnusedTyVarWarnings.stderr | 13 +-- .../UnusedTyVarWarningsNamedWCs.stderr | 10 +- .../tests/indexed-types/should_fail/T7862.stderr | 12 +-- testsuite/tests/module/mod128.stderr | 3 +- testsuite/tests/module/mod14.stderr | 2 +- testsuite/tests/module/mod176.stderr | 2 +- testsuite/tests/module/mod177.stderr | 2 +- testsuite/tests/module/mod5.stderr | 2 +- testsuite/tests/module/mod89.stderr | 4 +- .../MonadFailWarningsWithRebindableSyntax.stderr | 2 +- .../should_fail/overloadedrecfldsfail05.stderr | 2 +- .../should_fail/overloadedrecfldsfail06.stderr | 14 +-- .../should_fail/overloadedrecfldsfail11.stderr | 2 +- .../should_fail/overloadedrecfldsfail12.stderr | 6 +- testsuite/tests/parser/should_compile/T2245.stderr | 6 +- testsuite/tests/parser/should_compile/T3303.stderr | 4 +- .../tests/parser/should_compile/read014.stderr | 10 +- .../should_compile/ExprSigLocal.stderr | 4 +- .../partial-sigs/should_compile/SplicesUsed.stderr | 22 ++--- .../partial-sigs/should_compile/T10403.stderr | 6 +- .../partial-sigs/should_compile/T10438.stderr | 2 +- .../partial-sigs/should_compile/T10463.stderr | 14 +-- .../partial-sigs/should_compile/T10519.stderr | 2 +- .../partial-sigs/should_compile/T11016.stderr | 4 +- .../partial-sigs/should_compile/T11192.stderr | 4 +- .../partial-sigs/should_compile/TypedSplice.stderr | 28 +++--- .../WarningWildcardInstantiations.stderr | 14 +-- .../should_fail/Defaulting1MROff.stderr | 2 +- .../tests/partial-sigs/should_fail/T11122.stderr | 2 +- .../tests/patsyn/should_compile/T11283.stderr | 2 +- testsuite/tests/patsyn/should_fail/T11053.stderr | 10 +- testsuite/tests/rename/should_compile/T1789.stderr | 8 +- testsuite/tests/rename/should_compile/T17a.stderr | 4 +- testsuite/tests/rename/should_compile/T17b.stderr | 4 +- testsuite/tests/rename/should_compile/T17c.stderr | 4 +- testsuite/tests/rename/should_compile/T17d.stderr | 4 +- testsuite/tests/rename/should_compile/T17e.stderr | 8 +- testsuite/tests/rename/should_compile/T1972.stderr | 7 +- testsuite/tests/rename/should_compile/T3262.stderr | 4 +- testsuite/tests/rename/should_compile/T3371.stderr | 3 +- testsuite/tests/rename/should_compile/T3449.stderr | 3 +- testsuite/tests/rename/should_compile/T4489.stderr | 4 +- testsuite/tests/rename/should_compile/T5331.stderr | 6 +- testsuite/tests/rename/should_compile/T5334.stderr | 22 ++--- testsuite/tests/rename/should_compile/T5867.stderr | 4 +- testsuite/tests/rename/should_compile/T7085.stderr | 2 +- .../tests/rename/should_compile/T7145b.stderr | 3 +- testsuite/tests/rename/should_compile/T7167.stderr | 3 +- testsuite/tests/rename/should_compile/T9778.stderr | 7 +- testsuite/tests/rename/should_compile/mc10.stderr | 3 +- testsuite/tests/rename/should_compile/rn037.stderr | 2 +- testsuite/tests/rename/should_compile/rn039.stderr | 2 +- testsuite/tests/rename/should_compile/rn040.stderr | 6 +- testsuite/tests/rename/should_compile/rn041.stderr | 9 +- testsuite/tests/rename/should_compile/rn046.stderr | 4 +- testsuite/tests/rename/should_compile/rn047.stderr | 3 +- testsuite/tests/rename/should_compile/rn050.stderr | 4 +- testsuite/tests/rename/should_compile/rn055.stderr | 3 +- testsuite/tests/rename/should_compile/rn063.stderr | 6 +- testsuite/tests/rename/should_compile/rn064.stderr | 2 +- testsuite/tests/rename/should_compile/rn066.stderr | 4 +- testsuite/tests/rename/should_fail/T2723.stderr | 2 +- testsuite/tests/rename/should_fail/T5211.stderr | 2 +- testsuite/tests/rename/should_fail/T5281.stderr | 2 +- testsuite/tests/rename/should_fail/T5892a.stderr | 14 +-- testsuite/tests/rename/should_fail/T7454.stderr | 2 +- testsuite/tests/rename/should_fail/T8149.stderr | 2 +- testsuite/tests/semigroup/SemigroupWarnings.stderr | 4 +- .../tests/simplCore/should_compile/simpl020.stderr | 8 +- .../typecheck/prog001/typecheck.prog001.stderr | 8 +- .../tests/typecheck/should_compile/HasKey.stderr | 8 +- .../tests/typecheck/should_compile/T10935.stderr | 10 +- .../tests/typecheck/should_compile/T10971a.stderr | 16 ++-- .../tests/typecheck/should_compile/T2497.stderr | 3 +- .../tests/typecheck/should_compile/T3696.stderr | 4 +- .../tests/typecheck/should_compile/T4912.stderr | 4 +- .../tests/typecheck/should_compile/T7903.stderr | 16 ++-- .../tests/typecheck/should_compile/T9497a.stderr | 12 +-- .../tests/typecheck/should_compile/holes.stderr | 8 +- .../tests/typecheck/should_compile/holes2.stderr | 2 +- .../tests/typecheck/should_compile/tc078.stderr | 16 ++-- .../tests/typecheck/should_compile/tc115.stderr | 8 +- .../tests/typecheck/should_compile/tc116.stderr | 8 +- .../tests/typecheck/should_compile/tc125.stderr | 41 ++++---- .../tests/typecheck/should_compile/tc126.stderr | 16 ++-- .../tests/typecheck/should_compile/tc161.stderr | 8 +- .../tests/typecheck/should_compile/tc175.stderr | 8 +- .../tests/typecheck/should_compile/tc243.stderr | 2 +- .../tests/typecheck/should_compile/tc254.stderr | 6 +- testsuite/tests/typecheck/should_fail/T5051.stderr | 8 +- .../tests/typecheck/should_fail/tcfail204.stderr | 2 +- .../tests/warnings/minimal/WarnMinimal.stderr | 106 ++++++++++----------- .../tests/warnings/should_compile/DeprU.stderr | 4 +- .../tests/warnings/should_compile/PluralS.stderr | 4 +- .../warnings/should_compile/T10890/T10890_2.stderr | 2 +- .../tests/warnings/should_compile/T11077.stderr | 2 +- .../tests/warnings/should_compile/T11128.stderr | 8 +- .../tests/warnings/should_compile/T11128b.stderr | 4 +- .../tests/warnings/should_compile/T2526.stderr | 2 +- .../tests/warnings/should_compile/T9178.stderr | 2 +- .../wcompat-warnings/WCompatWarningsOn.stderr | 6 +- 164 files changed, 788 insertions(+), 648 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 ed0d72d892b2e70099aaac758343e1e733478c1e From git at git.haskell.org Tue Feb 23 11:27:04 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 23 Feb 2016 11:27:04 +0000 (UTC) Subject: [commit: ghc] master: Testsuite: delete Windows line endings [skip ci] (#11631) (31c312e) Message-ID: <20160223112704.BD38E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/31c312ebd29a4e79c166ad5dbbd5b57b42b6fafa/ghc >--------------------------------------------------------------- commit 31c312ebd29a4e79c166ad5dbbd5b57b42b6fafa Author: Thomas Miedema Date: Mon Feb 22 21:31:24 2016 +0100 Testsuite: delete Windows line endings [skip ci] (#11631) >--------------------------------------------------------------- 31c312ebd29a4e79c166ad5dbbd5b57b42b6fafa testsuite/tests/typecheck/should_run/T1735.hs | 0 testsuite/tests/typecheck/should_run/T1735_Help/Basics.hs | 0 testsuite/tests/typecheck/should_run/T1735_Help/Context.hs | 0 testsuite/tests/typecheck/should_run/T1735_Help/Instances.hs | 0 testsuite/tests/typecheck/should_run/T1735_Help/Main.hs | 0 testsuite/tests/typecheck/should_run/T1735_Help/State.hs | 0 testsuite/tests/typecheck/should_run/T1735_Help/Xml.hs | 0 testsuite/tests/typecheck/should_run/T4809_XMLGenerator.hs | 0 testsuite/tests/typecheck/should_run/TcRun038_B.hs | 0 testsuite/tests/typecheck/should_run/tcrun032.hs | 4 ++-- testsuite/tests/typecheck/should_run/tcrun038.hs | 0 testsuite/tests/typecheck/should_run/tcrun039.hs | 2 +- 12 files changed, 3 insertions(+), 3 deletions(-) diff --git a/testsuite/tests/typecheck/should_run/tcrun032.hs b/testsuite/tests/typecheck/should_run/tcrun032.hs index 8aa4363..5609a9f 100644 --- a/testsuite/tests/typecheck/should_run/tcrun032.hs +++ b/testsuite/tests/typecheck/should_run/tcrun032.hs @@ -8,7 +8,7 @@ module Main where data Fix f = In (f (Fix f)) instance Show (f (Fix f)) => Show (Fix f) where - show (In x) = "In " ++ show x -- No parens, but never mind + show (In x) = "In " ++ show x -- No parens, but never mind instance Eq (f (Fix f)) => Eq (Fix f) where (In x) == (In y) = x==y @@ -16,5 +16,5 @@ instance Eq (f (Fix f)) => Eq (Fix f) where data L x = Nil | Cons Int x deriving( Show, Eq ) main = do { print (In Nil); - print (In Nil == In Nil) } + print (In Nil == In Nil) } diff --git a/testsuite/tests/typecheck/should_run/tcrun039.hs b/testsuite/tests/typecheck/should_run/tcrun039.hs index 916d533..eabe015 100644 --- a/testsuite/tests/typecheck/should_run/tcrun039.hs +++ b/testsuite/tests/typecheck/should_run/tcrun039.hs @@ -16,7 +16,7 @@ data GADT a where g :: forall b. Read b => GADT b -> String -> b g (MkG n) s = -- Here we know Read [b] - n : (read s) + n : (read s) main = do print (f (MkT (3::Int)) "4") print (g (MkG (3::Int)) "[4,5]") From git at git.haskell.org Tue Feb 23 11:27:10 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 23 Feb 2016 11:27:10 +0000 (UTC) Subject: [commit: ghc] master: Testsuite: delete Windows line endings [skip ci] (#11631) (754a2f2) Message-ID: <20160223112710.440C73A301@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/754a2f2bb7416bd7fe453ba7bcb7c089f5ef3b8f/ghc >--------------------------------------------------------------- commit 754a2f2bb7416bd7fe453ba7bcb7c089f5ef3b8f Author: Thomas Miedema Date: Mon Feb 22 21:32:51 2016 +0100 Testsuite: delete Windows line endings [skip ci] (#11631) >--------------------------------------------------------------- 754a2f2bb7416bd7fe453ba7bcb7c089f5ef3b8f testsuite/tests/ghci.debugger/Test.hs | 2 +- testsuite/tests/ghci/scripts/ghci019.hs | 0 testsuite/tests/indexed-types/should_compile/ATLoop.hs | 0 testsuite/tests/indexed-types/should_compile/ATLoop_help.hs | 0 testsuite/tests/indexed-types/should_compile/CoTest3.hs | 0 testsuite/tests/indexed-types/should_compile/PushedInAsGivens.hs | 0 testsuite/tests/indexed-types/should_compile/T1769.hs | 0 testsuite/tests/indexed-types/should_compile/T2850.hs | 0 testsuite/tests/indexed-types/should_compile/T3423.hs | 0 testsuite/tests/indexed-types/should_compile/T3826.hs | 0 testsuite/tests/indexed-types/should_compile/T3851.hs | 0 testsuite/tests/indexed-types/should_compile/T4185.hs | 6 +++--- testsuite/tests/indexed-types/should_compile/TF_GADT.hs | 0 testsuite/tests/indexed-types/should_fail/DerivUnsatFam.hs | 0 testsuite/tests/indexed-types/should_fail/T2544.hs | 0 testsuite/tests/indexed-types/should_fail/T4093b.hs | 0 testsuite/tests/indexed-types/should_fail/T4246.hs | 0 testsuite/tests/mdo/should_fail/mdofail006.hs | 0 testsuite/tests/mdo/should_run/mdorun003.hs | 0 testsuite/tests/mdo/should_run/mdorun004.hs | 0 testsuite/tests/mdo/should_run/mdorun005.hs | 0 testsuite/tests/module/T1074.hs | 0 testsuite/tests/module/T1074a.hs | 0 testsuite/tests/module/T1148.hs | 0 testsuite/tests/module/T2267.hs | 0 testsuite/tests/parser/should_compile/read062.hs | 0 testsuite/tests/parser/should_fail/readFail031.hs | 0 testsuite/tests/parser/should_fail/readFail042.hs | 0 testsuite/tests/parser/should_fail/readFail043.hs | 0 testsuite/tests/parser/unicode/T1744.hs | 0 testsuite/tests/polykinds/T5862.hs | 0 testsuite/tests/polykinds/T5912.hs | 0 testsuite/tests/polykinds/T6020.hs | 0 testsuite/tests/polykinds/T6035.hs | 0 testsuite/tests/polykinds/T6036.hs | 0 testsuite/tests/polykinds/T7073.hs | 0 testsuite/tests/polykinds/T7272.hs | 0 testsuite/tests/polykinds/T7272a.hs | 0 testsuite/tests/polykinds/T7433.hs | 0 testsuite/tests/quasiquotation/T4491/A.hs | 0 testsuite/tests/quasiquotation/qq007/QQ.hs | 0 testsuite/tests/quasiquotation/qq007/Test.hs | 4 ++-- testsuite/tests/rebindable/T303.hs | 0 testsuite/tests/rebindable/rebindable7.hs | 4 ++-- testsuite/tests/rename/should_compile/T2436.hs | 0 testsuite/tests/rename/should_compile/T2436a.hs | 0 testsuite/tests/rename/should_compile/T3943.hs | 0 testsuite/tests/rename/should_compile/T4489.hs | 0 testsuite/tests/rename/should_compile/T5306.hs | 0 testsuite/tests/rename/should_compile/T5306a.hs | 0 testsuite/tests/rename/should_compile/T5306b.hs | 0 testsuite/tests/rename/should_compile/T7007.hs | 0 testsuite/tests/rename/should_compile/T7336.hs | 0 testsuite/tests/rename/should_fail/T2723.hs | 0 testsuite/tests/rename/should_fail/T3792.hs | 2 +- testsuite/tests/rename/should_fail/T5211.hs | 0 testsuite/tests/rename/should_fail/T9436.hs | 0 testsuite/tests/rename/should_fail/T9437.hs | 0 testsuite/tests/rename/should_fail/rnfail043.hs | 0 testsuite/tests/rename/should_fail/rnfail046.hs | 0 testsuite/tests/rename/should_fail/rnfail049.hs | 0 61 files changed, 9 insertions(+), 9 deletions(-) diff --git a/testsuite/tests/ghci.debugger/Test.hs b/testsuite/tests/ghci.debugger/Test.hs index f0477af..0e177a5 100644 --- a/testsuite/tests/ghci.debugger/Test.hs +++ b/testsuite/tests/ghci.debugger/Test.hs @@ -20,7 +20,7 @@ newtype MkT2 a = MkT2 (MkT a) deriving Show data Param2 s r = P2 (FakeSTRef r (s(Param2 s r))) - | P2Nil + | P2Nil data FakeSTRef r s = Ref s testParam2 = O (P2 (Ref P2Nil)) diff --git a/testsuite/tests/indexed-types/should_compile/T4185.hs b/testsuite/tests/indexed-types/should_compile/T4185.hs index 6a1be25..d7fdbd5 100644 --- a/testsuite/tests/indexed-types/should_compile/T4185.hs +++ b/testsuite/tests/indexed-types/should_compile/T4185.hs @@ -5,12 +5,12 @@ data family Foo k :: * -> * ------------- Generalised newtype deriving of user class ----------- class Bar f where - bar :: f a -> Int + bar :: f a -> Int woo :: f a -> f a instance Bar Maybe where - bar Nothing = 0 - bar Just{} = 1 + bar Nothing = 0 + bar Just{} = 1 woo x = x -- Deriving clause diff --git a/testsuite/tests/quasiquotation/qq007/Test.hs b/testsuite/tests/quasiquotation/qq007/Test.hs index 42cef72..0f81321 100644 --- a/testsuite/tests/quasiquotation/qq007/Test.hs +++ b/testsuite/tests/quasiquotation/qq007/Test.hs @@ -4,10 +4,10 @@ module Test where import QQ f :: [pq| foo |] -- Expands to Int -> Int -[pq| blah |] -- Expands to f x = x +[pq| blah |] -- Expands to f x = x h [pq| foo |] = f [pq| blah |] * 8 - -- Expands to h (Just x) = f (x+1) * 8 + -- Expands to h (Just x) = f (x+1) * 8 diff --git a/testsuite/tests/rebindable/rebindable7.hs b/testsuite/tests/rebindable/rebindable7.hs index 8e0000e..01f3eda 100644 --- a/testsuite/tests/rebindable/rebindable7.hs +++ b/testsuite/tests/rebindable/rebindable7.hs @@ -32,7 +32,7 @@ t1 :: T Int t1 = MkT 4 myt = do { x <- t1 - ; return x } + ; return x } main = case myt of - MkT i -> Prelude.print i + MkT i -> Prelude.print i diff --git a/testsuite/tests/rename/should_fail/T3792.hs b/testsuite/tests/rename/should_fail/T3792.hs index e01efb9..e53dd26 100644 --- a/testsuite/tests/rename/should_fail/T3792.hs +++ b/testsuite/tests/rename/should_fail/T3792.hs @@ -1,4 +1,4 @@ module T3792 where -import Prelude( Prelude.map ) -- Illegal +import Prelude( Prelude.map ) -- Illegal From git at git.haskell.org Tue Feb 23 11:27:07 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 23 Feb 2016 11:27:07 +0000 (UTC) Subject: [commit: ghc] master: Testsuite: delete Windows line endings [skip ci] (#11631) (8626ac9) Message-ID: <20160223112707.6C0A63A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8626ac91a3cac028bbe742f07a1ce9fb598589f6/ghc >--------------------------------------------------------------- commit 8626ac91a3cac028bbe742f07a1ce9fb598589f6 Author: Thomas Miedema Date: Mon Feb 22 21:31:35 2016 +0100 Testsuite: delete Windows line endings [skip ci] (#11631) >--------------------------------------------------------------- 8626ac91a3cac028bbe742f07a1ce9fb598589f6 testsuite/tests/rts/T2047.hs | 0 testsuite/tests/simplCore/should_compile/T4201.hs | 0 testsuite/tests/simplCore/should_compile/T5366.hs | 0 testsuite/tests/simplCore/should_compile/T7287.hs | 0 testsuite/tests/simplCore/should_compile/rule1.hs | 4 ++-- testsuite/tests/simplCore/should_run/T5441.hs | 0 testsuite/tests/simplCore/should_run/T5441a.hs | 0 testsuite/tests/stranal/should_compile/T8037.hs | 0 testsuite/tests/th/T2597a.hs | 0 testsuite/tests/th/T2597a_Lib.hs | 2 +- testsuite/tests/th/T2597b.hs | 0 testsuite/tests/th/T2597b_Lib.hs | 0 testsuite/tests/th/T2700.hs | 0 testsuite/tests/th/T2713.hs | 0 testsuite/tests/th/T3395.hs | 0 testsuite/tests/th/T3467.hs | 0 testsuite/tests/th/T5404.hs | 0 testsuite/tests/th/T5410.hs | 0 testsuite/tests/th/T5665.hs | 0 testsuite/tests/th/T5737.hs | 0 testsuite/tests/th/T8954.hs | 0 testsuite/tests/th/TH_1tuple.hs | 6 +++--- testsuite/tests/th/TH_NestedSplices.hs | 0 testsuite/tests/th/TH_NestedSplices_Lib.hs | 0 testsuite/tests/typecheck/should_compile/FD2.hs | 0 testsuite/tests/typecheck/should_compile/FD4.hs | 0 testsuite/tests/typecheck/should_compile/GivenTypeSynonym.hs | 0 testsuite/tests/typecheck/should_compile/T2572.hs | 0 testsuite/tests/typecheck/should_compile/T5120.hs | 0 testsuite/tests/typecheck/should_compile/T5595.hs | 0 testsuite/tests/typecheck/should_compile/T7268.hs | 0 testsuite/tests/typecheck/should_compile/T7384.hs | 0 testsuite/tests/typecheck/should_compile/T7888.hs | 0 testsuite/tests/typecheck/should_compile/faxen.hs | 4 ++-- testsuite/tests/typecheck/should_compile/tc190.hs | 0 testsuite/tests/typecheck/should_compile/tc240.hs | 0 testsuite/tests/typecheck/should_compile/tc247.hs | 0 testsuite/tests/typecheck/should_fail/FailDueToGivenOverlapping.hs | 0 testsuite/tests/typecheck/should_fail/LongWayOverlapping.hs | 0 testsuite/tests/typecheck/should_fail/SCLoop.hs | 0 testsuite/tests/typecheck/should_fail/T2126.hs | 0 testsuite/tests/typecheck/should_fail/T2714.hs | 0 testsuite/tests/typecheck/should_fail/T3406.hs | 0 testsuite/tests/typecheck/should_fail/T3592.hs | 0 testsuite/tests/typecheck/should_fail/T3613.hs | 0 testsuite/tests/typecheck/should_fail/T3950.hs | 0 testsuite/tests/typecheck/should_fail/T4875.hs | 0 testsuite/tests/typecheck/should_fail/T5246.hs | 0 testsuite/tests/typecheck/should_fail/T5689.hs | 0 testsuite/tests/typecheck/should_fail/T5978.hs | 0 testsuite/tests/typecheck/should_fail/T6022.hs | 0 testsuite/tests/typecheck/should_fail/T7892.hs | 0 testsuite/tests/typecheck/should_fail/fd-loop.hs | 0 testsuite/tests/typecheck/should_fail/tcfail136.hs | 0 testsuite/tests/typecheck/should_fail/tcfail140.hs | 0 testsuite/tests/typecheck/should_fail/tcfail146.hs | 0 testsuite/tests/typecheck/should_fail/tcfail147.hs | 0 testsuite/tests/typecheck/should_fail/tcfail189.hs | 0 testsuite/tests/typecheck/should_fail/tcfail193.hs | 0 59 files changed, 8 insertions(+), 8 deletions(-) diff --git a/testsuite/tests/simplCore/should_compile/rule1.hs b/testsuite/tests/simplCore/should_compile/rule1.hs index 923f480..6894f82 100644 --- a/testsuite/tests/simplCore/should_compile/rule1.hs +++ b/testsuite/tests/simplCore/should_compile/rule1.hs @@ -1,9 +1,9 @@ -- This one triggers the bug reported in Trac #1092 -- The problem is that the rule --- forall w. f (\v->w) = w +-- forall w. f (\v->w) = w -- erroneously matches the call --- f id +-- f id -- -- Lint catches the error diff --git a/testsuite/tests/th/T2597a_Lib.hs b/testsuite/tests/th/T2597a_Lib.hs index 0e8f794..ad69ac2 100644 --- a/testsuite/tests/th/T2597a_Lib.hs +++ b/testsuite/tests/th/T2597a_Lib.hs @@ -7,6 +7,6 @@ import Language.Haskell.TH mkBug :: ExpQ mkBug = return $ CompE [BindS (VarP $ mkName "p") (ListE []), NoBindS - (VarE $ mkName "p")] + (VarE $ mkName "p")] diff --git a/testsuite/tests/th/TH_1tuple.hs b/testsuite/tests/th/TH_1tuple.hs index 3674a5a..ea1a119 100644 --- a/testsuite/tests/th/TH_1tuple.hs +++ b/testsuite/tests/th/TH_1tuple.hs @@ -6,10 +6,10 @@ module ShouldFail where import Language.Haskell.TH x = $(sigE [|1|] (tupleT 1 `appT` conT ''Int)) - -- 1 :: (Int) ( a 1-tuple type) + -- 1 :: (Int) ( a 1-tuple type) y = $(sigE [|1|] (tupleT 1)) - -- 1 :: (1) (a 1-tuple tycon not applied) + -- 1 :: (1) (a 1-tuple tycon not applied) z = $(tupE [ [| "yes" |] ]) - -- ("yes") (a 1-tuple expression) + -- ("yes") (a 1-tuple expression) diff --git a/testsuite/tests/typecheck/should_compile/faxen.hs b/testsuite/tests/typecheck/should_compile/faxen.hs index 8ad56c6..3dd9f7b 100644 --- a/testsuite/tests/typecheck/should_compile/faxen.hs +++ b/testsuite/tests/typecheck/should_compile/faxen.hs @@ -22,12 +22,12 @@ instance HasEmpty (Maybe a) where test1 y = (null y) || (let f :: forall d. d -> Bool - f x = isEmpty (y >> return x) + f x = isEmpty (y >> return x) in f y) test2 y = (let f :: forall d. d -> Bool - f x = isEmpty (y >> return x) + f x = isEmpty (y >> return x) in f y) || (null y) From git at git.haskell.org Tue Feb 23 11:27:13 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 23 Feb 2016 11:27:13 +0000 (UTC) Subject: [commit: ghc] master: Testsuite: delete Windows line endings [skip ci] (#11631) (6074c10) Message-ID: <20160223112713.180A73A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6074c108b66ec9cd2230852addb60782a8b17e0a/ghc >--------------------------------------------------------------- commit 6074c108b66ec9cd2230852addb60782a8b17e0a Author: Thomas Miedema Date: Mon Feb 22 21:32:51 2016 +0100 Testsuite: delete Windows line endings [skip ci] (#11631) >--------------------------------------------------------------- 6074c108b66ec9cd2230852addb60782a8b17e0a testsuite/tests/deriving/should_compile/T3012.hs | 0 testsuite/tests/deriving/should_compile/T6031.hs | 0 testsuite/tests/deriving/should_compile/T6031a.hs | 0 testsuite/tests/deriving/should_compile/T8893.hs | 0 testsuite/tests/deriving/should_fail/T2701.hs | 0 testsuite/tests/deriving/should_fail/T4846.hs | 0 testsuite/tests/deriving/should_run/T4136.hs | 0 testsuite/tests/deriving/should_run/drvrun019.hs | 0 testsuite/tests/driver/Shared001.hs | 0 testsuite/tests/driver/recomp010/X1.hs | 0 testsuite/tests/driver/recomp010/X2.hs | 0 testsuite/tests/dynlibs/T4464H.hs | 0 testsuite/tests/eyeball/inline4.hs | 0 testsuite/tests/eyeball/record1.hs | 4 +-- testsuite/tests/ffi/should_compile/ffi-deriv1.hs | 0 testsuite/tests/ffi/should_run/T1288.hs | 0 testsuite/tests/ffi/should_run/T1288_ghci.hs | 0 testsuite/tests/ffi/should_run/T2276.hs | 0 testsuite/tests/ffi/should_run/T2276_ghci.hs | 0 testsuite/tests/ffi/should_run/ffi014.hs | 8 ++--- testsuite/tests/gadt/Arith.hs | 0 testsuite/tests/gadt/T2587.hs | 0 testsuite/tests/gadt/data1.hs | 0 testsuite/tests/gadt/data2.hs | 0 testsuite/tests/gadt/gadt-fd.hs | 0 testsuite/tests/gadt/gadt14.hs | 0 testsuite/tests/gadt/gadt18.hs | 0 testsuite/tests/gadt/gadt9.hs | 0 testsuite/tests/gadt/karl1.hs | 4 +-- testsuite/tests/gadt/karl2.hs | 0 testsuite/tests/gadt/lazypat.hs | 0 testsuite/tests/gadt/lazypatok.hs | 0 testsuite/tests/gadt/rw.hs | 14 ++++---- testsuite/tests/gadt/tc.hs | 42 +++++++++++------------ 34 files changed, 36 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 6074c108b66ec9cd2230852addb60782a8b17e0a From git at git.haskell.org Tue Feb 23 11:27:15 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 23 Feb 2016 11:27:15 +0000 (UTC) Subject: [commit: ghc] master: Testsuite: delete Windows line endings [skip ci] (#11631) (d5e8b39) Message-ID: <20160223112715.CADB63A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d5e8b3940e8f190e9ad94e044014162bcb808c3a/ghc >--------------------------------------------------------------- commit d5e8b3940e8f190e9ad94e044014162bcb808c3a Author: Thomas Miedema Date: Mon Feb 22 21:32:51 2016 +0100 Testsuite: delete Windows line endings [skip ci] (#11631) >--------------------------------------------------------------- d5e8b3940e8f190e9ad94e044014162bcb808c3a libraries/base/tests/Concurrent/Chan001.hs | 42 ++++++------ libraries/base/tests/Concurrent/MVar001.hs | 78 +++++++++++----------- libraries/base/tests/IO/T7853.hs | 0 libraries/base/tests/IO/encoding004.hs | 0 libraries/base/tests/IO/hGetLine001.hs | 4 +- libraries/base/tests/IO/hReady002.hs | 0 testsuite/tests/arityanal/f0.hs | 4 +- testsuite/tests/arityanal/f1.hs | 4 +- testsuite/tests/arityanal/f10.hs | 0 testsuite/tests/arityanal/f11.hs | 0 testsuite/tests/arityanal/f12.hs | 0 testsuite/tests/arityanal/f13.hs | 8 +-- testsuite/tests/arityanal/f14.hs | 0 testsuite/tests/arityanal/f15.hs | 0 testsuite/tests/arityanal/f2.hs | 4 +- testsuite/tests/arityanal/f3.hs | 2 +- testsuite/tests/arityanal/f4.hs | 2 +- testsuite/tests/arityanal/f5.hs | 0 testsuite/tests/arityanal/f6.hs | 0 testsuite/tests/arityanal/f7.hs | 0 testsuite/tests/arityanal/f8.hs | 2 +- testsuite/tests/arityanal/f9.hs | 0 testsuite/tests/arityanal/prim.hs | 0 testsuite/tests/codeGen/should_compile/cg005.hs | 0 .../tests/deSugar/should_compile/GadtOverlap.hs | 0 testsuite/tests/deSugar/should_compile/T4870.hs | 0 testsuite/tests/deSugar/should_compile/T4870a.hs | 0 testsuite/tests/deSugar/should_compile/T5117.hs | 0 testsuite/tests/deSugar/should_compile/T5252.hs | 0 testsuite/tests/deSugar/should_compile/T5252a.hs | 0 testsuite/tests/deSugar/should_compile/ds055.hs | 2 +- testsuite/tests/deSugar/should_run/T3382.hs | 0 testsuite/tests/deSugar/should_run/dsrun021.hs | 0 33 files changed, 76 insertions(+), 76 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 d5e8b3940e8f190e9ad94e044014162bcb808c3a From git at git.haskell.org Tue Feb 23 11:27:18 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 23 Feb 2016 11:27:18 +0000 (UTC) Subject: [commit: ghc] master: Testsuite: accept output without Windows line endings (#11631) (978c3ea) Message-ID: <20160223112718.823FF3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/978c3ea14a4fb9be577fe64e1e6b724a44f332a8/ghc >--------------------------------------------------------------- commit 978c3ea14a4fb9be577fe64e1e6b724a44f332a8 Author: Thomas Miedema Date: Tue Feb 23 02:57:53 2016 +0100 Testsuite: accept output without Windows line endings (#11631) >--------------------------------------------------------------- 978c3ea14a4fb9be577fe64e1e6b724a44f332a8 testsuite/tests/deriving/should_fail/T5287.stderr | 18 ++-- .../tests/deriving/should_fail/drvfail002.stderr | 14 +-- .../tests/deriving/should_fail/drvfail008.stderr | 10 +- .../tests/deriving/should_fail/drvfail016.stderr | 2 +- testsuite/tests/driver/sigof04/sigof04.stderr | 2 +- testsuite/tests/gadt/T3651.stderr | 36 +++---- testsuite/tests/gadt/T7293.stderr | 14 +-- testsuite/tests/gadt/T7294.stderr | 14 +-- testsuite/tests/gadt/T7558.stderr | 26 ++--- testsuite/tests/gadt/gadt11.stderr | 8 +- testsuite/tests/gadt/gadtSyntaxFail001.stderr | 10 +- testsuite/tests/gadt/gadtSyntaxFail002.stderr | 10 +- testsuite/tests/gadt/gadtSyntaxFail003.stderr | 10 +- .../tests/ghci.debugger/scripts/break019.stderr | 2 +- testsuite/tests/ghci/prog008/ghci.prog008.stdout | 0 testsuite/tests/ghci/prog009/ghci.prog009.stderr | 4 +- testsuite/tests/ghci/scripts/T5564.stderr | 12 +-- testsuite/tests/ghci/scripts/T7894.stderr | 2 +- testsuite/tests/ghci/scripts/T9293.stderr | 26 ++--- testsuite/tests/ghci/scripts/ghci034.stderr | 2 +- testsuite/tests/ghci/scripts/ghci044.stderr | 12 +-- testsuite/tests/ghci/scripts/ghci057.stderr | 26 ++--- .../indexed-types/should_compile/Simple14.stderr | 32 +++--- .../tests/indexed-types/should_fail/BadSock.stderr | 6 +- .../indexed-types/should_fail/DerivUnsatFam.stderr | 8 +- .../indexed-types/should_fail/NoMatchErr.stderr | 17 ++-- .../should_fail/NotRelaxedExamples.stderr | 22 ++--- .../indexed-types/should_fail/Overlap15.stderr | 13 +-- .../tests/indexed-types/should_fail/T1900.stderr | 20 ++-- .../tests/indexed-types/should_fail/T2157.stderr | 4 +- .../tests/indexed-types/should_fail/T9036.stderr | 18 ++-- .../tests/indexed-types/should_fail/T9433.stderr | 5 +- .../indexed-types/should_fail/TyFamUndec.stderr | 22 ++--- testsuite/tests/module/mod101.stderr | 4 +- testsuite/tests/module/mod102.stderr | 4 +- testsuite/tests/module/mod132.stderr | 4 +- testsuite/tests/module/mod39.stderr | 12 +-- testsuite/tests/module/mod60.stderr | 6 +- .../should_fail/ParserNoBinaryLiterals2.stderr | 6 +- .../should_fail/ParserNoBinaryLiterals3.stderr | 6 +- .../should_compile/Defaulting2MROff.stderr | 2 +- .../partial-sigs/should_compile/Either.stderr | 2 +- .../partial-sigs/should_compile/EveryNamed.stderr | 2 +- .../partial-sigs/should_compile/ShowNamed.stderr | 2 +- .../partial-sigs/should_compile/SimpleGen.stderr | 2 +- .../partial-sigs/should_compile/Uncurry.stderr | 2 +- .../should_compile/UncurryNamed.stderr | 2 +- ...ExtraConstraintsWildcardInTypeSpliceUsed.stderr | 10 +- .../should_fail/NamedWildcardsNotInMonotype.stderr | 20 ++-- .../WildcardsInPatternAndExprSig.stderr | 108 ++++++++++----------- 50 files changed, 312 insertions(+), 309 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 978c3ea14a4fb9be577fe64e1e6b724a44f332a8 From git at git.haskell.org Tue Feb 23 11:27:21 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 23 Feb 2016 11:27:21 +0000 (UTC) Subject: [commit: ghc] master: Testsuite: accept output without Windows line endings (#11631) (42f06f6) Message-ID: <20160223112721.456863A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/42f06f6821a221b88d67b0adc110eea78c159d7f/ghc >--------------------------------------------------------------- commit 42f06f6821a221b88d67b0adc110eea78c159d7f Author: Thomas Miedema Date: Tue Feb 23 02:25:17 2016 +0100 Testsuite: accept output without Windows line endings (#11631) >--------------------------------------------------------------- 42f06f6821a221b88d67b0adc110eea78c159d7f testsuite/tests/polykinds/T10516.stderr | 5 +- testsuite/tests/polykinds/T6054.stderr | 16 +-- .../tests/rename/should_fail/Misplaced.stderr | 2 +- testsuite/tests/rename/should_fail/T2310.stderr | 6 +- testsuite/tests/rename/should_fail/T3792.stderr | 3 +- .../tests/rename/should_fail/rnfail022.stderr | 4 +- .../tests/rename/should_fail/rnfail047.stderr | 2 +- .../tests/simplCore/should_compile/simpl020.stderr | 8 +- testsuite/tests/th/T3600.stderr | 4 +- .../tests/typecheck/should_compile/T10632.stderr | 6 +- .../tests/typecheck/should_compile/T3696.stderr | 4 +- .../tests/typecheck/should_compile/T7050.stderr | 6 +- .../tests/typecheck/should_compile/T7220a.stderr | 25 ++-- .../tests/typecheck/should_compile/T7562.stderr | 6 +- .../tests/typecheck/should_compile/T9497a.stderr | 10 +- .../typecheck/should_fail/AssocTyDef05.stderr | 8 +- .../typecheck/should_fail/ContextStack2.stderr | 21 ++-- .../typecheck/should_fail/FDsFromGivens.stderr | 31 ++--- .../should_fail/FailDueToGivenOverlapping.stderr | 22 ++-- .../tests/typecheck/should_fail/IPFail.stderr | 16 +-- .../tests/typecheck/should_fail/T10351.stderr | 8 +- .../tests/typecheck/should_fail/T1897a.stderr | 20 ++-- testsuite/tests/typecheck/should_fail/T3592.stderr | 30 ++--- testsuite/tests/typecheck/should_fail/T3966.stderr | 6 +- testsuite/tests/typecheck/should_fail/T5051.stderr | 8 +- testsuite/tests/typecheck/should_fail/T5236.stderr | 23 ++-- testsuite/tests/typecheck/should_fail/T6022.stderr | 8 +- testsuite/tests/typecheck/should_fail/T7279.stderr | 17 +-- testsuite/tests/typecheck/should_fail/T7697.stderr | 5 +- testsuite/tests/typecheck/should_fail/T8034.stderr | 18 +-- .../tests/typecheck/should_fail/T8392a.stderr | 11 +- .../tests/typecheck/should_fail/T9497d.stderr | 10 +- .../tests/typecheck/should_fail/fd-loop.stderr | 16 +-- .../tests/typecheck/should_fail/tcfail019.stderr | 16 +-- .../tests/typecheck/should_fail/tcfail058.stderr | 7 +- .../tests/typecheck/should_fail/tcfail063.stderr | 7 +- .../tests/typecheck/should_fail/tcfail067.stderr | 129 +++++++++++---------- .../tests/typecheck/should_fail/tcfail080.stderr | 20 ++-- .../tests/typecheck/should_fail/tcfail097.stderr | 19 +-- .../tests/typecheck/should_fail/tcfail098.stderr | 17 +-- .../tests/typecheck/should_fail/tcfail100.stderr | 4 +- .../tests/typecheck/should_fail/tcfail101.stderr | 5 +- .../tests/typecheck/should_fail/tcfail102.stderr | 16 +-- .../tests/typecheck/should_fail/tcfail106.stderr | 16 +-- .../tests/typecheck/should_fail/tcfail107.stderr | 6 +- .../tests/typecheck/should_fail/tcfail108.stderr | 8 +- .../tests/typecheck/should_fail/tcfail110.stderr | 7 +- .../tests/typecheck/should_fail/tcfail116.stderr | 20 ++-- .../tests/typecheck/should_fail/tcfail125.stderr | 17 +-- .../tests/typecheck/should_fail/tcfail129.stderr | 16 +-- .../tests/typecheck/should_fail/tcfail134.stderr | 9 +- .../tests/typecheck/should_fail/tcfail135.stderr | 9 +- .../tests/typecheck/should_fail/tcfail142.stderr | 20 ++-- .../tests/typecheck/should_fail/tcfail150.stderr | 14 +-- .../tests/typecheck/should_fail/tcfail154.stderr | 8 +- .../tests/typecheck/should_fail/tcfail155.stderr | 8 +- .../tests/typecheck/should_fail/tcfail157.stderr | 16 +-- .../tests/typecheck/should_fail/tcfail158.stderr | 7 +- .../tests/typecheck/should_fail/tcfail167.stderr | 14 +-- .../tests/typecheck/should_fail/tcfail171.stderr | 15 +-- .../tests/typecheck/should_fail/tcfail186.stderr | 14 +-- .../tests/typecheck/should_fail/tcfail187.stderr | 6 +- .../tests/typecheck/should_fail/tcfail209.stderr | 6 +- .../tests/typecheck/should_fail/tcfail209a.stderr | 7 +- .../tests/typecheck/should_fail/tcfail213.stderr | 10 +- .../tests/typecheck/should_fail/tcfail214.stderr | 6 +- .../tests/typecheck/should_fail/tcfail215.stderr | 5 +- .../tests/typecheck/should_fail/tcfail222.stderr | 2 +- 68 files changed, 457 insertions(+), 434 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 42f06f6821a221b88d67b0adc110eea78c159d7f From git at git.haskell.org Tue Feb 23 11:27:24 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 23 Feb 2016 11:27:24 +0000 (UTC) Subject: [commit: ghc] master: Testsuite: delete Windows line endings [skip ci] (#11631) (28620ba) Message-ID: <20160223112724.12EBE3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/28620ba6a7968ef3ab589f62ac761fffe4f42caa/ghc >--------------------------------------------------------------- commit 28620ba6a7968ef3ab589f62ac761fffe4f42caa Author: Thomas Miedema Date: Mon Feb 22 21:32:51 2016 +0100 Testsuite: delete Windows line endings [skip ci] (#11631) >--------------------------------------------------------------- 28620ba6a7968ef3ab589f62ac761fffe4f42caa testsuite/tests/patsyn/should_fail/T9705-1.stderr | 0 testsuite/tests/patsyn/should_fail/T9705-2.stderr | 0 testsuite/tests/polykinds/T7272.hs-boot | 0 testsuite/tests/profiling/should_run/T5363.stdout-ws-32 | 0 testsuite/tests/quotes/T3572.stdout | 0 testsuite/tests/quotes/TH_ppr1.stdout | 0 testsuite/tests/rebindable/rebindable7.stdout | 0 testsuite/tests/rename/should_compile/T1972.stderr | 0 testsuite/tests/rename/should_compile/T5331.stderr | 0 testsuite/tests/rename/should_compile/T5592.stdout | 0 testsuite/tests/rename/should_fail/RnStaticPointersFail02.stderr | 0 testsuite/tests/rename/should_fail/T5372.stderr | 0 testsuite/tests/rename/should_fail/T5533.stderr | 0 testsuite/tests/rename/should_fail/T7906.stderr | 0 testsuite/tests/rename/should_fail/T9177.stderr | 0 testsuite/tests/rename/should_fail/T9177a.stderr | 0 testsuite/tests/rename/should_fail/mc14.stderr | 0 testsuite/tests/rename/should_fail/rn_dup.stderr | 0 testsuite/tests/rename/should_fail/rnfail024.stderr | 0 testsuite/tests/rename/should_fail/rnfail044.stderr | 0 testsuite/tests/rename/should_fail/rnfail049.stderr | 0 testsuite/tests/rename/should_fail/rnfail050.stderr | 0 testsuite/tests/rts/T10672/cxxy.cpp | 0 testsuite/tests/rts/derefnull.stdout-x86_64-unknown-mingw32 | 0 testsuite/tests/rts/divbyzero.stdout-x86_64-unknown-mingw32 | 0 testsuite/tests/safeHaskell/ghci/p10.stderr | 0 testsuite/tests/safeHaskell/ghci/p9.stderr | 0 testsuite/tests/simplCore/should_compile/T5996.stdout | 0 testsuite/tests/simplCore/should_compile/T8848a.stderr | 0 testsuite/tests/simplCore/should_run/T11172.stdout | 0 testsuite/tests/simplCore/should_run/T5441.stdout | 0 testsuite/tests/simplCore/should_run/T5453.stdout | 0 testsuite/tests/th/T2700.stderr | 0 testsuite/tests/th/T3920.stdout | 0 testsuite/tests/th/T5217.stderr | 0 testsuite/tests/th/T5410.stdout | 0 testsuite/tests/th/T7241.stderr | 0 testsuite/tests/th/T8625.stdout | 0 testsuite/tests/th/T8932.stderr | 0 testsuite/tests/th/TH_linePragma.stderr | 0 testsuite/tests/th/TH_pragma.stderr | 0 testsuite/tests/th/TH_viewPatPrint.stdout | 0 testsuite/tests/typecheck/should_compile/T11254.stderr | 0 testsuite/tests/typecheck/should_fail/T11355.stderr | 0 testsuite/tests/typecheck/should_fail/T2538.stderr | 0 testsuite/tests/typecheck/should_fail/T5957.stderr | 0 testsuite/tests/typecheck/should_fail/T7019.stderr | 0 testsuite/tests/typecheck/should_fail/T7019a.stderr | 0 testsuite/tests/typecheck/should_fail/T7809.stderr | 0 testsuite/tests/typecheck/should_fail/T8806.stderr | 0 testsuite/tests/typecheck/should_fail/T9196.stderr | 0 testsuite/tests/typecheck/should_fail/mc22.stderr | 0 testsuite/tests/typecheck/should_fail/mc25.stderr | 0 testsuite/tests/typecheck/should_fail/tcfail011.stderr | 0 testsuite/tests/typecheck/should_fail/tcfail021.stderr | 0 testsuite/tests/typecheck/should_fail/tcfail037.stderr | 0 testsuite/tests/typecheck/should_fail/tcfail088.stderr | 0 testsuite/tests/typecheck/should_fail/tcfail127.stderr | 0 testsuite/tests/typecheck/should_fail/tcfail184.stderr | 0 testsuite/tests/typecheck/should_fail/tcfail195.stderr | 0 testsuite/tests/typecheck/should_fail/tcfail196.stderr | 0 testsuite/tests/typecheck/should_fail/tcfail197.stderr | 0 testsuite/tests/typecheck/should_run/T1735.stdout | 0 testsuite/tests/typecheck/should_run/T3500a.stdout | 0 testsuite/tests/typecheck/should_run/T3500b.stdout | 0 testsuite/tests/typecheck/should_run/T7023.stdout | 0 testsuite/tests/typecheck/should_run/tcrun032.stdout | 0 testsuite/tests/typecheck/should_run/tcrun033.stdout | 0 testsuite/tests/typecheck/should_run/tcrun038.stdout | 0 testsuite/tests/typecheck/should_run/tcrun039.stdout | 0 testsuite/tests/typecheck/should_run/testeq2.stdout | 0 testsuite/tests/typecheck/testeq1/typecheck.testeq1.stdout | 0 72 files changed, 0 insertions(+), 0 deletions(-) From git at git.haskell.org Tue Feb 23 11:27:26 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 23 Feb 2016 11:27:26 +0000 (UTC) Subject: [commit: ghc] master: Testsuite: delete Windows line endings [skip ci] (#11631) (6d0aa9f) Message-ID: <20160223112726.C31583A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6d0aa9ffc094ec69f1fbd7f9e15bcf7535e3370b/ghc >--------------------------------------------------------------- commit 6d0aa9ffc094ec69f1fbd7f9e15bcf7535e3370b Author: Thomas Miedema Date: Mon Feb 22 21:32:51 2016 +0100 Testsuite: delete Windows line endings [skip ci] (#11631) >--------------------------------------------------------------- 6d0aa9ffc094ec69f1fbd7f9e15bcf7535e3370b libraries/base/tests/IO/hGetLine001.stdout | 16 ++++++++-------- libraries/base/tests/IO/hReady002.stdout | 0 libraries/base/tests/IO/openFile003.stdout-mingw32 | 0 .../tests/Numeric/num009.stdout-i386-unknown-mingw32 | 0 testsuite/tests/arrows/should_fail/arrowfail002.stderr | 0 testsuite/tests/cabal/cabal01/cabal01.stdout-mingw32 | 0 testsuite/tests/concurrent/should_run/conc041.stdout | 0 testsuite/tests/concurrent/should_run/conc042.stdout | 0 testsuite/tests/concurrent/should_run/conc043.stdout | 0 testsuite/tests/concurrent/should_run/conc044.stdout | 0 testsuite/tests/concurrent/should_run/conc045.stdout | 0 testsuite/tests/deSugar/should_run/T3382.stdout | 0 testsuite/tests/deriving/should_fail/T2604.stderr-7.0 | 11 ----------- testsuite/tests/deriving/should_fail/T9968a.stderr | 0 testsuite/tests/deriving/should_fail/drvfail006.stderr | 0 testsuite/tests/deriving/should_run/T4136.stdout | 0 testsuite/tests/deriving/should_run/drvrun019.stdout | 0 testsuite/tests/ffi/should_run/T1288_c.c | 0 testsuite/tests/ffi/should_run/T1288_ghci_c.c | 0 testsuite/tests/ffi/should_run/T2276_c.c | 0 testsuite/tests/ffi/should_run/T2276_ghci_c.c | 0 testsuite/tests/ffi/should_run/ffi012.stdout | 0 testsuite/tests/ffi/should_run/ffi014_cbits.c | 0 testsuite/tests/ffi/should_run/ffi014_cbits.h | 0 testsuite/tests/gadt/T3163.stderr | 0 testsuite/tests/generics/T5462Yes1.stdout | 0 testsuite/tests/ghc-api/annotations/T10278.stderr | 0 testsuite/tests/ghci.debugger/scripts/print026.stdout | 0 testsuite/tests/ghci/prog012/prog012.stderr | 0 testsuite/tests/ghci/scripts/T11098.script | 0 testsuite/tests/ghci/scripts/T2816.stderr | 0 testsuite/tests/ghci/scripts/T4127.script | 0 testsuite/tests/ghci/scripts/T4127a.script | 0 testsuite/tests/ghci/scripts/T5566.stdout | 0 testsuite/tests/ghci/scripts/ghci019.script | 0 testsuite/tests/ghci/scripts/ghci023.ghci | 0 testsuite/tests/ghci/scripts/ghci038.stderr | 0 testsuite/tests/ghci/scripts/ghci044.stdout | 0 .../tests/indexed-types/should_compile/T11361a.stderr | 0 .../tests/indexed-types/should_fail/SimpleFail15.stderr | 0 testsuite/tests/indexed-types/should_fail/T10899.stderr | 0 testsuite/tests/indexed-types/should_fail/T11136.stderr | 0 testsuite/tests/mdo/should_run/mdorun003.stdout | 0 testsuite/tests/module/mod110.stderr | 0 testsuite/tests/module/mod120.stderr | 0 testsuite/tests/module/mod138.stderr | 0 testsuite/tests/module/mod151.stderr | 0 testsuite/tests/module/mod152.stderr | 0 testsuite/tests/module/mod153.stderr | 0 testsuite/tests/module/mod158.stderr | 0 testsuite/tests/module/mod48.stderr | 0 testsuite/tests/module/mod98.stderr | 0 .../tests/parser/should_fail/NoPatternSynonyms.stderr | 0 testsuite/tests/parser/should_fail/T3811.stderr | 0 testsuite/tests/parser/should_fail/readFail001.stderr | 0 testsuite/tests/parser/should_fail/readFail031.stderr | 0 testsuite/tests/parser/should_fail/readFail042.stderr | 0 testsuite/tests/parser/should_fail/readFail043.stderr | 0 testsuite/tests/parser/unicode/T2302.stderr | 0 .../tests/partial-sigs/should_compile/T10519.stderr | 0 .../ExtraConstraintsWildcardInTypeSplice2.stderr | 0 .../ExtraConstraintsWildcardNotEnabled.stderr | 0 .../should_fail/ExtraConstraintsWildcardNotLast.stderr | 0 .../should_fail/ExtraConstraintsWildcardTwice.stderr | 0 .../should_fail/NamedWildcardInTypeSplice.stderr | 0 .../should_fail/NestedExtraConstraintsWildcard.stderr | 0 .../NestedNamedExtraConstraintsWildcard.stderr | 0 .../should_fail/PartialClassMethodSignature.stderr | 0 .../should_fail/PartialClassMethodSignature2.stderr | 0 .../should_fail/UnnamedConstraintWildcard1.stderr | 0 .../should_fail/UnnamedConstraintWildcard2.stderr | 0 .../tests/partial-sigs/should_fail/WildcardInADT1.stderr | 0 .../tests/partial-sigs/should_fail/WildcardInADT2.stderr | 0 .../tests/partial-sigs/should_fail/WildcardInADT3.stderr | 0 .../should_fail/WildcardInADTContext1.stderr | 0 .../should_fail/WildcardInADTContext2.stderr | 0 .../partial-sigs/should_fail/WildcardInDefault.stderr | 0 .../should_fail/WildcardInDefaultSignature.stderr | 0 .../partial-sigs/should_fail/WildcardInDeriving.stderr | 0 .../should_fail/WildcardInForeignExport.stderr | 0 .../should_fail/WildcardInForeignImport.stderr | 0 .../partial-sigs/should_fail/WildcardInGADT1.stderr | 0 .../partial-sigs/should_fail/WildcardInGADT2.stderr | 0 .../should_fail/WildcardInInstanceHead.stderr | 0 .../should_fail/WildcardInInstanceSig.stderr | 0 .../partial-sigs/should_fail/WildcardInNewtype.stderr | 0 .../partial-sigs/should_fail/WildcardInPatSynSig.stderr | 0 .../should_fail/WildcardInStandaloneDeriving.stderr | 0 .../should_fail/WildcardInTypeFamilyInstanceRHS.stderr | 0 .../should_fail/WildcardInTypeSynonymRHS.stderr | 0 90 files changed, 8 insertions(+), 19 deletions(-) diff --git a/libraries/base/tests/IO/hGetLine001.stdout b/libraries/base/tests/IO/hGetLine001.stdout index 3e023db..ab88bf0 100644 --- a/libraries/base/tests/IO/hGetLine001.stdout +++ b/libraries/base/tests/IO/hGetLine001.stdout @@ -5,8 +5,8 @@ import System.IO -- one version of 'cat' main = do let loop h = do b <- hIsEOF h - if b then return () - else do l <- hGetLine h; putStrLn l; loop h + if b then return () + else do l <- hGetLine h; putStrLn l; loop h loop stdin h <- openFile "hGetLine001.hs" ReadMode @@ -30,8 +30,8 @@ import System.IO -- one version of 'cat' main = do let loop h = do b <- hIsEOF h - if b then return () - else do l <- hGetLine h; putStrLn l; loop h + if b then return () + else do l <- hGetLine h; putStrLn l; loop h loop stdin h <- openFile "hGetLine001.hs" ReadMode @@ -55,8 +55,8 @@ import System.IO -- one version of 'cat' main = do let loop h = do b <- hIsEOF h - if b then return () - else do l <- hGetLine h; putStrLn l; loop h + if b then return () + else do l <- hGetLine h; putStrLn l; loop h loop stdin h <- openFile "hGetLine001.hs" ReadMode @@ -80,8 +80,8 @@ import System.IO -- one version of 'cat' main = do let loop h = do b <- hIsEOF h - if b then return () - else do l <- hGetLine h; putStrLn l; loop h + if b then return () + else do l <- hGetLine h; putStrLn l; loop h loop stdin h <- openFile "hGetLine001.hs" ReadMode diff --git a/testsuite/tests/deriving/should_fail/T2604.stderr-7.0 b/testsuite/tests/deriving/should_fail/T2604.stderr-7.0 deleted file mode 100644 index aa996e0..0000000 --- a/testsuite/tests/deriving/should_fail/T2604.stderr-7.0 +++ /dev/null @@ -1,11 +0,0 @@ - -T2604.hs:7:35: - Can't make a derived instance of `Typeable (DList a)': - You need -XDeriveDataTypeable to derive an instance for this class - In the data type declaration for `DList' - -T2604.hs:9:38: - Can't make a derived instance of `Typeable (NList a)' - (even with cunning newtype deriving): - You need -XDeriveDataTypeable to derive an instance for this class - In the newtype declaration for `NList' From git at git.haskell.org Tue Feb 23 11:27:29 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 23 Feb 2016 11:27:29 +0000 (UTC) Subject: [commit: ghc] master: Filter out -prof callstacks from test output (#11521) (176be87) Message-ID: <20160223112729.726F73A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/176be87cb28f675d87ea8f5c07eaef7ca47ff8de/ghc >--------------------------------------------------------------- commit 176be87cb28f675d87ea8f5c07eaef7ca47ff8de Author: Thomas Miedema Date: Mon Feb 22 17:44:17 2016 +0100 Filter out -prof callstacks from test output (#11521) >--------------------------------------------------------------- 176be87cb28f675d87ea8f5c07eaef7ca47ff8de testsuite/driver/testglobals.py | 3 +++ testsuite/driver/testlib.py | 19 ++++++++++++++++--- testsuite/tests/profiling/should_run/all.T | 1 + 3 files changed, 20 insertions(+), 3 deletions(-) diff --git a/testsuite/driver/testglobals.py b/testsuite/driver/testglobals.py index 0891624..6f8dd64 100644 --- a/testsuite/driver/testglobals.py +++ b/testsuite/driver/testglobals.py @@ -265,6 +265,9 @@ class TestOptions: # Extra normalisation for compiler error messages self.extra_errmsg_normaliser = lambda x: x + # Keep profiling callstacks. + self.keep_prof_callstacks = False + # The directory the test is in self.testdir = '.' diff --git a/testsuite/driver/testlib.py b/testsuite/driver/testlib.py index 9eb79e8..1ebe6a7 100644 --- a/testsuite/driver/testlib.py +++ b/testsuite/driver/testlib.py @@ -494,6 +494,13 @@ def normalise_drive_letter(name, opts): # Windows only. Change D:\\ to C:\\. _normalise_fun(name, opts, lambda str: re.sub(r'[A-Z]:\\', r'C:\\', str)) +def keep_prof_callstacks(name, opts): + """Keep profiling callstacks. + + Use together with `only_ways(prof_ways)`. + """ + opts.keep_prof_callstacks = True + def join_normalisers(*a): """ Compose functions, flattening sequences. @@ -1669,15 +1676,21 @@ def normalise_whitespace( str ): callSite_re = re.compile(r', called at (.+):[\d]+:[\d]+ in [\w\-\.]+:') -def normalise_callstacks(str): +def normalise_callstacks(s): + opts = getTestOpts() def repl(matches): location = matches.group(1) location = normalise_slashes_(location) return ', called at {0}:: in :'.format(location) # Ignore line number differences in call stacks (#10834). - str1 = re.sub(callSite_re, repl, str) + s = re.sub(callSite_re, repl, s) # Ignore the change in how we identify implicit call-stacks - return str1.replace('from ImplicitParams', 'from HasCallStack') + s = s.replace('from ImplicitParams', 'from HasCallStack') + if not opts.keep_prof_callstacks: + # Don't output prof callstacks. Test output should be + # independent from the WAY we run the test. + s = re.sub(r'CallStack \(from -prof\):(\n .*)*\n?', '', s) + return s tyCon_re = re.compile(r'TyCon\s*\d+L?\#\#\s*\d+L?\#\#\s*', flags=re.MULTILINE) diff --git a/testsuite/tests/profiling/should_run/all.T b/testsuite/tests/profiling/should_run/all.T index ae349e9..707ade3 100644 --- a/testsuite/tests/profiling/should_run/all.T +++ b/testsuite/tests/profiling/should_run/all.T @@ -15,6 +15,7 @@ test('T11489', [req_profiling, extra_clean(['T11489.prof', 'T11489.hp'])], setTestOpts(req_profiling) setTestOpts(extra_ways(['prof'])) setTestOpts(only_ways(prof_ways)) +setTestOpts(keep_prof_callstacks) extra_prof_ways = ['prof', 'prof_hc_hb', 'prof_hb', 'prof_hd', 'prof_hy', 'prof_hr'] From git at git.haskell.org Tue Feb 23 11:27:32 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 23 Feb 2016 11:27:32 +0000 (UTC) Subject: [commit: ghc] master: Testsuite: cleanup profiling/should_run/all.T (#11521) (73e4095) Message-ID: <20160223112732.238033A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/73e409555019d370f3644bdf02b37dd526de4d8a/ghc >--------------------------------------------------------------- commit 73e409555019d370f3644bdf02b37dd526de4d8a Author: Thomas Miedema Date: Sun Feb 21 13:40:56 2016 +0100 Testsuite: cleanup profiling/should_run/all.T (#11521) Refactoring only. I compared before and after with 'make slow', and it still runs each test with the same 'ways' as before. >--------------------------------------------------------------- 73e409555019d370f3644bdf02b37dd526de4d8a testsuite/tests/profiling/should_run/all.T | 143 +++++++-------------- testsuite/tests/profiling/should_run/bio001.stdout | 1 - 2 files changed, 44 insertions(+), 100 deletions(-) diff --git a/testsuite/tests/profiling/should_run/all.T b/testsuite/tests/profiling/should_run/all.T index 891303e..ae349e9 100644 --- a/testsuite/tests/profiling/should_run/all.T +++ b/testsuite/tests/profiling/should_run/all.T @@ -1,13 +1,5 @@ # Test for #1227, #1418 -extra_prof_ways = ['prof', 'prof_hc_hb', 'prof_hb', 'prof_hd', 'prof_hy', 'prof_hr'] - -test('heapprof001', - [only_ways(prof_ways), - when(have_profiling(), extra_ways(extra_prof_ways)), - extra_run_opts('7')], - compile_and_run, ['']) - test('heapprof002', [ pre_cmd('cp heapprof001.hs heapprof002.hs') , extra_clean(['heapprof002.hs']) @@ -16,107 +8,72 @@ test('heapprof002', ], compile_and_run, ['']) +test('T11489', [req_profiling, extra_clean(['T11489.prof', 'T11489.hp'])], + run_command, ['$MAKE -s --no-print-directory T11489']) + +# Below this line, run tests only with profiling ways. +setTestOpts(req_profiling) +setTestOpts(extra_ways(['prof'])) +setTestOpts(only_ways(prof_ways)) + +extra_prof_ways = ['prof', 'prof_hc_hb', 'prof_hb', 'prof_hd', 'prof_hy', 'prof_hr'] + +test('heapprof001', + [when(have_profiling(), extra_ways(extra_prof_ways)), extra_run_opts('7')], + compile_and_run, ['']) + test('T2592', - [only_ways(['profasm']), req_profiling, - extra_run_opts('+RTS -M1m -RTS'), exit_code(251)], + [only_ways(['profasm']), extra_run_opts('+RTS -M1m -RTS'), exit_code(251)], compile_and_run, ['']) -test('T3001', - [only_ways(['prof_hb']), extra_ways(['prof_hb']), req_profiling], +test('T3001', [only_ways(['prof_hb']), extra_ways(['prof_hb'])], compile_and_run, ['']) -test('T3001-2', - [only_ways(['prof_hb']), extra_ways(['prof_hb']), req_profiling], +test('T3001-2', [only_ways(['prof_hb']), extra_ways(['prof_hb'])], compile_and_run, ['-package bytestring']) -test('scc001', [req_profiling, - extra_ways(['prof']), only_ways(prof_ways), - expect_broken_for(10037,['prof'])], - # As with ioprof001, the unoptimised profile is different but - # not badly wrong (CAF attribution is different). - compile_and_run, +# As with ioprof001, the unoptimised profile is different but +# not badly wrong (CAF attribution is different). +test('scc001', [expect_broken_for(10037, ['prof'])], compile_and_run, ['-fno-state-hack -fno-full-laziness']) # Note [consistent stacks] -test('scc002', [req_profiling, - extra_ways(['prof']), only_ways(prof_ways)], - compile_and_run, - ['']) +test('scc002', [], compile_and_run, ['']) -test('scc003', [req_profiling, - extra_ways(['prof']), only_ways(prof_ways)], - compile_and_run, +test('scc003', [], compile_and_run, ['-fno-state-hack']) # Note [consistent stacks] -test('T5654', [req_profiling, - extra_ways(['prof']), only_ways(prof_ways), - expect_broken(5654)], - compile_and_run, - ['']) +test('T5654', [expect_broken(5654)], compile_and_run, ['']) -test('T5654b-O0', [req_profiling, - extra_ways(['prof']), only_ways(['prof'])], - compile_and_run, - ['']) +test('T5654b-O0', [only_ways(['prof'])], compile_and_run, ['']) -test('T5654b-O1', [req_profiling, - only_ways(['profasm'])], - compile_and_run, - ['']) +test('T5654b-O1', [only_ways(['profasm'])], compile_and_run, ['']) -test('scc005', [req_profiling, - extra_ways(['prof']), only_ways(prof_ways)], - compile_and_run, - ['']) +test('scc005', [], compile_and_run, ['']) -test('T5314', - [ only_ways(prof_ways), - extra_ways(extra_prof_ways), - req_profiling ], - compile_and_run, - ['']) +test('T5314', [extra_ways(extra_prof_ways)], compile_and_run, ['']) -test('T680', - [ req_profiling, extra_ways(['prof']), only_ways(prof_ways) ], - compile_and_run, +test('T680', [], compile_and_run, ['-fno-full-laziness']) # Note [consistent stacks] -test('T2552', - [ req_profiling, extra_ways(['prof']), only_ways(prof_ways), - expect_broken_for(10037, opt_ways)], - compile_and_run, - ['']) +test('T2552', [expect_broken_for(10037, opt_ways)], compile_and_run, ['']) -test('T949', - [ req_profiling, extra_ways(extra_prof_ways), only_ways(prof_ways) ], - compile_and_run, - ['']) - -test('ioprof', - [ req_profiling, extra_ways(['prof']), only_ways(prof_ways), - expect_broken_for(10037,['prof']), - # The results for 'prof' are fine, but the ordering changes. - # We care more about getting the optimised results right, so ignoring - # this for now. - exit_code(1) ], +test('T949', [extra_ways(extra_prof_ways)], compile_and_run, ['']) + +# The results for 'prof' are fine, but the ordering changes. +# We care more about getting the optimised results right, so ignoring +# this for now. +test('ioprof', [expect_broken_for(10037, ['prof']), exit_code(1)], compile_and_run, ['-fno-full-laziness -fno-state-hack']) # Note [consistent stacks] # These two examples are from the User's Guide: -test('prof-doc-fib', - [ req_profiling, extra_ways(['prof']), only_ways(prof_ways) ], - compile_and_run, - ['']) +test('prof-doc-fib', [], compile_and_run, ['']) -test('prof-doc-last', - [ req_profiling, extra_ways(['prof']), only_ways(prof_ways) ], - compile_and_run, - ['-fno-full-laziness']) +test('prof-doc-last', [], compile_and_run, ['-fno-full-laziness']) -test('T5559', # unicode in cost centre names - [ req_profiling, extra_ways(['prof']), only_ways(prof_ways) ], - compile_and_run, - ['']) +# unicode in cost centre names +test('T5559', [], compile_and_run, ['']) # Note [consistent stacks] # Certain optimisations can change the stacks we get out of the @@ -126,26 +83,14 @@ test('T5559', # unicode in cost centre names # -fno-state-hack # -fno-full-laziness -test('callstack001', - [ req_profiling, extra_ways(['prof']), only_ways(prof_ways), - expect_broken_for(10037,['prof'])], +test('callstack001', [expect_broken_for(10037, ['prof'])], # unoptimised results are different w.r.t. CAF attribution compile_and_run, ['-fprof-auto-calls -fno-full-laziness -fno-state-hack']) -test('callstack002', - [ req_profiling, extra_ways(['prof']), only_ways(prof_ways) ], - compile_and_run, ['-fprof-auto-calls -fno-full-laziness -fno-state-hack']) +test('callstack002', [], compile_and_run, + ['-fprof-auto-calls -fno-full-laziness -fno-state-hack']) # Should not stack overflow with -prof -auto-all -test('T5363', - [ req_profiling, extra_ways(['prof']), only_ways(prof_ways) ], - compile_and_run, ['']) - -test('profinline001', - [ req_profiling, extra_ways(['prof']), only_ways(prof_ways) ], - compile_and_run, ['']) +test('T5363', [], compile_and_run, ['']) -test('T11489', [ - req_profiling, - extra_clean(['T11489.prof', 'T11489.hp']), - ], run_command, ['$MAKE -s --no-print-directory T11489']) +test('profinline001', [], compile_and_run, ['']) diff --git a/testsuite/tests/profiling/should_run/bio001.stdout b/testsuite/tests/profiling/should_run/bio001.stdout deleted file mode 100644 index 90ee71a..0000000 --- a/testsuite/tests/profiling/should_run/bio001.stdout +++ /dev/null @@ -1 +0,0 @@ -5000050000 From git at git.haskell.org Tue Feb 23 11:27:34 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 23 Feb 2016 11:27:34 +0000 (UTC) Subject: [commit: ghc] master: Testsuite: failing profiling tests (#10037) (661aa07) Message-ID: <20160223112734.C595F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/661aa07ed1b133a5ba1ae90525115f8aca0ac92b/ghc >--------------------------------------------------------------- commit 661aa07ed1b133a5ba1ae90525115f8aca0ac92b Author: Thomas Miedema Date: Mon Feb 22 17:57:43 2016 +0100 Testsuite: failing profiling tests (#10037) These tests fail not only for WAY=prof, but also for WAY=profllvm. >--------------------------------------------------------------- 661aa07ed1b133a5ba1ae90525115f8aca0ac92b testsuite/tests/profiling/should_run/all.T | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/testsuite/tests/profiling/should_run/all.T b/testsuite/tests/profiling/should_run/all.T index 707ade3..41597a4 100644 --- a/testsuite/tests/profiling/should_run/all.T +++ b/testsuite/tests/profiling/should_run/all.T @@ -19,6 +19,10 @@ setTestOpts(keep_prof_callstacks) extra_prof_ways = ['prof', 'prof_hc_hb', 'prof_hb', 'prof_hd', 'prof_hy', 'prof_hr'] +expect_broken_for_10037 = expect_broken_for( + 10037, + [w for w in prof_ways if w not in opt_ways]) # e.g. prof and profllvm + test('heapprof001', [when(have_profiling(), extra_ways(extra_prof_ways)), extra_run_opts('7')], compile_and_run, ['']) @@ -35,7 +39,7 @@ test('T3001-2', [only_ways(['prof_hb']), extra_ways(['prof_hb'])], # As with ioprof001, the unoptimised profile is different but # not badly wrong (CAF attribution is different). -test('scc001', [expect_broken_for(10037, ['prof'])], compile_and_run, +test('scc001', [expect_broken_for_10037], compile_and_run, ['-fno-state-hack -fno-full-laziness']) # Note [consistent stacks] test('scc002', [], compile_and_run, ['']) @@ -56,15 +60,14 @@ test('T5314', [extra_ways(extra_prof_ways)], compile_and_run, ['']) test('T680', [], compile_and_run, ['-fno-full-laziness']) # Note [consistent stacks] -test('T2552', [expect_broken_for(10037, opt_ways)], compile_and_run, ['']) +test('T2552', [expect_broken_for_10037], compile_and_run, ['']) test('T949', [extra_ways(extra_prof_ways)], compile_and_run, ['']) # The results for 'prof' are fine, but the ordering changes. # We care more about getting the optimised results right, so ignoring # this for now. -test('ioprof', [expect_broken_for(10037, ['prof']), exit_code(1)], - compile_and_run, +test('ioprof', [expect_broken_for_10037, exit_code(1)], compile_and_run, ['-fno-full-laziness -fno-state-hack']) # Note [consistent stacks] # These two examples are from the User's Guide: @@ -84,7 +87,7 @@ test('T5559', [], compile_and_run, ['']) # -fno-state-hack # -fno-full-laziness -test('callstack001', [expect_broken_for(10037, ['prof'])], +test('callstack001', [expect_broken_for_10037], # unoptimised results are different w.r.t. CAF attribution compile_and_run, ['-fprof-auto-calls -fno-full-laziness -fno-state-hack']) From git at git.haskell.org Tue Feb 23 11:27:38 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 23 Feb 2016 11:27:38 +0000 (UTC) Subject: [commit: ghc] master: Allow combining characters in identifiers (#7650) (2aee419) Message-ID: <20160223112738.036F23A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2aee41960aa00fe09a2cd1983e02c15e06013037/ghc >--------------------------------------------------------------- commit 2aee41960aa00fe09a2cd1983e02c15e06013037 Author: Thomas Miedema Date: Sat Feb 20 23:50:28 2016 +0100 Allow combining characters in identifiers (#7650) Reviewed by: austin, rwbarton Differential Revision: https://phabricator.haskell.org/D1938 >--------------------------------------------------------------- 2aee41960aa00fe09a2cd1983e02c15e06013037 compiler/basicTypes/Lexeme.hs | 5 +++-- compiler/parser/Lexer.x | 12 ++++++------ testsuite/tests/parser/unicode/T7650.hs | 11 +++++++++++ .../tests/parser/unicode/T7650.stdout | 0 testsuite/tests/parser/unicode/all.T | 1 + 5 files changed, 21 insertions(+), 8 deletions(-) diff --git a/compiler/basicTypes/Lexeme.hs b/compiler/basicTypes/Lexeme.hs index 9e75376..22515c1 100644 --- a/compiler/basicTypes/Lexeme.hs +++ b/compiler/basicTypes/Lexeme.hs @@ -194,9 +194,10 @@ okIdChar c = case generalCategory c of LowercaseLetter -> True TitlecaseLetter -> True ModifierLetter -> True -- See #10196 - OtherLetter -> True + OtherLetter -> True -- See #1103 + NonSpacingMark -> True -- See #7650 DecimalNumber -> True - OtherNumber -> True + OtherNumber -> True -- See #4373 _ -> c == '\'' || c == '_' -- | Is this character acceptable in a symbol (after the first char)? diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x index 5f3bdee..3f959f2 100644 --- a/compiler/parser/Lexer.x +++ b/compiler/parser/Lexer.x @@ -155,8 +155,8 @@ $binit = 0-1 $octit = 0-7 $hexit = [$decdigit A-F a-f] -$modifier = \x07 -- Trick Alex into handling Unicode. See alexGetByte. -$idchar = [$small $large $digit $modifier \'] +$uniidchar = \x07 -- Trick Alex into handling Unicode. See alexGetByte. +$idchar = [$small $large $digit $uniidchar \'] $pragmachar = [$small $large $digit] @@ -1874,10 +1874,10 @@ alexGetByte (AI loc s) symbol = '\x04' space = '\x05' other_graphic = '\x06' - modifier = '\x07' + uniidchar = '\x07' adj_c - | c <= '\x06' = non_graphic + | c <= '\x07' = non_graphic | c <= '\x7f' = c -- Alex doesn't handle Unicode, so when Unicode -- character is encountered we output these values @@ -1891,9 +1891,9 @@ alexGetByte (AI loc s) UppercaseLetter -> upper LowercaseLetter -> lower TitlecaseLetter -> upper - ModifierLetter -> modifier -- see #10196 + ModifierLetter -> uniidchar -- see #10196 OtherLetter -> lower -- see #1103 - NonSpacingMark -> other_graphic + NonSpacingMark -> uniidchar -- see #7650 SpacingCombiningMark -> other_graphic EnclosingMark -> other_graphic DecimalNumber -> digit diff --git a/testsuite/tests/parser/unicode/T7650.hs b/testsuite/tests/parser/unicode/T7650.hs new file mode 100644 index 0000000..c474bc0 --- /dev/null +++ b/testsuite/tests/parser/unicode/T7650.hs @@ -0,0 +1,11 @@ +main = print sp?n?alTap + where sp?n?alTap = 11 + +-- n? is a combining character sequence. We now allow it to be used in +-- identifiers (#7650). +-- +-- > map generalCategory "n?" +-- [LowercaseLetter,NonSpacingMark] +-- +-- > map show "n?" +-- ["'n'","'\776'"] diff --git a/libraries/ghc-prim/tests/T6026.stdout b/testsuite/tests/parser/unicode/T7650.stdout similarity index 100% copy from libraries/ghc-prim/tests/T6026.stdout copy to testsuite/tests/parser/unicode/T7650.stdout diff --git a/testsuite/tests/parser/unicode/all.T b/testsuite/tests/parser/unicode/all.T index 6972a0d..36554cc 100644 --- a/testsuite/tests/parser/unicode/all.T +++ b/testsuite/tests/parser/unicode/all.T @@ -25,3 +25,4 @@ test('T7671', normal, compile, ['']) # TODO: This test ought to be run in a non-UTF8 locale, but this is not yet # supported by the test suite (see 10907) test('T10907', normal, compile, ['']) +test('T7650', normal, compile, ['']) From git at git.haskell.org Tue Feb 23 19:46:07 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 23 Feb 2016 19:46:07 +0000 (UTC) Subject: [commit: ghc] master: Testsuite: MAKEFLAGS is magic, do not unexport it (a3e0e93) Message-ID: <20160223194607.169C43A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a3e0e9365e4f195d5dad9389955869744f2cdba9/ghc >--------------------------------------------------------------- commit a3e0e9365e4f195d5dad9389955869744f2cdba9 Author: Thomas Miedema Date: Tue Feb 23 19:27:43 2016 +0100 Testsuite: MAKEFLAGS is magic, do not unexport it Call `+$(PYTHON) ...` to fix #11569 instead. See Note [Communicating options and variables to a submake]. >--------------------------------------------------------------- a3e0e9365e4f195d5dad9389955869744f2cdba9 testsuite/mk/boilerplate.mk | 5 +++- testsuite/mk/test.mk | 67 ++++++++++++++++++++++++++++++++++++++++++++- 2 files changed, 70 insertions(+), 2 deletions(-) diff --git a/testsuite/mk/boilerplate.mk b/testsuite/mk/boilerplate.mk index 4bae8a1..b51cc89 100644 --- a/testsuite/mk/boilerplate.mk +++ b/testsuite/mk/boilerplate.mk @@ -1,4 +1,5 @@ -unexport MAKEFLAGS # See Trac #11569 +# Don't blindly unexport MAKEFLAGS, see +# Note [Communicating options and variables to a submake]. # Eliminate use of the built-in implicit rules, and clear out the default list # of suffixes for suffix rules. Speeds up make quite a bit. Both are needed @@ -126,6 +127,8 @@ IMPLICIT_COMPILER = NO endif IN_TREE_COMPILER = NO +# Note [The TEST_HC variable] +# # As values of TEST_HC passed in by the user, we want to support: # * both "ghc" and "/usr/bin/ghc" # We use 'which' to convert the former to the latter. diff --git a/testsuite/mk/test.mk b/testsuite/mk/test.mk index 013d67f..aa20a42 100644 --- a/testsuite/mk/test.mk +++ b/testsuite/mk/test.mk @@ -277,8 +277,11 @@ $(TIMEOUT_PROGRAM) : @echo "Looks like you don't have timeout, building it first..." $(MAKE) -C $(TOP)/timeout all +# Use a '+' to make sure that any sub-MAKEs that python spawns can +# communicate with the topmake. +# See Note [Communicating options and variables to a submake] test: $(TIMEOUT_PROGRAM) - $(PYTHON) $(RUNTESTS) $(RUNTEST_OPTS) \ + +$(PYTHON) $(RUNTESTS) $(RUNTEST_OPTS) \ $(patsubst %, --only=%, $(TEST)) \ $(patsubst %, --only=%, $(TESTS)) \ $(patsubst %, --way=%, $(WAY)) \ @@ -302,3 +305,65 @@ slow: list_broken: $(MAKE) list_broken=YES +# Note [Communicating options and variables to a submake] +# +# Consider the following scenario: +# * A test foo is defined as +# test('foo', [], run_command, ['$MAKE footarget']) +# * A user calls 'make -j24 TEST=foo' +# +# What happens is something like this: +# * make (topmake) reads all options and variables given on the commandline +# and adds them to the variable MAKEFLAGS [1]. This variable is exported by +# default [1], so submakes can use them. +# * The 'test' target calls 'python ..' +# * Python calls 'make footarget' (submake) +# +# **First question**: what happens to the '-j24' option when calling make +# recursively? +# +# From +# https://www.gnu.org/software/make/manual/html_node/Variables_002fRecursion.html: +# +# "The ?-j? option is a special case (see Parallel Execution). If you set +# it to some numeric value ?N? and your operating system supports it (most +# any UNIX system will; others typically won?t), the parent make and all the +# sub-makes will communicate to ensure that there are only ?N? jobs running +# at the same time between them all." +# +# In our scenario, the user will actually see the following warning [2]: +# +# ?warning: jobserver unavailable: using -j1. Add `+' to parent make rule.? +# +# The problem is that topmake and submake don't know about eachother, since +# python is in between. To let them communicate, we have to use the '+' +# option, by calling '+python' instead of 'python' [2]. This works, +# magically, and fixes #11569. +# +# **Second question**: can't we just unexport MAKEFLAGS, instead of using +# that '+' trick? The testsuite driver (python) mangages parallelism by +# itself already, so '-j24' doesn't do the right thing anyway. You have to +# use 'make test THREADS=24'. Unexporting MAKEFLAGS would mean ignoring +# any '-j' flags passed to make (either from the user calling 'make -j' +# explicitly or from having MAKEFLAGS=-j set in the shell, see #11569). +# +# This almost works, except when calling 'make fast/slow/accept TEST_HC=ghc' +# instead of just 'make test'. These targets call 'make test FAST=YES' +# recursively (and 'make test' calls python, as before). +# +# The problem is that in boilerplate.mk we try to override the variable +# TEST_HC (See Note [The TEST_HC variable]). Somewhere somehow this +# information (of us wanting to update TEST_HC) gets lost in the process, +# resulting in the final TEST_HC always getting set to the inplace compiler. +# It seems possible to remedy this yet again by exporting TEST_HC explicitly, +# but I didn't understand nor test it thoroughly (what about the other +# variables we override, see calls to canonicalise), and the '+' trick seems +# to work at least equally well (just don't run something like +# 'make test fast slow accept'). +# +# Tests: +# * `make TEST=T3307 -j2` should not show a warning. +# * `make TEST=tc001 TEST_HC=ghc fast` should not use the inplace compiler. +# +# [1] https://www.gnu.org/software/make/manual/html_node/Variables_002fRecursion.html +# [2] https://www.gnu.org/software/make/manual/html_node/Error-Messages.html From git at git.haskell.org Tue Feb 23 22:51:46 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 23 Feb 2016 22:51:46 +0000 (UTC) Subject: [commit: ghc] master: Extend `-Wunrecognised-warning-flag` to cover `-f(no-)warn-*` (32a9a7f) Message-ID: <20160223225146.515AA3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/32a9a7f514bdd33ff72a673ade2591e4e815be58/ghc >--------------------------------------------------------------- commit 32a9a7f514bdd33ff72a673ade2591e4e815be58 Author: Herbert Valerio Riedel Date: Tue Feb 23 23:13:33 2016 +0100 Extend `-Wunrecognised-warning-flag` to cover `-f(no-)warn-*` The original implementation for #11429 covers only `-W*` flags. However, old packages will continue to use `-f(no-)warn-*` flags, so it seems desirable to have `-Wunrecognised-warning-flag` apply to those legacy aliases as well. Reviewed By: bgamari Differential Revision: https://phabricator.haskell.org/D1942 >--------------------------------------------------------------- 32a9a7f514bdd33ff72a673ade2591e4e815be58 compiler/main/DynFlags.hs | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 52da300..62fa936 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -2935,14 +2935,16 @@ dynamic_flags_deps = [ wWarningFlagsDeps ++ map (mkFlag turnOff "fno-warn-" unSetWarningFlag . hideFlag) wWarningFlagsDeps + ++ [ (NotDeprecated, unrecognisedWarning "W") + , (NotDeprecated, unrecognisedWarning "fwarn-") + , (NotDeprecated, unrecognisedWarning "fno-warn-") ] ++ map (mkFlag turnOn "f" setExtensionFlag ) fLangFlagsDeps ++ map (mkFlag turnOff "fno-" unSetExtensionFlag) fLangFlagsDeps ++ map (mkFlag turnOn "X" setExtensionFlag ) xFlagsDeps ++ map (mkFlag turnOff "XNo" unSetExtensionFlag) xFlagsDeps ++ map (mkFlag turnOn "X" setLanguage ) languageFlagsDeps ++ map (mkFlag turnOn "X" setSafeHaskell ) safeHaskellFlagsDeps - ++ [ (NotDeprecated, unrecognisedWarning) - , make_dep_flag defFlag "XGenerics" + ++ [ make_dep_flag defFlag "XGenerics" (NoArg $ return ()) ("it does nothing; look into -XDefaultSignatures " ++ "and -XDeriveGeneric for generic programming support.") @@ -2953,13 +2955,13 @@ dynamic_flags_deps = [ -- | This is where we handle unrecognised warning flags. We only issue a warning -- if -Wunrecognised-warning-flags is set. See Trac #11429 for context. -unrecognisedWarning :: Flag (CmdLineP DynFlags) -unrecognisedWarning = defFlag "W" (Prefix action) +unrecognisedWarning :: String -> Flag (CmdLineP DynFlags) +unrecognisedWarning pfx = defFlag pfx (Prefix action) where action :: String -> EwM (CmdLineP DynFlags) () action flag = do f <- wopt Opt_WarnUnrecognisedWarningFlags <$> liftEwM getCmdLineState - when f $ addWarn $ "unrecognised warning flag: -W" ++ flag + when f $ addWarn $ "unrecognised warning flag: -" ++ pfx ++ flag -- See Note [Supporting CLI completion] package_flags_deps :: [(Deprecation, Flag (CmdLineP DynFlags))] From git at git.haskell.org Tue Feb 23 22:54:22 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 23 Feb 2016 22:54:22 +0000 (UTC) Subject: [commit: ghc] master: Follow-up to 32a9a7f514bdd33ff72a673ade (ce36115) Message-ID: <20160223225422.C230C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ce36115b369510c51f402073174d82d0d1244589/ghc >--------------------------------------------------------------- commit ce36115b369510c51f402073174d82d0d1244589 Author: Herbert Valerio Riedel Date: Tue Feb 23 23:55:23 2016 +0100 Follow-up to 32a9a7f514bdd33ff72a673ade ...forgot to stage/add this alpha renaming to the previous commit >--------------------------------------------------------------- ce36115b369510c51f402073174d82d0d1244589 compiler/main/DynFlags.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 62fa936..f92cf9b 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -2956,12 +2956,12 @@ dynamic_flags_deps = [ -- | This is where we handle unrecognised warning flags. We only issue a warning -- if -Wunrecognised-warning-flags is set. See Trac #11429 for context. unrecognisedWarning :: String -> Flag (CmdLineP DynFlags) -unrecognisedWarning pfx = defFlag pfx (Prefix action) +unrecognisedWarning prefix = defFlag prefix (Prefix action) where action :: String -> EwM (CmdLineP DynFlags) () action flag = do f <- wopt Opt_WarnUnrecognisedWarningFlags <$> liftEwM getCmdLineState - when f $ addWarn $ "unrecognised warning flag: -" ++ pfx ++ flag + when f $ addWarn $ "unrecognised warning flag: -" ++ prefix ++ flag -- See Note [Supporting CLI completion] package_flags_deps :: [(Deprecation, Flag (CmdLineP DynFlags))] From git at git.haskell.org Tue Feb 23 22:56:28 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 23 Feb 2016 22:56:28 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Extend `-Wunrecognised-warning-flag` to cover `-f(no-)warn-*` (3d345e8) Message-ID: <20160223225628.97F223A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/3d345e8f1551b21980aeef9110463ecd2ee2686f/ghc >--------------------------------------------------------------- commit 3d345e8f1551b21980aeef9110463ecd2ee2686f Author: Herbert Valerio Riedel Date: Tue Feb 23 23:13:33 2016 +0100 Extend `-Wunrecognised-warning-flag` to cover `-f(no-)warn-*` The original implementation for #11429 covers only `-W*` flags. However, old packages will continue to use `-f(no-)warn-*` flags, so it seems desirable to have `-Wunrecognised-warning-flag` apply to those legacy aliases as well. (cherry picked from commit 32a9a7f514bdd33ff72a673ade2591e4e815be58) >--------------------------------------------------------------- 3d345e8f1551b21980aeef9110463ecd2ee2686f compiler/main/DynFlags.hs | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index c02e0d3..57fd140 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -2931,14 +2931,16 @@ dynamic_flags_deps = [ wWarningFlagsDeps ++ map (mkFlag turnOff "fno-warn-" unSetWarningFlag . hideFlag) wWarningFlagsDeps + ++ [ (NotDeprecated, unrecognisedWarning "W") + , (NotDeprecated, unrecognisedWarning "fwarn-") + , (NotDeprecated, unrecognisedWarning "fno-warn-") ] ++ map (mkFlag turnOn "f" setExtensionFlag ) fLangFlagsDeps ++ map (mkFlag turnOff "fno-" unSetExtensionFlag) fLangFlagsDeps ++ map (mkFlag turnOn "X" setExtensionFlag ) xFlagsDeps ++ map (mkFlag turnOff "XNo" unSetExtensionFlag) xFlagsDeps ++ map (mkFlag turnOn "X" setLanguage ) languageFlagsDeps ++ map (mkFlag turnOn "X" setSafeHaskell ) safeHaskellFlagsDeps - ++ [ (NotDeprecated, unrecognisedWarning) - , make_dep_flag defFlag "XGenerics" + ++ [ make_dep_flag defFlag "XGenerics" (NoArg $ return ()) ("it does nothing; look into -XDefaultSignatures " ++ "and -XDeriveGeneric for generic programming support.") @@ -2949,13 +2951,13 @@ dynamic_flags_deps = [ -- | This is where we handle unrecognised warning flags. We only issue a warning -- if -Wunrecognised-warning-flags is set. See Trac #11429 for context. -unrecognisedWarning :: Flag (CmdLineP DynFlags) -unrecognisedWarning = defFlag "W" (Prefix action) +unrecognisedWarning :: String -> Flag (CmdLineP DynFlags) +unrecognisedWarning prefix = defFlag prefix (Prefix action) where action :: String -> EwM (CmdLineP DynFlags) () action flag = do f <- wopt Opt_WarnUnrecognisedWarningFlags <$> liftEwM getCmdLineState - when f $ addWarn $ "unrecognised warning flag: -W" ++ flag + when f $ addWarn $ "unrecognised warning flag: -" ++ prefix ++ flag -- See Note [Supporting CLI completion] package_flags_deps :: [(Deprecation, Flag (CmdLineP DynFlags))] From git at git.haskell.org Wed Feb 24 19:47:12 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 24 Feb 2016 19:47:12 +0000 (UTC) Subject: [commit: ghc] branch 'wip/runtime-rep' created Message-ID: <20160224194712.C9A543A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/runtime-rep Referencing: d8c64e86361f6766ebe26a262bb229fb8301a42a From git at git.haskell.org Wed Feb 24 19:47:15 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 24 Feb 2016 19:47:15 +0000 (UTC) Subject: [commit: ghc] wip/runtime-rep: Address #11471 by putting RuntimeRep in kinds. (d8c64e8) Message-ID: <20160224194715.DAA813A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/runtime-rep Link : http://ghc.haskell.org/trac/ghc/changeset/d8c64e86361f6766ebe26a262bb229fb8301a42a/ghc >--------------------------------------------------------------- commit d8c64e86361f6766ebe26a262bb229fb8301a42a Author: Richard Eisenberg Date: Thu Feb 4 10:42:56 2016 -0500 Address #11471 by putting RuntimeRep in kinds. See Note [TYPE] in TysPrim. There are still some outstanding pieces in #11471 though, so this doesn't actually nail the bug. This commit also contains a few performance improvements: * Short-cut equality checking of nullary type syns * Compare types before kinds in eqType * INLINE coreViewOneStarKind * Store tycon binders separately from kinds. This resulted in a ~10% performance improvement in compiling the Cabal package. No change in functionality other than performance. (This affects the interface file format, though.) This commit updates the haddock submodule. >--------------------------------------------------------------- d8c64e86361f6766ebe26a262bb229fb8301a42a compiler/basicTypes/DataCon.hs | 22 +- compiler/basicTypes/MkId.hs | 29 +- compiler/basicTypes/PatSyn.hs | 4 +- compiler/coreSyn/CoreLint.hs | 4 +- compiler/coreSyn/CorePrep.hs | 2 +- compiler/coreSyn/MkCore.hs | 20 +- compiler/deSugar/DsBinds.hs | 2 +- compiler/deSugar/DsForeign.hs | 8 +- compiler/deSugar/DsUtils.hs | 4 +- compiler/ghci/RtClosureInspect.hs | 4 +- compiler/iface/BinIface.hs | 2 +- compiler/iface/BuildTyCl.hs | 9 +- compiler/iface/IfaceEnv.hs | 2 +- compiler/iface/IfaceSyn.hs | 148 +++++----- compiler/iface/IfaceType.hs | 119 ++++++-- compiler/iface/MkIface.hs | 35 +-- compiler/iface/TcIface.hs | 96 +++--- compiler/prelude/PrelNames.hs | 38 ++- compiler/prelude/PrimOp.hs | 2 +- compiler/prelude/TysPrim.hs | 192 +++++++----- compiler/prelude/TysWiredIn.hs | 267 +++++++++++++---- compiler/prelude/TysWiredIn.hs-boot | 22 +- compiler/typecheck/Inst.hs | 127 +++++++- compiler/typecheck/TcBinds.hs | 2 +- compiler/typecheck/TcCanonical.hs | 4 +- compiler/typecheck/TcDeriv.hs | 2 +- compiler/typecheck/TcErrors.hs | 26 +- compiler/typecheck/TcExpr.hs | 12 +- compiler/typecheck/TcHsSyn.hs | 26 +- compiler/typecheck/TcHsType.hs | 325 +++++++-------------- compiler/typecheck/TcInstDcls.hs | 7 +- compiler/typecheck/TcInteract.hs | 2 +- compiler/typecheck/TcMType.hs | 34 ++- compiler/typecheck/TcPat.hs | 4 +- compiler/typecheck/TcPatSyn.hs | 18 +- compiler/typecheck/TcRnDriver.hs | 2 +- compiler/typecheck/TcSMonad.hs | 6 +- compiler/typecheck/TcSimplify.hs | 22 +- compiler/typecheck/TcSplice.hs | 36 +-- compiler/typecheck/TcTyClsDecls.hs | 196 +++++++------ compiler/typecheck/TcType.hs | 12 +- compiler/typecheck/TcTypeNats.hs | 12 +- compiler/typecheck/TcUnify.hs | 19 +- compiler/typecheck/TcValidity.hs | 4 +- compiler/types/Kind.hs | 30 +- compiler/types/TyCoRep.hs | 92 +++--- compiler/types/TyCoRep.hs-boot | 2 + compiler/types/TyCon.hs | 302 ++++++++++++------- compiler/types/Type.hs | 133 +++++---- compiler/utils/Util.hs | 16 + compiler/vectorise/Vectorise/Exp.hs | 2 +- compiler/vectorise/Vectorise/Generic/PData.hs | 3 +- compiler/vectorise/Vectorise/Type/Env.hs | 2 +- compiler/vectorise/Vectorise/Type/TyConDecl.hs | 5 +- libraries/base/Data/Data.hs | 2 +- libraries/base/Data/Typeable/Internal.hs | 28 +- libraries/base/GHC/Err.hs | 8 +- libraries/base/GHC/Exts.hs | 4 +- libraries/base/tests/T11334.hs | 4 +- libraries/ghc-prim/GHC/Types.hs | 73 ++++- testsuite/tests/dependent/should_compile/T11405.hs | 2 +- .../dependent/should_fail/BadTelescope4.stderr | 6 +- .../tests/dependent/should_fail/TypeSkolEscape.hs | 2 +- .../dependent/should_fail/TypeSkolEscape.stderr | 10 +- testsuite/tests/ghci/scripts/T4175.stdout | 10 +- testsuite/tests/ghci/scripts/T7627.stdout | 8 +- testsuite/tests/ghci/scripts/T7939.stdout | 19 +- testsuite/tests/ghci/scripts/T8535.stdout | 2 +- testsuite/tests/ghci/scripts/T9181.stdout | 18 +- testsuite/tests/ghci/scripts/ghci020.stdout | 2 +- testsuite/tests/ghci/should_run/T10145.stdout | 2 +- .../indexed-types/should_compile/T3017.stderr | 4 +- .../indexed-types/should_fail/ClosedFam3.stderr | 45 ++- .../indexed-types/should_fail/Overlap4.stderr | 9 +- .../indexed-types/should_fail/SimpleFail1a.stderr | 3 +- .../indexed-types/should_fail/TyFamArity1.stderr | 8 +- .../indexed-types/should_fail/TyFamArity2.stderr | 13 +- .../tests/indexed-types/should_run/T11465a.hs | 2 +- .../tests/partial-sigs/should_compile/ADT.stderr | 1 - .../should_compile/DataFamilyInstanceLHS.stderr | 1 - .../partial-sigs/should_compile/Meltdown.stderr | 3 +- .../NamedWildcardInDataFamilyInstanceLHS.stderr | 1 - .../NamedWildcardInTypeFamilyInstanceLHS.stderr | 3 +- .../partial-sigs/should_compile/SkipMany.stderr | 1 - .../should_compile/TypeFamilyInstanceLHS.stderr | 3 +- testsuite/tests/perf/compiler/all.T | 3 +- testsuite/tests/polykinds/T11399.stderr | 4 +- testsuite/tests/polykinds/T7328.stderr | 2 +- testsuite/tests/polykinds/TidyClassKinds.stderr | 2 +- testsuite/tests/roles/should_compile/Roles1.stderr | 7 - testsuite/tests/roles/should_compile/Roles2.stderr | 2 - testsuite/tests/roles/should_compile/Roles3.stderr | 6 +- testsuite/tests/roles/should_compile/T8958.stderr | 1 - .../tests/simplCore/should_compile/T9400.stderr | 2 +- .../simplCore/should_compile/spec-inline.stderr | 2 +- testsuite/tests/th/TH_Roles2.stderr | 5 +- .../tests/typecheck/should_compile/tc231.stderr | 2 - .../typecheck/should_run/KindInvariant.stderr | 3 +- testsuite/tests/typecheck/should_run/TypeOf.hs | 4 +- testsuite/tests/typecheck/should_run/TypeOf.stdout | 4 +- utils/genprimopcode/Main.hs | 2 +- utils/haddock | 2 +- 102 files changed, 1700 insertions(+), 1166 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 d8c64e86361f6766ebe26a262bb229fb8301a42a From git at git.haskell.org Wed Feb 24 19:49:16 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 24 Feb 2016 19:49:16 +0000 (UTC) Subject: [commit: ghc] master's head updated: Address #11471 by putting RuntimeRep in kinds. (d8c64e8) Message-ID: <20160224194916.D33D43A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'master' now includes: d8c64e8 Address #11471 by putting RuntimeRep in kinds. From git at git.haskell.org Wed Feb 24 22:05:29 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 24 Feb 2016 22:05:29 +0000 (UTC) Subject: [commit: ghc] master: Remove "use mask" from StgAlt syntax (a9dc62a) Message-ID: <20160224220529.0D0D93A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a9dc62ae3a28a7c5fc173895f148e65c6ffc14de/ghc >--------------------------------------------------------------- commit a9dc62ae3a28a7c5fc173895f148e65c6ffc14de Author: ?mer Sinan A?acan Date: Wed Feb 24 16:22:36 2016 -0500 Remove "use mask" from StgAlt syntax Reviewers: austin, bgamari, simonpj Reviewed By: simonpj Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1933 >--------------------------------------------------------------- a9dc62ae3a28a7c5fc173895f148e65c6ffc14de compiler/codeGen/StgCmmBind.hs | 2 +- compiler/codeGen/StgCmmExpr.hs | 10 +++++----- compiler/profiling/SCCfinal.hs | 4 ++-- compiler/simplStg/StgStats.hs | 2 +- compiler/simplStg/UnariseStg.hs | 25 ++++++++----------------- compiler/stgSyn/CoreToStg.hs | 8 ++------ compiler/stgSyn/StgLint.hs | 8 ++++---- compiler/stgSyn/StgSyn.hs | 8 ++------ 8 files changed, 25 insertions(+), 42 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 a9dc62ae3a28a7c5fc173895f148e65c6ffc14de From git at git.haskell.org Thu Feb 25 14:40:33 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 25 Feb 2016 14:40:33 +0000 (UTC) Subject: [commit: ghc] master: TyCoRep: Add haddock sections (009a999) Message-ID: <20160225144033.14C8A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/009a99979437314a4cefa07b55a80fd13ea07c8c/ghc >--------------------------------------------------------------- commit 009a99979437314a4cefa07b55a80fd13ea07c8c Author: Ben Gamari Date: Wed Feb 24 11:20:26 2016 +0100 TyCoRep: Add haddock sections >--------------------------------------------------------------- 009a99979437314a4cefa07b55a80fd13ea07c8c compiler/types/TyCoRep.hs | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/compiler/types/TyCoRep.hs b/compiler/types/TyCoRep.hs index 5624730..4c60b6e 100644 --- a/compiler/types/TyCoRep.hs +++ b/compiler/types/TyCoRep.hs @@ -30,12 +30,12 @@ module TyCoRep ( PredType, ThetaType, -- Synonyms VisibilityFlag(..), - -- Coercions + -- * Coercions Coercion(..), LeftOrRight(..), UnivCoProvenance(..), CoercionHole(..), CoercionN, CoercionR, CoercionP, KindCoercion, - -- Functions over types + -- * Functions over types mkTyConTy, mkTyVarTy, mkTyVarTys, mkFunTy, mkFunTys, mkForAllTys, isLiftedTypeKind, isUnliftedTypeKind, @@ -43,14 +43,14 @@ module TyCoRep ( isRuntimeRepKindedTy, dropRuntimeRepArgs, sameVis, - -- Functions over binders + -- * Functions over binders binderType, delBinderVar, isInvisibleBinder, isVisibleBinder, isNamedBinder, isAnonBinder, - -- Functions over coercions + -- * Functions over coercions pickLR, - -- Pretty-printing + -- * Pretty-printing pprType, pprParendType, pprTypeApp, pprTvBndr, pprTvBndrs, pprTyThing, pprTyThingCategory, pprSigmaType, pprTheta, pprForAll, pprForAllImplicit, pprUserForAll, From git at git.haskell.org Thu Feb 25 14:40:35 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 25 Feb 2016 14:40:35 +0000 (UTC) Subject: [commit: ghc] master: base: A selection of fixes to the comments in GHC.Stats (8e19d3a) Message-ID: <20160225144035.B4D703A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8e19d3a3066b883d9bc10a75c8d3183907272a9f/ghc >--------------------------------------------------------------- commit 8e19d3a3066b883d9bc10a75c8d3183907272a9f Author: David Turner Date: Thu Feb 25 14:46:28 2016 +0100 base: A selection of fixes to the comments in GHC.Stats Use `-- |` comments throughout. Note that numByteUsageSamples is also the number of major GCs Note that numGcs counts GCs for all generations Note that 'current' really means 'at the end of the last major GC' Reviewers: ezyang, hvr, simonmar, austin, bgamari Reviewed By: ezyang, simonmar, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1929 GHC Trac Issues: #11603 >--------------------------------------------------------------- 8e19d3a3066b883d9bc10a75c8d3183907272a9f libraries/base/GHC/Stats.hsc | 48 ++++++++++++++++++++++++++++---------------- 1 file changed, 31 insertions(+), 17 deletions(-) diff --git a/libraries/base/GHC/Stats.hsc b/libraries/base/GHC/Stats.hsc index 0e501da..73e2de9 100644 --- a/libraries/base/GHC/Stats.hsc +++ b/libraries/base/GHC/Stats.hsc @@ -39,26 +39,37 @@ foreign import ccall "getGCStatsEnabled" getGCStatsEnabled :: IO Bool -- I'm probably violating a bucket of constraints here... oops. --- | Global garbage collection and memory statistics. +-- | Statistics about memory usage and the garbage collector. Apart from +-- 'currentBytesUsed' and 'currentBytesSlop' all are cumulative values since +-- the program started. -- -- @since 4.5.0.0 data GCStats = GCStats - { bytesAllocated :: !Int64 -- ^ Total number of bytes allocated - , numGcs :: !Int64 -- ^ Number of garbage collections performed - , maxBytesUsed :: !Int64 -- ^ Maximum number of live bytes seen so far - , numByteUsageSamples :: !Int64 -- ^ Number of byte usage samples taken - + { -- | Total number of bytes allocated + bytesAllocated :: !Int64 + -- | Number of garbage collections performed (any generation, major and + -- minor) + , numGcs :: !Int64 + -- | Maximum number of live bytes seen so far + , maxBytesUsed :: !Int64 + -- | Number of byte usage samples taken, or equivalently + -- the number of major GCs performed. + , numByteUsageSamples :: !Int64 -- | Sum of all byte usage samples, can be used with -- 'numByteUsageSamples' to calculate averages with -- arbitrary weighting (if you are sampling this record multiple -- times). , cumulativeBytesUsed :: !Int64 - , bytesCopied :: !Int64 -- ^ Number of bytes copied during GC - , currentBytesUsed :: !Int64 -- ^ Current number of live bytes - , currentBytesSlop :: !Int64 -- ^ Current number of bytes lost to slop - , maxBytesSlop :: !Int64 -- ^ Maximum number of bytes lost to slop at any one time so far - , peakMegabytesAllocated :: !Int64 -- ^ Maximum number of megabytes allocated - + -- | Number of bytes copied during GC + , bytesCopied :: !Int64 + -- | Number of live bytes at the end of the last major GC + , currentBytesUsed :: !Int64 + -- | Current number of bytes lost to slop + , currentBytesSlop :: !Int64 + -- | Maximum number of bytes lost to slop at any one time so far + , maxBytesSlop :: !Int64 + -- | Maximum number of megabytes allocated + , peakMegabytesAllocated :: !Int64 -- | CPU time spent running mutator threads. This does not include -- any profiling overhead or initialization. , mutatorCpuSeconds :: !Double @@ -66,11 +77,14 @@ data GCStats = GCStats -- | Wall clock time spent running mutator threads. This does not -- include initialization. , mutatorWallSeconds :: !Double - , gcCpuSeconds :: !Double -- ^ CPU time spent running GC - , gcWallSeconds :: !Double -- ^ Wall clock time spent running GC - , cpuSeconds :: !Double -- ^ Total CPU time elapsed since program start - , wallSeconds :: !Double -- ^ Total wall clock time elapsed since start - + -- | CPU time spent running GC + , gcCpuSeconds :: !Double + -- | Wall clock time spent running GC + , gcWallSeconds :: !Double + -- | Total CPU time elapsed since program start + , cpuSeconds :: !Double + -- | Total wall clock time elapsed since start + , wallSeconds :: !Double -- | Number of bytes copied during GC, minus space held by mutable -- lists held by the capabilities. Can be used with -- 'parMaxBytesCopied' to determine how well parallel GC utilized From git at git.haskell.org Thu Feb 25 14:40:38 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 25 Feb 2016 14:40:38 +0000 (UTC) Subject: [commit: ghc] master: testsuite: mark tests broken on powerpc64 (feb19ea) Message-ID: <20160225144038.6C6CB3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/feb19eae3d7b70a2c0038624dcfe2c417213d5c5/ghc >--------------------------------------------------------------- commit feb19eae3d7b70a2c0038624dcfe2c417213d5c5 Author: Peter Trommler Date: Thu Feb 25 14:46:13 2016 +0100 testsuite: mark tests broken on powerpc64 The following tests fail on powerpc64 and have a ticket. Mark those tests as expect_broken. Here are the details: The PowerPC native code generator does not support DWARF debug information. This is tracked in ticket #11261. Mark the respective tests broken on powerpc64. testsuite: mark print022 broken on powerpc64 Ticket #11262 tracks difference in stdout for print022. testsuite: mark recomp015 broken on powerpc64 testsuite: mark recomp011 broken on powerpc64 This is tracked as ticket #11323 and #11260. testsuite: mark linker tests broken on powerpc64 Ticket #11259 tracks tests failing because there is no RTS linker on powerpc64. Test Plan: validate Reviewers: erikd, austin, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1928 GHC Trac Issues: #11259, #11260, #11261, #11262, #11323 >--------------------------------------------------------------- feb19eae3d7b70a2c0038624dcfe2c417213d5c5 rts/Interpreter.c | 4 ++-- testsuite/tests/codeGen/should_compile/all.T | 6 ++++-- testsuite/tests/concurrent/prog001/all.T | 1 + testsuite/tests/driver/all.T | 3 ++- testsuite/tests/driver/recomp011/all.T | 3 ++- testsuite/tests/driver/recomp015/all.T | 3 ++- testsuite/tests/ghc-api/T10052/all.T | 2 +- testsuite/tests/ghc-api/all.T | 7 ++++--- testsuite/tests/ghc-api/dynCompileExpr/all.T | 1 + testsuite/tests/ghci.debugger/scripts/all.T | 3 ++- testsuite/tests/ghci/linking/all.T | 1 + testsuite/tests/ghci/prog001/prog001.T | 1 + testsuite/tests/ghci/scripts/all.T | 2 ++ testsuite/tests/rts/all.T | 7 ++++--- 14 files changed, 29 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 feb19eae3d7b70a2c0038624dcfe2c417213d5c5 From git at git.haskell.org Thu Feb 25 14:40:41 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 25 Feb 2016 14:40:41 +0000 (UTC) Subject: [commit: ghc] master: Overload the static form to reduce verbosity. (c1efdcc) Message-ID: <20160225144041.214663A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c1efdcc40209bc4f0ded85269eb8ba49c7d1ff09/ghc >--------------------------------------------------------------- commit c1efdcc40209bc4f0ded85269eb8ba49c7d1ff09 Author: Facundo Dom?nguez Date: Thu Feb 25 14:33:43 2016 +0100 Overload the static form to reduce verbosity. Static pointers are rarely used naked: most often they are defined at the base of a Closure, as defined in e.g. the distributed-closure and distributed-static packages. So a typical usage pattern is: distributeMap (closure (static (\x -> x * 2))) which is more verbose than it needs to be. Ideally we'd just have to write distributeMap (static (\x -> x * 2)) and let the static pointer be lifted to a Closure implicitly. i.e. what we want is to overload static literals, just like we already overload list literals and string literals. This is achieved by introducing the IsStatic type class and changing the typing rule for static forms slightly: static (e :: t) :: IsStatic p => p t Test Plan: ./validate Reviewers: austin, hvr, bgamari Reviewed By: bgamari Subscribers: simonpj, mboes, thomie Differential Revision: https://phabricator.haskell.org/D1923 GHC Trac Issues: #11585 >--------------------------------------------------------------- c1efdcc40209bc4f0ded85269eb8ba49c7d1ff09 compiler/prelude/PrelNames.hs | 8 ++++++++ compiler/typecheck/TcExpr.hs | 16 +++++++++++----- docs/users_guide/glasgow_exts.rst | 22 +++++++++++++++++++--- libraries/base/GHC/StaticPtr.hs | 8 ++++++++ 4 files changed, 46 insertions(+), 8 deletions(-) diff --git a/compiler/prelude/PrelNames.hs b/compiler/prelude/PrelNames.hs index 068f276..cc18398 100644 --- a/compiler/prelude/PrelNames.hs +++ b/compiler/prelude/PrelNames.hs @@ -371,6 +371,7 @@ basicKnownKeyNames -- StaticPtr , staticPtrTyConName , staticPtrDataConName, staticPtrInfoDataConName + , fromStaticPtrName -- Fingerprint , fingerprintDataConName @@ -1382,6 +1383,10 @@ staticPtrDataConName :: Name staticPtrDataConName = dcQual gHC_STATICPTR (fsLit "StaticPtr") staticPtrDataConKey +fromStaticPtrName :: Name +fromStaticPtrName = + varQual gHC_STATICPTR (fsLit "fromStaticPtr") fromStaticPtrClassOpKey + fingerprintDataConName :: Name fingerprintDataConName = dcQual gHC_FINGERPRINT_TYPE (fsLit "Fingerprint") fingerprintDataConKey @@ -2184,6 +2189,9 @@ emptyCallStackKey, pushCallStackKey :: Unique emptyCallStackKey = mkPreludeMiscIdUnique 517 pushCallStackKey = mkPreludeMiscIdUnique 518 +fromStaticPtrClassOpKey :: Unique +fromStaticPtrClassOpKey = mkPreludeMiscIdUnique 519 + {- ************************************************************************ * * diff --git a/compiler/typecheck/TcExpr.hs b/compiler/typecheck/TcExpr.hs index 6d5fe09..b98e1de 100644 --- a/compiler/typecheck/TcExpr.hs +++ b/compiler/typecheck/TcExpr.hs @@ -569,10 +569,10 @@ tcExpr (HsProc pat cmd) res_ty = do { (pat', cmd', coi) <- tcProc pat cmd res_ty ; return $ mkHsWrapCo coi (HsProc pat' cmd') } +-- Typechecks the static form and wraps it with a call to 'fromStaticPtr'. tcExpr (HsStatic expr) res_ty - = do { staticPtrTyCon <- tcLookupTyCon staticPtrTyConName - ; res_ty <- expTypeToType res_ty - ; (co, [expr_ty]) <- matchExpectedTyConApp staticPtrTyCon res_ty + = do { res_ty <- expTypeToType res_ty + ; (co, (p_ty, expr_ty)) <- matchExpectedAppTy res_ty ; (expr', lie) <- captureConstraints $ addErrCtxt (hang (text "In the body of a static form:") 2 (ppr expr) @@ -586,10 +586,16 @@ tcExpr (HsStatic expr) res_ty ; _ <- emitWantedEvVar StaticOrigin $ mkTyConApp (classTyCon typeableClass) [liftedTypeKind, expr_ty] - -- Insert the static form in a global list for later validation. + -- Insert the constraints of the static form in a global list for later + -- validation. ; stWC <- tcg_static_wc <$> getGblEnv ; updTcRef stWC (andWC lie) - ; return $ mkHsWrapCo co $ HsStatic expr' + -- Wrap the static form with the 'fromStaticPtr' call. + ; fromStaticPtr <- newMethodFromName StaticOrigin fromStaticPtrName p_ty + ; let wrap = mkWpTyApps [expr_ty] + ; loc <- getSrcSpanM + ; return $ mkHsWrapCo co $ HsApp (L loc $ mkHsWrap wrap fromStaticPtr) + (L loc (HsStatic expr')) } {- diff --git a/docs/users_guide/glasgow_exts.rst b/docs/users_guide/glasgow_exts.rst index 725f2ba..fc7ec52 100644 --- a/docs/users_guide/glasgow_exts.rst +++ b/docs/users_guide/glasgow_exts.rst @@ -11043,11 +11043,11 @@ Using static pointers Each reference is given a key which can be used to locate it at runtime with -:base-ref:`unsafeLookupStaticPtr ` +:base-ref:`unsafeLookupStaticPtr ` which uses a global and immutable table called the Static Pointer Table. The compiler includes entries in this table for all static forms found in the linked modules. The value can be obtained from the reference via -:base-ref:`deRefStaticPtr `. +:base-ref:`deRefStaticPtr `. The body ``e`` of a ``static e`` expression must be a closed expression. That is, there can be no free variables occurring in ``e``, i.e. lambda- @@ -11080,7 +11080,23 @@ Informally, if we have a closed expression :: the static form is of type :: - static e :: (Typeable a_1, ... , Typeable a_n) => StaticPtr t + static e :: (IsStatic p, Typeable a_1, ... , Typeable a_n) => p t + + +A static form determines a value of type ``StaticPtr t``, but just +like ``OverloadedLists`` and ``OverloadedStrings``, this literal +expression is overloaded to allow lifting a ``StaticPtr`` into another +type implicitly, via the ``IsStatic`` class: :: + + class IsStatic p where + fromStaticPtr :: StaticPtr a -> p a + +The only predefined instance is the obvious one that does nothing: :: + + instance IsStatic StaticPtr where + fromStaticPtr sptr = sptr + +See :base-ref:`IsStatic `. Furthermore, type ``t`` is constrained to have a ``Typeable`` instance. The following are therefore illegal: :: diff --git a/libraries/base/GHC/StaticPtr.hs b/libraries/base/GHC/StaticPtr.hs index 117d705..3d5807a 100644 --- a/libraries/base/GHC/StaticPtr.hs +++ b/libraries/base/GHC/StaticPtr.hs @@ -38,6 +38,7 @@ module GHC.StaticPtr , StaticPtrInfo(..) , staticPtrInfo , staticPtrKeys + , IsStatic(..) ) where import Foreign.C.Types (CInt(..)) @@ -80,6 +81,13 @@ unsafeLookupStaticPtr (Fingerprint w1 w2) = do foreign import ccall unsafe hs_spt_lookup :: Ptr () -> IO (Ptr a) +-- | A class for things buildable from static pointers. +class IsStatic p where + fromStaticPtr :: StaticPtr a -> p a + +instance IsStatic StaticPtr where + fromStaticPtr = id + -- | Miscelaneous information available for debugging purposes. data StaticPtrInfo = StaticPtrInfo { -- | Package key of the package where the static pointer is defined From git at git.haskell.org Thu Feb 25 14:40:44 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 25 Feb 2016 14:40:44 +0000 (UTC) Subject: [commit: ghc] master: Reconstruct record expression in bidir pattern synonym (52879d1) Message-ID: <20160225144044.420F93A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/52879d1f5d804bf1a32d11d9cefc36d7b6fea382/ghc >--------------------------------------------------------------- commit 52879d1f5d804bf1a32d11d9cefc36d7b6fea382 Author: Matthew Pickering Date: Thu Feb 25 14:52:39 2016 +0100 Reconstruct record expression in bidir pattern synonym Reviewers: austin, rdragon, bgamari Reviewed By: bgamari Subscribers: rdragon, thomie Differential Revision: https://phabricator.haskell.org/D1949 >--------------------------------------------------------------- 52879d1f5d804bf1a32d11d9cefc36d7b6fea382 compiler/hsSyn/HsPat.hs | 9 ++++++--- compiler/typecheck/TcPatSyn.hs | 25 ++++++++++++++++++++----- testsuite/tests/patsyn/should_compile/T11633.hs | 12 ++++++++++++ testsuite/tests/patsyn/should_compile/all.T | 1 + 4 files changed, 39 insertions(+), 8 deletions(-) diff --git a/compiler/hsSyn/HsPat.hs b/compiler/hsSyn/HsPat.hs index 5b7f6d4..36c4faf 100644 --- a/compiler/hsSyn/HsPat.hs +++ b/compiler/hsSyn/HsPat.hs @@ -6,7 +6,9 @@ -} {-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE DeriveFoldable #-} +{-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE UndecidableInstances #-} -- Note [Pass sensitive types] @@ -244,9 +246,10 @@ data HsRecFields id arg -- A bunch of record fields -- Used for both expressions and patterns = HsRecFields { rec_flds :: [LHsRecField id arg], rec_dotdot :: Maybe Int } -- Note [DotDot fields] - deriving (Typeable) + deriving (Typeable, Functor, Foldable, Traversable) deriving instance (DataId id, Data arg) => Data (HsRecFields id arg) + -- Note [DotDot fields] -- ~~~~~~~~~~~~~~~~~~~~ -- The rec_dotdot field means this: @@ -275,7 +278,7 @@ data HsRecField' id arg = HsRecField { hsRecFieldLbl :: Located id, hsRecFieldArg :: arg, -- ^ Filled in by renamer when punning hsRecPun :: Bool -- ^ Note [Punning] - } deriving (Data, Typeable) + } deriving (Data, Typeable, Functor, Foldable, Traversable) -- Note [Punning] diff --git a/compiler/typecheck/TcPatSyn.hs b/compiler/typecheck/TcPatSyn.hs index b627cd4..06f2042 100644 --- a/compiler/typecheck/TcPatSyn.hs +++ b/compiler/typecheck/TcPatSyn.hs @@ -813,15 +813,30 @@ tcPatToExpr args = go lhsVars = mkNameSet (map unLoc args) go :: LPat Name -> Maybe (LHsExpr Name) - go (L loc (ConPatIn (L _ con) info)) - = do { exprs <- mapM go (hsConPatArgs info) - ; return $ L loc $ - foldl (\x y -> HsApp (L loc x) y) (HsVar (L loc con)) exprs } + go (L loc (ConPatIn con info)) + = case info of + PrefixCon ps -> mkPrefixConExpr con ps + InfixCon l r -> mkPrefixConExpr con [l,r] + RecCon fields -> L loc <$> mkRecordConExpr con fields go (L _ (SigPatIn pat _)) = go pat -- See Note [Type signatures and the builder expression] - go (L loc p) = fmap (L loc) $ go1 p + go (L loc p) = L loc <$> go1 p + + -- Make a prefix con for prefix and infix patterns for simplicity + mkPrefixConExpr :: Located Name -> [LPat Name] -> Maybe (LHsExpr Name) + mkPrefixConExpr con pats = do + exprs <- traverse go pats + return $ foldl (\x y -> L (combineLocs x y) (HsApp x y)) + (L (getLoc con) (HsVar con)) + exprs + + + mkRecordConExpr :: Located Name -> HsRecFields Name (LPat Name) -> Maybe (HsExpr Name) + mkRecordConExpr con fields = do + exprFields <- traverse go fields + return $ RecordCon con PlaceHolder noPostTcExpr exprFields go1 :: Pat Name -> Maybe (HsExpr Name) go1 (VarPat (L l var)) diff --git a/testsuite/tests/patsyn/should_compile/T11633.hs b/testsuite/tests/patsyn/should_compile/T11633.hs new file mode 100644 index 0000000..45caec8 --- /dev/null +++ b/testsuite/tests/patsyn/should_compile/T11633.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE PatternSynonyms #-} + +module T11633 where + +data ARecord = ARecord {anInt :: Int, aString :: String} + +-- This works... +pattern AGoodPat :: Int -> String -> ARecord +pattern AGoodPat n s = ARecord {anInt=n, aString=s} + +pattern ABadPat :: Int -> String -> ARecord +pattern ABadPat n s = ARecord {aString=s, anInt=n} diff --git a/testsuite/tests/patsyn/should_compile/all.T b/testsuite/tests/patsyn/should_compile/all.T index 7668398..0fc26cb 100644 --- a/testsuite/tests/patsyn/should_compile/all.T +++ b/testsuite/tests/patsyn/should_compile/all.T @@ -50,3 +50,4 @@ test('T11283', normal, compile, ['']) test('T11336', normal, compile, ['']) test('T11367', normal, compile, ['']) test('T11351', normal, compile, ['']) +test('T11633', normal, compile, ['']) From git at git.haskell.org Thu Feb 25 14:40:46 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 25 Feb 2016 14:40:46 +0000 (UTC) Subject: [commit: ghc] master: HscMain: Delete some unused code (6319a8c) Message-ID: <20160225144046.E33BF3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6319a8cf79cc1f1e25220113149ab48e5083321b/ghc >--------------------------------------------------------------- commit 6319a8cf79cc1f1e25220113149ab48e5083321b Author: ?mer Sinan A?acan Date: Thu Feb 25 14:47:47 2016 +0100 HscMain: Delete some unused code Reviewers: bgamari, austin Reviewed By: austin Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1936 >--------------------------------------------------------------- 6319a8cf79cc1f1e25220113149ab48e5083321b compiler/main/HscMain.hs | 68 ------------------------------------------------ 1 file changed, 68 deletions(-) diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs index 4b26cdb..b1daae5 100644 --- a/compiler/main/HscMain.hs +++ b/compiler/main/HscMain.hs @@ -39,14 +39,7 @@ module HscMain , HscStatus (..) , hscIncrementalCompile , hscCompileCmmFile - , hscCompileCore - , hscIncrementalFrontend - - , genModDetails - , hscSimpleIface - , hscWriteIface - , hscNormalIface , hscGenHardCode , hscInteractive @@ -54,7 +47,6 @@ module HscMain , hscParse , hscTypecheckRename , hscDesugar - , makeSimpleIface , makeSimpleDetails , hscSimplify -- ToDo, shouldn't really export this @@ -491,19 +483,6 @@ hscDesugar' mod_location tc_result = do handleWarnings return r --- | Make a 'ModIface' from the results of typechecking. Used when --- not optimising, and the interface doesn't need to contain any --- unfoldings or other cross-module optimisation info. --- ToDo: the old interface is only needed to get the version numbers, --- we should use fingerprint versions instead. -makeSimpleIface :: HscEnv -> Maybe ModIface -> TcGblEnv -> ModDetails - -> IO (ModIface,Bool) -makeSimpleIface hsc_env maybe_old_iface tc_result details = runHsc hsc_env $ do - safe_mode <- hscGetSafeMode tc_result - liftIO $ do - mkIfaceTc hsc_env (fmap mi_iface_hash maybe_old_iface) safe_mode - details tc_result - -- | Make a 'ModDetails' from the results of typechecking. Used when -- typechecking only, as opposed to full compilation. makeSimpleDetails :: HscEnv -> TcGblEnv -> IO ModDetails @@ -1695,53 +1674,6 @@ hscParseThingWithLocation source linenumber parser str liftIO $ dumpIfSet_dyn dflags Opt_D_dump_parsed "Parser" (ppr thing) return thing -hscCompileCore :: HscEnv -> Bool -> SafeHaskellMode -> ModSummary - -> CoreProgram -> FilePath -> IO () -hscCompileCore hsc_env simplify safe_mode mod_summary binds output_filename - = runHsc hsc_env $ do - guts <- maybe_simplify (mkModGuts (ms_mod mod_summary) safe_mode binds) - (iface, changed, _details, cgguts) <- hscNormalIface' guts Nothing - liftIO $ hscWriteIface (hsc_dflags hsc_env) iface changed mod_summary - _ <- liftIO $ hscGenHardCode hsc_env cgguts mod_summary output_filename - return () - - where - maybe_simplify mod_guts | simplify = hscSimplify' mod_guts - | otherwise = return mod_guts - --- Makes a "vanilla" ModGuts. -mkModGuts :: Module -> SafeHaskellMode -> CoreProgram -> ModGuts -mkModGuts mod safe binds = - ModGuts { - mg_module = mod, - mg_hsc_src = HsSrcFile, - mg_loc = mkGeneralSrcSpan (moduleNameFS (moduleName mod)), - -- A bit crude - mg_exports = [], - mg_usages = [], - mg_deps = noDependencies, - mg_used_th = False, - mg_rdr_env = emptyGlobalRdrEnv, - mg_fix_env = emptyFixityEnv, - mg_tcs = [], - mg_insts = [], - mg_fam_insts = [], - mg_patsyns = [], - mg_rules = [], - mg_vect_decls = [], - mg_binds = binds, - mg_foreign = NoStubs, - mg_warns = NoWarnings, - mg_anns = [], - mg_hpc_info = emptyHpcInfo False, - mg_modBreaks = Nothing, - mg_vect_info = noVectInfo, - mg_inst_env = emptyInstEnv, - mg_fam_inst_env = emptyFamInstEnv, - mg_safe_haskell = safe, - mg_trust_pkg = False - } - {- ********************************************************************** %* * From git at git.haskell.org Thu Feb 25 14:40:49 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 25 Feb 2016 14:40:49 +0000 (UTC) Subject: [commit: ghc] master: Add more type class instances for GHC.Generics (673efcc) Message-ID: <20160225144049.9DAE23A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/673efccb3b348e9daf23d9e65460691bbea8586e/ghc >--------------------------------------------------------------- commit 673efccb3b348e9daf23d9e65460691bbea8586e Author: RyanGlScott Date: Thu Feb 25 14:49:48 2016 +0100 Add more type class instances for GHC.Generics GHC.Generics provides several representation data types that have obvious instances of various type classes in base, along with various other types of meta-data (such as associativity and fixity). Specifically, instances have been added for the following type classes (where possible): - Applicative - Data - Functor - Monad - MonadFix - MonadPlus - MonadZip - Foldable - Traversable - Enum - Bounded - Ix - Generic1 Thanks to ocharles for starting this! Test Plan: Validate Reviewers: ekmett, austin, hvr, bgamari Reviewed By: bgamari Subscribers: RyanGlScott, thomie Differential Revision: https://phabricator.haskell.org/D1937 GHC Trac Issues: #9043 >--------------------------------------------------------------- 673efccb3b348e9daf23d9e65460691bbea8586e libraries/base/Control/Monad/Fix.hs | 18 ++ libraries/base/Control/Monad/Zip.hs | 15 + libraries/base/Data/Bifunctor.hs | 4 + libraries/base/Data/Data.hs | 309 ++++++++++++++++++++- libraries/base/Data/Foldable.hs | 24 +- libraries/base/Data/Traversable.hs | 24 +- libraries/base/GHC/Generics.hs | 124 +++++++-- libraries/base/changelog.md | 5 + .../tests/annotations/should_fail/annfail10.stderr | 2 +- .../tests/ghci.debugger/scripts/break006.stderr | 4 +- .../tests/typecheck/should_fail/T10971b.stderr | 8 +- testsuite/tests/typecheck/should_fail/T5095.stderr | 2 +- 12 files changed, 505 insertions(+), 34 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 673efccb3b348e9daf23d9e65460691bbea8586e From git at git.haskell.org Thu Feb 25 14:40:52 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 25 Feb 2016 14:40:52 +0000 (UTC) Subject: [commit: ghc] master: ApplicativeDo: Handle terminal `pure` statements (0c7db61) Message-ID: <20160225144052.DC1743A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/0c7db61f8a17b2c5c4335b62103eb9ffc5d24154/ghc >--------------------------------------------------------------- commit 0c7db61f8a17b2c5c4335b62103eb9ffc5d24154 Author: Ben Gamari Date: Thu Feb 25 14:47:34 2016 +0100 ApplicativeDo: Handle terminal `pure` statements ApplicativeDo handled terminal `return` statements properly, but not `pure`. Test Plan: Validate with included testcase Reviewers: austin, simonmar Reviewed By: austin, simonmar Subscribers: simonpj, thomie Differential Revision: https://phabricator.haskell.org/D1931 GHC Trac Issues: #11607 >--------------------------------------------------------------- 0c7db61f8a17b2c5c4335b62103eb9ffc5d24154 compiler/rename/RnExpr.hs | 2 +- docs/users_guide/glasgow_exts.rst | 3 ++- testsuite/tests/ado/T11607.hs | 10 ++++++++++ testsuite/tests/ado/T11607.stdout | 1 + testsuite/tests/ado/all.T | 1 + 5 files changed, 15 insertions(+), 2 deletions(-) diff --git a/compiler/rename/RnExpr.hs b/compiler/rename/RnExpr.hs index 9d1200a..ce113b4 100644 --- a/compiler/rename/RnExpr.hs +++ b/compiler/rename/RnExpr.hs @@ -1678,7 +1678,7 @@ isReturnApp (L _ (HsApp f arg)) | otherwise = Nothing where is_return (L _ (HsPar e)) = is_return e - is_return (L _ (HsVar (L _ r))) = r == returnMName + is_return (L _ (HsVar (L _ r))) = r == returnMName || r == pureAName -- TODO: I don't know how to get this right for rebindable syntax is_return _ = False isReturnApp _ = Nothing diff --git a/docs/users_guide/glasgow_exts.rst b/docs/users_guide/glasgow_exts.rst index fc7ec52..59e8b62 100644 --- a/docs/users_guide/glasgow_exts.rst +++ b/docs/users_guide/glasgow_exts.rst @@ -906,7 +906,8 @@ is as follows. If the do-expression has the following form: :: where none of the variables defined by ``p1...pn`` are mentioned in ``E1...En``, then the expression will only require ``Applicative``. Otherwise, the expression -will require ``Monad``. +will require ``Monad``. The block may return a pure expression ``E`` depending +upon the results ``p1...pn`` with either ``return`` or ``pure``. .. _applicative-do-pitfall: diff --git a/testsuite/tests/ado/T11607.hs b/testsuite/tests/ado/T11607.hs new file mode 100644 index 0000000..f2bb341 --- /dev/null +++ b/testsuite/tests/ado/T11607.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE ApplicativeDo #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + +newtype MaybeA a = MaybeA (Maybe a) + deriving (Show, Functor, Applicative) + +main :: IO () +main = print $ do + x <- MaybeA $ Just 42 + pure x diff --git a/testsuite/tests/ado/T11607.stdout b/testsuite/tests/ado/T11607.stdout new file mode 100644 index 0000000..1e6c1e1 --- /dev/null +++ b/testsuite/tests/ado/T11607.stdout @@ -0,0 +1 @@ +MaybeA (Just 42) diff --git a/testsuite/tests/ado/all.T b/testsuite/tests/ado/all.T index 2ec3e34..e1efdf2 100644 --- a/testsuite/tests/ado/all.T +++ b/testsuite/tests/ado/all.T @@ -5,3 +5,4 @@ test('ado004', normal, compile, ['']) test('ado005', normal, compile_fail, ['']) test('ado006', normal, compile, ['']) test('ado007', normal, compile, ['']) +test('T11607', normal, compile_and_run, ['']) From git at git.haskell.org Thu Feb 25 14:40:55 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 25 Feb 2016 14:40:55 +0000 (UTC) Subject: [commit: ghc] master: Make warning names more consistent (6658491) Message-ID: <20160225144055.B02CD3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/665849142bca36c14bcb25d64180c153a1ef1f2c/ghc >--------------------------------------------------------------- commit 665849142bca36c14bcb25d64180c153a1ef1f2c Author: Manav Rathi Date: Thu Feb 25 14:51:32 2016 +0100 Make warning names more consistent - Replace "Sigs" with "Signatures" in WarningFlag data constructors. - Replace "PatSyn" with "PatternSynonym" in WarningFlag data constructors. - Deprecate "missing-local-sigs" in favor of "missing-local-signatures". - Deprecate "missing-exported-sigs" in favor of "missing-exported-signatures". - Deprecate "missing-pat-syn-signatures" in favor of "missing-pattern-synonym-signatures". - Replace "ddump-strsigs" with "ddump-str-signatures" These complete the tasks that were explicitly mentioned in #11583 Test Plan: Executed `ghc --show-options` and verified that the flags were changed as expected. Reviewers: svenpanne, austin, bgamari Reviewed By: austin, bgamari Subscribers: mpickering, thomie Differential Revision: https://phabricator.haskell.org/D1939 GHC Trac Issues: #11583 >--------------------------------------------------------------- 665849142bca36c14bcb25d64180c153a1ef1f2c compiler/main/DynFlags.hs | 31 ++++++++------ compiler/rename/RnNames.hs | 12 +++--- compiler/stranal/DmdAnal.hs | 3 +- compiler/typecheck/TcBinds.hs | 8 ++-- docs/users_guide/8.0.1-notes.rst | 16 +++++-- docs/users_guide/debugging.rst | 2 +- docs/users_guide/using-warnings.rst | 49 +++++++++++++++------- testsuite/tests/patsyn/should_fail/T11053.hs | 2 +- testsuite/tests/patsyn/should_fail/all.T | 2 +- testsuite/tests/stranal/sigs/all.T | 2 +- testsuite/tests/warnings/should_compile/T10908.hs | 2 +- testsuite/tests/warnings/should_compile/all.T | 6 +-- utils/mkUserGuidePart/Options/CompilerDebugging.hs | 2 +- utils/mkUserGuidePart/Options/Warnings.hs | 15 +++++++ 14 files changed, 101 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 665849142bca36c14bcb25d64180c153a1ef1f2c From git at git.haskell.org Thu Feb 25 14:40:58 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 25 Feb 2016 14:40:58 +0000 (UTC) Subject: [commit: ghc] master: Bump haddock.base allocations (ebaa638) Message-ID: <20160225144058.6388B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ebaa638f47d0805d613daee48b0d93bafed85702/ghc >--------------------------------------------------------------- commit ebaa638f47d0805d613daee48b0d93bafed85702 Author: Ben Gamari Date: Thu Feb 25 15:35:25 2016 +0100 Bump haddock.base allocations I believe this is probably due to the recent RuntimeRep change. >--------------------------------------------------------------- ebaa638f47d0805d613daee48b0d93bafed85702 testsuite/tests/perf/haddock/all.T | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/testsuite/tests/perf/haddock/all.T b/testsuite/tests/perf/haddock/all.T index 5a99333..606d391 100644 --- a/testsuite/tests/perf/haddock/all.T +++ b/testsuite/tests/perf/haddock/all.T @@ -5,7 +5,7 @@ test('haddock.base', [unless(in_tree_compiler(), skip), req_haddock ,stats_num_field('bytes allocated', - [(wordsize(64), 27812188000, 5) + [(wordsize(64), 30987348040, 5) # 2012-08-14: 5920822352 (amd64/Linux) # 2012-09-20: 5829972376 (amd64/Linux) # 2012-10-08: 5902601224 (amd64/Linux) @@ -28,6 +28,7 @@ test('haddock.base', # 2015-12-11: 11119767632 (amd64/Linux) - TypeInType (see #11196) # 2015-12-17: 26282821104 (x86_64/Linux) - Update Haddock to master # 2015-12-17: 27812188000 (x86_64/Linux) - Move Data.Functor.* into base + # 2016-02-25: 30987348040 (x86_64/Linux) - RuntimeRep ,(platform('i386-unknown-mingw32'), 4434804940, 5) # 2013-02-10: 3358693084 (x86/Windows) From git at git.haskell.org Thu Feb 25 16:16:50 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 25 Feb 2016 16:16:50 +0000 (UTC) Subject: [commit: ghc] master: cmpTypeX: Avoid kind comparison when possible (073e20e) Message-ID: <20160225161650.819503A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/073e20ebda73309173b6b6e3ea10164e8808cc79/ghc >--------------------------------------------------------------- commit 073e20ebda73309173b6b6e3ea10164e8808cc79 Author: Ben Gamari Date: Thu Feb 25 15:44:20 2016 +0100 cmpTypeX: Avoid kind comparison when possible This comparison is only necessary when the types being compared contain casts. Otherwise the structural equality of the types implies that their kinds are equal. Test Plan: Validate Reviewers: goldfire, austin, simonpj Reviewed By: simonpj Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1944 GHC Trac Issues: #11597 >--------------------------------------------------------------- 073e20ebda73309173b6b6e3ea10164e8808cc79 compiler/types/Type.hs | 85 +++++++++++++++++++++++++++++++++++--------------- 1 file changed, 60 insertions(+), 25 deletions(-) diff --git a/compiler/types/Type.hs b/compiler/types/Type.hs index bca64c2..78c20a9 100644 --- a/compiler/types/Type.hs +++ b/compiler/types/Type.hs @@ -2074,46 +2074,79 @@ cmpTypes ts1 ts2 = cmpTypesX rn_env ts1 ts2 where rn_env = mkRnEnv2 (mkInScopeSet (tyCoVarsOfTypes (ts1 ++ ts2))) +-- | An ordering relation between two 'Type's (known below as @t1 :: k1@ +-- and @t2 :: k2@) +data TypeOrdering = TLT -- ^ @t1 < t2@ + | TEQ -- ^ @t1 ~ t2@ and there are no casts in either, + -- therefore we can conclude @k1 ~ k2@ + | TEQX -- ^ @t1 ~ t2@ yet one of the types contains a cast so + -- they may differ in kind. + | TGT -- ^ @t1 > t2@ + deriving (Eq, Ord, Enum, Bounded) + cmpTypeX :: RnEnv2 -> Type -> Type -> Ordering -- Main workhorse -- See Note [Non-trivial definitional equality] in TyCoRep -cmpTypeX env orig_t1 orig_t2 - = go env orig_t1 orig_t2 `thenCmp` go env k1 k2 - -- NB: this ordering appears to be faster than the other +cmpTypeX env orig_t1 orig_t2 = + case go env orig_t1 orig_t2 of + -- If there are casts then we also need to do a comparison of the kinds of + -- the types being compared + TEQX -> toOrdering $ go env k1 k2 + ty_ordering -> toOrdering ty_ordering where k1 = typeKind orig_t1 k2 = typeKind orig_t2 - -- short-cut to handle comparing * against *. - -- appears to have a roughly 1% improvement in compile times - go _ (TyConApp tc1 []) (TyConApp tc2 []) | tc1 == tc2 = EQ - - go env t1 t2 | Just t1' <- coreViewOneStarKind t1 = go env t1' t2 - go env t1 t2 | Just t2' <- coreViewOneStarKind t2 = go env t1 t2' + toOrdering :: TypeOrdering -> Ordering + toOrdering TLT = LT + toOrdering TEQ = EQ + toOrdering TEQX = EQ + toOrdering TGT = GT + + liftOrdering :: Ordering -> TypeOrdering + liftOrdering LT = TLT + liftOrdering EQ = TEQ + liftOrdering GT = TGT + + thenCmpTy :: TypeOrdering -> TypeOrdering -> TypeOrdering + thenCmpTy TEQ rel = rel + thenCmpTy TEQX rel = hasCast rel + thenCmpTy rel _ = rel + + hasCast :: TypeOrdering -> TypeOrdering + hasCast TEQ = TEQX + hasCast rel = rel + + -- Returns both the resulting ordering relation between the two types + -- and whether either contains a cast. + go :: RnEnv2 -> Type -> Type -> TypeOrdering + go env t1 t2 + | Just t1' <- coreViewOneStarKind t1 = go env t1' t2 + | Just t2' <- coreViewOneStarKind t2 = go env t1 t2' go env (TyVarTy tv1) (TyVarTy tv2) - = rnOccL env tv1 `compare` rnOccR env tv2 + = liftOrdering $ rnOccL env tv1 `compare` rnOccR env tv2 go env (ForAllTy (Named tv1 _) t1) (ForAllTy (Named tv2 _) t2) = go env (tyVarKind tv1) (tyVarKind tv2) - `thenCmp` go (rnBndr2 env tv1 tv2) t1 t2 + `thenCmpTy` go (rnBndr2 env tv1 tv2) t1 t2 -- See Note [Equality on AppTys] go env (AppTy s1 t1) ty2 | Just (s2, t2) <- repSplitAppTy_maybe ty2 - = go env s1 s2 `thenCmp` go env t1 t2 + = go env s1 s2 `thenCmpTy` go env t1 t2 go env ty1 (AppTy s2 t2) | Just (s1, t1) <- repSplitAppTy_maybe ty1 - = go env s1 s2 `thenCmp` go env t1 t2 + = go env s1 s2 `thenCmpTy` go env t1 t2 go env (ForAllTy (Anon s1) t1) (ForAllTy (Anon s2) t2) - = go env s1 s2 `thenCmp` go env t1 t2 + = go env s1 s2 `thenCmpTy` go env t1 t2 go env (TyConApp tc1 tys1) (TyConApp tc2 tys2) - = (tc1 `cmpTc` tc2) `thenCmp` gos env tys1 tys2 - go _ (LitTy l1) (LitTy l2) = compare l1 l2 - go env (CastTy t1 _) t2 = go env t1 t2 - go env t1 (CastTy t2 _) = go env t1 t2 - go _ (CoercionTy {}) (CoercionTy {}) = EQ + = liftOrdering (tc1 `cmpTc` tc2) `thenCmpTy` gos env tys1 tys2 + go _ (LitTy l1) (LitTy l2) = liftOrdering (compare l1 l2) + go env (CastTy t1 _) t2 = hasCast $ go env t1 t2 + go env t1 (CastTy t2 _) = hasCast $ go env t1 t2 + go _ (CoercionTy {}) (CoercionTy {}) = TEQ -- Deal with the rest: TyVarTy < CoercionTy < AppTy < LitTy < TyConApp < ForAllTy go _ ty1 ty2 - = (get_rank ty1) `compare` (get_rank ty2) + = liftOrdering $ (get_rank ty1) `compare` (get_rank ty2) where get_rank :: Type -> Int get_rank (CastTy {}) = pprPanic "cmpTypeX.get_rank" (ppr [ty1,ty2]) @@ -2125,15 +2158,17 @@ cmpTypeX env orig_t1 orig_t2 get_rank (ForAllTy (Anon {}) _) = 6 get_rank (ForAllTy (Named {}) _) = 7 - gos _ [] [] = EQ - gos _ [] _ = LT - gos _ _ [] = GT - gos env (ty1:tys1) (ty2:tys2) = go env ty1 ty2 `thenCmp` gos env tys1 tys2 + gos :: RnEnv2 -> [Type] -> [Type] -> TypeOrdering + gos _ [] [] = TEQ + gos _ [] _ = TLT + gos _ _ [] = TGT + gos env (ty1:tys1) (ty2:tys2) = go env ty1 ty2 `thenCmpTy` gos env tys1 tys2 ------------- cmpTypesX :: RnEnv2 -> [Type] -> [Type] -> Ordering cmpTypesX _ [] [] = EQ -cmpTypesX env (t1:tys1) (t2:tys2) = cmpTypeX env t1 t2 `thenCmp` cmpTypesX env tys1 tys2 +cmpTypesX env (t1:tys1) (t2:tys2) = cmpTypeX env t1 t2 + `thenCmp` cmpTypesX env tys1 tys2 cmpTypesX _ [] _ = LT cmpTypesX _ _ [] = GT From git at git.haskell.org Thu Feb 25 16:16:53 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 25 Feb 2016 16:16:53 +0000 (UTC) Subject: [commit: ghc] master: Handle multiline named haddock comments properly (6350eb1) Message-ID: <20160225161653.D46BF3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6350eb1126e29b93829de688623c91b772f6d9eb/ghc >--------------------------------------------------------------- commit 6350eb1126e29b93829de688623c91b772f6d9eb Author: Thomas Miedema Date: Thu Feb 25 15:51:38 2016 +0100 Handle multiline named haddock comments properly Fixes #10398 in a different way, thereby also fixing #11579. I inverted the logic of the Bool argument to "worker", to hopefully make it more self-explanatory. Reviewers: austin, hvr, bgamari Reviewed By: bgamari Differential Revision: https://phabricator.haskell.org/D1935 >--------------------------------------------------------------- 6350eb1126e29b93829de688623c91b772f6d9eb compiler/parser/Lexer.x | 43 +++++++++++++++++++++++------------ libraries/base/GHC/ExecutionStack.hs | 2 +- testsuite/tests/ghc-api/T11579.hs | 26 +++++++++++++++++++++ testsuite/tests/ghc-api/T11579.stdout | 1 + testsuite/tests/ghc-api/all.T | 2 ++ 5 files changed, 58 insertions(+), 16 deletions(-) diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x index 3f959f2..7147802 100644 --- a/compiler/parser/Lexer.x +++ b/compiler/parser/Lexer.x @@ -970,24 +970,35 @@ ifExtension pred bits _ _ _ = pred bits multiline_doc_comment :: Action multiline_doc_comment span buf _len = withLexedDocType (worker "") where - worker commentAcc input docType oneLine = case alexGetChar' input of + worker commentAcc input docType checkNextLine = case alexGetChar' input of Just ('\n', input') - | oneLine -> docCommentEnd input commentAcc docType buf span - | otherwise -> case checkIfCommentLine input' of - Just input -> worker ('\n':commentAcc) input docType False + | checkNextLine -> case checkIfCommentLine input' of + Just input -> worker ('\n':commentAcc) input docType checkNextLine Nothing -> docCommentEnd input commentAcc docType buf span - Just (c, input) -> worker (c:commentAcc) input docType oneLine + | otherwise -> docCommentEnd input commentAcc docType buf span + Just (c, input) -> worker (c:commentAcc) input docType checkNextLine Nothing -> docCommentEnd input commentAcc docType buf span + -- Check if the next line of input belongs to this doc comment as well. + -- A doc comment continues onto the next line when the following + -- conditions are met: + -- * The line starts with "--" + -- * The line doesn't start with "---". + -- * The line doesn't start with "-- $", because that would be the + -- start of a /new/ named haddock chunk (#10398). + checkIfCommentLine :: AlexInput -> Maybe AlexInput checkIfCommentLine input = check (dropNonNewlineSpace input) where - check input = case alexGetChar' input of - Just ('-', input) -> case alexGetChar' input of - Just ('-', input) -> case alexGetChar' input of - Just (c, _) | c /= '-' -> Just input - _ -> Nothing - _ -> Nothing - _ -> Nothing + check input = do + ('-', input) <- alexGetChar' input + ('-', input) <- alexGetChar' input + (c, after_c) <- alexGetChar' input + case c of + '-' -> Nothing + ' ' -> case alexGetChar' after_c of + Just ('$', _) -> Nothing + _ -> Just input + _ -> Just input dropNonNewlineSpace input = case alexGetChar' input of Just (c, input') @@ -1051,15 +1062,17 @@ withLexedDocType :: (AlexInput -> (String -> Token) -> Bool -> P (RealLocated To withLexedDocType lexDocComment = do input@(AI _ buf) <- getInput case prevChar buf ' ' of - '|' -> lexDocComment input ITdocCommentNext False - '^' -> lexDocComment input ITdocCommentPrev False + -- The `Bool` argument to lexDocComment signals whether or not the next + -- line of input might also belong to this doc comment. + '|' -> lexDocComment input ITdocCommentNext True + '^' -> lexDocComment input ITdocCommentPrev True '$' -> lexDocComment input ITdocCommentNamed True '*' -> lexDocSection 1 input _ -> panic "withLexedDocType: Bad doc type" where lexDocSection n input = case alexGetChar' input of Just ('*', input) -> lexDocSection (n+1) input - Just (_, _) -> lexDocComment input (ITdocSection n) True + Just (_, _) -> lexDocComment input (ITdocSection n) False Nothing -> do setInput input; lexToken -- eof reached, lex it normally -- RULES pragmas turn on the forall and '.' keywords, and we turn them diff --git a/libraries/base/GHC/ExecutionStack.hs b/libraries/base/GHC/ExecutionStack.hs index 11f8c9e..22be903 100644 --- a/libraries/base/GHC/ExecutionStack.hs +++ b/libraries/base/GHC/ExecutionStack.hs @@ -22,7 +22,7 @@ -- Your GHC must have been built with @libdw@ support for this to work. -- -- @ --- $ ghc --info | grep libdw +-- user at host:~$ ghc --info | grep libdw -- ,("RTS expects libdw","YES") -- @ -- diff --git a/testsuite/tests/ghc-api/T11579.hs b/testsuite/tests/ghc-api/T11579.hs new file mode 100644 index 0000000..3294f99 --- /dev/null +++ b/testsuite/tests/ghc-api/T11579.hs @@ -0,0 +1,26 @@ +import System.Environment +import DynFlags +import FastString +import GHC +import StringBuffer +import Lexer +import SrcLoc + +main :: IO () +main = do + [libdir] <- getArgs + + let stringBuffer = stringToStringBuffer "-- $bar some\n-- named chunk" + loc = mkRealSrcLoc (mkFastString "Foo.hs") 1 1 + + token <- runGhc (Just libdir) $ do + dflags <- getSessionDynFlags + let pstate = mkPState (dflags `gopt_set` Opt_Haddock) stringBuffer loc + case unP (lexer False return) pstate of + POk _ token -> return (unLoc token) + _ -> error "No token" + + -- #11579 + -- Expected: "ITdocCommentNamed "bar some\n named chunk" + -- Actual (with ghc-8.0.1-rc2): "ITdocCommentNamed "bar some" + print token diff --git a/testsuite/tests/ghc-api/T11579.stdout b/testsuite/tests/ghc-api/T11579.stdout new file mode 100644 index 0000000..7603e53 --- /dev/null +++ b/testsuite/tests/ghc-api/T11579.stdout @@ -0,0 +1 @@ +ITdocCommentNamed "bar some\n named chunk" diff --git a/testsuite/tests/ghc-api/all.T b/testsuite/tests/ghc-api/all.T index 8aa2ede..3859d53 100644 --- a/testsuite/tests/ghc-api/all.T +++ b/testsuite/tests/ghc-api/all.T @@ -21,3 +21,5 @@ test('T10942', extra_run_opts('"' + config.libdir + '"'), test('T9015', extra_run_opts('"' + config.libdir + '"'), compile_and_run, ['-package ghc']) +test('T11579', extra_run_opts('"' + config.libdir + '"'), compile_and_run, + ['-package ghc']) From git at git.haskell.org Thu Feb 25 16:16:56 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 25 Feb 2016 16:16:56 +0000 (UTC) Subject: [commit: ghc] master: Improve accuracy of suggestion to use TypeApplications (e38c07b) Message-ID: <20160225161656.8E53A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e38c07bf5ceb8f50fa5110b70b3b83f0ce1358ba/ghc >--------------------------------------------------------------- commit e38c07bf5ceb8f50fa5110b70b3b83f0ce1358ba Author: Matthew Pickering Date: Thu Feb 25 15:51:46 2016 +0100 Improve accuracy of suggestion to use TypeApplications The suggestion only makes sense when we try to use an as pattern in an expression context. It is misleading in the case of a lazy pattern and view pattern. Reviewers: austin, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1948 >--------------------------------------------------------------- e38c07bf5ceb8f50fa5110b70b3b83f0ce1358ba compiler/rename/RnExpr.hs | 13 +++++++------ testsuite/tests/module/mod70.stderr | 4 +--- testsuite/tests/rename/should_fail/rnfail016.stderr | 4 +--- testsuite/tests/rename/should_fail/rnfail051.stderr | 1 - 4 files changed, 9 insertions(+), 13 deletions(-) diff --git a/compiler/rename/RnExpr.hs b/compiler/rename/RnExpr.hs index ce113b4..4764f3d 100644 --- a/compiler/rename/RnExpr.hs +++ b/compiler/rename/RnExpr.hs @@ -325,9 +325,10 @@ We return a (bogus) EWildPat in each case. -} rnExpr EWildPat = return (hsHoleExpr, emptyFVs) -- "_" is just a hole -rnExpr e@(EAsPat {}) = patSynErr e -rnExpr e@(EViewPat {}) = patSynErr e -rnExpr e@(ELazyPat {}) = patSynErr e +rnExpr e@(EAsPat {}) = + patSynErr e (text "Did you mean to enable TypeApplications?") +rnExpr e@(EViewPat {}) = patSynErr e empty +rnExpr e@(ELazyPat {}) = patSynErr e empty {- ************************************************************************ @@ -1854,10 +1855,10 @@ sectionErr expr = hang (text "A section must be enclosed in parentheses") 2 (text "thus:" <+> (parens (ppr expr))) -patSynErr :: HsExpr RdrName -> RnM (HsExpr Name, FreeVars) -patSynErr e = do { addErr (sep [text "Pattern syntax in expression context:", +patSynErr :: HsExpr RdrName -> SDoc -> RnM (HsExpr Name, FreeVars) +patSynErr e explanation = do { addErr (sep [text "Pattern syntax in expression context:", nest 4 (ppr e)] $$ - text "Did you mean to enable TypeApplications?") + explanation) ; return (EWildPat, emptyFVs) } badIpBinds :: Outputable a => SDoc -> a -> SDoc diff --git a/testsuite/tests/module/mod70.stderr b/testsuite/tests/module/mod70.stderr index f0e3042..616ef12 100644 --- a/testsuite/tests/module/mod70.stderr +++ b/testsuite/tests/module/mod70.stderr @@ -1,4 +1,2 @@ -mod70.hs:3:8: error: - Pattern syntax in expression context: ~1 - Did you mean to enable TypeApplications? +mod70.hs:3:8: error: Pattern syntax in expression context: ~1 diff --git a/testsuite/tests/rename/should_fail/rnfail016.stderr b/testsuite/tests/rename/should_fail/rnfail016.stderr index 2193ffb..4013255 100644 --- a/testsuite/tests/rename/should_fail/rnfail016.stderr +++ b/testsuite/tests/rename/should_fail/rnfail016.stderr @@ -3,6 +3,4 @@ rnfail016.hs:6:7: error: Pattern syntax in expression context: x at x Did you mean to enable TypeApplications? -rnfail016.hs:7:7: error: - Pattern syntax in expression context: ~x - Did you mean to enable TypeApplications? +rnfail016.hs:7:7: error: Pattern syntax in expression context: ~x diff --git a/testsuite/tests/rename/should_fail/rnfail051.stderr b/testsuite/tests/rename/should_fail/rnfail051.stderr index a06ddc5..9c45a61 100644 --- a/testsuite/tests/rename/should_fail/rnfail051.stderr +++ b/testsuite/tests/rename/should_fail/rnfail051.stderr @@ -1,4 +1,3 @@ rnfail051.hs:7:17: error: Pattern syntax in expression context: _ -> putStrLn "_" - Did you mean to enable TypeApplications? From git at git.haskell.org Thu Feb 25 16:16:59 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 25 Feb 2016 16:16:59 +0000 (UTC) Subject: [commit: ghc] master: (Alternative way to) address #8710 (6739397) Message-ID: <20160225161659.5B3663A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/67393977489942ef41f4f7d4a77076c15db18b92/ghc >--------------------------------------------------------------- commit 67393977489942ef41f4f7d4a77076c15db18b92 Author: George Karachalias Date: Thu Feb 25 15:50:35 2016 +0100 (Alternative way to) address #8710 Issue a separate warning per redundant (or inaccessible) clause. This way each warning can have more precice location information (the location of the clause under consideration and not the whole match). I thought that this could be too much but actually the number of such warnings is bound by the number of cases matched against (in contrast to the non-exhaustive warnings which may be exponentially more). Test Plan: validate Reviewers: simonpj, austin, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1920 GHC Trac Issues: #8710 >--------------------------------------------------------------- 67393977489942ef41f4f7d4a77076c15db18b92 compiler/deSugar/Check.hs | 45 +++++++++++++--------- .../tests/deSugar/should_compile/T2395.stderr | 4 +- .../tests/deSugar/should_compile/T5117.stderr | 4 +- .../tests/deSugar/should_compile/ds002.stderr | 16 ++++---- .../tests/deSugar/should_compile/ds003.stderr | 12 +++--- .../tests/deSugar/should_compile/ds019.stderr | 17 +++++--- .../tests/deSugar/should_compile/ds020.stderr | 24 ++++++------ .../tests/deSugar/should_compile/ds022.stderr | 12 +++--- .../tests/deSugar/should_compile/ds043.stderr | 4 +- .../tests/deSugar/should_compile/ds051.stderr | 12 +++--- .../tests/deSugar/should_compile/ds056.stderr | 4 +- .../tests/deSugar/should_compile/ds058.stderr | 4 +- testsuite/tests/driver/werror.stderr | 8 ++-- testsuite/tests/gadt/T7294.stderr | 4 +- testsuite/tests/ghci/scripts/Defer02.stderr | 4 +- .../tests/pmcheck/should_compile/pmc003.stderr | 5 ++- .../tests/pmcheck/should_compile/pmc004.stderr | 5 ++- .../tests/pmcheck/should_compile/pmc005.stderr | 7 ++-- testsuite/tests/th/TH_repUnboxedTuples.stderr | 2 +- .../tests/typecheck/should_compile/T5490.stderr | 8 ++-- 20 files changed, 112 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 67393977489942ef41f4f7d4a77076c15db18b92 From git at git.haskell.org Thu Feb 25 16:56:17 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 25 Feb 2016 16:56:17 +0000 (UTC) Subject: [commit: ghc] branch 'wip/warning-origins' created Message-ID: <20160225165617.C39553A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/warning-origins Referencing: 736c2fe705f083fe42bd5fe9318f0636b6b2fca6 From git at git.haskell.org Thu Feb 25 16:56:20 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 25 Feb 2016 16:56:20 +0000 (UTC) Subject: [commit: ghc] wip/warning-origins: Print which warning-flag controls an emitted warning. (736c2fe) Message-ID: <20160225165620.B909B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/warning-origins Link : http://ghc.haskell.org/trac/ghc/changeset/736c2fe705f083fe42bd5fe9318f0636b6b2fca6/ghc >--------------------------------------------------------------- commit 736c2fe705f083fe42bd5fe9318f0636b6b2fca6 Author: Michael Walker Date: Thu Feb 25 17:34:07 2016 +0100 Print which warning-flag controls an emitted warning. Both gcc and clang tell which warning flag a reported warning can be controlled with, this patch makes ghc do the same. More generally, this allows for annotated compiler output, where an optional annotation is displayed in brackets after the severity. Display which group enables a warning. Add flag to show which group a warning belongs to ``-f(no-)show-warning-groups``, used to show/hide the group an emitted warning belongs to. On by default. Fix compilation error in ghc-api test Reviewers: goldfire, hvr, quchen, austin, bgamari Reviewed By: quchen, bgamari Subscribers: goldfire, thomie Differential Revision: https://phabricator.haskell.org/D1943 GHC Trac Issues: #10752 >--------------------------------------------------------------- 736c2fe705f083fe42bd5fe9318f0636b6b2fca6 compiler/coreSyn/CoreLint.hs | 7 ++- compiler/deSugar/Coverage.hs | 2 +- compiler/ghci/Debugger.hs | 2 +- compiler/ghci/Linker.hs | 11 +++- compiler/iface/BinIface.hs | 9 ++- compiler/iface/LoadIface.hs | 2 +- compiler/main/CodeOutput.hs | 8 ++- compiler/main/DriverPipeline.hs | 4 +- compiler/main/DynFlags.hs | 93 ++++++++++++++++++++++++++++--- compiler/main/ErrUtils.hs | 49 +++++++++++----- compiler/main/ErrUtils.hs-boot | 1 + compiler/main/GhcMake.hs | 12 ++-- compiler/main/SysTools.hs | 4 +- compiler/main/TidyPgm.hs | 2 +- compiler/rename/RnBinds.hs | 4 +- compiler/rename/RnEnv.hs | 21 ++++--- compiler/rename/RnNames.hs | 81 ++++++++++++++++----------- compiler/rename/RnSource.hs | 42 +++++++++----- compiler/rename/RnTypes.hs | 2 +- compiler/simplCore/CoreMonad.hs | 2 +- compiler/simplCore/SimplCore.hs | 3 +- compiler/simplStg/SimplStg.hs | 2 +- compiler/typecheck/Inst.hs | 4 +- compiler/typecheck/TcAnnotations.hs | 4 +- compiler/typecheck/TcBinds.hs | 21 ++++--- compiler/typecheck/TcClassDcl.hs | 7 ++- compiler/typecheck/TcDeriv.hs | 5 +- compiler/typecheck/TcErrors.hs | 19 ++++--- compiler/typecheck/TcExpr.hs | 3 +- compiler/typecheck/TcForeign.hs | 6 +- compiler/typecheck/TcInstDcls.hs | 4 +- compiler/typecheck/TcMatches.hs | 4 +- compiler/typecheck/TcPat.hs | 3 +- compiler/typecheck/TcRnDriver.hs | 7 ++- compiler/typecheck/TcRnMonad.hs | 78 ++++++++++++++++---------- compiler/typecheck/TcSMonad.hs | 5 +- compiler/typecheck/TcSimplify.hs | 3 +- compiler/typecheck/TcSplice.hs | 2 +- compiler/typecheck/TcTyClsDecls.hs | 4 +- compiler/typecheck/TcValidity.hs | 7 ++- docs/users_guide/using-warnings.rst | 9 +++ ghc/GHCi/UI.hs | 4 +- testsuite/tests/ghc-api/T7478/T7478.hs | 4 +- utils/mkUserGuidePart/Options/Warnings.hs | 5 ++ 44 files changed, 387 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 736c2fe705f083fe42bd5fe9318f0636b6b2fca6 From git at git.haskell.org Thu Feb 25 19:49:34 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 25 Feb 2016 19:49:34 +0000 (UTC) Subject: [commit: ghc] master: Note new GHC.Generics instances in release notes (20ab2ad) Message-ID: <20160225194934.8CD223A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/20ab2adf7938bf1c6afed38509b4b01102bceff9/ghc >--------------------------------------------------------------- commit 20ab2adf7938bf1c6afed38509b4b01102bceff9 Author: Ben Gamari Date: Thu Feb 25 19:26:46 2016 +0100 Note new GHC.Generics instances in release notes >--------------------------------------------------------------- 20ab2adf7938bf1c6afed38509b4b01102bceff9 docs/users_guide/8.0.1-notes.rst | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/docs/users_guide/8.0.1-notes.rst b/docs/users_guide/8.0.1-notes.rst index 5943ed2..17c15ac 100644 --- a/docs/users_guide/8.0.1-notes.rst +++ b/docs/users_guide/8.0.1-notes.rst @@ -539,6 +539,11 @@ See ``changelog.md`` in the ``base`` package for full release notes. to define custom compile-time error messages. (see :ref:`custom-errors` and the original :ghc-wiki:`proposal `). +- The datatypes in ``GHC.Generics`` now have ``Enum``, ``Bounded``, ``Ix``, + ``Functor``, ``Applicative``, ``Monad``, ``MonadFix``, ``MonadPlus``, ``MonadZip``, + ``Foldable``, ``Foldable``, ``Traversable``, ``Generic1``, and ``Data`` instances + as appropriate. (:ghc-ticket:`9043`) + - The ``Generic`` instance for ``Proxy`` is now poly-kinded (see :ghc-ticket:`10775`) - The ``IsString`` instance for ``[Char]`` has been modified to eliminate From git at git.haskell.org Thu Feb 25 19:49:38 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 25 Feb 2016 19:49:38 +0000 (UTC) Subject: [commit: ghc] master: Improve pattern synonym error messages (add `PatSynOrigin`) (116528c) Message-ID: <20160225194938.5564A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/116528c8429257a0ae855251fd266547bb23d01d/ghc >--------------------------------------------------------------- commit 116528c8429257a0ae855251fd266547bb23d01d Author: Rik Steenkamp Date: Thu Feb 25 19:27:54 2016 +0100 Improve pattern synonym error messages (add `PatSynOrigin`) Adds a new data constructor `PatSynOrigin Bool Name` to the `CtOrigin` data type. This allows for better error messages when the origin of a wanted constraint is a pattern synonym declaration. Fixes T10873. Reviewers: mpickering, simonpj, austin, thomie, bgamari Reviewed By: simonpj, thomie, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1866 GHC Trac Issues: #10873 >--------------------------------------------------------------- 116528c8429257a0ae855251fd266547bb23d01d compiler/typecheck/TcErrors.hs | 37 +++++++++++++++++++----- compiler/typecheck/TcPatSyn.hs | 6 ++-- compiler/typecheck/TcRnTypes.hs | 7 +++++ testsuite/tests/patsyn/should_fail/T10873.hs | 10 +++++++ testsuite/tests/patsyn/should_fail/T10873.stderr | 24 +++++++++++++++ testsuite/tests/patsyn/should_fail/all.T | 1 + 6 files changed, 75 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 116528c8429257a0ae855251fd266547bb23d01d From git at git.haskell.org Thu Feb 25 22:19:20 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 25 Feb 2016 22:19:20 +0000 (UTC) Subject: [commit: packages/hpc] master: Testsuite: hpc_fork is failing for some ways (17c3771) Message-ID: <20160225221920.E484F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/hpc On branch : master Link : http://git.haskell.org/packages/hpc.git/commitdiff/17c3771e42e64ecda8970e8d6bea5c7e7fe1a4d6 >--------------------------------------------------------------- commit 17c3771e42e64ecda8970e8d6bea5c7e7fe1a4d6 Author: Thomas Miedema Date: Thu Feb 25 23:21:06 2016 +0100 Testsuite: hpc_fork is failing for some ways >--------------------------------------------------------------- 17c3771e42e64ecda8970e8d6bea5c7e7fe1a4d6 tests/fork/test.T | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/tests/fork/test.T b/tests/fork/test.T index cd8b963..5b27e62 100644 --- a/tests/fork/test.T +++ b/tests/fork/test.T @@ -2,6 +2,12 @@ setTestOpts([omit_ways(['ghci','threaded2']), when(fast(), skip)]) hpc_prefix = "perl ../hpcrun.pl --clear --exeext={exeext} --hpc={hpc}" -test('hpc_fork', [ when(opsys('mingw32'), skip), # no forkProcess on Windows - cmd_prefix(hpc_prefix) ], compile_and_run, ['-fhpc']) +failing_ways_for_11645 = \ + [w for w in prof_ways if w not in threaded_ways and w in opt_ways] + +# Skip on Windows, no forkProcess. +test('hpc_fork', + [when(opsys('mingw32'), skip), cmd_prefix(hpc_prefix), + expect_broken_for(11645, failing_ways_for_11645)], + compile_and_run, ['-fhpc']) From git at git.haskell.org Thu Feb 25 22:24:42 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 25 Feb 2016 22:24:42 +0000 (UTC) Subject: [commit: ghc] master: Testsuite: do not write empty files on 'make accept' (1badf15) Message-ID: <20160225222442.B27ED3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1badf157be3b7f604ba1ac64d2ea044d783e6e50/ghc >--------------------------------------------------------------- commit 1badf157be3b7f604ba1ac64d2ea044d783e6e50 Author: Thomas Miedema Date: Tue Feb 23 21:29:59 2016 +0100 Testsuite: do not write empty files on 'make accept' Also prevent showing '\ No newline at end of file' in diff output. >--------------------------------------------------------------- 1badf157be3b7f604ba1ac64d2ea044d783e6e50 testsuite/driver/testlib.py | 12 ++++++++++-- testsuite/tests/typecheck/should_compile/tc162.stderr | 0 2 files changed, 10 insertions(+), 2 deletions(-) diff --git a/testsuite/driver/testlib.py b/testsuite/driver/testlib.py index 1ebe6a7..2a9f141 100644 --- a/testsuite/driver/testlib.py +++ b/testsuite/driver/testlib.py @@ -1647,10 +1647,14 @@ def compare_outputs(way, kind, normaliser, expected_file, actual_file, way in getTestOpts().expect_fail_for): if_verbose(1, 'Test is expected to fail. Not accepting new output.') return 0 - elif config.accept: + elif config.accept and actual_raw: if_verbose(1, 'Accepting new output.') write_file(expected_path, actual_raw) return 1 + elif config.accept: + if_verbose(1, 'No output. Deleting {0}.'.format(expected_path)) + rm_no_fail(expected_path) + return 1 else: return 0 @@ -2306,4 +2310,8 @@ def printFailingTestInfosSummary(file, testInfos): file.write('\n') def modify_lines(s, f): - return '\n'.join([f(l) for l in s.splitlines()]) + s = '\n'.join([f(l) for l in s.splitlines()]) + if s and s[-1] != '\n': + # Prevent '\ No newline at end of file' warnings when diffing. + s += '\n' + return s diff --git a/testsuite/tests/typecheck/should_compile/tc162.stderr b/testsuite/tests/typecheck/should_compile/tc162.stderr deleted file mode 100644 index e69de29..0000000 From git at git.haskell.org Thu Feb 25 22:24:45 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 25 Feb 2016 22:24:45 +0000 (UTC) Subject: [commit: ghc] master: Testsuite: for tests that use TH, omit *all* prof_ways (e02b8c8) Message-ID: <20160225222445.6A3AA3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e02b8c8dadcc77c0c40d5346246f6a3b548258c2/ghc >--------------------------------------------------------------- commit e02b8c8dadcc77c0c40d5346246f6a3b548258c2 Author: Thomas Miedema Date: Mon Feb 22 18:55:30 2016 +0100 Testsuite: for tests that use TH, omit *all* prof_ways Instead of just profasm and profthreaded. And at least until -fexternal-interpreter is the default. Also: * WAY=profc doesn't exist anymore. * Omit all threaded_ways for conc039, not just a few. >--------------------------------------------------------------- e02b8c8dadcc77c0c40d5346246f6a3b548258c2 testsuite/config/ghc | 2 +- testsuite/tests/annotations/should_compile/all.T | 5 +---- testsuite/tests/annotations/should_compile/th/all.T | 4 ++-- testsuite/tests/annotations/should_run/all.T | 2 +- testsuite/tests/concurrent/should_run/all.T | 2 +- testsuite/tests/haddock/haddock_examples/test.T | 2 +- testsuite/tests/overloadedrecflds/should_run/all.T | 8 +++++--- testsuite/tests/parser/should_compile/all.T | 4 ++-- testsuite/tests/partial-sigs/should_compile/all.T | 3 ++- testsuite/tests/quasiquotation/qq005/test.T | 2 +- testsuite/tests/quasiquotation/qq007/test.T | 1 + testsuite/tests/quasiquotation/qq008/test.T | 1 + testsuite/tests/quasiquotation/qq009/test.T | 1 + testsuite/tests/quotes/TH_spliceViewPat/test.T | 5 ++--- testsuite/tests/rts/all.T | 8 ++++---- testsuite/tests/simplCore/should_compile/all.T | 2 +- 16 files changed, 27 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 e02b8c8dadcc77c0c40d5346246f6a3b548258c2 From git at git.haskell.org Thu Feb 25 22:24:48 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 25 Feb 2016 22:24:48 +0000 (UTC) Subject: [commit: ghc] master: Testsuite: delete empty files [skip ci] (9b49c65) Message-ID: <20160225222448.53F173A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9b49c65fe696b7a24f3858e3f23e1d73f9b92a21/ghc >--------------------------------------------------------------- commit 9b49c65fe696b7a24f3858e3f23e1d73f9b92a21 Author: Thomas Miedema Date: Tue Feb 23 21:37:22 2016 +0100 Testsuite: delete empty files [skip ci] >--------------------------------------------------------------- 9b49c65fe696b7a24f3858e3f23e1d73f9b92a21 libraries/base/tests/IO/misc001.stdout | 0 libraries/base/tests/System/exitWith001.stdout | 0 libraries/base/tests/performGC001.stdout | 0 testsuite/tests/annotations/should_compile/ann01.stderr | 0 testsuite/tests/array/should_run/arr014.stdout | 0 testsuite/tests/cabal/cabal06/cabal06.stderr | 0 testsuite/tests/cabal/pkg01.stderr | 0 testsuite/tests/cabal/pkg02/pkg02.stderr | 0 testsuite/tests/codeGen/should_run/cgrun016.stdout | 0 testsuite/tests/codeGen/should_run/cgrun025.stdout | 0 testsuite/tests/codeGen/should_run/cgrun038.stdout | 0 testsuite/tests/codeGen/should_run/cgrun043.stdout | 0 testsuite/tests/codeGen/should_run/cgrun045.stdout | 0 testsuite/tests/concurrent/should_run/conc031.stdout | 0 testsuite/tests/concurrent/should_run/conc041.stderr | 0 testsuite/tests/concurrent/should_run/conc042.stderr | 0 testsuite/tests/concurrent/should_run/conc043.stderr | 0 testsuite/tests/concurrent/should_run/conc044.stderr | 0 testsuite/tests/concurrent/should_run/conc045.stderr | 0 testsuite/tests/deSugar/should_compile/ds-wildcard.stderr | 0 testsuite/tests/deSugar/should_compile/ds001.stderr | 0 testsuite/tests/deSugar/should_compile/ds004.stderr | 0 testsuite/tests/deSugar/should_compile/ds005.stderr | 0 testsuite/tests/deSugar/should_compile/ds006.stderr | 0 testsuite/tests/deSugar/should_compile/ds007.stderr | 0 testsuite/tests/deSugar/should_compile/ds008.stderr | 0 testsuite/tests/deSugar/should_compile/ds009.stderr | 0 testsuite/tests/deSugar/should_compile/ds010.stderr | 0 testsuite/tests/deSugar/should_compile/ds011.stderr | 0 testsuite/tests/deSugar/should_compile/ds012.stderr | 0 testsuite/tests/deSugar/should_compile/ds013.stderr | 0 testsuite/tests/deSugar/should_compile/ds014.stderr | 0 testsuite/tests/deSugar/should_compile/ds015.stderr | 0 testsuite/tests/deSugar/should_compile/ds016.stderr | 0 testsuite/tests/deSugar/should_compile/ds017.stderr | 0 testsuite/tests/deSugar/should_compile/ds018.stderr | 0 testsuite/tests/deSugar/should_compile/ds021.stderr | 0 testsuite/tests/deSugar/should_compile/ds023.stderr | 0 testsuite/tests/deSugar/should_compile/ds024.stderr | 0 testsuite/tests/deSugar/should_compile/ds025.stderr | 0 testsuite/tests/deSugar/should_compile/ds026.stderr | 0 testsuite/tests/deSugar/should_compile/ds027.stderr | 0 testsuite/tests/deSugar/should_compile/ds028.stderr | 0 testsuite/tests/deSugar/should_compile/ds029.stderr | 0 testsuite/tests/deSugar/should_compile/ds030.stderr | 0 testsuite/tests/deSugar/should_compile/ds031.stderr | 0 testsuite/tests/deSugar/should_compile/ds032.stderr | 0 testsuite/tests/deSugar/should_compile/ds033.stderr | 0 testsuite/tests/deSugar/should_compile/ds034.stderr | 0 testsuite/tests/deSugar/should_compile/ds035.stderr | 0 testsuite/tests/deSugar/should_compile/ds036.stderr | 0 testsuite/tests/deSugar/should_compile/ds037.stderr | 0 testsuite/tests/deSugar/should_compile/ds038.stderr | 0 testsuite/tests/deSugar/should_compile/ds039.stderr | 0 testsuite/tests/deSugar/should_compile/ds040.stderr | 0 testsuite/tests/deSugar/should_compile/ds052.stderr | 0 testsuite/tests/deSugar/should_run/dsrun005.stdout | 0 testsuite/tests/deriving/should_compile/drv001.stderr | 0 testsuite/tests/deriving/should_compile/drv002.stderr | 0 testsuite/tests/deriving/should_compile/drv004.stderr | 0 testsuite/tests/deriving/should_compile/drv005.stderr | 0 testsuite/tests/deriving/should_compile/drv006.stderr | 0 testsuite/tests/deriving/should_compile/drv007.stderr | 0 testsuite/tests/deriving/should_compile/drv008.stderr | 0 testsuite/tests/deriving/should_compile/drv009.stderr | 0 testsuite/tests/deriving/should_compile/drv010.stderr | 0 testsuite/tests/deriving/should_run/drvrun005.stderr | 0 testsuite/tests/determinism/determ002/determ002.stderr | 0 testsuite/tests/driver/T10970a.stderr | 0 testsuite/tests/driver/T437/T437.stderr | 0 testsuite/tests/driver/recomp015/recomp015.stderr | 0 testsuite/tests/driver/shared001.stderr | 0 testsuite/tests/ffi/should_compile/cc001.stderr | 0 testsuite/tests/gadt/lazypatok.stderr | 0 testsuite/tests/ghci.debugger/scripts/break001.stderr | 0 testsuite/tests/ghci.debugger/scripts/print018.stderr | 0 testsuite/tests/ghci.debugger/scripts/print020.stderr | 0 testsuite/tests/ghci/linking/ghcilink002.stderr-mingw32 | 0 testsuite/tests/ghci/linking/ghcilink003.stdout | 0 testsuite/tests/ghci/linking/ghcilink005.stderr-mingw32 | 0 testsuite/tests/ghci/prog014/prog014.stdout | 0 testsuite/tests/ghci/scripts/T5979.stdout | 0 testsuite/tests/ghci/scripts/T6018ghci.stdout | 0 testsuite/tests/ghci/scripts/T8640.stdout | 0 testsuite/tests/ghci/scripts/ghci004.stderr | 0 testsuite/tests/ghci/scripts/ghci006.stderr | 0 testsuite/tests/ghci/scripts/ghci022.stdout | 0 testsuite/tests/ghci/scripts/ghci024.stderr | 0 testsuite/tests/indexed-types/should_compile/GADT12.stderr | 0 testsuite/tests/indexed-types/should_compile/Gentle.stderr | 0 testsuite/tests/indexed-types/should_compile/T4120.stderr | 0 testsuite/tests/indexed-types/should_fail/NonLinearSigErr.stderr | 0 testsuite/tests/indexed-types/should_fail/SimpleFail10.stderr | 0 testsuite/tests/indexed-types/should_fail/T4254.stderr | 0 .../should_run/subsections_via_symbols/subsections_via_symbols.stderr | 0 testsuite/tests/module/mod64.stderr | 0 testsuite/tests/module/mod65.stderr | 0 testsuite/tests/parser/should_compile/read002.stderr | 0 testsuite/tests/parser/should_compile/read007.stderr | 0 testsuite/tests/parser/should_compile/read010.stderr | 0 testsuite/tests/parser/should_fail/readFail009.stdout | 0 testsuite/tests/parser/unicode/utf8_001.stderr | 0 testsuite/tests/parser/unicode/utf8_023.stderr | 0 testsuite/tests/plugins/plugins06.stdout | 0 testsuite/tests/pmcheck/should_compile/T11276.stderr | 0 testsuite/tests/pmcheck/should_compile/T2006.stderr | 0 testsuite/tests/pmcheck/should_compile/T3078.stderr | 0 testsuite/tests/pmcheck/should_compile/T322.stderr | 0 testsuite/tests/pmcheck/should_compile/T366.stderr | 0 testsuite/tests/pmcheck/should_compile/T3927.stderr | 0 testsuite/tests/pmcheck/should_compile/T3927a.stderr | 0 testsuite/tests/pmcheck/should_compile/T3927b.stderr | 0 testsuite/tests/pmcheck/should_compile/T4139.stderr | 0 testsuite/tests/pmcheck/should_compile/T6124.stderr | 0 testsuite/tests/pmcheck/should_compile/T7669a.stderr | 0 testsuite/tests/pmcheck/should_compile/T8970.stderr | 0 testsuite/tests/pmcheck/should_compile/T9951.stderr | 0 testsuite/tests/pmcheck/should_compile/pmc002.stderr | 0 testsuite/tests/pmcheck/should_compile/pmc006.stderr | 0 testsuite/tests/primops/should_run/T11296.stdout | 0 testsuite/tests/programs/hs-boot/hs-boot.stderr | 0 testsuite/tests/quasiquotation/qq005/qq005.stderr | 0 testsuite/tests/rebindable/rebindable1.stderr | 0 testsuite/tests/rebindable/rebindable5.stderr | 0 testsuite/tests/rename/prog004/rename.prog004.stderr | 0 testsuite/tests/rename/prog006/rn.prog006.stderr | 0 testsuite/tests/rename/should_compile/T3103/T3103.stderr | 0 testsuite/tests/rename/should_compile/T9127.stderr | 0 testsuite/tests/rename/should_compile/rn003.stderr | 0 testsuite/tests/rename/should_compile/rn005.stderr | 0 testsuite/tests/rename/should_compile/rn006.stderr | 0 testsuite/tests/rename/should_compile/rn009.stderr | 0 testsuite/tests/rename/should_compile/rn010.stderr | 0 testsuite/tests/rename/should_compile/rn011.stderr | 0 testsuite/tests/rename/should_compile/rn012.stderr | 0 testsuite/tests/rename/should_compile/rn013.stderr | 0 testsuite/tests/rename/should_compile/rn016.stderr | 0 testsuite/tests/rename/should_compile/rn018.stderr | 0 testsuite/tests/rename/should_compile/rn022.stderr | 0 testsuite/tests/rename/should_compile/rn025.stderr | 0 testsuite/tests/rename/should_compile/rn056.stderr | 0 testsuite/tests/rename/should_compile/rn057.stderr | 0 testsuite/tests/rename/should_compile/timing001.stderr | 0 testsuite/tests/rename/should_compile/timing002.stderr | 0 testsuite/tests/rename/should_compile/timing003.stderr | 0 testsuite/tests/rename/should_fail/rnfail020.stderr | 0 testsuite/tests/rts/T5435_dyn_asm.stderr-mingw32 | 0 testsuite/tests/rts/T5435_dyn_gcc.stderr-mingw32 | 0 testsuite/tests/safeHaskell/check/pkg01/ImpSafeOnly05.stdout | 0 testsuite/tests/safeHaskell/ghci/p18.stderr | 0 testsuite/tests/safeHaskell/ghci/p2.stderr | 0 testsuite/tests/safeHaskell/safeInfered/UnsafeInfered13.stderr | 0 testsuite/tests/safeHaskell/safeInfered/UnsafeInfered14.stderr | 0 testsuite/tests/safeHaskell/safeInfered/UnsafeInfered15.stderr | 0 testsuite/tests/safeHaskell/safeInfered/UnsafeInfered16.stderr | 0 testsuite/tests/safeHaskell/safeInfered/UnsafeInfered17.stderr | 0 testsuite/tests/safeHaskell/safeInfered/UnsafeInfered19.stderr | 0 testsuite/tests/safeHaskell/safeLanguage/SafeLang16.stdout | 0 testsuite/tests/safeHaskell/safeLanguage/SafeRecomp01.stderr | 0 testsuite/tests/safeHaskell/safeLanguage/SafeRecomp01.stdout | 0 testsuite/tests/safeHaskell/safeLanguage/SafeRecomp02.stderr | 0 testsuite/tests/safeHaskell/safeLanguage/SafeRecomp02.stdout | 0 testsuite/tests/simplCore/should_compile/T5359b.stderr | 0 testsuite/tests/simplCore/should_compile/T5550.stderr | 0 testsuite/tests/simplCore/should_compile/T7162.stderr | 0 testsuite/tests/simplCore/should_compile/simpl001.stderr | 0 testsuite/tests/simplCore/should_compile/simpl002.stderr | 0 testsuite/tests/simplCore/should_compile/simpl003.stderr | 0 testsuite/tests/simplCore/should_compile/simpl004.stderr | 0 testsuite/tests/simplCore/should_compile/simpl005.stderr | 0 testsuite/tests/simplCore/should_run/T2756.stdout | 0 testsuite/tests/simplCore/should_run/simplrun001.stderr | 0 testsuite/tests/stranal/should_compile/default.stderr | 0 testsuite/tests/stranal/should_compile/fact.stderr | 0 testsuite/tests/stranal/should_compile/fun.stderr | 0 testsuite/tests/stranal/should_compile/goo.stderr | 0 testsuite/tests/stranal/should_compile/ins.stderr | 0 testsuite/tests/stranal/should_compile/map.stderr | 0 testsuite/tests/stranal/should_compile/sim.stderr | 0 testsuite/tests/stranal/should_compile/str002.stderr | 0 testsuite/tests/stranal/should_compile/syn.stderr | 0 testsuite/tests/stranal/should_compile/test.stderr | 0 testsuite/tests/stranal/should_compile/tst.stderr | 0 testsuite/tests/stranal/should_compile/unu.stderr | 0 testsuite/tests/stranal/should_run/T10148.stdout | 0 testsuite/tests/th/T1476b.stderr | 0 testsuite/tests/th/T5434.stderr | 0 testsuite/tests/th/T8333.stdout | 0 testsuite/tests/th/T8624.stderr | 0 testsuite/tests/typecheck/should_compile/T2846.stderr | 0 testsuite/tests/typecheck/should_compile/T9497b.stderr | 0 testsuite/tests/typecheck/should_compile/T9497c.stderr | 0 testsuite/tests/typecheck/should_compile/tc056.stderr | 0 testsuite/tests/typecheck/should_compile/tc216.stderr | 0 testsuite/tests/typecheck/should_fail/tcfail071.stderr | 0 testsuite/tests/typecheck/should_fail/tcfail124.stderr | 0 testsuite/tests/typecheck/should_fail/tcfail126.stderr | 0 testsuite/tests/typecheck/should_fail/tcfail138.stderr | 0 testsuite/tests/typecheck/should_fail/tcfail144.stderr | 0 testsuite/tests/typecheck/should_fail/tcfail145.stderr | 0 testsuite/tests/typecheck/should_fail/tcfail149.stderr | 0 testsuite/tests/typecheck/should_fail/tcfail172.stderr | 0 testsuite/tests/typecheck/should_fail/tcfail188.stderr | 0 testsuite/tests/typecheck/should_fail/tcfail205.stderr | 0 testsuite/tests/typecheck/should_run/tcrun026.stderr | 0 205 files changed, 0 insertions(+), 0 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 9b49c65fe696b7a24f3858e3f23e1d73f9b92a21 From git at git.haskell.org Thu Feb 25 22:24:51 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 25 Feb 2016 22:24:51 +0000 (UTC) Subject: [commit: ghc] master: Mark tests for #11643, #11644, #11645 and #9406 expect_broken (90fa8cf) Message-ID: <20160225222451.1489F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/90fa8cf2bf1677545c3f4a8bc967b1674822e90a/ghc >--------------------------------------------------------------- commit 90fa8cf2bf1677545c3f4a8bc967b1674822e90a Author: Thomas Miedema Date: Thu Feb 25 14:15:41 2016 +0100 Mark tests for #11643, #11644, #11645 and #9406 expect_broken For opt_ways or prof_ways only. indexed-types/should_compile/all.T called setTestOpts to not run the tests with opt_ways. Since I'm finding regressions for opt_ways, I removed it. This only makes a difference when running `./validate --slow` or `make slowtest`. Update submodule hpc. >--------------------------------------------------------------- 90fa8cf2bf1677545c3f4a8bc967b1674822e90a libraries/hpc | 2 +- testsuite/tests/indexed-types/should_compile/all.T | 12 +++++------- testsuite/tests/rts/all.T | 4 +++- 3 files changed, 9 insertions(+), 9 deletions(-) diff --git a/libraries/hpc b/libraries/hpc index 63adbd0..17c3771 160000 --- a/libraries/hpc +++ b/libraries/hpc @@ -1 +1 @@ -Subproject commit 63adbd0ca8be391358c0313a94d5c1801ceafb55 +Subproject commit 17c3771e42e64ecda8970e8d6bea5c7e7fe1a4d6 diff --git a/testsuite/tests/indexed-types/should_compile/all.T b/testsuite/tests/indexed-types/should_compile/all.T index bee76d2..b7223cc 100644 --- a/testsuite/tests/indexed-types/should_compile/all.T +++ b/testsuite/tests/indexed-types/should_compile/all.T @@ -1,6 +1,3 @@ -# Keep optimised tests, so we test coercion optimisation -setTestOpts(omit_ways(['optasm', 'optllvm', 'hpc'])) - test('Simple1', normal, compile, ['']) test('Simple2', normal, compile, ['']) test('Simple3', normal, compile, ['']) @@ -81,13 +78,13 @@ test('Class3', normal, compile, ['']) test('Refl', normal, compile, ['']) test('Refl2', normal, compile, ['']) -test('Rules1', normal, compile, ['']) +test('Rules1', [expect_broken_for(11643, opt_ways)], compile, ['']) test('Numerals', normal, compile, ['']) test('ColInference', normal, compile, ['']) test('ColInference2', normal, compile, ['']) -test('ColInference3', normal, compile, ['']) +test('ColInference3', [expect_broken_for(11643, opt_ways)], compile, ['']) test('ColInference4', normal, compile, ['']) test('ColInference5', normal, compile, ['']) test('ColInference6', normal, compile, ['']) @@ -131,7 +128,7 @@ test('T3208b', normal, compile_fail, ['']) test('T3418', normal, compile, ['']) test('T3423', normal, compile, ['']) test('T2850', normal, compile, ['']) -test('T3220', normal, compile, ['']) +test('T3220', [expect_broken_for(11644, opt_ways)], compile, ['']) test('T3590', normal, compile, ['']) test('CoTest3', normal, compile, ['']) test('Roman1', normal, compile, ['']) @@ -209,7 +206,8 @@ test('T7489', normal, compile, ['']) test('T7585', normal, compile, ['']) test('T7282', normal, compile, ['']) test('T7804', normal, compile, ['']) -test('T7837', normal, compile, ['-O -ddump-rule-firings']) +test('T7837', expect_broken_for(9406, prof_ways), compile, + ['-O -ddump-rule-firings']) test('T4185', normal, compile, ['']) # Caused infinite loop in the compiler diff --git a/testsuite/tests/rts/all.T b/testsuite/tests/rts/all.T index 60513ca..b81e0e8 100644 --- a/testsuite/tests/rts/all.T +++ b/testsuite/tests/rts/all.T @@ -255,7 +255,9 @@ test('T9045', [ omit_ways(['ghci']), extra_run_opts('10000 +RTS -A8k -RTS') ], c # I couldn't reproduce 9078 with the -threaded runtime, but could easily # with the non-threaded one. -test('T9078', [ omit_ways(threaded_ways) ], compile_and_run, ['-with-rtsopts="-DS" -debug']) +# Skip the prof_ways, because we don't build the 'debug_p' rts way by default. +test('T9078', [omit_ways(threaded_ways + prof_ways)], compile_and_run, + ['-with-rtsopts="-DS" -debug']) test('T10017', [ when(opsys('mingw32'), skip) , only_ways(threaded_ways), extra_run_opts('+RTS -N2 -RTS') ], compile_and_run, ['']) From git at git.haskell.org Thu Feb 25 22:24:53 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 25 Feb 2016 22:24:53 +0000 (UTC) Subject: [commit: ghc] master: Testsuite: Introduce config.plugin_way_flags. (8e6e022) Message-ID: <20160225222453.BF31C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8e6e022216b19b10841a896ee1a0b08e019a9481/ghc >--------------------------------------------------------------- commit 8e6e022216b19b10841a896ee1a0b08e019a9481 Author: Thomas Miedema Date: Thu Feb 25 01:00:48 2016 +0100 Testsuite: Introduce config.plugin_way_flags. Refactoring only. >--------------------------------------------------------------- 8e6e022216b19b10841a896ee1a0b08e019a9481 testsuite/config/ghc | 4 ++++ testsuite/mk/boilerplate.mk | 13 +++++++++++++ testsuite/tests/annotations/should_compile/all.T | 2 +- testsuite/tests/annotations/should_compile/th/all.T | 2 +- testsuite/tests/annotations/should_run/all.T | 2 +- testsuite/tests/plugins/all.T | 2 +- testsuite/tests/simplCore/should_compile/all.T | 2 +- testsuite/tests/th/all.T | 3 ++- 8 files changed, 24 insertions(+), 6 deletions(-) diff --git a/testsuite/config/ghc b/testsuite/config/ghc index 63488dd..31b644a 100644 --- a/testsuite/config/ghc +++ b/testsuite/config/ghc @@ -203,18 +203,22 @@ def get_compiler_info(): # GHC < 7.7 doesn't have a "GHC Dynamic" field ghcDynamic = False + # See Note [WayFlags] if ghcDynamic: config.ghc_th_way_flags = "-dynamic" config.ghci_way_flags = "-dynamic" + config.plugin_way_flags = "-dynamic" config.ghc_th_way = "dyn" config.ghc_plugin_way = "dyn" elif config.compiler_profiled: config.ghc_th_way_flags = "-prof" config.ghci_way_flags = "-prof" + config.plugin_way_flags = "-prof" config.ghc_th_way = "prof" config.ghc_plugin_way = "prof" else: config.ghc_th_way_flags = "-static" config.ghci_way_flags = "-static" + config.plugin_way_flags = "-static" config.ghc_th_way = "normal" config.ghc_plugin_way = "normal" diff --git a/testsuite/mk/boilerplate.mk b/testsuite/mk/boilerplate.mk index b51cc89..077d503 100644 --- a/testsuite/mk/boilerplate.mk +++ b/testsuite/mk/boilerplate.mk @@ -247,6 +247,19 @@ ifeq "$(findstring clean,$(MAKECMDGOALS))" "" include $(ghc-config-mk) endif +# Note [WayFlags] +# +# Code that uses TemplateHaskell should either use -fexternal-interpreter, or +# be built in the same way as the compiler (-prof, -dynamic or -static). +# +# We therefore add those flags to ghcThWayFlags and ghc_th_way_flags here and +# in testsuite/config/ghc, and use them in all tests that use TemplateHaskell. +# +# The same applies to code loaded in regular GHCi, and code that uses the +# plugin system. +# +# See #11495 and TEST=TH_spliceE5_prof for a complication: trying to compile +# code that uses TemplateHaskell with -prof, while GhcDynamic=YES. ifeq "$(GhcDynamic)" "YES" ghcThWayFlags = -dynamic ghciWayFlags = -dynamic diff --git a/testsuite/tests/annotations/should_compile/all.T b/testsuite/tests/annotations/should_compile/all.T index 57efc26..d8d6ad8 100644 --- a/testsuite/tests/annotations/should_compile/all.T +++ b/testsuite/tests/annotations/should_compile/all.T @@ -1,6 +1,6 @@ # Annotations, like Template Haskell, require runtime evaluation. In # order for this to work with profiling, we would have to build the -# program twice and use -osuf p_o (see the TH_splitE5_prof test). For +# program twice and use -osuf p_o (see the TH_spliceE5_prof test). For # now, just disable the profiling ways. test('ann01', [req_interp, omit_ways(['profasm','profthreaded'])], diff --git a/testsuite/tests/annotations/should_compile/th/all.T b/testsuite/tests/annotations/should_compile/th/all.T index a1681cf..8684de2 100644 --- a/testsuite/tests/annotations/should_compile/th/all.T +++ b/testsuite/tests/annotations/should_compile/th/all.T @@ -1,6 +1,6 @@ # Annotations and Template Haskell, require runtime evaluation. In # order for this to work with profiling, we would have to build the -# program twice and use -osuf p_o (see the TH_splitE5_prof test). For +# program twice and use -osuf p_o (see the TH_spliceE5_prof test). For # now, just disable the profiling ways. test('annth_make', diff --git a/testsuite/tests/annotations/should_run/all.T b/testsuite/tests/annotations/should_run/all.T index 183ff97..17f1631 100644 --- a/testsuite/tests/annotations/should_run/all.T +++ b/testsuite/tests/annotations/should_run/all.T @@ -3,7 +3,7 @@ setTestOpts(when(fast(), skip)) # Annotations, like Template Haskell, require runtime evaluation. In # order for this to work with profiling, we would have to build the -# program twice and use -osuf p_o (see the TH_splitE5_prof test). For +# program twice and use -osuf p_o (see the TH_spliceE5_prof test). For # now, just disable the profiling and dynamic ways, and use # config.ghc_th_way_flags. test('annrun01', diff --git a/testsuite/tests/plugins/all.T b/testsuite/tests/plugins/all.T index 189e519..7cf412c 100644 --- a/testsuite/tests/plugins/all.T +++ b/testsuite/tests/plugins/all.T @@ -13,7 +13,7 @@ test('plugins02', [pre_cmd('$MAKE -s --no-print-directory -C simple-plugin package.plugins02'), clean_cmd('$MAKE -s --no-print-directory -C simple-plugin clean.plugins02')], compile_fail, - ['-package-db simple-plugin/pkg.plugins02/local.package.conf -fplugin Simple.BadlyTypedPlugin -package simple-plugin ' + config.ghci_way_flags]) + ['-package-db simple-plugin/pkg.plugins02/local.package.conf -fplugin Simple.BadlyTypedPlugin -package simple-plugin ' + config.plugin_way_flags]) test('plugins03', [pre_cmd('$MAKE -s --no-print-directory -C simple-plugin package.plugins03'), diff --git a/testsuite/tests/simplCore/should_compile/all.T b/testsuite/tests/simplCore/should_compile/all.T index 803e344..6c0380f 100644 --- a/testsuite/tests/simplCore/should_compile/all.T +++ b/testsuite/tests/simplCore/should_compile/all.T @@ -179,7 +179,7 @@ test('T7702', [(wordsize(32), 18, 70), (wordsize(64), 18, 70)]) ], compile, - ['-v0 -package-db T7702plugin/pkg.T7702/local.package.conf -fplugin T7702Plugin -package T7702plugin ' + config.ghci_way_flags]) + ['-v0 -package-db T7702plugin/pkg.T7702/local.package.conf -fplugin T7702Plugin -package T7702plugin ' + config.plugin_way_flags]) test('T7995', # RULE doesn't seem to fire unless optimizations are turned on. diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T index 5b72ba0..c39136b 100644 --- a/testsuite/tests/th/all.T +++ b/testsuite/tests/th/all.T @@ -38,7 +38,8 @@ test('TH_NestedSplices', multimod_compile, ['TH_NestedSplices.hs', '-v0 ' + config.ghc_th_way_flags]) -# Testing profiling with TH is a bit tricky; we've already disabled +# Testing profiling with TH is a bit tricky (when not using +# -fexternal-interpreter); we've already disabled # the prof way above, and also we want to add options specifically for # profiling (-osuf p.o) because this is necessary when mixing # profiling w/ TH. Furthermore we must have built the program the From git at git.haskell.org Thu Feb 25 22:55:09 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 25 Feb 2016 22:55:09 +0000 (UTC) Subject: [commit: ghc] master: Print which warning-flag controls an emitted warning (bb5afd3) Message-ID: <20160225225509.D8E8C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/bb5afd3c274011c5ea302210b4c290ec1f83209c/ghc >--------------------------------------------------------------- commit bb5afd3c274011c5ea302210b4c290ec1f83209c Author: Michael Walker Date: Thu Feb 25 17:34:07 2016 +0100 Print which warning-flag controls an emitted warning Both gcc and clang tell which warning flag a reported warning can be controlled with, this patch makes ghc do the same. More generally, this allows for annotated compiler output, where an optional annotation is displayed in brackets after the severity. This also adds a new flag `-f(no-)show-warning-groups` to control whether to show which warning-group (such as `-Wall` or `-Wcompat`) a warning belongs to. This flag is on by default. This implements #10752 Reviewed By: quchen, bgamari, hvr Differential Revision: https://phabricator.haskell.org/D1943 >--------------------------------------------------------------- bb5afd3c274011c5ea302210b4c290ec1f83209c compiler/coreSyn/CoreLint.hs | 7 +- compiler/deSugar/Coverage.hs | 2 +- compiler/ghci/Debugger.hs | 2 +- compiler/ghci/Linker.hs | 11 ++- compiler/iface/BinIface.hs | 9 +- compiler/iface/LoadIface.hs | 2 +- compiler/main/CodeOutput.hs | 8 +- compiler/main/DriverPipeline.hs | 4 +- compiler/main/DynFlags.hs | 93 ++++++++++++++++-- compiler/main/ErrUtils.hs | 49 +++++++--- compiler/main/ErrUtils.hs-boot | 1 + compiler/main/GhcMake.hs | 12 +-- compiler/main/SysTools.hs | 4 +- compiler/main/TidyPgm.hs | 2 +- compiler/rename/RnBinds.hs | 4 +- compiler/rename/RnEnv.hs | 21 ++-- compiler/rename/RnNames.hs | 81 +++++++++------- compiler/rename/RnSource.hs | 42 +++++--- compiler/rename/RnTypes.hs | 2 +- compiler/simplCore/CoreMonad.hs | 2 +- compiler/simplCore/SimplCore.hs | 3 +- compiler/simplStg/SimplStg.hs | 2 +- compiler/typecheck/Inst.hs | 4 +- compiler/typecheck/TcAnnotations.hs | 4 +- compiler/typecheck/TcBinds.hs | 25 ++--- compiler/typecheck/TcClassDcl.hs | 7 +- compiler/typecheck/TcDeriv.hs | 5 +- compiler/typecheck/TcErrors.hs | 19 ++-- compiler/typecheck/TcExpr.hs | 3 +- compiler/typecheck/TcForeign.hs | 6 +- compiler/typecheck/TcInstDcls.hs | 4 +- compiler/typecheck/TcMatches.hs | 4 +- compiler/typecheck/TcPat.hs | 3 +- compiler/typecheck/TcRnDriver.hs | 7 +- compiler/typecheck/TcRnMonad.hs | 78 +++++++++------ compiler/typecheck/TcSMonad.hs | 5 +- compiler/typecheck/TcSimplify.hs | 3 +- compiler/typecheck/TcSplice.hs | 2 +- compiler/typecheck/TcTyClsDecls.hs | 4 +- compiler/typecheck/TcValidity.hs | 7 +- docs/users_guide/using-warnings.rst | 9 ++ ghc/GHCi/UI.hs | 4 +- .../tests/deSugar/should_compile/ds041.stderr | 10 +- .../tests/deSugar/should_compile/ds053.stderr | 3 +- .../tests/dependent/should_compile/T11241.stderr | 2 +- .../tests/deriving/should_compile/T4966.stderr | 10 +- .../deriving/should_compile/deriving-1935.stderr | 24 ++--- .../tests/deriving/should_compile/drv003.stderr | 16 ++-- testsuite/tests/driver/werror.stderr | 12 ++- testsuite/tests/ffi/should_compile/T1357.stderr | 4 +- testsuite/tests/ghc-api/T7478/T7478.hs | 4 +- .../tests/ghc-api/apirecomp001/apirecomp001.stderr | 12 +-- testsuite/tests/ghci/scripts/T5820.stderr | 8 +- testsuite/tests/ghci/scripts/T8353.stderr | 6 +- testsuite/tests/ghci/scripts/ghci019.stderr | 2 +- .../haddock/haddock_examples/haddock.Test.stderr | 12 ++- .../indexed-types/should_compile/Class3.stderr | 8 +- .../indexed-types/should_compile/Simple2.stderr | 48 +++++----- .../indexed-types/should_compile/T3023.stderr | 2 +- .../indexed-types/should_compile/T8889.stderr | 2 +- .../should_compile/UnusedTyVarWarnings.stderr | 13 +-- .../UnusedTyVarWarningsNamedWCs.stderr | 10 +- .../tests/indexed-types/should_fail/T7862.stderr | 12 +-- testsuite/tests/module/mod128.stderr | 3 +- testsuite/tests/module/mod14.stderr | 2 +- testsuite/tests/module/mod176.stderr | 2 +- testsuite/tests/module/mod177.stderr | 2 +- testsuite/tests/module/mod5.stderr | 2 +- testsuite/tests/module/mod89.stderr | 4 +- testsuite/tests/monadfail/MonadFailWarnings.stderr | 8 +- .../MonadFailWarningsWithRebindableSyntax.stderr | 2 +- .../should_fail/overloadedrecfldsfail05.stderr | 2 +- .../should_fail/overloadedrecfldsfail06.stderr | 14 +-- .../should_fail/overloadedrecfldsfail11.stderr | 2 +- .../should_fail/overloadedrecfldsfail12.stderr | 6 +- testsuite/tests/parser/should_compile/T2245.stderr | 6 +- testsuite/tests/parser/should_compile/T3303.stderr | 4 +- .../tests/parser/should_compile/read014.stderr | 10 +- .../should_compile/ExprSigLocal.stderr | 4 +- .../partial-sigs/should_compile/SplicesUsed.stderr | 22 ++--- .../partial-sigs/should_compile/T10403.stderr | 6 +- .../partial-sigs/should_compile/T10438.stderr | 2 +- .../partial-sigs/should_compile/T10463.stderr | 14 +-- .../partial-sigs/should_compile/T10519.stderr | 2 +- .../partial-sigs/should_compile/T11016.stderr | 4 +- .../partial-sigs/should_compile/T11192.stderr | 4 +- .../partial-sigs/should_compile/TypedSplice.stderr | 28 +++--- .../WarningWildcardInstantiations.stderr | 14 +-- .../should_fail/Defaulting1MROff.stderr | 2 +- .../tests/partial-sigs/should_fail/T11122.stderr | 2 +- .../tests/patsyn/should_compile/T11283.stderr | 2 +- testsuite/tests/patsyn/should_fail/T11053.stderr | 10 +- testsuite/tests/rename/should_compile/T1789.stderr | 8 +- testsuite/tests/rename/should_compile/T17a.stderr | 4 +- testsuite/tests/rename/should_compile/T17b.stderr | 4 +- testsuite/tests/rename/should_compile/T17c.stderr | 4 +- testsuite/tests/rename/should_compile/T17d.stderr | 4 +- testsuite/tests/rename/should_compile/T17e.stderr | 8 +- testsuite/tests/rename/should_compile/T1972.stderr | 7 +- testsuite/tests/rename/should_compile/T3262.stderr | 4 +- testsuite/tests/rename/should_compile/T3371.stderr | 3 +- testsuite/tests/rename/should_compile/T3449.stderr | 3 +- testsuite/tests/rename/should_compile/T4489.stderr | 4 +- testsuite/tests/rename/should_compile/T5331.stderr | 6 +- testsuite/tests/rename/should_compile/T5334.stderr | 22 ++--- testsuite/tests/rename/should_compile/T5867.stderr | 4 +- testsuite/tests/rename/should_compile/T7085.stderr | 2 +- .../tests/rename/should_compile/T7145b.stderr | 3 +- testsuite/tests/rename/should_compile/T7167.stderr | 3 +- testsuite/tests/rename/should_compile/T9778.stderr | 7 +- testsuite/tests/rename/should_compile/mc10.stderr | 3 +- testsuite/tests/rename/should_compile/rn037.stderr | 2 +- testsuite/tests/rename/should_compile/rn039.stderr | 2 +- testsuite/tests/rename/should_compile/rn040.stderr | 6 +- testsuite/tests/rename/should_compile/rn041.stderr | 9 +- testsuite/tests/rename/should_compile/rn046.stderr | 4 +- testsuite/tests/rename/should_compile/rn047.stderr | 3 +- testsuite/tests/rename/should_compile/rn050.stderr | 4 +- testsuite/tests/rename/should_compile/rn055.stderr | 3 +- testsuite/tests/rename/should_compile/rn063.stderr | 6 +- testsuite/tests/rename/should_compile/rn064.stderr | 2 +- testsuite/tests/rename/should_compile/rn066.stderr | 4 +- testsuite/tests/rename/should_fail/T2723.stderr | 2 +- testsuite/tests/rename/should_fail/T5211.stderr | 2 +- testsuite/tests/rename/should_fail/T5281.stderr | 2 +- testsuite/tests/rename/should_fail/T5892a.stderr | 14 +-- testsuite/tests/rename/should_fail/T7454.stderr | 2 +- testsuite/tests/rename/should_fail/T8149.stderr | 2 +- testsuite/tests/semigroup/SemigroupWarnings.stderr | 4 +- .../tests/simplCore/should_compile/simpl020.stderr | 2 +- .../typecheck/prog001/typecheck.prog001.stderr | 8 +- .../tests/typecheck/should_compile/HasKey.stderr | 8 +- .../tests/typecheck/should_compile/T10935.stderr | 10 +- .../tests/typecheck/should_compile/T10971a.stderr | 16 ++-- .../tests/typecheck/should_compile/T2497.stderr | 3 +- .../tests/typecheck/should_compile/T3696.stderr | 2 +- .../tests/typecheck/should_compile/T4912.stderr | 4 +- .../tests/typecheck/should_compile/T7903.stderr | 16 ++-- .../tests/typecheck/should_compile/T9497a.stderr | 2 +- .../tests/typecheck/should_compile/holes.stderr | 8 +- .../tests/typecheck/should_compile/holes2.stderr | 2 +- .../tests/typecheck/should_compile/tc078.stderr | 16 ++-- .../tests/typecheck/should_compile/tc115.stderr | 8 +- .../tests/typecheck/should_compile/tc116.stderr | 8 +- .../tests/typecheck/should_compile/tc125.stderr | 41 ++++---- .../tests/typecheck/should_compile/tc126.stderr | 16 ++-- .../tests/typecheck/should_compile/tc161.stderr | 8 +- .../tests/typecheck/should_compile/tc175.stderr | 8 +- .../tests/typecheck/should_compile/tc243.stderr | 2 +- .../tests/typecheck/should_compile/tc254.stderr | 6 +- testsuite/tests/typecheck/should_fail/T5051.stderr | 2 +- .../tests/typecheck/should_fail/tcfail204.stderr | 2 +- .../tests/warnings/minimal/WarnMinimal.stderr | 106 ++++++++++----------- .../tests/warnings/should_compile/DeprU.stderr | 4 +- .../tests/warnings/should_compile/PluralS.stderr | 4 +- .../warnings/should_compile/T10890/T10890_2.stderr | 2 +- .../tests/warnings/should_compile/T11077.stderr | 2 +- .../tests/warnings/should_compile/T11128.stderr | 8 +- .../tests/warnings/should_compile/T11128b.stderr | 4 +- .../tests/warnings/should_compile/T2526.stderr | 2 +- .../tests/warnings/should_compile/T9178.stderr | 2 +- .../wcompat-warnings/WCompatWarningsOn.stderr | 8 +- utils/mkUserGuidePart/Options/Warnings.hs | 5 + 163 files changed, 865 insertions(+), 627 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 bb5afd3c274011c5ea302210b4c290ec1f83209c From git at git.haskell.org Fri Feb 26 11:22:31 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 26 Feb 2016 11:22:31 +0000 (UTC) Subject: [commit: ghc] master: Unconditionally handle TH known key names. (bbfff22) Message-ID: <20160226112231.CFE4C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/bbfff2298d7ea7d0f4e590f8137f43a651e8f61d/ghc >--------------------------------------------------------------- commit bbfff2298d7ea7d0f4e590f8137f43a651e8f61d Author: Edward Z. Yang Date: Thu Feb 25 21:47:30 2016 +0100 Unconditionally handle TH known key names. Previously, we didn't add Template Haskell key names to the list of known uniques when building a stage 1 compiler. But with f16ddcee0c64a92ab911a7841a8cf64e3ac671fd we may refer to TH names even in stage 1, and this was causing uniques to not be setup properly. Signed-off-by: Edward Z. Yang Test Plan: validate and run stage1 test suite Reviewers: osa1, austin, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1520 GHC Trac Issues: #10382 >--------------------------------------------------------------- bbfff2298d7ea7d0f4e590f8137f43a651e8f61d compiler/main/HscMain.hs | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs index b1daae5..d9aae24 100644 --- a/compiler/main/HscMain.hs +++ b/compiler/main/HscMain.hs @@ -90,12 +90,12 @@ import Type ( Type ) import {- Kind parts of -} Type ( Kind ) import CoreLint ( lintInteractiveExpr ) import VarEnv ( emptyTidyEnv ) -import THNames ( templateHaskellNames ) import Panic import ConLike import Control.Concurrent #endif +import THNames ( templateHaskellNames ) import Module import Packages import RdrName @@ -208,9 +208,7 @@ allKnownKeyNames -- where templateHaskellNames are defined = all_names where all_names = knownKeyNames -#ifdef GHCI ++ templateHaskellNames -#endif namesEnv = foldl (\m n -> extendNameEnv_Acc (:) singleton m n n) emptyUFM all_names From git at git.haskell.org Fri Feb 26 14:47:37 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 26 Feb 2016 14:47:37 +0000 (UTC) Subject: [commit: ghc] master: Typos in comments, etc. (a026112) Message-ID: <20160226144737.ADF023A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a02611210b9846ee18de179c932915a838fdacb5/ghc >--------------------------------------------------------------- commit a02611210b9846ee18de179c932915a838fdacb5 Author: Gabor Greif Date: Fri Feb 26 15:48:10 2016 +0100 Typos in comments, etc. >--------------------------------------------------------------- a02611210b9846ee18de179c932915a838fdacb5 compiler/parser/Parser.y | 2 +- compiler/rename/RnSource.hs | 2 +- compiler/typecheck/TcEvidence.hs | 2 +- docs/ndp/vect.tex | 2 +- libraries/base/Data/Type/Equality.hs | 2 +- rts/STM.c | 4 ++-- testsuite/tests/profiling/should_run/T5654b-O0.hs | 2 +- testsuite/tests/profiling/should_run/T5654b-O1.hs | 2 +- testsuite/tests/programs/andy_cherry/andy_cherry.stdout | 2 +- testsuite/tests/programs/andy_cherry/mygames.pgn | 2 +- testsuite/tests/simplCore/should_compile/simpl007.hs | 2 +- testsuite/tests/typecheck/should_fail/T11347.hs | 2 +- 12 files changed, 13 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 a02611210b9846ee18de179c932915a838fdacb5 From git at git.haskell.org Fri Feb 26 17:14:37 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 26 Feb 2016 17:14:37 +0000 (UTC) Subject: [commit: ghc] master: Get the right in-scope set in specUnfolding (4ddfe13) Message-ID: <20160226171437.426143A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4ddfe1352e20d805a0ad6eeea0400ee218023bfb/ghc >--------------------------------------------------------------- commit 4ddfe1352e20d805a0ad6eeea0400ee218023bfb Author: Simon Peyton Jones Date: Thu Feb 25 15:55:56 2016 +0000 Get the right in-scope set in specUnfolding This fixes Trac #11600 >--------------------------------------------------------------- 4ddfe1352e20d805a0ad6eeea0400ee218023bfb compiler/coreSyn/CoreUnfold.hs | 4 ++++ compiler/specialise/Specialise.hs | 21 ++++++++++++++++----- 2 files changed, 20 insertions(+), 5 deletions(-) diff --git a/compiler/coreSyn/CoreUnfold.hs b/compiler/coreSyn/CoreUnfold.hs index 48cdb5e..7dde2c0 100644 --- a/compiler/coreSyn/CoreUnfold.hs +++ b/compiler/coreSyn/CoreUnfold.hs @@ -149,6 +149,10 @@ mkInlinableUnfolding dflags expr specUnfolding :: DynFlags -> Subst -> [Var] -> [CoreExpr] -> Unfolding -> Unfolding -- See Note [Specialising unfoldings] +-- specUnfolding subst new_bndrs spec_args unf +-- = \new_bndrs. (subst( unf ) spec_args) +-- +-- Precondition: in-scope(subst) `superset` fvs( spec_args ) specUnfolding _ subst new_bndrs spec_args df@(DFunUnfolding { df_bndrs = bndrs, df_con = con , df_args = args }) = ASSERT2( length bndrs >= length spec_args, ppr df $$ ppr spec_args $$ ppr new_bndrs ) diff --git a/compiler/specialise/Specialise.hs b/compiler/specialise/Specialise.hs index a8380d8..477092e 100644 --- a/compiler/specialise/Specialise.hs +++ b/compiler/specialise/Specialise.hs @@ -1309,9 +1309,17 @@ specCalls mb_mod env rules_for_me calls_for_me fn rhs = (inl_prag { inl_inline = EmptyInlineSpec }, noUnfolding) | otherwise - = (inl_prag, specUnfolding dflags (se_subst env) - poly_tyvars (ty_args ++ spec_dict_args) - fn_unf) + = (inl_prag, specUnfolding dflags spec_unf_subst poly_tyvars + spec_unf_args fn_unf) + + spec_unf_args = ty_args ++ spec_dict_args + spec_unf_subst = CoreSubst.setInScope (se_subst env) + (CoreSubst.substInScope (se_subst rhs_env2)) + -- Extend the in-scope set to satisfy the precondition of + -- specUnfolding, namely that in-scope(unf_subst) includes + -- the free vars of spec_unf_args. The in-scope set of rhs_env2 + -- is just the ticket; but the actual substitution we want is + -- the same old one from 'env' -------------------------------------- -- Adding arity information just propagates it a bit faster @@ -1357,9 +1365,12 @@ bindAuxiliaryDicts env@(SE { se_subst = subst, se_interesting = interesting }) = (env', dx_binds, spec_dict_args) where (dx_binds, spec_dict_args) = go call_ds inst_dict_ids - env' = env { se_subst = CoreSubst.extendIdSubstList subst (orig_dict_ids `zip` spec_dict_args) + env' = env { se_subst = subst `CoreSubst.extendIdSubstList` + (orig_dict_ids `zip` spec_dict_args) + `CoreSubst.extendInScopeList` dx_ids , se_interesting = interesting `unionVarSet` interesting_dicts } + dx_ids = [dx_id | (NonRec dx_id _, _) <- dx_binds] interesting_dicts = mkVarSet [ dx_id | (NonRec dx_id dx, _) <- dx_binds , interestingDict env dx ] -- See Note [Make the new dictionaries interesting] @@ -1367,7 +1378,7 @@ bindAuxiliaryDicts env@(SE { se_subst = subst, se_interesting = interesting }) go :: [CoreExpr] -> [CoreBndr] -> ([DictBind], [CoreExpr]) go [] _ = ([], []) go (dx:dxs) (dx_id:dx_ids) - | exprIsTrivial dx = (dx_binds, dx:args) + | exprIsTrivial dx = (dx_binds, dx : args) | otherwise = (mkDB (NonRec dx_id dx) : dx_binds, Var dx_id : args) where (dx_binds, args) = go dxs dx_ids From git at git.haskell.org Fri Feb 26 17:14:40 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 26 Feb 2016 17:14:40 +0000 (UTC) Subject: [commit: ghc] master: Fix and refactor strict pattern bindings (e3f341f) Message-ID: <20160226171440.CA16E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e3f341f334d89c88f388d8e864ed8762d0890a64/ghc >--------------------------------------------------------------- commit e3f341f334d89c88f388d8e864ed8762d0890a64 Author: Simon Peyton Jones Date: Thu Feb 25 15:53:03 2016 +0000 Fix and refactor strict pattern bindings This patch was triggered by Trac #11601, where I discovered that -XStrict was really not doing the right thing. In particular, f y = let !(Just x) = blah[y] in body[y,x] This was evaluating 'blah' but not pattern matching it against Just until x was demanded. This is wrong. The patch implements a new semantics which ensures that strict patterns (i.e. ones with an explicit bang, or with -XStrict) are evaluated fully when bound. * There are extensive notes in DsUtils: Note [mkSelectorBinds] * To do this I found I need one-tuples; see Note [One-tuples] in TysWiredIn I updated the user manual to give the new semantics >--------------------------------------------------------------- e3f341f334d89c88f388d8e864ed8762d0890a64 compiler/coreSyn/CoreLint.hs | 9 +- compiler/coreSyn/MkCore.hs | 117 +++++--- compiler/deSugar/DsBinds.hs | 8 +- compiler/deSugar/DsUtils.hs | 308 +++++++++++++-------- compiler/deSugar/Match.hs | 35 +-- compiler/prelude/TysWiredIn.hs | 60 +++- docs/users_guide/glasgow_exts.rst | 34 +-- libraries/ghc-prim/GHC/Tuple.hs | 5 + .../tests/deSugar/should_compile/T5455.stderr | 10 +- testsuite/tests/deSugar/should_run/T11601.hs | 8 + testsuite/tests/deSugar/should_run/T11601.stderr | 5 + testsuite/tests/deSugar/should_run/all.T | 1 + 12 files changed, 379 insertions(+), 221 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 e3f341f334d89c88f388d8e864ed8762d0890a64 From git at git.haskell.org Fri Feb 26 17:14:43 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 26 Feb 2016 17:14:43 +0000 (UTC) Subject: [commit: ghc] master: Special case for desugaring AbsBinds (a81e9d5) Message-ID: <20160226171443.949183A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a81e9d57439f338ac3c202b929b4b9e991ee7c20/ghc >--------------------------------------------------------------- commit a81e9d57439f338ac3c202b929b4b9e991ee7c20 Author: Simon Peyton Jones Date: Thu Feb 25 15:53:59 2016 +0000 Special case for desugaring AbsBinds When AbsBinds has no tyvars and no dicts, a rather simpler desugaring is possible. This patch implements it. I don't think the optimised code changes, but there is less clutter generated. >--------------------------------------------------------------- a81e9d57439f338ac3c202b929b4b9e991ee7c20 compiler/deSugar/DsBinds.hs | 20 ++++++++++++++++++++ 1 file changed, 20 insertions(+) diff --git a/compiler/deSugar/DsBinds.hs b/compiler/deSugar/DsBinds.hs index 72b74c7..da20686 100644 --- a/compiler/deSugar/DsBinds.hs +++ b/compiler/deSugar/DsBinds.hs @@ -184,6 +184,26 @@ dsHsBind dflags ; return ([], main_bind : fromOL spec_binds) } + -- Another common case: no tyvars, no dicts + -- In this case we can have a much simpler desugaring +dsHsBind dflags + (AbsBinds { abs_tvs = [], abs_ev_vars = [] + , abs_exports = exports + , abs_ev_binds = ev_binds, abs_binds = binds }) + = do { (force_vars, bind_prs) <- ds_lhs_binds binds + ; let mk_bind (ABE { abe_wrap = wrap + , abe_poly = global + , abe_mono = local + , abe_prags = prags }) + = do { rhs <- dsHsWrapper wrap (Var local) + ; return (makeCorePair dflags global + (isDefaultMethod prags) + 0 rhs) } + ; main_binds <- mapM mk_bind exports + + ; ds_binds <- dsTcEvBinds_s ev_binds + ; return (force_vars, flattenBinds ds_binds ++ bind_prs ++ main_binds) } + dsHsBind dflags (AbsBinds { abs_tvs = tyvars, abs_ev_vars = dicts , abs_exports = exports, abs_ev_binds = ev_binds From git at git.haskell.org Fri Feb 26 17:14:46 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 26 Feb 2016 17:14:46 +0000 (UTC) Subject: [commit: ghc] master: Exclude TyVars from the constraint solver (7496be5) Message-ID: <20160226171446.E83723A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7496be5c0ab96bcc9ab70ab873aa561674b7789d/ghc >--------------------------------------------------------------- commit 7496be5c0ab96bcc9ab70ab873aa561674b7789d Author: Simon Peyton Jones Date: Fri Feb 26 09:02:07 2016 +0000 Exclude TyVars from the constraint solver There is a general invariant that the constraint solver doesn't see TyVars, only TcTyVars. But when checking the generic-default signature of a class, we called checkValidType on the generic-default type, which had the class TyVar free. That in turn meant that it wasn't considered during flattening, which led to the error reported in Trac #11608. The fix is simple: call checkValidType on the /closed/ type. Easy. While I was at it, I added a bunch of ASSERTs about the TcTyVar invariant. >--------------------------------------------------------------- 7496be5c0ab96bcc9ab70ab873aa561674b7789d compiler/typecheck/TcErrors.hs | 49 ++++++++++++++------- compiler/typecheck/TcTyClsDecls.hs | 16 +++++-- compiler/typecheck/TcType.hs | 50 +++++++++++++++------- testsuite/tests/typecheck/should_compile/T11608.hs | 14 ++++++ testsuite/tests/typecheck/should_compile/all.T | 1 + 5 files changed, 96 insertions(+), 34 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 7496be5c0ab96bcc9ab70ab873aa561674b7789d From git at git.haskell.org Fri Feb 26 17:14:49 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 26 Feb 2016 17:14:49 +0000 (UTC) Subject: [commit: ghc] master: Comments and white space only (253ccdf) Message-ID: <20160226171449.A132A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/253ccdf09cc97c8a4d23cd5fea0d3dced0968738/ghc >--------------------------------------------------------------- commit 253ccdf09cc97c8a4d23cd5fea0d3dced0968738 Author: Simon Peyton Jones Date: Fri Feb 26 09:07:39 2016 +0000 Comments and white space only >--------------------------------------------------------------- 253ccdf09cc97c8a4d23cd5fea0d3dced0968738 compiler/typecheck/TcErrors.hs | 18 ++++++++++-------- 1 file changed, 10 insertions(+), 8 deletions(-) diff --git a/compiler/typecheck/TcErrors.hs b/compiler/typecheck/TcErrors.hs index 58bcafd..a17e80a 100644 --- a/compiler/typecheck/TcErrors.hs +++ b/compiler/typecheck/TcErrors.hs @@ -453,7 +453,7 @@ reportWanteds ctxt tc_lvl (WC { wc_simple = simples, wc_insol = insols, wc_impl very_wrong _ _ = False -- Things like (a ~N b) or (a ~N F Bool) - skolem_eq _ (EqPred NomEq ty1 _) = isSkolemTy tc_lvl ty1 + skolem_eq _ (EqPred NomEq ty1 _) = isSkolemTy tc_lvl ty1 skolem_eq _ _ = False -- Things like (F a ~N Int) @@ -486,20 +486,22 @@ reportWanteds ctxt tc_lvl (WC { wc_simple = simples, wc_insol = insols, wc_impl --------------- isSkolemTy :: TcLevel -> Type -> Bool +-- The type is a skolem tyvar isSkolemTy tc_lvl ty - = case getTyVar_maybe ty of - Nothing -> False - Just tv -> isSkolemTyVar tv - || (isSigTyVar tv && isTouchableMetaTyVar tc_lvl tv) - -- The latter case is for touchable SigTvs - -- we postpone untouchables to a latter test (too obscure) + | Just tv <- getTyVar_maybe ty + = isSkolemTyVar tv + || (isSigTyVar tv && isTouchableMetaTyVar tc_lvl tv) + -- The last case is for touchable SigTvs + -- we postpone untouchables to a latter test (too obscure) + + | otherwise + = False isTyFun_maybe :: Type -> Maybe TyCon isTyFun_maybe ty = case tcSplitTyConApp_maybe ty of Just (tc,_) | isTypeFamilyTyCon tc -> Just tc _ -> Nothing - -------------------------------------------- -- Reporters -------------------------------------------- From git at git.haskell.org Fri Feb 26 17:14:52 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 26 Feb 2016 17:14:52 +0000 (UTC) Subject: [commit: ghc] master: Fix kind generalisation for pattern synonyms (b4dfe04) Message-ID: <20160226171452.5E23D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b4dfe04aa77bb2d0ce2c7d82cab5e4425e0b738c/ghc >--------------------------------------------------------------- commit b4dfe04aa77bb2d0ce2c7d82cab5e4425e0b738c Author: Simon Peyton Jones Date: Fri Feb 26 09:20:12 2016 +0000 Fix kind generalisation for pattern synonyms We were failing to zonk, after quantifyTyVars, and that left un-zonked type variables in the final PatSyn. This fixes the patsyn/ problems in Trac #11648, but not the polykinds/ ones. >--------------------------------------------------------------- b4dfe04aa77bb2d0ce2c7d82cab5e4425e0b738c compiler/typecheck/TcPatSyn.hs | 35 ++++++++++++++++++++++------------- 1 file changed, 22 insertions(+), 13 deletions(-) diff --git a/compiler/typecheck/TcPatSyn.hs b/compiler/typecheck/TcPatSyn.hs index 9b28758..f6562cc 100644 --- a/compiler/typecheck/TcPatSyn.hs +++ b/compiler/typecheck/TcPatSyn.hs @@ -119,9 +119,17 @@ tcPatSynSig name sig_ty ; return ( (univ_tvs, req, ex_tvs, prov, arg_tys, body_ty) , bound_tvs) } + -- Kind generalisation; c.f. kindGeneralise + ; let free_kvs = tyCoVarsOfTelescope (implicit_tvs ++ univ_tvs ++ ex_tvs) $ + tyCoVarsOfTypes (body_ty : req ++ prov ++ arg_tys) + + ; kvs <- quantifyTyVars emptyVarSet (Pair free_kvs emptyVarSet) + -- These are /signatures/ so we zonk to squeeze out any kind - -- unification variables. + -- unification variables. Do this after quantifyTyVars which may + -- default kind variables to *. -- ToDo: checkValidType? + ; traceTc "about zonk" empty ; implicit_tvs <- mapM zonkTcTyCoVarBndr implicit_tvs ; univ_tvs <- mapM zonkTcTyCoVarBndr univ_tvs ; ex_tvs <- mapM zonkTcTyCoVarBndr ex_tvs @@ -130,12 +138,6 @@ tcPatSynSig name sig_ty ; arg_tys <- zonkTcTypes arg_tys ; body_ty <- zonkTcType body_ty - -- Kind generalisation; c.f. kindGeneralise - ; let free_kvs = tyCoVarsOfTelescope (implicit_tvs ++ univ_tvs ++ ex_tvs) $ - tyCoVarsOfTypes (body_ty : req ++ prov ++ arg_tys) - - ; kvs <- quantifyTyVars emptyVarSet (Pair free_kvs emptyVarSet) - -- Complain about: pattern P :: () => forall x. x -> P x -- The renamer thought it was fine, but the existential 'x' -- should not appear in the result type @@ -151,13 +153,13 @@ tcPatSynSig name sig_ty (extra_univ, extra_ex) = partition (`elemVarSet` univ_fvs) $ kvs ++ implicit_tvs ; traceTc "tcTySig }" $ - vcat [ text "implicit_tvs" <+> ppr implicit_tvs - , text "kvs" <+> ppr kvs - , text "extra_univ" <+> ppr extra_univ - , text "univ_tvs" <+> ppr univ_tvs + vcat [ text "implicit_tvs" <+> ppr_tvs implicit_tvs + , text "kvs" <+> ppr_tvs kvs + , text "extra_univ" <+> ppr_tvs extra_univ + , text "univ_tvs" <+> ppr_tvs univ_tvs , text "req" <+> ppr req - , text "extra_ex" <+> ppr extra_ex - , text "ex_tvs" <+> ppr ex_tvs + , text "extra_ex" <+> ppr_tvs extra_ex + , text "ex_tvs" <+> ppr_tvs ex_tvs , text "prov" <+> ppr prov , text "arg_tys" <+> ppr arg_tys , text "body_ty" <+> ppr body_ty ] @@ -168,6 +170,11 @@ tcPatSynSig name sig_ty , patsig_prov = prov , patsig_arg_tys = arg_tys , patsig_body_ty = body_ty }) } + where + +ppr_tvs :: [TyVar] -> SDoc +ppr_tvs tvs = braces (vcat [ ppr tv <+> dcolon <+> ppr (tyVarKind tv) + | tv <- tvs]) {- @@ -251,6 +258,8 @@ tcCheckPatSynDecl psb at PSB{ psb_id = lname@(L _ name), psb_args = details else newMetaSigTyVars ex_tvs -- See the "Existential type variables" part of -- Note [Checking against a pattern signature] + ; traceTc "tcpatsyn1" (vcat [ ppr v <+> dcolon <+> ppr (tyVarKind v) | v <- ex_tvs]) + ; traceTc "tcpatsyn2" (vcat [ ppr v <+> dcolon <+> ppr (tyVarKind v) | v <- ex_tvs']) ; prov_dicts <- mapM (emitWanted origin) (substTheta (extendTCvInScopeList subst univ_tvs) prov_theta) -- Add the free vars of 'prov_theta' to the in_scope set to From git at git.haskell.org Fri Feb 26 17:14:55 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 26 Feb 2016 17:14:55 +0000 (UTC) Subject: [commit: ghc] master: Filter out BuiltinRules in occurrence analysis (e193f66) Message-ID: <20160226171455.1113D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e193f66669eda712e832a05349055f8e518f770a/ghc >--------------------------------------------------------------- commit e193f66669eda712e832a05349055f8e518f770a Author: Simon Peyton Jones Date: Fri Feb 26 17:12:52 2016 +0000 Filter out BuiltinRules in occurrence analysis Fixes Trac #11651. Merge to 8.0. >--------------------------------------------------------------- e193f66669eda712e832a05349055f8e518f770a compiler/simplCore/OccurAnal.hs | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/compiler/simplCore/OccurAnal.hs b/compiler/simplCore/OccurAnal.hs index d1c3ca8..3eb20d0 100644 --- a/compiler/simplCore/OccurAnal.hs +++ b/compiler/simplCore/OccurAnal.hs @@ -86,6 +86,7 @@ occurAnalysePgm this_mod active_rule imp_rules vects vectVars binds imp_rule_edges = foldr (plusVarEnv_C unionVarSet) emptyVarEnv [ mapVarEnv (const maps_to) (exprFreeIds arg `delVarSetList` ru_bndrs imp_rule) | imp_rule <- imp_rules + , not (isBuiltinRule imp_rule) -- See Note [Plugin rules] , let maps_to = exprFreeIds (ru_rhs imp_rule) `delVarSetList` ru_bndrs imp_rule , arg <- ru_args imp_rule ] @@ -114,6 +115,19 @@ occurAnalyseExpr' enable_binder_swap expr -- To be conservative, we say that all inlines and rules are active all_active_rules = \_ -> True +{- Note [Plugin rules] +~~~~~~~~~~~~~~~~~~~~~~ +Conal Eliot (Trac #11651) built a GHC plugin that added some +BuiltinRules (for imported Ids) to the mg_rules field of ModGuts, to +do some domain-specific transformations that could not be expressed +with an ordinary pattern-matching CoreRule. But then we can't extract +the dependencies (in imp_rule_edges) from ru_rhs etc, because a +BuiltinRule doesn't have any of that stuff. + +So we simply assume that BuiltinRules have no dependencies, and filter +them out from the imp_rule_edges comprehension. +-} + {- ************************************************************************ * * From git at git.haskell.org Fri Feb 26 17:43:36 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 26 Feb 2016 17:43:36 +0000 (UTC) Subject: [commit: ghc] master: Test Trac #11611 (ef7b1d5) Message-ID: <20160226174336.A527D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ef7b1d5efb17fdca14ee1269f79b9c08d4f8636f/ghc >--------------------------------------------------------------- commit ef7b1d5efb17fdca14ee1269f79b9c08d4f8636f Author: Simon Peyton Jones Date: Fri Feb 26 17:45:18 2016 +0000 Test Trac #11611 >--------------------------------------------------------------- ef7b1d5efb17fdca14ee1269f79b9c08d4f8636f testsuite/tests/polykinds/T11611.hs | 8 ++++++++ testsuite/tests/polykinds/T11611.stderr | 6 ++++++ testsuite/tests/polykinds/all.T | 1 + 3 files changed, 15 insertions(+) diff --git a/testsuite/tests/polykinds/T11611.hs b/testsuite/tests/polykinds/T11611.hs new file mode 100644 index 0000000..e4ee977 --- /dev/null +++ b/testsuite/tests/polykinds/T11611.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE DataKinds, StandaloneDeriving, TypeOperators, GADTs, FlexibleInstances #-} + +module T11611 where + +data A a where + A :: A (a:as) -> a -> A as + +deriving instance Show a => Show (A a) diff --git a/testsuite/tests/polykinds/T11611.stderr b/testsuite/tests/polykinds/T11611.stderr new file mode 100644 index 0000000..15d4749 --- /dev/null +++ b/testsuite/tests/polykinds/T11611.stderr @@ -0,0 +1,6 @@ + +T11611.hs:8:37: error: + ? Expected kind ?[*]?, but ?a? has kind ?*? + ? In the first argument of ?A?, namely ?a? + In the first argument of ?Show?, namely ?A a? + In the stand-alone deriving instance for ?Show a => Show (A a)? diff --git a/testsuite/tests/polykinds/all.T b/testsuite/tests/polykinds/all.T index b426f0e..d48d108 100644 --- a/testsuite/tests/polykinds/all.T +++ b/testsuite/tests/polykinds/all.T @@ -142,3 +142,4 @@ test('T11516', normal, compile_fail, ['']) test('T11362', normal, compile, ['-dunique-increment=-1']) # -dunique-increment=-1 doesn't work inside the file test('T11399', normal, compile_fail, ['']) +test('T11611', normal, compile_fail, ['']) From git at git.haskell.org Fri Feb 26 20:44:49 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 26 Feb 2016 20:44:49 +0000 (UTC) Subject: [commit: ghc] master: Update transformer submodule to v0.5.2.0 release (eee040c) Message-ID: <20160226204449.3FB6D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/eee040c17ad2feb6706f206eb8ea66c7ea131921/ghc >--------------------------------------------------------------- commit eee040c17ad2feb6706f206eb8ea66c7ea131921 Author: Herbert Valerio Riedel Date: Wed Feb 17 18:23:08 2016 +0100 Update transformer submodule to v0.5.2.0 release Most notably, this update pulls in documentation improvements and several INLINE pragmas for significant performance gains[1]. [1]: https://groups.google.com/d/msg/haskell-cafe/SUKtkDI84EE/fXMBd-jNDQAJ >--------------------------------------------------------------- eee040c17ad2feb6706f206eb8ea66c7ea131921 libraries/transformers | 2 +- mk/warnings.mk | 1 + 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/libraries/transformers b/libraries/transformers index a2f7dd0..10348c4 160000 --- a/libraries/transformers +++ b/libraries/transformers @@ -1 +1 @@ -Subproject commit a2f7dd057a0ee0c6cb206609594d7a07d26a1861 +Subproject commit 10348c4bbf60debbfc82463e1035aca1cb7b51bc diff --git a/mk/warnings.mk b/mk/warnings.mk index 10c0935..63388fb 100644 --- a/mk/warnings.mk +++ b/mk/warnings.mk @@ -104,6 +104,7 @@ libraries/dph/dph-lifted-common-install_EXTRA_HC_OPTS += -Wwarn libraries/transformers_dist-boot_EXTRA_HC_OPTS += -fno-warn-unused-matches -fno-warn-unused-imports libraries/transformers_dist-install_EXTRA_HC_OPTS += -Wno-unused-matches -Wno-unused-imports libraries/transformers_dist-install_EXTRA_HC_OPTS += -Wno-redundant-constraints +libraries/transformers_dist-install_EXTRA_HC_OPTS += -Wno-orphans # Turn of trustworthy-safe warning libraries/base_dist-install_EXTRA_HC_OPTS += -Wno-trustworthy-safe From git at git.haskell.org Fri Feb 26 22:01:02 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 26 Feb 2016 22:01:02 +0000 (UTC) Subject: [commit: ghc] master: GHC.Generics: Ensure some, many for U1 don't bottom (890e2bb) Message-ID: <20160226220102.4FD0B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/890e2bb72b9953ca3e6990911b4cf6e51a0dd0f8/ghc >--------------------------------------------------------------- commit 890e2bb72b9953ca3e6990911b4cf6e51a0dd0f8 Author: Ben Gamari Date: Fri Feb 26 23:02:31 2016 +0100 GHC.Generics: Ensure some, many for U1 don't bottom Reviewers: austin, hvr, ekmett, RyanGlScott Reviewed By: RyanGlScott Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1952 GHC Trac Issues: #11650 >--------------------------------------------------------------- 890e2bb72b9953ca3e6990911b4cf6e51a0dd0f8 libraries/base/GHC/Generics.hs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/libraries/base/GHC/Generics.hs b/libraries/base/GHC/Generics.hs index 4e01c13..f723127 100644 --- a/libraries/base/GHC/Generics.hs +++ b/libraries/base/GHC/Generics.hs @@ -745,6 +745,9 @@ instance Applicative U1 where instance Alternative U1 where empty = U1 U1 <|> U1 = U1 + -- The defaults will otherwise bottom; see #11650. + some U1 = U1 + many U1 = U1 instance Monad U1 where U1 >>= _ = U1 From git at git.haskell.org Sat Feb 27 09:24:43 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 27 Feb 2016 09:24:43 +0000 (UTC) Subject: [commit: ghc] branch 'wip/warning-origins' deleted Message-ID: <20160227092443.892413A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Deleted branch: wip/warning-origins From git at git.haskell.org Sat Feb 27 09:25:22 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 27 Feb 2016 09:25:22 +0000 (UTC) Subject: [commit: ghc] branch 'wip/D1934' deleted Message-ID: <20160227092522.403BE3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Deleted branch: wip/D1934 From git at git.haskell.org Sat Feb 27 09:25:32 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 27 Feb 2016 09:25:32 +0000 (UTC) Subject: [commit: ghc] branch 'wip/transformers-0.5.2' deleted Message-ID: <20160227092532.288263A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Deleted branch: wip/transformers-0.5.2 From git at git.haskell.org Sat Feb 27 09:26:11 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 27 Feb 2016 09:26:11 +0000 (UTC) Subject: [commit: ghc] branch 'arcpatch-D1448' deleted Message-ID: <20160227092611.7E29F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Deleted branch: arcpatch-D1448 From git at git.haskell.org Sat Feb 27 14:39:46 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 27 Feb 2016 14:39:46 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Testsuite: delete Windows line endings [skip ci] (#11631) (e2defb8) Message-ID: <20160227143946.4D8CD3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/e2defb838d57d49a1dd0daded5f1c5f353f3d508/ghc >--------------------------------------------------------------- commit e2defb838d57d49a1dd0daded5f1c5f353f3d508 Author: Thomas Miedema Date: Mon Feb 22 21:31:35 2016 +0100 Testsuite: delete Windows line endings [skip ci] (#11631) (cherry picked from commit 8626ac91a3cac028bbe742f07a1ce9fb598589f6) >--------------------------------------------------------------- e2defb838d57d49a1dd0daded5f1c5f353f3d508 testsuite/tests/rts/T2047.hs | 0 testsuite/tests/simplCore/should_compile/T4201.hs | 0 testsuite/tests/simplCore/should_compile/T5366.hs | 0 testsuite/tests/simplCore/should_compile/T7287.hs | 0 testsuite/tests/simplCore/should_compile/rule1.hs | 4 ++-- testsuite/tests/simplCore/should_run/T5441.hs | 0 testsuite/tests/simplCore/should_run/T5441a.hs | 0 testsuite/tests/stranal/should_compile/T8037.hs | 0 testsuite/tests/th/T2597a.hs | 0 testsuite/tests/th/T2597a_Lib.hs | 2 +- testsuite/tests/th/T2597b.hs | 0 testsuite/tests/th/T2597b_Lib.hs | 0 testsuite/tests/th/T2700.hs | 0 testsuite/tests/th/T2713.hs | 0 testsuite/tests/th/T3395.hs | 0 testsuite/tests/th/T3467.hs | 0 testsuite/tests/th/T5404.hs | 0 testsuite/tests/th/T5410.hs | 0 testsuite/tests/th/T5665.hs | 0 testsuite/tests/th/T5737.hs | 0 testsuite/tests/th/T8954.hs | 0 testsuite/tests/th/TH_1tuple.hs | 6 +++--- testsuite/tests/th/TH_NestedSplices.hs | 0 testsuite/tests/th/TH_NestedSplices_Lib.hs | 0 testsuite/tests/typecheck/should_compile/FD2.hs | 0 testsuite/tests/typecheck/should_compile/FD4.hs | 0 testsuite/tests/typecheck/should_compile/GivenTypeSynonym.hs | 0 testsuite/tests/typecheck/should_compile/T2572.hs | 0 testsuite/tests/typecheck/should_compile/T5120.hs | 0 testsuite/tests/typecheck/should_compile/T5595.hs | 0 testsuite/tests/typecheck/should_compile/T7268.hs | 0 testsuite/tests/typecheck/should_compile/T7384.hs | 0 testsuite/tests/typecheck/should_compile/T7888.hs | 0 testsuite/tests/typecheck/should_compile/faxen.hs | 4 ++-- testsuite/tests/typecheck/should_compile/tc190.hs | 0 testsuite/tests/typecheck/should_compile/tc240.hs | 0 testsuite/tests/typecheck/should_compile/tc247.hs | 0 testsuite/tests/typecheck/should_fail/FailDueToGivenOverlapping.hs | 0 testsuite/tests/typecheck/should_fail/LongWayOverlapping.hs | 0 testsuite/tests/typecheck/should_fail/SCLoop.hs | 0 testsuite/tests/typecheck/should_fail/T2126.hs | 0 testsuite/tests/typecheck/should_fail/T2714.hs | 0 testsuite/tests/typecheck/should_fail/T3406.hs | 0 testsuite/tests/typecheck/should_fail/T3592.hs | 0 testsuite/tests/typecheck/should_fail/T3613.hs | 0 testsuite/tests/typecheck/should_fail/T3950.hs | 0 testsuite/tests/typecheck/should_fail/T4875.hs | 0 testsuite/tests/typecheck/should_fail/T5246.hs | 0 testsuite/tests/typecheck/should_fail/T5689.hs | 0 testsuite/tests/typecheck/should_fail/T5978.hs | 0 testsuite/tests/typecheck/should_fail/T6022.hs | 0 testsuite/tests/typecheck/should_fail/T7892.hs | 0 testsuite/tests/typecheck/should_fail/fd-loop.hs | 0 testsuite/tests/typecheck/should_fail/tcfail136.hs | 0 testsuite/tests/typecheck/should_fail/tcfail140.hs | 0 testsuite/tests/typecheck/should_fail/tcfail146.hs | 0 testsuite/tests/typecheck/should_fail/tcfail147.hs | 0 testsuite/tests/typecheck/should_fail/tcfail189.hs | 0 testsuite/tests/typecheck/should_fail/tcfail193.hs | 0 59 files changed, 8 insertions(+), 8 deletions(-) diff --git a/testsuite/tests/simplCore/should_compile/rule1.hs b/testsuite/tests/simplCore/should_compile/rule1.hs index 923f480..6894f82 100644 --- a/testsuite/tests/simplCore/should_compile/rule1.hs +++ b/testsuite/tests/simplCore/should_compile/rule1.hs @@ -1,9 +1,9 @@ -- This one triggers the bug reported in Trac #1092 -- The problem is that the rule --- forall w. f (\v->w) = w +-- forall w. f (\v->w) = w -- erroneously matches the call --- f id +-- f id -- -- Lint catches the error diff --git a/testsuite/tests/th/T2597a_Lib.hs b/testsuite/tests/th/T2597a_Lib.hs index 0e8f794..ad69ac2 100644 --- a/testsuite/tests/th/T2597a_Lib.hs +++ b/testsuite/tests/th/T2597a_Lib.hs @@ -7,6 +7,6 @@ import Language.Haskell.TH mkBug :: ExpQ mkBug = return $ CompE [BindS (VarP $ mkName "p") (ListE []), NoBindS - (VarE $ mkName "p")] + (VarE $ mkName "p")] diff --git a/testsuite/tests/th/TH_1tuple.hs b/testsuite/tests/th/TH_1tuple.hs index 3674a5a..ea1a119 100644 --- a/testsuite/tests/th/TH_1tuple.hs +++ b/testsuite/tests/th/TH_1tuple.hs @@ -6,10 +6,10 @@ module ShouldFail where import Language.Haskell.TH x = $(sigE [|1|] (tupleT 1 `appT` conT ''Int)) - -- 1 :: (Int) ( a 1-tuple type) + -- 1 :: (Int) ( a 1-tuple type) y = $(sigE [|1|] (tupleT 1)) - -- 1 :: (1) (a 1-tuple tycon not applied) + -- 1 :: (1) (a 1-tuple tycon not applied) z = $(tupE [ [| "yes" |] ]) - -- ("yes") (a 1-tuple expression) + -- ("yes") (a 1-tuple expression) diff --git a/testsuite/tests/typecheck/should_compile/faxen.hs b/testsuite/tests/typecheck/should_compile/faxen.hs index 8ad56c6..3dd9f7b 100644 --- a/testsuite/tests/typecheck/should_compile/faxen.hs +++ b/testsuite/tests/typecheck/should_compile/faxen.hs @@ -22,12 +22,12 @@ instance HasEmpty (Maybe a) where test1 y = (null y) || (let f :: forall d. d -> Bool - f x = isEmpty (y >> return x) + f x = isEmpty (y >> return x) in f y) test2 y = (let f :: forall d. d -> Bool - f x = isEmpty (y >> return x) + f x = isEmpty (y >> return x) in f y) || (null y) From git at git.haskell.org Sat Feb 27 14:39:49 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 27 Feb 2016 14:39:49 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Testsuite: delete Windows line endings [skip ci] (#11631) (3d6f24d) Message-ID: <20160227143949.2B8B63A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/3d6f24d824de4e8f51211f8ca9fb18b652e38068/ghc >--------------------------------------------------------------- commit 3d6f24d824de4e8f51211f8ca9fb18b652e38068 Author: Thomas Miedema Date: Mon Feb 22 21:32:51 2016 +0100 Testsuite: delete Windows line endings [skip ci] (#11631) (cherry picked from commit 28620ba6a7968ef3ab589f62ac761fffe4f42caa) >--------------------------------------------------------------- 3d6f24d824de4e8f51211f8ca9fb18b652e38068 testsuite/tests/patsyn/should_fail/T9705-1.stderr | 0 testsuite/tests/patsyn/should_fail/T9705-2.stderr | 0 testsuite/tests/polykinds/T7272.hs-boot | 0 testsuite/tests/profiling/should_run/T5363.stdout-ws-32 | 0 testsuite/tests/quotes/T3572.stdout | 0 testsuite/tests/quotes/TH_ppr1.stdout | 0 testsuite/tests/rebindable/rebindable7.stdout | 0 testsuite/tests/rename/should_compile/T1972.stderr | 0 testsuite/tests/rename/should_compile/T5331.stderr | 0 testsuite/tests/rename/should_compile/T5592.stdout | 0 testsuite/tests/rename/should_fail/RnStaticPointersFail02.stderr | 0 testsuite/tests/rename/should_fail/T5372.stderr | 0 testsuite/tests/rename/should_fail/T5533.stderr | 0 testsuite/tests/rename/should_fail/T7906.stderr | 0 testsuite/tests/rename/should_fail/T9177.stderr | 0 testsuite/tests/rename/should_fail/T9177a.stderr | 0 testsuite/tests/rename/should_fail/mc14.stderr | 0 testsuite/tests/rename/should_fail/rn_dup.stderr | 0 testsuite/tests/rename/should_fail/rnfail024.stderr | 0 testsuite/tests/rename/should_fail/rnfail044.stderr | 0 testsuite/tests/rename/should_fail/rnfail049.stderr | 0 testsuite/tests/rename/should_fail/rnfail050.stderr | 0 testsuite/tests/rts/T10672/cxxy.cpp | 0 testsuite/tests/rts/derefnull.stdout-x86_64-unknown-mingw32 | 0 testsuite/tests/rts/divbyzero.stdout-x86_64-unknown-mingw32 | 0 testsuite/tests/safeHaskell/ghci/p10.stderr | 0 testsuite/tests/safeHaskell/ghci/p9.stderr | 0 testsuite/tests/simplCore/should_compile/T5996.stdout | 0 testsuite/tests/simplCore/should_compile/T8848a.stderr | 0 testsuite/tests/simplCore/should_run/T11172.stdout | 0 testsuite/tests/simplCore/should_run/T5441.stdout | 0 testsuite/tests/simplCore/should_run/T5453.stdout | 0 testsuite/tests/th/T2700.stderr | 0 testsuite/tests/th/T3920.stdout | 0 testsuite/tests/th/T5217.stderr | 0 testsuite/tests/th/T5410.stdout | 0 testsuite/tests/th/T7241.stderr | 0 testsuite/tests/th/T8625.stdout | 0 testsuite/tests/th/T8932.stderr | 0 testsuite/tests/th/TH_linePragma.stderr | 0 testsuite/tests/th/TH_pragma.stderr | 0 testsuite/tests/th/TH_viewPatPrint.stdout | 0 testsuite/tests/typecheck/should_compile/T11254.stderr | 0 testsuite/tests/typecheck/should_fail/T11355.stderr | 0 testsuite/tests/typecheck/should_fail/T2538.stderr | 0 testsuite/tests/typecheck/should_fail/T5957.stderr | 0 testsuite/tests/typecheck/should_fail/T7019.stderr | 0 testsuite/tests/typecheck/should_fail/T7019a.stderr | 0 testsuite/tests/typecheck/should_fail/T7809.stderr | 0 testsuite/tests/typecheck/should_fail/T8806.stderr | 0 testsuite/tests/typecheck/should_fail/T9196.stderr | 0 testsuite/tests/typecheck/should_fail/mc22.stderr | 0 testsuite/tests/typecheck/should_fail/mc25.stderr | 0 testsuite/tests/typecheck/should_fail/tcfail011.stderr | 0 testsuite/tests/typecheck/should_fail/tcfail021.stderr | 0 testsuite/tests/typecheck/should_fail/tcfail037.stderr | 0 testsuite/tests/typecheck/should_fail/tcfail088.stderr | 0 testsuite/tests/typecheck/should_fail/tcfail127.stderr | 0 testsuite/tests/typecheck/should_fail/tcfail184.stderr | 0 testsuite/tests/typecheck/should_fail/tcfail195.stderr | 0 testsuite/tests/typecheck/should_fail/tcfail196.stderr | 0 testsuite/tests/typecheck/should_fail/tcfail197.stderr | 0 testsuite/tests/typecheck/should_run/T1735.stdout | 0 testsuite/tests/typecheck/should_run/T3500a.stdout | 0 testsuite/tests/typecheck/should_run/T3500b.stdout | 0 testsuite/tests/typecheck/should_run/T7023.stdout | 0 testsuite/tests/typecheck/should_run/tcrun032.stdout | 0 testsuite/tests/typecheck/should_run/tcrun033.stdout | 0 testsuite/tests/typecheck/should_run/tcrun038.stdout | 0 testsuite/tests/typecheck/should_run/tcrun039.stdout | 0 testsuite/tests/typecheck/should_run/testeq2.stdout | 0 testsuite/tests/typecheck/testeq1/typecheck.testeq1.stdout | 0 72 files changed, 0 insertions(+), 0 deletions(-) From git at git.haskell.org Sat Feb 27 14:39:51 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 27 Feb 2016 14:39:51 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Fix GHC.Stats documentation markup (#11619) (05e83aa) Message-ID: <20160227143951.D5F953A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/05e83aacf3e16adc22452a8247c89b80c976517c/ghc >--------------------------------------------------------------- commit 05e83aacf3e16adc22452a8247c89b80c976517c Author: Thomas Miedema Date: Sun Feb 21 18:31:00 2016 +0100 Fix GHC.Stats documentation markup (#11619) (cherry picked from commit bb9cd45498b36be1624fbdccb4999bb45a776b4f) >--------------------------------------------------------------- 05e83aacf3e16adc22452a8247c89b80c976517c libraries/base/GHC/Stats.hsc | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/libraries/base/GHC/Stats.hsc b/libraries/base/GHC/Stats.hsc index 7bcc221..0e501da 100644 --- a/libraries/base/GHC/Stats.hsc +++ b/libraries/base/GHC/Stats.hsc @@ -47,6 +47,7 @@ data GCStats = GCStats , numGcs :: !Int64 -- ^ Number of garbage collections performed , maxBytesUsed :: !Int64 -- ^ Maximum number of live bytes seen so far , numByteUsageSamples :: !Int64 -- ^ Number of byte usage samples taken + -- | Sum of all byte usage samples, can be used with -- 'numByteUsageSamples' to calculate averages with -- arbitrary weighting (if you are sampling this record multiple @@ -57,9 +58,11 @@ data GCStats = GCStats , currentBytesSlop :: !Int64 -- ^ Current number of bytes lost to slop , maxBytesSlop :: !Int64 -- ^ Maximum number of bytes lost to slop at any one time so far , peakMegabytesAllocated :: !Int64 -- ^ Maximum number of megabytes allocated + -- | CPU time spent running mutator threads. This does not include -- any profiling overhead or initialization. , mutatorCpuSeconds :: !Double + -- | Wall clock time spent running mutator threads. This does not -- include initialization. , mutatorWallSeconds :: !Double @@ -67,11 +70,13 @@ data GCStats = GCStats , gcWallSeconds :: !Double -- ^ Wall clock time spent running GC , cpuSeconds :: !Double -- ^ Total CPU time elapsed since program start , wallSeconds :: !Double -- ^ Total wall clock time elapsed since start + -- | Number of bytes copied during GC, minus space held by mutable -- lists held by the capabilities. Can be used with -- 'parMaxBytesCopied' to determine how well parallel GC utilized -- all cores. , parTotBytesCopied :: !Int64 + -- | Sum of number of bytes copied each GC by the most active GC -- thread each GC. The ratio of 'parTotBytesCopied' divided by -- 'parMaxBytesCopied' approaches 1 for a maximally sequential From git at git.haskell.org Sat Feb 27 14:39:54 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 27 Feb 2016 14:39:54 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: base: A selection of fixes to the comments in GHC.Stats (2b79025) Message-ID: <20160227143954.8753E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/2b7902585cda6a091d33054c93bcf4c94cc56f81/ghc >--------------------------------------------------------------- commit 2b7902585cda6a091d33054c93bcf4c94cc56f81 Author: David Turner Date: Thu Feb 25 14:46:28 2016 +0100 base: A selection of fixes to the comments in GHC.Stats Use `-- |` comments throughout. Note that numByteUsageSamples is also the number of major GCs Note that numGcs counts GCs for all generations Note that 'current' really means 'at the end of the last major GC' Reviewers: ezyang, hvr, simonmar, austin, bgamari Reviewed By: ezyang, simonmar, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1929 GHC Trac Issues: #11603 (cherry picked from commit 8e19d3a3066b883d9bc10a75c8d3183907272a9f) >--------------------------------------------------------------- 2b7902585cda6a091d33054c93bcf4c94cc56f81 libraries/base/GHC/Stats.hsc | 48 ++++++++++++++++++++++++++++---------------- 1 file changed, 31 insertions(+), 17 deletions(-) diff --git a/libraries/base/GHC/Stats.hsc b/libraries/base/GHC/Stats.hsc index 0e501da..73e2de9 100644 --- a/libraries/base/GHC/Stats.hsc +++ b/libraries/base/GHC/Stats.hsc @@ -39,26 +39,37 @@ foreign import ccall "getGCStatsEnabled" getGCStatsEnabled :: IO Bool -- I'm probably violating a bucket of constraints here... oops. --- | Global garbage collection and memory statistics. +-- | Statistics about memory usage and the garbage collector. Apart from +-- 'currentBytesUsed' and 'currentBytesSlop' all are cumulative values since +-- the program started. -- -- @since 4.5.0.0 data GCStats = GCStats - { bytesAllocated :: !Int64 -- ^ Total number of bytes allocated - , numGcs :: !Int64 -- ^ Number of garbage collections performed - , maxBytesUsed :: !Int64 -- ^ Maximum number of live bytes seen so far - , numByteUsageSamples :: !Int64 -- ^ Number of byte usage samples taken - + { -- | Total number of bytes allocated + bytesAllocated :: !Int64 + -- | Number of garbage collections performed (any generation, major and + -- minor) + , numGcs :: !Int64 + -- | Maximum number of live bytes seen so far + , maxBytesUsed :: !Int64 + -- | Number of byte usage samples taken, or equivalently + -- the number of major GCs performed. + , numByteUsageSamples :: !Int64 -- | Sum of all byte usage samples, can be used with -- 'numByteUsageSamples' to calculate averages with -- arbitrary weighting (if you are sampling this record multiple -- times). , cumulativeBytesUsed :: !Int64 - , bytesCopied :: !Int64 -- ^ Number of bytes copied during GC - , currentBytesUsed :: !Int64 -- ^ Current number of live bytes - , currentBytesSlop :: !Int64 -- ^ Current number of bytes lost to slop - , maxBytesSlop :: !Int64 -- ^ Maximum number of bytes lost to slop at any one time so far - , peakMegabytesAllocated :: !Int64 -- ^ Maximum number of megabytes allocated - + -- | Number of bytes copied during GC + , bytesCopied :: !Int64 + -- | Number of live bytes at the end of the last major GC + , currentBytesUsed :: !Int64 + -- | Current number of bytes lost to slop + , currentBytesSlop :: !Int64 + -- | Maximum number of bytes lost to slop at any one time so far + , maxBytesSlop :: !Int64 + -- | Maximum number of megabytes allocated + , peakMegabytesAllocated :: !Int64 -- | CPU time spent running mutator threads. This does not include -- any profiling overhead or initialization. , mutatorCpuSeconds :: !Double @@ -66,11 +77,14 @@ data GCStats = GCStats -- | Wall clock time spent running mutator threads. This does not -- include initialization. , mutatorWallSeconds :: !Double - , gcCpuSeconds :: !Double -- ^ CPU time spent running GC - , gcWallSeconds :: !Double -- ^ Wall clock time spent running GC - , cpuSeconds :: !Double -- ^ Total CPU time elapsed since program start - , wallSeconds :: !Double -- ^ Total wall clock time elapsed since start - + -- | CPU time spent running GC + , gcCpuSeconds :: !Double + -- | Wall clock time spent running GC + , gcWallSeconds :: !Double + -- | Total CPU time elapsed since program start + , cpuSeconds :: !Double + -- | Total wall clock time elapsed since start + , wallSeconds :: !Double -- | Number of bytes copied during GC, minus space held by mutable -- lists held by the capabilities. Can be used with -- 'parMaxBytesCopied' to determine how well parallel GC utilized From git at git.haskell.org Sat Feb 27 14:39:59 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 27 Feb 2016 14:39:59 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Testsuite: delete Windows line endings [skip ci] (#11631) (461f804) Message-ID: <20160227143959.EC8033A301@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/461f804ca174f5376edda5ff1485ddd4bfbfcf8e/ghc >--------------------------------------------------------------- commit 461f804ca174f5376edda5ff1485ddd4bfbfcf8e Author: Thomas Miedema Date: Mon Feb 22 21:32:51 2016 +0100 Testsuite: delete Windows line endings [skip ci] (#11631) (cherry picked from commit d5e8b3940e8f190e9ad94e044014162bcb808c3a) >--------------------------------------------------------------- 461f804ca174f5376edda5ff1485ddd4bfbfcf8e libraries/base/tests/Concurrent/Chan001.hs | 42 ++++++------ libraries/base/tests/Concurrent/MVar001.hs | 78 +++++++++++----------- libraries/base/tests/IO/T7853.hs | 0 libraries/base/tests/IO/encoding004.hs | 0 libraries/base/tests/IO/hGetLine001.hs | 4 +- libraries/base/tests/IO/hReady002.hs | 0 testsuite/tests/arityanal/f0.hs | 4 +- testsuite/tests/arityanal/f1.hs | 4 +- testsuite/tests/arityanal/f10.hs | 0 testsuite/tests/arityanal/f11.hs | 0 testsuite/tests/arityanal/f12.hs | 0 testsuite/tests/arityanal/f13.hs | 8 +-- testsuite/tests/arityanal/f14.hs | 0 testsuite/tests/arityanal/f15.hs | 0 testsuite/tests/arityanal/f2.hs | 4 +- testsuite/tests/arityanal/f3.hs | 2 +- testsuite/tests/arityanal/f4.hs | 2 +- testsuite/tests/arityanal/f5.hs | 0 testsuite/tests/arityanal/f6.hs | 0 testsuite/tests/arityanal/f7.hs | 0 testsuite/tests/arityanal/f8.hs | 2 +- testsuite/tests/arityanal/f9.hs | 0 testsuite/tests/arityanal/prim.hs | 0 testsuite/tests/codeGen/should_compile/cg005.hs | 0 .../tests/deSugar/should_compile/GadtOverlap.hs | 0 testsuite/tests/deSugar/should_compile/T4870.hs | 0 testsuite/tests/deSugar/should_compile/T4870a.hs | 0 testsuite/tests/deSugar/should_compile/T5117.hs | 0 testsuite/tests/deSugar/should_compile/T5252.hs | 0 testsuite/tests/deSugar/should_compile/T5252a.hs | 0 testsuite/tests/deSugar/should_compile/ds055.hs | 2 +- testsuite/tests/deSugar/should_run/T3382.hs | 0 testsuite/tests/deSugar/should_run/dsrun021.hs | 0 33 files changed, 76 insertions(+), 76 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 461f804ca174f5376edda5ff1485ddd4bfbfcf8e From git at git.haskell.org Sat Feb 27 14:39:57 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 27 Feb 2016 14:39:57 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Testsuite: delete Windows line endings [skip ci] (#11631) (18a921b) Message-ID: <20160227143957.413E83A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/18a921b81abfeee29dfd4ca35711f72de8aa5d5b/ghc >--------------------------------------------------------------- commit 18a921b81abfeee29dfd4ca35711f72de8aa5d5b Author: Thomas Miedema Date: Mon Feb 22 21:32:51 2016 +0100 Testsuite: delete Windows line endings [skip ci] (#11631) (cherry picked from commit 6d0aa9ffc094ec69f1fbd7f9e15bcf7535e3370b) >--------------------------------------------------------------- 18a921b81abfeee29dfd4ca35711f72de8aa5d5b libraries/base/tests/IO/hGetLine001.stdout | 16 ++++++++-------- libraries/base/tests/IO/hReady002.stdout | 0 libraries/base/tests/IO/openFile003.stdout-mingw32 | 0 .../tests/Numeric/num009.stdout-i386-unknown-mingw32 | 0 testsuite/tests/arrows/should_fail/arrowfail002.stderr | 0 testsuite/tests/cabal/cabal01/cabal01.stdout-mingw32 | 0 testsuite/tests/concurrent/should_run/conc041.stdout | 0 testsuite/tests/concurrent/should_run/conc042.stdout | 0 testsuite/tests/concurrent/should_run/conc043.stdout | 0 testsuite/tests/concurrent/should_run/conc044.stdout | 0 testsuite/tests/concurrent/should_run/conc045.stdout | 0 testsuite/tests/deSugar/should_run/T3382.stdout | 0 testsuite/tests/deriving/should_fail/T2604.stderr-7.0 | 11 ----------- testsuite/tests/deriving/should_fail/T9968a.stderr | 0 testsuite/tests/deriving/should_fail/drvfail006.stderr | 0 testsuite/tests/deriving/should_run/T4136.stdout | 0 testsuite/tests/deriving/should_run/drvrun019.stdout | 0 testsuite/tests/ffi/should_run/T1288_c.c | 0 testsuite/tests/ffi/should_run/T1288_ghci_c.c | 0 testsuite/tests/ffi/should_run/T2276_c.c | 0 testsuite/tests/ffi/should_run/T2276_ghci_c.c | 0 testsuite/tests/ffi/should_run/ffi012.stdout | 0 testsuite/tests/ffi/should_run/ffi014_cbits.c | 0 testsuite/tests/ffi/should_run/ffi014_cbits.h | 0 testsuite/tests/gadt/T3163.stderr | 0 testsuite/tests/generics/T5462Yes1.stdout | 0 testsuite/tests/ghc-api/annotations/T10278.stderr | 0 testsuite/tests/ghci.debugger/scripts/print026.stdout | 0 testsuite/tests/ghci/prog012/prog012.stderr | 0 testsuite/tests/ghci/scripts/T11098.script | 0 testsuite/tests/ghci/scripts/T2816.stderr | 0 testsuite/tests/ghci/scripts/T4127.script | 0 testsuite/tests/ghci/scripts/T4127a.script | 0 testsuite/tests/ghci/scripts/T5566.stdout | 0 testsuite/tests/ghci/scripts/ghci019.script | 0 testsuite/tests/ghci/scripts/ghci023.ghci | 0 testsuite/tests/ghci/scripts/ghci038.stderr | 0 testsuite/tests/ghci/scripts/ghci044.stdout | 0 .../tests/indexed-types/should_compile/T11361a.stderr | 0 .../tests/indexed-types/should_fail/SimpleFail15.stderr | 0 testsuite/tests/indexed-types/should_fail/T10899.stderr | 0 testsuite/tests/indexed-types/should_fail/T11136.stderr | 0 testsuite/tests/mdo/should_run/mdorun003.stdout | 0 testsuite/tests/module/mod110.stderr | 0 testsuite/tests/module/mod120.stderr | 0 testsuite/tests/module/mod138.stderr | 0 testsuite/tests/module/mod151.stderr | 0 testsuite/tests/module/mod152.stderr | 0 testsuite/tests/module/mod153.stderr | 0 testsuite/tests/module/mod158.stderr | 0 testsuite/tests/module/mod48.stderr | 0 testsuite/tests/module/mod98.stderr | 0 .../tests/parser/should_fail/NoPatternSynonyms.stderr | 0 testsuite/tests/parser/should_fail/T3811.stderr | 0 testsuite/tests/parser/should_fail/readFail001.stderr | 0 testsuite/tests/parser/should_fail/readFail031.stderr | 0 testsuite/tests/parser/should_fail/readFail042.stderr | 0 testsuite/tests/parser/should_fail/readFail043.stderr | 0 testsuite/tests/parser/unicode/T2302.stderr | 0 .../tests/partial-sigs/should_compile/T10519.stderr | 0 .../ExtraConstraintsWildcardInTypeSplice2.stderr | 0 .../ExtraConstraintsWildcardNotEnabled.stderr | 0 .../should_fail/ExtraConstraintsWildcardNotLast.stderr | 0 .../should_fail/ExtraConstraintsWildcardTwice.stderr | 0 .../should_fail/NamedWildcardInTypeSplice.stderr | 0 .../should_fail/NestedExtraConstraintsWildcard.stderr | 0 .../NestedNamedExtraConstraintsWildcard.stderr | 0 .../should_fail/PartialClassMethodSignature.stderr | 0 .../should_fail/PartialClassMethodSignature2.stderr | 0 .../should_fail/UnnamedConstraintWildcard1.stderr | 0 .../should_fail/UnnamedConstraintWildcard2.stderr | 0 .../tests/partial-sigs/should_fail/WildcardInADT1.stderr | 0 .../tests/partial-sigs/should_fail/WildcardInADT2.stderr | 0 .../tests/partial-sigs/should_fail/WildcardInADT3.stderr | 0 .../should_fail/WildcardInADTContext1.stderr | 0 .../should_fail/WildcardInADTContext2.stderr | 0 .../partial-sigs/should_fail/WildcardInDefault.stderr | 0 .../should_fail/WildcardInDefaultSignature.stderr | 0 .../partial-sigs/should_fail/WildcardInDeriving.stderr | 0 .../should_fail/WildcardInForeignExport.stderr | 0 .../should_fail/WildcardInForeignImport.stderr | 0 .../partial-sigs/should_fail/WildcardInGADT1.stderr | 0 .../partial-sigs/should_fail/WildcardInGADT2.stderr | 0 .../should_fail/WildcardInInstanceHead.stderr | 0 .../should_fail/WildcardInInstanceSig.stderr | 0 .../partial-sigs/should_fail/WildcardInNewtype.stderr | 0 .../partial-sigs/should_fail/WildcardInPatSynSig.stderr | 0 .../should_fail/WildcardInStandaloneDeriving.stderr | 0 .../should_fail/WildcardInTypeFamilyInstanceRHS.stderr | 0 .../should_fail/WildcardInTypeSynonymRHS.stderr | 0 90 files changed, 8 insertions(+), 19 deletions(-) diff --git a/libraries/base/tests/IO/hGetLine001.stdout b/libraries/base/tests/IO/hGetLine001.stdout index 3e023db..ab88bf0 100644 --- a/libraries/base/tests/IO/hGetLine001.stdout +++ b/libraries/base/tests/IO/hGetLine001.stdout @@ -5,8 +5,8 @@ import System.IO -- one version of 'cat' main = do let loop h = do b <- hIsEOF h - if b then return () - else do l <- hGetLine h; putStrLn l; loop h + if b then return () + else do l <- hGetLine h; putStrLn l; loop h loop stdin h <- openFile "hGetLine001.hs" ReadMode @@ -30,8 +30,8 @@ import System.IO -- one version of 'cat' main = do let loop h = do b <- hIsEOF h - if b then return () - else do l <- hGetLine h; putStrLn l; loop h + if b then return () + else do l <- hGetLine h; putStrLn l; loop h loop stdin h <- openFile "hGetLine001.hs" ReadMode @@ -55,8 +55,8 @@ import System.IO -- one version of 'cat' main = do let loop h = do b <- hIsEOF h - if b then return () - else do l <- hGetLine h; putStrLn l; loop h + if b then return () + else do l <- hGetLine h; putStrLn l; loop h loop stdin h <- openFile "hGetLine001.hs" ReadMode @@ -80,8 +80,8 @@ import System.IO -- one version of 'cat' main = do let loop h = do b <- hIsEOF h - if b then return () - else do l <- hGetLine h; putStrLn l; loop h + if b then return () + else do l <- hGetLine h; putStrLn l; loop h loop stdin h <- openFile "hGetLine001.hs" ReadMode diff --git a/testsuite/tests/deriving/should_fail/T2604.stderr-7.0 b/testsuite/tests/deriving/should_fail/T2604.stderr-7.0 deleted file mode 100644 index aa996e0..0000000 --- a/testsuite/tests/deriving/should_fail/T2604.stderr-7.0 +++ /dev/null @@ -1,11 +0,0 @@ - -T2604.hs:7:35: - Can't make a derived instance of `Typeable (DList a)': - You need -XDeriveDataTypeable to derive an instance for this class - In the data type declaration for `DList' - -T2604.hs:9:38: - Can't make a derived instance of `Typeable (NList a)' - (even with cunning newtype deriving): - You need -XDeriveDataTypeable to derive an instance for this class - In the newtype declaration for `NList' From git at git.haskell.org Sat Feb 27 14:40:02 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 27 Feb 2016 14:40:02 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Testsuite: delete Windows line endings [skip ci] (#11631) (6bd1d97) Message-ID: <20160227144002.B28803A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/6bd1d97b734eeaed35620a99b7a5851334405d1d/ghc >--------------------------------------------------------------- commit 6bd1d97b734eeaed35620a99b7a5851334405d1d Author: Thomas Miedema Date: Mon Feb 22 21:32:51 2016 +0100 Testsuite: delete Windows line endings [skip ci] (#11631) (cherry picked from commit 6074c108b66ec9cd2230852addb60782a8b17e0a) >--------------------------------------------------------------- 6bd1d97b734eeaed35620a99b7a5851334405d1d testsuite/tests/deriving/should_compile/T3012.hs | 0 testsuite/tests/deriving/should_compile/T6031.hs | 0 testsuite/tests/deriving/should_compile/T6031a.hs | 0 testsuite/tests/deriving/should_compile/T8893.hs | 0 testsuite/tests/deriving/should_fail/T2701.hs | 0 testsuite/tests/deriving/should_fail/T4846.hs | 0 testsuite/tests/deriving/should_run/T4136.hs | 0 testsuite/tests/deriving/should_run/drvrun019.hs | 0 testsuite/tests/driver/Shared001.hs | 0 testsuite/tests/driver/recomp010/X1.hs | 0 testsuite/tests/driver/recomp010/X2.hs | 0 testsuite/tests/dynlibs/T4464H.hs | 0 testsuite/tests/eyeball/inline4.hs | 0 testsuite/tests/eyeball/record1.hs | 4 +-- testsuite/tests/ffi/should_compile/ffi-deriv1.hs | 0 testsuite/tests/ffi/should_run/T1288.hs | 0 testsuite/tests/ffi/should_run/T1288_ghci.hs | 0 testsuite/tests/ffi/should_run/T2276.hs | 0 testsuite/tests/ffi/should_run/T2276_ghci.hs | 0 testsuite/tests/ffi/should_run/ffi014.hs | 8 ++--- testsuite/tests/gadt/Arith.hs | 0 testsuite/tests/gadt/T2587.hs | 0 testsuite/tests/gadt/data1.hs | 0 testsuite/tests/gadt/data2.hs | 0 testsuite/tests/gadt/gadt-fd.hs | 0 testsuite/tests/gadt/gadt14.hs | 0 testsuite/tests/gadt/gadt18.hs | 0 testsuite/tests/gadt/gadt9.hs | 0 testsuite/tests/gadt/karl1.hs | 4 +-- testsuite/tests/gadt/karl2.hs | 0 testsuite/tests/gadt/lazypat.hs | 0 testsuite/tests/gadt/lazypatok.hs | 0 testsuite/tests/gadt/rw.hs | 14 ++++---- testsuite/tests/gadt/tc.hs | 42 +++++++++++------------ 34 files changed, 36 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 6bd1d97b734eeaed35620a99b7a5851334405d1d From git at git.haskell.org Sat Feb 27 14:40:05 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 27 Feb 2016 14:40:05 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Testsuite: delete Windows line endings [skip ci] (#11631) (c5bf4c0) Message-ID: <20160227144005.670103A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/c5bf4c003ffa250ac1badc7e701e7c3866f8ce35/ghc >--------------------------------------------------------------- commit c5bf4c003ffa250ac1badc7e701e7c3866f8ce35 Author: Thomas Miedema Date: Mon Feb 22 21:32:51 2016 +0100 Testsuite: delete Windows line endings [skip ci] (#11631) (cherry picked from commit 754a2f2bb7416bd7fe453ba7bcb7c089f5ef3b8f) >--------------------------------------------------------------- c5bf4c003ffa250ac1badc7e701e7c3866f8ce35 testsuite/tests/ghci.debugger/Test.hs | 2 +- testsuite/tests/ghci/scripts/ghci019.hs | 0 testsuite/tests/indexed-types/should_compile/ATLoop.hs | 0 testsuite/tests/indexed-types/should_compile/ATLoop_help.hs | 0 testsuite/tests/indexed-types/should_compile/CoTest3.hs | 0 testsuite/tests/indexed-types/should_compile/PushedInAsGivens.hs | 0 testsuite/tests/indexed-types/should_compile/T1769.hs | 0 testsuite/tests/indexed-types/should_compile/T2850.hs | 0 testsuite/tests/indexed-types/should_compile/T3423.hs | 0 testsuite/tests/indexed-types/should_compile/T3826.hs | 0 testsuite/tests/indexed-types/should_compile/T3851.hs | 0 testsuite/tests/indexed-types/should_compile/T4185.hs | 6 +++--- testsuite/tests/indexed-types/should_compile/TF_GADT.hs | 0 testsuite/tests/indexed-types/should_fail/DerivUnsatFam.hs | 0 testsuite/tests/indexed-types/should_fail/T2544.hs | 0 testsuite/tests/indexed-types/should_fail/T4093b.hs | 0 testsuite/tests/indexed-types/should_fail/T4246.hs | 0 testsuite/tests/mdo/should_fail/mdofail006.hs | 0 testsuite/tests/mdo/should_run/mdorun003.hs | 0 testsuite/tests/mdo/should_run/mdorun004.hs | 0 testsuite/tests/mdo/should_run/mdorun005.hs | 0 testsuite/tests/module/T1074.hs | 0 testsuite/tests/module/T1074a.hs | 0 testsuite/tests/module/T1148.hs | 0 testsuite/tests/module/T2267.hs | 0 testsuite/tests/parser/should_compile/read062.hs | 0 testsuite/tests/parser/should_fail/readFail031.hs | 0 testsuite/tests/parser/should_fail/readFail042.hs | 0 testsuite/tests/parser/should_fail/readFail043.hs | 0 testsuite/tests/parser/unicode/T1744.hs | 0 testsuite/tests/polykinds/T5862.hs | 0 testsuite/tests/polykinds/T5912.hs | 0 testsuite/tests/polykinds/T6020.hs | 0 testsuite/tests/polykinds/T6035.hs | 0 testsuite/tests/polykinds/T6036.hs | 0 testsuite/tests/polykinds/T7073.hs | 0 testsuite/tests/polykinds/T7272.hs | 0 testsuite/tests/polykinds/T7272a.hs | 0 testsuite/tests/polykinds/T7433.hs | 0 testsuite/tests/quasiquotation/T4491/A.hs | 0 testsuite/tests/quasiquotation/qq007/QQ.hs | 0 testsuite/tests/quasiquotation/qq007/Test.hs | 4 ++-- testsuite/tests/rebindable/T303.hs | 0 testsuite/tests/rebindable/rebindable7.hs | 4 ++-- testsuite/tests/rename/should_compile/T2436.hs | 0 testsuite/tests/rename/should_compile/T2436a.hs | 0 testsuite/tests/rename/should_compile/T3943.hs | 0 testsuite/tests/rename/should_compile/T4489.hs | 0 testsuite/tests/rename/should_compile/T5306.hs | 0 testsuite/tests/rename/should_compile/T5306a.hs | 0 testsuite/tests/rename/should_compile/T5306b.hs | 0 testsuite/tests/rename/should_compile/T7007.hs | 0 testsuite/tests/rename/should_compile/T7336.hs | 0 testsuite/tests/rename/should_fail/T2723.hs | 0 testsuite/tests/rename/should_fail/T3792.hs | 2 +- testsuite/tests/rename/should_fail/T5211.hs | 0 testsuite/tests/rename/should_fail/T9436.hs | 0 testsuite/tests/rename/should_fail/T9437.hs | 0 testsuite/tests/rename/should_fail/rnfail043.hs | 0 testsuite/tests/rename/should_fail/rnfail046.hs | 0 testsuite/tests/rename/should_fail/rnfail049.hs | 0 61 files changed, 9 insertions(+), 9 deletions(-) diff --git a/testsuite/tests/ghci.debugger/Test.hs b/testsuite/tests/ghci.debugger/Test.hs index f0477af..0e177a5 100644 --- a/testsuite/tests/ghci.debugger/Test.hs +++ b/testsuite/tests/ghci.debugger/Test.hs @@ -20,7 +20,7 @@ newtype MkT2 a = MkT2 (MkT a) deriving Show data Param2 s r = P2 (FakeSTRef r (s(Param2 s r))) - | P2Nil + | P2Nil data FakeSTRef r s = Ref s testParam2 = O (P2 (Ref P2Nil)) diff --git a/testsuite/tests/indexed-types/should_compile/T4185.hs b/testsuite/tests/indexed-types/should_compile/T4185.hs index 6a1be25..d7fdbd5 100644 --- a/testsuite/tests/indexed-types/should_compile/T4185.hs +++ b/testsuite/tests/indexed-types/should_compile/T4185.hs @@ -5,12 +5,12 @@ data family Foo k :: * -> * ------------- Generalised newtype deriving of user class ----------- class Bar f where - bar :: f a -> Int + bar :: f a -> Int woo :: f a -> f a instance Bar Maybe where - bar Nothing = 0 - bar Just{} = 1 + bar Nothing = 0 + bar Just{} = 1 woo x = x -- Deriving clause diff --git a/testsuite/tests/quasiquotation/qq007/Test.hs b/testsuite/tests/quasiquotation/qq007/Test.hs index 42cef72..0f81321 100644 --- a/testsuite/tests/quasiquotation/qq007/Test.hs +++ b/testsuite/tests/quasiquotation/qq007/Test.hs @@ -4,10 +4,10 @@ module Test where import QQ f :: [pq| foo |] -- Expands to Int -> Int -[pq| blah |] -- Expands to f x = x +[pq| blah |] -- Expands to f x = x h [pq| foo |] = f [pq| blah |] * 8 - -- Expands to h (Just x) = f (x+1) * 8 + -- Expands to h (Just x) = f (x+1) * 8 diff --git a/testsuite/tests/rebindable/rebindable7.hs b/testsuite/tests/rebindable/rebindable7.hs index 8e0000e..01f3eda 100644 --- a/testsuite/tests/rebindable/rebindable7.hs +++ b/testsuite/tests/rebindable/rebindable7.hs @@ -32,7 +32,7 @@ t1 :: T Int t1 = MkT 4 myt = do { x <- t1 - ; return x } + ; return x } main = case myt of - MkT i -> Prelude.print i + MkT i -> Prelude.print i diff --git a/testsuite/tests/rename/should_fail/T3792.hs b/testsuite/tests/rename/should_fail/T3792.hs index e01efb9..e53dd26 100644 --- a/testsuite/tests/rename/should_fail/T3792.hs +++ b/testsuite/tests/rename/should_fail/T3792.hs @@ -1,4 +1,4 @@ module T3792 where -import Prelude( Prelude.map ) -- Illegal +import Prelude( Prelude.map ) -- Illegal From git at git.haskell.org Sat Feb 27 14:40:08 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 27 Feb 2016 14:40:08 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Fix and refactor strict pattern bindings (649cb34) Message-ID: <20160227144008.D46483A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/649cb346a38684df2e932987065817c5cafc2d90/ghc >--------------------------------------------------------------- commit 649cb346a38684df2e932987065817c5cafc2d90 Author: Simon Peyton Jones Date: Thu Feb 25 15:53:03 2016 +0000 Fix and refactor strict pattern bindings This patch was triggered by Trac #11601, where I discovered that -XStrict was really not doing the right thing. In particular, f y = let !(Just x) = blah[y] in body[y,x] This was evaluating 'blah' but not pattern matching it against Just until x was demanded. This is wrong. The patch implements a new semantics which ensures that strict patterns (i.e. ones with an explicit bang, or with -XStrict) are evaluated fully when bound. * There are extensive notes in DsUtils: Note [mkSelectorBinds] * To do this I found I need one-tuples; see Note [One-tuples] in TysWiredIn I updated the user manual to give the new semantics (cherry picked from commit e3f341f334d89c88f388d8e864ed8762d0890a64) >--------------------------------------------------------------- 649cb346a38684df2e932987065817c5cafc2d90 compiler/coreSyn/CoreLint.hs | 9 +- compiler/coreSyn/MkCore.hs | 117 +++++--- compiler/deSugar/DsBinds.hs | 8 +- compiler/deSugar/DsUtils.hs | 308 +++++++++++++-------- compiler/deSugar/Match.hs | 35 +-- compiler/prelude/TysWiredIn.hs | 60 +++- docs/users_guide/glasgow_exts.rst | 34 +-- libraries/ghc-prim/GHC/Tuple.hs | 5 + .../tests/deSugar/should_compile/T5455.stderr | 10 +- testsuite/tests/deSugar/should_run/T11601.hs | 8 + testsuite/tests/deSugar/should_run/T11601.stderr | 5 + testsuite/tests/deSugar/should_run/all.T | 1 + 12 files changed, 379 insertions(+), 221 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 649cb346a38684df2e932987065817c5cafc2d90 From git at git.haskell.org Sat Feb 27 14:40:11 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 27 Feb 2016 14:40:11 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Testsuite: delete Windows line endings [skip ci] (#11631) (ec701bc) Message-ID: <20160227144011.9F0DB3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/ec701bcf190a2a71697568a87834528d70040e50/ghc >--------------------------------------------------------------- commit ec701bcf190a2a71697568a87834528d70040e50 Author: Thomas Miedema Date: Mon Feb 22 21:31:24 2016 +0100 Testsuite: delete Windows line endings [skip ci] (#11631) (cherry picked from commit 31c312ebd29a4e79c166ad5dbbd5b57b42b6fafa) >--------------------------------------------------------------- ec701bcf190a2a71697568a87834528d70040e50 testsuite/tests/typecheck/should_run/T1735.hs | 0 testsuite/tests/typecheck/should_run/T1735_Help/Basics.hs | 0 testsuite/tests/typecheck/should_run/T1735_Help/Context.hs | 0 testsuite/tests/typecheck/should_run/T1735_Help/Instances.hs | 0 testsuite/tests/typecheck/should_run/T1735_Help/Main.hs | 0 testsuite/tests/typecheck/should_run/T1735_Help/State.hs | 0 testsuite/tests/typecheck/should_run/T1735_Help/Xml.hs | 0 testsuite/tests/typecheck/should_run/T4809_XMLGenerator.hs | 0 testsuite/tests/typecheck/should_run/TcRun038_B.hs | 0 testsuite/tests/typecheck/should_run/tcrun032.hs | 4 ++-- testsuite/tests/typecheck/should_run/tcrun038.hs | 0 testsuite/tests/typecheck/should_run/tcrun039.hs | 2 +- 12 files changed, 3 insertions(+), 3 deletions(-) diff --git a/testsuite/tests/typecheck/should_run/tcrun032.hs b/testsuite/tests/typecheck/should_run/tcrun032.hs index 8aa4363..5609a9f 100644 --- a/testsuite/tests/typecheck/should_run/tcrun032.hs +++ b/testsuite/tests/typecheck/should_run/tcrun032.hs @@ -8,7 +8,7 @@ module Main where data Fix f = In (f (Fix f)) instance Show (f (Fix f)) => Show (Fix f) where - show (In x) = "In " ++ show x -- No parens, but never mind + show (In x) = "In " ++ show x -- No parens, but never mind instance Eq (f (Fix f)) => Eq (Fix f) where (In x) == (In y) = x==y @@ -16,5 +16,5 @@ instance Eq (f (Fix f)) => Eq (Fix f) where data L x = Nil | Cons Int x deriving( Show, Eq ) main = do { print (In Nil); - print (In Nil == In Nil) } + print (In Nil == In Nil) } diff --git a/testsuite/tests/typecheck/should_run/tcrun039.hs b/testsuite/tests/typecheck/should_run/tcrun039.hs index 916d533..eabe015 100644 --- a/testsuite/tests/typecheck/should_run/tcrun039.hs +++ b/testsuite/tests/typecheck/should_run/tcrun039.hs @@ -16,7 +16,7 @@ data GADT a where g :: forall b. Read b => GADT b -> String -> b g (MkG n) s = -- Here we know Read [b] - n : (read s) + n : (read s) main = do print (f (MkT (3::Int)) "4") print (g (MkG (3::Int)) "[4,5]") From git at git.haskell.org Sat Feb 27 14:40:14 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 27 Feb 2016 14:40:14 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Testsuite: accept output without Windows line endings (#11631) (908973b) Message-ID: <20160227144014.57E3B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/908973b73a862f1fa5862cba95d643205d013c6e/ghc >--------------------------------------------------------------- commit 908973b73a862f1fa5862cba95d643205d013c6e Author: Thomas Miedema Date: Tue Feb 23 02:57:53 2016 +0100 Testsuite: accept output without Windows line endings (#11631) (cherry picked from commit 978c3ea14a4fb9be577fe64e1e6b724a44f332a8) >--------------------------------------------------------------- 908973b73a862f1fa5862cba95d643205d013c6e testsuite/tests/deriving/should_fail/T5287.stderr | 18 ++-- .../tests/deriving/should_fail/drvfail002.stderr | 14 +-- .../tests/deriving/should_fail/drvfail008.stderr | 10 +- .../tests/deriving/should_fail/drvfail016.stderr | 2 +- testsuite/tests/driver/sigof04/sigof04.stderr | 2 +- testsuite/tests/gadt/T3651.stderr | 36 +++---- testsuite/tests/gadt/T7293.stderr | 14 +-- testsuite/tests/gadt/T7294.stderr | 14 +-- testsuite/tests/gadt/T7558.stderr | 26 ++--- testsuite/tests/gadt/gadt11.stderr | 8 +- testsuite/tests/gadt/gadtSyntaxFail001.stderr | 10 +- testsuite/tests/gadt/gadtSyntaxFail002.stderr | 10 +- testsuite/tests/gadt/gadtSyntaxFail003.stderr | 10 +- .../tests/ghci.debugger/scripts/break019.stderr | 2 +- testsuite/tests/ghci/prog008/ghci.prog008.stdout | 0 testsuite/tests/ghci/prog009/ghci.prog009.stderr | 4 +- testsuite/tests/ghci/scripts/T5564.stderr | 12 +-- testsuite/tests/ghci/scripts/T7894.stderr | 2 +- testsuite/tests/ghci/scripts/T9293.stderr | 26 ++--- testsuite/tests/ghci/scripts/ghci034.stderr | 2 +- testsuite/tests/ghci/scripts/ghci044.stderr | 12 +-- testsuite/tests/ghci/scripts/ghci057.stderr | 26 ++--- .../indexed-types/should_compile/Simple14.stderr | 32 +++--- .../tests/indexed-types/should_fail/BadSock.stderr | 6 +- .../indexed-types/should_fail/DerivUnsatFam.stderr | 8 +- .../indexed-types/should_fail/NoMatchErr.stderr | 17 ++-- .../should_fail/NotRelaxedExamples.stderr | 22 ++--- .../indexed-types/should_fail/Overlap15.stderr | 13 +-- .../tests/indexed-types/should_fail/T1900.stderr | 20 ++-- .../tests/indexed-types/should_fail/T2157.stderr | 4 +- .../tests/indexed-types/should_fail/T9036.stderr | 18 ++-- .../tests/indexed-types/should_fail/T9433.stderr | 5 +- .../indexed-types/should_fail/TyFamUndec.stderr | 22 ++--- testsuite/tests/module/mod101.stderr | 4 +- testsuite/tests/module/mod102.stderr | 4 +- testsuite/tests/module/mod132.stderr | 4 +- testsuite/tests/module/mod39.stderr | 12 +-- testsuite/tests/module/mod60.stderr | 6 +- .../should_fail/ParserNoBinaryLiterals2.stderr | 6 +- .../should_fail/ParserNoBinaryLiterals3.stderr | 6 +- .../should_compile/Defaulting2MROff.stderr | 2 +- .../partial-sigs/should_compile/Either.stderr | 2 +- .../partial-sigs/should_compile/EveryNamed.stderr | 2 +- .../partial-sigs/should_compile/ShowNamed.stderr | 2 +- .../partial-sigs/should_compile/SimpleGen.stderr | 2 +- .../partial-sigs/should_compile/Uncurry.stderr | 2 +- .../should_compile/UncurryNamed.stderr | 2 +- ...ExtraConstraintsWildcardInTypeSpliceUsed.stderr | 10 +- .../should_fail/NamedWildcardsNotInMonotype.stderr | 20 ++-- .../WildcardsInPatternAndExprSig.stderr | 108 ++++++++++----------- 50 files changed, 312 insertions(+), 309 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 908973b73a862f1fa5862cba95d643205d013c6e From git at git.haskell.org Sat Feb 27 14:40:17 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 27 Feb 2016 14:40:17 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Testsuite: accept output without Windows line endings (#11631) (6a2e22b) Message-ID: <20160227144017.19D6C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/6a2e22ba446bbfa9df2a4457d20a3d26a91aad58/ghc >--------------------------------------------------------------- commit 6a2e22ba446bbfa9df2a4457d20a3d26a91aad58 Author: Thomas Miedema Date: Tue Feb 23 02:25:17 2016 +0100 Testsuite: accept output without Windows line endings (#11631) (cherry picked from commit 42f06f6821a221b88d67b0adc110eea78c159d7f) >--------------------------------------------------------------- 6a2e22ba446bbfa9df2a4457d20a3d26a91aad58 testsuite/tests/polykinds/T10516.stderr | 5 +- testsuite/tests/polykinds/T6054.stderr | 16 +-- .../tests/rename/should_fail/Misplaced.stderr | 2 +- testsuite/tests/rename/should_fail/T2310.stderr | 6 +- testsuite/tests/rename/should_fail/T3792.stderr | 3 +- .../tests/rename/should_fail/rnfail022.stderr | 4 +- .../tests/rename/should_fail/rnfail047.stderr | 2 +- .../tests/simplCore/should_compile/simpl020.stderr | 8 +- testsuite/tests/th/T3600.stderr | 4 +- .../tests/typecheck/should_compile/T10632.stderr | 6 +- .../tests/typecheck/should_compile/T3696.stderr | 4 +- .../tests/typecheck/should_compile/T7050.stderr | 6 +- .../tests/typecheck/should_compile/T7220a.stderr | 25 ++-- .../tests/typecheck/should_compile/T7562.stderr | 6 +- .../tests/typecheck/should_compile/T9497a.stderr | 10 +- .../typecheck/should_fail/AssocTyDef05.stderr | 8 +- .../typecheck/should_fail/ContextStack2.stderr | 21 ++-- .../typecheck/should_fail/FDsFromGivens.stderr | 31 ++--- .../should_fail/FailDueToGivenOverlapping.stderr | 22 ++-- .../tests/typecheck/should_fail/IPFail.stderr | 16 +-- .../tests/typecheck/should_fail/T10351.stderr | 8 +- .../tests/typecheck/should_fail/T1897a.stderr | 20 ++-- testsuite/tests/typecheck/should_fail/T3592.stderr | 30 ++--- testsuite/tests/typecheck/should_fail/T3966.stderr | 6 +- testsuite/tests/typecheck/should_fail/T5051.stderr | 8 +- testsuite/tests/typecheck/should_fail/T5236.stderr | 23 ++-- testsuite/tests/typecheck/should_fail/T6022.stderr | 8 +- testsuite/tests/typecheck/should_fail/T7279.stderr | 17 +-- testsuite/tests/typecheck/should_fail/T7697.stderr | 5 +- testsuite/tests/typecheck/should_fail/T8034.stderr | 18 +-- .../tests/typecheck/should_fail/T8392a.stderr | 11 +- .../tests/typecheck/should_fail/T9497d.stderr | 10 +- .../tests/typecheck/should_fail/fd-loop.stderr | 16 +-- .../tests/typecheck/should_fail/tcfail019.stderr | 16 +-- .../tests/typecheck/should_fail/tcfail058.stderr | 7 +- .../tests/typecheck/should_fail/tcfail063.stderr | 7 +- .../tests/typecheck/should_fail/tcfail067.stderr | 129 +++++++++++---------- .../tests/typecheck/should_fail/tcfail080.stderr | 20 ++-- .../tests/typecheck/should_fail/tcfail097.stderr | 19 +-- .../tests/typecheck/should_fail/tcfail098.stderr | 17 +-- .../tests/typecheck/should_fail/tcfail100.stderr | 4 +- .../tests/typecheck/should_fail/tcfail101.stderr | 5 +- .../tests/typecheck/should_fail/tcfail102.stderr | 16 +-- .../tests/typecheck/should_fail/tcfail106.stderr | 16 +-- .../tests/typecheck/should_fail/tcfail107.stderr | 6 +- .../tests/typecheck/should_fail/tcfail108.stderr | 8 +- .../tests/typecheck/should_fail/tcfail110.stderr | 7 +- .../tests/typecheck/should_fail/tcfail116.stderr | 20 ++-- .../tests/typecheck/should_fail/tcfail125.stderr | 17 +-- .../tests/typecheck/should_fail/tcfail129.stderr | 16 +-- .../tests/typecheck/should_fail/tcfail134.stderr | 9 +- .../tests/typecheck/should_fail/tcfail135.stderr | 9 +- .../tests/typecheck/should_fail/tcfail142.stderr | 20 ++-- .../tests/typecheck/should_fail/tcfail150.stderr | 14 +-- .../tests/typecheck/should_fail/tcfail154.stderr | 8 +- .../tests/typecheck/should_fail/tcfail155.stderr | 8 +- .../tests/typecheck/should_fail/tcfail157.stderr | 16 +-- .../tests/typecheck/should_fail/tcfail158.stderr | 7 +- .../tests/typecheck/should_fail/tcfail167.stderr | 14 +-- .../tests/typecheck/should_fail/tcfail171.stderr | 15 +-- .../tests/typecheck/should_fail/tcfail186.stderr | 14 +-- .../tests/typecheck/should_fail/tcfail187.stderr | 6 +- .../tests/typecheck/should_fail/tcfail209.stderr | 6 +- .../tests/typecheck/should_fail/tcfail209a.stderr | 7 +- .../tests/typecheck/should_fail/tcfail213.stderr | 10 +- .../tests/typecheck/should_fail/tcfail214.stderr | 6 +- .../tests/typecheck/should_fail/tcfail215.stderr | 5 +- .../tests/typecheck/should_fail/tcfail222.stderr | 2 +- 68 files changed, 457 insertions(+), 434 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 6a2e22ba446bbfa9df2a4457d20a3d26a91aad58 From git at git.haskell.org Sat Feb 27 14:43:23 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 27 Feb 2016 14:43:23 +0000 (UTC) Subject: [commit: ghc] master: rts: drop unused global 'blackhole_queue' (3ee4fc0) Message-ID: <20160227144323.6AB903A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3ee4fc04322dacb66c70262a220dce0f52c29d4f/ghc >--------------------------------------------------------------- commit 3ee4fc04322dacb66c70262a220dce0f52c29d4f Author: Sergei Trofimovich Date: Sat Feb 27 14:44:45 2016 +0000 rts: drop unused global 'blackhole_queue' Commit 5d52d9b64c21dcf77849866584744722f8121389 removed global 'blackhole_queue' in favour of new mechanism: when TSO hits blackhole TSO blocks waiting for 'MessgaeBlackhole' delivery. Patch removed unused global and updates stale comments. Noticed by Yuras Shumovich. Signed-off-by: Sergei Trofimovich Test Plan: build test Reviewers: simonmar, austin, Yuras, bgamari Reviewed By: Yuras, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1953 >--------------------------------------------------------------- 3ee4fc04322dacb66c70262a220dce0f52c29d4f includes/rts/storage/TSO.h | 2 +- includes/stg/MiscClosures.h | 1 - rts/Schedule.h | 1 - rts/sm/Storage.c | 1 - 4 files changed, 1 insertion(+), 4 deletions(-) diff --git a/includes/rts/storage/TSO.h b/includes/rts/storage/TSO.h index 744ab2b..9bddfca 100644 --- a/includes/rts/storage/TSO.h +++ b/includes/rts/storage/TSO.h @@ -230,7 +230,7 @@ void dirty_STACK (Capability *cap, StgStack *stack); ---------------------------------------------------------------------- NotBlocked END_TSO_QUEUE runnable_queue, or running - BlockedOnBlackHole the BLACKHOLE blackhole_queue + BlockedOnBlackHole MessageBlackHole * TSO->bq BlockedOnMVar the MVAR the MVAR's queue diff --git a/includes/stg/MiscClosures.h b/includes/stg/MiscClosures.h index dff129b..5f5e0d6 100644 --- a/includes/stg/MiscClosures.h +++ b/includes/stg/MiscClosures.h @@ -462,7 +462,6 @@ extern StgWord rts_breakpoint_io_action[]; // Schedule.c extern StgWord RTS_VAR(blocked_queue_hd), RTS_VAR(blocked_queue_tl); extern StgWord RTS_VAR(sleeping_queue); -extern StgWord RTS_VAR(blackhole_queue); extern StgWord RTS_VAR(sched_mutex); // Apply.cmm diff --git a/rts/Schedule.h b/rts/Schedule.h index 67e2fdc..b6fbed4 100644 --- a/rts/Schedule.h +++ b/rts/Schedule.h @@ -97,7 +97,6 @@ extern volatile StgWord recent_activity; /* Thread queues. * Locks required : sched_mutex */ -extern StgTSO *blackhole_queue; #if !defined(THREADED_RTS) extern StgTSO *blocked_queue_hd, *blocked_queue_tl; extern StgTSO *sleeping_queue; diff --git a/rts/sm/Storage.c b/rts/sm/Storage.c index c815b99..45bb54c 100644 --- a/rts/sm/Storage.c +++ b/rts/sm/Storage.c @@ -1046,7 +1046,6 @@ dirty_TVAR(Capability *cap, StgTVar *p) // Setting a TSO's link field with a write barrier. // It is *not* necessary to call this function when // * setting the link field to END_TSO_QUEUE -// * putting a TSO on the blackhole_queue // * setting the link field of the currently running TSO, as it // will already be dirty. void From git at git.haskell.org Sat Feb 27 15:21:09 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 27 Feb 2016 15:21:09 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Overload the static form to reduce verbosity. (70287bc) Message-ID: <20160227152109.7DACC3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/70287bceb5a339456179f08bfbe64c4fe2ff718a/ghc >--------------------------------------------------------------- commit 70287bceb5a339456179f08bfbe64c4fe2ff718a Author: Facundo Dom?nguez Date: Thu Feb 25 14:33:43 2016 +0100 Overload the static form to reduce verbosity. Static pointers are rarely used naked: most often they are defined at the base of a Closure, as defined in e.g. the distributed-closure and distributed-static packages. So a typical usage pattern is: distributeMap (closure (static (\x -> x * 2))) which is more verbose than it needs to be. Ideally we'd just have to write distributeMap (static (\x -> x * 2)) and let the static pointer be lifted to a Closure implicitly. i.e. what we want is to overload static literals, just like we already overload list literals and string literals. This is achieved by introducing the IsStatic type class and changing the typing rule for static forms slightly: static (e :: t) :: IsStatic p => p t Test Plan: ./validate Reviewers: austin, hvr, bgamari Reviewed By: bgamari Subscribers: simonpj, mboes, thomie Differential Revision: https://phabricator.haskell.org/D1923 GHC Trac Issues: #11585 (cherry picked from commit c1efdcc40209bc4f0ded85269eb8ba49c7d1ff09) >--------------------------------------------------------------- 70287bceb5a339456179f08bfbe64c4fe2ff718a compiler/prelude/PrelNames.hs | 8 ++++++++ compiler/typecheck/TcExpr.hs | 16 +++++++++++----- docs/users_guide/glasgow_exts.rst | 22 +++++++++++++++++++--- libraries/base/GHC/StaticPtr.hs | 8 ++++++++ 4 files changed, 46 insertions(+), 8 deletions(-) diff --git a/compiler/prelude/PrelNames.hs b/compiler/prelude/PrelNames.hs index 5c2984b..c32a4ee 100644 --- a/compiler/prelude/PrelNames.hs +++ b/compiler/prelude/PrelNames.hs @@ -371,6 +371,7 @@ basicKnownKeyNames -- StaticPtr , staticPtrTyConName , staticPtrDataConName, staticPtrInfoDataConName + , fromStaticPtrName -- Fingerprint , fingerprintDataConName @@ -1382,6 +1383,10 @@ staticPtrDataConName :: Name staticPtrDataConName = dcQual gHC_STATICPTR (fsLit "StaticPtr") staticPtrDataConKey +fromStaticPtrName :: Name +fromStaticPtrName = + varQual gHC_STATICPTR (fsLit "fromStaticPtr") fromStaticPtrClassOpKey + fingerprintDataConName :: Name fingerprintDataConName = dcQual gHC_FINGERPRINT_TYPE (fsLit "Fingerprint") fingerprintDataConKey @@ -2166,6 +2171,9 @@ emptyCallStackKey, pushCallStackKey :: Unique emptyCallStackKey = mkPreludeMiscIdUnique 517 pushCallStackKey = mkPreludeMiscIdUnique 518 +fromStaticPtrClassOpKey :: Unique +fromStaticPtrClassOpKey = mkPreludeMiscIdUnique 519 + {- ************************************************************************ * * diff --git a/compiler/typecheck/TcExpr.hs b/compiler/typecheck/TcExpr.hs index 9b875b5..2fecfc3 100644 --- a/compiler/typecheck/TcExpr.hs +++ b/compiler/typecheck/TcExpr.hs @@ -569,10 +569,10 @@ tcExpr (HsProc pat cmd) res_ty = do { (pat', cmd', coi) <- tcProc pat cmd res_ty ; return $ mkHsWrapCo coi (HsProc pat' cmd') } +-- Typechecks the static form and wraps it with a call to 'fromStaticPtr'. tcExpr (HsStatic expr) res_ty - = do { staticPtrTyCon <- tcLookupTyCon staticPtrTyConName - ; res_ty <- expTypeToType res_ty - ; (co, [expr_ty]) <- matchExpectedTyConApp staticPtrTyCon res_ty + = do { res_ty <- expTypeToType res_ty + ; (co, (p_ty, expr_ty)) <- matchExpectedAppTy res_ty ; (expr', lie) <- captureConstraints $ addErrCtxt (hang (text "In the body of a static form:") 2 (ppr expr) @@ -586,10 +586,16 @@ tcExpr (HsStatic expr) res_ty ; _ <- emitWantedEvVar StaticOrigin $ mkTyConApp (classTyCon typeableClass) [liftedTypeKind, expr_ty] - -- Insert the static form in a global list for later validation. + -- Insert the constraints of the static form in a global list for later + -- validation. ; stWC <- tcg_static_wc <$> getGblEnv ; updTcRef stWC (andWC lie) - ; return $ mkHsWrapCo co $ HsStatic expr' + -- Wrap the static form with the 'fromStaticPtr' call. + ; fromStaticPtr <- newMethodFromName StaticOrigin fromStaticPtrName p_ty + ; let wrap = mkWpTyApps [expr_ty] + ; loc <- getSrcSpanM + ; return $ mkHsWrapCo co $ HsApp (L loc $ mkHsWrap wrap fromStaticPtr) + (L loc (HsStatic expr')) } {- diff --git a/docs/users_guide/glasgow_exts.rst b/docs/users_guide/glasgow_exts.rst index c39e436..0234955 100644 --- a/docs/users_guide/glasgow_exts.rst +++ b/docs/users_guide/glasgow_exts.rst @@ -11047,11 +11047,11 @@ Using static pointers Each reference is given a key which can be used to locate it at runtime with -:base-ref:`unsafeLookupStaticPtr ` +:base-ref:`unsafeLookupStaticPtr ` which uses a global and immutable table called the Static Pointer Table. The compiler includes entries in this table for all static forms found in the linked modules. The value can be obtained from the reference via -:base-ref:`deRefStaticPtr `. +:base-ref:`deRefStaticPtr `. The body ``e`` of a ``static e`` expression must be a closed expression. That is, there can be no free variables occurring in ``e``, i.e. lambda- @@ -11084,7 +11084,23 @@ Informally, if we have a closed expression :: the static form is of type :: - static e :: (Typeable a_1, ... , Typeable a_n) => StaticPtr t + static e :: (IsStatic p, Typeable a_1, ... , Typeable a_n) => p t + + +A static form determines a value of type ``StaticPtr t``, but just +like ``OverloadedLists`` and ``OverloadedStrings``, this literal +expression is overloaded to allow lifting a ``StaticPtr`` into another +type implicitly, via the ``IsStatic`` class: :: + + class IsStatic p where + fromStaticPtr :: StaticPtr a -> p a + +The only predefined instance is the obvious one that does nothing: :: + + instance IsStatic StaticPtr where + fromStaticPtr sptr = sptr + +See :base-ref:`IsStatic `. Furthermore, type ``t`` is constrained to have a ``Typeable`` instance. The following are therefore illegal: :: diff --git a/libraries/base/GHC/StaticPtr.hs b/libraries/base/GHC/StaticPtr.hs index 117d705..3d5807a 100644 --- a/libraries/base/GHC/StaticPtr.hs +++ b/libraries/base/GHC/StaticPtr.hs @@ -38,6 +38,7 @@ module GHC.StaticPtr , StaticPtrInfo(..) , staticPtrInfo , staticPtrKeys + , IsStatic(..) ) where import Foreign.C.Types (CInt(..)) @@ -80,6 +81,13 @@ unsafeLookupStaticPtr (Fingerprint w1 w2) = do foreign import ccall unsafe hs_spt_lookup :: Ptr () -> IO (Ptr a) +-- | A class for things buildable from static pointers. +class IsStatic p where + fromStaticPtr :: StaticPtr a -> p a + +instance IsStatic StaticPtr where + fromStaticPtr = id + -- | Miscelaneous information available for debugging purposes. data StaticPtrInfo = StaticPtrInfo { -- | Package key of the package where the static pointer is defined From git at git.haskell.org Sat Feb 27 15:21:13 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 27 Feb 2016 15:21:13 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Fix cost-centre-stack bug when creating new PAP (#5654) (5eb31d2) Message-ID: <20160227152113.284483A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/5eb31d270b72982afe008dc32adcf1a44984b6a5/ghc >--------------------------------------------------------------- commit 5eb31d270b72982afe008dc32adcf1a44984b6a5 Author: Simon Marlow Date: Thu Jan 21 09:45:52 2016 +0000 Fix cost-centre-stack bug when creating new PAP (#5654) See comment in `AutoApply.h`. This partly fixes #5654. New test added, and renamed the old test to match the ticket number. (cherry picked from commit 85daac593c498f581d46f44982ee5dcf1001f611) >--------------------------------------------------------------- 5eb31d270b72982afe008dc32adcf1a44984b6a5 rts/AutoApply.h | 12 +++++++++ testsuite/tests/profiling/should_run/T5654.hs | 14 +++++++++++ .../{scc004.prof.sample => T5654.prof.sample} | 0 .../profiling/should_run/T5654b-O0.prof.sample | 29 ++++++++++++++++++++++ .../profiling/should_run/T5654b-O1.prof.sample | 28 +++++++++++++++++++++ testsuite/tests/profiling/should_run/T5654b.hs | 22 ++++++++++++++++ testsuite/tests/profiling/should_run/all.T | 12 ++++++++- testsuite/tests/profiling/should_run/scc004.hs | 10 -------- 8 files changed, 116 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 5eb31d270b72982afe008dc32adcf1a44984b6a5 From git at git.haskell.org Sat Feb 27 15:21:15 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 27 Feb 2016 15:21:15 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Testsuite: cleanup profiling/should_run/all.T (#11521) (2c6d4fa) Message-ID: <20160227152115.CECF43A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/2c6d4fa523a0088bc94ff9cf71514ccce827ab26/ghc >--------------------------------------------------------------- commit 2c6d4fa523a0088bc94ff9cf71514ccce827ab26 Author: Thomas Miedema Date: Sun Feb 21 13:40:56 2016 +0100 Testsuite: cleanup profiling/should_run/all.T (#11521) Refactoring only. I compared before and after with 'make slow', and it still runs each test with the same 'ways' as before. (cherry picked from commit 73e409555019d370f3644bdf02b37dd526de4d8a) >--------------------------------------------------------------- 2c6d4fa523a0088bc94ff9cf71514ccce827ab26 testsuite/tests/profiling/should_run/all.T | 143 +++++++-------------- testsuite/tests/profiling/should_run/bio001.stdout | 1 - 2 files changed, 44 insertions(+), 100 deletions(-) diff --git a/testsuite/tests/profiling/should_run/all.T b/testsuite/tests/profiling/should_run/all.T index 891303e..ae349e9 100644 --- a/testsuite/tests/profiling/should_run/all.T +++ b/testsuite/tests/profiling/should_run/all.T @@ -1,13 +1,5 @@ # Test for #1227, #1418 -extra_prof_ways = ['prof', 'prof_hc_hb', 'prof_hb', 'prof_hd', 'prof_hy', 'prof_hr'] - -test('heapprof001', - [only_ways(prof_ways), - when(have_profiling(), extra_ways(extra_prof_ways)), - extra_run_opts('7')], - compile_and_run, ['']) - test('heapprof002', [ pre_cmd('cp heapprof001.hs heapprof002.hs') , extra_clean(['heapprof002.hs']) @@ -16,107 +8,72 @@ test('heapprof002', ], compile_and_run, ['']) +test('T11489', [req_profiling, extra_clean(['T11489.prof', 'T11489.hp'])], + run_command, ['$MAKE -s --no-print-directory T11489']) + +# Below this line, run tests only with profiling ways. +setTestOpts(req_profiling) +setTestOpts(extra_ways(['prof'])) +setTestOpts(only_ways(prof_ways)) + +extra_prof_ways = ['prof', 'prof_hc_hb', 'prof_hb', 'prof_hd', 'prof_hy', 'prof_hr'] + +test('heapprof001', + [when(have_profiling(), extra_ways(extra_prof_ways)), extra_run_opts('7')], + compile_and_run, ['']) + test('T2592', - [only_ways(['profasm']), req_profiling, - extra_run_opts('+RTS -M1m -RTS'), exit_code(251)], + [only_ways(['profasm']), extra_run_opts('+RTS -M1m -RTS'), exit_code(251)], compile_and_run, ['']) -test('T3001', - [only_ways(['prof_hb']), extra_ways(['prof_hb']), req_profiling], +test('T3001', [only_ways(['prof_hb']), extra_ways(['prof_hb'])], compile_and_run, ['']) -test('T3001-2', - [only_ways(['prof_hb']), extra_ways(['prof_hb']), req_profiling], +test('T3001-2', [only_ways(['prof_hb']), extra_ways(['prof_hb'])], compile_and_run, ['-package bytestring']) -test('scc001', [req_profiling, - extra_ways(['prof']), only_ways(prof_ways), - expect_broken_for(10037,['prof'])], - # As with ioprof001, the unoptimised profile is different but - # not badly wrong (CAF attribution is different). - compile_and_run, +# As with ioprof001, the unoptimised profile is different but +# not badly wrong (CAF attribution is different). +test('scc001', [expect_broken_for(10037, ['prof'])], compile_and_run, ['-fno-state-hack -fno-full-laziness']) # Note [consistent stacks] -test('scc002', [req_profiling, - extra_ways(['prof']), only_ways(prof_ways)], - compile_and_run, - ['']) +test('scc002', [], compile_and_run, ['']) -test('scc003', [req_profiling, - extra_ways(['prof']), only_ways(prof_ways)], - compile_and_run, +test('scc003', [], compile_and_run, ['-fno-state-hack']) # Note [consistent stacks] -test('T5654', [req_profiling, - extra_ways(['prof']), only_ways(prof_ways), - expect_broken(5654)], - compile_and_run, - ['']) +test('T5654', [expect_broken(5654)], compile_and_run, ['']) -test('T5654b-O0', [req_profiling, - extra_ways(['prof']), only_ways(['prof'])], - compile_and_run, - ['']) +test('T5654b-O0', [only_ways(['prof'])], compile_and_run, ['']) -test('T5654b-O1', [req_profiling, - only_ways(['profasm'])], - compile_and_run, - ['']) +test('T5654b-O1', [only_ways(['profasm'])], compile_and_run, ['']) -test('scc005', [req_profiling, - extra_ways(['prof']), only_ways(prof_ways)], - compile_and_run, - ['']) +test('scc005', [], compile_and_run, ['']) -test('T5314', - [ only_ways(prof_ways), - extra_ways(extra_prof_ways), - req_profiling ], - compile_and_run, - ['']) +test('T5314', [extra_ways(extra_prof_ways)], compile_and_run, ['']) -test('T680', - [ req_profiling, extra_ways(['prof']), only_ways(prof_ways) ], - compile_and_run, +test('T680', [], compile_and_run, ['-fno-full-laziness']) # Note [consistent stacks] -test('T2552', - [ req_profiling, extra_ways(['prof']), only_ways(prof_ways), - expect_broken_for(10037, opt_ways)], - compile_and_run, - ['']) +test('T2552', [expect_broken_for(10037, opt_ways)], compile_and_run, ['']) -test('T949', - [ req_profiling, extra_ways(extra_prof_ways), only_ways(prof_ways) ], - compile_and_run, - ['']) - -test('ioprof', - [ req_profiling, extra_ways(['prof']), only_ways(prof_ways), - expect_broken_for(10037,['prof']), - # The results for 'prof' are fine, but the ordering changes. - # We care more about getting the optimised results right, so ignoring - # this for now. - exit_code(1) ], +test('T949', [extra_ways(extra_prof_ways)], compile_and_run, ['']) + +# The results for 'prof' are fine, but the ordering changes. +# We care more about getting the optimised results right, so ignoring +# this for now. +test('ioprof', [expect_broken_for(10037, ['prof']), exit_code(1)], compile_and_run, ['-fno-full-laziness -fno-state-hack']) # Note [consistent stacks] # These two examples are from the User's Guide: -test('prof-doc-fib', - [ req_profiling, extra_ways(['prof']), only_ways(prof_ways) ], - compile_and_run, - ['']) +test('prof-doc-fib', [], compile_and_run, ['']) -test('prof-doc-last', - [ req_profiling, extra_ways(['prof']), only_ways(prof_ways) ], - compile_and_run, - ['-fno-full-laziness']) +test('prof-doc-last', [], compile_and_run, ['-fno-full-laziness']) -test('T5559', # unicode in cost centre names - [ req_profiling, extra_ways(['prof']), only_ways(prof_ways) ], - compile_and_run, - ['']) +# unicode in cost centre names +test('T5559', [], compile_and_run, ['']) # Note [consistent stacks] # Certain optimisations can change the stacks we get out of the @@ -126,26 +83,14 @@ test('T5559', # unicode in cost centre names # -fno-state-hack # -fno-full-laziness -test('callstack001', - [ req_profiling, extra_ways(['prof']), only_ways(prof_ways), - expect_broken_for(10037,['prof'])], +test('callstack001', [expect_broken_for(10037, ['prof'])], # unoptimised results are different w.r.t. CAF attribution compile_and_run, ['-fprof-auto-calls -fno-full-laziness -fno-state-hack']) -test('callstack002', - [ req_profiling, extra_ways(['prof']), only_ways(prof_ways) ], - compile_and_run, ['-fprof-auto-calls -fno-full-laziness -fno-state-hack']) +test('callstack002', [], compile_and_run, + ['-fprof-auto-calls -fno-full-laziness -fno-state-hack']) # Should not stack overflow with -prof -auto-all -test('T5363', - [ req_profiling, extra_ways(['prof']), only_ways(prof_ways) ], - compile_and_run, ['']) - -test('profinline001', - [ req_profiling, extra_ways(['prof']), only_ways(prof_ways) ], - compile_and_run, ['']) +test('T5363', [], compile_and_run, ['']) -test('T11489', [ - req_profiling, - extra_clean(['T11489.prof', 'T11489.hp']), - ], run_command, ['$MAKE -s --no-print-directory T11489']) +test('profinline001', [], compile_and_run, ['']) diff --git a/testsuite/tests/profiling/should_run/bio001.stdout b/testsuite/tests/profiling/should_run/bio001.stdout deleted file mode 100644 index 90ee71a..0000000 --- a/testsuite/tests/profiling/should_run/bio001.stdout +++ /dev/null @@ -1 +0,0 @@ -5000050000 From git at git.haskell.org Sat Feb 27 15:21:18 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 27 Feb 2016 15:21:18 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Filter out -prof callstacks from test output (#11521) (dd55ce4) Message-ID: <20160227152118.AFBAD3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/dd55ce43051156265cd30fa9a7300310b002b39d/ghc >--------------------------------------------------------------- commit dd55ce43051156265cd30fa9a7300310b002b39d Author: Thomas Miedema Date: Mon Feb 22 17:44:17 2016 +0100 Filter out -prof callstacks from test output (#11521) (cherry picked from commit 176be87cb28f675d87ea8f5c07eaef7ca47ff8de) >--------------------------------------------------------------- dd55ce43051156265cd30fa9a7300310b002b39d testsuite/driver/testglobals.py | 3 +++ testsuite/driver/testlib.py | 19 ++++++++++++++++--- testsuite/tests/profiling/should_run/all.T | 1 + 3 files changed, 20 insertions(+), 3 deletions(-) diff --git a/testsuite/driver/testglobals.py b/testsuite/driver/testglobals.py index 0891624..6f8dd64 100644 --- a/testsuite/driver/testglobals.py +++ b/testsuite/driver/testglobals.py @@ -265,6 +265,9 @@ class TestOptions: # Extra normalisation for compiler error messages self.extra_errmsg_normaliser = lambda x: x + # Keep profiling callstacks. + self.keep_prof_callstacks = False + # The directory the test is in self.testdir = '.' diff --git a/testsuite/driver/testlib.py b/testsuite/driver/testlib.py index 0251884..08ab6e1 100644 --- a/testsuite/driver/testlib.py +++ b/testsuite/driver/testlib.py @@ -516,6 +516,13 @@ def normalise_drive_letter(name, opts): # Windows only. Change D:\\ to C:\\. _normalise_fun(name, opts, lambda str: re.sub(r'[A-Z]:\\', r'C:\\', str)) +def keep_prof_callstacks(name, opts): + """Keep profiling callstacks. + + Use together with `only_ways(prof_ways)`. + """ + opts.keep_prof_callstacks = True + def join_normalisers(*a): """ Compose functions, flattening sequences. @@ -1691,15 +1698,21 @@ def normalise_whitespace( str ): callSite_re = re.compile(r', called at (.+):[\d]+:[\d]+ in [\w\-\.]+:') -def normalise_callstacks(str): +def normalise_callstacks(s): + opts = getTestOpts() def repl(matches): location = matches.group(1) location = normalise_slashes_(location) return ', called at {0}:: in :'.format(location) # Ignore line number differences in call stacks (#10834). - str1 = re.sub(callSite_re, repl, str) + s = re.sub(callSite_re, repl, s) # Ignore the change in how we identify implicit call-stacks - return str1.replace('from ImplicitParams', 'from HasCallStack') + s = s.replace('from ImplicitParams', 'from HasCallStack') + if not opts.keep_prof_callstacks: + # Don't output prof callstacks. Test output should be + # independent from the WAY we run the test. + s = re.sub(r'CallStack \(from -prof\):(\n .*)*\n?', '', s) + return s tyCon_re = re.compile(r'TyCon\s*\d+L?\#\#\s*\d+L?\#\#\s*', flags=re.MULTILINE) diff --git a/testsuite/tests/profiling/should_run/all.T b/testsuite/tests/profiling/should_run/all.T index ae349e9..707ade3 100644 --- a/testsuite/tests/profiling/should_run/all.T +++ b/testsuite/tests/profiling/should_run/all.T @@ -15,6 +15,7 @@ test('T11489', [req_profiling, extra_clean(['T11489.prof', 'T11489.hp'])], setTestOpts(req_profiling) setTestOpts(extra_ways(['prof'])) setTestOpts(only_ways(prof_ways)) +setTestOpts(keep_prof_callstacks) extra_prof_ways = ['prof', 'prof_hc_hb', 'prof_hb', 'prof_hd', 'prof_hy', 'prof_hr'] From git at git.haskell.org Sat Feb 27 15:21:21 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 27 Feb 2016 15:21:21 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Refactoring only: use ExprLStmt (f6c8ce9) Message-ID: <20160227152121.7035C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/f6c8ce9a009f76227b07706932220fcce1917605/ghc >--------------------------------------------------------------- commit f6c8ce9a009f76227b07706932220fcce1917605 Author: Simon Marlow Date: Sat Feb 20 06:59:10 2016 +0000 Refactoring only: use ExprLStmt (cherry picked from commit 6cec90584deca4b09538e89804648435b284cff0) >--------------------------------------------------------------- f6c8ce9a009f76227b07706932220fcce1917605 compiler/rename/RnExpr.hs | 38 +++++++++++++++++++------------------- 1 file changed, 19 insertions(+), 19 deletions(-) diff --git a/compiler/rename/RnExpr.hs b/compiler/rename/RnExpr.hs index 69b8d6e..616f259 100644 --- a/compiler/rename/RnExpr.hs +++ b/compiler/rename/RnExpr.hs @@ -678,8 +678,8 @@ rnStmtsWithPostProcessing ctxt rnBody ppStmts stmts thing_inside -- | maybe rearrange statements according to the ApplicativeDo transformation postProcessStmtsForApplicativeDo :: HsStmtContext Name - -> [(LStmt Name (LHsExpr Name), FreeVars)] - -> RnM ([LStmt Name (LHsExpr Name)], FreeVars) + -> [(ExprLStmt Name, FreeVars)] + -> RnM ([ExprLStmt Name], FreeVars) postProcessStmtsForApplicativeDo ctxt stmts = do { -- rearrange the statements using ApplicativeStmt if @@ -1430,8 +1430,8 @@ dsDo {(arg_1 | ... | arg_n); stmts} expr = -- Note [ApplicativeDo]. rearrangeForApplicativeDo :: HsStmtContext Name - -> [(LStmt Name (LHsExpr Name), FreeVars)] - -> RnM ([LStmt Name (LHsExpr Name)], FreeVars) + -> [(ExprLStmt Name, FreeVars)] + -> RnM ([ExprLStmt Name], FreeVars) rearrangeForApplicativeDo _ [] = return ([], emptyNameSet) rearrangeForApplicativeDo ctxt stmts0 = do @@ -1445,10 +1445,10 @@ rearrangeForApplicativeDo ctxt stmts0 = do -- | The ApplicativeDo transformation. ado :: HsStmtContext Name - -> [(LStmt Name (LHsExpr Name), FreeVars)] -- ^ input statements - -> [LStmt Name (LHsExpr Name)] -- ^ the "tail" + -> [(ExprLStmt Name, FreeVars)] -- ^ input statements + -> [ExprLStmt Name] -- ^ the "tail" -> FreeVars -- ^ free variables of the tail - -> RnM ( [LStmt Name (LHsExpr Name)] -- ( output statements, + -> RnM ( [ExprLStmt Name] -- ( output statements, , FreeVars ) -- , things we needed -- e.g. <$>, <*>, join ) @@ -1491,10 +1491,10 @@ ado ctxt stmts tail tail_fvs = -- two halves. adoSegment :: HsStmtContext Name - -> [(LStmt Name (LHsExpr Name), FreeVars)] - -> [LStmt Name (LHsExpr Name)] + -> [(ExprLStmt Name, FreeVars)] + -> [ExprLStmt Name] -> FreeVars - -> RnM ( [LStmt Name (LHsExpr Name)], FreeVars ) + -> RnM ( [ExprLStmt Name], FreeVars ) adoSegment ctxt stmts tail tail_fvs = do { -- choose somewhere to put a bind let (before,after) = splitSegment stmts @@ -1509,7 +1509,7 @@ adoSegment ctxt stmts tail tail_fvs adoSegmentArg :: HsStmtContext Name -> FreeVars - -> [(LStmt Name (LHsExpr Name), FreeVars)] + -> [(ExprLStmt Name, FreeVars)] -> RnM (ApplicativeArg Name Name, FreeVars) adoSegmentArg _ _ [(L _ (BindStmt pat exp _ _ _),_)] = return (ApplicativeArgOne pat exp, emptyFVs) @@ -1532,8 +1532,8 @@ adoSegmentArg ctxt tail_fvs stmts = -- | Divide a sequence of statements into segments, where no segment -- depends on any variables defined by a statement in another segment. segments - :: [(LStmt Name (LHsExpr Name), FreeVars)] - -> [[(LStmt Name (LHsExpr Name), FreeVars)]] + :: [(ExprLStmt Name, FreeVars)] + -> [[(ExprLStmt Name, FreeVars)]] segments stmts = map fst $ merge $ reverse $ map reverse $ walk (reverse stmts) where allvars = mkNameSet (concatMap (collectStmtBinders.unLoc.fst) stmts) @@ -1573,9 +1573,9 @@ segments stmts = map fst $ merge $ reverse $ map reverse $ walk (reverse stmts) -- heuristic is to peel off the first group of independent statements -- and put the bind after those. splitSegment - :: [(LStmt Name (LHsExpr Name), FreeVars)] - -> ( [(LStmt Name (LHsExpr Name), FreeVars)] - , [(LStmt Name (LHsExpr Name), FreeVars)] ) + :: [(ExprLStmt Name, FreeVars)] + -> ( [(ExprLStmt Name, FreeVars)] + , [(ExprLStmt Name, FreeVars)] ) splitSegment stmts | Just (lets,binds,rest) <- slurpIndependentStmts stmts = if not (null lets) @@ -1629,8 +1629,8 @@ mkApplicativeStmt :: HsStmtContext Name -> [ApplicativeArg Name Name] -- ^ The args -> Bool -- ^ True <=> need a join - -> [LStmt Name (LHsExpr Name)] -- ^ The body statements - -> RnM ([LStmt Name (LHsExpr Name)], FreeVars) + -> [ExprLStmt Name] -- ^ The body statements + -> RnM ([ExprLStmt Name], FreeVars) mkApplicativeStmt ctxt args need_join body_stmts = do { (fmap_op, fvs1) <- lookupStmtName ctxt fmapName ; (ap_op, fvs2) <- lookupStmtName ctxt apAName @@ -1649,7 +1649,7 @@ mkApplicativeStmt ctxt args need_join body_stmts -- | Given the statements following an ApplicativeStmt, determine whether -- we need a @join@ or not, and remove the @return@ if necessary. -needJoin :: [LStmt Name (LHsExpr Name)] -> (Bool, [LStmt Name (LHsExpr Name)]) +needJoin :: [ExprLStmt Name] -> (Bool, [ExprLStmt Name]) needJoin [] = (False, []) -- we're in an ApplicativeArg needJoin [L loc (LastStmt e _ t)] | Just arg <- isReturnApp e = (False, [L loc (LastStmt arg True t)]) From git at git.haskell.org Sat Feb 27 15:21:24 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 27 Feb 2016 15:21:24 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Fix a bug in ApplicativeDo (#11612) (e3020f2) Message-ID: <20160227152124.1EF323A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/e3020f26e322e0fcbc7ea2403479d6a734578bc8/ghc >--------------------------------------------------------------- commit e3020f26e322e0fcbc7ea2403479d6a734578bc8 Author: Simon Marlow Date: Sat Feb 20 07:23:37 2016 +0000 Fix a bug in ApplicativeDo (#11612) In some cases ApplicativeDo would miss some opportunities, due to a wrong calculation of free variables in RnExpr.segments. (cherry picked from commit 3259bf658662e7052ae91de2fa27baae8c84b7fa) >--------------------------------------------------------------- e3020f26e322e0fcbc7ea2403479d6a734578bc8 compiler/rename/RnExpr.hs | 27 +++++++++++++++++++++------ testsuite/tests/ado/ado001.hs | 12 ++++++++++++ testsuite/tests/ado/ado001.stdout | 1 + 3 files changed, 34 insertions(+), 6 deletions(-) diff --git a/compiler/rename/RnExpr.hs b/compiler/rename/RnExpr.hs index 616f259..9d1200a 100644 --- a/compiler/rename/RnExpr.hs +++ b/compiler/rename/RnExpr.hs @@ -1549,24 +1549,36 @@ segments stmts = map fst $ merge $ reverse $ map reverse $ walk (reverse stmts) _otherwise -> (seg,all_lets) : rest where rest = merge segs - all_lets = all (not . isBindStmt . fst) seg + all_lets = all (isLetStmt . fst) seg + -- walk splits the statement sequence into segments, traversing + -- the sequence from the back to the front, and keeping track of + -- the set of free variables of the current segment. Whenever + -- this set of free variables is empty, we have a complete segment. + walk :: [(ExprLStmt Name, FreeVars)] -> [[(ExprLStmt Name, FreeVars)]] walk [] = [] walk ((stmt,fvs) : stmts) = ((stmt,fvs) : seg) : walk rest - where (seg,rest) = chunter (fvs `intersectNameSet` allvars) stmts + where (seg,rest) = chunter fvs' stmts + (_, fvs') = stmtRefs stmt fvs chunter _ [] = ([], []) chunter vars ((stmt,fvs) : rest) | not (isEmptyNameSet vars) = ((stmt,fvs) : chunk, rest') where (chunk,rest') = chunter vars' rest - evars = fvs `intersectNameSet` allvars - pvars = mkNameSet (collectStmtBinders (unLoc stmt)) + (pvars, evars) = stmtRefs stmt fvs vars' = (vars `minusNameSet` pvars) `unionNameSet` evars chunter _ rest = ([], rest) - isBindStmt (L _ BindStmt{}) = True - isBindStmt _ = False + stmtRefs stmt fvs + | isLetStmt stmt = (pvars, fvs' `minusNameSet` pvars) + | otherwise = (pvars, fvs') + where fvs' = fvs `intersectNameSet` allvars + pvars = mkNameSet (collectStmtBinders (unLoc stmt)) + +isLetStmt :: LStmt a b -> Bool +isLetStmt (L _ LetStmt{}) = True +isLetStmt _ = False -- | Find a "good" place to insert a bind in an indivisible segment. -- This is the only place where we use heuristics. The current @@ -1576,6 +1588,9 @@ splitSegment :: [(ExprLStmt Name, FreeVars)] -> ( [(ExprLStmt Name, FreeVars)] , [(ExprLStmt Name, FreeVars)] ) +splitSegment [one,two] = ([one],[two]) + -- there is no choice when there are only two statements; this just saves + -- some work in a common case. splitSegment stmts | Just (lets,binds,rest) <- slurpIndependentStmts stmts = if not (null lets) diff --git a/testsuite/tests/ado/ado001.hs b/testsuite/tests/ado/ado001.hs index 9f8f8da..e452cdd 100644 --- a/testsuite/tests/ado/ado001.hs +++ b/testsuite/tests/ado/ado001.hs @@ -109,6 +109,17 @@ test10 = do x5 <- e return (const () (x3,x4,x5)) +-- (a | b) +-- This demonstrated a bug in RnExpr.segments (#11612) +test11 :: M () +test11 = do + x1 <- a + let x2 = x1 + x3 <- b + let x4 = c + x5 = x4 + return (const () (x1,x2,x3,x4)) + main = mapM_ run [ test1 , test2 @@ -120,6 +131,7 @@ main = mapM_ run , test8 , test9 , test10 + , test11 ] -- Testing code, prints out the structure of a monad/applicative expression diff --git a/testsuite/tests/ado/ado001.stdout b/testsuite/tests/ado/ado001.stdout index 93e300c..f7c48ca 100644 --- a/testsuite/tests/ado/ado001.stdout +++ b/testsuite/tests/ado/ado001.stdout @@ -8,3 +8,4 @@ a; (b | (c; (d; (e | (f; g))))) a; ((b | c) | d) ((a | (b; c)) | d) | e ((a | b); (c | d)) | e +a | b From git at git.haskell.org Sat Feb 27 15:21:27 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 27 Feb 2016 15:21:27 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: ApplicativeDo: Handle terminal `pure` statements (32e2d58) Message-ID: <20160227152127.4DB713A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/32e2d58c8b767d791dd79f5e77f39a776f784054/ghc >--------------------------------------------------------------- commit 32e2d58c8b767d791dd79f5e77f39a776f784054 Author: Ben Gamari Date: Thu Feb 25 14:47:34 2016 +0100 ApplicativeDo: Handle terminal `pure` statements ApplicativeDo handled terminal `return` statements properly, but not `pure`. Test Plan: Validate with included testcase Reviewers: austin, simonmar Reviewed By: austin, simonmar Subscribers: simonpj, thomie Differential Revision: https://phabricator.haskell.org/D1931 GHC Trac Issues: #11607 (cherry picked from commit 0c7db61f8a17b2c5c4335b62103eb9ffc5d24154) >--------------------------------------------------------------- 32e2d58c8b767d791dd79f5e77f39a776f784054 compiler/rename/RnExpr.hs | 2 +- docs/users_guide/glasgow_exts.rst | 3 ++- testsuite/tests/ado/T11607.hs | 10 ++++++++++ testsuite/tests/ado/T11607.stdout | 1 + testsuite/tests/ado/all.T | 1 + 5 files changed, 15 insertions(+), 2 deletions(-) diff --git a/compiler/rename/RnExpr.hs b/compiler/rename/RnExpr.hs index 9d1200a..ce113b4 100644 --- a/compiler/rename/RnExpr.hs +++ b/compiler/rename/RnExpr.hs @@ -1678,7 +1678,7 @@ isReturnApp (L _ (HsApp f arg)) | otherwise = Nothing where is_return (L _ (HsPar e)) = is_return e - is_return (L _ (HsVar (L _ r))) = r == returnMName + is_return (L _ (HsVar (L _ r))) = r == returnMName || r == pureAName -- TODO: I don't know how to get this right for rebindable syntax is_return _ = False isReturnApp _ = Nothing diff --git a/docs/users_guide/glasgow_exts.rst b/docs/users_guide/glasgow_exts.rst index 0234955..594745d 100644 --- a/docs/users_guide/glasgow_exts.rst +++ b/docs/users_guide/glasgow_exts.rst @@ -906,7 +906,8 @@ is as follows. If the do-expression has the following form: :: where none of the variables defined by ``p1...pn`` are mentioned in ``E1...En``, then the expression will only require ``Applicative``. Otherwise, the expression -will require ``Monad``. +will require ``Monad``. The block may return a pure expression ``E`` depending +upon the results ``p1...pn`` with either ``return`` or ``pure``. .. _applicative-do-pitfall: diff --git a/testsuite/tests/ado/T11607.hs b/testsuite/tests/ado/T11607.hs new file mode 100644 index 0000000..f2bb341 --- /dev/null +++ b/testsuite/tests/ado/T11607.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE ApplicativeDo #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + +newtype MaybeA a = MaybeA (Maybe a) + deriving (Show, Functor, Applicative) + +main :: IO () +main = print $ do + x <- MaybeA $ Just 42 + pure x diff --git a/testsuite/tests/ado/T11607.stdout b/testsuite/tests/ado/T11607.stdout new file mode 100644 index 0000000..1e6c1e1 --- /dev/null +++ b/testsuite/tests/ado/T11607.stdout @@ -0,0 +1 @@ +MaybeA (Just 42) diff --git a/testsuite/tests/ado/all.T b/testsuite/tests/ado/all.T index 2ec3e34..e1efdf2 100644 --- a/testsuite/tests/ado/all.T +++ b/testsuite/tests/ado/all.T @@ -5,3 +5,4 @@ test('ado004', normal, compile, ['']) test('ado005', normal, compile_fail, ['']) test('ado006', normal, compile, ['']) test('ado007', normal, compile, ['']) +test('T11607', normal, compile_and_run, ['']) From git at git.haskell.org Sat Feb 27 15:21:30 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 27 Feb 2016 15:21:30 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Make warning names more consistent (e61e290) Message-ID: <20160227152130.116C23A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/e61e29081c8f73d3fa933f456fac49c51a9599db/ghc >--------------------------------------------------------------- commit e61e29081c8f73d3fa933f456fac49c51a9599db Author: Manav Rathi Date: Thu Feb 25 14:51:32 2016 +0100 Make warning names more consistent - Replace "Sigs" with "Signatures" in WarningFlag data constructors. - Replace "PatSyn" with "PatternSynonym" in WarningFlag data constructors. - Deprecate "missing-local-sigs" in favor of "missing-local-signatures". - Deprecate "missing-exported-sigs" in favor of "missing-exported-signatures". - Deprecate "missing-pat-syn-signatures" in favor of "missing-pattern-synonym-signatures". - Replace "ddump-strsigs" with "ddump-str-signatures" These complete the tasks that were explicitly mentioned in #11583 Test Plan: Executed `ghc --show-options` and verified that the flags were changed as expected. Reviewers: svenpanne, austin, bgamari Reviewed By: austin, bgamari Subscribers: mpickering, thomie Differential Revision: https://phabricator.haskell.org/D1939 GHC Trac Issues: #11583 (cherry picked from commit 665849142bca36c14bcb25d64180c153a1ef1f2c) >--------------------------------------------------------------- e61e29081c8f73d3fa933f456fac49c51a9599db compiler/main/DynFlags.hs | 31 ++++++++------ compiler/rename/RnNames.hs | 12 +++--- compiler/stranal/DmdAnal.hs | 3 +- compiler/typecheck/TcBinds.hs | 8 ++-- docs/users_guide/8.0.1-notes.rst | 16 +++++-- docs/users_guide/debugging.rst | 2 +- docs/users_guide/using-warnings.rst | 49 +++++++++++++++------- testsuite/tests/patsyn/should_fail/T11053.hs | 2 +- testsuite/tests/patsyn/should_fail/all.T | 2 +- testsuite/tests/stranal/sigs/all.T | 2 +- testsuite/tests/warnings/should_compile/T10908.hs | 2 +- testsuite/tests/warnings/should_compile/all.T | 6 +-- utils/mkUserGuidePart/Options/CompilerDebugging.hs | 2 +- utils/mkUserGuidePart/Options/Warnings.hs | 15 +++++++ 14 files changed, 101 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 e61e29081c8f73d3fa933f456fac49c51a9599db From git at git.haskell.org Sat Feb 27 15:21:33 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 27 Feb 2016 15:21:33 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Handle multiline named haddock comments properly (a69542b) Message-ID: <20160227152133.367C23A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/a69542ba51f7dd1d77b2e16f2b3259263cc375f6/ghc >--------------------------------------------------------------- commit a69542ba51f7dd1d77b2e16f2b3259263cc375f6 Author: Thomas Miedema Date: Thu Feb 25 15:51:38 2016 +0100 Handle multiline named haddock comments properly Fixes #10398 in a different way, thereby also fixing #11579. I inverted the logic of the Bool argument to "worker", to hopefully make it more self-explanatory. Reviewers: austin, hvr, bgamari Reviewed By: bgamari Differential Revision: https://phabricator.haskell.org/D1935 (cherry picked from commit 6350eb1126e29b93829de688623c91b772f6d9eb) >--------------------------------------------------------------- a69542ba51f7dd1d77b2e16f2b3259263cc375f6 compiler/parser/Lexer.x | 43 +++++++++++++++++++++++------------ libraries/base/GHC/ExecutionStack.hs | 2 +- testsuite/tests/ghc-api/T11579.hs | 26 +++++++++++++++++++++ testsuite/tests/ghc-api/T11579.stdout | 1 + testsuite/tests/ghc-api/all.T | 2 ++ 5 files changed, 58 insertions(+), 16 deletions(-) diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x index b3b73f6..899849c 100644 --- a/compiler/parser/Lexer.x +++ b/compiler/parser/Lexer.x @@ -981,24 +981,35 @@ ifExtension pred bits _ _ _ = pred bits multiline_doc_comment :: Action multiline_doc_comment span buf _len = withLexedDocType (worker "") where - worker commentAcc input docType oneLine = case alexGetChar' input of + worker commentAcc input docType checkNextLine = case alexGetChar' input of Just ('\n', input') - | oneLine -> docCommentEnd input commentAcc docType buf span - | otherwise -> case checkIfCommentLine input' of - Just input -> worker ('\n':commentAcc) input docType False + | checkNextLine -> case checkIfCommentLine input' of + Just input -> worker ('\n':commentAcc) input docType checkNextLine Nothing -> docCommentEnd input commentAcc docType buf span - Just (c, input) -> worker (c:commentAcc) input docType oneLine + | otherwise -> docCommentEnd input commentAcc docType buf span + Just (c, input) -> worker (c:commentAcc) input docType checkNextLine Nothing -> docCommentEnd input commentAcc docType buf span + -- Check if the next line of input belongs to this doc comment as well. + -- A doc comment continues onto the next line when the following + -- conditions are met: + -- * The line starts with "--" + -- * The line doesn't start with "---". + -- * The line doesn't start with "-- $", because that would be the + -- start of a /new/ named haddock chunk (#10398). + checkIfCommentLine :: AlexInput -> Maybe AlexInput checkIfCommentLine input = check (dropNonNewlineSpace input) where - check input = case alexGetChar' input of - Just ('-', input) -> case alexGetChar' input of - Just ('-', input) -> case alexGetChar' input of - Just (c, _) | c /= '-' -> Just input - _ -> Nothing - _ -> Nothing - _ -> Nothing + check input = do + ('-', input) <- alexGetChar' input + ('-', input) <- alexGetChar' input + (c, after_c) <- alexGetChar' input + case c of + '-' -> Nothing + ' ' -> case alexGetChar' after_c of + Just ('$', _) -> Nothing + _ -> Just input + _ -> Just input dropNonNewlineSpace input = case alexGetChar' input of Just (c, input') @@ -1062,8 +1073,10 @@ withLexedDocType :: (AlexInput -> (String -> Token) -> Bool -> P (RealLocated To withLexedDocType lexDocComment = do input@(AI _ buf) <- getInput case prevChar buf ' ' of - '|' -> lexDocComment input ITdocCommentNext False - '^' -> lexDocComment input ITdocCommentPrev False + -- The `Bool` argument to lexDocComment signals whether or not the next + -- line of input might also belong to this doc comment. + '|' -> lexDocComment input ITdocCommentNext True + '^' -> lexDocComment input ITdocCommentPrev True '$' -> lexDocComment input ITdocCommentNamed True '*' -> lexDocSection 1 input '#' -> lexDocComment input ITdocOptionsOld False @@ -1071,7 +1084,7 @@ withLexedDocType lexDocComment = do where lexDocSection n input = case alexGetChar' input of Just ('*', input) -> lexDocSection (n+1) input - Just (_, _) -> lexDocComment input (ITdocSection n) True + Just (_, _) -> lexDocComment input (ITdocSection n) False Nothing -> do setInput input; lexToken -- eof reached, lex it normally -- RULES pragmas turn on the forall and '.' keywords, and we turn them diff --git a/libraries/base/GHC/ExecutionStack.hs b/libraries/base/GHC/ExecutionStack.hs index 11f8c9e..22be903 100644 --- a/libraries/base/GHC/ExecutionStack.hs +++ b/libraries/base/GHC/ExecutionStack.hs @@ -22,7 +22,7 @@ -- Your GHC must have been built with @libdw@ support for this to work. -- -- @ --- $ ghc --info | grep libdw +-- user at host:~$ ghc --info | grep libdw -- ,("RTS expects libdw","YES") -- @ -- diff --git a/testsuite/tests/ghc-api/T11579.hs b/testsuite/tests/ghc-api/T11579.hs new file mode 100644 index 0000000..3294f99 --- /dev/null +++ b/testsuite/tests/ghc-api/T11579.hs @@ -0,0 +1,26 @@ +import System.Environment +import DynFlags +import FastString +import GHC +import StringBuffer +import Lexer +import SrcLoc + +main :: IO () +main = do + [libdir] <- getArgs + + let stringBuffer = stringToStringBuffer "-- $bar some\n-- named chunk" + loc = mkRealSrcLoc (mkFastString "Foo.hs") 1 1 + + token <- runGhc (Just libdir) $ do + dflags <- getSessionDynFlags + let pstate = mkPState (dflags `gopt_set` Opt_Haddock) stringBuffer loc + case unP (lexer False return) pstate of + POk _ token -> return (unLoc token) + _ -> error "No token" + + -- #11579 + -- Expected: "ITdocCommentNamed "bar some\n named chunk" + -- Actual (with ghc-8.0.1-rc2): "ITdocCommentNamed "bar some" + print token diff --git a/testsuite/tests/ghc-api/T11579.stdout b/testsuite/tests/ghc-api/T11579.stdout new file mode 100644 index 0000000..7603e53 --- /dev/null +++ b/testsuite/tests/ghc-api/T11579.stdout @@ -0,0 +1 @@ +ITdocCommentNamed "bar some\n named chunk" diff --git a/testsuite/tests/ghc-api/all.T b/testsuite/tests/ghc-api/all.T index e3e31da..a5267a2 100644 --- a/testsuite/tests/ghc-api/all.T +++ b/testsuite/tests/ghc-api/all.T @@ -20,3 +20,5 @@ test('T10942', extra_run_opts('"' + config.libdir + '"'), test('T9015', extra_run_opts('"' + config.libdir + '"'), compile_and_run, ['-package ghc']) +test('T11579', extra_run_opts('"' + config.libdir + '"'), compile_and_run, + ['-package ghc']) From git at git.haskell.org Sat Feb 27 15:21:35 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 27 Feb 2016 15:21:35 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Filter out BuiltinRules in occurrence analysis (934022c) Message-ID: <20160227152135.DF47C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/934022c088778303fcfac9c63d8c2fd4a4f1fdc2/ghc >--------------------------------------------------------------- commit 934022c088778303fcfac9c63d8c2fd4a4f1fdc2 Author: Simon Peyton Jones Date: Fri Feb 26 17:12:52 2016 +0000 Filter out BuiltinRules in occurrence analysis Fixes Trac #11651. Merge to 8.0. (cherry picked from commit e193f66669eda712e832a05349055f8e518f770a) >--------------------------------------------------------------- 934022c088778303fcfac9c63d8c2fd4a4f1fdc2 compiler/simplCore/OccurAnal.hs | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/compiler/simplCore/OccurAnal.hs b/compiler/simplCore/OccurAnal.hs index d1c3ca8..3eb20d0 100644 --- a/compiler/simplCore/OccurAnal.hs +++ b/compiler/simplCore/OccurAnal.hs @@ -86,6 +86,7 @@ occurAnalysePgm this_mod active_rule imp_rules vects vectVars binds imp_rule_edges = foldr (plusVarEnv_C unionVarSet) emptyVarEnv [ mapVarEnv (const maps_to) (exprFreeIds arg `delVarSetList` ru_bndrs imp_rule) | imp_rule <- imp_rules + , not (isBuiltinRule imp_rule) -- See Note [Plugin rules] , let maps_to = exprFreeIds (ru_rhs imp_rule) `delVarSetList` ru_bndrs imp_rule , arg <- ru_args imp_rule ] @@ -114,6 +115,19 @@ occurAnalyseExpr' enable_binder_swap expr -- To be conservative, we say that all inlines and rules are active all_active_rules = \_ -> True +{- Note [Plugin rules] +~~~~~~~~~~~~~~~~~~~~~~ +Conal Eliot (Trac #11651) built a GHC plugin that added some +BuiltinRules (for imported Ids) to the mg_rules field of ModGuts, to +do some domain-specific transformations that could not be expressed +with an ordinary pattern-matching CoreRule. But then we can't extract +the dependencies (in imp_rule_edges) from ru_rhs etc, because a +BuiltinRule doesn't have any of that stuff. + +So we simply assume that BuiltinRules have no dependencies, and filter +them out from the imp_rule_edges comprehension. +-} + {- ************************************************************************ * * From git at git.haskell.org Sat Feb 27 15:21:39 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 27 Feb 2016 15:21:39 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Exclude TyVars from the constraint solver (7f15c2b) Message-ID: <20160227152139.26F8B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/7f15c2b8cd0b8c9f2e407b3a91a5541677df306b/ghc >--------------------------------------------------------------- commit 7f15c2b8cd0b8c9f2e407b3a91a5541677df306b Author: Simon Peyton Jones Date: Fri Feb 26 09:02:07 2016 +0000 Exclude TyVars from the constraint solver There is a general invariant that the constraint solver doesn't see TyVars, only TcTyVars. But when checking the generic-default signature of a class, we called checkValidType on the generic-default type, which had the class TyVar free. That in turn meant that it wasn't considered during flattening, which led to the error reported in Trac #11608. The fix is simple: call checkValidType on the /closed/ type. Easy. While I was at it, I added a bunch of ASSERTs about the TcTyVar invariant. (cherry picked from commit 7496be5c0ab96bcc9ab70ab873aa561674b7789d) >--------------------------------------------------------------- 7f15c2b8cd0b8c9f2e407b3a91a5541677df306b compiler/typecheck/TcErrors.hs | 49 ++++++++++++++------- compiler/typecheck/TcTyClsDecls.hs | 16 +++++-- compiler/typecheck/TcType.hs | 50 +++++++++++++++------- testsuite/tests/typecheck/should_compile/T11608.hs | 14 ++++++ testsuite/tests/typecheck/should_compile/all.T | 1 + 5 files changed, 96 insertions(+), 34 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 7f15c2b8cd0b8c9f2e407b3a91a5541677df306b From git at git.haskell.org Sat Feb 27 15:21:41 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 27 Feb 2016 15:21:41 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Get the right in-scope set in specUnfolding (c7d83f8) Message-ID: <20160227152141.C921E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/c7d83f84a51c0f8b8e60bb824efa7830516f9da9/ghc >--------------------------------------------------------------- commit c7d83f84a51c0f8b8e60bb824efa7830516f9da9 Author: Simon Peyton Jones Date: Thu Feb 25 15:55:56 2016 +0000 Get the right in-scope set in specUnfolding This fixes Trac #11600 (cherry picked from commit 4ddfe1352e20d805a0ad6eeea0400ee218023bfb) >--------------------------------------------------------------- c7d83f84a51c0f8b8e60bb824efa7830516f9da9 compiler/coreSyn/CoreUnfold.hs | 4 ++++ compiler/specialise/Specialise.hs | 21 ++++++++++++++++----- 2 files changed, 20 insertions(+), 5 deletions(-) diff --git a/compiler/coreSyn/CoreUnfold.hs b/compiler/coreSyn/CoreUnfold.hs index 48cdb5e..7dde2c0 100644 --- a/compiler/coreSyn/CoreUnfold.hs +++ b/compiler/coreSyn/CoreUnfold.hs @@ -149,6 +149,10 @@ mkInlinableUnfolding dflags expr specUnfolding :: DynFlags -> Subst -> [Var] -> [CoreExpr] -> Unfolding -> Unfolding -- See Note [Specialising unfoldings] +-- specUnfolding subst new_bndrs spec_args unf +-- = \new_bndrs. (subst( unf ) spec_args) +-- +-- Precondition: in-scope(subst) `superset` fvs( spec_args ) specUnfolding _ subst new_bndrs spec_args df@(DFunUnfolding { df_bndrs = bndrs, df_con = con , df_args = args }) = ASSERT2( length bndrs >= length spec_args, ppr df $$ ppr spec_args $$ ppr new_bndrs ) diff --git a/compiler/specialise/Specialise.hs b/compiler/specialise/Specialise.hs index 1ddef4a..c080cab 100644 --- a/compiler/specialise/Specialise.hs +++ b/compiler/specialise/Specialise.hs @@ -1312,9 +1312,17 @@ specCalls mb_mod env rules_for_me calls_for_me fn rhs = (inl_prag { inl_inline = EmptyInlineSpec }, noUnfolding) | otherwise - = (inl_prag, specUnfolding dflags (se_subst env) - poly_tyvars (ty_args ++ spec_dict_args) - fn_unf) + = (inl_prag, specUnfolding dflags spec_unf_subst poly_tyvars + spec_unf_args fn_unf) + + spec_unf_args = ty_args ++ spec_dict_args + spec_unf_subst = CoreSubst.setInScope (se_subst env) + (CoreSubst.substInScope (se_subst rhs_env2)) + -- Extend the in-scope set to satisfy the precondition of + -- specUnfolding, namely that in-scope(unf_subst) includes + -- the free vars of spec_unf_args. The in-scope set of rhs_env2 + -- is just the ticket; but the actual substitution we want is + -- the same old one from 'env' -------------------------------------- -- Adding arity information just propagates it a bit faster @@ -1360,9 +1368,12 @@ bindAuxiliaryDicts env@(SE { se_subst = subst, se_interesting = interesting }) = (env', dx_binds, spec_dict_args) where (dx_binds, spec_dict_args) = go call_ds inst_dict_ids - env' = env { se_subst = CoreSubst.extendIdSubstList subst (orig_dict_ids `zip` spec_dict_args) + env' = env { se_subst = subst `CoreSubst.extendIdSubstList` + (orig_dict_ids `zip` spec_dict_args) + `CoreSubst.extendInScopeList` dx_ids , se_interesting = interesting `unionVarSet` interesting_dicts } + dx_ids = [dx_id | (NonRec dx_id _, _) <- dx_binds] interesting_dicts = mkVarSet [ dx_id | (NonRec dx_id dx, _) <- dx_binds , interestingDict env dx ] -- See Note [Make the new dictionaries interesting] @@ -1370,7 +1381,7 @@ bindAuxiliaryDicts env@(SE { se_subst = subst, se_interesting = interesting }) go :: [CoreExpr] -> [CoreBndr] -> ([DictBind], [CoreExpr]) go [] _ = ([], []) go (dx:dxs) (dx_id:dx_ids) - | exprIsTrivial dx = (dx_binds, dx:args) + | exprIsTrivial dx = (dx_binds, dx : args) | otherwise = (mkDB (NonRec dx_id dx) : dx_binds, Var dx_id : args) where (dx_binds, args) = go dxs dx_ids From git at git.haskell.org Sat Feb 27 15:33:57 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 27 Feb 2016 15:33:57 +0000 (UTC) Subject: [commit: ghc] master: Print which flag controls emitted desugaring warnings (b9c697e) Message-ID: <20160227153357.5F6443A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b9c697eefd34fcba3ab9c1f831baf7f651ad7503/ghc >--------------------------------------------------------------- commit b9c697eefd34fcba3ab9c1f831baf7f651ad7503 Author: Herbert Valerio Riedel Date: Sat Feb 27 13:50:10 2016 +0100 Print which flag controls emitted desugaring warnings This is extends bb5afd3c274011c5ea302210b4c290ec1f83209c to cover warnings emitted during the desugaring phase. This implements another part of #10752 Reviewed-by: quchen, bgamari Differential Revision: https://phabricator.haskell.org/D1954 >--------------------------------------------------------------- b9c697eefd34fcba3ab9c1f831baf7f651ad7503 compiler/deSugar/Check.hs | 40 ++++++++++++++-------- compiler/deSugar/Desugar.hs | 8 +++-- compiler/deSugar/DsBinds.hs | 12 +++---- compiler/deSugar/DsExpr.hs | 14 ++++---- compiler/deSugar/DsMonad.hs | 15 ++++---- compiler/deSugar/Match.hs | 2 +- compiler/deSugar/MatchLit.hs | 9 ++--- .../deSugar/should_compile/DsStrictWarn.stderr | 2 +- .../deSugar/should_compile/GadtOverlap.stderr | 2 +- .../tests/deSugar/should_compile/T10662.stderr | 3 +- .../tests/deSugar/should_compile/T2395.stderr | 2 +- .../tests/deSugar/should_compile/T3263-1.stderr | 6 ++-- .../tests/deSugar/should_compile/T3263-2.stderr | 6 ++-- .../tests/deSugar/should_compile/T4488.stderr | 12 +++---- .../tests/deSugar/should_compile/T5117.stderr | 2 +- .../tests/deSugar/should_compile/T5455.stderr | 4 +-- .../tests/deSugar/should_compile/ds002.stderr | 6 ++-- .../tests/deSugar/should_compile/ds003.stderr | 4 +-- .../tests/deSugar/should_compile/ds019.stderr | 6 ++-- .../tests/deSugar/should_compile/ds020.stderr | 10 +++--- .../tests/deSugar/should_compile/ds022.stderr | 4 +-- .../tests/deSugar/should_compile/ds043.stderr | 2 +- .../tests/deSugar/should_compile/ds051.stderr | 6 ++-- .../tests/deSugar/should_compile/ds056.stderr | 2 +- .../tests/deSugar/should_compile/ds058.stderr | 2 +- .../dependent/should_compile/KindEqualities.stderr | 2 +- testsuite/tests/driver/werror.stderr | 4 +-- testsuite/tests/gadt/T7294.stderr | 2 +- testsuite/tests/ghci/scripts/Defer02.stderr | 4 +-- testsuite/tests/ghci/scripts/T3263.stderr | 3 +- .../tests/numeric/should_compile/T10929.stderr | 9 +++-- .../tests/numeric/should_compile/T7881.stderr | 9 +++-- .../tests/numeric/should_compile/T7895.stderr | 4 +-- .../tests/numeric/should_compile/T8542.stderr | 4 +-- .../tests/pmcheck/should_compile/T11245.stderr | 2 +- .../tests/pmcheck/should_compile/T2204.stderr | 5 +-- .../tests/pmcheck/should_compile/T9951b.stderr | 3 +- .../tests/pmcheck/should_compile/pmc001.stderr | 5 +-- .../tests/pmcheck/should_compile/pmc003.stderr | 2 +- .../tests/pmcheck/should_compile/pmc004.stderr | 2 +- .../tests/pmcheck/should_compile/pmc005.stderr | 4 +-- .../tests/pmcheck/should_compile/pmc007.stderr | 7 ++-- .../simplCore/should_compile/T6082-RULE.stderr | 4 +-- .../tests/simplCore/should_compile/T7287.stderr | 2 +- testsuite/tests/th/TH_repUnboxedTuples.stderr | 2 +- .../tests/typecheck/should_compile/T5490.stderr | 4 +-- 46 files changed, 140 insertions(+), 124 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 b9c697eefd34fcba3ab9c1f831baf7f651ad7503 From git at git.haskell.org Sat Feb 27 15:57:02 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 27 Feb 2016 15:57:02 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: cmpTypeX: Avoid kind comparison when possible (6f7baa0) Message-ID: <20160227155702.A54913A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/6f7baa0eb995b6cef8b9ae4ad0845f76a229bd3b/ghc >--------------------------------------------------------------- commit 6f7baa0eb995b6cef8b9ae4ad0845f76a229bd3b Author: Ben Gamari Date: Thu Feb 25 15:44:20 2016 +0100 cmpTypeX: Avoid kind comparison when possible This comparison is only necessary when the types being compared contain casts. Otherwise the structural equality of the types implies that their kinds are equal. Test Plan: Validate Reviewers: goldfire, austin, simonpj Reviewed By: simonpj Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1944 GHC Trac Issues: #11597 (cherry picked from commit 073e20ebda73309173b6b6e3ea10164e8808cc79) >--------------------------------------------------------------- 6f7baa0eb995b6cef8b9ae4ad0845f76a229bd3b compiler/types/Type.hs | 76 ++++++++++++++++++++++++++++++++++++++------------ 1 file changed, 58 insertions(+), 18 deletions(-) diff --git a/compiler/types/Type.hs b/compiler/types/Type.hs index d08afb8..07b20c6 100644 --- a/compiler/types/Type.hs +++ b/compiler/types/Type.hs @@ -2045,40 +2045,79 @@ cmpTypes ts1 ts2 = cmpTypesX rn_env ts1 ts2 where rn_env = mkRnEnv2 (mkInScopeSet (tyCoVarsOfTypes (ts1 ++ ts2))) +-- | An ordering relation between two 'Type's (known below as @t1 :: k1@ +-- and @t2 :: k2@) +data TypeOrdering = TLT -- ^ @t1 < t2@ + | TEQ -- ^ @t1 ~ t2@ and there are no casts in either, + -- therefore we can conclude @k1 ~ k2@ + | TEQX -- ^ @t1 ~ t2@ yet one of the types contains a cast so + -- they may differ in kind. + | TGT -- ^ @t1 > t2@ + deriving (Eq, Ord, Enum, Bounded) + cmpTypeX :: RnEnv2 -> Type -> Type -> Ordering -- Main workhorse -- See Note [Non-trivial definitional equality] in TyCoRep -cmpTypeX env orig_t1 orig_t2 = go env k1 k2 `thenCmp` go env orig_t1 orig_t2 +cmpTypeX env orig_t1 orig_t2 = + case go env orig_t1 orig_t2 of + -- If there are casts then we also need to do a comparison of the kinds of + -- the types being compared + TEQX -> toOrdering $ go env k1 k2 + ty_ordering -> toOrdering ty_ordering where k1 = typeKind orig_t1 k2 = typeKind orig_t2 - go env t1 t2 | Just t1' <- coreViewOneStarKind t1 = go env t1' t2 - go env t1 t2 | Just t2' <- coreViewOneStarKind t2 = go env t1 t2' + toOrdering :: TypeOrdering -> Ordering + toOrdering TLT = LT + toOrdering TEQ = EQ + toOrdering TEQX = EQ + toOrdering TGT = GT + + liftOrdering :: Ordering -> TypeOrdering + liftOrdering LT = TLT + liftOrdering EQ = TEQ + liftOrdering GT = TGT + + thenCmpTy :: TypeOrdering -> TypeOrdering -> TypeOrdering + thenCmpTy TEQ rel = rel + thenCmpTy TEQX rel = hasCast rel + thenCmpTy rel _ = rel + + hasCast :: TypeOrdering -> TypeOrdering + hasCast TEQ = TEQX + hasCast rel = rel + + -- Returns both the resulting ordering relation between the two types + -- and whether either contains a cast. + go :: RnEnv2 -> Type -> Type -> TypeOrdering + go env t1 t2 + | Just t1' <- coreViewOneStarKind t1 = go env t1' t2 + | Just t2' <- coreViewOneStarKind t2 = go env t1 t2' go env (TyVarTy tv1) (TyVarTy tv2) - = rnOccL env tv1 `compare` rnOccR env tv2 + = liftOrdering $ rnOccL env tv1 `compare` rnOccR env tv2 go env (ForAllTy (Named tv1 _) t1) (ForAllTy (Named tv2 _) t2) = go env (tyVarKind tv1) (tyVarKind tv2) - `thenCmp` go (rnBndr2 env tv1 tv2) t1 t2 + `thenCmpTy` go (rnBndr2 env tv1 tv2) t1 t2 -- See Note [Equality on AppTys] go env (AppTy s1 t1) ty2 | Just (s2, t2) <- repSplitAppTy_maybe ty2 - = go env s1 s2 `thenCmp` go env t1 t2 + = go env s1 s2 `thenCmpTy` go env t1 t2 go env ty1 (AppTy s2 t2) | Just (s1, t1) <- repSplitAppTy_maybe ty1 - = go env s1 s2 `thenCmp` go env t1 t2 + = go env s1 s2 `thenCmpTy` go env t1 t2 go env (ForAllTy (Anon s1) t1) (ForAllTy (Anon s2) t2) - = go env s1 s2 `thenCmp` go env t1 t2 + = go env s1 s2 `thenCmpTy` go env t1 t2 go env (TyConApp tc1 tys1) (TyConApp tc2 tys2) - = (tc1 `cmpTc` tc2) `thenCmp` gos env tys1 tys2 - go _ (LitTy l1) (LitTy l2) = compare l1 l2 - go env (CastTy t1 _) t2 = go env t1 t2 - go env t1 (CastTy t2 _) = go env t1 t2 - go _ (CoercionTy {}) (CoercionTy {}) = EQ + = liftOrdering (tc1 `cmpTc` tc2) `thenCmpTy` gos env tys1 tys2 + go _ (LitTy l1) (LitTy l2) = liftOrdering (compare l1 l2) + go env (CastTy t1 _) t2 = hasCast $ go env t1 t2 + go env t1 (CastTy t2 _) = hasCast $ go env t1 t2 + go _ (CoercionTy {}) (CoercionTy {}) = TEQ -- Deal with the rest: TyVarTy < CoercionTy < AppTy < LitTy < TyConApp < ForAllTy go _ ty1 ty2 - = (get_rank ty1) `compare` (get_rank ty2) + = liftOrdering $ (get_rank ty1) `compare` (get_rank ty2) where get_rank :: Type -> Int get_rank (CastTy {}) = pprPanic "cmpTypeX.get_rank" (ppr [ty1,ty2]) @@ -2090,10 +2129,11 @@ cmpTypeX env orig_t1 orig_t2 = go env k1 k2 `thenCmp` go env orig_t1 orig_t2 get_rank (ForAllTy (Anon {}) _) = 6 get_rank (ForAllTy (Named {}) _) = 7 - gos _ [] [] = EQ - gos _ [] _ = LT - gos _ _ [] = GT - gos env (ty1:tys1) (ty2:tys2) = go env ty1 ty2 `thenCmp` gos env tys1 tys2 + gos :: RnEnv2 -> [Type] -> [Type] -> TypeOrdering + gos _ [] [] = TEQ + gos _ [] _ = TLT + gos _ _ [] = TGT + gos env (ty1:tys1) (ty2:tys2) = go env ty1 ty2 `thenCmpTy` gos env tys1 tys2 ------------- cmpTypesX :: RnEnv2 -> [Type] -> [Type] -> Ordering From git at git.haskell.org Sat Feb 27 15:57:05 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 27 Feb 2016 15:57:05 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Docs: -keep-llvm-file(s)/-ddump-llvm imply -fllvm (c980640) Message-ID: <20160227155705.5DD953A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/c980640302e38801bf3642addb7c9f7c6be34cc7/ghc >--------------------------------------------------------------- commit c980640302e38801bf3642addb7c9f7c6be34cc7 Author: Thomas Miedema Date: Mon Feb 22 14:31:40 2016 +0100 Docs: -keep-llvm-file(s)/-ddump-llvm imply -fllvm This fixes #9917. (cherry picked from commit ed119096be6739b67d99acfa4c2d43627960f0e3) >--------------------------------------------------------------- c980640302e38801bf3642addb7c9f7c6be34cc7 docs/users_guide/debugging.rst | 2 ++ docs/users_guide/separate_compilation.rst | 5 +++++ utils/mkUserGuidePart/Options/CompilerDebugging.hs | 3 ++- utils/mkUserGuidePart/Options/KeepingIntermediates.hs | 9 +++++---- 4 files changed, 14 insertions(+), 5 deletions(-) diff --git a/docs/users_guide/debugging.rst b/docs/users_guide/debugging.rst index db36612..f49e84e 100644 --- a/docs/users_guide/debugging.rst +++ b/docs/users_guide/debugging.rst @@ -144,6 +144,8 @@ Dumping out compiler intermediate structures .. ghc-flag:: -ddump-llvm + :implies: :ghc-flag:`-fllvm` + LLVM code from the :ref:`LLVM code generator ` .. ghc-flag:: -ddump-bcos diff --git a/docs/users_guide/separate_compilation.rst b/docs/users_guide/separate_compilation.rst index afdde83..a2ce5eb 100644 --- a/docs/users_guide/separate_compilation.rst +++ b/docs/users_guide/separate_compilation.rst @@ -334,12 +334,16 @@ The following options are useful for keeping certain intermediate files around, when normally GHC would throw these away after compilation: .. ghc-flag:: -keep-hc-file + -keep-hc-files Keep intermediate ``.hc`` files when doing ``.hs``-to-``.o`` compilations via :ref:`C ` (Note: ``.hc`` files are only generated by :ref:`unregisterised ` compilers). .. ghc-flag:: -keep-llvm-file + -keep-llvm-files + + :implies: :ghc-flag:`-fllvm` Keep intermediate ``.ll`` files when doing ``.hs``-to-``.o`` compilations via :ref:`LLVM ` (Note: ``.ll`` files @@ -347,6 +351,7 @@ around, when normally GHC would throw these away after compilation: to use :ghc-flag:`-fllvm` to force them to be produced). .. ghc-flag:: -keep-s-file + -keep-s-files Keep intermediate ``.s`` files. diff --git a/utils/mkUserGuidePart/Options/CompilerDebugging.hs b/utils/mkUserGuidePart/Options/CompilerDebugging.hs index 320587b..ce84a2a 100644 --- a/utils/mkUserGuidePart/Options/CompilerDebugging.hs +++ b/utils/mkUserGuidePart/Options/CompilerDebugging.hs @@ -55,7 +55,8 @@ compilerDebuggingOptions = , flagType = DynamicFlag } , flag { flagName = "-ddump-llvm" - , flagDescription = "Dump LLVM intermediate code" + , flagDescription = "Dump LLVM intermediate code. "++ + "Implies :ghc-flag:`-fllvm`." , flagType = DynamicFlag } , flag { flagName = "-ddump-occur-anal" diff --git a/utils/mkUserGuidePart/Options/KeepingIntermediates.hs b/utils/mkUserGuidePart/Options/KeepingIntermediates.hs index 9c93aed..dd68de4 100644 --- a/utils/mkUserGuidePart/Options/KeepingIntermediates.hs +++ b/utils/mkUserGuidePart/Options/KeepingIntermediates.hs @@ -5,19 +5,20 @@ import Types keepingIntermediatesOptions :: [Flag] keepingIntermediatesOptions = [ flag { flagName = "-keep-hc-file, -keep-hc-files" - , flagDescription = "retain intermediate ``.hc`` files" + , flagDescription = "Retain intermediate ``.hc`` files." , flagType = DynamicFlag } , flag { flagName = "-keep-llvm-file, -keep-llvm-files" - , flagDescription = "retain intermediate LLVM ``.ll`` files" + , flagDescription = "Retain intermediate LLVM ``.ll`` files. "++ + "Implies :ghc-flag:`-fllvm`." , flagType = DynamicFlag } , flag { flagName = "-keep-s-file, -keep-s-files" - , flagDescription = "retain intermediate ``.s`` files" + , flagDescription = "Retain intermediate ``.s`` files." , flagType = DynamicFlag } , flag { flagName = "-keep-tmp-files" - , flagDescription = "retain all intermediate temporary files" + , flagDescription = "Retain all intermediate temporary files." , flagType = DynamicFlag } ] From git at git.haskell.org Sat Feb 27 15:57:08 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 27 Feb 2016 15:57:08 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: (Alternative way to) address #8710 (680557c) Message-ID: <20160227155708.12CC13A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/680557c125021a1f248ef010418b1234d9a2aa4a/ghc >--------------------------------------------------------------- commit 680557c125021a1f248ef010418b1234d9a2aa4a Author: George Karachalias Date: Thu Feb 25 15:50:35 2016 +0100 (Alternative way to) address #8710 Issue a separate warning per redundant (or inaccessible) clause. This way each warning can have more precice location information (the location of the clause under consideration and not the whole match). I thought that this could be too much but actually the number of such warnings is bound by the number of cases matched against (in contrast to the non-exhaustive warnings which may be exponentially more). Test Plan: validate Reviewers: simonpj, austin, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1920 GHC Trac Issues: #8710 (cherry picked from commit 67393977489942ef41f4f7d4a77076c15db18b92) >--------------------------------------------------------------- 680557c125021a1f248ef010418b1234d9a2aa4a compiler/deSugar/Check.hs | 45 +++++++++++++--------- .../tests/deSugar/should_compile/T2395.stderr | 4 +- .../tests/deSugar/should_compile/T5117.stderr | 4 +- .../tests/deSugar/should_compile/ds002.stderr | 16 ++++---- .../tests/deSugar/should_compile/ds003.stderr | 12 +++--- .../tests/deSugar/should_compile/ds019.stderr | 17 +++++--- .../tests/deSugar/should_compile/ds020.stderr | 24 ++++++------ .../tests/deSugar/should_compile/ds022.stderr | 12 +++--- .../tests/deSugar/should_compile/ds043.stderr | 4 +- .../tests/deSugar/should_compile/ds051.stderr | 12 +++--- .../tests/deSugar/should_compile/ds056.stderr | 4 +- .../tests/deSugar/should_compile/ds058.stderr | 4 +- testsuite/tests/driver/werror.stderr | 8 ++-- testsuite/tests/gadt/T7294.stderr | 4 +- testsuite/tests/ghci/scripts/Defer02.stderr | 4 +- .../tests/pmcheck/should_compile/pmc003.stderr | 5 ++- .../tests/pmcheck/should_compile/pmc004.stderr | 5 ++- .../tests/pmcheck/should_compile/pmc005.stderr | 7 ++-- testsuite/tests/th/TH_repUnboxedTuples.stderr | 2 +- .../tests/typecheck/should_compile/T5490.stderr | 8 ++-- 20 files changed, 112 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 680557c125021a1f248ef010418b1234d9a2aa4a From git at git.haskell.org Sat Feb 27 15:57:10 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 27 Feb 2016 15:57:10 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Fix kind generalisation for pattern synonyms (6fd8cf4) Message-ID: <20160227155710.BECCA3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/6fd8cf4c9f597af907b2fbb5721e1c16204f1a28/ghc >--------------------------------------------------------------- commit 6fd8cf4c9f597af907b2fbb5721e1c16204f1a28 Author: Simon Peyton Jones Date: Fri Feb 26 09:20:12 2016 +0000 Fix kind generalisation for pattern synonyms We were failing to zonk, after quantifyTyVars, and that left un-zonked type variables in the final PatSyn. This fixes the patsyn/ problems in Trac #11648, but not the polykinds/ ones. (cherry picked from commit b4dfe04aa77bb2d0ce2c7d82cab5e4425e0b738c) >--------------------------------------------------------------- 6fd8cf4c9f597af907b2fbb5721e1c16204f1a28 compiler/typecheck/TcPatSyn.hs | 35 ++++++++++++++++++++++------------- 1 file changed, 22 insertions(+), 13 deletions(-) diff --git a/compiler/typecheck/TcPatSyn.hs b/compiler/typecheck/TcPatSyn.hs index 41470f2..ad49a62 100644 --- a/compiler/typecheck/TcPatSyn.hs +++ b/compiler/typecheck/TcPatSyn.hs @@ -122,9 +122,17 @@ tcPatSynSig name sig_ty ; return ( (univ_tvs, req, ex_tvs, prov, arg_tys, body_ty) , bound_tvs) } + -- Kind generalisation; c.f. kindGeneralise + ; let free_kvs = tyCoVarsOfTelescope (implicit_tvs ++ univ_tvs ++ ex_tvs) $ + tyCoVarsOfTypes (body_ty : req ++ prov ++ arg_tys) + + ; kvs <- quantifyTyVars emptyVarSet (Pair free_kvs emptyVarSet) + -- These are /signatures/ so we zonk to squeeze out any kind - -- unification variables. + -- unification variables. Do this after quantifyTyVars which may + -- default kind variables to *. -- ToDo: checkValidType? + ; traceTc "about zonk" empty ; implicit_tvs <- mapM zonkTcTyCoVarBndr implicit_tvs ; univ_tvs <- mapM zonkTcTyCoVarBndr univ_tvs ; ex_tvs <- mapM zonkTcTyCoVarBndr ex_tvs @@ -133,12 +141,6 @@ tcPatSynSig name sig_ty ; arg_tys <- zonkTcTypes arg_tys ; body_ty <- zonkTcType body_ty - -- Kind generalisation; c.f. kindGeneralise - ; let free_kvs = tyCoVarsOfTelescope (implicit_tvs ++ univ_tvs ++ ex_tvs) $ - tyCoVarsOfTypes (body_ty : req ++ prov ++ arg_tys) - - ; kvs <- quantifyTyVars emptyVarSet (Pair free_kvs emptyVarSet) - -- Complain about: pattern P :: () => forall x. x -> P x -- The renamer thought it was fine, but the existential 'x' -- should not appear in the result type @@ -154,13 +156,13 @@ tcPatSynSig name sig_ty (extra_univ, extra_ex) = partition (`elemVarSet` univ_fvs) $ kvs ++ implicit_tvs ; traceTc "tcTySig }" $ - vcat [ text "implicit_tvs" <+> ppr implicit_tvs - , text "kvs" <+> ppr kvs - , text "extra_univ" <+> ppr extra_univ - , text "univ_tvs" <+> ppr univ_tvs + vcat [ text "implicit_tvs" <+> ppr_tvs implicit_tvs + , text "kvs" <+> ppr_tvs kvs + , text "extra_univ" <+> ppr_tvs extra_univ + , text "univ_tvs" <+> ppr_tvs univ_tvs , text "req" <+> ppr req - , text "extra_ex" <+> ppr extra_ex - , text "ex_tvs" <+> ppr ex_tvs + , text "extra_ex" <+> ppr_tvs extra_ex + , text "ex_tvs" <+> ppr_tvs ex_tvs , text "prov" <+> ppr prov , text "arg_tys" <+> ppr arg_tys , text "body_ty" <+> ppr body_ty ] @@ -171,6 +173,11 @@ tcPatSynSig name sig_ty , patsig_prov = prov , patsig_arg_tys = arg_tys , patsig_body_ty = body_ty }) } + where + +ppr_tvs :: [TyVar] -> SDoc +ppr_tvs tvs = braces (vcat [ ppr tv <+> dcolon <+> ppr (tyVarKind tv) + | tv <- tvs]) {- @@ -254,6 +261,8 @@ tcCheckPatSynDecl PSB{ psb_id = lname@(L _ name), psb_args = details else newMetaSigTyVars ex_tvs -- See the "Existential type variables" part of -- Note [Checking against a pattern signature] + ; traceTc "tcpatsyn1" (vcat [ ppr v <+> dcolon <+> ppr (tyVarKind v) | v <- ex_tvs]) + ; traceTc "tcpatsyn2" (vcat [ ppr v <+> dcolon <+> ppr (tyVarKind v) | v <- ex_tvs']) ; prov_dicts <- mapM (emitWanted origin) (substTheta (extendTCvInScopeList subst univ_tvs) prov_theta) -- Add the free vars of 'prov_theta' to the in_scope set to From git at git.haskell.org Sat Feb 27 17:08:09 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 27 Feb 2016 17:08:09 +0000 (UTC) Subject: [commit: ghc] master: Print which flag controls emitted lexer warnings (869d9c6) Message-ID: <20160227170809.33F5C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/869d9c62d8329022f9f5504a92d2d74efec4f2e8/ghc >--------------------------------------------------------------- commit 869d9c62d8329022f9f5504a92d2d74efec4f2e8 Author: Herbert Valerio Riedel Date: Sat Feb 27 17:34:14 2016 +0100 Print which flag controls emitted lexer warnings This is extends bb5afd3c274011c5ea302210b4c290ec1f83209c to cover warnings emitted during lexing. This implements another part of #10752 >--------------------------------------------------------------- 869d9c62d8329022f9f5504a92d2d74efec4f2e8 compiler/parser/Lexer.x | 6 ++++-- testsuite/tests/driver/recomp005/recomp005.stderr | 4 ++-- testsuite/tests/driver/werror.stderr | 2 +- testsuite/tests/ghci/should_run/T7253.stderr | 11 ++++++----- testsuite/tests/layout/layout001.stdout | 4 ++-- testsuite/tests/layout/layout003.stdout | 4 ++-- testsuite/tests/layout/layout006.stdout | 4 ++-- testsuite/tests/parser/should_compile/T9723a.stderr | 2 +- testsuite/tests/parser/should_compile/T9723b.stderr | 2 +- testsuite/tests/parser/should_compile/read043.stderr | 2 +- testsuite/tests/parser/should_compile/read064.stderr | 3 ++- testsuite/tests/parser/should_compile/read066.stderr | 3 ++- testsuite/tests/warnings/should_compile/T9230.stderr | 2 +- 13 files changed, 27 insertions(+), 22 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 869d9c62d8329022f9f5504a92d2d74efec4f2e8 From git at git.haskell.org Sat Feb 27 17:26:28 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 27 Feb 2016 17:26:28 +0000 (UTC) Subject: [commit: ghc] master: Annotate `[-Wredundant-constraints]` in warnings (re #10752) (82f200b) Message-ID: <20160227172628.81C313A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/82f200b74ac1ea8c5593e2909c0033eb251eeaf2/ghc >--------------------------------------------------------------- commit 82f200b74ac1ea8c5593e2909c0033eb251eeaf2 Author: Herbert Valerio Riedel Date: Sat Feb 27 18:26:32 2016 +0100 Annotate `[-Wredundant-constraints]` in warnings (re #10752) This was missed in bb5afd3c274011c5ea302210b4c290ec1f83209c >--------------------------------------------------------------- 82f200b74ac1ea8c5593e2909c0033eb251eeaf2 compiler/typecheck/TcErrors.hs | 4 ++-- testsuite/tests/typecheck/should_compile/T10632.stderr | 2 +- testsuite/tests/typecheck/should_compile/T9939.stderr | 8 ++++---- testsuite/tests/warnings/should_compile/PluralS.stderr | 4 ++-- 4 files changed, 9 insertions(+), 9 deletions(-) diff --git a/compiler/typecheck/TcErrors.hs b/compiler/typecheck/TcErrors.hs index a17e80a..c78f073 100644 --- a/compiler/typecheck/TcErrors.hs +++ b/compiler/typecheck/TcErrors.hs @@ -343,13 +343,13 @@ warnRedundantConstraints ctxt env info ev_vars addErrCtxt (text "In" <+> ppr info) $ do { env <- getLclEnv ; msg <- mkErrorReport ctxt env (important doc) - ; reportWarning NoReason msg } + ; reportWarning (Reason Opt_WarnRedundantConstraints) msg } | otherwise -- But for InstSkol there already *is* a surrounding -- "In the instance declaration for Eq [a]" context -- and we don't want to say it twice. Seems a bit ad-hoc = do { msg <- mkErrorReport ctxt env (important doc) - ; reportWarning NoReason msg } + ; reportWarning (Reason Opt_WarnRedundantConstraints) msg } where doc = text "Redundant constraint" <> plural redundant_evs <> colon <+> pprEvVarTheta redundant_evs diff --git a/testsuite/tests/typecheck/should_compile/T10632.stderr b/testsuite/tests/typecheck/should_compile/T10632.stderr index 8e72f42..211972d 100644 --- a/testsuite/tests/typecheck/should_compile/T10632.stderr +++ b/testsuite/tests/typecheck/should_compile/T10632.stderr @@ -1,5 +1,5 @@ -T10632.hs:3:1: warning: +T10632.hs:3:1: warning: [-Wredundant-constraints] ? Redundant constraint: ?file1::String ? In the type signature for: f :: (?file1::String) => IO () diff --git a/testsuite/tests/typecheck/should_compile/T9939.stderr b/testsuite/tests/typecheck/should_compile/T9939.stderr index 106335e..a10066b 100644 --- a/testsuite/tests/typecheck/should_compile/T9939.stderr +++ b/testsuite/tests/typecheck/should_compile/T9939.stderr @@ -1,20 +1,20 @@ -T9939.hs:5:1: warning: +T9939.hs:5:1: warning: [-Wredundant-constraints] ? Redundant constraint: Eq a ? In the type signature for: f1 :: (Eq a, Ord a) => a -> a -> Bool -T9939.hs:9:1: warning: +T9939.hs:9:1: warning: [-Wredundant-constraints] ? Redundant constraint: Eq a ? In the type signature for: f2 :: (Eq a, Ord a) => a -> a -> Bool -T9939.hs:13:1: warning: +T9939.hs:13:1: warning: [-Wredundant-constraints] ? Redundant constraint: Eq b ? In the type signature for: f3 :: (Eq a, a ~ b, Eq b) => a -> b -> Bool -T9939.hs:20:1: warning: +T9939.hs:20:1: warning: [-Wredundant-constraints] ? Redundant constraint: Eq a ? In the type signature for: f4 :: (Eq a, Eq b) => a -> b -> Equal a b -> Bool diff --git a/testsuite/tests/warnings/should_compile/PluralS.stderr b/testsuite/tests/warnings/should_compile/PluralS.stderr index a06ab5e..9289a0b 100644 --- a/testsuite/tests/warnings/should_compile/PluralS.stderr +++ b/testsuite/tests/warnings/should_compile/PluralS.stderr @@ -15,12 +15,12 @@ PluralS.hs:17:29: warning: [-Wtype-defaults (in -Wall)] In an equation for ?defaultingNumAndShow?: defaultingNumAndShow = show 123 -PluralS.hs:23:1: warning: +PluralS.hs:23:1: warning: [-Wredundant-constraints] ? Redundant constraint: Num a ? In the type signature for: redundantNum :: (Num a, Num a) => a -PluralS.hs:26:1: warning: +PluralS.hs:26:1: warning: [-Wredundant-constraints] ? Redundant constraints: (Show a, Num a, Eq a, Eq a) ? In the type signature for: redundantMultiple :: (Num a, Show a, Num a, Eq a, Eq a) => a From git at git.haskell.org Sat Feb 27 17:47:17 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 27 Feb 2016 17:47:17 +0000 (UTC) Subject: [commit: ghc] master: Print which flag controls emitted SafeHaskell warnings (b6c61e3) Message-ID: <20160227174717.869893A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b6c61e372a1a783b32f1bbd1ceb446e89478a138/ghc >--------------------------------------------------------------- commit b6c61e372a1a783b32f1bbd1ceb446e89478a138 Author: Herbert Valerio Riedel Date: Sat Feb 27 18:48:04 2016 +0100 Print which flag controls emitted SafeHaskell warnings This is extends bb5afd3c274011c5ea302210b4c290ec1f83209c to cover SafeHaskell warnings. This implements yet another part of #10752 >--------------------------------------------------------------- b6c61e372a1a783b32f1bbd1ceb446e89478a138 compiler/main/HscMain.hs | 14 ++++++++----- .../tests/safeHaskell/flags/SafeFlags22.stderr | 4 ++-- .../tests/safeHaskell/flags/SafeFlags23.stderr | 6 +++--- .../tests/safeHaskell/flags/SafeFlags25.stderr | 2 +- .../tests/safeHaskell/flags/SafeFlags26.stderr | 4 ++-- .../safeHaskell/overlapping/SH_Overlap11.stderr | 23 +++++++++++----------- .../safeHaskell/overlapping/SH_Overlap7.stderr | 23 +++++++++++----------- .../safeHaskell/safeInfered/SafeInfered05.stderr | 2 +- .../safeHaskell/safeInfered/SafeWarn01.stderr | 2 +- .../safeInfered/TrustworthySafe02.stderr | 2 +- .../safeInfered/TrustworthySafe03.stderr | 2 +- .../safeHaskell/safeInfered/UnsafeInfered11.stderr | 6 +++--- .../safeHaskell/safeInfered/UnsafeInfered12.stderr | 4 ++-- .../safeHaskell/safeInfered/UnsafeWarn01.stderr | 4 ++-- .../safeHaskell/safeInfered/UnsafeWarn02.stderr | 2 +- .../safeHaskell/safeInfered/UnsafeWarn03.stderr | 4 ++-- .../safeHaskell/safeInfered/UnsafeWarn04.stderr | 4 ++-- .../safeHaskell/safeInfered/UnsafeWarn05.stderr | 8 ++++---- .../safeHaskell/safeInfered/UnsafeWarn06.stderr | 4 ++-- .../safeHaskell/safeInfered/UnsafeWarn07.stderr | 4 ++-- 20 files changed, 65 insertions(+), 59 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 b6c61e372a1a783b32f1bbd1ceb446e89478a138 From git at git.haskell.org Sat Feb 27 19:45:48 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 27 Feb 2016 19:45:48 +0000 (UTC) Subject: [commit: ghc] master: Annotate `[-Wdeferred-type-errors]` in warnings (re #10752) (3cd4c9c) Message-ID: <20160227194548.EDBD43A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3cd4c9ca4564982cf159f11f59d434235ba28808/ghc >--------------------------------------------------------------- commit 3cd4c9ca4564982cf159f11f59d434235ba28808 Author: Herbert Valerio Riedel Date: Sat Feb 27 19:45:11 2016 +0100 Annotate `[-Wdeferred-type-errors]` in warnings (re #10752) This was missed in bb5afd3c274011c5ea302210b4c290ec1f83209c >--------------------------------------------------------------- 3cd4c9ca4564982cf159f11f59d434235ba28808 compiler/typecheck/TcErrors.hs | 2 +- testsuite/tests/gadt/T7294.stderr | 2 +- testsuite/tests/ghci/scripts/Defer02.stderr | 26 +++++++++++----------- testsuite/tests/ghci/scripts/T8353.stderr | 6 ++--- .../partial-sigs/should_compile/T10403.stderr | 6 ++--- testsuite/tests/th/T7276a.stdout | 2 +- .../tests/typecheck/should_compile/T11254.stderr | 4 ++-- .../tests/typecheck/should_compile/T9834.stderr | 4 ++-- .../tests/typecheck/should_compile/holes2.stderr | 2 +- 9 files changed, 27 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 3cd4c9ca4564982cf159f11f59d434235ba28808 From git at git.haskell.org Sat Feb 27 21:55:07 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 27 Feb 2016 21:55:07 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Reconstruct record expression in bidir pattern synonym (66029cc) Message-ID: <20160227215507.0BCA43A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/66029ccb2f98c2e7c1687b1eeb4e03750cbc263e/ghc >--------------------------------------------------------------- commit 66029ccb2f98c2e7c1687b1eeb4e03750cbc263e Author: Matthew Pickering Date: Thu Feb 25 14:52:39 2016 +0100 Reconstruct record expression in bidir pattern synonym Reviewers: austin, rdragon, bgamari Reviewed By: bgamari Subscribers: rdragon, thomie Differential Revision: https://phabricator.haskell.org/D1949 (cherry picked from commit 52879d1f5d804bf1a32d11d9cefc36d7b6fea382) >--------------------------------------------------------------- 66029ccb2f98c2e7c1687b1eeb4e03750cbc263e compiler/hsSyn/HsPat.hs | 9 ++++++--- compiler/typecheck/TcPatSyn.hs | 25 ++++++++++++++++++++----- testsuite/tests/patsyn/should_compile/T11633.hs | 12 ++++++++++++ testsuite/tests/patsyn/should_compile/all.T | 1 + 4 files changed, 39 insertions(+), 8 deletions(-) diff --git a/compiler/hsSyn/HsPat.hs b/compiler/hsSyn/HsPat.hs index 5b7f6d4..36c4faf 100644 --- a/compiler/hsSyn/HsPat.hs +++ b/compiler/hsSyn/HsPat.hs @@ -6,7 +6,9 @@ -} {-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE DeriveFoldable #-} +{-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE UndecidableInstances #-} -- Note [Pass sensitive types] @@ -244,9 +246,10 @@ data HsRecFields id arg -- A bunch of record fields -- Used for both expressions and patterns = HsRecFields { rec_flds :: [LHsRecField id arg], rec_dotdot :: Maybe Int } -- Note [DotDot fields] - deriving (Typeable) + deriving (Typeable, Functor, Foldable, Traversable) deriving instance (DataId id, Data arg) => Data (HsRecFields id arg) + -- Note [DotDot fields] -- ~~~~~~~~~~~~~~~~~~~~ -- The rec_dotdot field means this: @@ -275,7 +278,7 @@ data HsRecField' id arg = HsRecField { hsRecFieldLbl :: Located id, hsRecFieldArg :: arg, -- ^ Filled in by renamer when punning hsRecPun :: Bool -- ^ Note [Punning] - } deriving (Data, Typeable) + } deriving (Data, Typeable, Functor, Foldable, Traversable) -- Note [Punning] diff --git a/compiler/typecheck/TcPatSyn.hs b/compiler/typecheck/TcPatSyn.hs index ad49a62..425e203 100644 --- a/compiler/typecheck/TcPatSyn.hs +++ b/compiler/typecheck/TcPatSyn.hs @@ -825,15 +825,30 @@ tcPatToExpr args = go lhsVars = mkNameSet (map unLoc args) go :: LPat Name -> Maybe (LHsExpr Name) - go (L loc (ConPatIn (L _ con) info)) - = do { exprs <- mapM go (hsConPatArgs info) - ; return $ L loc $ - foldl (\x y -> HsApp (L loc x) y) (HsVar (L loc con)) exprs } + go (L loc (ConPatIn con info)) + = case info of + PrefixCon ps -> mkPrefixConExpr con ps + InfixCon l r -> mkPrefixConExpr con [l,r] + RecCon fields -> L loc <$> mkRecordConExpr con fields go (L _ (SigPatIn pat _)) = go pat -- See Note [Type signatures and the builder expression] - go (L loc p) = fmap (L loc) $ go1 p + go (L loc p) = L loc <$> go1 p + + -- Make a prefix con for prefix and infix patterns for simplicity + mkPrefixConExpr :: Located Name -> [LPat Name] -> Maybe (LHsExpr Name) + mkPrefixConExpr con pats = do + exprs <- traverse go pats + return $ foldl (\x y -> L (combineLocs x y) (HsApp x y)) + (L (getLoc con) (HsVar con)) + exprs + + + mkRecordConExpr :: Located Name -> HsRecFields Name (LPat Name) -> Maybe (HsExpr Name) + mkRecordConExpr con fields = do + exprFields <- traverse go fields + return $ RecordCon con PlaceHolder noPostTcExpr exprFields go1 :: Pat Name -> Maybe (HsExpr Name) go1 (VarPat (L l var)) diff --git a/testsuite/tests/patsyn/should_compile/T11633.hs b/testsuite/tests/patsyn/should_compile/T11633.hs new file mode 100644 index 0000000..45caec8 --- /dev/null +++ b/testsuite/tests/patsyn/should_compile/T11633.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE PatternSynonyms #-} + +module T11633 where + +data ARecord = ARecord {anInt :: Int, aString :: String} + +-- This works... +pattern AGoodPat :: Int -> String -> ARecord +pattern AGoodPat n s = ARecord {anInt=n, aString=s} + +pattern ABadPat :: Int -> String -> ARecord +pattern ABadPat n s = ARecord {aString=s, anInt=n} diff --git a/testsuite/tests/patsyn/should_compile/all.T b/testsuite/tests/patsyn/should_compile/all.T index b089e2f..be7b380 100644 --- a/testsuite/tests/patsyn/should_compile/all.T +++ b/testsuite/tests/patsyn/should_compile/all.T @@ -49,3 +49,4 @@ test('MoreEx', normal, compile, ['']) test('T11283', normal, compile, ['']) test('T11367', normal, compile, ['']) test('T11351', normal, compile, ['']) +test('T11633', normal, compile, ['']) From git at git.haskell.org Sat Feb 27 21:55:12 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 27 Feb 2016 21:55:12 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Note new GHC.Generics instances in release notes (4e7a46f) Message-ID: <20160227215512.6E4EA3A301@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/4e7a46fd1356f3b344e4e11311b146c715f76a5a/ghc >--------------------------------------------------------------- commit 4e7a46fd1356f3b344e4e11311b146c715f76a5a Author: Ben Gamari Date: Thu Feb 25 19:26:46 2016 +0100 Note new GHC.Generics instances in release notes (cherry picked from commit 20ab2adf7938bf1c6afed38509b4b01102bceff9) >--------------------------------------------------------------- 4e7a46fd1356f3b344e4e11311b146c715f76a5a docs/users_guide/8.0.1-notes.rst | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/docs/users_guide/8.0.1-notes.rst b/docs/users_guide/8.0.1-notes.rst index 6aacada..c240f29 100644 --- a/docs/users_guide/8.0.1-notes.rst +++ b/docs/users_guide/8.0.1-notes.rst @@ -522,6 +522,11 @@ See ``changelog.md`` in the ``base`` package for full release notes. to define custom compile-time error messages. (see :ref:`custom-errors` and the original :ghc-wiki:`proposal `). +- The datatypes in ``GHC.Generics`` now have ``Enum``, ``Bounded``, ``Ix``, + ``Functor``, ``Applicative``, ``Monad``, ``MonadFix``, ``MonadPlus``, ``MonadZip``, + ``Foldable``, ``Foldable``, ``Traversable``, ``Generic1``, and ``Data`` instances + as appropriate. (:ghc-ticket:`9043`) + - The ``Generic`` instance for ``Proxy`` is now poly-kinded (see :ghc-ticket:`10775`) - The ``IsString`` instance for ``[Char]`` has been modified to eliminate From git at git.haskell.org Sat Feb 27 21:55:09 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 27 Feb 2016 21:55:09 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Add more type class instances for GHC.Generics (1fcddf8) Message-ID: <20160227215509.BC0983A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/1fcddf82d17feed714854fb351412736d61278d4/ghc >--------------------------------------------------------------- commit 1fcddf82d17feed714854fb351412736d61278d4 Author: RyanGlScott Date: Thu Feb 25 14:49:48 2016 +0100 Add more type class instances for GHC.Generics GHC.Generics provides several representation data types that have obvious instances of various type classes in base, along with various other types of meta-data (such as associativity and fixity). Specifically, instances have been added for the following type classes (where possible): - Applicative - Data - Functor - Monad - MonadFix - MonadPlus - MonadZip - Foldable - Traversable - Enum - Bounded - Ix - Generic1 Thanks to ocharles for starting this! Test Plan: Validate Reviewers: ekmett, austin, hvr, bgamari Reviewed By: bgamari Subscribers: RyanGlScott, thomie Differential Revision: https://phabricator.haskell.org/D1937 GHC Trac Issues: #9043 (cherry picked from commit 673efccb3b348e9daf23d9e65460691bbea8586e) >--------------------------------------------------------------- 1fcddf82d17feed714854fb351412736d61278d4 libraries/base/Control/Monad/Fix.hs | 18 ++ libraries/base/Control/Monad/Zip.hs | 15 + libraries/base/Data/Bifunctor.hs | 4 + libraries/base/Data/Data.hs | 309 ++++++++++++++++++++- libraries/base/Data/Foldable.hs | 24 +- libraries/base/Data/Traversable.hs | 24 +- libraries/base/GHC/Generics.hs | 124 +++++++-- libraries/base/changelog.md | 5 + .../tests/annotations/should_fail/annfail10.stderr | 2 +- .../tests/ghci.debugger/scripts/break006.stderr | 4 +- .../tests/typecheck/should_fail/T10971b.stderr | 8 +- testsuite/tests/typecheck/should_fail/T5095.stderr | 2 +- 12 files changed, 505 insertions(+), 34 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 1fcddf82d17feed714854fb351412736d61278d4 From git at git.haskell.org Sat Feb 27 21:55:15 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 27 Feb 2016 21:55:15 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Remove superfluous code when deriving Foldable/Traversable (9d7f890) Message-ID: <20160227215515.B18CC3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/9d7f890ca2408ca7671e6a6d06dff95341d869f0/ghc >--------------------------------------------------------------- commit 9d7f890ca2408ca7671e6a6d06dff95341d869f0 Author: RyanGlScott Date: Wed Feb 17 12:06:17 2016 +0100 Remove superfluous code when deriving Foldable/Traversable Currently, `-XDeriveFoldable` and `-XDeriveTraversable` generate unnecessary `mempty` and `pure` expressions when it traverses of an argument of a constructor whose type does not mention the last type parameter. Not only is this inefficient, but it prevents `Traversable` from being derivable for datatypes with unlifted arguments (see Trac #11174). The solution to this problem is to adopt a slight change to the algorithms for `-XDeriveFoldable` and `-XDeriveTraversable`, which is described in [this wiki page](https://ghc.haskell.org/trac/ghc/wiki/Commentary/Compiler/DeriveFu nctor#Proposal:alternativestrategyforderivingFoldableandTraversable). The wiki page also describes why we don't apply the same changes to the algorithm for `-XDeriveFunctor`. This is techincally a breaking change for users of `-XDeriveFoldable` and `-XDeriveTraversable`, since if someone was using a law-breaking `Monoid` instance with a derived `Foldable` instance (i.e., one where `x <> mempty` does not equal `x`) or a law-breaking `Applicative` instance with a derived `Traversable` instance, then the new generated code could result in different behavior. I suspect the number of scenarios like this is very small, and the onus really should be on those users to fix up their `Monoid`/`Applicative` instances. Fixes #11174. Test Plan: ./validate Reviewers: hvr, simonpj, austin, bgamari Reviewed By: simonpj, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1908 GHC Trac Issues: #11174 (cherry picked from commit a82956df5b34175410e0feb9e2febe7d39b60b49) >--------------------------------------------------------------- 9d7f890ca2408ca7671e6a6d06dff95341d869f0 compiler/typecheck/TcGenDeriv.hs | 478 ++++++++++++++++++---- compiler/utils/Util.hs | 19 +- docs/users_guide/8.0.1-notes.rst | 5 +- docs/users_guide/glasgow_exts.rst | 24 +- testsuite/tests/deriving/should_compile/T11174.hs | 14 + testsuite/tests/deriving/should_compile/all.T | 1 + 6 files changed, 445 insertions(+), 96 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 9d7f890ca2408ca7671e6a6d06dff95341d869f0 From git at git.haskell.org Sat Feb 27 21:55:18 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 27 Feb 2016 21:55:18 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: GHC.Generics: Ensure some, many for U1 don't bottom (b89747e) Message-ID: <20160227215518.7EDDF3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/b89747e33de0e27a8ed45e9e6b4dedbaa40c4ce3/ghc >--------------------------------------------------------------- commit b89747e33de0e27a8ed45e9e6b4dedbaa40c4ce3 Author: Ben Gamari Date: Fri Feb 26 23:02:31 2016 +0100 GHC.Generics: Ensure some, many for U1 don't bottom Reviewers: austin, hvr, ekmett, RyanGlScott Reviewed By: RyanGlScott Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1952 GHC Trac Issues: #11650 (cherry picked from commit 890e2bb72b9953ca3e6990911b4cf6e51a0dd0f8) >--------------------------------------------------------------- b89747e33de0e27a8ed45e9e6b4dedbaa40c4ce3 libraries/base/GHC/Generics.hs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/libraries/base/GHC/Generics.hs b/libraries/base/GHC/Generics.hs index 026584a..c6c8f63 100644 --- a/libraries/base/GHC/Generics.hs +++ b/libraries/base/GHC/Generics.hs @@ -745,6 +745,9 @@ instance Applicative U1 where instance Alternative U1 where empty = U1 U1 <|> U1 = U1 + -- The defaults will otherwise bottom; see #11650. + some U1 = U1 + many U1 = U1 instance Monad U1 where U1 >>= _ = U1 From git at git.haskell.org Sat Feb 27 23:17:35 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 27 Feb 2016 23:17:35 +0000 (UTC) Subject: [commit: ghc] master: Default to -fno-show-warning-groups (re #10752) (46f3775) Message-ID: <20160227231735.574E73A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/46f3775c683faeb710c9dc22f360f39334947d73/ghc >--------------------------------------------------------------- commit 46f3775c683faeb710c9dc22f360f39334947d73 Author: Herbert Valerio Riedel Date: Sat Feb 27 23:36:11 2016 +0100 Default to -fno-show-warning-groups (re #10752) As `-fno-show-warning-groups` shows associated warning groups regardless of whether the respective warning group flag as been passed on the CLI, the warning-group information may be confusing to users. At this point, `-fshow-warning-groups` is useful mostly to GHC developers and possibly GHC users who want to see which warning groups an emitted warning is part of. (Btw, this is particularly interesting in combination with `-Weverything` which enables *every* warning flag known to GHC.) Consequently, starting with this commit, one has to opt-in via `-fshow-warning-groups` for GHC to show warning groups. In order to reduce the testsuite delta in this commit, the `-fshow-warning-groups` flag has been added to TEST_HC_OPTS. >--------------------------------------------------------------- 46f3775c683faeb710c9dc22f360f39334947d73 compiler/main/DynFlags.hs | 3 +-- docs/users_guide/using-warnings.rst | 7 ++++--- testsuite/mk/test.mk | 2 +- testsuite/tests/ghc-api/apirecomp001/apirecomp001.stderr | 12 ++++++------ testsuite/tests/ghci/scripts/T9293.stdout | 4 ++++ testsuite/tests/ghci/scripts/ghci024.stdout | 1 + testsuite/tests/ghci/scripts/ghci057.stdout | 4 ++++ 7 files changed, 21 insertions(+), 12 deletions(-) diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index ebfd861..8f9fbbb 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -3617,8 +3617,7 @@ defaultFlags settings Opt_ProfCountEntries, Opt_RPath, Opt_SharedImplib, - Opt_SimplPreInlining, - Opt_ShowWarnGroups + Opt_SimplPreInlining ] ++ [f | (ns,f) <- optLevelFlags, 0 `elem` ns] diff --git a/docs/users_guide/using-warnings.rst b/docs/users_guide/using-warnings.rst index 3f24f6a..ffe5a41 100644 --- a/docs/users_guide/using-warnings.rst +++ b/docs/users_guide/using-warnings.rst @@ -103,13 +103,14 @@ The following flags are simple ways to select standard "packages" of warnings: default, but can be useful to negate a :ghc-flag:`-Werror` flag. When a warning is emitted, the specific warning flag which controls -it, as well as the group it belongs to, are shown. +it is shown. .. ghc-flag:: -fshow-warning-groups - Name the group a warning flag belongs to. + When showing which flag controls a warning, also show the + respective warning group flag(s) that warning is contained in. - This is enabled by default. Disable with ``-fno-show-warning-groups``. + This option is off by default. The full set of warning options is described below. To turn off any warning, simply give the corresponding ``-Wno-...`` option on the diff --git a/testsuite/mk/test.mk b/testsuite/mk/test.mk index aa20a42..97ceb39 100644 --- a/testsuite/mk/test.mk +++ b/testsuite/mk/test.mk @@ -34,7 +34,7 @@ endif # TEST_HC_OPTS is passed to every invocation of TEST_HC # in nested Makefiles -TEST_HC_OPTS = -fforce-recomp -dcore-lint -dcmm-lint -dno-debug-output -no-user-$(GhcPackageDbFlag) -rtsopts $(EXTRA_HC_OPTS) +TEST_HC_OPTS = -fforce-recomp -dcore-lint -dcmm-lint -dno-debug-output -fshow-warning-groups -no-user-$(GhcPackageDbFlag) -rtsopts $(EXTRA_HC_OPTS) # The warning suppression flag below is a temporary kludge. While working with # tests that contain tabs, please de-tab them so this flag can be eventually diff --git a/testsuite/tests/ghc-api/apirecomp001/apirecomp001.stderr b/testsuite/tests/ghc-api/apirecomp001/apirecomp001.stderr index a943e48..80b94dc 100644 --- a/testsuite/tests/ghc-api/apirecomp001/apirecomp001.stderr +++ b/testsuite/tests/ghc-api/apirecomp001/apirecomp001.stderr @@ -1,9 +1,9 @@ -B.hs:4:1: warning: [-Wmissing-signatures (in -Wall)] +B.hs:4:1: warning: [-Wmissing-signatures] Top-level binding with no type signature: answer_to_live_the_universe_and_everything :: Int -B.hs:5:12: warning: [-Wtype-defaults (in -Wall)] +B.hs:5:12: warning: [-Wtype-defaults] ? Defaulting the following constraints to type ?Integer? (Enum a0) arising from the arithmetic sequence ?1 .. 23 * 2? at B.hs:5:12-20 @@ -12,14 +12,14 @@ B.hs:5:12: warning: [-Wtype-defaults (in -Wall)] In the first argument of ?(-)?, namely ?length [1 .. 23 * 2]? In the expression: length [1 .. 23 * 2] - 4 -A.hs:7:1: warning: [-Wmissing-signatures (in -Wall)] +A.hs:7:1: warning: [-Wmissing-signatures] Top-level binding with no type signature: main :: IO () -B.hs:4:1: warning: [-Wmissing-signatures (in -Wall)] +B.hs:4:1: warning: [-Wmissing-signatures] Top-level binding with no type signature: answer_to_live_the_universe_and_everything :: Int -B.hs:5:12: warning: [-Wtype-defaults (in -Wall)] +B.hs:5:12: warning: [-Wtype-defaults] ? Defaulting the following constraints to type ?Integer? (Enum a0) arising from the arithmetic sequence ?1 .. 23 * 2? at B.hs:5:12-20 @@ -28,5 +28,5 @@ B.hs:5:12: warning: [-Wtype-defaults (in -Wall)] In the first argument of ?(-)?, namely ?length [1 .. 23 * 2]? In the expression: length [1 .. 23 * 2] - 4 -A.hs:7:1: warning: [-Wmissing-signatures (in -Wall)] +A.hs:7:1: warning: [-Wmissing-signatures] Top-level binding with no type signature: main :: IO () diff --git a/testsuite/tests/ghci/scripts/T9293.stdout b/testsuite/tests/ghci/scripts/T9293.stdout index 67fc630..02ee22c 100644 --- a/testsuite/tests/ghci/scripts/T9293.stdout +++ b/testsuite/tests/ghci/scripts/T9293.stdout @@ -7,6 +7,7 @@ GHCi-specific dynamic flag settings: other dynamic, non-language, flag settings: -fno-ghci-history -fimplicit-import-qualified + -fshow-warning-groups warning settings: Should fail, GADTs is not enabled options currently set: none. @@ -21,6 +22,7 @@ GHCi-specific dynamic flag settings: other dynamic, non-language, flag settings: -fno-ghci-history -fimplicit-import-qualified + -fshow-warning-groups warning settings: Should work, GADTs is in force from :set options currently set: none. @@ -34,6 +36,7 @@ GHCi-specific dynamic flag settings: other dynamic, non-language, flag settings: -fno-ghci-history -fimplicit-import-qualified + -fshow-warning-groups warning settings: Should fail, GADTs is now disabled base language is: Haskell2010 @@ -49,6 +52,7 @@ GHCi-specific dynamic flag settings: other dynamic, non-language, flag settings: -fno-ghci-history -fimplicit-import-qualified + -fshow-warning-groups warning settings: Should fail, GADTs is only enabled at the prompt C :: T Int diff --git a/testsuite/tests/ghci/scripts/ghci024.stdout b/testsuite/tests/ghci/scripts/ghci024.stdout index 9fea946..b92adad 100644 --- a/testsuite/tests/ghci/scripts/ghci024.stdout +++ b/testsuite/tests/ghci/scripts/ghci024.stdout @@ -8,6 +8,7 @@ GHCi-specific dynamic flag settings: other dynamic, non-language, flag settings: -fforce-recomp -fimplicit-import-qualified + -fshow-warning-groups warning settings: -Wno-tabs ~~~~~~~~~~ Testing :set -a diff --git a/testsuite/tests/ghci/scripts/ghci057.stdout b/testsuite/tests/ghci/scripts/ghci057.stdout index 67fc630..02ee22c 100644 --- a/testsuite/tests/ghci/scripts/ghci057.stdout +++ b/testsuite/tests/ghci/scripts/ghci057.stdout @@ -7,6 +7,7 @@ GHCi-specific dynamic flag settings: other dynamic, non-language, flag settings: -fno-ghci-history -fimplicit-import-qualified + -fshow-warning-groups warning settings: Should fail, GADTs is not enabled options currently set: none. @@ -21,6 +22,7 @@ GHCi-specific dynamic flag settings: other dynamic, non-language, flag settings: -fno-ghci-history -fimplicit-import-qualified + -fshow-warning-groups warning settings: Should work, GADTs is in force from :set options currently set: none. @@ -34,6 +36,7 @@ GHCi-specific dynamic flag settings: other dynamic, non-language, flag settings: -fno-ghci-history -fimplicit-import-qualified + -fshow-warning-groups warning settings: Should fail, GADTs is now disabled base language is: Haskell2010 @@ -49,6 +52,7 @@ GHCi-specific dynamic flag settings: other dynamic, non-language, flag settings: -fno-ghci-history -fimplicit-import-qualified + -fshow-warning-groups warning settings: Should fail, GADTs is only enabled at the prompt C :: T Int From git at git.haskell.org Sun Feb 28 18:10:02 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 28 Feb 2016 18:10:02 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Update transformer submodule to v0.5.2.0 release (ab4f1c5) Message-ID: <20160228181003.001E33A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/ab4f1c5c0b8952cb86b157bacd06941091a5b126/ghc >--------------------------------------------------------------- commit ab4f1c5c0b8952cb86b157bacd06941091a5b126 Author: Herbert Valerio Riedel Date: Wed Feb 17 18:23:08 2016 +0100 Update transformer submodule to v0.5.2.0 release Most notably, this update pulls in documentation improvements and several INLINE pragmas for significant performance gains[1]. [1]: https://groups.google.com/d/msg/haskell-cafe/SUKtkDI84EE/fXMBd-jNDQAJ (cherry picked from commit eee040c17ad2feb6706f206eb8ea66c7ea131921) >--------------------------------------------------------------- ab4f1c5c0b8952cb86b157bacd06941091a5b126 libraries/transformers | 2 +- mk/warnings.mk | 1 + 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/libraries/transformers b/libraries/transformers index a2f7dd0..10348c4 160000 --- a/libraries/transformers +++ b/libraries/transformers @@ -1 +1 @@ -Subproject commit a2f7dd057a0ee0c6cb206609594d7a07d26a1861 +Subproject commit 10348c4bbf60debbfc82463e1035aca1cb7b51bc diff --git a/mk/warnings.mk b/mk/warnings.mk index d844db4..be32e3f 100644 --- a/mk/warnings.mk +++ b/mk/warnings.mk @@ -104,6 +104,7 @@ libraries/dph/dph-lifted-common-install_EXTRA_HC_OPTS += -Wwarn libraries/transformers_dist-boot_EXTRA_HC_OPTS += -fno-warn-unused-matches -fno-warn-unused-imports libraries/transformers_dist-install_EXTRA_HC_OPTS += -Wno-unused-matches -Wno-unused-imports libraries/transformers_dist-install_EXTRA_HC_OPTS += -Wno-redundant-constraints +libraries/transformers_dist-install_EXTRA_HC_OPTS += -Wno-orphans # Turn of trustworthy-safe warning libraries/base_dist-install_EXTRA_HC_OPTS += -Wno-trustworthy-safe From git at git.haskell.org Sun Feb 28 18:10:05 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 28 Feb 2016 18:10:05 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Print which warning-flag controls an emitted warning (4f5b7ad) Message-ID: <20160228181005.D467B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/4f5b7ad8fe567bc520e5c1b185beadda9007afea/ghc >--------------------------------------------------------------- commit 4f5b7ad8fe567bc520e5c1b185beadda9007afea Author: Michael Walker Date: Thu Feb 25 17:34:07 2016 +0100 Print which warning-flag controls an emitted warning Both gcc and clang tell which warning flag a reported warning can be controlled with, this patch makes ghc do the same. More generally, this allows for annotated compiler output, where an optional annotation is displayed in brackets after the severity. This also adds a new flag `-f(no-)show-warning-groups` to control whether to show which warning-group (such as `-Wall` or `-Wcompat`) a warning belongs to. This flag is on by default. This implements #10752 (cherry picked from commit bb5afd3c274011c5ea302210b4c290ec1f83209c) >--------------------------------------------------------------- 4f5b7ad8fe567bc520e5c1b185beadda9007afea compiler/coreSyn/CoreLint.hs | 7 +- compiler/deSugar/Coverage.hs | 2 +- compiler/ghci/Debugger.hs | 2 +- compiler/ghci/Linker.hs | 11 ++- compiler/iface/BinIface.hs | 9 +- compiler/iface/LoadIface.hs | 2 +- compiler/main/CodeOutput.hs | 8 +- compiler/main/DriverPipeline.hs | 4 +- compiler/main/DynFlags.hs | 93 ++++++++++++++++-- compiler/main/ErrUtils.hs | 49 +++++++--- compiler/main/ErrUtils.hs-boot | 1 + compiler/main/GhcMake.hs | 12 +-- compiler/main/SysTools.hs | 4 +- compiler/main/TidyPgm.hs | 2 +- compiler/rename/RnBinds.hs | 4 +- compiler/rename/RnEnv.hs | 21 ++-- compiler/rename/RnNames.hs | 81 +++++++++------- compiler/rename/RnSource.hs | 42 +++++--- compiler/rename/RnTypes.hs | 2 +- compiler/simplCore/CoreMonad.hs | 2 +- compiler/simplCore/SimplCore.hs | 3 +- compiler/simplStg/SimplStg.hs | 2 +- compiler/typecheck/Inst.hs | 4 +- compiler/typecheck/TcAnnotations.hs | 4 +- compiler/typecheck/TcBinds.hs | 25 ++--- compiler/typecheck/TcClassDcl.hs | 7 +- compiler/typecheck/TcDeriv.hs | 5 +- compiler/typecheck/TcErrors.hs | 19 ++-- compiler/typecheck/TcExpr.hs | 3 +- compiler/typecheck/TcForeign.hs | 6 +- compiler/typecheck/TcInstDcls.hs | 4 +- compiler/typecheck/TcMatches.hs | 4 +- compiler/typecheck/TcPat.hs | 3 +- compiler/typecheck/TcRnDriver.hs | 7 +- compiler/typecheck/TcRnMonad.hs | 78 +++++++++------ compiler/typecheck/TcSMonad.hs | 5 +- compiler/typecheck/TcSimplify.hs | 3 +- compiler/typecheck/TcSplice.hs | 2 +- compiler/typecheck/TcTyClsDecls.hs | 4 +- compiler/typecheck/TcValidity.hs | 7 +- docs/users_guide/using-warnings.rst | 9 ++ ghc/GHCi/UI.hs | 4 +- .../tests/deSugar/should_compile/ds041.stderr | 10 +- .../tests/deSugar/should_compile/ds053.stderr | 3 +- .../tests/dependent/should_compile/T11241.stderr | 2 +- .../tests/deriving/should_compile/T4966.stderr | 10 +- .../deriving/should_compile/deriving-1935.stderr | 24 ++--- .../tests/deriving/should_compile/drv003.stderr | 16 ++-- testsuite/tests/driver/werror.stderr | 12 ++- testsuite/tests/ffi/should_compile/T1357.stderr | 4 +- testsuite/tests/ghc-api/T7478/T7478.hs | 4 +- .../tests/ghc-api/apirecomp001/apirecomp001.stderr | 12 +-- testsuite/tests/ghci/scripts/T5820.stderr | 8 +- testsuite/tests/ghci/scripts/T8353.stderr | 6 +- testsuite/tests/ghci/scripts/ghci019.stderr | 2 +- .../haddock/haddock_examples/haddock.Test.stderr | 12 ++- .../indexed-types/should_compile/Class3.stderr | 8 +- .../indexed-types/should_compile/Simple2.stderr | 48 +++++----- .../indexed-types/should_compile/T3023.stderr | 2 +- .../indexed-types/should_compile/T8889.stderr | 2 +- .../should_compile/UnusedTyVarWarnings.stderr | 13 +-- .../UnusedTyVarWarningsNamedWCs.stderr | 10 +- .../tests/indexed-types/should_fail/T7862.stderr | 12 +-- testsuite/tests/module/mod128.stderr | 3 +- testsuite/tests/module/mod14.stderr | 2 +- testsuite/tests/module/mod176.stderr | 2 +- testsuite/tests/module/mod177.stderr | 2 +- testsuite/tests/module/mod5.stderr | 2 +- testsuite/tests/module/mod89.stderr | 4 +- testsuite/tests/monadfail/MonadFailWarnings.stderr | 8 +- .../MonadFailWarningsWithRebindableSyntax.stderr | 2 +- .../should_fail/overloadedrecfldsfail05.stderr | 2 +- .../should_fail/overloadedrecfldsfail06.stderr | 14 +-- .../should_fail/overloadedrecfldsfail11.stderr | 2 +- .../should_fail/overloadedrecfldsfail12.stderr | 6 +- testsuite/tests/parser/should_compile/T2245.stderr | 6 +- testsuite/tests/parser/should_compile/T3303.stderr | 4 +- .../tests/parser/should_compile/read014.stderr | 10 +- .../should_compile/ExprSigLocal.stderr | 4 +- .../partial-sigs/should_compile/SplicesUsed.stderr | 22 ++--- .../partial-sigs/should_compile/T10403.stderr | 6 +- .../partial-sigs/should_compile/T10438.stderr | 2 +- .../partial-sigs/should_compile/T10463.stderr | 14 +-- .../partial-sigs/should_compile/T10519.stderr | 2 +- .../partial-sigs/should_compile/T11016.stderr | 4 +- .../partial-sigs/should_compile/T11192.stderr | 4 +- .../partial-sigs/should_compile/TypedSplice.stderr | 28 +++--- .../WarningWildcardInstantiations.stderr | 14 +-- .../should_fail/Defaulting1MROff.stderr | 2 +- .../tests/partial-sigs/should_fail/T11122.stderr | 2 +- .../tests/patsyn/should_compile/T11283.stderr | 2 +- testsuite/tests/patsyn/should_fail/T11053.stderr | 10 +- testsuite/tests/rename/should_compile/T1789.stderr | 8 +- testsuite/tests/rename/should_compile/T17a.stderr | 4 +- testsuite/tests/rename/should_compile/T17b.stderr | 4 +- testsuite/tests/rename/should_compile/T17c.stderr | 4 +- testsuite/tests/rename/should_compile/T17d.stderr | 4 +- testsuite/tests/rename/should_compile/T17e.stderr | 8 +- testsuite/tests/rename/should_compile/T1972.stderr | 7 +- testsuite/tests/rename/should_compile/T3262.stderr | 4 +- testsuite/tests/rename/should_compile/T3371.stderr | 3 +- testsuite/tests/rename/should_compile/T3449.stderr | 3 +- testsuite/tests/rename/should_compile/T4489.stderr | 4 +- testsuite/tests/rename/should_compile/T5331.stderr | 6 +- testsuite/tests/rename/should_compile/T5334.stderr | 22 ++--- testsuite/tests/rename/should_compile/T5867.stderr | 4 +- testsuite/tests/rename/should_compile/T7085.stderr | 2 +- .../tests/rename/should_compile/T7145b.stderr | 3 +- testsuite/tests/rename/should_compile/T7167.stderr | 3 +- testsuite/tests/rename/should_compile/T9778.stderr | 7 +- testsuite/tests/rename/should_compile/mc10.stderr | 3 +- testsuite/tests/rename/should_compile/rn037.stderr | 2 +- testsuite/tests/rename/should_compile/rn039.stderr | 2 +- testsuite/tests/rename/should_compile/rn040.stderr | 6 +- testsuite/tests/rename/should_compile/rn041.stderr | 9 +- testsuite/tests/rename/should_compile/rn046.stderr | 4 +- testsuite/tests/rename/should_compile/rn047.stderr | 3 +- testsuite/tests/rename/should_compile/rn050.stderr | 4 +- testsuite/tests/rename/should_compile/rn055.stderr | 3 +- testsuite/tests/rename/should_compile/rn063.stderr | 6 +- testsuite/tests/rename/should_compile/rn064.stderr | 2 +- testsuite/tests/rename/should_compile/rn066.stderr | 4 +- testsuite/tests/rename/should_fail/T2723.stderr | 2 +- testsuite/tests/rename/should_fail/T5211.stderr | 2 +- testsuite/tests/rename/should_fail/T5281.stderr | 2 +- testsuite/tests/rename/should_fail/T5892a.stderr | 14 +-- testsuite/tests/rename/should_fail/T7454.stderr | 2 +- testsuite/tests/rename/should_fail/T8149.stderr | 2 +- testsuite/tests/semigroup/SemigroupWarnings.stderr | 4 +- .../tests/simplCore/should_compile/simpl020.stderr | 2 +- .../typecheck/prog001/typecheck.prog001.stderr | 8 +- .../tests/typecheck/should_compile/HasKey.stderr | 8 +- .../tests/typecheck/should_compile/T10935.stderr | 10 +- .../tests/typecheck/should_compile/T10971a.stderr | 16 ++-- .../tests/typecheck/should_compile/T2497.stderr | 3 +- .../tests/typecheck/should_compile/T3696.stderr | 2 +- .../tests/typecheck/should_compile/T4912.stderr | 4 +- .../tests/typecheck/should_compile/T7903.stderr | 16 ++-- .../tests/typecheck/should_compile/T9497a.stderr | 2 +- .../tests/typecheck/should_compile/holes.stderr | 8 +- .../tests/typecheck/should_compile/holes2.stderr | 2 +- .../tests/typecheck/should_compile/tc078.stderr | 16 ++-- .../tests/typecheck/should_compile/tc115.stderr | 8 +- .../tests/typecheck/should_compile/tc116.stderr | 8 +- .../tests/typecheck/should_compile/tc125.stderr | 41 ++++---- .../tests/typecheck/should_compile/tc126.stderr | 16 ++-- .../tests/typecheck/should_compile/tc161.stderr | 8 +- .../tests/typecheck/should_compile/tc175.stderr | 8 +- .../tests/typecheck/should_compile/tc243.stderr | 2 +- .../tests/typecheck/should_compile/tc254.stderr | 6 +- testsuite/tests/typecheck/should_fail/T5051.stderr | 2 +- .../tests/typecheck/should_fail/tcfail204.stderr | 2 +- .../tests/warnings/minimal/WarnMinimal.stderr | 106 ++++++++++----------- .../tests/warnings/should_compile/DeprU.stderr | 4 +- .../tests/warnings/should_compile/PluralS.stderr | 4 +- .../warnings/should_compile/T10890/T10890_2.stderr | 2 +- .../tests/warnings/should_compile/T11077.stderr | 2 +- .../tests/warnings/should_compile/T11128.stderr | 8 +- .../tests/warnings/should_compile/T11128b.stderr | 4 +- .../tests/warnings/should_compile/T2526.stderr | 2 +- .../tests/warnings/should_compile/T9178.stderr | 2 +- .../wcompat-warnings/WCompatWarningsOn.stderr | 8 +- utils/mkUserGuidePart/Options/Warnings.hs | 5 + 163 files changed, 865 insertions(+), 627 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 4f5b7ad8fe567bc520e5c1b185beadda9007afea From git at git.haskell.org Sun Feb 28 18:40:22 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 28 Feb 2016 18:40:22 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Print which flag controls emitted desugaring warnings (2091439) Message-ID: <20160228184022.F16C63A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/209143945233726a8cf5c4eb2605a4f8084e5fa0/ghc >--------------------------------------------------------------- commit 209143945233726a8cf5c4eb2605a4f8084e5fa0 Author: Herbert Valerio Riedel Date: Sat Feb 27 13:50:10 2016 +0100 Print which flag controls emitted desugaring warnings This is extends bb5afd3c274011c5ea302210b4c290ec1f83209c to cover warnings emitted during the desugaring phase. This implements another part of #10752 (cherry picked from commit b9c697eefd34fcba3ab9c1f831baf7f651ad7503) >--------------------------------------------------------------- 209143945233726a8cf5c4eb2605a4f8084e5fa0 compiler/deSugar/Check.hs | 40 ++++++++++++++-------- compiler/deSugar/Desugar.hs | 8 +++-- compiler/deSugar/DsBinds.hs | 12 +++---- compiler/deSugar/DsExpr.hs | 14 ++++---- compiler/deSugar/DsMonad.hs | 15 ++++---- compiler/deSugar/Match.hs | 2 +- compiler/deSugar/MatchLit.hs | 9 ++--- .../deSugar/should_compile/DsStrictWarn.stderr | 2 +- .../deSugar/should_compile/GadtOverlap.stderr | 2 +- .../tests/deSugar/should_compile/T10662.stderr | 3 +- .../tests/deSugar/should_compile/T2395.stderr | 2 +- .../tests/deSugar/should_compile/T3263-1.stderr | 6 ++-- .../tests/deSugar/should_compile/T3263-2.stderr | 6 ++-- .../tests/deSugar/should_compile/T4488.stderr | 12 +++---- .../tests/deSugar/should_compile/T5117.stderr | 2 +- .../tests/deSugar/should_compile/T5455.stderr | 4 +-- .../tests/deSugar/should_compile/ds002.stderr | 6 ++-- .../tests/deSugar/should_compile/ds003.stderr | 4 +-- .../tests/deSugar/should_compile/ds019.stderr | 6 ++-- .../tests/deSugar/should_compile/ds020.stderr | 10 +++--- .../tests/deSugar/should_compile/ds022.stderr | 4 +-- .../tests/deSugar/should_compile/ds043.stderr | 2 +- .../tests/deSugar/should_compile/ds051.stderr | 6 ++-- .../tests/deSugar/should_compile/ds056.stderr | 2 +- .../tests/deSugar/should_compile/ds058.stderr | 2 +- .../dependent/should_compile/KindEqualities.stderr | 2 +- testsuite/tests/driver/werror.stderr | 4 +-- testsuite/tests/gadt/T7294.stderr | 2 +- testsuite/tests/ghci/scripts/Defer02.stderr | 4 +-- testsuite/tests/ghci/scripts/T3263.stderr | 3 +- .../tests/numeric/should_compile/T10929.stderr | 9 +++-- .../tests/numeric/should_compile/T7881.stderr | 9 +++-- .../tests/numeric/should_compile/T7895.stderr | 4 +-- .../tests/numeric/should_compile/T8542.stderr | 4 +-- .../tests/pmcheck/should_compile/T2204.stderr | 5 +-- .../tests/pmcheck/should_compile/T9951b.stderr | 3 +- .../tests/pmcheck/should_compile/pmc001.stderr | 5 +-- .../tests/pmcheck/should_compile/pmc003.stderr | 2 +- .../tests/pmcheck/should_compile/pmc004.stderr | 2 +- .../tests/pmcheck/should_compile/pmc005.stderr | 4 +-- .../tests/pmcheck/should_compile/pmc007.stderr | 7 ++-- .../simplCore/should_compile/T6082-RULE.stderr | 4 +-- .../tests/simplCore/should_compile/T7287.stderr | 2 +- testsuite/tests/th/TH_repUnboxedTuples.stderr | 2 +- .../tests/typecheck/should_compile/T5490.stderr | 4 +-- 45 files changed, 139 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 209143945233726a8cf5c4eb2605a4f8084e5fa0 From git at git.haskell.org Sun Feb 28 18:40:25 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 28 Feb 2016 18:40:25 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Print which flag controls emitted lexer warnings (02e91ac) Message-ID: <20160228184025.A8D7F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/02e91accf082967cd28ad0d081f774117ee3386b/ghc >--------------------------------------------------------------- commit 02e91accf082967cd28ad0d081f774117ee3386b Author: Herbert Valerio Riedel Date: Sat Feb 27 17:34:14 2016 +0100 Print which flag controls emitted lexer warnings This is extends bb5afd3c274011c5ea302210b4c290ec1f83209c to cover warnings emitted during lexing. This implements another part of #10752 (cherry picked from commit 869d9c62d8329022f9f5504a92d2d74efec4f2e8) >--------------------------------------------------------------- 02e91accf082967cd28ad0d081f774117ee3386b compiler/parser/Lexer.x | 6 ++++-- testsuite/tests/driver/recomp005/recomp005.stderr | 4 ++-- testsuite/tests/driver/werror.stderr | 2 +- testsuite/tests/ghci/should_run/T7253.stderr | 11 ++++++----- testsuite/tests/layout/layout001.stdout | 4 ++-- testsuite/tests/layout/layout003.stdout | 4 ++-- testsuite/tests/layout/layout006.stdout | 4 ++-- testsuite/tests/parser/should_compile/T9723a.stderr | 2 +- testsuite/tests/parser/should_compile/T9723b.stderr | 2 +- testsuite/tests/parser/should_compile/read043.stderr | 2 +- testsuite/tests/parser/should_compile/read064.stderr | 3 ++- testsuite/tests/parser/should_compile/read066.stderr | 3 ++- testsuite/tests/warnings/should_compile/T9230.stderr | 2 +- 13 files changed, 27 insertions(+), 22 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 02e91accf082967cd28ad0d081f774117ee3386b From git at git.haskell.org Sun Feb 28 18:40:28 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 28 Feb 2016 18:40:28 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Annotate `[-Wredundant-constraints]` in warnings (re #10752) (94b2681) Message-ID: <20160228184028.583503A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/94b2681507db793359b101b945c710e504971556/ghc >--------------------------------------------------------------- commit 94b2681507db793359b101b945c710e504971556 Author: Herbert Valerio Riedel Date: Sat Feb 27 18:26:32 2016 +0100 Annotate `[-Wredundant-constraints]` in warnings (re #10752) This was missed in bb5afd3c274011c5ea302210b4c290ec1f83209c (cherry picked from commit 82f200b74ac1ea8c5593e2909c0033eb251eeaf2) >--------------------------------------------------------------- 94b2681507db793359b101b945c710e504971556 compiler/typecheck/TcErrors.hs | 4 ++-- testsuite/tests/typecheck/should_compile/T10632.stderr | 2 +- testsuite/tests/typecheck/should_compile/T9939.stderr | 8 ++++---- testsuite/tests/warnings/should_compile/PluralS.stderr | 4 ++-- 4 files changed, 9 insertions(+), 9 deletions(-) diff --git a/compiler/typecheck/TcErrors.hs b/compiler/typecheck/TcErrors.hs index 63def64..ee2ea0f 100644 --- a/compiler/typecheck/TcErrors.hs +++ b/compiler/typecheck/TcErrors.hs @@ -336,13 +336,13 @@ warnRedundantConstraints ctxt env info ev_vars addErrCtxt (text "In" <+> ppr info) $ do { env <- getLclEnv ; msg <- mkErrorReport ctxt env (important doc) - ; reportWarning NoReason msg } + ; reportWarning (Reason Opt_WarnRedundantConstraints) msg } | otherwise -- But for InstSkol there already *is* a surrounding -- "In the instance declaration for Eq [a]" context -- and we don't want to say it twice. Seems a bit ad-hoc = do { msg <- mkErrorReport ctxt env (important doc) - ; reportWarning NoReason msg } + ; reportWarning (Reason Opt_WarnRedundantConstraints) msg } where doc = text "Redundant constraint" <> plural redundant_evs <> colon <+> pprEvVarTheta redundant_evs diff --git a/testsuite/tests/typecheck/should_compile/T10632.stderr b/testsuite/tests/typecheck/should_compile/T10632.stderr index 8e72f42..211972d 100644 --- a/testsuite/tests/typecheck/should_compile/T10632.stderr +++ b/testsuite/tests/typecheck/should_compile/T10632.stderr @@ -1,5 +1,5 @@ -T10632.hs:3:1: warning: +T10632.hs:3:1: warning: [-Wredundant-constraints] ? Redundant constraint: ?file1::String ? In the type signature for: f :: (?file1::String) => IO () diff --git a/testsuite/tests/typecheck/should_compile/T9939.stderr b/testsuite/tests/typecheck/should_compile/T9939.stderr index 106335e..a10066b 100644 --- a/testsuite/tests/typecheck/should_compile/T9939.stderr +++ b/testsuite/tests/typecheck/should_compile/T9939.stderr @@ -1,20 +1,20 @@ -T9939.hs:5:1: warning: +T9939.hs:5:1: warning: [-Wredundant-constraints] ? Redundant constraint: Eq a ? In the type signature for: f1 :: (Eq a, Ord a) => a -> a -> Bool -T9939.hs:9:1: warning: +T9939.hs:9:1: warning: [-Wredundant-constraints] ? Redundant constraint: Eq a ? In the type signature for: f2 :: (Eq a, Ord a) => a -> a -> Bool -T9939.hs:13:1: warning: +T9939.hs:13:1: warning: [-Wredundant-constraints] ? Redundant constraint: Eq b ? In the type signature for: f3 :: (Eq a, a ~ b, Eq b) => a -> b -> Bool -T9939.hs:20:1: warning: +T9939.hs:20:1: warning: [-Wredundant-constraints] ? Redundant constraint: Eq a ? In the type signature for: f4 :: (Eq a, Eq b) => a -> b -> Equal a b -> Bool diff --git a/testsuite/tests/warnings/should_compile/PluralS.stderr b/testsuite/tests/warnings/should_compile/PluralS.stderr index a06ab5e..9289a0b 100644 --- a/testsuite/tests/warnings/should_compile/PluralS.stderr +++ b/testsuite/tests/warnings/should_compile/PluralS.stderr @@ -15,12 +15,12 @@ PluralS.hs:17:29: warning: [-Wtype-defaults (in -Wall)] In an equation for ?defaultingNumAndShow?: defaultingNumAndShow = show 123 -PluralS.hs:23:1: warning: +PluralS.hs:23:1: warning: [-Wredundant-constraints] ? Redundant constraint: Num a ? In the type signature for: redundantNum :: (Num a, Num a) => a -PluralS.hs:26:1: warning: +PluralS.hs:26:1: warning: [-Wredundant-constraints] ? Redundant constraints: (Show a, Num a, Eq a, Eq a) ? In the type signature for: redundantMultiple :: (Num a, Show a, Num a, Eq a, Eq a) => a From git at git.haskell.org Sun Feb 28 18:40:31 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 28 Feb 2016 18:40:31 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Print which flag controls emitted SafeHaskell warnings (2ffd9b1) Message-ID: <20160228184031.1B78E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/2ffd9b167a107a82fff42adb22d15b185d8b8757/ghc >--------------------------------------------------------------- commit 2ffd9b167a107a82fff42adb22d15b185d8b8757 Author: Herbert Valerio Riedel Date: Sat Feb 27 18:48:04 2016 +0100 Print which flag controls emitted SafeHaskell warnings This is extends bb5afd3c274011c5ea302210b4c290ec1f83209c to cover SafeHaskell warnings. This implements yet another part of #10752 (cherry picked from commit b6c61e372a1a783b32f1bbd1ceb446e89478a138) >--------------------------------------------------------------- 2ffd9b167a107a82fff42adb22d15b185d8b8757 compiler/main/HscMain.hs | 14 ++++++++----- .../tests/safeHaskell/flags/SafeFlags22.stderr | 4 ++-- .../tests/safeHaskell/flags/SafeFlags23.stderr | 6 +++--- .../tests/safeHaskell/flags/SafeFlags25.stderr | 2 +- .../tests/safeHaskell/flags/SafeFlags26.stderr | 4 ++-- .../safeHaskell/overlapping/SH_Overlap11.stderr | 23 +++++++++++----------- .../safeHaskell/overlapping/SH_Overlap7.stderr | 23 +++++++++++----------- .../safeHaskell/safeInfered/SafeInfered05.stderr | 2 +- .../safeHaskell/safeInfered/SafeWarn01.stderr | 2 +- .../safeInfered/TrustworthySafe02.stderr | 2 +- .../safeInfered/TrustworthySafe03.stderr | 2 +- .../safeHaskell/safeInfered/UnsafeInfered11.stderr | 6 +++--- .../safeHaskell/safeInfered/UnsafeInfered12.stderr | 4 ++-- .../safeHaskell/safeInfered/UnsafeWarn01.stderr | 4 ++-- .../safeHaskell/safeInfered/UnsafeWarn02.stderr | 2 +- .../safeHaskell/safeInfered/UnsafeWarn03.stderr | 4 ++-- .../safeHaskell/safeInfered/UnsafeWarn04.stderr | 4 ++-- .../safeHaskell/safeInfered/UnsafeWarn05.stderr | 8 ++++---- .../safeHaskell/safeInfered/UnsafeWarn06.stderr | 4 ++-- .../safeHaskell/safeInfered/UnsafeWarn07.stderr | 4 ++-- 20 files changed, 65 insertions(+), 59 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 2ffd9b167a107a82fff42adb22d15b185d8b8757 From git at git.haskell.org Sun Feb 28 18:40:33 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 28 Feb 2016 18:40:33 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Annotate `[-Wdeferred-type-errors]` in warnings (re #10752) (966cc28) Message-ID: <20160228184033.C74DC3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/966cc28ffe1707685cb908753bb6f8fb78fc86c9/ghc >--------------------------------------------------------------- commit 966cc28ffe1707685cb908753bb6f8fb78fc86c9 Author: Herbert Valerio Riedel Date: Sat Feb 27 19:45:11 2016 +0100 Annotate `[-Wdeferred-type-errors]` in warnings (re #10752) This was missed in bb5afd3c274011c5ea302210b4c290ec1f83209c (cherry picked from commit 3cd4c9ca4564982cf159f11f59d434235ba28808) >--------------------------------------------------------------- 966cc28ffe1707685cb908753bb6f8fb78fc86c9 compiler/typecheck/TcErrors.hs | 2 +- testsuite/tests/gadt/T7294.stderr | 2 +- testsuite/tests/ghci/scripts/Defer02.stderr | 26 +++++++++++----------- testsuite/tests/ghci/scripts/T8353.stderr | 6 ++--- .../partial-sigs/should_compile/T10403.stderr | 6 ++--- testsuite/tests/th/T7276a.stdout | 2 +- .../tests/typecheck/should_compile/T11254.stderr | 4 ++-- .../tests/typecheck/should_compile/T9834.stderr | 4 ++-- .../tests/typecheck/should_compile/holes2.stderr | 2 +- 9 files changed, 27 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 966cc28ffe1707685cb908753bb6f8fb78fc86c9 From git at git.haskell.org Sun Feb 28 18:40:36 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 28 Feb 2016 18:40:36 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Default to -fno-show-warning-groups (re #10752) (975353b) Message-ID: <20160228184036.7F0A73A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/975353bfdfab375cb5c47dc2460792190abac277/ghc >--------------------------------------------------------------- commit 975353bfdfab375cb5c47dc2460792190abac277 Author: Herbert Valerio Riedel Date: Sat Feb 27 23:36:11 2016 +0100 Default to -fno-show-warning-groups (re #10752) As `-fno-show-warning-groups` shows associated warning groups regardless of whether the respective warning group flag as been passed on the CLI, the warning-group information may be confusing to users. At this point, `-fshow-warning-groups` is useful mostly to GHC developers and possibly GHC users who want to see which warning groups an emitted warning is part of. (Btw, this is particularly interesting in combination with `-Weverything` which enables *every* warning flag known to GHC.) Consequently, starting with this commit, one has to opt-in via `-fshow-warning-groups` for GHC to show warning groups. In order to reduce the testsuite delta in this commit, the `-fshow-warning-groups` flag has been added to TEST_HC_OPTS. (cherry picked from commit 46f3775c683faeb710c9dc22f360f39334947d73) >--------------------------------------------------------------- 975353bfdfab375cb5c47dc2460792190abac277 compiler/main/DynFlags.hs | 3 +-- docs/users_guide/using-warnings.rst | 7 ++++--- testsuite/mk/test.mk | 2 +- testsuite/tests/ghc-api/apirecomp001/apirecomp001.stderr | 12 ++++++------ testsuite/tests/ghci/scripts/T9293.stdout | 4 ++++ testsuite/tests/ghci/scripts/ghci024.stdout | 1 + testsuite/tests/ghci/scripts/ghci057.stdout | 4 ++++ 7 files changed, 21 insertions(+), 12 deletions(-) diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 35805cc..c2ad3f9 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -3612,8 +3612,7 @@ defaultFlags settings Opt_ProfCountEntries, Opt_RPath, Opt_SharedImplib, - Opt_SimplPreInlining, - Opt_ShowWarnGroups + Opt_SimplPreInlining ] ++ [f | (ns,f) <- optLevelFlags, 0 `elem` ns] diff --git a/docs/users_guide/using-warnings.rst b/docs/users_guide/using-warnings.rst index 3f24f6a..ffe5a41 100644 --- a/docs/users_guide/using-warnings.rst +++ b/docs/users_guide/using-warnings.rst @@ -103,13 +103,14 @@ The following flags are simple ways to select standard "packages" of warnings: default, but can be useful to negate a :ghc-flag:`-Werror` flag. When a warning is emitted, the specific warning flag which controls -it, as well as the group it belongs to, are shown. +it is shown. .. ghc-flag:: -fshow-warning-groups - Name the group a warning flag belongs to. + When showing which flag controls a warning, also show the + respective warning group flag(s) that warning is contained in. - This is enabled by default. Disable with ``-fno-show-warning-groups``. + This option is off by default. The full set of warning options is described below. To turn off any warning, simply give the corresponding ``-Wno-...`` option on the diff --git a/testsuite/mk/test.mk b/testsuite/mk/test.mk index 013d67f..6379a16 100644 --- a/testsuite/mk/test.mk +++ b/testsuite/mk/test.mk @@ -34,7 +34,7 @@ endif # TEST_HC_OPTS is passed to every invocation of TEST_HC # in nested Makefiles -TEST_HC_OPTS = -fforce-recomp -dcore-lint -dcmm-lint -dno-debug-output -no-user-$(GhcPackageDbFlag) -rtsopts $(EXTRA_HC_OPTS) +TEST_HC_OPTS = -fforce-recomp -dcore-lint -dcmm-lint -dno-debug-output -fshow-warning-groups -no-user-$(GhcPackageDbFlag) -rtsopts $(EXTRA_HC_OPTS) # The warning suppression flag below is a temporary kludge. While working with # tests that contain tabs, please de-tab them so this flag can be eventually diff --git a/testsuite/tests/ghc-api/apirecomp001/apirecomp001.stderr b/testsuite/tests/ghc-api/apirecomp001/apirecomp001.stderr index a943e48..80b94dc 100644 --- a/testsuite/tests/ghc-api/apirecomp001/apirecomp001.stderr +++ b/testsuite/tests/ghc-api/apirecomp001/apirecomp001.stderr @@ -1,9 +1,9 @@ -B.hs:4:1: warning: [-Wmissing-signatures (in -Wall)] +B.hs:4:1: warning: [-Wmissing-signatures] Top-level binding with no type signature: answer_to_live_the_universe_and_everything :: Int -B.hs:5:12: warning: [-Wtype-defaults (in -Wall)] +B.hs:5:12: warning: [-Wtype-defaults] ? Defaulting the following constraints to type ?Integer? (Enum a0) arising from the arithmetic sequence ?1 .. 23 * 2? at B.hs:5:12-20 @@ -12,14 +12,14 @@ B.hs:5:12: warning: [-Wtype-defaults (in -Wall)] In the first argument of ?(-)?, namely ?length [1 .. 23 * 2]? In the expression: length [1 .. 23 * 2] - 4 -A.hs:7:1: warning: [-Wmissing-signatures (in -Wall)] +A.hs:7:1: warning: [-Wmissing-signatures] Top-level binding with no type signature: main :: IO () -B.hs:4:1: warning: [-Wmissing-signatures (in -Wall)] +B.hs:4:1: warning: [-Wmissing-signatures] Top-level binding with no type signature: answer_to_live_the_universe_and_everything :: Int -B.hs:5:12: warning: [-Wtype-defaults (in -Wall)] +B.hs:5:12: warning: [-Wtype-defaults] ? Defaulting the following constraints to type ?Integer? (Enum a0) arising from the arithmetic sequence ?1 .. 23 * 2? at B.hs:5:12-20 @@ -28,5 +28,5 @@ B.hs:5:12: warning: [-Wtype-defaults (in -Wall)] In the first argument of ?(-)?, namely ?length [1 .. 23 * 2]? In the expression: length [1 .. 23 * 2] - 4 -A.hs:7:1: warning: [-Wmissing-signatures (in -Wall)] +A.hs:7:1: warning: [-Wmissing-signatures] Top-level binding with no type signature: main :: IO () diff --git a/testsuite/tests/ghci/scripts/T9293.stdout b/testsuite/tests/ghci/scripts/T9293.stdout index 67fc630..02ee22c 100644 --- a/testsuite/tests/ghci/scripts/T9293.stdout +++ b/testsuite/tests/ghci/scripts/T9293.stdout @@ -7,6 +7,7 @@ GHCi-specific dynamic flag settings: other dynamic, non-language, flag settings: -fno-ghci-history -fimplicit-import-qualified + -fshow-warning-groups warning settings: Should fail, GADTs is not enabled options currently set: none. @@ -21,6 +22,7 @@ GHCi-specific dynamic flag settings: other dynamic, non-language, flag settings: -fno-ghci-history -fimplicit-import-qualified + -fshow-warning-groups warning settings: Should work, GADTs is in force from :set options currently set: none. @@ -34,6 +36,7 @@ GHCi-specific dynamic flag settings: other dynamic, non-language, flag settings: -fno-ghci-history -fimplicit-import-qualified + -fshow-warning-groups warning settings: Should fail, GADTs is now disabled base language is: Haskell2010 @@ -49,6 +52,7 @@ GHCi-specific dynamic flag settings: other dynamic, non-language, flag settings: -fno-ghci-history -fimplicit-import-qualified + -fshow-warning-groups warning settings: Should fail, GADTs is only enabled at the prompt C :: T Int diff --git a/testsuite/tests/ghci/scripts/ghci024.stdout b/testsuite/tests/ghci/scripts/ghci024.stdout index 9fea946..b92adad 100644 --- a/testsuite/tests/ghci/scripts/ghci024.stdout +++ b/testsuite/tests/ghci/scripts/ghci024.stdout @@ -8,6 +8,7 @@ GHCi-specific dynamic flag settings: other dynamic, non-language, flag settings: -fforce-recomp -fimplicit-import-qualified + -fshow-warning-groups warning settings: -Wno-tabs ~~~~~~~~~~ Testing :set -a diff --git a/testsuite/tests/ghci/scripts/ghci057.stdout b/testsuite/tests/ghci/scripts/ghci057.stdout index 67fc630..02ee22c 100644 --- a/testsuite/tests/ghci/scripts/ghci057.stdout +++ b/testsuite/tests/ghci/scripts/ghci057.stdout @@ -7,6 +7,7 @@ GHCi-specific dynamic flag settings: other dynamic, non-language, flag settings: -fno-ghci-history -fimplicit-import-qualified + -fshow-warning-groups warning settings: Should fail, GADTs is not enabled options currently set: none. @@ -21,6 +22,7 @@ GHCi-specific dynamic flag settings: other dynamic, non-language, flag settings: -fno-ghci-history -fimplicit-import-qualified + -fshow-warning-groups warning settings: Should work, GADTs is in force from :set options currently set: none. @@ -34,6 +36,7 @@ GHCi-specific dynamic flag settings: other dynamic, non-language, flag settings: -fno-ghci-history -fimplicit-import-qualified + -fshow-warning-groups warning settings: Should fail, GADTs is now disabled base language is: Haskell2010 @@ -49,6 +52,7 @@ GHCi-specific dynamic flag settings: other dynamic, non-language, flag settings: -fno-ghci-history -fimplicit-import-qualified + -fshow-warning-groups warning settings: Should fail, GADTs is only enabled at the prompt C :: T Int From git at git.haskell.org Mon Feb 29 12:41:14 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 29 Feb 2016 12:41:14 +0000 (UTC) Subject: [commit: ghc] master: Missing Proxy instances, make U1 instance more Proxy-like (171d95d) Message-ID: <20160229124114.9C2273A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/171d95df24dc2d9d0c1a3af9e75f021438a7da50/ghc >--------------------------------------------------------------- commit 171d95df24dc2d9d0c1a3af9e75f021438a7da50 Author: RyanGlScott Date: Mon Feb 29 12:28:18 2016 +0100 Missing Proxy instances, make U1 instance more Proxy-like This accomplishes three things: * Adds missing `Alternative`, `MonadPlus`, and `MonadZip` instances for `Proxy` * Adds a missing `MonadPlus` instance for `U1` * Changes several existing `U1` instances to use lazy pattern-matching, exactly how `Proxy` does it (in case we ever replace `U1` with `Proxy`). This is technically a breaking change (albeit an extremely minor one). Test Plan: ./validate Reviewers: austin, ekmett, hvr, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1962 GHC Trac Issues: #11650 >--------------------------------------------------------------- 171d95df24dc2d9d0c1a3af9e75f021438a7da50 libraries/base/Control/Monad/Zip.hs | 7 +++++++ libraries/base/Data/Foldable.hs | 18 +++++++++++++++++- libraries/base/Data/Proxy.hs | 8 ++++++++ libraries/base/Data/Traversable.hs | 11 ++++++++++- libraries/base/GHC/Generics.hs | 34 ++++++++++++++++++++++++---------- libraries/base/changelog.md | 3 +++ 6 files changed, 69 insertions(+), 12 deletions(-) diff --git a/libraries/base/Control/Monad/Zip.hs b/libraries/base/Control/Monad/Zip.hs index 771b8aa..fa44438 100644 --- a/libraries/base/Control/Monad/Zip.hs +++ b/libraries/base/Control/Monad/Zip.hs @@ -20,6 +20,7 @@ module Control.Monad.Zip where import Control.Monad (liftM, liftM2) import Data.Monoid +import Data.Proxy import GHC.Generics -- | `MonadZip` type class. Minimal definition: `mzip` or `mzipWith` @@ -78,7 +79,13 @@ instance MonadZip Last where instance MonadZip f => MonadZip (Alt f) where mzipWith f (Alt ma) (Alt mb) = Alt (mzipWith f ma mb) +instance MonadZip Proxy where + mzipWith _ _ _ = Proxy + -- Instances for GHC.Generics +instance MonadZip U1 where + mzipWith _ _ _ = U1 + instance MonadZip Par1 where mzipWith = liftM2 diff --git a/libraries/base/Data/Foldable.hs b/libraries/base/Data/Foldable.hs index 5d758ae..0defe6c 100644 --- a/libraries/base/Data/Foldable.hs +++ b/libraries/base/Data/Foldable.hs @@ -425,8 +425,24 @@ instance Ord a => Monoid (Min a) where | otherwise = Min n -- Instances for GHC.Generics +instance Foldable U1 where + foldMap _ _ = mempty + {-# INLINE foldMap #-} + fold _ = mempty + {-# INLINE fold #-} + foldr _ z _ = z + {-# INLINE foldr #-} + foldl _ z _ = z + {-# INLINE foldl #-} + foldl1 _ _ = errorWithoutStackTrace "foldl1: U1" + foldr1 _ _ = errorWithoutStackTrace "foldr1: U1" + length _ = 0 + null _ = True + elem _ _ = False + sum _ = 0 + product _ = 1 + deriving instance Foldable V1 -deriving instance Foldable U1 deriving instance Foldable Par1 deriving instance Foldable f => Foldable (Rec1 f) deriving instance Foldable (K1 i c) diff --git a/libraries/base/Data/Proxy.hs b/libraries/base/Data/Proxy.hs index 9f602ea..f0760e8 100644 --- a/libraries/base/Data/Proxy.hs +++ b/libraries/base/Data/Proxy.hs @@ -89,10 +89,18 @@ instance Applicative Proxy where _ <*> _ = Proxy {-# INLINE (<*>) #-} +instance Alternative Proxy where + empty = Proxy + {-# INLINE empty #-} + _ <|> _ = Proxy + {-# INLINE (<|>) #-} + instance Monad Proxy where _ >>= _ = Proxy {-# INLINE (>>=) #-} +instance MonadPlus Proxy + -- | 'asProxyTypeOf' is a type-restricted version of 'const'. -- 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 diff --git a/libraries/base/Data/Traversable.hs b/libraries/base/Data/Traversable.hs index c6a30d7..b903b1d 100644 --- a/libraries/base/Data/Traversable.hs +++ b/libraries/base/Data/Traversable.hs @@ -228,8 +228,17 @@ instance Traversable ZipList where traverse f (ZipList x) = ZipList <$> traverse f x -- Instances for GHC.Generics +instance Traversable U1 where + traverse _ _ = pure U1 + {-# INLINE traverse #-} + sequenceA _ = pure U1 + {-# INLINE sequenceA #-} + mapM _ _ = pure U1 + {-# INLINE mapM #-} + sequence _ = pure U1 + {-# INLINE sequence #-} + deriving instance Traversable V1 -deriving instance Traversable U1 deriving instance Traversable Par1 deriving instance Traversable f => Traversable (Rec1 f) deriving instance Traversable (K1 i c) diff --git a/libraries/base/GHC/Generics.hs b/libraries/base/GHC/Generics.hs index f723127..62c3576 100644 --- a/libraries/base/GHC/Generics.hs +++ b/libraries/base/GHC/Generics.hs @@ -712,10 +712,10 @@ import GHC.Types import GHC.Arr ( Ix ) import GHC.Base ( Alternative(..), Applicative(..), Functor(..) , Monad(..), MonadPlus(..), String ) -import GHC.Classes ( Eq, Ord ) +import GHC.Classes ( Eq(..), Ord(..) ) import GHC.Enum ( Bounded, Enum ) -import GHC.Read ( Read ) -import GHC.Show ( Show ) +import GHC.Read ( Read(..), lex, readParen ) +import GHC.Show ( Show(..), showString ) -- Needed for metadata import Data.Proxy ( Proxy(..), KProxy(..) ) @@ -736,21 +736,35 @@ deriving instance Show (V1 p) -- | Unit: used for constructors without arguments data U1 (p :: *) = U1 - deriving (Eq, Ord, Read, Show, Functor, Generic, Generic1) + deriving (Generic, Generic1) + +instance Eq (U1 p) where + _ == _ = True + +instance Ord (U1 p) where + compare _ _ = EQ + +instance Read (U1 p) where + readsPrec d = readParen (d > 10) (\r -> [(U1, s) | ("U1",s) <- lex r ]) + +instance Show (U1 p) where + showsPrec _ _ = showString "U1" + +instance Functor U1 where + fmap _ _ = U1 instance Applicative U1 where pure _ = U1 - U1 <*> U1 = U1 + _ <*> _ = U1 instance Alternative U1 where empty = U1 - U1 <|> U1 = U1 - -- The defaults will otherwise bottom; see #11650. - some U1 = U1 - many U1 = U1 + _ <|> _ = U1 instance Monad U1 where - U1 >>= _ = U1 + _ >>= _ = U1 + +instance MonadPlus U1 -- | Used for marking occurrences of the parameter newtype Par1 p = Par1 { unPar1 :: p } diff --git a/libraries/base/changelog.md b/libraries/base/changelog.md index b0ccda6..92451b9 100644 --- a/libraries/base/changelog.md +++ b/libraries/base/changelog.md @@ -49,6 +49,9 @@ `GHC.Generics` as part of making GHC generics capable of handling unlifted types (#10868) + * The `Eq`, `Ord`, `Read`, and `Show` instances for `U1` now use lazier + pattern-matching + * Keep `shift{L,R}` on `Integer` with negative shift-arguments from segfaulting (#10571) From git at git.haskell.org Mon Feb 29 12:41:18 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 29 Feb 2016 12:41:18 +0000 (UTC) Subject: [commit: ghc] master: Fix bug where reexports of wired-in packages don't work. (2535c82) Message-ID: <20160229124118.35E9C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2535c82179f3c7431543babfd11a0ba4514a57b4/ghc >--------------------------------------------------------------- commit 2535c82179f3c7431543babfd11a0ba4514a57b4 Author: Edward Z. Yang Date: Mon Feb 29 11:53:34 2016 +0100 Fix bug where reexports of wired-in packages don't work. Signed-off-by: Edward Z. Yang Test Plan: validate Reviewers: hvr, bgamari, austin Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1926 GHC Trac Issues: #11589 >--------------------------------------------------------------- 2535c82179f3c7431543babfd11a0ba4514a57b4 testsuite/tests/cabal/cabal09/Main.hs | 2 ++ testsuite/tests/cabal/cabal09/Makefile | 21 +++++++++++++++++++++ testsuite/tests/cabal/{cabal05 => cabal09}/Setup.hs | 0 testsuite/tests/cabal/{cabal03 => cabal09}/all.T | 4 ++-- testsuite/tests/cabal/cabal09/reexport.cabal | 20 ++++++++++++++++++++ 5 files changed, 45 insertions(+), 2 deletions(-) diff --git a/testsuite/tests/cabal/cabal09/Main.hs b/testsuite/tests/cabal/cabal09/Main.hs new file mode 100644 index 0000000..eabafdf --- /dev/null +++ b/testsuite/tests/cabal/cabal09/Main.hs @@ -0,0 +1,2 @@ +import Data.List.NonEmpty +main = return () diff --git a/testsuite/tests/cabal/cabal09/Makefile b/testsuite/tests/cabal/cabal09/Makefile new file mode 100644 index 0000000..e89c2ea --- /dev/null +++ b/testsuite/tests/cabal/cabal09/Makefile @@ -0,0 +1,21 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +SETUP = ./Setup -v0 + +# This test is for package reexports from a wired-in package, +# which had a bug + +cabal09: clean + $(MAKE) clean + '$(TEST_HC)' -v0 --make Setup + $(SETUP) clean + $(SETUP) configure $(CABAL_MINIMAL_BUILD) --with-ghc='$(TEST_HC)' --ghc-options='$(TEST_HC_OPTS)' + $(SETUP) build +ifneq "$(CLEANUP)" "" + $(MAKE) clean +endif + +clean : + $(RM) -r */dist Setup$(exeext) *.o *.hi diff --git a/testsuite/tests/cabal/cabal05/Setup.hs b/testsuite/tests/cabal/cabal09/Setup.hs similarity index 100% copy from testsuite/tests/cabal/cabal05/Setup.hs copy to testsuite/tests/cabal/cabal09/Setup.hs diff --git a/testsuite/tests/cabal/cabal03/all.T b/testsuite/tests/cabal/cabal09/all.T similarity index 61% copy from testsuite/tests/cabal/cabal03/all.T copy to testsuite/tests/cabal/cabal09/all.T index 01d3882..66bdb01 100644 --- a/testsuite/tests/cabal/cabal03/all.T +++ b/testsuite/tests/cabal/cabal09/all.T @@ -3,7 +3,7 @@ if default_testopts.cleanup != '': else: cleanup = '' -test('cabal03', +test('cabal09', ignore_output, run_command, - ['$MAKE -s --no-print-directory cabal03 ' + cleanup]) + ['$MAKE -s --no-print-directory cabal09 ' + cleanup]) diff --git a/testsuite/tests/cabal/cabal09/reexport.cabal b/testsuite/tests/cabal/cabal09/reexport.cabal new file mode 100644 index 0000000..447a3ee --- /dev/null +++ b/testsuite/tests/cabal/cabal09/reexport.cabal @@ -0,0 +1,20 @@ +-- Initial reexport.cabal generated by cabal init. For further +-- documentation, see http://haskell.org/cabal/users-guide/ + +name: reexport +version: 0.1.0.0 +license: BSD3 +author: Edward Z. Yang +maintainer: ezyang at cs.stanford.edu +build-type: Simple +cabal-version: >=1.23 + +library + reexported-modules: Data.List.NonEmpty + build-depends: base >=4.9 && <4.10 + default-language: Haskell2010 + +executable foo + main-is: Main.hs + build-depends: base, reexport + default-language: Haskell2010 From git at git.haskell.org Mon Feb 29 12:41:20 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 29 Feb 2016 12:41:20 +0000 (UTC) Subject: [commit: ghc] master: Build system: Correctly pass `TARGETPLATFORM` as host (16e97c1) Message-ID: <20160229124120.DA54C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/16e97c16851ccb74e9137d71f9a5c9d5971baf77/ghc >--------------------------------------------------------------- commit 16e97c16851ccb74e9137d71f9a5c9d5971baf77 Author: Nicolas Trangez Date: Mon Feb 29 11:56:33 2016 +0100 Build system: Correctly pass `TARGETPLATFORM` as host When building the bundled GMP sources, the `HOSTPLATFORM` value was passed to the `--host` flag of the `./configure` call. This is incorrect: when building a cross-compiler, e.g. a compiler targeting ARM but running on X86, the host on which GMP will run is ARM, i.e. the target platform of the compiler, and the host platform (i.e. the platform on which the compiler will run) is X86. See e.g. [1] for more information about the meaning of and relation between build, host and target. [1] https://www.gnu.org/software/autoconf/manual/ autoconf-2.65/html_node/Specifying-Target-Triplets.html Test Plan: Building ARM cross-compiler with `integer-gmp` Reviewers: thomie, gracjan, austin, erikd, Phyx, hvr, bgamari Reviewed By: erikd, bgamari Subscribers: erikd, gracjan Differential Revision: https://phabricator.haskell.org/D1960 >--------------------------------------------------------------- 16e97c16851ccb74e9137d71f9a5c9d5971baf77 libraries/integer-gmp/gmp/ghc.mk | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/libraries/integer-gmp/gmp/ghc.mk b/libraries/integer-gmp/gmp/ghc.mk index 33fab0b..8e52574 100644 --- a/libraries/integer-gmp/gmp/ghc.mk +++ b/libraries/integer-gmp/gmp/ghc.mk @@ -122,13 +122,16 @@ libraries/integer-gmp/gmp/libgmp.a libraries/integer-gmp/gmp/gmp.h: cat libraries/integer-gmp/gmp/tarball/gmp-5.0.4.patch | { cd libraries/integer-gmp/gmp/gmpbuild && $(PATCH_CMD) -p1 ; } chmod +x libraries/integer-gmp/gmp/ln + # Note: We must pass `TARGETPLATFORM` to the `--host` argument of GMP's + # `./configure`, not `HOSTPLATFORM`: the 'host' on which GMP will + # run is the 'target' platform of the compiler we're building. cd libraries/integer-gmp/gmp; (set -o igncr 2>/dev/null) && set -o igncr; export SHELLOPTS; \ PATH=`pwd`:$$PATH; \ export PATH; \ cd gmpbuild && \ CC=$(CCX) NM=$(NM) AR=$(AR_STAGE1) ./configure \ --enable-shared=no \ - --host=$(HOSTPLATFORM) --build=$(BUILDPLATFORM) + --host=$(TARGETPLATFORM) --build=$(BUILDPLATFORM) $(MAKE) -C libraries/integer-gmp/gmp/gmpbuild MAKEFLAGS= $(CP) libraries/integer-gmp/gmp/gmpbuild/gmp.h libraries/integer-gmp/gmp/ $(CP) libraries/integer-gmp/gmp/gmpbuild/.libs/libgmp.a libraries/integer-gmp/gmp/ From git at git.haskell.org Mon Feb 29 12:41:23 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 29 Feb 2016 12:41:23 +0000 (UTC) Subject: [commit: ghc] master: Refactor `warnMissingSignatures` in `RnNames.hs` (f72bdbd) Message-ID: <20160229124123.A6FA03A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f72bdbd2fd4204975eb8699cacc4310090134a9f/ghc >--------------------------------------------------------------- commit f72bdbd2fd4204975eb8699cacc4310090134a9f Author: Rik Steenkamp Date: Mon Feb 29 11:56:16 2016 +0100 Refactor `warnMissingSignatures` in `RnNames.hs` Reviewers: austin, thomie, bgamari Reviewed By: thomie, bgamari Differential Revision: https://phabricator.haskell.org/D1955 >--------------------------------------------------------------- f72bdbd2fd4204975eb8699cacc4310090134a9f compiler/rename/RnNames.hs | 101 ++++++++++++++------------------------------- 1 file changed, 32 insertions(+), 69 deletions(-) diff --git a/compiler/rename/RnNames.hs b/compiler/rename/RnNames.hs index 70f76b9..c9f916a 100644 --- a/compiler/rename/RnNames.hs +++ b/compiler/rename/RnNames.hs @@ -1568,8 +1568,8 @@ warnMissingSignatures :: TcGblEnv -> RnM () warnMissingSignatures gbl_env = do { let exports = availsToNameSet (tcg_exports gbl_env) sig_ns = tcg_sigs gbl_env - binds = tcg_binds gbl_env - ps = tcg_patsyns gbl_env + all_binds = collectHsBindsBinders $ tcg_binds gbl_env + all_ps = tcg_patsyns gbl_env -- Warn about missing signatures -- Do this only when we we have a type to offer @@ -1577,73 +1577,36 @@ warnMissingSignatures gbl_env ; warn_only_exported <- woptM Opt_WarnMissingExportedSignatures ; warn_pat_syns <- woptM Opt_WarnMissingPatternSynonymSignatures - ; let sig_warn - | warn_only_exported - = topSigWarnIfExported Opt_WarnMissingExportedSignatures - exports sig_ns - | warn_missing_sigs - = topSigWarn Opt_WarnMissingSignatures sig_ns - | warn_pat_syns - = topSigWarn Opt_WarnMissingPatternSynonymSignatures sig_ns - | otherwise - = noSigWarn - - - ; let binders = (if warn_pat_syns then ps_binders else []) - ++ (if warn_missing_sigs || warn_only_exported - then fun_binders else []) - - fun_binders = [(idType b, idName b)| b - <- collectHsBindsBinders binds] - ps_binders = [(patSynType p, patSynName p) | p <- ps] - - ; sig_warn binders } - -type SigWarn = [(Type, Name)] -> RnM () - -- Missing-signature warning - -noSigWarn :: SigWarn -noSigWarn _ = return () - -topSigWarnIfExported :: WarningFlag -> NameSet -> NameSet -> SigWarn -topSigWarnIfExported flag exported sig_ns ids - = mapM_ (topSigWarnIdIfExported flag exported sig_ns) ids - -topSigWarnIdIfExported :: WarningFlag -> NameSet -> NameSet -> (Type, Name) - -> RnM () -topSigWarnIdIfExported flag exported sig_ns (ty, name) - | name `elemNameSet` exported - = topSigWarnId flag sig_ns (ty, name) - | otherwise - = return () - -topSigWarn :: WarningFlag -> NameSet -> SigWarn -topSigWarn flag sig_ns ids = mapM_ (topSigWarnId flag sig_ns) ids - -topSigWarnId :: WarningFlag -> NameSet -> (Type, Name) -> RnM () --- The NameSet is the Ids that *lack* a signature --- We have to do it this way round because there are --- lots of top-level bindings that are generated by GHC --- and that don't have signatures -topSigWarnId flag sig_ns (ty, name) - | name `elemNameSet` sig_ns = warnMissingSig flag msg (ty, name) - | otherwise = return () - where - msg = text "Top-level binding with no type signature:" - -warnMissingSig :: WarningFlag -> SDoc -> (Type, Name) -> RnM () -warnMissingSig flag msg (ty, name) = do - tymsg <- getMsg ty - addWarnAt (Reason flag) (getSrcSpan name) (mk_msg tymsg) - where - mk_msg endmsg = sep [ msg, nest 2 $ pprPrefixName name <+> endmsg ] - - getMsg :: Type -> RnM SDoc - getMsg ty = do - { env <- tcInitTidyEnv - ; let (_, tidy_ty) = tidyOpenType env ty - ; return (dcolon <+> ppr tidy_ty) - } + ; let add_sig_warns + | warn_only_exported = add_warns Opt_WarnMissingExportedSignatures + | warn_missing_sigs = add_warns Opt_WarnMissingSignatures + | warn_pat_syns = add_warns Opt_WarnMissingPatternSynonymSignatures + | otherwise = return () + + add_warns flag + = forM_ binders + (\(name, ty) -> + do { env <- tcInitTidyEnv + ; let (_, tidy_ty) = tidyOpenType env ty + ; addWarnAt (Reason flag) (getSrcSpan name) + (get_msg name tidy_ty) }) + + binds = if warn_missing_sigs || warn_only_exported then all_binds else [] + ps = if warn_pat_syns then all_ps else [] + binders = filter pred $ + [(patSynName p, patSynType p) | p <- ps ] ++ + [(idName b, idType b) | b <- binds] + + pred (name, _) = name `elemNameSet` sig_ns + && (not warn_only_exported || name `elemNameSet` exports) + -- We use sig_ns to exclude top-level bindings that are + -- generated by GHC and that don't have signatures + + get_msg name ty + = sep [ text "Top-level binding with no type signature:", + nest 2 $ pprPrefixName name <+> dcolon <+> ppr ty ] + + ; add_sig_warns } {- Note [The ImportMap] From git at git.haskell.org Mon Feb 29 12:41:26 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 29 Feb 2016 12:41:26 +0000 (UTC) Subject: [commit: ghc] master: base: Mark Data.Type.Equality as Trustworthy (ad4428d) Message-ID: <20160229124126.63F463A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ad4428ddd33f80a883a268dc31f5a2ef68330161/ghc >--------------------------------------------------------------- commit ad4428ddd33f80a883a268dc31f5a2ef68330161 Author: Ben Gamari Date: Mon Feb 29 12:29:25 2016 +0100 base: Mark Data.Type.Equality as Trustworthy Test Plan: Validate Reviewers: austin, ekmett, hvr Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1957 GHC Trac Issues: #11625 >--------------------------------------------------------------- ad4428ddd33f80a883a268dc31f5a2ef68330161 libraries/base/Data/Type/Equality.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/libraries/base/Data/Type/Equality.hs b/libraries/base/Data/Type/Equality.hs index 1eba1cc..19c9bca 100644 --- a/libraries/base/Data/Type/Equality.hs +++ b/libraries/base/Data/Type/Equality.hs @@ -12,6 +12,7 @@ {-# LANGUAGE ExplicitNamespaces #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE Trustworthy #-} ----------------------------------------------------------------------------- -- | From git at git.haskell.org Mon Feb 29 12:41:29 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 29 Feb 2016 12:41:29 +0000 (UTC) Subject: [commit: ghc] master: DynFlags: Add -Wredundant-constraints to -Wall (2e49a31) Message-ID: <20160229124129.2938C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2e49a31658afb4f730fcfec69edfc9e785af71f4/ghc >--------------------------------------------------------------- commit 2e49a31658afb4f730fcfec69edfc9e785af71f4 Author: Ben Gamari Date: Mon Feb 29 12:28:49 2016 +0100 DynFlags: Add -Wredundant-constraints to -Wall Test Plan: It works, I promise. Reviewers: austin Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1956 GHC Trac Issues: #11370 >--------------------------------------------------------------- 2e49a31658afb4f730fcfec69edfc9e785af71f4 compiler/main/DynFlags.hs | 3 ++- testsuite/tests/typecheck/should_compile/T10632.stderr | 2 +- testsuite/tests/typecheck/should_compile/T9939.stderr | 8 ++++---- testsuite/tests/warnings/should_compile/PluralS.stderr | 4 ++-- 4 files changed, 9 insertions(+), 8 deletions(-) diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 8f9fbbb..ce51d3e 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -3887,7 +3887,8 @@ minusWallOpts Opt_WarnUnusedDoBind, Opt_WarnTrustworthySafe, Opt_WarnUntickedPromotedConstructors, - Opt_WarnMissingPatternSynonymSignatures + Opt_WarnMissingPatternSynonymSignatures, + Opt_WarnRedundantConstraints ] -- | Things you get with -Weverything, i.e. *all* known warnings flags diff --git a/testsuite/tests/typecheck/should_compile/T10632.stderr b/testsuite/tests/typecheck/should_compile/T10632.stderr index 211972d..c3d112f 100644 --- a/testsuite/tests/typecheck/should_compile/T10632.stderr +++ b/testsuite/tests/typecheck/should_compile/T10632.stderr @@ -1,5 +1,5 @@ -T10632.hs:3:1: warning: [-Wredundant-constraints] +T10632.hs:3:1: warning: [-Wredundant-constraints (in -Wall)] ? Redundant constraint: ?file1::String ? In the type signature for: f :: (?file1::String) => IO () diff --git a/testsuite/tests/typecheck/should_compile/T9939.stderr b/testsuite/tests/typecheck/should_compile/T9939.stderr index a10066b..d10c510 100644 --- a/testsuite/tests/typecheck/should_compile/T9939.stderr +++ b/testsuite/tests/typecheck/should_compile/T9939.stderr @@ -1,20 +1,20 @@ -T9939.hs:5:1: warning: [-Wredundant-constraints] +T9939.hs:5:1: warning: [-Wredundant-constraints (in -Wall)] ? Redundant constraint: Eq a ? In the type signature for: f1 :: (Eq a, Ord a) => a -> a -> Bool -T9939.hs:9:1: warning: [-Wredundant-constraints] +T9939.hs:9:1: warning: [-Wredundant-constraints (in -Wall)] ? Redundant constraint: Eq a ? In the type signature for: f2 :: (Eq a, Ord a) => a -> a -> Bool -T9939.hs:13:1: warning: [-Wredundant-constraints] +T9939.hs:13:1: warning: [-Wredundant-constraints (in -Wall)] ? Redundant constraint: Eq b ? In the type signature for: f3 :: (Eq a, a ~ b, Eq b) => a -> b -> Bool -T9939.hs:20:1: warning: [-Wredundant-constraints] +T9939.hs:20:1: warning: [-Wredundant-constraints (in -Wall)] ? Redundant constraint: Eq a ? In the type signature for: f4 :: (Eq a, Eq b) => a -> b -> Equal a b -> Bool diff --git a/testsuite/tests/warnings/should_compile/PluralS.stderr b/testsuite/tests/warnings/should_compile/PluralS.stderr index 9289a0b..4cffc15 100644 --- a/testsuite/tests/warnings/should_compile/PluralS.stderr +++ b/testsuite/tests/warnings/should_compile/PluralS.stderr @@ -15,12 +15,12 @@ PluralS.hs:17:29: warning: [-Wtype-defaults (in -Wall)] In an equation for ?defaultingNumAndShow?: defaultingNumAndShow = show 123 -PluralS.hs:23:1: warning: [-Wredundant-constraints] +PluralS.hs:23:1: warning: [-Wredundant-constraints (in -Wall)] ? Redundant constraint: Num a ? In the type signature for: redundantNum :: (Num a, Num a) => a -PluralS.hs:26:1: warning: [-Wredundant-constraints] +PluralS.hs:26:1: warning: [-Wredundant-constraints (in -Wall)] ? Redundant constraints: (Show a, Num a, Eq a, Eq a) ? In the type signature for: redundantMultiple :: (Num a, Show a, Num a, Eq a, Eq a) => a From git at git.haskell.org Mon Feb 29 13:49:42 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 29 Feb 2016 13:49:42 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Test Trac #11611 (b213a84) Message-ID: <20160229134942.DAA143A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/b213a8435e886729ddac82f541a5de4ce0e76905/ghc >--------------------------------------------------------------- commit b213a8435e886729ddac82f541a5de4ce0e76905 Author: Simon Peyton Jones Date: Fri Feb 26 17:45:18 2016 +0000 Test Trac #11611 (cherry picked from commit ef7b1d5efb17fdca14ee1269f79b9c08d4f8636f) >--------------------------------------------------------------- b213a8435e886729ddac82f541a5de4ce0e76905 testsuite/tests/polykinds/T11611.hs | 8 ++++++++ testsuite/tests/polykinds/T11611.stderr | 6 ++++++ testsuite/tests/polykinds/all.T | 1 + 3 files changed, 15 insertions(+) diff --git a/testsuite/tests/polykinds/T11611.hs b/testsuite/tests/polykinds/T11611.hs new file mode 100644 index 0000000..e4ee977 --- /dev/null +++ b/testsuite/tests/polykinds/T11611.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE DataKinds, StandaloneDeriving, TypeOperators, GADTs, FlexibleInstances #-} + +module T11611 where + +data A a where + A :: A (a:as) -> a -> A as + +deriving instance Show a => Show (A a) diff --git a/testsuite/tests/polykinds/T11611.stderr b/testsuite/tests/polykinds/T11611.stderr new file mode 100644 index 0000000..15d4749 --- /dev/null +++ b/testsuite/tests/polykinds/T11611.stderr @@ -0,0 +1,6 @@ + +T11611.hs:8:37: error: + ? Expected kind ?[*]?, but ?a? has kind ?*? + ? In the first argument of ?A?, namely ?a? + In the first argument of ?Show?, namely ?A a? + In the stand-alone deriving instance for ?Show a => Show (A a)? diff --git a/testsuite/tests/polykinds/all.T b/testsuite/tests/polykinds/all.T index 4500cfc..3a81766 100644 --- a/testsuite/tests/polykinds/all.T +++ b/testsuite/tests/polykinds/all.T @@ -141,3 +141,4 @@ test('T11516', normal, compile_fail, ['']) test('T11362', normal, compile, ['-dunique-increment=-1']) # -dunique-increment=-1 doesn't work inside the file test('T11399', normal, compile_fail, ['']) +test('T11611', normal, compile_fail, ['']) From git at git.haskell.org Mon Feb 29 13:49:45 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 29 Feb 2016 13:49:45 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: rts: drop unused global 'blackhole_queue' (0fb2d54) Message-ID: <20160229134945.892B93A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/0fb2d54f84b6597ff8a63d5490d989233084531e/ghc >--------------------------------------------------------------- commit 0fb2d54f84b6597ff8a63d5490d989233084531e Author: Sergei Trofimovich Date: Sat Feb 27 14:44:45 2016 +0000 rts: drop unused global 'blackhole_queue' Commit 5d52d9b64c21dcf77849866584744722f8121389 removed global 'blackhole_queue' in favour of new mechanism: when TSO hits blackhole TSO blocks waiting for 'MessgaeBlackhole' delivery. Patch removed unused global and updates stale comments. Noticed by Yuras Shumovich. Signed-off-by: Sergei Trofimovich Test Plan: build test Reviewers: simonmar, austin, Yuras, bgamari Reviewed By: Yuras, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1953 (cherry picked from commit 3ee4fc04322dacb66c70262a220dce0f52c29d4f) >--------------------------------------------------------------- 0fb2d54f84b6597ff8a63d5490d989233084531e includes/rts/storage/TSO.h | 2 +- includes/stg/MiscClosures.h | 1 - rts/Schedule.h | 1 - rts/sm/Storage.c | 1 - 4 files changed, 1 insertion(+), 4 deletions(-) diff --git a/includes/rts/storage/TSO.h b/includes/rts/storage/TSO.h index 744ab2b..9bddfca 100644 --- a/includes/rts/storage/TSO.h +++ b/includes/rts/storage/TSO.h @@ -230,7 +230,7 @@ void dirty_STACK (Capability *cap, StgStack *stack); ---------------------------------------------------------------------- NotBlocked END_TSO_QUEUE runnable_queue, or running - BlockedOnBlackHole the BLACKHOLE blackhole_queue + BlockedOnBlackHole MessageBlackHole * TSO->bq BlockedOnMVar the MVAR the MVAR's queue diff --git a/includes/stg/MiscClosures.h b/includes/stg/MiscClosures.h index 1236d73..6736658 100644 --- a/includes/stg/MiscClosures.h +++ b/includes/stg/MiscClosures.h @@ -463,7 +463,6 @@ extern StgWord rts_breakpoint_io_action[]; // Schedule.c extern StgWord RTS_VAR(blocked_queue_hd), RTS_VAR(blocked_queue_tl); extern StgWord RTS_VAR(sleeping_queue); -extern StgWord RTS_VAR(blackhole_queue); extern StgWord RTS_VAR(sched_mutex); // Apply.cmm diff --git a/rts/Schedule.h b/rts/Schedule.h index eb5135b..35606af 100644 --- a/rts/Schedule.h +++ b/rts/Schedule.h @@ -97,7 +97,6 @@ extern volatile StgWord recent_activity; /* Thread queues. * Locks required : sched_mutex */ -extern StgTSO *blackhole_queue; #if !defined(THREADED_RTS) extern StgTSO *blocked_queue_hd, *blocked_queue_tl; extern StgTSO *sleeping_queue; diff --git a/rts/sm/Storage.c b/rts/sm/Storage.c index 65f5b70..bfc6eb1 100644 --- a/rts/sm/Storage.c +++ b/rts/sm/Storage.c @@ -1046,7 +1046,6 @@ dirty_TVAR(Capability *cap, StgTVar *p) // Setting a TSO's link field with a write barrier. // It is *not* necessary to call this function when // * setting the link field to END_TSO_QUEUE -// * putting a TSO on the blackhole_queue // * setting the link field of the currently running TSO, as it // will already be dirty. void From git at git.haskell.org Mon Feb 29 13:49:48 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 29 Feb 2016 13:49:48 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Missing Proxy instances, make U1 instance more Proxy-like (18e5edc) Message-ID: <20160229134948.4B0B33A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/18e5edc03fa4d7a2b934179f6971c9b5e5d180d8/ghc >--------------------------------------------------------------- commit 18e5edc03fa4d7a2b934179f6971c9b5e5d180d8 Author: RyanGlScott Date: Mon Feb 29 12:28:18 2016 +0100 Missing Proxy instances, make U1 instance more Proxy-like This accomplishes three things: * Adds missing `Alternative`, `MonadPlus`, and `MonadZip` instances for `Proxy` * Adds a missing `MonadPlus` instance for `U1` * Changes several existing `U1` instances to use lazy pattern-matching, exactly how `Proxy` does it (in case we ever replace `U1` with `Proxy`). This is technically a breaking change (albeit an extremely minor one). Test Plan: ./validate Reviewers: austin, ekmett, hvr, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1962 GHC Trac Issues: #11650 (cherry picked from commit 171d95df24dc2d9d0c1a3af9e75f021438a7da50) >--------------------------------------------------------------- 18e5edc03fa4d7a2b934179f6971c9b5e5d180d8 libraries/base/Control/Monad/Zip.hs | 7 +++++++ libraries/base/Data/Foldable.hs | 18 +++++++++++++++++- libraries/base/Data/Proxy.hs | 8 ++++++++ libraries/base/Data/Traversable.hs | 11 ++++++++++- libraries/base/GHC/Generics.hs | 34 ++++++++++++++++++++++++---------- libraries/base/changelog.md | 3 +++ 6 files changed, 69 insertions(+), 12 deletions(-) diff --git a/libraries/base/Control/Monad/Zip.hs b/libraries/base/Control/Monad/Zip.hs index 771b8aa..fa44438 100644 --- a/libraries/base/Control/Monad/Zip.hs +++ b/libraries/base/Control/Monad/Zip.hs @@ -20,6 +20,7 @@ module Control.Monad.Zip where import Control.Monad (liftM, liftM2) import Data.Monoid +import Data.Proxy import GHC.Generics -- | `MonadZip` type class. Minimal definition: `mzip` or `mzipWith` @@ -78,7 +79,13 @@ instance MonadZip Last where instance MonadZip f => MonadZip (Alt f) where mzipWith f (Alt ma) (Alt mb) = Alt (mzipWith f ma mb) +instance MonadZip Proxy where + mzipWith _ _ _ = Proxy + -- Instances for GHC.Generics +instance MonadZip U1 where + mzipWith _ _ _ = U1 + instance MonadZip Par1 where mzipWith = liftM2 diff --git a/libraries/base/Data/Foldable.hs b/libraries/base/Data/Foldable.hs index 5d758ae..0defe6c 100644 --- a/libraries/base/Data/Foldable.hs +++ b/libraries/base/Data/Foldable.hs @@ -425,8 +425,24 @@ instance Ord a => Monoid (Min a) where | otherwise = Min n -- Instances for GHC.Generics +instance Foldable U1 where + foldMap _ _ = mempty + {-# INLINE foldMap #-} + fold _ = mempty + {-# INLINE fold #-} + foldr _ z _ = z + {-# INLINE foldr #-} + foldl _ z _ = z + {-# INLINE foldl #-} + foldl1 _ _ = errorWithoutStackTrace "foldl1: U1" + foldr1 _ _ = errorWithoutStackTrace "foldr1: U1" + length _ = 0 + null _ = True + elem _ _ = False + sum _ = 0 + product _ = 1 + deriving instance Foldable V1 -deriving instance Foldable U1 deriving instance Foldable Par1 deriving instance Foldable f => Foldable (Rec1 f) deriving instance Foldable (K1 i c) diff --git a/libraries/base/Data/Proxy.hs b/libraries/base/Data/Proxy.hs index 9f602ea..f0760e8 100644 --- a/libraries/base/Data/Proxy.hs +++ b/libraries/base/Data/Proxy.hs @@ -89,10 +89,18 @@ instance Applicative Proxy where _ <*> _ = Proxy {-# INLINE (<*>) #-} +instance Alternative Proxy where + empty = Proxy + {-# INLINE empty #-} + _ <|> _ = Proxy + {-# INLINE (<|>) #-} + instance Monad Proxy where _ >>= _ = Proxy {-# INLINE (>>=) #-} +instance MonadPlus Proxy + -- | 'asProxyTypeOf' is a type-restricted version of 'const'. -- 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 diff --git a/libraries/base/Data/Traversable.hs b/libraries/base/Data/Traversable.hs index c6a30d7..b903b1d 100644 --- a/libraries/base/Data/Traversable.hs +++ b/libraries/base/Data/Traversable.hs @@ -228,8 +228,17 @@ instance Traversable ZipList where traverse f (ZipList x) = ZipList <$> traverse f x -- Instances for GHC.Generics +instance Traversable U1 where + traverse _ _ = pure U1 + {-# INLINE traverse #-} + sequenceA _ = pure U1 + {-# INLINE sequenceA #-} + mapM _ _ = pure U1 + {-# INLINE mapM #-} + sequence _ = pure U1 + {-# INLINE sequence #-} + deriving instance Traversable V1 -deriving instance Traversable U1 deriving instance Traversable Par1 deriving instance Traversable f => Traversable (Rec1 f) deriving instance Traversable (K1 i c) diff --git a/libraries/base/GHC/Generics.hs b/libraries/base/GHC/Generics.hs index c6c8f63..f9a4154 100644 --- a/libraries/base/GHC/Generics.hs +++ b/libraries/base/GHC/Generics.hs @@ -712,10 +712,10 @@ import GHC.Types import GHC.Arr ( Ix ) import GHC.Base ( Alternative(..), Applicative(..), Functor(..) , Monad(..), MonadPlus(..), String ) -import GHC.Classes ( Eq, Ord ) +import GHC.Classes ( Eq(..), Ord(..) ) import GHC.Enum ( Bounded, Enum ) -import GHC.Read ( Read ) -import GHC.Show ( Show ) +import GHC.Read ( Read(..), lex, readParen ) +import GHC.Show ( Show(..), showString ) -- Needed for metadata import Data.Proxy ( Proxy(..), KProxy(..) ) @@ -736,21 +736,35 @@ deriving instance Show (V1 p) -- | Unit: used for constructors without arguments data U1 (p :: *) = U1 - deriving (Eq, Ord, Read, Show, Functor, Generic, Generic1) + deriving (Generic, Generic1) + +instance Eq (U1 p) where + _ == _ = True + +instance Ord (U1 p) where + compare _ _ = EQ + +instance Read (U1 p) where + readsPrec d = readParen (d > 10) (\r -> [(U1, s) | ("U1",s) <- lex r ]) + +instance Show (U1 p) where + showsPrec _ _ = showString "U1" + +instance Functor U1 where + fmap _ _ = U1 instance Applicative U1 where pure _ = U1 - U1 <*> U1 = U1 + _ <*> _ = U1 instance Alternative U1 where empty = U1 - U1 <|> U1 = U1 - -- The defaults will otherwise bottom; see #11650. - some U1 = U1 - many U1 = U1 + _ <|> _ = U1 instance Monad U1 where - U1 >>= _ = U1 + _ >>= _ = U1 + +instance MonadPlus U1 -- | Used for marking occurrences of the parameter newtype Par1 p = Par1 { unPar1 :: p } diff --git a/libraries/base/changelog.md b/libraries/base/changelog.md index b0ccda6..92451b9 100644 --- a/libraries/base/changelog.md +++ b/libraries/base/changelog.md @@ -49,6 +49,9 @@ `GHC.Generics` as part of making GHC generics capable of handling unlifted types (#10868) + * The `Eq`, `Ord`, `Read`, and `Show` instances for `U1` now use lazier + pattern-matching + * Keep `shift{L,R}` on `Integer` with negative shift-arguments from segfaulting (#10571) From git at git.haskell.org Mon Feb 29 13:49:50 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 29 Feb 2016 13:49:50 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: base: Mark Data.Type.Equality as Trustworthy (90d2cd7) Message-ID: <20160229134950.EF9623A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/90d2cd72927116339b6c911a2017a535167089a9/ghc >--------------------------------------------------------------- commit 90d2cd72927116339b6c911a2017a535167089a9 Author: Ben Gamari Date: Mon Feb 29 12:29:25 2016 +0100 base: Mark Data.Type.Equality as Trustworthy Test Plan: Validate Reviewers: austin, ekmett, hvr Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1957 GHC Trac Issues: #11625 (cherry picked from commit ad4428ddd33f80a883a268dc31f5a2ef68330161) >--------------------------------------------------------------- 90d2cd72927116339b6c911a2017a535167089a9 libraries/base/Data/Type/Equality.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/libraries/base/Data/Type/Equality.hs b/libraries/base/Data/Type/Equality.hs index 75d2a6c..a57b65e 100644 --- a/libraries/base/Data/Type/Equality.hs +++ b/libraries/base/Data/Type/Equality.hs @@ -12,6 +12,7 @@ {-# LANGUAGE ExplicitNamespaces #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE Trustworthy #-} ----------------------------------------------------------------------------- -- | From git at git.haskell.org Mon Feb 29 13:49:53 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 29 Feb 2016 13:49:53 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Build system: Correctly pass `TARGETPLATFORM` as host (8c04585) Message-ID: <20160229134953.AD3A63A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/8c04585babd0db54fdbbc91497d7ffcb0e0924a1/ghc >--------------------------------------------------------------- commit 8c04585babd0db54fdbbc91497d7ffcb0e0924a1 Author: Nicolas Trangez Date: Mon Feb 29 11:56:33 2016 +0100 Build system: Correctly pass `TARGETPLATFORM` as host When building the bundled GMP sources, the `HOSTPLATFORM` value was passed to the `--host` flag of the `./configure` call. This is incorrect: when building a cross-compiler, e.g. a compiler targeting ARM but running on X86, the host on which GMP will run is ARM, i.e. the target platform of the compiler, and the host platform (i.e. the platform on which the compiler will run) is X86. See e.g. [1] for more information about the meaning of and relation between build, host and target. [1] https://www.gnu.org/software/autoconf/manual/ autoconf-2.65/html_node/Specifying-Target-Triplets.html Test Plan: Building ARM cross-compiler with `integer-gmp` Reviewers: thomie, gracjan, austin, erikd, Phyx, hvr, bgamari Reviewed By: erikd, bgamari Subscribers: erikd, gracjan Differential Revision: https://phabricator.haskell.org/D1960 (cherry picked from commit 16e97c16851ccb74e9137d71f9a5c9d5971baf77) >--------------------------------------------------------------- 8c04585babd0db54fdbbc91497d7ffcb0e0924a1 libraries/integer-gmp/gmp/ghc.mk | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/libraries/integer-gmp/gmp/ghc.mk b/libraries/integer-gmp/gmp/ghc.mk index 33fab0b..8e52574 100644 --- a/libraries/integer-gmp/gmp/ghc.mk +++ b/libraries/integer-gmp/gmp/ghc.mk @@ -122,13 +122,16 @@ libraries/integer-gmp/gmp/libgmp.a libraries/integer-gmp/gmp/gmp.h: cat libraries/integer-gmp/gmp/tarball/gmp-5.0.4.patch | { cd libraries/integer-gmp/gmp/gmpbuild && $(PATCH_CMD) -p1 ; } chmod +x libraries/integer-gmp/gmp/ln + # Note: We must pass `TARGETPLATFORM` to the `--host` argument of GMP's + # `./configure`, not `HOSTPLATFORM`: the 'host' on which GMP will + # run is the 'target' platform of the compiler we're building. cd libraries/integer-gmp/gmp; (set -o igncr 2>/dev/null) && set -o igncr; export SHELLOPTS; \ PATH=`pwd`:$$PATH; \ export PATH; \ cd gmpbuild && \ CC=$(CCX) NM=$(NM) AR=$(AR_STAGE1) ./configure \ --enable-shared=no \ - --host=$(HOSTPLATFORM) --build=$(BUILDPLATFORM) + --host=$(TARGETPLATFORM) --build=$(BUILDPLATFORM) $(MAKE) -C libraries/integer-gmp/gmp/gmpbuild MAKEFLAGS= $(CP) libraries/integer-gmp/gmp/gmpbuild/gmp.h libraries/integer-gmp/gmp/ $(CP) libraries/integer-gmp/gmp/gmpbuild/.libs/libgmp.a libraries/integer-gmp/gmp/ From git at git.haskell.org Mon Feb 29 13:49:56 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 29 Feb 2016 13:49:56 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: DynFlags: Add -Wredundant-constraints to -Wall (0af2be8) Message-ID: <20160229134956.73E043A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/0af2be84e1e31c4131d8547852de29a2c3cdafe0/ghc >--------------------------------------------------------------- commit 0af2be84e1e31c4131d8547852de29a2c3cdafe0 Author: Ben Gamari Date: Mon Feb 29 12:28:49 2016 +0100 DynFlags: Add -Wredundant-constraints to -Wall Test Plan: It works, I promise. Reviewers: austin Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1956 GHC Trac Issues: #11370 (cherry picked from commit 2e49a31658afb4f730fcfec69edfc9e785af71f4) >--------------------------------------------------------------- 0af2be84e1e31c4131d8547852de29a2c3cdafe0 compiler/main/DynFlags.hs | 3 ++- testsuite/tests/typecheck/should_compile/T10632.stderr | 2 +- testsuite/tests/typecheck/should_compile/T9939.stderr | 8 ++++---- testsuite/tests/warnings/should_compile/PluralS.stderr | 4 ++-- 4 files changed, 9 insertions(+), 8 deletions(-) diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index c2ad3f9..0a54834 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -3867,7 +3867,8 @@ minusWallOpts Opt_WarnUnusedDoBind, Opt_WarnTrustworthySafe, Opt_WarnUntickedPromotedConstructors, - Opt_WarnMissingPatternSynonymSignatures + Opt_WarnMissingPatternSynonymSignatures, + Opt_WarnRedundantConstraints ] -- | Things you get with -Weverything, i.e. *all* known warnings flags diff --git a/testsuite/tests/typecheck/should_compile/T10632.stderr b/testsuite/tests/typecheck/should_compile/T10632.stderr index 211972d..c3d112f 100644 --- a/testsuite/tests/typecheck/should_compile/T10632.stderr +++ b/testsuite/tests/typecheck/should_compile/T10632.stderr @@ -1,5 +1,5 @@ -T10632.hs:3:1: warning: [-Wredundant-constraints] +T10632.hs:3:1: warning: [-Wredundant-constraints (in -Wall)] ? Redundant constraint: ?file1::String ? In the type signature for: f :: (?file1::String) => IO () diff --git a/testsuite/tests/typecheck/should_compile/T9939.stderr b/testsuite/tests/typecheck/should_compile/T9939.stderr index a10066b..d10c510 100644 --- a/testsuite/tests/typecheck/should_compile/T9939.stderr +++ b/testsuite/tests/typecheck/should_compile/T9939.stderr @@ -1,20 +1,20 @@ -T9939.hs:5:1: warning: [-Wredundant-constraints] +T9939.hs:5:1: warning: [-Wredundant-constraints (in -Wall)] ? Redundant constraint: Eq a ? In the type signature for: f1 :: (Eq a, Ord a) => a -> a -> Bool -T9939.hs:9:1: warning: [-Wredundant-constraints] +T9939.hs:9:1: warning: [-Wredundant-constraints (in -Wall)] ? Redundant constraint: Eq a ? In the type signature for: f2 :: (Eq a, Ord a) => a -> a -> Bool -T9939.hs:13:1: warning: [-Wredundant-constraints] +T9939.hs:13:1: warning: [-Wredundant-constraints (in -Wall)] ? Redundant constraint: Eq b ? In the type signature for: f3 :: (Eq a, a ~ b, Eq b) => a -> b -> Bool -T9939.hs:20:1: warning: [-Wredundant-constraints] +T9939.hs:20:1: warning: [-Wredundant-constraints (in -Wall)] ? Redundant constraint: Eq a ? In the type signature for: f4 :: (Eq a, Eq b) => a -> b -> Equal a b -> Bool diff --git a/testsuite/tests/warnings/should_compile/PluralS.stderr b/testsuite/tests/warnings/should_compile/PluralS.stderr index 9289a0b..4cffc15 100644 --- a/testsuite/tests/warnings/should_compile/PluralS.stderr +++ b/testsuite/tests/warnings/should_compile/PluralS.stderr @@ -15,12 +15,12 @@ PluralS.hs:17:29: warning: [-Wtype-defaults (in -Wall)] In an equation for ?defaultingNumAndShow?: defaultingNumAndShow = show 123 -PluralS.hs:23:1: warning: [-Wredundant-constraints] +PluralS.hs:23:1: warning: [-Wredundant-constraints (in -Wall)] ? Redundant constraint: Num a ? In the type signature for: redundantNum :: (Num a, Num a) => a -PluralS.hs:26:1: warning: [-Wredundant-constraints] +PluralS.hs:26:1: warning: [-Wredundant-constraints (in -Wall)] ? Redundant constraints: (Show a, Num a, Eq a, Eq a) ? In the type signature for: redundantMultiple :: (Num a, Show a, Num a, Eq a, Eq a) => a From git at git.haskell.org Mon Feb 29 14:48:49 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 29 Feb 2016 14:48:49 +0000 (UTC) Subject: [commit: ghc] master: Testsuite: check actual_prof_file only when needed (e3b9dbf) Message-ID: <20160229144849.AAFE83A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e3b9dbf48c7b7b1ac4a5d6ecf1411469b5f7666c/ghc >--------------------------------------------------------------- commit e3b9dbf48c7b7b1ac4a5d6ecf1411469b5f7666c Author: Thomas Miedema Date: Fri Feb 26 11:23:28 2016 +0100 Testsuite: check actual_prof_file only when needed Might be a little faster. Avoids testing for #6113 (.prof file not written when process is killed with any signal but SIGINT) for tests that don't have a .prof.sample file (which is almost all of them) when running the profiling ways. Tests that were failing because of #6113: T8089, overflow1, overflow2 and overflow3. >--------------------------------------------------------------- e3b9dbf48c7b7b1ac4a5d6ecf1411469b5f7666c testsuite/driver/testlib.py | 21 +++++++++++---------- 1 file changed, 11 insertions(+), 10 deletions(-) diff --git a/testsuite/driver/testlib.py b/testsuite/driver/testlib.py index 2a9f141..0e2ba49 100644 --- a/testsuite/driver/testlib.py +++ b/testsuite/driver/testlib.py @@ -1576,6 +1576,14 @@ def check_hp_ok(name): return(False) def check_prof_ok(name, way): + (_, expected_prof_file) = find_expected_file(name, 'prof.sample') + expected_prof_path = in_testdir(expected_prof_file) + + # Check actual prof file only if we have an expected prof file to + # compare it with. + if not os.path.exists(expected_prof_path): + return True + actual_prof_file = add_suffix(name, 'prof') actual_prof_path = in_testdir(actual_prof_file) @@ -1587,16 +1595,9 @@ def check_prof_ok(name, way): print(actual_prof_path + " is empty") return(False) - (_, expected_prof_file) = find_expected_file(name, 'prof.sample') - expected_prof_path = in_testdir(expected_prof_file) - - # sample prof file is not required - if not os.path.exists(expected_prof_path): - return True - else: - return compare_outputs(way, 'prof', normalise_prof, - expected_prof_file, actual_prof_file, - whitespace_normaliser=normalise_whitespace) + return compare_outputs(way, 'prof', normalise_prof, + expected_prof_file, actual_prof_file, + whitespace_normaliser=normalise_whitespace) # Compare expected output to actual output, and optionally accept the # new output. Returns true if output matched or was accepted, false From git at git.haskell.org Mon Feb 29 14:48:52 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 29 Feb 2016 14:48:52 +0000 (UTC) Subject: [commit: ghc] master: Remove some more Windows line endings [skip ci] (de01de7) Message-ID: <20160229144852.7B0BC3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/de01de736ec927b4a3a77395e830c796b1bfb3cd/ghc >--------------------------------------------------------------- commit de01de736ec927b4a3a77395e830c796b1bfb3cd Author: Thomas Miedema Date: Tue Feb 23 04:43:58 2016 +0100 Remove some more Windows line endings [skip ci] >--------------------------------------------------------------- de01de736ec927b4a3a77395e830c796b1bfb3cd testsuite/tests/ghci/scripts/T9367.hs | 2 ++ testsuite/tests/indexed-types/should_fail/T9357.stderr | 0 testsuite/tests/typecheck/should_compile/PolyRec.hs | 0 testsuite/tests/typecheck/should_fail/T11541.stderr | 0 4 files changed, 2 insertions(+) diff --git a/testsuite/tests/ghci/scripts/T9367.hs b/testsuite/tests/ghci/scripts/T9367.hs index 0f24fa4..4ad8699 100644 --- a/testsuite/tests/ghci/scripts/T9367.hs +++ b/testsuite/tests/ghci/scripts/T9367.hs @@ -1,2 +1,4 @@ x = "abc" main = print x +-- This file has Windows line endings (CRLF) on purpose. Do not remove. +-- See #9367. From git at git.haskell.org Mon Feb 29 14:48:55 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 29 Feb 2016 14:48:55 +0000 (UTC) Subject: [commit: ghc] master: Only add -fshow-warning-groups for ghc >= 7.11 (#10752) (f8a5dd0) Message-ID: <20160229144855.463FD3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f8a5dd05ed50fe46eb86f30dc12f4c341b980e61/ghc >--------------------------------------------------------------- commit f8a5dd05ed50fe46eb86f30dc12f4c341b980e61 Author: Thomas Miedema Date: Mon Feb 29 13:49:05 2016 +0100 Only add -fshow-warning-groups for ghc >= 7.11 (#10752) >--------------------------------------------------------------- f8a5dd05ed50fe46eb86f30dc12f4c341b980e61 testsuite/mk/test.mk | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/testsuite/mk/test.mk b/testsuite/mk/test.mk index 97ceb39..6d9a4c2 100644 --- a/testsuite/mk/test.mk +++ b/testsuite/mk/test.mk @@ -34,7 +34,7 @@ endif # TEST_HC_OPTS is passed to every invocation of TEST_HC # in nested Makefiles -TEST_HC_OPTS = -fforce-recomp -dcore-lint -dcmm-lint -dno-debug-output -fshow-warning-groups -no-user-$(GhcPackageDbFlag) -rtsopts $(EXTRA_HC_OPTS) +TEST_HC_OPTS = -fforce-recomp -dcore-lint -dcmm-lint -dno-debug-output -no-user-$(GhcPackageDbFlag) -rtsopts $(EXTRA_HC_OPTS) # The warning suppression flag below is a temporary kludge. While working with # tests that contain tabs, please de-tab them so this flag can be eventually @@ -48,6 +48,7 @@ ifeq "$(MinGhcVersion711)" "YES" # Don't warn about missing specialisations. They can only occur with `-O`, but # we want tests to produce the same output for all test ways. TEST_HC_OPTS += -fno-warn-missed-specialisations +TEST_HC_OPTS += -fshow-warning-groups endif RUNTEST_OPTS = From git at git.haskell.org Mon Feb 29 14:48:57 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 29 Feb 2016 14:48:57 +0000 (UTC) Subject: [commit: ghc] master: Skip TEST=TcCoercibleFail when compiler_debugged (49c55e6) Message-ID: <20160229144857.F28783A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/49c55e68aae9841c166430ae566b0d9bdc03c99d/ghc >--------------------------------------------------------------- commit 49c55e68aae9841c166430ae566b0d9bdc03c99d Author: Thomas Miedema Date: Mon Feb 29 13:59:48 2016 +0100 Skip TEST=TcCoercibleFail when compiler_debugged >--------------------------------------------------------------- 49c55e68aae9841c166430ae566b0d9bdc03c99d testsuite/tests/typecheck/should_fail/all.T | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T index cb0f9fb..485ac2f 100644 --- a/testsuite/tests/typecheck/should_fail/all.T +++ b/testsuite/tests/typecheck/should_fail/all.T @@ -327,7 +327,11 @@ test('T7989', normal, compile_fail, ['']) test('T8034', normal, compile_fail, ['']) test('T8142', normal, compile_fail, ['']) test('T8262', normal, compile_fail, ['']) -test('TcCoercibleFail', [], compile_fail, ['']) + +# TcCoercibleFail times out with the compiler is compiled with -DDEBUG. +# This is expected (see comment in source file). +test('TcCoercibleFail', [when(compiler_debugged(), skip)], compile_fail, ['']) + test('TcCoercibleFail2', [], compile_fail, ['']) test('TcCoercibleFail3', [], compile_fail, ['']) test('T8306', normal, compile_fail, ['']) From git at git.haskell.org Mon Feb 29 19:48:38 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 29 Feb 2016 19:48:38 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: HsPat: Restore compatibility with ghc-7.8 (b7a2d22) Message-ID: <20160229194838.87E0C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/b7a2d22901c991d1754741b1518f0ed1afb98eb2/ghc >--------------------------------------------------------------- commit b7a2d22901c991d1754741b1518f0ed1afb98eb2 Author: Ben Gamari Date: Mon Feb 29 20:36:50 2016 +0100 HsPat: Restore compatibility with ghc-7.8 >--------------------------------------------------------------- b7a2d22901c991d1754741b1518f0ed1afb98eb2 compiler/hsSyn/HsPat.hs | 2 ++ compiler/typecheck/TcGenDeriv.hs | 2 ++ compiler/typecheck/TcPatSyn.hs | 1 + 3 files changed, 5 insertions(+) diff --git a/compiler/hsSyn/HsPat.hs b/compiler/hsSyn/HsPat.hs index 36c4faf..82aeb69 100644 --- a/compiler/hsSyn/HsPat.hs +++ b/compiler/hsSyn/HsPat.hs @@ -63,6 +63,8 @@ import DynFlags( gopt, GeneralFlag(..) ) import Maybes -- libraries: import Data.Data hiding (TyCon,Fixity) +import Data.Traversable (Traversable) +import Data.Foldable (Foldable) type InPat id = LPat id -- No 'Out' constructors type OutPat id = LPat id -- No 'In' constructors diff --git a/compiler/typecheck/TcGenDeriv.hs b/compiler/typecheck/TcGenDeriv.hs index c572b31..f9c368e 100644 --- a/compiler/typecheck/TcGenDeriv.hs +++ b/compiler/typecheck/TcGenDeriv.hs @@ -74,6 +74,8 @@ import StaticFlags( opt_PprStyle_Debug ) import ListSetOps ( assocMaybe ) import Data.List ( partition, intersperse ) import Data.Maybe ( catMaybes, isJust ) +import Data.Traversable ( mapM ) +import Prelude hiding (mapM) type BagDerivStuff = Bag DerivStuff diff --git a/compiler/typecheck/TcPatSyn.hs b/compiler/typecheck/TcPatSyn.hs index 425e203..b1f1ac8 100644 --- a/compiler/typecheck/TcPatSyn.hs +++ b/compiler/typecheck/TcPatSyn.hs @@ -51,6 +51,7 @@ import Data.Maybe import Control.Monad ( unless, zipWithM ) import Data.List( partition ) import Pair( Pair(..) ) +import Data.Traversable( traverse ) #include "HsVersions.h" From git at git.haskell.org Mon Feb 29 22:34:06 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 29 Feb 2016 22:34:06 +0000 (UTC) Subject: [commit: ghc] branch 'wip/rwbarton-tiny-tables' created Message-ID: <20160229223406.766C33A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/rwbarton-tiny-tables Referencing: 0fd5db798e31912f335e4553e939e1e783284495 From git at git.haskell.org Mon Feb 29 22:34:09 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 29 Feb 2016 22:34:09 +0000 (UTC) Subject: [commit: ghc] wip/rwbarton-tiny-tables: Experiment with one-byte info tables (0fd5db7) Message-ID: <20160229223409.38F293A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rwbarton-tiny-tables Link : http://ghc.haskell.org/trac/ghc/changeset/0fd5db798e31912f335e4553e939e1e783284495/ghc >--------------------------------------------------------------- commit 0fd5db798e31912f335e4553e939e1e783284495 Author: Reid Barton Date: Mon Feb 29 17:35:43 2016 -0500 Experiment with one-byte info tables >--------------------------------------------------------------- 0fd5db798e31912f335e4553e939e1e783284495 compiler/cmm/CmmInfo.hs | 12 +++++++++++- compiler/nativeGen/X86/Ppr.hs | 5 +++++ includes/rts/storage/ClosureMacros.h | 15 +++++++++++++++ rts/ThreadPaused.c | 8 ++++++++ rts/sm/Scav.c | 20 ++++++++++++++++++++ 5 files changed, 59 insertions(+), 1 deletion(-) diff --git a/compiler/cmm/CmmInfo.hs b/compiler/cmm/CmmInfo.hs index b9981f2..299f7bb 100644 --- a/compiler/cmm/CmmInfo.hs +++ b/compiler/cmm/CmmInfo.hs @@ -194,7 +194,11 @@ mkInfoTableContents dflags | null liveness_data = rET_SMALL -- Fits in extra_bits | otherwise = rET_BIG -- Does not; extra_bits is -- a label - ; return (prof_data ++ liveness_data, (std_info, srt_label)) } + mb_tiny_liveness = mkTinyLivenessBits frame + ; case (prof_data, liveness_data, srt_label, rts_tag == rET_SMALL, + srt_bitmap == toStgHalfWord dflags 0, mb_tiny_liveness) of + ([], [], [], True, True, Just b) -> return ([], ([b], [])) + _ -> return (prof_data ++ liveness_data, (std_info, srt_label)) } | HeapRep _ ptrs nonptrs closure_type <- smrep = do { let layout = packIntsCLit dflags ptrs nonptrs @@ -317,6 +321,12 @@ makeRelativeRefTo _ _ lit = lit -- The head of the stack layout is the top of the stack and -- the least-significant bit. +mkTinyLivenessBits :: Liveness -> Maybe CmmLit +mkTinyLivenessBits liveness + | length liveness > 7 = Nothing + | otherwise = Just (CmmInt b W8) + where b = foldr (.|.) 0 [ 1 `shiftL` n | (True,n) <- zip (liveness ++ [True]) [0..] ] + mkLivenessBits :: DynFlags -> Liveness -> UniqSM (CmmLit, [RawCmmDecl]) -- ^ Returns: -- 1. The bitmap (literal value or label) diff --git a/compiler/nativeGen/X86/Ppr.hs b/compiler/nativeGen/X86/Ppr.hs index 7809ae1..b5111a1 100644 --- a/compiler/nativeGen/X86/Ppr.hs +++ b/compiler/nativeGen/X86/Ppr.hs @@ -108,6 +108,11 @@ pprBasicBlock info_env (BasicBlock blockid instrs) asmLbl = mkAsmTempLabel (getUnique blockid) maybe_infotable = case mapLookup blockid info_env of Nothing -> empty + Just (Statics info_lbl [b8@(CmmStaticLit (CmmInt _ W8))]) -> + text ".align 2" $$ -- XXX Needs to be adjusted for darwin + infoTableLoc $$ + pprData b8 $$ + pprLabel info_lbl Just (Statics info_lbl info) -> pprAlignForSection Text $$ infoTableLoc $$ diff --git a/includes/rts/storage/ClosureMacros.h b/includes/rts/storage/ClosureMacros.h index d534873..a5966ab 100644 --- a/includes/rts/storage/ClosureMacros.h +++ b/includes/rts/storage/ClosureMacros.h @@ -415,11 +415,26 @@ EXTERN_INLINE nat closure_sizeW (StgClosure *p) Sizes of stack frames -------------------------------------------------------------------------- */ +INLINE_HEADER StgWord tiny_bitmap_size(uint8_t liveness) +{ + StgWord bitmap_size = 0; + // XXX use a table or instruction? + while (liveness > 1) { + bitmap_size++; + liveness = liveness >> 1; + } + return bitmap_size; +} + EXTERN_INLINE StgWord stack_frame_sizeW( StgClosure *frame ); EXTERN_INLINE StgWord stack_frame_sizeW( StgClosure *frame ) { StgRetInfoTable *info; + if (*(P_)frame & 1) { + return 1 + tiny_bitmap_size(*(*(uint8_t **)frame - 1)); + } + info = get_ret_itbl(frame); switch (info->i.type) { diff --git a/rts/ThreadPaused.c b/rts/ThreadPaused.c index 1f1d0af..e0e616a 100644 --- a/rts/ThreadPaused.c +++ b/rts/ThreadPaused.c @@ -219,6 +219,14 @@ threadPaused(Capability *cap, StgTSO *tso) frame = (StgClosure *)tso->stackobj->sp; while ((P_)frame < stack_end) { + if (*(P_)frame & 1) { + nat frame_size = stack_frame_sizeW(frame); + weight_pending += frame_size; + frame = (StgClosure *)((StgPtr)frame + frame_size); + prev_was_update_frame = rtsFalse; + continue; + } + info = get_ret_itbl(frame); switch (info->i.type) { diff --git a/rts/sm/Scav.c b/rts/sm/Scav.c index 953f055..b678374 100644 --- a/rts/sm/Scav.c +++ b/rts/sm/Scav.c @@ -174,6 +174,19 @@ static StgPtr scavenge_mut_arr_ptrs_marked (StgMutArrPtrs *a) } STATIC_INLINE StgPtr +scavenge_tiny_bitmap (StgPtr p, uint8_t layout) +{ + while (layout > 1) { + if ((layout & 1) == 0) { + evacuate((StgClosure **)p); + } + p++; + layout = layout >> 1; + } + return p; +} + +STATIC_INLINE StgPtr scavenge_small_bitmap (StgPtr p, StgWord size, StgWord bitmap) { while (size > 0) { @@ -1807,6 +1820,13 @@ scavenge_stack(StgPtr p, StgPtr stack_end) */ while (p < stack_end) { + if (*p & 1) { + // Tiny liveness layout: no SRT + uint8_t liveness = *((uint8_t *)(*p) - 1); + p = scavenge_tiny_bitmap(p+1, liveness); + continue; + } + info = get_ret_itbl((StgClosure *)p); switch (info->i.type) {