From git at git.haskell.org Wed Nov 1 17:00:13 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 1 Nov 2017 17:00:13 +0000 (UTC) Subject: [commit: ghc] wip/T14068: Prevent inlining of loopified programs (cec4ce2) Message-ID: <20171101170013.C4FE13A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14068 Link : http://ghc.haskell.org/trac/ghc/changeset/cec4ce21a05ae083150998cdfb31f12701424d9c/ghc >--------------------------------------------------------------- commit cec4ce21a05ae083150998cdfb31f12701424d9c Author: Joachim Breitner Date: Fri Aug 4 15:34:11 2017 -0400 Prevent inlining of loopified programs Previously, a recursive function is not inlineable. After loopification, it turns into a non-recursive function, and suddenly it is. While this is in general desirable, it has many knock-on effects, which makes it hard to evaluate and debug loopification. Therefore, this commit (tries to) prevent this inlining. When this results in no unfixable regressions, then we can tackle the next step. It is surprisingly hard to reliably prevent inlining, it seems, so I have been playing whack-a-mole a bit: * simpl_binds has two copies of the ids around, one in the env and one in the AST. If maybeLoopify changes only one of them, then things go wrong. Worked-around that for now, but probably not ideal. TODO: Apply maybeLoopify before entering simplTopBinds * Also, worker-wrapper needs to preserve the no-inlining better. >--------------------------------------------------------------- cec4ce21a05ae083150998cdfb31f12701424d9c compiler/coreSyn/CoreOpt.hs | 8 +++++++- compiler/simplCore/Simplify.hs | 4 +++- compiler/stranal/WorkWrap.hs | 1 + 3 files changed, 11 insertions(+), 2 deletions(-) diff --git a/compiler/coreSyn/CoreOpt.hs b/compiler/coreSyn/CoreOpt.hs index 605a679..550a0a7 100644 --- a/compiler/coreSyn/CoreOpt.hs +++ b/compiler/coreSyn/CoreOpt.hs @@ -673,8 +673,14 @@ loopificationJoinPointBinding_maybe bndr rhs zapFragileIdInfo $ localiseId $ bndr + -- RULES etc stay with bindr' - bndr' = zapIdTailCallInfo bndr + -- Also, previously, the function was recursive, and hence not inlineable. + -- To tread with caution, let's keep it this way + bndr' = (`setIdUnfolding` noUnfolding) $ + (`setInlinePragma` neverInlinePragma) $ + zapIdTailCallInfo $ + bndr in Just (bndr', join_bndr, mkLams bndrs body) | otherwise diff --git a/compiler/simplCore/Simplify.hs b/compiler/simplCore/Simplify.hs index 7eaf96a..6e75a80 100644 --- a/compiler/simplCore/Simplify.hs +++ b/compiler/simplCore/Simplify.hs @@ -145,7 +145,9 @@ simplTopBinds env0 binds0 ; return (float `addFloats` floats, env2) } simpl_bind env bind | Just bind' <- maybeLoopify bind - = simpl_bind env bind' + = do -- update the env, as maybeLoopify changes the id info + env1 <- simplRecBndrs env (bindersOf bind') + simpl_bind env1 bind' simpl_bind env (Rec pairs) = simplRecBind env TopLevel Nothing pairs simpl_bind env (NonRec b r) = do { (env', b') <- addBndrRules env b (lookupRecBndr env b) ; simplRecOrTopPair env' TopLevel diff --git a/compiler/stranal/WorkWrap.hs b/compiler/stranal/WorkWrap.hs index ac8798e..49045d9 100644 --- a/compiler/stranal/WorkWrap.hs +++ b/compiler/stranal/WorkWrap.hs @@ -479,6 +479,7 @@ splitFun dflags fam_envs fn_id fn_info wrap_dmds res_info rhs work_act = case work_inline of -- See Note [Activation for workers] NoInline -> inl_act inl_prag + NoUserInline | isNeverActive (inl_act inl_prag) -> inl_act inl_prag _ -> wrap_act work_prag = InlinePragma { inl_src = SourceText "{-# INLINE" , inl_inline = work_inline From git at git.haskell.org Wed Nov 1 17:06:45 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 1 Nov 2017 17:06:45 +0000 (UTC) Subject: [commit: ghc] wip/T14068: simplTopBinds: Call maybeLoopify before simplRecBndrs (294a175) Message-ID: <20171101170645.624B33A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14068 Link : http://ghc.haskell.org/trac/ghc/changeset/294a175d4e3a78b9e6630725e2ffc44a1a5883fe/ghc >--------------------------------------------------------------- commit 294a175d4e3a78b9e6630725e2ffc44a1a5883fe Author: Joachim Breitner Date: Wed Nov 1 13:05:59 2017 -0400 simplTopBinds: Call maybeLoopify before simplRecBndrs so that the post-loopified binder ends up in the SimplEnv >--------------------------------------------------------------- 294a175d4e3a78b9e6630725e2ffc44a1a5883fe compiler/simplCore/Simplify.hs | 9 +++------ 1 file changed, 3 insertions(+), 6 deletions(-) diff --git a/compiler/simplCore/Simplify.hs b/compiler/simplCore/Simplify.hs index 6e75a80..532b7ee 100644 --- a/compiler/simplCore/Simplify.hs +++ b/compiler/simplCore/Simplify.hs @@ -129,11 +129,12 @@ simplTopBinds env0 binds0 -- anything into scope, then we don't get a complaint about that. -- It's rather as if the top-level binders were imported. -- See note [Glomming] in OccurAnal. - ; env1 <- simplRecBndrs env0 (bindersOfBinds binds0) - ; (floats, env2) <- simpl_binds env1 binds0 + ; env1 <- simplRecBndrs env0 (bindersOfBinds binds1) + ; (floats, env2) <- simpl_binds env1 binds1 ; freeTick SimplifierDone ; return (floats, env2) } where + binds1 = [ maybeLoopify bind `orElse` bind | bind <- binds0 ] -- We need to track the zapped top-level binders, because -- they should have their fragile IdInfo zapped (notably occurrence info) -- That's why we run down binds and bndrs' simultaneously. @@ -144,10 +145,6 @@ simplTopBinds env0 binds0 ; (floats, env2) <- simpl_binds env1 binds ; return (float `addFloats` floats, env2) } - simpl_bind env bind | Just bind' <- maybeLoopify bind - = do -- update the env, as maybeLoopify changes the id info - env1 <- simplRecBndrs env (bindersOf bind') - simpl_bind env1 bind' simpl_bind env (Rec pairs) = simplRecBind env TopLevel Nothing pairs simpl_bind env (NonRec b r) = do { (env', b') <- addBndrRules env b (lookupRecBndr env b) ; simplRecOrTopPair env' TopLevel From git at git.haskell.org Thu Nov 2 15:48:10 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 2 Nov 2017 15:48:10 +0000 (UTC) Subject: [commit: ghc] branch 'wip/D4145' created Message-ID: <20171102154810.4F5123A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/D4145 Referencing: 44406d3ffd0a6a8bc706ca5492632ff4122ce8f9 From git at git.haskell.org Thu Nov 2 15:48:13 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 2 Nov 2017 15:48:13 +0000 (UTC) Subject: [commit: ghc] wip/D4145: CmmSink: Use a IntSet instead of a list (44406d3) Message-ID: <20171102154813.159623A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/D4145 Link : http://ghc.haskell.org/trac/ghc/changeset/44406d3ffd0a6a8bc706ca5492632ff4122ce8f9/ghc >--------------------------------------------------------------- commit 44406d3ffd0a6a8bc706ca5492632ff4122ce8f9 Author: alexbiehl Date: Thu Nov 2 11:47:32 2017 -0400 CmmSink: Use a IntSet instead of a list CmmProcs which have *lots* of local variables take a considerable amount of time in CmmSink. This was noticed by @tdammers in #7258 while compiling files with large records (~200-400 fields). Before: ``` Sun Oct 29 19:58 2017 Time and Allocation Profiling Report (Final) ghc-stage2 +RTS -p -RTS -B/Users/alexbiehl/git/ghc/inplace/lib /Users/alexbiehl/Downloads/W2.hs -fforce-recomp -O2 total time = 26.00 secs (25996 ticks @ 1000 us, 1 processor) total alloc = 14,921,627,912 bytes (excludes profiling overheads) COST CENTRE MODULE SRC %time %alloc sink CmmPipeline compiler/cmm/CmmPipeline.hs:(104,13)-(105,59) 55.7 15.9 SimplTopBinds SimplCore compiler/simplCore/SimplCore.hs:761:39-74 19.5 30.6 FloatOutwards SimplCore compiler/simplCore/SimplCore.hs:471:40-66 4.2 9.0 RegAlloc-linear AsmCodeGen compiler/nativeGen/AsmCodeGen.hs:(658,27)-(660,55) 4.0 11.1 pprNativeCode AsmCodeGen compiler/nativeGen/AsmCodeGen.hs:(529,37)-(530,65) 2.8 6.3 NewStranal SimplCore compiler/simplCore/SimplCore.hs:480:40-63 1.6 3.7 OccAnal SimplCore compiler/simplCore/SimplCore.hs:(739,22)-(740,67) 1.5 3.5 StgCmm HscMain compiler/main/HscMain.hs:(1426,13)-(1427,62) 1.2 2.4 regLiveness AsmCodeGen compiler/nativeGen/AsmCodeGen.hs:(591,17)-(593,52) 1.2 1.9 genMachCode AsmCodeGen compiler/nativeGen/AsmCodeGen.hs:(580,17)-(582,62) 0.9 1.8 NativeCodeGen CodeOutput compiler/main/CodeOutput.hs:171:18-78 0.9 2.1 CoreTidy HscMain compiler/main/HscMain.hs:1253:27-67 0.8 1.9 ``` After: ``` Sun Oct 29 19:18 2017 Time and Allocation Profiling Report (Final) ghc-stage2 +RTS -p -RTS -B/Users/alexbiehl/git/ghc/inplace/lib /Users/alexbiehl/Downloads/W2.hs -fforce-recomp -O2 total time = 13.31 secs (13307 ticks @ 1000 us, 1 processor) total alloc = 15,772,184,488 bytes (excludes profiling overheads) COST CENTRE MODULE SRC %time %alloc SimplTopBinds SimplCore compiler/simplCore/SimplCore.hs:761:39-74 38.3 29.0 sink CmmPipeline compiler/cmm/CmmPipeline.hs:(104,13)-(105,59) 13.2 20.3 RegAlloc-linear AsmCodeGen compiler/nativeGen/AsmCodeGen.hs:(658,27)-(660,55) 8.3 10.5 FloatOutwards SimplCore compiler/simplCore/SimplCore.hs:471:40-66 8.1 8.5 pprNativeCode AsmCodeGen compiler/nativeGen/AsmCodeGen.hs:(529,37)-(530,65) 5.4 5.9 NewStranal SimplCore compiler/simplCore/SimplCore.hs:480:40-63 3.1 3.5 OccAnal SimplCore compiler/simplCore/SimplCore.hs:(739,22)-(740,67) 2.9 3.3 StgCmm HscMain compiler/main/HscMain.hs:(1426,13)-(1427,62) 2.3 2.3 regLiveness AsmCodeGen compiler/nativeGen/AsmCodeGen.hs:(591,17)-(593,52) 2.1 1.8 NativeCodeGen CodeOutput compiler/main/CodeOutput.hs:171:18-78 1.7 2.0 genMachCode AsmCodeGen compiler/nativeGen/AsmCodeGen.hs:(580,17)-(582,62) 1.6 1.7 CoreTidy HscMain compiler/main/HscMain.hs:1253:27-67 1.4 1.8 foldNodesBwdOO Hoopl.Dataflow compiler/cmm/Hoopl/Dataflow.hs:(397,1)-(403,17) 1.1 0.8 ``` Reviewers: austin, bgamari, simonmar Subscribers: duog, rwbarton, thomie, tdammers GHC Trac Issues: #7258 Differential Revision: https://phabricator.haskell.org/D4145 >--------------------------------------------------------------- 44406d3ffd0a6a8bc706ca5492632ff4122ce8f9 compiler/cmm/CmmSink.hs | 32 +++++++++++++++++++++++++------- 1 file changed, 25 insertions(+), 7 deletions(-) diff --git a/compiler/cmm/CmmSink.hs b/compiler/cmm/CmmSink.hs index a674e54..3633ed3 100644 --- a/compiler/cmm/CmmSink.hs +++ b/compiler/cmm/CmmSink.hs @@ -17,13 +17,31 @@ import CodeGen.Platform import Platform (isARM, platformArch) import DynFlags +import Unique import UniqFM import PprCmm () +import qualified Data.IntSet as IntSet import Data.List (partition) import qualified Data.Set as Set import Data.Maybe +-- Compact sets for membership tests of local variables. + +type LRegSet = IntSet.IntSet + +emptyLRegSet :: LRegSet +emptyLRegSet = IntSet.empty + +nullLRegSet :: LRegSet -> Bool +nullLRegSet = IntSet.null + +insertLRegSet :: LocalReg -> LRegSet -> LRegSet +insertLRegSet l = IntSet.insert (getKey (getUnique l)) + +elemLRegSet :: LocalReg -> LRegSet -> Bool +elemLRegSet l = IntSet.member (getKey (getUnique l)) + -- ----------------------------------------------------------------------------- -- Sinking and inlining @@ -399,7 +417,7 @@ tryToInline , Assignments -- Remaining assignments ) -tryToInline dflags live node assigs = go usages node [] assigs +tryToInline dflags live node assigs = go usages node emptyLRegSet assigs where usages :: UniqFM Int -- Maps each LocalReg to a count of how often it is used usages = foldLocalRegsUsed dflags addUsage emptyUFM node @@ -422,7 +440,7 @@ tryToInline dflags live node assigs = go usages node [] assigs inline_and_keep = keep inl_node -- inline the assignment, keep it keep node' = (final_node, a : rest') - where (final_node, rest') = go usages' node' (l:skipped) rest + where (final_node, rest') = go usages' node' (insertLRegSet l skipped) rest usages' = foldLocalRegsUsed dflags (\m r -> addToUFM m r 2) usages rhs -- we must not inline anything that is mentioned in the RHS @@ -430,7 +448,7 @@ tryToInline dflags live node assigs = go usages node [] assigs -- usages of the regs on the RHS to 2. cannot_inline = skipped `regsUsedIn` rhs -- Note [dependent assignments] - || l `elem` skipped + || l `elemLRegSet` skipped || not (okToInline dflags rhs node) l_usages = lookupUFM usages l @@ -521,11 +539,11 @@ And we do that right here in tryToInline, just as we do cmmMachOpFold. addUsage :: UniqFM Int -> LocalReg -> UniqFM Int addUsage m r = addToUFM_C (+) m r 1 -regsUsedIn :: [LocalReg] -> CmmExpr -> Bool -regsUsedIn [] _ = False +regsUsedIn :: LRegSet -> CmmExpr -> Bool +regsUsedIn ls _ | nullLRegSet ls = False regsUsedIn ls e = wrapRecExpf f e False - where f (CmmReg (CmmLocal l)) _ | l `elem` ls = True - f (CmmRegOff (CmmLocal l) _) _ | l `elem` ls = True + where f (CmmReg (CmmLocal l)) _ | l `elemLRegSet` ls = True + f (CmmRegOff (CmmLocal l) _) _ | l `elemLRegSet` ls = True f _ z = z -- we don't inline into CmmUnsafeForeignCall if the expression refers From git at git.haskell.org Thu Nov 2 17:30:52 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 2 Nov 2017 17:30:52 +0000 (UTC) Subject: [commit: ghc] master: Implement the EmptyDataDeriving proposal (1317ba6) Message-ID: <20171102173052.129D13A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1317ba625d40fbd51cb0538b3fde28f412f30c01/ghc >--------------------------------------------------------------- commit 1317ba625d40fbd51cb0538b3fde28f412f30c01 Author: Ryan Scott Date: Thu Nov 2 11:52:50 2017 -0400 Implement the EmptyDataDeriving proposal This implements the `EmptyDataDeriving` proposal put forth in https://github.com/ghc-proposals/ghc-proposals/blob/dbf51608/proposals/0006-deriving-empty.rst. This has two major changes: * The introduction of an `EmptyDataDeriving` extension, which permits directly deriving `Eq`, `Ord`, `Read`, and `Show` instances for empty data types. * An overhaul in the code that is emitted in derived instances for empty data types. To see an overview of the changes brought forth, refer to the changes to the 8.4.1 release notes. Test Plan: ./validate Reviewers: bgamari, dfeuer, austin, hvr, goldfire Reviewed By: bgamari Subscribers: rwbarton, thomie GHC Trac Issues: #7401, #10577, #13117 Differential Revision: https://phabricator.haskell.org/D4047 >--------------------------------------------------------------- 1317ba625d40fbd51cb0538b3fde28f412f30c01 compiler/main/DynFlags.hs | 1 + compiler/main/ErrUtils.hs | 6 +- compiler/typecheck/TcDerivUtils.hs | 15 +- compiler/typecheck/TcGenDeriv.hs | 61 ++--- docs/users_guide/8.4.1-notes.rst | 134 +++++++++-- docs/users_guide/glasgow_exts.rst | 52 +++++ libraries/base/Data/Void.hs | 33 +-- libraries/base/GHC/Generics.hs | 15 +- .../ghc-boot-th/GHC/LanguageExtensions/Type.hs | 1 + .../deriving/should_compile/drv-empty-data.stderr | 250 ++++++++++++++++++++- testsuite/tests/deriving/should_fail/T7401_fail.hs | 3 + .../tests/deriving/should_fail/T7401_fail.stderr | 6 + testsuite/tests/deriving/should_fail/all.T | 1 + testsuite/tests/deriving/should_run/T5628.stderr | 3 - .../tests/deriving/should_run/T5628.stdout | 0 testsuite/tests/deriving/should_run/T7401.hs | 20 ++ .../tests/deriving/should_run/T7401.stdout | 1 + testsuite/tests/deriving/should_run/all.T | 3 +- testsuite/tests/driver/T4437.hs | 3 +- 19 files changed, 512 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 1317ba625d40fbd51cb0538b3fde28f412f30c01 From git at git.haskell.org Thu Nov 2 17:30:54 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 2 Nov 2017 17:30:54 +0000 (UTC) Subject: [commit: ghc] master: PPC NCG: Impl branch prediction, atomic ops. (1130c67) Message-ID: <20171102173054.CEB4A3A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1130c67bbb6dc06f513e5c8705a488a591fabadb/ghc >--------------------------------------------------------------- commit 1130c67bbb6dc06f513e5c8705a488a591fabadb Author: Peter Trommler Date: Thu Nov 2 11:57:05 2017 -0400 PPC NCG: Impl branch prediction, atomic ops. Implement AtomicRMW ops, atomic read, atomic write in PowerPC native code generator. Also implement branch prediction because we need it in atomic ops anyway. This patch improves the issue in #12537 a bit but does not fix it entirely. The fallback operations for atomicread and atomicwrite in libraries/ghc-prim/cbits/atomic.c are incorrect. This patch avoids those functions by implementing the operations directly in the native code generator. This is also what the x86/amd64 NCG and the LLVM backend do. Test Plan: validate on AIX and PowerPC (32-bit) Linux Reviewers: erikd, hvr, austin, bgamari, simonmar Reviewed By: hvr, bgamari Subscribers: rwbarton, thomie GHC Trac Issues: #12537 Differential Revision: https://phabricator.haskell.org/D3984 >--------------------------------------------------------------- 1130c67bbb6dc06f513e5c8705a488a591fabadb compiler/nativeGen/PPC/CodeGen.hs | 149 ++++++++++++++++++++++++++++++-------- compiler/nativeGen/PPC/Instr.hs | 51 ++++++++----- compiler/nativeGen/PPC/Ppr.hs | 62 +++++++++++++--- 3 files changed, 201 insertions(+), 61 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 1130c67bbb6dc06f513e5c8705a488a591fabadb From git at git.haskell.org Thu Nov 2 17:30:58 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 2 Nov 2017 17:30:58 +0000 (UTC) Subject: [commit: ghc] master: Implement the basics of hex floating point literals (b0b80e9) Message-ID: <20171102173058.D162F3A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b0b80e90c0382a6cdb61c96c860feac27482d6e8/ghc >--------------------------------------------------------------- commit b0b80e90c0382a6cdb61c96c860feac27482d6e8 Author: Iavor Diatchki Date: Thu Nov 2 12:02:22 2017 -0400 Implement the basics of hex floating point literals Implement hexadecmial floating point literals. The digits of the mantissa are hexadecimal. The exponent is written in base 10, and the base for the exponentiation is 2. Hexadecimal literals look a lot like ordinary decimal literals, except that they use hexadecmial digits, and the exponent is written using `p` rather than `e`. The specification of the feature is available here: https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0004-hexFloats.rst For a discussion of the various choices: https://github.com/ghc-proposals/ghc-proposals/pull/37 Reviewers: mpickering, goldfire, austin, bgamari, hvr Reviewed By: bgamari Subscribers: mpickering, thomie Differential Revision: https://phabricator.haskell.org/D3066 >--------------------------------------------------------------- b0b80e90c0382a6cdb61c96c860feac27482d6e8 compiler/main/DynFlags.hs | 1 + compiler/parser/Lexer.x | 26 ++++++++-- compiler/utils/Util.hs | 59 +++++++++++++++++++++- docs/users_guide/8.4.1-notes.rst | 5 ++ docs/users_guide/glasgow_exts.rst | 44 ++++++++++++++++ libraries/base/Numeric.hs | 48 ++++++++++++++++++ libraries/base/changelog.md | 2 + .../ghc-boot-th/GHC/LanguageExtensions/Type.hs | 1 + testsuite/tests/driver/T4437.hs | 3 +- .../tests/parser/should_run/HexFloatLiterals.hs | 16 ++++++ .../parser/should_run/HexFloatLiterals.stdout | 4 ++ testsuite/tests/parser/should_run/all.T | 1 + 12 files changed, 203 insertions(+), 7 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc b0b80e90c0382a6cdb61c96c860feac27482d6e8 From git at git.haskell.org Thu Nov 2 17:31:01 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 2 Nov 2017 17:31:01 +0000 (UTC) Subject: [commit: ghc] master: Use proper Unique for Name (e0df569) Message-ID: <20171102173101.9C75B3A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e0df569f7619dbef266139b9a6fa3ee9f632ea6e/ghc >--------------------------------------------------------------- commit e0df569f7619dbef266139b9a6fa3ee9f632ea6e Author: alexbiehl Date: Thu Nov 2 12:06:21 2017 -0400 Use proper Unique for Name I noticed this while tinkering in haddock. This might be a relict from ancient times where newtypes wouldn't optimize well. Reviewers: austin, bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie Differential Revision: https://phabricator.haskell.org/D4146 >--------------------------------------------------------------- e0df569f7619dbef266139b9a6fa3ee9f632ea6e compiler/basicTypes/Name.hs | 23 +++++++++++------------ 1 file changed, 11 insertions(+), 12 deletions(-) diff --git a/compiler/basicTypes/Name.hs b/compiler/basicTypes/Name.hs index 2e35290..637fc69 100644 --- a/compiler/basicTypes/Name.hs +++ b/compiler/basicTypes/Name.hs @@ -109,7 +109,7 @@ import Data.Data data Name = Name { n_sort :: NameSort, -- What sort of name it is n_occ :: !OccName, -- Its occurrence name - n_uniq :: {-# UNPACK #-} !Int, + n_uniq :: {-# UNPACK #-} !Unique, n_loc :: !SrcSpan -- Definition site } @@ -198,7 +198,7 @@ nameModule :: Name -> Module nameSrcLoc :: Name -> SrcLoc nameSrcSpan :: Name -> SrcSpan -nameUnique name = mkUniqueGrimily (n_uniq name) +nameUnique name = n_uniq name nameOccName name = n_occ name nameSrcLoc name = srcSpanStart (n_loc name) nameSrcSpan name = n_loc name @@ -334,7 +334,7 @@ isSystemName _ = False -- | Create a name which is (for now at least) local to the current module and hence -- does not need a 'Module' to disambiguate it from other 'Name's mkInternalName :: Unique -> OccName -> SrcSpan -> Name -mkInternalName uniq occ loc = Name { n_uniq = getKey uniq +mkInternalName uniq occ loc = Name { n_uniq = uniq , n_sort = Internal , n_occ = occ , n_loc = loc } @@ -349,12 +349,12 @@ mkInternalName uniq occ loc = Name { n_uniq = getKey uniq mkClonedInternalName :: Unique -> Name -> Name mkClonedInternalName uniq (Name { n_occ = occ, n_loc = loc }) - = Name { n_uniq = getKey uniq, n_sort = Internal + = Name { n_uniq = uniq, n_sort = Internal , n_occ = occ, n_loc = loc } mkDerivedInternalName :: (OccName -> OccName) -> Unique -> Name -> Name mkDerivedInternalName derive_occ uniq (Name { n_occ = occ, n_loc = loc }) - = Name { n_uniq = getKey uniq, n_sort = Internal + = Name { n_uniq = uniq, n_sort = Internal , n_occ = derive_occ occ, n_loc = loc } -- | Create a name which definitely originates in the given module @@ -363,13 +363,13 @@ mkExternalName :: Unique -> Module -> OccName -> SrcSpan -> Name -- (see Note [The Name Cache] in IfaceEnv), so don't just call mkExternalName -- with some fresh unique without populating the Name Cache mkExternalName uniq mod occ loc - = Name { n_uniq = getKey uniq, n_sort = External mod, + = Name { n_uniq = uniq, n_sort = External mod, n_occ = occ, n_loc = loc } -- | Create a name which is actually defined by the compiler itself mkWiredInName :: Module -> OccName -> Unique -> TyThing -> BuiltInSyntax -> Name mkWiredInName mod occ uniq thing built_in - = Name { n_uniq = getKey uniq, + = Name { n_uniq = uniq, n_sort = WiredIn mod thing built_in, n_occ = occ, n_loc = wiredInSrcSpan } @@ -378,7 +378,7 @@ mkSystemName :: Unique -> OccName -> Name mkSystemName uniq occ = mkSystemNameAt uniq occ noSrcSpan mkSystemNameAt :: Unique -> OccName -> SrcSpan -> Name -mkSystemNameAt uniq occ loc = Name { n_uniq = getKey uniq, n_sort = System +mkSystemNameAt uniq occ loc = Name { n_uniq = uniq, n_sort = System , n_occ = occ, n_loc = loc } mkSystemVarName :: Unique -> FastString -> Name @@ -396,7 +396,7 @@ mkFCallName uniq str = mkInternalName uniq (mkVarOcc str) noSrcSpan -- able to change a Name's Unique to match the cached -- one in the thing it's the name of. If you know what I mean. setNameUnique :: Name -> Unique -> Name -setNameUnique name uniq = name {n_uniq = getKey uniq} +setNameUnique name uniq = name {n_uniq = uniq} -- This is used for hsigs: we want to use the name of the originally exported -- entity, but edit the location to refer to the reexport site @@ -435,7 +435,7 @@ mkLocalisedOccName this_mod mk_occ name = mk_occ origin (nameOccName name) -} cmpName :: Name -> Name -> Ordering -cmpName n1 n2 = n_uniq n1 `compare` n_uniq n2 +cmpName n1 n2 = n_uniq n1 `nonDetCmpUnique` n_uniq n2 -- | Compare Names lexicographically -- This only works for Names that originate in the source code or have been @@ -527,14 +527,13 @@ instance OutputableBndr Name where pprPrefixOcc = pprPrefixName pprName :: Name -> SDoc -pprName (Name {n_sort = sort, n_uniq = u, n_occ = occ}) +pprName (Name {n_sort = sort, n_uniq = uniq, n_occ = occ}) = getPprStyle $ \ sty -> case sort of WiredIn mod _ builtin -> pprExternal sty uniq mod occ True builtin External mod -> pprExternal sty uniq mod occ False UserSyntax System -> pprSystem sty uniq occ Internal -> pprInternal sty uniq occ - where uniq = mkUniqueGrimily u pprExternal :: PprStyle -> Unique -> Module -> OccName -> Bool -> BuiltInSyntax -> SDoc pprExternal sty uniq mod occ is_wired is_builtin From git at git.haskell.org Thu Nov 2 17:31:04 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 2 Nov 2017 17:31:04 +0000 (UTC) Subject: [commit: ghc] master: TcRnDriver: Bracket family instance consistency output in -ddump-rn-trace (36f0cb7) Message-ID: <20171102173104.5CDBB3A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/36f0cb74c5f7a0a8f3d164e580f293fa07106064/ghc >--------------------------------------------------------------- commit 36f0cb74c5f7a0a8f3d164e580f293fa07106064 Author: Ben Gamari Date: Thu Nov 2 12:07:50 2017 -0400 TcRnDriver: Bracket family instance consistency output in -ddump-rn-trace Reviewers: austin Subscribers: rwbarton, thomie Differential Revision: https://phabricator.haskell.org/D4141 >--------------------------------------------------------------- 36f0cb74c5f7a0a8f3d164e580f293fa07106064 compiler/typecheck/TcRnDriver.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/compiler/typecheck/TcRnDriver.hs b/compiler/typecheck/TcRnDriver.hs index 105f884..fd63eff 100644 --- a/compiler/typecheck/TcRnDriver.hs +++ b/compiler/typecheck/TcRnDriver.hs @@ -366,11 +366,12 @@ tcRnImports hsc_env import_decls -- Check type-family consistency between imports. -- See Note [The type family instance consistency story] - ; traceRn "rn1: checking family instance consistency" empty + ; traceRn "rn1: checking family instance consistency {" empty ; let { dir_imp_mods = moduleEnvKeys . imp_mods $ imports } ; tcg_env <- checkFamInstConsistency dir_imp_mods ; + ; traceRn "rn1: } checking family instance consistency" empty ; return tcg_env } } From git at git.haskell.org Thu Nov 2 17:31:07 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 2 Nov 2017 17:31:07 +0000 (UTC) Subject: [commit: ghc] master: Add custom exception for fixIO (b938576) Message-ID: <20171102173107.5A1853A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b938576d151731b85314987fc550c17cfe824178/ghc >--------------------------------------------------------------- commit b938576d151731b85314987fc550c17cfe824178 Author: David Feuer Date: Thu Nov 2 12:06:56 2017 -0400 Add custom exception for fixIO Traditionally, `fixIO f` throws `BlockedIndefinitelyOnMVar` if `f` is strict. This is not particularly friendly, since the `MVar` in question is just part of the way `fixIO` happens to be implemented. Instead, throw a new `FixIOException` with a better explanation of the problem. Reviewers: austin, hvr, bgamari Subscribers: rwbarton, thomie GHC Trac Issues: #14356 Differential Revision: https://phabricator.haskell.org/D4113 >--------------------------------------------------------------- b938576d151731b85314987fc550c17cfe824178 libraries/base/Control/Exception/Base.hs | 1 + libraries/base/GHC/IO/Exception.hs | 10 ++++++++++ libraries/base/System/IO.hs | 7 ++++++- testsuite/tests/mdo/should_fail/mdofail006.stderr | 2 +- testsuite/tests/typecheck/should_compile/holes2.stderr | 2 +- 5 files changed, 19 insertions(+), 3 deletions(-) diff --git a/libraries/base/Control/Exception/Base.hs b/libraries/base/Control/Exception/Base.hs index a15cc8e..d443159 100644 --- a/libraries/base/Control/Exception/Base.hs +++ b/libraries/base/Control/Exception/Base.hs @@ -30,6 +30,7 @@ module Control.Exception.Base ( NonTermination(..), NestedAtomically(..), BlockedIndefinitelyOnMVar(..), + FixIOException (..), BlockedIndefinitelyOnSTM(..), AllocationLimitExceeded(..), CompactionFailed(..), diff --git a/libraries/base/GHC/IO/Exception.hs b/libraries/base/GHC/IO/Exception.hs index 9203f46..020bc06 100644 --- a/libraries/base/GHC/IO/Exception.hs +++ b/libraries/base/GHC/IO/Exception.hs @@ -33,6 +33,7 @@ module GHC.IO.Exception ( ArrayException(..), ExitCode(..), + FixIOException (..), ioException, ioError, @@ -268,6 +269,15 @@ instance Show ArrayException where . (if not (null s) then showString ": " . showString s else id) +-- | @since TODO +data FixIOException = FixIOException + +-- | @since TODO +instance Exception FixIOException + +instance Show FixIOException where + showsPrec _ FixIOException = showString "cyclic evaluation in fixIO" + -- ----------------------------------------------------------------------------- -- The ExitCode type diff --git a/libraries/base/System/IO.hs b/libraries/base/System/IO.hs index fde5bb6..6881724 100644 --- a/libraries/base/System/IO.hs +++ b/libraries/base/System/IO.hs @@ -400,10 +400,15 @@ withBinaryFile name mode = bracket (openBinaryFile name mode) hClose -- --------------------------------------------------------------------------- -- fixIO +-- | The implementation of 'mfix' for 'IO'. If the function passed +-- to 'fixIO' inspects its argument, the resulting action will throw +-- 'FixIOException'. fixIO :: (a -> IO a) -> IO a fixIO k = do m <- newEmptyMVar - ans <- unsafeDupableInterleaveIO (readMVar m) + ans <- unsafeDupableInterleaveIO + (readMVar m `catch` \BlockedIndefinitelyOnMVar -> + throwIO FixIOException) result <- k ans putMVar m result return result diff --git a/testsuite/tests/mdo/should_fail/mdofail006.stderr b/testsuite/tests/mdo/should_fail/mdofail006.stderr index ea186c0..e2cf503 100644 --- a/testsuite/tests/mdo/should_fail/mdofail006.stderr +++ b/testsuite/tests/mdo/should_fail/mdofail006.stderr @@ -1 +1 @@ -mdofail006: thread blocked indefinitely in an MVar operation +mdofail006: cyclic evaluation in fixIO diff --git a/testsuite/tests/typecheck/should_compile/holes2.stderr b/testsuite/tests/typecheck/should_compile/holes2.stderr index d7484fa..fd3073d 100644 --- a/testsuite/tests/typecheck/should_compile/holes2.stderr +++ b/testsuite/tests/typecheck/should_compile/holes2.stderr @@ -9,7 +9,7 @@ holes2.hs:3:5: warning: [-Wdeferred-type-errors (in -Wdefault)] instance Show Ordering -- Defined in ‘GHC.Show’ instance Show Integer -- Defined in ‘GHC.Show’ ...plus 23 others - ...plus 61 instances involving out-of-scope types + ...plus 62 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 _ From git at git.haskell.org Thu Nov 2 21:04:12 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 2 Nov 2017 21:04:12 +0000 (UTC) Subject: [commit: ghc] master: Fix atomicread/write operations (bd765f4) Message-ID: <20171102210412.3E2073A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/bd765f4b1332b3d2a7908de3f9ff1d50da0e0b1d/ghc >--------------------------------------------------------------- commit bd765f4b1332b3d2a7908de3f9ff1d50da0e0b1d Author: Peter Trommler Date: Thu Nov 2 13:34:41 2017 -0400 Fix atomicread/write operations In `libraries/ghc-prim/cbits/atomic.c` no barriers were issued for atomic read and write operations. Starting with gcc 4.7 compiler intrinsics are offered. The atomic intrinisics are also available in clang. Use these to implement `hs_atomicread*` and `hs_atomicwrite`. Test Plan: validate on OSX and Windows Reviewers: austin, bgamari, simonmar, hvr, erikd, dfeuer Reviewed By: bgamari Subscribers: dfeuer, rwbarton, thomie GHC Trac Issues: #14244 Differential Revision: https://phabricator.haskell.org/D4009 >--------------------------------------------------------------- bd765f4b1332b3d2a7908de3f9ff1d50da0e0b1d libraries/ghc-prim/cbits/atomic.c | 22 ++++++++++++++-------- 1 file changed, 14 insertions(+), 8 deletions(-) diff --git a/libraries/ghc-prim/cbits/atomic.c b/libraries/ghc-prim/cbits/atomic.c index 2ecbf34..b091d22 100644 --- a/libraries/ghc-prim/cbits/atomic.c +++ b/libraries/ghc-prim/cbits/atomic.c @@ -260,61 +260,67 @@ hs_cmpxchg64(StgWord x, StgWord64 old, StgWord64 new) #endif // AtomicReadByteArrayOp_Int +// Implies a full memory barrier (see compiler/prelude/primops.txt.pp) +// __ATOMIC_SEQ_CST: Full barrier in both directions (hoisting and sinking +// of code) and synchronizes with acquire loads and release stores in +// all threads. extern StgWord hs_atomicread8(StgWord x); StgWord hs_atomicread8(StgWord x) { - return *(volatile StgWord8 *) x; + return __atomic_load_n((StgWord8 *) x, __ATOMIC_SEQ_CST); } extern StgWord hs_atomicread16(StgWord x); StgWord hs_atomicread16(StgWord x) { - return *(volatile StgWord16 *) x; + return __atomic_load_n((StgWord16 *) x, __ATOMIC_SEQ_CST); } extern StgWord hs_atomicread32(StgWord x); StgWord hs_atomicread32(StgWord x) { - return *(volatile StgWord32 *) x; + return __atomic_load_n((StgWord32 *) x, __ATOMIC_SEQ_CST); } extern StgWord64 hs_atomicread64(StgWord x); StgWord64 hs_atomicread64(StgWord x) { - return *(volatile StgWord64 *) x; + return __atomic_load_n((StgWord64 *) x, __ATOMIC_SEQ_CST); } // AtomicWriteByteArrayOp_Int +// Implies a full memory barrier (see compiler/prelude/primops.txt.pp) +// __ATOMIC_SEQ_CST: Full barrier (see hs_atomicread8 above). extern void hs_atomicwrite8(StgWord x, StgWord val); void hs_atomicwrite8(StgWord x, StgWord val) { - *(volatile StgWord8 *) x = (StgWord8) val; + __atomic_store_n((StgWord8 *) x, (StgWord8) val, __ATOMIC_SEQ_CST); } extern void hs_atomicwrite16(StgWord x, StgWord val); void hs_atomicwrite16(StgWord x, StgWord val) { - *(volatile StgWord16 *) x = (StgWord16) val; + __atomic_store_n((StgWord16 *) x, (StgWord16) val, __ATOMIC_SEQ_CST); } extern void hs_atomicwrite32(StgWord x, StgWord val); void hs_atomicwrite32(StgWord x, StgWord val) { - *(volatile StgWord32 *) x = (StgWord32) val; + __atomic_store_n((StgWord32 *) x, (StgWord32) val, __ATOMIC_SEQ_CST); } extern void hs_atomicwrite64(StgWord x, StgWord64 val); void hs_atomicwrite64(StgWord x, StgWord64 val) { - *(volatile StgWord64 *) x = (StgWord64) val; + __atomic_store_n((StgWord64 *) x, (StgWord64) val, __ATOMIC_SEQ_CST); } From git at git.haskell.org Thu Nov 2 21:04:15 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 2 Nov 2017 21:04:15 +0000 (UTC) Subject: [commit: ghc] master: Introduce -dsuppress-stg-free-vars flag (cbd6a4d) Message-ID: <20171102210415.029DF3A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/cbd6a4d05bf382641b108347218dfd534dc57558/ghc >--------------------------------------------------------------- commit cbd6a4d05bf382641b108347218dfd534dc57558 Author: Ben Gamari Date: Thu Nov 2 13:32:21 2017 -0400 Introduce -dsuppress-stg-free-vars flag This breaks out control over STG free variable list output from -dppr-debug into its own distinct flag. This makes it more discoverable and easier to change independently from other dump output. Test Plan: Validate Reviewers: austin Subscribers: rwbarton, thomie Differential Revision: https://phabricator.haskell.org/D4140 >--------------------------------------------------------------- cbd6a4d05bf382641b108347218dfd534dc57558 compiler/main/DynFlags.hs | 3 +++ compiler/stgSyn/StgSyn.hs | 9 ++++++--- docs/users_guide/debugging.rst | 12 ++++++++++++ testsuite/tests/simplCore/should_compile/noinline01.stderr | 8 ++++---- 4 files changed, 25 insertions(+), 7 deletions(-) diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 904257e..a421284 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -563,6 +563,7 @@ data GeneralFlag -- Except for uniques, as some simplifier phases introduce new -- variables that have otherwise identical names. | Opt_SuppressUniques + | Opt_SuppressStgFreeVars | Opt_SuppressTicks -- Replaces Opt_PprShowTicks -- temporary flags @@ -2916,6 +2917,7 @@ dynamic_flags_deps = [ setGeneralFlag Opt_SuppressTypeApplications setGeneralFlag Opt_SuppressIdInfo setGeneralFlag Opt_SuppressTicks + setGeneralFlag Opt_SuppressStgFreeVars setGeneralFlag Opt_SuppressTypeSignatures) ------ Debugging ---------------------------------------------------- @@ -3689,6 +3691,7 @@ dFlagsDeps = [ depFlagSpec' "ppr-ticks" Opt_PprShowTicks (\turn_on -> useInstead "-d" "suppress-ticks" (not turn_on)), flagSpec "suppress-ticks" Opt_SuppressTicks, + flagSpec "suppress-stg-free-vars" Opt_SuppressStgFreeVars, flagSpec "suppress-coercions" Opt_SuppressCoercions, flagSpec "suppress-idinfo" Opt_SuppressIdInfo, flagSpec "suppress-unfoldings" Opt_SuppressUnfoldings, diff --git a/compiler/stgSyn/StgSyn.hs b/compiler/stgSyn/StgSyn.hs index b31a8fc..330e2b4 100644 --- a/compiler/stgSyn/StgSyn.hs +++ b/compiler/stgSyn/StgSyn.hs @@ -803,9 +803,11 @@ pprStgRhs :: (OutputableBndr bndr, Outputable bdee, Ord bdee) -- special case pprStgRhs (StgRhsClosure cc bi [free_var] upd_flag [{-no args-}] (StgApp func [])) - = hsep [ ppr cc, + = sdocWithDynFlags $ \dflags -> + hsep [ ppr cc, pp_binder_info bi, - brackets (whenPprDebug (ppr free_var)), + if not $ gopt Opt_SuppressStgFreeVars dflags + then brackets (ppr free_var) else empty, text " \\", ppr upd_flag, ptext (sLit " [] "), ppr func ] -- general case @@ -813,7 +815,8 @@ pprStgRhs (StgRhsClosure cc bi free_vars upd_flag args body) = sdocWithDynFlags $ \dflags -> hang (hsep [if gopt Opt_SccProfilingOn dflags then ppr cc else empty, pp_binder_info bi, - whenPprDebug (brackets (interppSP free_vars)), + if not $ gopt Opt_SuppressStgFreeVars dflags + then brackets (interppSP free_vars) else empty, char '\\' <> ppr upd_flag, brackets (interppSP args)]) 4 (ppr body) diff --git a/docs/users_guide/debugging.rst b/docs/users_guide/debugging.rst index 4e071a2..0d3872e 100644 --- a/docs/users_guide/debugging.rst +++ b/docs/users_guide/debugging.rst @@ -659,6 +659,18 @@ parts that you are not interested in. Suppress the printing of type coercions. +.. ghc-flag:: -dsuppress-var-kinds + :shortdesc: Suppress the printing of variable kinds + :type: dynamic + + Suppress the printing of variable kinds + +.. ghc-flag:: -dsuppress-stg-free-vars + :shortdesc: Suppress the printing of closure free variable lists in STG output + :type: dynamic + + Suppress the printing of closure free variable lists in STG output + .. _checking-consistency: diff --git a/testsuite/tests/simplCore/should_compile/noinline01.stderr b/testsuite/tests/simplCore/should_compile/noinline01.stderr index 1bb98e5..53db7da 100644 --- a/testsuite/tests/simplCore/should_compile/noinline01.stderr +++ b/testsuite/tests/simplCore/should_compile/noinline01.stderr @@ -3,11 +3,11 @@ Noinline01.f [InlPrag=INLINE (sat-args=1)] :: forall p. p -> GHC.Types.Bool [GblId, Arity=1, Caf=NoCafRefs, Str=, Unf=OtherCon []] = - \r [eta] GHC.Types.True []; + [] \r [eta] GHC.Types.True []; Noinline01.g :: GHC.Types.Bool [GblId] = - \u [] Noinline01.f GHC.Types.False; + [] \u [] Noinline01.f GHC.Types.False; Noinline01.$trModule4 :: GHC.Prim.Addr# [GblId, Caf=NoCafRefs, Unf=OtherCon []] = @@ -36,11 +36,11 @@ Noinline01.$trModule :: GHC.Types.Module Noinline01.f [InlPrag=INLINE (sat-args=1)] :: forall p. p -> GHC.Types.Bool [GblId, Arity=1, Caf=NoCafRefs, Str=, Unf=OtherCon []] = - \r [eta] GHC.Types.True []; + [] \r [eta] GHC.Types.True []; Noinline01.g :: GHC.Types.Bool [GblId] = - \u [] Noinline01.f GHC.Types.False; + [] \u [] Noinline01.f GHC.Types.False; Noinline01.$trModule4 :: GHC.Prim.Addr# [GblId, Caf=NoCafRefs, Unf=OtherCon []] = From git at git.haskell.org Thu Nov 2 21:04:18 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 2 Nov 2017 21:04:18 +0000 (UTC) Subject: [commit: ghc] master: Revert "Move check-ppr and check-api-annotations to testsuite/utils" (d9b6015) Message-ID: <20171102210418.5F8F13A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d9b6015d1942aa176e85bb71f34200bab54e1c9c/ghc >--------------------------------------------------------------- commit d9b6015d1942aa176e85bb71f34200bab54e1c9c Author: Ben Gamari Date: Thu Nov 2 14:35:01 2017 -0400 Revert "Move check-ppr and check-api-annotations to testsuite/utils" Unfortunately this (ironically) ended up breaking bindist testing since we didn't have a package-data.mk. Unfortunately there is no easy way to fix this. This reverts commit 1e9f90af7311c33de0f7f5b7dba594725596d675. >--------------------------------------------------------------- d9b6015d1942aa176e85bb71f34200bab54e1c9c .gitignore | 1 - Makefile | 10 ++----- ghc.mk | 34 ++++------------------ testsuite/utils/check-api-annotations/ghc.mk | 20 ------------- testsuite/utils/check-ppr/ghc.mk | 20 ------------- .../utils => utils}/check-api-annotations/Main.hs | 0 .../utils => utils}/check-api-annotations/README | 0 .../check-api-annotations.cabal | 0 {driver => utils/check-api-annotations}/ghc.mk | 16 ++++------ {testsuite/utils => utils}/check-ppr/Main.hs | 0 {testsuite/utils => utils}/check-ppr/README | 0 .../utils => utils}/check-ppr/check-ppr.cabal | 0 {driver => utils/check-ppr}/ghc.mk | 16 ++++------ 13 files changed, 21 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 d9b6015d1942aa176e85bb71f34200bab54e1c9c From git at git.haskell.org Thu Nov 2 23:16:34 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 2 Nov 2017 23:16:34 +0000 (UTC) Subject: [commit: ghc] master: rts/PrimOps.cmm: add declaration for heapOverflow closure (51321cf) Message-ID: <20171102231634.7599F3A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/51321cf2eb3b8d7cc525f26808f1340f5f8fd565/ghc >--------------------------------------------------------------- commit 51321cf2eb3b8d7cc525f26808f1340f5f8fd565 Author: Sergei Trofimovich Date: Thu Nov 2 23:07:57 2017 +0000 rts/PrimOps.cmm: add declaration for heapOverflow closure Before the change UNREG ghc build failed as: ``` rts_dist_HC rts/dist/build/PrimOps.o /tmp/ghc2370_0/ghc_4.hc: In function 'stg_newByteArrayzh': /tmp/ghc2370_0/ghc_4.hc:26:13: error: error: 'base_GHCziIOziException_heapOverflow_closure' undeclared (first use in this function) R1.w = (W_)&base_GHCziIOziException_heapOverflow_closure; ^~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ | 26 | R1.w = (W_)&base_GHCziIOziException_heapOverflow_closure; | ^ ``` It's an UNREG-specific failure because C backend always requires declarations to be known. Added missing declaration. Signed-off-by: Sergei Trofimovich >--------------------------------------------------------------- 51321cf2eb3b8d7cc525f26808f1340f5f8fd565 rts/PrimOps.cmm | 1 + 1 file changed, 1 insertion(+) diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm index ca519b6..467353a 100644 --- a/rts/PrimOps.cmm +++ b/rts/PrimOps.cmm @@ -30,6 +30,7 @@ import pthread_mutex_lock; import pthread_mutex_unlock; #endif import CLOSURE base_ControlziExceptionziBase_nestedAtomically_closure; +import CLOSURE base_GHCziIOziException_heapOverflow_closure; import EnterCriticalSection; import LeaveCriticalSection; import CLOSURE ghczmprim_GHCziTypes_False_closure; From git at git.haskell.org Fri Nov 3 00:16:07 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 3 Nov 2017 00:16:07 +0000 (UTC) Subject: [commit: ghc] master: llvmGen: Pass vector arguments in vector registers by default (15f788f) Message-ID: <20171103001607.C23CA3A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/15f788f5e5096641245a4f060600a6db9cbc2c4e/ghc >--------------------------------------------------------------- commit 15f788f5e5096641245a4f060600a6db9cbc2c4e Author: Ben Gamari Date: Thu Nov 2 17:28:40 2017 -0400 llvmGen: Pass vector arguments in vector registers by default Earlier this year Edward Kmett requested [1] that we enable passing of vector values in vector registers by default. The GHC calling convention changes have been in LLVM for a number of years now so let's just flip the switch. [1] https://mail.haskell.org/pipermail/ghc-devs/2017-March/013905.html Reviewers: austin Subscribers: rwbarton, thomie Differential Revision: https://phabricator.haskell.org/D4142 >--------------------------------------------------------------- 15f788f5e5096641245a4f060600a6db9cbc2c4e compiler/main/DynFlags.hs | 5 +++-- docs/users_guide/using-optimisation.rst | 12 ++++++++++++ 2 files changed, 15 insertions(+), 2 deletions(-) diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index a421284..825497e 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -3757,7 +3757,7 @@ fFlagsDeps = [ flagSpec "kill-one-shot" Opt_KillOneShot, flagSpec "late-dmd-anal" Opt_LateDmdAnal, flagSpec "liberate-case" Opt_LiberateCase, - flagHiddenSpec "llvm-pass-vectors-in-regs" Opt_LlvmPassVectorsInRegisters, + flagSpec "llvm-pass-vectors-in-regs" Opt_LlvmPassVectorsInRegisters, flagHiddenSpec "llvm-tbaa" Opt_LlvmTBAA, flagHiddenSpec "llvm-fill-undef-with-garbage" Opt_LlvmFillUndefWithGarbage, flagSpec "loopification" Opt_Loopification, @@ -4051,7 +4051,8 @@ defaultFlags settings Opt_RPath, Opt_SharedImplib, Opt_SimplPreInlining, - Opt_VersionMacros + Opt_VersionMacros, + Opt_LlvmPassVectorsInRegisters ] ++ [f | (ns,f) <- optLevelFlags, 0 `elem` ns] diff --git a/docs/users_guide/using-optimisation.rst b/docs/users_guide/using-optimisation.rst index 4714de7..fc958e0 100644 --- a/docs/users_guide/using-optimisation.rst +++ b/docs/users_guide/using-optimisation.rst @@ -493,6 +493,18 @@ by saying ``-fno-wombat``. self-recursive saturated tail calls into local jumps rather than function calls. +.. ghc-flag:: -fllvm-pass-vectors-in-regs + :shortdesc: Pass vector value in vector registers for function calls + :type: dynamic + :reverse: -fno-llvm-pass-vectors-in-regs + :category: + + :default: on + + Instructs GHC to use the platform's native vector registers to pass vector + arguments during function calls. As with all vector support, this requires + :ghc-flag:`-fllvm`. + .. ghc-flag:: -fmax-inline-alloc-size=⟨n⟩ :shortdesc: *default: 128.* Set the maximum size of inline array allocations to ⟨n⟩ bytes (default: 128). From git at git.haskell.org Fri Nov 3 00:16:16 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 3 Nov 2017 00:16:16 +0000 (UTC) Subject: [commit: ghc] master: Deserialize all function TypeReps (19ca2ca) Message-ID: <20171103001616.0DAC03A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/19ca2cab4b32ff2eaacb1fb3502849ad762af0e1/ghc >--------------------------------------------------------------- commit 19ca2cab4b32ff2eaacb1fb3502849ad762af0e1 Author: David Feuer Date: Thu Nov 2 17:30:59 2017 -0400 Deserialize all function TypeReps Previously, we could only deserialize `TypeRep (a -> b)` if both `a` and `b` had kind `Type`. Now, we do it regardless of their runtime representations. Reviewers: austin, bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie Differential Revision: https://phabricator.haskell.org/D4137 >--------------------------------------------------------------- 19ca2cab4b32ff2eaacb1fb3502849ad762af0e1 compiler/utils/Binary.hs | 19 ++++++++++++------- 1 file changed, 12 insertions(+), 7 deletions(-) diff --git a/compiler/utils/Binary.hs b/compiler/utils/Binary.hs index 1c0284a..a7bbfd5 100644 --- a/compiler/utils/Binary.hs +++ b/compiler/utils/Binary.hs @@ -3,6 +3,7 @@ {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE GADTs #-} +{-# LANGUAGE MultiWayIf #-} {-# OPTIONS_GHC -O -funbox-strict-fields #-} -- We always optimise this, otherwise performance of a non-optimised @@ -82,7 +83,7 @@ import Data.Time import Type.Reflection import Type.Reflection.Unsafe import Data.Kind (Type) -import GHC.Exts (RuntimeRep(..), VecCount(..), VecElem(..)) +import GHC.Exts (TYPE, RuntimeRep(..), VecCount(..), VecElem(..)) #else import Data.Typeable #endif @@ -748,14 +749,18 @@ getSomeTypeRep bh = do ] 3 -> do SomeTypeRep arg <- getSomeTypeRep bh SomeTypeRep res <- getSomeTypeRep bh - case typeRepKind arg `eqTypeRep` (typeRep :: TypeRep Type) of - Just HRefl -> - case typeRepKind res `eqTypeRep` (typeRep :: TypeRep Type) of - Just HRefl -> return $ SomeTypeRep $ Fun arg res - Nothing -> failure "Kind mismatch" [] - _ -> failure "Kind mismatch" [] + if + | App argkcon _ <- typeRepKind arg + , App reskcon _ <- typeRepKind res + , Just HRefl <- argkcon `eqTypeRep` tYPErep + , Just HRefl <- reskcon `eqTypeRep` tYPErep + -> return $ SomeTypeRep $ Fun arg res + | otherwise -> failure "Kind mismatch" [] _ -> failure "Invalid SomeTypeRep" [] where + tYPErep :: TypeRep TYPE + tYPErep = typeRep + failure description info = fail $ unlines $ [ "Binary.getSomeTypeRep: "++description ] ++ map (" "++) info From git at git.haskell.org Fri Nov 3 00:16:10 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 3 Nov 2017 00:16:10 +0000 (UTC) Subject: [commit: ghc] master: Name TypeRep constructor fields (3c8e55c) Message-ID: <20171103001610.8CEAE3A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3c8e55ce7383e73bbca74b9954560b8555c5c5d4/ghc >--------------------------------------------------------------- commit 3c8e55ce7383e73bbca74b9954560b8555c5c5d4 Author: David Feuer Date: Thu Nov 2 17:30:23 2017 -0400 Name TypeRep constructor fields Give `TypeRep` constructor fields names, and use them when pattern matching and constructing values. This is a bit verbose, but makes it obvious which field means what. Reviewers: austin, hvr, bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie Differential Revision: https://phabricator.haskell.org/D4136 >--------------------------------------------------------------- 3c8e55ce7383e73bbca74b9954560b8555c5c5d4 libraries/base/Data/Typeable/Internal.hs | 132 ++++++++++++++++++++----------- 1 file changed, 88 insertions(+), 44 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 3c8e55ce7383e73bbca74b9954560b8555c5c5d4 From git at git.haskell.org Fri Nov 3 00:16:13 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 3 Nov 2017 00:16:13 +0000 (UTC) Subject: [commit: ghc] master: Bump haddock submodule (eb37132) Message-ID: <20171103001613.4C1393A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/eb3713225fd3199a81357b5853194e56f732e308/ghc >--------------------------------------------------------------- commit eb3713225fd3199a81357b5853194e56f732e308 Author: alexbiehl Date: Thu Nov 2 17:29:08 2017 -0400 Bump haddock submodule Reviewers: austin, bgamari Subscribers: rwbarton, thomie Differential Revision: https://phabricator.haskell.org/D4144 >--------------------------------------------------------------- eb3713225fd3199a81357b5853194e56f732e308 mk/build.mk.sample | 2 +- testsuite/tests/perf/haddock/all.T | 3 ++- utils/haddock | 2 +- 3 files changed, 4 insertions(+), 3 deletions(-) diff --git a/mk/build.mk.sample b/mk/build.mk.sample index 6bceca3..958cea7 100644 --- a/mk/build.mk.sample +++ b/mk/build.mk.sample @@ -99,7 +99,7 @@ endif # Enable pretty hyperlinked sources #HADDOCK_DOCS = YES -#EXTRA_HADDOCK_OPTS += --hyperlinked-source +#EXTRA_HADDOCK_OPTS += --quickjump --hyperlinked-source # Don't strip debug and other unneeded symbols from libraries and executables. STRIP_CMD = : diff --git a/testsuite/tests/perf/haddock/all.T b/testsuite/tests/perf/haddock/all.T index e329d86..04281d6 100644 --- a/testsuite/tests/perf/haddock/all.T +++ b/testsuite/tests/perf/haddock/all.T @@ -69,7 +69,7 @@ test('haddock.Cabal', [extra_files(['../../../../libraries/Cabal/Cabal/dist-install/haddock.t']), unless(in_tree_compiler(), skip), req_haddock ,stats_num_field('bytes allocated', - [(wordsize(64), 15857428040, 5) + [(wordsize(64), 17133915848, 5) # 2012-08-14: 3255435248 (amd64/Linux) # 2012-08-29: 3324606664 (amd64/Linux, new codegen) # 2012-10-08: 3373401360 (amd64/Linux) @@ -118,6 +118,7 @@ test('haddock.Cabal', # 2017-06-05: 22294859000 (amd64/Linux) - Desugar modules compiled with -fno-code # 2017-06-05: 18753963960 (amd64/Linux) - Don't pass on -dcore-lint in Haddock.mk # 2017-08-22: 15857428040 (amd64/Linux) - Various Haddock optimizations + # 2017-11-02: 17133915848 (amd64/Linux) - Phabricator D4144 ,(platform('i386-unknown-mingw32'), 3293415576, 5) # 2012-10-30: 1733638168 (x86/Windows) diff --git a/utils/haddock b/utils/haddock index 0a64b5c..1789c77 160000 --- a/utils/haddock +++ b/utils/haddock @@ -1 +1 @@ -Subproject commit 0a64b5cdc051c47b24151b8839ae9067f06d8d0d +Subproject commit 1789c77a6ed1580dc10a4391dc8c398e902f03b1 From git at git.haskell.org Fri Nov 3 00:16:05 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 3 Nov 2017 00:16:05 +0000 (UTC) Subject: [commit: ghc] master: CmmSink: Use a IntSet instead of a list (4353756) Message-ID: <20171103001605.0584F3A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/43537568579a63cb6b8d70b4815d76c46bb9a692/ghc >--------------------------------------------------------------- commit 43537568579a63cb6b8d70b4815d76c46bb9a692 Author: alexbiehl Date: Thu Nov 2 17:27:37 2017 -0400 CmmSink: Use a IntSet instead of a list CmmProcs which have *lots* of local variables take a considerable amount of time in CmmSink. This was noticed by @tdammers in #7258 while compiling files with large records (~200-400 fields). Before: ``` Sun Oct 29 19:58 2017 Time and Allocation Profiling Report (Final) ghc-stage2 +RTS -p -RTS -B/Users/alexbiehl/git/ghc/inplace/lib /Users/alexbiehl/Downloads/W2.hs -fforce-recomp -O2 total time = 26.00 secs (25996 ticks @ 1000 us, 1 processor) total alloc = 14,921,627,912 bytes (excludes profiling overheads) COST CENTRE MODULE SRC %time %alloc sink CmmPipeline compiler/cmm/CmmPipeline.hs:(104,13)-(105,59) 55.7 15.9 SimplTopBinds SimplCore compiler/simplCore/SimplCore.hs:761:39-74 19.5 30.6 FloatOutwards SimplCore compiler/simplCore/SimplCore.hs:471:40-66 4.2 9.0 RegAlloc-linear AsmCodeGen compiler/nativeGen/AsmCodeGen.hs:(658,27)-(660,55) 4.0 11.1 pprNativeCode AsmCodeGen compiler/nativeGen/AsmCodeGen.hs:(529,37)-(530,65) 2.8 6.3 NewStranal SimplCore compiler/simplCore/SimplCore.hs:480:40-63 1.6 3.7 OccAnal SimplCore compiler/simplCore/SimplCore.hs:(739,22)-(740,67) 1.5 3.5 StgCmm HscMain compiler/main/HscMain.hs:(1426,13)-(1427,62) 1.2 2.4 regLiveness AsmCodeGen compiler/nativeGen/AsmCodeGen.hs:(591,17)-(593,52) 1.2 1.9 genMachCode AsmCodeGen compiler/nativeGen/AsmCodeGen.hs:(580,17)-(582,62) 0.9 1.8 NativeCodeGen CodeOutput compiler/main/CodeOutput.hs:171:18-78 0.9 2.1 CoreTidy HscMain compiler/main/HscMain.hs:1253:27-67 0.8 1.9 ``` After: ``` Sun Oct 29 19:18 2017 Time and Allocation Profiling Report (Final) ghc-stage2 +RTS -p -RTS -B/Users/alexbiehl/git/ghc/inplace/lib /Users/alexbiehl/Downloads/W2.hs -fforce-recomp -O2 total time = 13.31 secs (13307 ticks @ 1000 us, 1 processor) total alloc = 15,772,184,488 bytes (excludes profiling overheads) COST CENTRE MODULE SRC %time %alloc SimplTopBinds SimplCore compiler/simplCore/SimplCore.hs:761:39-74 38.3 29.0 sink CmmPipeline compiler/cmm/CmmPipeline.hs:(104,13)-(105,59) 13.2 20.3 RegAlloc-linear AsmCodeGen compiler/nativeGen/AsmCodeGen.hs:(658,27)-(660,55) 8.3 10.5 FloatOutwards SimplCore compiler/simplCore/SimplCore.hs:471:40-66 8.1 8.5 pprNativeCode AsmCodeGen compiler/nativeGen/AsmCodeGen.hs:(529,37)-(530,65) 5.4 5.9 NewStranal SimplCore compiler/simplCore/SimplCore.hs:480:40-63 3.1 3.5 OccAnal SimplCore compiler/simplCore/SimplCore.hs:(739,22)-(740,67) 2.9 3.3 StgCmm HscMain compiler/main/HscMain.hs:(1426,13)-(1427,62) 2.3 2.3 regLiveness AsmCodeGen compiler/nativeGen/AsmCodeGen.hs:(591,17)-(593,52) 2.1 1.8 NativeCodeGen CodeOutput compiler/main/CodeOutput.hs:171:18-78 1.7 2.0 genMachCode AsmCodeGen compiler/nativeGen/AsmCodeGen.hs:(580,17)-(582,62) 1.6 1.7 CoreTidy HscMain compiler/main/HscMain.hs:1253:27-67 1.4 1.8 foldNodesBwdOO Hoopl.Dataflow compiler/cmm/Hoopl/Dataflow.hs:(397,1)-(403,17) 1.1 0.8 ``` Reviewers: austin, bgamari, simonmar Reviewed By: bgamari Subscribers: duog, rwbarton, thomie, tdammers GHC Trac Issues: #7258 Differential Revision: https://phabricator.haskell.org/D4145 >--------------------------------------------------------------- 43537568579a63cb6b8d70b4815d76c46bb9a692 compiler/cmm/CmmSink.hs | 32 +++++++++++++++++++++++++------- 1 file changed, 25 insertions(+), 7 deletions(-) diff --git a/compiler/cmm/CmmSink.hs b/compiler/cmm/CmmSink.hs index a674e54..3633ed3 100644 --- a/compiler/cmm/CmmSink.hs +++ b/compiler/cmm/CmmSink.hs @@ -17,13 +17,31 @@ import CodeGen.Platform import Platform (isARM, platformArch) import DynFlags +import Unique import UniqFM import PprCmm () +import qualified Data.IntSet as IntSet import Data.List (partition) import qualified Data.Set as Set import Data.Maybe +-- Compact sets for membership tests of local variables. + +type LRegSet = IntSet.IntSet + +emptyLRegSet :: LRegSet +emptyLRegSet = IntSet.empty + +nullLRegSet :: LRegSet -> Bool +nullLRegSet = IntSet.null + +insertLRegSet :: LocalReg -> LRegSet -> LRegSet +insertLRegSet l = IntSet.insert (getKey (getUnique l)) + +elemLRegSet :: LocalReg -> LRegSet -> Bool +elemLRegSet l = IntSet.member (getKey (getUnique l)) + -- ----------------------------------------------------------------------------- -- Sinking and inlining @@ -399,7 +417,7 @@ tryToInline , Assignments -- Remaining assignments ) -tryToInline dflags live node assigs = go usages node [] assigs +tryToInline dflags live node assigs = go usages node emptyLRegSet assigs where usages :: UniqFM Int -- Maps each LocalReg to a count of how often it is used usages = foldLocalRegsUsed dflags addUsage emptyUFM node @@ -422,7 +440,7 @@ tryToInline dflags live node assigs = go usages node [] assigs inline_and_keep = keep inl_node -- inline the assignment, keep it keep node' = (final_node, a : rest') - where (final_node, rest') = go usages' node' (l:skipped) rest + where (final_node, rest') = go usages' node' (insertLRegSet l skipped) rest usages' = foldLocalRegsUsed dflags (\m r -> addToUFM m r 2) usages rhs -- we must not inline anything that is mentioned in the RHS @@ -430,7 +448,7 @@ tryToInline dflags live node assigs = go usages node [] assigs -- usages of the regs on the RHS to 2. cannot_inline = skipped `regsUsedIn` rhs -- Note [dependent assignments] - || l `elem` skipped + || l `elemLRegSet` skipped || not (okToInline dflags rhs node) l_usages = lookupUFM usages l @@ -521,11 +539,11 @@ And we do that right here in tryToInline, just as we do cmmMachOpFold. addUsage :: UniqFM Int -> LocalReg -> UniqFM Int addUsage m r = addToUFM_C (+) m r 1 -regsUsedIn :: [LocalReg] -> CmmExpr -> Bool -regsUsedIn [] _ = False +regsUsedIn :: LRegSet -> CmmExpr -> Bool +regsUsedIn ls _ | nullLRegSet ls = False regsUsedIn ls e = wrapRecExpf f e False - where f (CmmReg (CmmLocal l)) _ | l `elem` ls = True - f (CmmRegOff (CmmLocal l) _) _ | l `elem` ls = True + where f (CmmReg (CmmLocal l)) _ | l `elemLRegSet` ls = True + f (CmmRegOff (CmmLocal l) _) _ | l `elemLRegSet` ls = True f _ z = z -- we don't inline into CmmUnsafeForeignCall if the expression refers From git at git.haskell.org Fri Nov 3 16:39:18 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 3 Nov 2017 16:39:18 +0000 (UTC) Subject: [commit: ghc] master: Fix documentation and comment issues (5d48f7c) Message-ID: <20171103163918.6A9C93A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5d48f7ce7030ea764446d3ad8cecd60d016f3197/ghc >--------------------------------------------------------------- commit 5d48f7ce7030ea764446d3ad8cecd60d016f3197 Author: Cyd Parser Date: Tue Oct 31 23:13:50 2017 -0700 Fix documentation and comment issues >--------------------------------------------------------------- 5d48f7ce7030ea764446d3ad8cecd60d016f3197 docs/users_guide/glasgow_exts.rst | 13 +++++++++---- libraries/base/Control/Monad/ST.hs | 2 +- libraries/base/Data/Traversable.hs | 4 ++-- libraries/base/GHC/Exception.hs | 8 ++++---- 4 files changed, 16 insertions(+), 11 deletions(-) diff --git a/docs/users_guide/glasgow_exts.rst b/docs/users_guide/glasgow_exts.rst index 3976bef..a86392f 100644 --- a/docs/users_guide/glasgow_exts.rst +++ b/docs/users_guide/glasgow_exts.rst @@ -5838,12 +5838,17 @@ information can be seen both as a generalisation of the proposal for Odersky, or as a special case of Mark Jones's later framework for "improvement" of qualified types. The underlying ideas are also discussed in a more theoretical and abstract setting in a manuscript -[implparam], where they are identified as one point in a general design +[Jones1999]_, where they are identified as one point in a general design space for systems of implicit parameterisation). To start with an abstract example, consider a declaration such as: :: class C a b where ... +.. [Jones1999] + "`Exploring the Design Space for Type-based Implicit Parameterization + `__", Mark P. Jones, Oregon + Graduate Institute of Science & Technology, Technical Report, July 1999. + which tells us simply that ``C`` can be thought of as a binary relation on types (or type constructors, depending on the kinds of ``a`` and ``b``). Extra clauses can be included in the definition of classes to add information @@ -5853,7 +5858,7 @@ about dependencies between parameters, as in the following examples: :: class E a b | a -> b, b -> a where ... The notation ``a -> b`` used here between the ``|`` and ``where`` symbols — -not to be confused with a function type — indicates that the a +not to be confused with a function type — indicates that the ``a`` parameter uniquely determines the ``b`` parameter, and might be read as "``a`` determines ``b``." Thus ``D`` is not just a relation, but actually a (partial) function. Similarly, from the two dependencies that are included in the @@ -7028,14 +7033,14 @@ families `__. and S. Marlow. In Proceedings of “The 32nd Annual ACM SIGPLAN-SIGACT Symposium on Principles of Programming Languages (POPL'05)”, pages 1-13, ACM - Press, 2005) + Press, 2005. .. [AssocTypeSyn2005] “`Type Associated Type Synonyms `__\ ”. M. Chakravarty, G. Keller, and S. Peyton Jones. In Proceedings of “The Tenth ACM SIGPLAN International Conference on Functional Programming”, - ACM Press, pages 241-253, 2005). + ACM Press, pages 241-253, 2005. .. [TypeFamilies2008] “\ `Type Checking with Open Type diff --git a/libraries/base/Control/Monad/ST.hs b/libraries/base/Control/Monad/ST.hs index 8313c2d..6f1dc31 100644 --- a/libraries/base/Control/Monad/ST.hs +++ b/libraries/base/Control/Monad/ST.hs @@ -16,7 +16,7 @@ -- -- References (variables) that can be used within the @ST@ monad are -- provided by "Data.STRef", and arrays are provided by --- "Data.Array.ST". +-- [Data.Array.ST](https://hackage.haskell.org/package/array/docs/Data-Array-ST.html). ----------------------------------------------------------------------------- diff --git a/libraries/base/Data/Traversable.hs b/libraries/base/Data/Traversable.hs index 71a4420..72d88b6 100644 --- a/libraries/base/Data/Traversable.hs +++ b/libraries/base/Data/Traversable.hs @@ -198,8 +198,8 @@ Consider This gives rise to a list-instance of mapM looking like this - $fTraversable[]_$ctaverse = ...code for traverse on lists... - {-# INLINE $fTraversable[]_$ctaverse #-} + $fTraversable[]_$ctraverse = ...code for traverse on lists... + {-# INLINE $fTraversable[]_$ctraverse #-} $fTraversable[]_$cmapM = $fTraversable[]_$ctraverse Now the $ctraverse obediently inlines into the RHS of $cmapM, /but/ diff --git a/libraries/base/GHC/Exception.hs b/libraries/base/GHC/Exception.hs index 6a77e6e..725b864 100644 --- a/libraries/base/GHC/Exception.hs +++ b/libraries/base/GHC/Exception.hs @@ -130,13 +130,13 @@ We can now catch a @MismatchedParentheses@ exception as @SomeCompilerException@, but not other types, e.g. @IOException@: @ -*Main> throw MismatchedParentheses `catch` \e -> putStrLn (\"Caught \" ++ show (e :: MismatchedParentheses)) +*Main> throw MismatchedParentheses \`catch\` \\e -> putStrLn (\"Caught \" ++ show (e :: MismatchedParentheses)) Caught MismatchedParentheses -*Main> throw MismatchedParentheses `catch` \e -> putStrLn (\"Caught \" ++ show (e :: SomeFrontendException)) +*Main> throw MismatchedParentheses \`catch\` \\e -> putStrLn (\"Caught \" ++ show (e :: SomeFrontendException)) Caught MismatchedParentheses -*Main> throw MismatchedParentheses `catch` \e -> putStrLn (\"Caught \" ++ show (e :: SomeCompilerException)) +*Main> throw MismatchedParentheses \`catch\` \\e -> putStrLn (\"Caught \" ++ show (e :: SomeCompilerException)) Caught MismatchedParentheses -*Main> throw MismatchedParentheses `catch` \e -> putStrLn (\"Caught \" ++ show (e :: IOException)) +*Main> throw MismatchedParentheses \`catch\` \\e -> putStrLn (\"Caught \" ++ show (e :: IOException)) *** Exception: MismatchedParentheses @ From git at git.haskell.org Fri Nov 3 16:39:21 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 3 Nov 2017 16:39:21 +0000 (UTC) Subject: [commit: ghc] master: change example from msum to mfilter (df479f7) Message-ID: <20171103163921.29CC63A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/df479f7c1e3f877e9981f16374bfdf03e79e57f4/ghc >--------------------------------------------------------------- commit df479f7c1e3f877e9981f16374bfdf03e79e57f4 Author: Julie Moronuki Date: Tue Oct 31 01:15:41 2017 -0400 change example from msum to mfilter >--------------------------------------------------------------- df479f7c1e3f877e9981f16374bfdf03e79e57f4 libraries/base/Control/Monad.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/libraries/base/Control/Monad.hs b/libraries/base/Control/Monad.hs index a3eaa72..0706c86 100644 --- a/libraries/base/Control/Monad.hs +++ b/libraries/base/Control/Monad.hs @@ -276,7 +276,7 @@ The functions in this library use the following naming conventions: * A prefix \'@m@\' generalizes an existing function to a monadic form. Thus, for example: -> sum :: Num a => [a] -> a -> msum :: MonadPlus m => [m a] -> m a +> filter :: (a -> Bool) -> [a] -> [a] +> mfilter :: MonadPlus m => (a -> Bool) -> m a -> m a -} From git at git.haskell.org Fri Nov 3 16:39:23 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 3 Nov 2017 16:39:23 +0000 (UTC) Subject: [commit: ghc] master: Clean up comments about match algorithm a bit. (436b3ef) Message-ID: <20171103163923.E63AB3A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/436b3ef01eb740a2a0818783ba94a62c4687b4fe/ghc >--------------------------------------------------------------- commit 436b3ef01eb740a2a0818783ba94a62c4687b4fe Author: klebinger.andreas at gmx.at Date: Sun Oct 29 20:26:51 2017 +0100 Clean up comments about match algorithm a bit. >--------------------------------------------------------------- 436b3ef01eb740a2a0818783ba94a62c4687b4fe compiler/deSugar/Match.hs | 109 ++++++++++++++++++---------------------------- 1 file changed, 43 insertions(+), 66 deletions(-) diff --git a/compiler/deSugar/Match.hs b/compiler/deSugar/Match.hs index 99529e7..7a3ee68 100644 --- a/compiler/deSugar/Match.hs +++ b/compiler/deSugar/Match.hs @@ -63,7 +63,8 @@ import Data.List (groupBy) * * ************************************************************************ -The function @match@ is basically the same as in the Wadler chapter, +The function @match@ is basically the same as in the Wadler chapter +from "The Implementation of Functional Programming Languages", except it is monadised, to carry around the name supply, info about annotations, etc. @@ -125,40 +126,25 @@ patterns that is examined. The steps carried out are roughly: \item Tidy the patterns in column~1 with @tidyEqnInfo@ (this may add bindings to the second component of the equation-info): -\begin{itemize} -\item -Remove the `as' patterns from column~1. -\item -Make all constructor patterns in column~1 into @ConPats@, notably - at ListPats@ and @TuplePats at . -\item -Handle any irrefutable (or ``twiddle'') @LazyPats at . -\end{itemize} \item Now {\em unmix} the equations into {\em blocks} [w\/ local function - at unmix_eqns@], in which the equations in a block all have variable -patterns in column~1, or they all have constructor patterns in ... + at match_groups@], in which the equations in a block all have the same + match group. (see ``the mixture rule'' in SLPJ). \item -Call @matchEqnBlock@ on each block of equations; it will do the -appropriate thing for each kind of column-1 pattern, usually ending up -in a recursive call to @match at . +Call the right match variant on each block of equations; it will do the +appropriate thing for each kind of column-1 pattern. \end{enumerate} We are a little more paranoid about the ``empty rule'' (SLPJ, p.~87) than the Wadler-chapter code for @match@ (p.~93, first @match@ clause). And gluing the ``success expressions'' together isn't quite so pretty. -This (more interesting) clause of @match@ uses @tidy_and_unmix_eqns@ -(a)~to get `as'- and `twiddle'-patterns out of the way (tidying), and -(b)~to do ``the mixture rule'' (SLPJ, p.~88) [which really {\em +This @match@ uses @tidyEqnInfo@ +to get `as'- and `twiddle'-patterns out of the way (tidying), before +applying ``the mixture rule'' (SLPJ, p.~88) [which really {\em un}mixes the equations], producing a list of equation-info -blocks, each block having as its first column of patterns either all -constructors, or all variables (or similar beasts), etc. - - at match_unmixed_eqn_blks@ simply takes the place of the @foldr@ in the -Wadler-chapter @match@ (p.~93, last clause), and @match_unmixed_blk@ -corresponds roughly to @matchVarCon at . +blocks, each block having as its first column patterns compatible with each other. Note [Match Ids] ~~~~~~~~~~~~~~~~ @@ -348,39 +334,40 @@ See also Note [Case elimination: lifted case] in Simplify. ************************************************************************ Tidy up the leftmost pattern in an @EquationInfo@, given the variable @v@ -which will be scrutinised. This means: -\begin{itemize} -\item -Replace variable patterns @x@ (@x /= v@) with the pattern @_@, -together with the binding @x = v at . -\item -Replace the `as' pattern @x@@p@ with the pattern p and a binding @x = v at . -\item -Removing lazy (irrefutable) patterns (you don't want to know...). -\item -Converting explicit tuple-, list-, and parallel-array-pats into ordinary - at ConPats@. -\item -Convert the literal pat "" to []. -\end{itemize} +which will be scrutinised. -The result of this tidying is that the column of patterns will include -{\em only}: -\begin{description} -\item[@WildPats@:] -The @VarPat@ information isn't needed any more after this. +This makes desugaring the pattern match simpler by transforming some of +the patterns to simpler forms. (Tuples to Constructor Patterns) -\item[@ConPats@:] - at ListPats@, @TuplePats@, etc., are all converted into @ConPats at . +Among other things in the resulting Pattern: +* Variables and irrefutable(lazy) patterns are replaced by Wildcards +* As patterns are replaced by the patterns they wrap. + +The bindings created by the above patterns are put into the returned wrapper +instead. + +This means a definition of the form: + f x = rhs +when called with v get's desugared to the equivalent of: + let x = v + in + f _ = rhs + +The same principle holds for as patterns (@) and +irrefutable/lazy patterns (~). +In the case of irrefutable patterns the irrefutable pattern is pushed into +the binding. + +Pattern Constructors which only represent syntactic sugar are converted into +their desugared representation. +This usually means converting them to Constructor patterns but for some +depends on enabled extensions. (Eg OverloadedLists) + +GHC also tries to convert overloaded Literals into regular ones. + +The result of this tidying is that the column of patterns will include +only these which can be assigned a PatternGroup (see patGroup). -\item[@LitPats@ and @NPats@:] - at LitPats@/@NPats@ of ``known friendly types'' (Int, Char, -Float, Double, at least) are converted to unboxed form; e.g., -\tr{(NPat (HsInt i) _ _)} is converted to: -\begin{verbatim} -(ConPat I# _ _ [LitPat (HsIntPrim i)]) -\end{verbatim} -\end{description} -} tidyEqnInfo :: Id -> EquationInfo @@ -391,12 +378,7 @@ tidyEqnInfo :: Id -> EquationInfo -- one pattern and fiddling the list of bindings. -- -- POST CONDITION: head pattern in the EqnInfo is - -- WildPat - -- ConPat - -- NPat - -- LitPat - -- NPlusKPat - -- but no other + -- one of these for which patGroup is defined. tidyEqnInfo _ (EqnInfo { eqn_pats = [] }) = panic "tidyEqnInfo" @@ -414,12 +396,7 @@ tidy1 :: Id -- The Id being scrutinised -- (pat', mr') = tidy1 v pat mr -- tidies the *outer level only* of pat, giving pat' -- It eliminates many pattern forms (as-patterns, variable patterns, --- list patterns, etc) yielding one of: --- WildPat --- ConPatOut --- LitPat --- NPat --- NPlusKPat +-- list patterns, etc) and returns any created bindings in the wrapper. tidy1 v (ParPat pat) = tidy1 v (unLoc pat) tidy1 v (SigPatOut pat _) = tidy1 v (unLoc pat) From git at git.haskell.org Sat Nov 4 23:18:21 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 4 Nov 2017 23:18:21 +0000 (UTC) Subject: [commit: ghc] ghc-8.2: Fix an exponential-blowup case in SpecConstr (58bb1a7) Message-ID: <20171104231821.AE7253A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.2 Link : http://ghc.haskell.org/trac/ghc/changeset/58bb1a781982d26729efb4a3b72186257a637013/ghc >--------------------------------------------------------------- commit 58bb1a781982d26729efb4a3b72186257a637013 Author: Simon Peyton Jones Date: Thu Oct 26 17:24:52 2017 +0100 Fix an exponential-blowup case in SpecConstr Trac #14379 showed a case where use of "forcing" to do "damn the torpedos" specialisation without resource limits (which 'vector' does a lot) led to exponential blowup. The fix is easy. Finding it wasn't. See Note [Forcing specialisation] and the one-line change in decreaseSpecCount. (cherry picked from commit 7d7d94fb4876dc7e58263abc9dd65921e09cddac) >--------------------------------------------------------------- 58bb1a781982d26729efb4a3b72186257a637013 compiler/specialise/SpecConstr.hs | 53 ++++++++++++++++++++++++--------------- 1 file changed, 33 insertions(+), 20 deletions(-) diff --git a/compiler/specialise/SpecConstr.hs b/compiler/specialise/SpecConstr.hs index 76c32f9..f686f0f 100644 --- a/compiler/specialise/SpecConstr.hs +++ b/compiler/specialise/SpecConstr.hs @@ -57,9 +57,6 @@ import Control.Monad ( zipWithM ) import Data.List import PrelNames ( specTyConName ) import Module - --- See Note [Forcing specialisation] - import TyCon ( TyCon ) import GHC.Exts( SpecConstrAnnotation(..) ) import Data.Ord( comparing ) @@ -502,6 +499,7 @@ This is all quite ugly; we ought to come up with a better design. ForceSpecConstr arguments are spotted in scExpr' and scTopBinds which then set sc_force to True when calling specLoop. This flag does four things: + * Ignore specConstrThreshold, to specialise functions of arbitrary size (see scTopBind) * Ignore specConstrCount, to make arbitrary numbers of specialisations @@ -511,22 +509,36 @@ sc_force to True when calling specLoop. This flag does four things: * Only specialise on recursive types a finite number of times (see is_too_recursive; Trac #5550; Note [Limit recursive specialisation]) -This flag is inherited for nested non-recursive bindings (which are likely to -be join points and hence should be fully specialised) but reset for nested -recursive bindings. - -What alternatives did I consider? Annotating the loop itself doesn't -work because (a) it is local and (b) it will be w/w'ed and having -w/w propagating annotations somehow doesn't seem like a good idea. The -types of the loop arguments really seem to be the most persistent -thing. - -Annotating the types that make up the loop state doesn't work, -either, because (a) it would prevent us from using types like Either -or tuples here, (b) we don't want to restrict the set of types that -can be used in Stream states and (c) some types are fixed by the user -(e.g., the accumulator here) but we still want to specialise as much -as possible. +The flag holds only for specialising a single binding group, and NOT +for nested bindings. (So really it should be passed around explicitly +and not stored in ScEnv.) Trac #14379 turned out to be caused by + f SPEC x = let g1 x = ... + in ... +We force-specialise f (becuase of the SPEC), but that generates a specialised +copy of g1 (as well as the original). Alas g1 has a nested binding g2; and +in each copy of g1 we get an unspecialised and specialised copy of g2; and so +on. Result, exponential. So the force-spec flag now only applies to one +level of bindings at a time. + +Mechanism for this one-level-only thing: + + - Switch it on at the call to specRec, in scExpr and scTopBinds + - Switch it off when doing the RHSs; + this can be done very conveneniently in decreaseSpecCount + +What alternatives did I consider? + +* Annotating the loop itself doesn't work because (a) it is local and + (b) it will be w/w'ed and having w/w propagating annotations somehow + doesn't seem like a good idea. The types of the loop arguments + really seem to be the most persistent thing. + +* Annotating the types that make up the loop state doesn't work, + either, because (a) it would prevent us from using types like Either + or tuples here, (b) we don't want to restrict the set of types that + can be used in Stream states and (c) some types are fixed by the + user (e.g., the accumulator here) but we still want to specialise as + much as possible. Alternatives to ForceSpecConstr ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -975,7 +987,8 @@ extendCaseBndrs env scrut case_bndr con alt_bndrs decreaseSpecCount :: ScEnv -> Int -> ScEnv -- See Note [Avoiding exponential blowup] decreaseSpecCount env n_specs - = env { sc_count = case sc_count env of + = env { sc_force = False -- See Note [Forcing specialisation] + , sc_count = case sc_count env of Nothing -> Nothing Just n -> Just (n `div` (n_specs + 1)) } -- The "+1" takes account of the original function; From git at git.haskell.org Sat Nov 4 23:18:24 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 4 Nov 2017 23:18:24 +0000 (UTC) Subject: [commit: ghc] ghc-8.2: testsuite: Bump metrics of T9203 (b8877b3) Message-ID: <20171104231824.7757D3A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.2 Link : http://ghc.haskell.org/trac/ghc/changeset/b8877b37d48d329e819a16995c636dcfa3da4200/ghc >--------------------------------------------------------------- commit b8877b37d48d329e819a16995c636dcfa3da4200 Author: Ben Gamari Date: Mon Oct 30 18:10:18 2017 -0400 testsuite: Bump metrics of T9203 >--------------------------------------------------------------- b8877b37d48d329e819a16995c636dcfa3da4200 testsuite/tests/perf/should_run/all.T | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/testsuite/tests/perf/should_run/all.T b/testsuite/tests/perf/should_run/all.T index 65e6091..9dd85f7 100644 --- a/testsuite/tests/perf/should_run/all.T +++ b/testsuite/tests/perf/should_run/all.T @@ -452,11 +452,12 @@ test('T9203', # 2016-04-06 84345136 (i386/Debian) not sure # 2017-03-24 77969268 (x86/Linux, 64-bit machine) probably join points - , (wordsize(64), 84620888, 5) ]), + , (wordsize(64), 95910600, 5) ]), # was 95747304 # 2019-09-10 94547280 post-AMP cleanup # 2015-10-28 95451192 emit Typeable at definition site # 2016-12-19 84620888 Join points + # 2017-10-30 95910600 Unknown only_ways(['normal'])], compile_and_run, ['-O2']) From git at git.haskell.org Mon Nov 6 19:31:59 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Nov 2017 19:31:59 +0000 (UTC) Subject: [commit: ghc] wip/T14068: Loopification: Clear OccInfo of loopified binding (6408e0d) Message-ID: <20171106193159.4C2CD3A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14068 Link : http://ghc.haskell.org/trac/ghc/changeset/6408e0da7b54cf25cbace9c4b0f84ddaafe54060/ghc >--------------------------------------------------------------- commit 6408e0da7b54cf25cbace9c4b0f84ddaafe54060 Author: Joachim Breitner Date: Mon Nov 6 14:25:48 2017 -0500 Loopification: Clear OccInfo of loopified binding as a loopified binding is no longer a loop breaker. This is a stab in the dark at maybe working around #14430, where I observe unsimplified unfoldings where I expec them to be simplified.. >--------------------------------------------------------------- 6408e0da7b54cf25cbace9c4b0f84ddaafe54060 compiler/coreSyn/CoreOpt.hs | 2 +- compiler/stranal/WorkWrap.hs | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/compiler/coreSyn/CoreOpt.hs b/compiler/coreSyn/CoreOpt.hs index 550a0a7..e3462c4 100644 --- a/compiler/coreSyn/CoreOpt.hs +++ b/compiler/coreSyn/CoreOpt.hs @@ -679,7 +679,7 @@ loopificationJoinPointBinding_maybe bndr rhs -- To tread with caution, let's keep it this way bndr' = (`setIdUnfolding` noUnfolding) $ (`setInlinePragma` neverInlinePragma) $ - zapIdTailCallInfo $ + (`setIdOccInfo` noOccInfo) $ bndr in Just (bndr', join_bndr, mkLams bndrs body) diff --git a/compiler/stranal/WorkWrap.hs b/compiler/stranal/WorkWrap.hs index 49045d9..4eb2f10 100644 --- a/compiler/stranal/WorkWrap.hs +++ b/compiler/stranal/WorkWrap.hs @@ -479,7 +479,7 @@ splitFun dflags fam_envs fn_id fn_info wrap_dmds res_info rhs work_act = case work_inline of -- See Note [Activation for workers] NoInline -> inl_act inl_prag - NoUserInline | isNeverActive (inl_act inl_prag) -> inl_act inl_prag + NoUserInline | isNeverActive (inl_act inl_prag) -> NeverActive _ -> wrap_act work_prag = InlinePragma { inl_src = SourceText "{-# INLINE" , inl_inline = work_inline From git at git.haskell.org Mon Nov 6 20:14:46 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Nov 2017 20:14:46 +0000 (UTC) Subject: [commit: ghc] wip/T14068: If there is a artificial no-inline-pragma, do not bother creating an unfolding (1d81171) Message-ID: <20171106201446.5C3AC3A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14068 Link : http://ghc.haskell.org/trac/ghc/changeset/1d811710f9681693f3dcdd647a1231dcebc8bce1/ghc >--------------------------------------------------------------- commit 1d811710f9681693f3dcdd647a1231dcebc8bce1 Author: Joachim Breitner Date: Mon Nov 6 15:14:11 2017 -0500 If there is a artificial no-inline-pragma, do not bother creating an unfolding >--------------------------------------------------------------- 1d811710f9681693f3dcdd647a1231dcebc8bce1 compiler/basicTypes/BasicTypes.hs | 8 +++++++- compiler/simplCore/Simplify.hs | 4 +++- 2 files changed, 10 insertions(+), 2 deletions(-) diff --git a/compiler/basicTypes/BasicTypes.hs b/compiler/basicTypes/BasicTypes.hs index a866153..3e5fbfe 100644 --- a/compiler/basicTypes/BasicTypes.hs +++ b/compiler/basicTypes/BasicTypes.hs @@ -88,7 +88,7 @@ module BasicTypes( InlineSpec(..), noUserInlineSpec, InlinePragma(..), defaultInlinePragma, alwaysInlinePragma, neverInlinePragma, dfunInlinePragma, - isDefaultInlinePragma, + isDefaultInlinePragma, isNeverInlinePragma, isInlinePragma, isInlinablePragma, isAnyInlinePragma, inlinePragmaSpec, inlinePragmaSat, inlinePragmaActivation, inlinePragmaRuleMatchInfo, @@ -1352,6 +1352,12 @@ isDefaultInlinePragma (InlinePragma { inl_act = activation , inl_inline = inline }) = noUserInlineSpec inline && isAlwaysActive activation && isFunLike match_info +isNeverInlinePragma :: InlinePragma -> Bool +isNeverInlinePragma (InlinePragma { inl_act = activation + , inl_rule = match_info + , inl_inline = inline }) + = noUserInlineSpec inline && isNeverActive activation && isFunLike match_info + isInlinePragma :: InlinePragma -> Bool isInlinePragma prag = case inl_inline prag of Inline -> True diff --git a/compiler/simplCore/Simplify.hs b/compiler/simplCore/Simplify.hs index 532b7ee..b576e8a 100644 --- a/compiler/simplCore/Simplify.hs +++ b/compiler/simplCore/Simplify.hs @@ -41,7 +41,7 @@ import CoreOpt ( pushCoTyArg, pushCoValArg import Rules ( mkRuleInfo, lookupRule, getRules ) import Demand ( mkClosedStrictSig, topDmd, exnRes ) import BasicTypes ( TopLevelFlag(..), isNotTopLevel, isTopLevel, - RecFlag(..), Arity ) + RecFlag(..), Arity, isNeverInlinePragma ) import MonadUtils ( mapAccumLM, liftIO ) import Maybes ( orElse ) import Control.Monad @@ -3263,6 +3263,8 @@ simplLetUnfolding env top_lvl cont_mb id new_rhs unf = simplStableUnfolding env top_lvl cont_mb id unf | isExitJoinId id = return noUnfolding -- see Note [Do not inline exit join points] + | isNeverInlinePragma (idInlinePragma id) + = return noUnfolding -- Do not bother creating one if we never inline anyways | otherwise = mkLetUnfolding (seDynFlags env) top_lvl InlineRhs id new_rhs From git at git.haskell.org Mon Nov 6 21:39:39 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Nov 2017 21:39:39 +0000 (UTC) Subject: [commit: ghc] master: testsuite: Bump metrics of haddock.Cabal (f6521e6) Message-ID: <20171106213939.A221A3A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f6521e6b5606130eb769e6844e9957c19acab7e7/ghc >--------------------------------------------------------------- commit f6521e6b5606130eb769e6844e9957c19acab7e7 Author: Ben Gamari Date: Mon Nov 6 15:23:45 2017 -0500 testsuite: Bump metrics of haddock.Cabal >--------------------------------------------------------------- f6521e6b5606130eb769e6844e9957c19acab7e7 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 04281d6..a5de011 100644 --- a/testsuite/tests/perf/haddock/all.T +++ b/testsuite/tests/perf/haddock/all.T @@ -69,7 +69,7 @@ test('haddock.Cabal', [extra_files(['../../../../libraries/Cabal/Cabal/dist-install/haddock.t']), unless(in_tree_compiler(), skip), req_haddock ,stats_num_field('bytes allocated', - [(wordsize(64), 17133915848, 5) + [(wordsize(64), 18936339648, 5) # 2012-08-14: 3255435248 (amd64/Linux) # 2012-08-29: 3324606664 (amd64/Linux, new codegen) # 2012-10-08: 3373401360 (amd64/Linux) @@ -119,6 +119,7 @@ test('haddock.Cabal', # 2017-06-05: 18753963960 (amd64/Linux) - Don't pass on -dcore-lint in Haddock.mk # 2017-08-22: 15857428040 (amd64/Linux) - Various Haddock optimizations # 2017-11-02: 17133915848 (amd64/Linux) - Phabricator D4144 + # 2017-11-06: 18936339648 (amd64/Linux) - Unknown ,(platform('i386-unknown-mingw32'), 3293415576, 5) # 2012-10-30: 1733638168 (x86/Windows) From git at git.haskell.org Mon Nov 6 21:39:42 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Nov 2017 21:39:42 +0000 (UTC) Subject: [commit: ghc] master: rts/win32: Emit exception handler output to stderr (4dfb790) Message-ID: <20171106213942.6DE0A3A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4dfb790ca0611d4024cd01ba4c28d145f1deb7cb/ghc >--------------------------------------------------------------- commit 4dfb790ca0611d4024cd01ba4c28d145f1deb7cb Author: Ben Gamari Date: Mon Nov 6 15:33:18 2017 -0500 rts/win32: Emit exception handler output to stderr Test Plan: Validate Reviewers: Phyx, austin, erikd, simonmar Reviewed By: Phyx Subscribers: rwbarton, thomie GHC Trac Issues: #14415 Differential Revision: https://phabricator.haskell.org/D4151 >--------------------------------------------------------------- 4dfb790ca0611d4024cd01ba4c28d145f1deb7cb rts/win32/veh_excn.c | 30 +++++++++++++++--------------- 1 file changed, 15 insertions(+), 15 deletions(-) diff --git a/rts/win32/veh_excn.c b/rts/win32/veh_excn.c index 3ac008d..fd50562 100644 --- a/rts/win32/veh_excn.c +++ b/rts/win32/veh_excn.c @@ -101,7 +101,7 @@ long WINAPI __hs_exception_handler(struct _EXCEPTION_POINTERS *exception_data) long action = EXCEPTION_CONTINUE_SEARCH; ULONG_PTR what; - fprintf (stdout, "\n"); + fprintf (stderr, "\n"); // When the system unwinds the VEH stack after having handled an excn, // return immediately. @@ -111,16 +111,16 @@ long WINAPI __hs_exception_handler(struct _EXCEPTION_POINTERS *exception_data) switch (exception_data->ExceptionRecord->ExceptionCode) { case EXCEPTION_FLT_DIVIDE_BY_ZERO: case EXCEPTION_INT_DIVIDE_BY_ZERO: - fprintf(stdout, "divide by zero\n"); + fprintf(stderr, "divide by zero\n"); action = EXCEPTION_CONTINUE_EXECUTION; break; case EXCEPTION_STACK_OVERFLOW: - fprintf(stdout, "C stack overflow in generated code\n"); + fprintf(stderr, "C stack overflow in generated code\n"); action = EXCEPTION_CONTINUE_EXECUTION; break; case EXCEPTION_ACCESS_VIOLATION: what = exception_data->ExceptionRecord->ExceptionInformation[0]; - fprintf(stdout, "Access violation in generated code" + fprintf(stderr, "Access violation in generated code" " when %s 0x%" PRIxPTR "\n" , what == 0 ? "reading" : what == 1 ? "writing" @@ -140,7 +140,7 @@ long WINAPI __hs_exception_handler(struct _EXCEPTION_POINTERS *exception_data) // But the correct action is still to exit as fast as possible. if (EXCEPTION_CONTINUE_EXECUTION == action) { - fflush(stdout); + fflush(stderr); generateStack (exception_data); generateDump (exception_data); stg_exit(EXIT_FAILURE); @@ -247,7 +247,7 @@ void generateDump (EXCEPTION_POINTERS* pExceptionPointers) MiniDumpWithThreadInfo | MiniDumpWithCodeSegs, &ExpParam, NULL, NULL); - fprintf (stdout, "Crash dump created. Dump written to:\n\t%ls", szFileName); + fprintf (stderr, "Crash dump created. Dump written to:\n\t%ls", szFileName); } // Generate stack trace information, we can piggy back on information we know @@ -283,9 +283,9 @@ void generateStack (EXCEPTION_POINTERS* pExceptionPointers) stackFrame.AddrStack.Offset = context->Esp; stackFrame.AddrStack.Mode = AddrModeFlat; #endif - fprintf (stdout, "\n Attempting to reconstruct a stack trace...\n\n"); + fprintf (stderr, "\n Attempting to reconstruct a stack trace...\n\n"); if (!SymInitialize (GetCurrentProcess (), NULL, true)) - fprintf (stdout, " \nNOTE: Symbols could not be loaded. Addresses may" + fprintf (stderr, " \nNOTE: Symbols could not be loaded. Addresses may" " be unresolved.\n\n"); /* Maximum amount of stack frames to show. */ @@ -294,7 +294,7 @@ void generateStack (EXCEPTION_POINTERS* pExceptionPointers) few. */ int max_frames = 35; - fprintf (stdout, " Frame\tCode address\n"); + fprintf (stderr, " Frame\tCode address\n"); DWORD64 lastBp = 0; /* Prevent loops with optimized stackframes. */ while (StackWalk64 (machineType, GetCurrentProcess(), GetCurrentThread(), &stackFrame, context, NULL, SymFunctionTableAccess64, @@ -302,19 +302,19 @@ void generateStack (EXCEPTION_POINTERS* pExceptionPointers) { if (stackFrame.AddrPC.Offset == 0) { - fprintf (stdout, "Null address\n"); + fprintf (stderr, "Null address\n"); break; } wchar_t buffer[1024]; uintptr_t topSp = 0; - fprintf (stdout, " * 0x%" PRIxPTR "\t%ls\n", + fprintf (stderr, " * 0x%" PRIxPTR "\t%ls\n", (uintptr_t)stackFrame.AddrFrame.Offset, resolveSymbolAddr ((wchar_t*)&buffer, 1024, (SymbolAddr*)stackFrame.AddrPC.Offset, &topSp)); if (lastBp >= stackFrame.AddrFrame.Offset) { - fprintf (stdout, "Stack frame out of sequence...\n"); + fprintf (stderr, "Stack frame out of sequence...\n"); break; } lastBp = stackFrame.AddrFrame.Offset; @@ -322,9 +322,9 @@ void generateStack (EXCEPTION_POINTERS* pExceptionPointers) max_frames--; if (max_frames ==0) { - fprintf (stdout, "\n ... (maximum recursion depth reached.)\n"); + fprintf (stderr, "\n ... (maximum recursion depth reached.)\n"); } } - fprintf (stdout, "\n"); - fflush(stdout); + fprintf (stderr, "\n"); + fflush(stderr); } From git at git.haskell.org Mon Nov 6 21:39:45 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Nov 2017 21:39:45 +0000 (UTC) Subject: [commit: ghc] master: cmm/CBE: Fix comparison between blocks of different lengths (6f990c5) Message-ID: <20171106213945.2E95E3A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6f990c54f922beae80362fe62426beededc21290/ghc >--------------------------------------------------------------- commit 6f990c54f922beae80362fe62426beededc21290 Author: Ben Gamari Date: Mon Nov 6 15:33:26 2017 -0500 cmm/CBE: Fix comparison between blocks of different lengths Previously CBE computed equality by taking the lists of middle nodes of the blocks being compared and zipping them together. It would then map over this list with the equality relation, and accumulate the result. However, this is completely wrong: Consider what will happen when we compare a block with no middle nodes with one with one or more. The result of `zip` will be empty and consequently the pass may conclude that the two are indeed equivalent (if their last nodes also match). This is very bad and the cause of #14361. The solution I chose was just to write out an explicit recursion, like I distinctly recall considering doing when I first wrote this code. Unfortunately I was feeling clever at the time. Unfortunately this case was just rare enough not to be triggered by the testsuite. I still need to find a testcase that doesn't have external dependencies. Test Plan: Need to find a more minimal testcase Reviewers: austin, simonmar, michalt Reviewed By: michalt Subscribers: michalt, rwbarton, thomie, hvr GHC Trac Issues: #14361 Differential Revision: https://phabricator.haskell.org/D4152 >--------------------------------------------------------------- 6f990c54f922beae80362fe62426beededc21290 compiler/cmm/CmmCommonBlockElim.hs | 14 +++++++++----- 1 file changed, 9 insertions(+), 5 deletions(-) diff --git a/compiler/cmm/CmmCommonBlockElim.hs b/compiler/cmm/CmmCommonBlockElim.hs index c83497e..b3a0b6f 100644 --- a/compiler/cmm/CmmCommonBlockElim.hs +++ b/compiler/cmm/CmmCommonBlockElim.hs @@ -371,11 +371,15 @@ eqBlockBodyWith dflags eqBid block block' (_,m',l') = blockSplit block' nodes' = filter (not . dont_care) (blockToList m') - (env_mid, eqs_mid) = - List.mapAccumL (\acc (a,b) -> eqMiddleWith dflags eqBid acc a b) - emptyUFM - (List.zip nodes nodes') - equal = and eqs_mid && eqLastWith eqBid env_mid l l' + eqMids :: LocalRegMapping -> [CmmNode O O] -> [CmmNode O O] -> Bool + eqMids env (a:as) (b:bs) + | eq = eqMids env' as bs + where + (env', eq) = eqMiddleWith dflags eqBid env a b + eqMids env [] [] = eqLastWith eqBid env l l' + eqMids _ _ _ = False + + equal = eqMids emptyUFM nodes nodes' eqLastWith :: (BlockId -> BlockId -> Bool) -> LocalRegMapping From git at git.haskell.org Mon Nov 6 21:39:47 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Nov 2017 21:39:47 +0000 (UTC) Subject: [commit: ghc] master: cmm/CBE: Fix a few more zip uses (a27056f) Message-ID: <20171106213947.E74FD3A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a27056f9823f8bbe2302f1924b3ab38fd6752e37/ghc >--------------------------------------------------------------- commit a27056f9823f8bbe2302f1924b3ab38fd6752e37 Author: Ben Gamari Date: Mon Nov 6 15:34:37 2017 -0500 cmm/CBE: Fix a few more zip uses Ensure that we don't consider lists of equal length to be equal when they are not. I noticed these while working on the fix for #14361. Reviewers: austin, simonmar, michalt Reviewed By: michalt Subscribers: rwbarton, thomie GHC Trac Issues: #14361 Differential Revision: https://phabricator.haskell.org/D4153 >--------------------------------------------------------------- a27056f9823f8bbe2302f1924b3ab38fd6752e37 compiler/cmm/CmmCommonBlockElim.hs | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/compiler/cmm/CmmCommonBlockElim.hs b/compiler/cmm/CmmCommonBlockElim.hs index b3a0b6f..c822078 100644 --- a/compiler/cmm/CmmCommonBlockElim.hs +++ b/compiler/cmm/CmmCommonBlockElim.hs @@ -316,7 +316,7 @@ eqMiddleWith dflags eqBid env a b = -- result registers aren't compared since they are binding occurrences (CmmUnsafeForeignCall t1 _ a1, CmmUnsafeForeignCall t2 _ a2) -> let eq = t1 == t2 - && and (zipWith (eqExprWith eqBid env) a1 a2) + && eqLists (eqExprWith eqBid env) a1 a2 in (env', eq) _ -> (env, False) @@ -326,6 +326,11 @@ eqMiddleWith dflags eqBid env a b = defd_a = foldLocalRegsDefd dflags (flip (:)) [] a defd_b = foldLocalRegsDefd dflags (flip (:)) [] b +eqLists :: (a -> b -> Bool) -> [a] -> [b] -> Bool +eqLists f (a:as) (b:bs) = f a b && eqLists f as bs +eqLists _ [] [] = True +eqLists _ _ _ = False + eqExprWith :: (BlockId -> BlockId -> Bool) -> LocalRegMapping -> CmmExpr -> CmmExpr @@ -340,7 +345,7 @@ eqExprWith eqBid env = eq CmmStackSlot a1 i1 `eq` CmmStackSlot a2 i2 = eqArea a1 a2 && i1==i2 _e1 `eq` _e2 = False - xs `eqs` ys = and (zipWith eq xs ys) + xs `eqs` ys = eqLists eq xs ys -- See Note [Equivalence up to local registers in CBE] CmmLocal a `eqReg` CmmLocal b @@ -399,7 +404,7 @@ eqLastWith eqBid env a b = (CmmForeignCall t1 _ a1 s1 ret_args1 ret_off1 intrbl1, CmmForeignCall t2 _ a2 s2 ret_args2 ret_off2 intrbl2) -> t1 == t2 - && and (zipWith (eqExprWith eqBid env) a1 a2) + && eqLists (eqExprWith eqBid env) a1 a2 && s1 == s2 && ret_args1 == ret_args2 && ret_off1 == ret_off2 From git at git.haskell.org Mon Nov 6 21:39:50 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Nov 2017 21:39:50 +0000 (UTC) Subject: [commit: ghc] master: Typo in glasgow_exts.rst (2ded536) Message-ID: <20171106213950.AE40C3A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2ded53681463fa03af7f73a9b745289fa4822afe/ghc >--------------------------------------------------------------- commit 2ded53681463fa03af7f73a9b745289fa4822afe Author: Douglas Wilson Date: Mon Nov 6 15:34:51 2017 -0500 Typo in glasgow_exts.rst Reviewers: austin, bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie Differential Revision: https://phabricator.haskell.org/D4157 >--------------------------------------------------------------- 2ded53681463fa03af7f73a9b745289fa4822afe docs/users_guide/glasgow_exts.rst | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/docs/users_guide/glasgow_exts.rst b/docs/users_guide/glasgow_exts.rst index a86392f..ab92375 100644 --- a/docs/users_guide/glasgow_exts.rst +++ b/docs/users_guide/glasgow_exts.rst @@ -515,7 +515,7 @@ Hexadecimal floating point literals ----------------------------------- .. ghc-flag:: -XHexFloatLiterals - :shortdesc: Enable support for :ref:`hexadecimal floating point literals `. + :shortdesc: Enable support for :ref:`hexadecimal floating point literals `. :type: dynamic :reverse: -XNoHexFloatLIterals :category: From git at git.haskell.org Mon Nov 6 21:39:53 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Nov 2017 21:39:53 +0000 (UTC) Subject: [commit: ghc] master: Update ErrorCall documentation for the location argument (35642f4) Message-ID: <20171106213953.79C563A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/35642f434ae9dff0d1bb8b5a6f1e725cd051c726/ghc >--------------------------------------------------------------- commit 35642f434ae9dff0d1bb8b5a6f1e725cd051c726 Author: Ömer Sinan Ağacan Date: Mon Nov 6 15:35:08 2017 -0500 Update ErrorCall documentation for the location argument Reviewers: hvr, bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie Differential Revision: https://phabricator.haskell.org/D4163 >--------------------------------------------------------------- 35642f434ae9dff0d1bb8b5a6f1e725cd051c726 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 725b864..d3a6745 100644 --- a/libraries/base/GHC/Exception.hs +++ b/libraries/base/GHC/Exception.hs @@ -167,8 +167,8 @@ instance Exception SomeException where throw :: Exception e => e -> a throw e = raise# (toException e) --- |This is thrown when the user calls 'error'. The @String@ is the --- argument given to 'error'. +-- | This is thrown when the user calls 'error'. The first @String@ is the +-- argument given to 'error', second @String@ is the location. data ErrorCall = ErrorCallWithLocation String String deriving (Eq, Ord) From git at git.haskell.org Mon Nov 6 21:39:56 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Nov 2017 21:39:56 +0000 (UTC) Subject: [commit: ghc] master: DynFlags: Introduce -show-mods-loaded flag (8613e61) Message-ID: <20171106213956.464EA3A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8613e61de62178e76cd0f8915bd1fbe9c200a039/ghc >--------------------------------------------------------------- commit 8613e61de62178e76cd0f8915bd1fbe9c200a039 Author: Ben Gamari Date: Mon Nov 6 15:35:19 2017 -0500 DynFlags: Introduce -show-mods-loaded flag This flag reintroduces the verbose module name output produced by GHCi's :load command behind a new flag, -show-mods-loaded. This was originally removed in D3651 but apparently some tools (e.g. haskell-mode) rely on this output. Addresses #14427. Test Plan: Validate Reviewers: svenpanne Reviewed By: svenpanne Subscribers: rwbarton, thomie Differential Revision: https://phabricator.haskell.org/D4164 >--------------------------------------------------------------- 8613e61de62178e76cd0f8915bd1fbe9c200a039 compiler/main/DynFlags.hs | 2 ++ docs/users_guide/ghci.rst | 13 ++++++++++ ghc/GHCi/UI.hs | 38 ++++++++++++++++++++--------- testsuite/tests/driver/T8526/T8526.stdout | 4 +-- testsuite/tests/ghci/scripts/T1914.stdout | 6 ++--- testsuite/tests/ghci/scripts/T6105.stdout | 4 +-- testsuite/tests/ghci/scripts/ghci058.stdout | 4 +-- 7 files changed, 50 insertions(+), 21 deletions(-) diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 825497e..0e6310e 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -544,6 +544,7 @@ data GeneralFlag | Opt_PprCaseAsLet | Opt_PprShowTicks | Opt_ShowHoleConstraints + | Opt_ShowLoadedModules -- Suppress all coercions, them replacing with '...' | Opt_SuppressCoercions @@ -3809,6 +3810,7 @@ fFlagsDeps = [ flagSpec "show-warning-groups" Opt_ShowWarnGroups, flagSpec "hide-source-paths" Opt_HideSourcePaths, flagSpec "show-hole-constraints" Opt_ShowHoleConstraints, + flagSpec "show-loaded-modules" Opt_ShowLoadedModules, flagSpec "whole-archive-hs-libs" Opt_WholeArchiveHsLibs ] diff --git a/docs/users_guide/ghci.rst b/docs/users_guide/ghci.rst index d2bb33d..1711903 100644 --- a/docs/users_guide/ghci.rst +++ b/docs/users_guide/ghci.rst @@ -138,6 +138,19 @@ them all in dependency order. Windows, then the current directory is probably something like ``C:\Documents and Settings\user name``. +.. ghc-flag:: -fshow-loaded-modules + :shortdesc: Show the names of modules that GHCi loaded after a + :ghci-cmd:`:load` command. + :type: dynamic + :default: off + + :since: 8.2.2 + + Typically GHCi will show only the number of modules that it loaded after a + :ghci-cmd:`:load` command. With this flag, GHC will also list the loaded + modules' names. This was the default behavior prior to GHC 8.2.1 and can be + useful for some tooling users. + .. _ghci-modules-filenames: diff --git a/ghc/GHCi/UI.hs b/ghc/GHCi/UI.hs index 32e581a..01c8505 100644 --- a/ghc/GHCi/UI.hs +++ b/ghc/GHCi/UI.hs @@ -51,7 +51,7 @@ import GHC ( LoadHowMuch(..), Target(..), TargetId(..), InteractiveImport(..), import HsImpExp import HsSyn import HscTypes ( tyThingParent_maybe, handleFlagWarnings, getSafeMode, hsc_IC, - setInteractivePrintName, hsc_dflags ) + setInteractivePrintName, hsc_dflags, msObjFilePath ) import Module import Name import Packages ( trusted, getPackageDetails, getInstalledPackageDetails, @@ -1726,7 +1726,7 @@ afterLoad ok retain_context = do lift revertCAFs -- always revert CAFs on load. lift discardTickArrays loaded_mods <- getLoadedModules - modulesLoadedMsg ok (length loaded_mods) + modulesLoadedMsg ok loaded_mods lift $ setContextAfterLoad retain_context loaded_mods setContextAfterLoad :: Bool -> [GHC.ModSummary] -> GHCi () @@ -1802,22 +1802,36 @@ keepPackageImports = filterM is_pkg_import mod_name = unLoc (ideclName d) -modulesLoadedMsg :: SuccessFlag -> Int -> InputT GHCi () -modulesLoadedMsg ok num_mods = do +modulesLoadedMsg :: SuccessFlag -> [GHC.ModSummary] -> InputT GHCi () +modulesLoadedMsg ok mods = do dflags <- getDynFlags unqual <- GHC.getPrintUnqual - let status = case ok of - Failed -> text "Failed" - Succeeded -> text "Ok" - num_mods_pp = if num_mods == 1 - then "1 module" - else int num_mods <+> "modules" - msg = status <> text "," <+> num_mods_pp <+> "loaded." + msg <- if gopt Opt_ShowLoadedModules dflags + then do + mod_names <- mapM mod_name mods + let mod_commas + | null mods = text "none." + | otherwise = hsep (punctuate comma mod_names) <> text "." + return $ status <> text ", modules loaded:" <+> mod_commas + else do + return $ status <> text "," + <+> speakNOf (length mods) (text "module") <+> "loaded." when (verbosity dflags > 0) $ liftIO $ putStrLn $ showSDocForUser dflags unqual msg - + where + status = case ok of + Failed -> text "Failed" + Succeeded -> text "Ok" + + mod_name mod = do + is_interpreted <- GHC.moduleIsBootOrNotObjectLinkable mod + return $ if is_interpreted + then ppr (GHC.ms_mod mod) + else ppr (GHC.ms_mod mod) + <+> parens (text $ normalise $ msObjFilePath mod) + -- Fix #9887 -- | Run an 'ExceptT' wrapped 'GhcMonad' while handling source errors -- and printing 'throwE' strings to 'stderr' diff --git a/testsuite/tests/driver/T8526/T8526.stdout b/testsuite/tests/driver/T8526/T8526.stdout index 83b8f95..0255fa3 100644 --- a/testsuite/tests/driver/T8526/T8526.stdout +++ b/testsuite/tests/driver/T8526/T8526.stdout @@ -1,6 +1,6 @@ [1 of 1] Compiling A ( A.hs, interpreted ) -Ok, 1 module loaded. +Ok, one module loaded. True [1 of 1] Compiling A ( A.hs, interpreted ) -Ok, 1 module loaded. +Ok, one module loaded. False diff --git a/testsuite/tests/ghci/scripts/T1914.stdout b/testsuite/tests/ghci/scripts/T1914.stdout index 2d1a82b..6612564 100644 --- a/testsuite/tests/ghci/scripts/T1914.stdout +++ b/testsuite/tests/ghci/scripts/T1914.stdout @@ -1,7 +1,7 @@ [1 of 2] Compiling T1914B ( T1914B.hs, interpreted ) [2 of 2] Compiling T1914A ( T1914A.hs, interpreted ) -Ok, 2 modules loaded. +Ok, two modules loaded. [2 of 2] Compiling T1914A ( T1914A.hs, interpreted ) -Failed, 1 module loaded. +Failed, one module loaded. [2 of 2] Compiling T1914A ( T1914A.hs, interpreted ) -Ok, 2 modules loaded. +Ok, two modules loaded. diff --git a/testsuite/tests/ghci/scripts/T6105.stdout b/testsuite/tests/ghci/scripts/T6105.stdout index 6a846e3..9a8190f 100644 --- a/testsuite/tests/ghci/scripts/T6105.stdout +++ b/testsuite/tests/ghci/scripts/T6105.stdout @@ -1,4 +1,4 @@ [1 of 1] Compiling T6105 ( T6105.hs, interpreted ) -Ok, 1 module loaded. +Ok, one module loaded. [1 of 1] Compiling T6105 ( T6105.hs, interpreted ) -Ok, 1 module loaded. +Ok, one module loaded. diff --git a/testsuite/tests/ghci/scripts/ghci058.stdout b/testsuite/tests/ghci/scripts/ghci058.stdout index 2028aee..83c8bbd 100644 --- a/testsuite/tests/ghci/scripts/ghci058.stdout +++ b/testsuite/tests/ghci/scripts/ghci058.stdout @@ -1,4 +1,4 @@ -Ok, 1 module loaded. +Ok, one module loaded. 'a' -Ok, 1 module loaded. +Ok, one module loaded. 'b' From git at git.haskell.org Mon Nov 6 21:39:59 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Nov 2017 21:39:59 +0000 (UTC) Subject: [commit: ghc] master: Specialise lcm :: Word -> Word -> Word (trac#14424) (66b5b3e) Message-ID: <20171106213959.054993A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/66b5b3eef1aa9fa9f192a85847d34b2756bec33f/ghc >--------------------------------------------------------------- commit 66b5b3eef1aa9fa9f192a85847d34b2756bec33f Author: Bodigrim Date: Mon Nov 6 21:49:11 2017 +0200 Specialise lcm :: Word -> Word -> Word (trac#14424) >--------------------------------------------------------------- 66b5b3eef1aa9fa9f192a85847d34b2756bec33f libraries/base/GHC/Real.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/libraries/base/GHC/Real.hs b/libraries/base/GHC/Real.hs index 6206598..85a1602 100644 --- a/libraries/base/GHC/Real.hs +++ b/libraries/base/GHC/Real.hs @@ -631,6 +631,7 @@ gcd x y = gcd' (abs x) (abs y) -- | @'lcm' x y@ is the smallest positive integer that both @x@ and @y@ divide. lcm :: (Integral a) => a -> a -> a {-# SPECIALISE lcm :: Int -> Int -> Int #-} +{-# SPECIALISE lcm :: Word -> Word -> Word #-} {-# NOINLINE [1] lcm #-} lcm _ 0 = 0 lcm 0 _ = 0 From git at git.haskell.org Mon Nov 6 21:40:01 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Nov 2017 21:40:01 +0000 (UTC) Subject: [commit: ghc] master: Update autoconf test for gcc to require 4.7 and up (59de290) Message-ID: <20171106214001.E1E0C3A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/59de290928e6903337f31c1f8107ac8a98ea145d/ghc >--------------------------------------------------------------- commit 59de290928e6903337f31c1f8107ac8a98ea145d Author: Peter Trommler Date: Mon Nov 6 15:35:30 2017 -0500 Update autoconf test for gcc to require 4.7 and up Fixing #14244 required the newer gcc atomic built-ins that are provided from 4.7 and up. This updates the test to check for minimum gcc version 4.7. The version tests for 3.4 (!), 4.4, and 4.6 are no longer needed and can be removed. This makes the build system simpler. Test Plan: validate Reviewers: austin, bgamari, hvr, simonmar Reviewed By: bgamari Subscribers: rwbarton, thomie, erikd Differential Revision: https://phabricator.haskell.org/D4165 >--------------------------------------------------------------- 59de290928e6903337f31c1f8107ac8a98ea145d aclocal.m4 | 16 ++-------------- mk/config.mk.in | 3 --- mk/warnings.mk | 6 +----- rts/ghc.mk | 6 ------ 4 files changed, 3 insertions(+), 28 deletions(-) diff --git a/aclocal.m4 b/aclocal.m4 index c8c5985..c5fdd1e 100644 --- a/aclocal.m4 +++ b/aclocal.m4 @@ -1229,27 +1229,15 @@ if test -z "$CC" then AC_MSG_ERROR([gcc is required]) fi -GccLT34=NO -GccLT44=NO -GccLT46=NO AC_CACHE_CHECK([version of gcc], [fp_cv_gcc_version], [ # Be sure only to look at the first occurrence of the "version " string; # Some Apple compilers emit multiple messages containing this string. fp_cv_gcc_version="`$CC -v 2>&1 | sed -n -e '1,/version /s/.*version [[^0-9]]*\([[0-9.]]*\).*/\1/p'`" - FP_COMPARE_VERSIONS([$fp_cv_gcc_version], [-lt], [3.0], - [AC_MSG_ERROR([Need at least gcc version 3.0 (3.4+ recommended)])]) - # See #2770: gcc 2.95 doesn't work any more, apparently. There probably - # isn't a very good reason for that, but for now just make configure - # fail. - FP_COMPARE_VERSIONS([$fp_cv_gcc_version], [-lt], [3.4], GccLT34=YES) - FP_COMPARE_VERSIONS([$fp_cv_gcc_version], [-lt], [4.4], GccLT44=YES) - FP_COMPARE_VERSIONS([$fp_cv_gcc_version], [-lt], [4.6], GccLT46=YES) + FP_COMPARE_VERSIONS([$fp_cv_gcc_version], [-lt], [4.7], + [AC_MSG_ERROR([Need at least gcc version 4.7])]) ]) AC_SUBST([GccVersion], [$fp_cv_gcc_version]) -AC_SUBST(GccLT34) -AC_SUBST(GccLT44) -AC_SUBST(GccLT46) ])# FP_GCC_VERSION dnl Check to see if the C compiler is clang or llvm-gcc diff --git a/mk/config.mk.in b/mk/config.mk.in index 92661a3..b046abe 100644 --- a/mk/config.mk.in +++ b/mk/config.mk.in @@ -522,9 +522,6 @@ GccVersion = @GccVersion@ # TargetPlatformFull retains the string passed to configure so we have it in # the necessary format to pass to libffi's configure. TargetPlatformFull = @TargetPlatformFull@ -GccLT34 = @GccLT34@ -GccLT44 = @GccLT44@ -GccLT46 = @GccLT46@ GccIsClang = @GccIsClang@ CC = @CC@ diff --git a/mk/warnings.mk b/mk/warnings.mk index 85cb1a0..69990a7 100644 --- a/mk/warnings.mk +++ b/mk/warnings.mk @@ -20,21 +20,17 @@ GhcStage2HcOpts += -Wcpp-undef ifneq "$(GccIsClang)" "YES" # Debian doesn't turn -Werror=unused-but-set-variable on by default, so -# we turn it on explicitly for consistency with other users -ifeq "$(GccLT46)" "NO" +# we turn it on explicitly for consistency with other users. # Never set the flag on Windows as the host gcc may be too old. ifneq "$(HostOS_CPP)" "mingw32" SRC_CC_WARNING_OPTS += -Werror=unused-but-set-variable endif -endif -ifeq "$(GccLT44)" "NO" # Suppress the warning about __sync_fetch_and_nand (#9678). libraries/ghc-prim/cbits/atomic_CC_OPTS += -Wno-sync-nand # gcc 4.6 gives 3 warnings for giveCapabilityToTask not being inlined # gcc 4.4 gives 2 warnings for lockClosure not being inlined SRC_CC_WARNING_OPTS += -Wno-error=inline -endif else diff --git a/rts/ghc.mk b/rts/ghc.mk index 57db297..3ba7e53 100644 --- a/rts/ghc.mk +++ b/rts/ghc.mk @@ -301,11 +301,7 @@ $(eval $(call distdir-opts,rts,dist,1)) # We like plenty of warnings. WARNING_OPTS += -Wall -ifeq "$(GccLT34)" "YES" -WARNING_OPTS += -W -else WARNING_OPTS += -Wextra -endif WARNING_OPTS += -Wstrict-prototypes WARNING_OPTS += -Wmissing-prototypes WARNING_OPTS += -Wmissing-declarations @@ -315,9 +311,7 @@ WARNING_OPTS += -Wpointer-arith WARNING_OPTS += -Wmissing-noreturn WARNING_OPTS += -Wnested-externs WARNING_OPTS += -Wredundant-decls -ifeq "$(GccLT46)" "NO" WARNING_OPTS += -Wundef -endif # These ones are hard to avoid: #WARNING_OPTS += -Wconversion From git at git.haskell.org Mon Nov 6 21:44:16 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Nov 2017 21:44:16 +0000 (UTC) Subject: [commit: ghc] master: base: Add examples to Bifunctor documentation (275ac8e) Message-ID: <20171106214416.B7A2B3A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/275ac8ef0a0081f16abbfb8934e10cf271573768/ghc >--------------------------------------------------------------- commit 275ac8ef0a0081f16abbfb8934e10cf271573768 Author: Julie Moronuki Date: Tue Oct 31 23:28:46 2017 -0400 base: Add examples to Bifunctor documentation >--------------------------------------------------------------- 275ac8ef0a0081f16abbfb8934e10cf271573768 libraries/base/Data/Bifunctor.hs | 37 ++++++++++++++++++++++++++++++++++++- 1 file changed, 36 insertions(+), 1 deletion(-) diff --git a/libraries/base/Data/Bifunctor.hs b/libraries/base/Data/Bifunctor.hs index 5441605..04de5ad 100644 --- a/libraries/base/Data/Bifunctor.hs +++ b/libraries/base/Data/Bifunctor.hs @@ -20,7 +20,15 @@ module Data.Bifunctor import Control.Applicative ( Const(..) ) import GHC.Generics ( K1(..) ) --- | Formally, the class 'Bifunctor' represents a bifunctor +-- | A bifunctor is a type constructor that takes +-- two type arguments and is a functor in /both/ arguments. That +-- is, unlike with 'Functor', a type constructor such as 'Either' +-- does not need to be partially applied for a 'Bifunctor' +-- instance, and the methods in this class permit mapping +-- functions over the 'Left' value or the 'Right' value, +-- or both at the same time. +-- +-- Formally, the class 'Bifunctor' represents a bifunctor -- from @Hask@ -> @Hask at . -- -- Intuitively it is a bifunctor where both the first and second @@ -59,22 +67,49 @@ class Bifunctor p where -- | Map over both arguments at the same time. -- -- @'bimap' f g ≡ 'first' f '.' 'second' g@ + -- + -- ==== __Examples__ + -- >>> bimap toUpper (+1) ('j', 3) + -- ('J',4) + -- + -- >>> bimap toUpper (+1) (Left 'j') + -- Left 'J' + -- + -- >>> bimap toUpper (+1) (Right 3) + -- Right 4 bimap :: (a -> b) -> (c -> d) -> p a c -> p b d bimap f g = first f . second g + -- | Map covariantly over the first argument. -- -- @'first' f ≡ 'bimap' f 'id'@ + -- + -- ==== __Examples__ + -- >>> first toUpper ('j', 3) + -- ('J',3) + -- + -- >>> first toUpper (Left 'j') + -- Left 'J' first :: (a -> b) -> p a c -> p b c first f = bimap f id + -- | Map covariantly over the second argument. -- -- @'second' ≡ 'bimap' 'id'@ + -- + -- ==== __Examples__ + -- >>> second (+1) ('j', 3) + -- ('j',4) + -- + -- >>> second (+1) (Right 3) + -- Right 4 second :: (b -> c) -> p a b -> p a c second = bimap id + -- | @since 4.8.0.0 instance Bifunctor (,) where bimap f g ~(a, b) = (f a, g b) From git at git.haskell.org Mon Nov 6 21:51:16 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Nov 2017 21:51:16 +0000 (UTC) Subject: [commit: ghc] branch 'wip/use-O2' created Message-ID: <20171106215116.D20E73A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/use-O2 Referencing: fc6f58477fe0ecdc5ede3d6b7e6590caacb926ef From git at git.haskell.org Mon Nov 6 21:51:19 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Nov 2017 21:51:19 +0000 (UTC) Subject: [commit: ghc] wip/use-O2: Change `OPTIONS_GHC -O` to `OPTIONS_GHC -O2` (fc6f584) Message-ID: <20171106215119.952B43A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/use-O2 Link : http://ghc.haskell.org/trac/ghc/changeset/fc6f58477fe0ecdc5ede3d6b7e6590caacb926ef/ghc >--------------------------------------------------------------- commit fc6f58477fe0ecdc5ede3d6b7e6590caacb926ef Author: Douglas Wilson Date: Mon Nov 6 16:50:39 2017 -0500 Change `OPTIONS_GHC -O` to `OPTIONS_GHC -O2` These pragmas were having the perverse effect of having these performance critical modules be LESS optimized in builds with -O2. Test Plan: Check on gipedia whether this is worthwhile. Reviewers: austin, bgamari Subscribers: rwbarton, thomie Differential Revision: https://phabricator.haskell.org/D4156 >--------------------------------------------------------------- fc6f58477fe0ecdc5ede3d6b7e6590caacb926ef compiler/iface/BinIface.hs | 2 +- compiler/utils/Binary.hs | 2 +- compiler/utils/Encoding.hs | 2 +- compiler/utils/FastMutInt.hs | 2 +- compiler/utils/FastString.hs | 2 +- compiler/utils/StringBuffer.hs | 2 +- 6 files changed, 6 insertions(+), 6 deletions(-) diff --git a/compiler/iface/BinIface.hs b/compiler/iface/BinIface.hs index 8ab2310..31b5af0 100644 --- a/compiler/iface/BinIface.hs +++ b/compiler/iface/BinIface.hs @@ -4,7 +4,7 @@ -- (c) The University of Glasgow 2002-2006 -- -{-# OPTIONS_GHC -O #-} +{-# OPTIONS_GHC -O2 #-} -- We always optimise this, otherwise performance of a non-optimised -- compiler is severely affected diff --git a/compiler/utils/Binary.hs b/compiler/utils/Binary.hs index a7bbfd5..c3c8ae3 100644 --- a/compiler/utils/Binary.hs +++ b/compiler/utils/Binary.hs @@ -5,7 +5,7 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE MultiWayIf #-} -{-# OPTIONS_GHC -O -funbox-strict-fields #-} +{-# OPTIONS_GHC -O2 -funbox-strict-fields #-} -- We always optimise this, otherwise performance of a non-optimised -- compiler is severely affected diff --git a/compiler/utils/Encoding.hs b/compiler/utils/Encoding.hs index f809ba9..b4af686 100644 --- a/compiler/utils/Encoding.hs +++ b/compiler/utils/Encoding.hs @@ -1,5 +1,5 @@ {-# LANGUAGE BangPatterns, MagicHash, UnboxedTuples #-} -{-# OPTIONS_GHC -O #-} +{-# OPTIONS_GHC -O2 #-} -- We always optimise this, otherwise performance of a non-optimised -- compiler is severely affected diff --git a/compiler/utils/FastMutInt.hs b/compiler/utils/FastMutInt.hs index 6ba139a..20206f8 100644 --- a/compiler/utils/FastMutInt.hs +++ b/compiler/utils/FastMutInt.hs @@ -1,5 +1,5 @@ {-# LANGUAGE BangPatterns, MagicHash, UnboxedTuples #-} -{-# OPTIONS_GHC -O #-} +{-# OPTIONS_GHC -O2 #-} -- We always optimise this, otherwise performance of a non-optimised -- compiler is severely affected -- diff --git a/compiler/utils/FastString.hs b/compiler/utils/FastString.hs index fde4ff0..f16b327 100644 --- a/compiler/utils/FastString.hs +++ b/compiler/utils/FastString.hs @@ -2,7 +2,7 @@ {-# LANGUAGE BangPatterns, CPP, MagicHash, UnboxedTuples, GeneralizedNewtypeDeriving #-} -{-# OPTIONS_GHC -O -funbox-strict-fields #-} +{-# OPTIONS_GHC -O2 -funbox-strict-fields #-} -- We always optimise this, otherwise performance of a non-optimised -- compiler is severely affected diff --git a/compiler/utils/StringBuffer.hs b/compiler/utils/StringBuffer.hs index 0840210..39941e2 100644 --- a/compiler/utils/StringBuffer.hs +++ b/compiler/utils/StringBuffer.hs @@ -7,7 +7,7 @@ Buffers for scanning string input stored in external arrays. -} {-# LANGUAGE BangPatterns, CPP, MagicHash, UnboxedTuples #-} -{-# OPTIONS_GHC -O #-} +{-# OPTIONS_GHC -O2 #-} -- We always optimise this, otherwise performance of a non-optimised -- compiler is severely affected From git at git.haskell.org Mon Nov 6 23:01:17 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Nov 2017 23:01:17 +0000 (UTC) Subject: [commit: ghc] branch 'wip/hadrian' created Message-ID: <20171106230117.CA99B3A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/hadrian Referencing: 5cee48036ed69ae298a599d43cf72e0fe73e3b4e From git at git.haskell.org Mon Nov 6 23:01:24 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Nov 2017 23:01:24 +0000 (UTC) Subject: [commit: ghc] wip/hadrian: Merge commit '7b0b9f603bb1215e2b7af23c2404d637b95a4988' as 'hadrian' (5cee480) Message-ID: <20171106230124.60B493A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/hadrian Link : http://ghc.haskell.org/trac/ghc/changeset/5cee48036ed69ae298a599d43cf72e0fe73e3b4e/ghc >--------------------------------------------------------------- commit 5cee48036ed69ae298a599d43cf72e0fe73e3b4e Merge: 275ac8e 7b0b9f6 Author: Andrey Mokhov Date: Mon Nov 6 22:59:38 2017 +0000 Merge commit '7b0b9f603bb1215e2b7af23c2404d637b95a4988' as 'hadrian' >--------------------------------------------------------------- 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 5cee48036ed69ae298a599d43cf72e0fe73e3b4e From git at git.haskell.org Mon Nov 6 23:01:21 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 6 Nov 2017 23:01:21 +0000 (UTC) Subject: [commit: ghc] wip/hadrian: Squashed 'hadrian/' content from commit 438dc57 (7b0b9f6) Message-ID: <20171106230121.4A5953A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/hadrian Link : http://ghc.haskell.org/trac/ghc/changeset/7b0b9f603bb1215e2b7af23c2404d637b95a4988/ghc >--------------------------------------------------------------- commit 7b0b9f603bb1215e2b7af23c2404d637b95a4988 Author: Andrey Mokhov Date: Mon Nov 6 22:59:37 2017 +0000 Squashed 'hadrian/' content from commit 438dc57 git-subtree-dir: hadrian git-subtree-split: 438dc576e7b84c473a09d1d7ec7798a30303bc4e >--------------------------------------------------------------- 7b0b9f603bb1215e2b7af23c2404d637b95a4988 .ghci | 11 + .gitignore | 26 ++ .travis.yml | 90 ++++++ LICENSE | 21 ++ README.md | 194 +++++++++++++ appveyor.yml | 39 +++ build.bat | 6 + build.cabal.sh | 74 +++++ build.global-db.bat | 32 ++ build.global-db.sh | 52 ++++ build.sh | 35 +++ build.stack.bat | 11 + build.stack.nix.sh | 33 +++ build.stack.sh | 39 +++ cabal.project | 2 + cfg/system.config.in | 141 +++++++++ circle.yml | 41 +++ doc/cross-compile.md | 57 ++++ doc/flavours.md | 176 +++++++++++ doc/user-settings.md | 212 ++++++++++++++ doc/windows.md | 69 +++++ hadrian.cabal | 142 +++++++++ src/Base.hs | 121 ++++++++ src/Builder.hs | 296 +++++++++++++++++++ src/CommandLine.hs | 137 +++++++++ src/Context.hs | 158 ++++++++++ src/Environment.hs | 16 + src/Expression.hs | 123 ++++++++ src/Flavour.hs | 34 +++ src/GHC.hs | 289 ++++++++++++++++++ src/Hadrian/Builder.hs | 125 ++++++++ src/Hadrian/Builder/Ar.hs | 68 +++++ src/Hadrian/Builder/Sphinx.hs | 39 +++ src/Hadrian/Builder/Tar.hs | 40 +++ src/Hadrian/Expression.hs | 153 ++++++++++ src/Hadrian/Haskell/Cabal.hs | 44 +++ src/Hadrian/Haskell/Cabal/Parse.hs | 63 ++++ src/Hadrian/Oracles/ArgsHash.hs | 51 ++++ src/Hadrian/Oracles/DirectoryContents.hs | 64 ++++ src/Hadrian/Oracles/Path.hs | 62 ++++ src/Hadrian/Oracles/TextFile.hs | 123 ++++++++ src/Hadrian/Package.hs | 120 ++++++++ src/Hadrian/Target.hs | 29 ++ src/Hadrian/Utilities.hs | 406 ++++++++++++++++++++++++++ src/Main.hs | 59 ++++ src/Oracles/Flag.hs | 80 +++++ src/Oracles/ModuleFiles.hs | 160 ++++++++++ src/Oracles/PackageData.hs | 66 +++++ src/Oracles/Setting.hs | 236 +++++++++++++++ src/Rules.hs | 123 ++++++++ src/Rules/Clean.hs | 23 ++ src/Rules/Compile.hs | 83 ++++++ src/Rules/Configure.hs | 42 +++ src/Rules/Dependencies.hs | 33 +++ src/Rules/Documentation.hs | 197 +++++++++++++ src/Rules/Generate.hs | 482 +++++++++++++++++++++++++++++++ src/Rules/Gmp.hs | 119 ++++++++ src/Rules/Install.hs | 336 +++++++++++++++++++++ src/Rules/Libffi.hs | 108 +++++++ src/Rules/Library.hs | 103 +++++++ src/Rules/PackageData.hs | 119 ++++++++ src/Rules/Program.hs | 116 ++++++++ src/Rules/Register.hs | 44 +++ src/Rules/Selftest.hs | 92 ++++++ src/Rules/SourceDist.hs | 113 ++++++++ src/Rules/Test.hs | 72 +++++ src/Rules/Wrappers.hs | 162 +++++++++++ src/Settings.hs | 68 +++++ src/Settings/Builders/Alex.hs | 8 + src/Settings/Builders/Cc.hs | 26 ++ src/Settings/Builders/Common.hs | 59 ++++ src/Settings/Builders/Configure.hs | 25 ++ src/Settings/Builders/DeriveConstants.hs | 39 +++ src/Settings/Builders/GenPrimopCode.hs | 24 ++ src/Settings/Builders/Ghc.hs | 149 ++++++++++ src/Settings/Builders/GhcCabal.hs | 118 ++++++++ src/Settings/Builders/GhcPkg.hs | 17 ++ src/Settings/Builders/Haddock.hs | 63 ++++ src/Settings/Builders/Happy.hs | 9 + src/Settings/Builders/HsCpp.hs | 16 + src/Settings/Builders/Hsc2Hs.hs | 56 ++++ src/Settings/Builders/Ld.hs | 9 + src/Settings/Builders/Make.hs | 16 + src/Settings/Builders/Xelatex.hs | 7 + src/Settings/Default.hs | 173 +++++++++++ src/Settings/Default.hs-boot | 20 ++ src/Settings/Flavours/Development.hs | 20 ++ src/Settings/Flavours/Performance.hs | 18 ++ src/Settings/Flavours/Profiled.hs | 19 ++ src/Settings/Flavours/Quick.hs | 22 ++ src/Settings/Flavours/QuickCross.hs | 24 ++ src/Settings/Flavours/Quickest.hs | 23 ++ src/Settings/Packages/Base.hs | 12 + src/Settings/Packages/Cabal.hs | 10 + src/Settings/Packages/Compiler.hs | 45 +++ src/Settings/Packages/Ghc.hs | 13 + src/Settings/Packages/GhcCabal.hs | 24 ++ src/Settings/Packages/GhcPkg.hs | 7 + src/Settings/Packages/GhcPrim.hs | 13 + src/Settings/Packages/Ghci.hs | 6 + src/Settings/Packages/Haddock.hs | 7 + src/Settings/Packages/Haskeline.hs | 8 + src/Settings/Packages/IntegerGmp.hs | 24 ++ src/Settings/Packages/Rts.hs | 218 ++++++++++++++ src/Settings/Packages/RunGhc.hs | 9 + src/Settings/Warnings.hs | 57 ++++ src/Stage.hs | 31 ++ src/Target.hs | 26 ++ src/UserSettings.hs | 64 ++++ src/Utilities.hs | 80 +++++ src/Way.hs | 162 +++++++++++ stack.yaml | 22 ++ 112 files changed, 8898 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 7b0b9f603bb1215e2b7af23c2404d637b95a4988 From git at git.haskell.org Tue Nov 7 06:31:05 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 7 Nov 2017 06:31:05 +0000 (UTC) Subject: [commit: ghc] master: WIP on combining Step 1 and 3 of Trees That Grow (0ff152c) Message-ID: <20171107063105.4A6663A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/0ff152c9e633accca48815e26e59d1af1fe44ceb/ghc >--------------------------------------------------------------- commit 0ff152c9e633accca48815e26e59d1af1fe44ceb Author: Alan Zimmerman Date: Sun Nov 5 21:49:11 2017 +0200 WIP on combining Step 1 and 3 of Trees That Grow See https://ghc.haskell.org/trac/ghc/wiki/ImplementingTreesThatGrow Trees that grow extension points are added for - ValBinds - HsPat - HsLit - HsOverLit - HsType - HsTyVarBndr - HsAppType - FieldOcc - AmbiguousFieldOcc Updates haddock submodule Test Plan: ./validate Reviewers: shayan-najd, simonpj, austin, goldfire, bgamari Subscribers: goldfire, rwbarton, thomie, mpickering Differential Revision: https://phabricator.haskell.org/D4147 >--------------------------------------------------------------- 0ff152c9e633accca48815e26e59d1af1fe44ceb compiler/deSugar/Check.hs | 53 +-- compiler/deSugar/DsArrows.hs | 30 +- compiler/deSugar/DsExpr.hs | 2 +- compiler/deSugar/DsMeta.hs | 108 ++--- compiler/deSugar/DsUtils.hs | 63 +-- compiler/deSugar/Match.hs | 72 ++-- compiler/deSugar/MatchLit.hs | 27 +- compiler/hsSyn/Convert.hs | 162 +++---- compiler/hsSyn/HsBinds.hs | 150 +++++-- compiler/hsSyn/HsDecls.hs | 154 +++---- compiler/hsSyn/HsExpr.hs | 246 ++++++----- compiler/hsSyn/HsExpr.hs-boot | 46 +- compiler/hsSyn/HsExtension.hs | 328 ++++++++++---- compiler/hsSyn/HsLit.hs | 71 ++- compiler/hsSyn/HsPat.hs | 303 ++++++++----- compiler/hsSyn/HsPat.hs-boot | 6 +- compiler/hsSyn/HsSyn.hs | 5 +- compiler/hsSyn/HsTypes.hs | 478 +++++++++++++-------- compiler/hsSyn/HsUtils.hs | 186 ++++---- compiler/hsSyn/PlaceHolder.hs | 9 +- compiler/main/HscStats.hs | 2 +- compiler/main/InteractiveEval.hs | 3 +- compiler/parser/Parser.y | 99 ++--- compiler/parser/RdrHsSyn.hs | 103 ++--- compiler/rename/RnBinds.hs | 10 +- compiler/rename/RnExpr.hs | 46 +- compiler/rename/RnFixity.hs | 5 +- compiler/rename/RnNames.hs | 20 +- compiler/rename/RnPat.hs | 93 ++-- compiler/rename/RnSource.hs | 12 +- compiler/rename/RnSplice.hs | 16 +- compiler/rename/RnSplice.hs-boot | 4 +- compiler/rename/RnTypes.hs | 283 ++++++------ compiler/typecheck/Inst.hs | 16 +- compiler/typecheck/TcAnnotations.hs | 3 +- compiler/typecheck/TcBinds.hs | 5 +- compiler/typecheck/TcDeriv.hs | 2 +- compiler/typecheck/TcEnv.hs | 6 +- compiler/typecheck/TcExpr.hs | 43 +- compiler/typecheck/TcGenDeriv.hs | 15 +- compiler/typecheck/TcGenFunctor.hs | 1 + compiler/typecheck/TcHsSyn.hs | 124 +++--- compiler/typecheck/TcHsType.hs | 79 ++-- compiler/typecheck/TcInstDcls.hs | 3 +- compiler/typecheck/TcPat.hs | 78 ++-- compiler/typecheck/TcPatSyn.hs | 124 +++--- compiler/typecheck/TcRnDriver.hs | 18 +- compiler/typecheck/TcTyClsDecls.hs | 12 +- compiler/typecheck/TcTyDecls.hs | 5 +- ghc/GHCi/UI/Info.hs | 4 +- .../parser/should_compile/DumpParsedAst.stderr | 33 +- .../parser/should_compile/DumpRenamedAst.stderr | 139 ++++-- .../tests/parser/should_compile/T14189.stderr | 13 +- testsuite/tests/quasiquotation/T7918.hs | 4 +- utils/ghctags/Main.hs | 23 +- utils/haddock | 2 +- 56 files changed, 2332 insertions(+), 1615 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 0ff152c9e633accca48815e26e59d1af1fe44ceb From git at git.haskell.org Tue Nov 7 14:03:41 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 7 Nov 2017 14:03:41 +0000 (UTC) Subject: [commit: ghc] master: testsuite: Bump haddock.compiler allocations (ae7c33f) Message-ID: <20171107140341.04D3D3A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ae7c33f86e7b5cfed19b2e62214a92db0bb5f9f0/ghc >--------------------------------------------------------------- commit ae7c33f86e7b5cfed19b2e62214a92db0bb5f9f0 Author: Ben Gamari Date: Tue Nov 7 09:02:39 2017 -0500 testsuite: Bump haddock.compiler allocations This is due to alanz's recent trees that grow patch, almost certainly because of the increased surface area of libghc. >--------------------------------------------------------------- ae7c33f86e7b5cfed19b2e62214a92db0bb5f9f0 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 a5de011..7e55d49 100644 --- a/testsuite/tests/perf/haddock/all.T +++ b/testsuite/tests/perf/haddock/all.T @@ -143,7 +143,7 @@ test('haddock.compiler', [extra_files(['../../../../compiler/stage2/haddock.t']), unless(in_tree_compiler(), skip), req_haddock ,stats_num_field('bytes allocated', - [(wordsize(64), 51592019560, 10) + [(wordsize(64), 65807004616, 10) # 2012-08-14: 26070600504 (amd64/Linux) # 2012-08-29: 26353100288 (amd64/Linux, new CG) # 2012-09-18: 26882813032 (amd64/Linux) @@ -165,6 +165,7 @@ test('haddock.compiler', # 2017-06-05: 65378619232 (amd64/Linux) Desugar modules compiled with -fno-code # 2017-06-06: 55990521024 (amd64/Linux) Don't pass on -dcore-lint in Haddock.mk # 2017-07-12: 51592019560 (amd64/Linux) Use getNameToInstancesIndex + # 2017-11-07: 65807004616 (amd64/Linux) Trees that grow ,(platform('i386-unknown-mingw32'), 367546388, 10) # 2012-10-30: 13773051312 (x86/Windows) From git at git.haskell.org Tue Nov 7 18:13:39 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 7 Nov 2017 18:13:39 +0000 (UTC) Subject: [commit: ghc] master: relnotes: Clarify a few things (7d34f69) Message-ID: <20171107181339.488AC3A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7d34f6962183c638012a69b972e43feae55a89eb/ghc >--------------------------------------------------------------- commit 7d34f6962183c638012a69b972e43feae55a89eb Author: Ben Gamari Date: Tue Nov 7 09:55:02 2017 -0500 relnotes: Clarify a few things [skip ci] >--------------------------------------------------------------- 7d34f6962183c638012a69b972e43feae55a89eb docs/users_guide/8.4.1-notes.rst | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/docs/users_guide/8.4.1-notes.rst b/docs/users_guide/8.4.1-notes.rst index 21b19f1..49dd861 100644 --- a/docs/users_guide/8.4.1-notes.rst +++ b/docs/users_guide/8.4.1-notes.rst @@ -236,12 +236,12 @@ Compiler performance for recursive types not shaped like cons-lists, and allows ``null`` to terminate for more (but not all) infinitely large structures. -- `-fsplit-sections` is now supported on x86_64 Windows and is on by default. +- :ghc-flag:`-fsplit-sections` is now supported on x86_64 Windows and is on by default. See :ghc-ticket:`12913`. -- Configure on Windows now supports ``--enable-distro-toolchain`` which can be - used to build a GHC using compilers on your ``PATH`` instead of using the - bundled bindist. See :ghc-ticket:`13792` +- Configure on Windows now supports the ``--enable-distro-toolchain`` + ``configure`` flag, which can be used to build a GHC using compilers on your + ``PATH`` instead of using the bundled bindist. See :ghc-ticket:`13792` - The optional ``instance`` keyword is now usable in type family instance declarations. See :ghc-ticket:`13747` From git at git.haskell.org Tue Nov 7 18:13:42 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 7 Nov 2017 18:13:42 +0000 (UTC) Subject: [commit: ghc] master: relnotes: Note enabling of -fllvm-pass-vectorse-in-regs (c1bc923) Message-ID: <20171107181342.0C95A3A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c1bc923b08860101d0b74795ff42f6022c7fec0b/ghc >--------------------------------------------------------------- commit c1bc923b08860101d0b74795ff42f6022c7fec0b Author: Ben Gamari Date: Tue Nov 7 09:58:59 2017 -0500 relnotes: Note enabling of -fllvm-pass-vectorse-in-regs [skip ci] >--------------------------------------------------------------- c1bc923b08860101d0b74795ff42f6022c7fec0b docs/users_guide/8.4.1-notes.rst | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/docs/users_guide/8.4.1-notes.rst b/docs/users_guide/8.4.1-notes.rst index 49dd861..28e93b2 100644 --- a/docs/users_guide/8.4.1-notes.rst +++ b/docs/users_guide/8.4.1-notes.rst @@ -243,6 +243,10 @@ Compiler ``configure`` flag, which can be used to build a GHC using compilers on your ``PATH`` instead of using the bundled bindist. See :ghc-ticket:`13792` +- GHC now enables :ghc-flag:`-fllvm-pass-vectors-in-regs` by default. This means + that GHC will now use native vector registers to pass vector arguments across + function calls. + - The optional ``instance`` keyword is now usable in type family instance declarations. See :ghc-ticket:`13747` From git at git.haskell.org Tue Nov 7 18:13:47 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 7 Nov 2017 18:13:47 +0000 (UTC) Subject: [commit: ghc] master: Update link to Haskeline user preferences (9f8dde0) Message-ID: <20171107181347.C1D3F3A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9f8dde0cb4d6b7db4a33e89e0607ba9b976c6a92/ghc >--------------------------------------------------------------- commit 9f8dde0cb4d6b7db4a33e89e0607ba9b976c6a92 Author: Taylor Fausak Date: Mon Nov 6 22:21:19 2017 -0600 Update link to Haskeline user preferences Unfortunately trac.haskell.org doesn't exist anymore. [skip ci] >--------------------------------------------------------------- 9f8dde0cb4d6b7db4a33e89e0607ba9b976c6a92 docs/users_guide/ghci.rst | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/docs/users_guide/ghci.rst b/docs/users_guide/ghci.rst index 1711903..5be8a0f 100644 --- a/docs/users_guide/ghci.rst +++ b/docs/users_guide/ghci.rst @@ -3171,7 +3171,7 @@ The ``.haskeline`` file GHCi uses `Haskeline `__ under the hood. You can configure it to, among other things, prune duplicates from GHCi history. See: -`Haskeline user preferences `__. +`Haskeline user preferences `__. .. _ghci-obj: From git at git.haskell.org Tue Nov 7 18:13:45 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 7 Nov 2017 18:13:45 +0000 (UTC) Subject: [commit: ghc] master: Revert "WIP on combining Step 1 and 3 of Trees That Grow" (93b4820) Message-ID: <20171107181345.08CF23A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/93b4820607aed1ab633e836084c5e39f5e631f87/ghc >--------------------------------------------------------------- commit 93b4820607aed1ab633e836084c5e39f5e631f87 Author: Ben Gamari Date: Tue Nov 7 11:50:36 2017 -0500 Revert "WIP on combining Step 1 and 3 of Trees That Grow" This reverts commit 0ff152c9e633accca48815e26e59d1af1fe44ceb. Sadly this broke when bootstrapping with 8.0.2 due to #14396. Reverts haddock submodule. >--------------------------------------------------------------- 93b4820607aed1ab633e836084c5e39f5e631f87 compiler/deSugar/Check.hs | 53 ++- compiler/deSugar/DsArrows.hs | 30 +- compiler/deSugar/DsExpr.hs | 2 +- compiler/deSugar/DsMeta.hs | 108 +++-- compiler/deSugar/DsUtils.hs | 63 ++- compiler/deSugar/Match.hs | 72 ++-- compiler/deSugar/MatchLit.hs | 27 +- compiler/hsSyn/Convert.hs | 162 ++++--- compiler/hsSyn/HsBinds.hs | 150 ++----- compiler/hsSyn/HsDecls.hs | 154 ++++--- compiler/hsSyn/HsExpr.hs | 246 +++++------ compiler/hsSyn/HsExpr.hs-boot | 46 +- compiler/hsSyn/HsExtension.hs | 328 ++++---------- compiler/hsSyn/HsLit.hs | 71 +-- compiler/hsSyn/HsPat.hs | 303 +++++-------- compiler/hsSyn/HsPat.hs-boot | 6 +- compiler/hsSyn/HsSyn.hs | 5 +- compiler/hsSyn/HsTypes.hs | 478 ++++++++------------- compiler/hsSyn/HsUtils.hs | 186 ++++---- compiler/hsSyn/PlaceHolder.hs | 9 +- compiler/main/HscStats.hs | 2 +- compiler/main/InteractiveEval.hs | 3 +- compiler/parser/Parser.y | 99 +++-- compiler/parser/RdrHsSyn.hs | 103 +++-- compiler/rename/RnBinds.hs | 10 +- compiler/rename/RnExpr.hs | 46 +- compiler/rename/RnFixity.hs | 5 +- compiler/rename/RnNames.hs | 20 +- compiler/rename/RnPat.hs | 93 ++-- compiler/rename/RnSource.hs | 12 +- compiler/rename/RnSplice.hs | 16 +- compiler/rename/RnSplice.hs-boot | 4 +- compiler/rename/RnTypes.hs | 283 ++++++------ compiler/typecheck/Inst.hs | 16 +- compiler/typecheck/TcAnnotations.hs | 3 +- compiler/typecheck/TcBinds.hs | 5 +- compiler/typecheck/TcDeriv.hs | 2 +- compiler/typecheck/TcEnv.hs | 6 +- compiler/typecheck/TcExpr.hs | 43 +- compiler/typecheck/TcGenDeriv.hs | 15 +- compiler/typecheck/TcGenFunctor.hs | 1 - compiler/typecheck/TcHsSyn.hs | 124 +++--- compiler/typecheck/TcHsType.hs | 79 ++-- compiler/typecheck/TcInstDcls.hs | 3 +- compiler/typecheck/TcPat.hs | 78 ++-- compiler/typecheck/TcPatSyn.hs | 124 +++--- compiler/typecheck/TcRnDriver.hs | 18 +- compiler/typecheck/TcTyClsDecls.hs | 12 +- compiler/typecheck/TcTyDecls.hs | 5 +- ghc/GHCi/UI/Info.hs | 4 +- .../parser/should_compile/DumpParsedAst.stderr | 33 +- .../parser/should_compile/DumpRenamedAst.stderr | 139 ++---- .../tests/parser/should_compile/T14189.stderr | 13 +- testsuite/tests/perf/haddock/all.T | 3 +- testsuite/tests/quasiquotation/T7918.hs | 4 +- utils/ghctags/Main.hs | 23 +- utils/haddock | 2 +- 57 files changed, 1616 insertions(+), 2334 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 93b4820607aed1ab633e836084c5e39f5e631f87 From git at git.haskell.org Tue Nov 7 18:13:50 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 7 Nov 2017 18:13:50 +0000 (UTC) Subject: [commit: ghc] master: base: Escape \ in CallStack example (bf9ba7b) Message-ID: <20171107181350.8701E3A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/bf9ba7b43fc8c262f24ec3d1e6e13c9a7cad4b3b/ghc >--------------------------------------------------------------- commit bf9ba7b43fc8c262f24ec3d1e6e13c9a7cad4b3b Author: Chris Martin Date: Mon Nov 6 21:18:49 2017 -0500 base: Escape \ in CallStack example [skip ci] >--------------------------------------------------------------- bf9ba7b43fc8c262f24ec3d1e6e13c9a7cad4b3b libraries/base/GHC/Stack/Types.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/base/GHC/Stack/Types.hs b/libraries/base/GHC/Stack/Types.hs index 54352b1..d9e7552 100644 --- a/libraries/base/GHC/Stack/Types.hs +++ b/libraries/base/GHC/Stack/Types.hs @@ -83,7 +83,7 @@ type HasCallStack = (?callStack :: CallStack) -- -- @ -- errorWithCallStack :: HasCallStack => String -> a --- errorWithCallStack msg = error (msg ++ "\n" ++ prettyCallStack callStack) +-- errorWithCallStack msg = error (msg ++ "\\n" ++ prettyCallStack callStack) -- @ -- -- Thus, if we call @errorWithCallStack@ we will get a formatted call-stack From git at git.haskell.org Wed Nov 8 03:20:45 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 8 Nov 2017 03:20:45 +0000 (UTC) Subject: [commit: ghc] wip/T14068: Revert "If there is a artificial no-inline-pragma, do not bother creating an unfolding" (951b10d) Message-ID: <20171108032045.8FCA93A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14068 Link : http://ghc.haskell.org/trac/ghc/changeset/951b10db1fc720f0fb43d50d8e6515821d48031a/ghc >--------------------------------------------------------------- commit 951b10db1fc720f0fb43d50d8e6515821d48031a Author: Joachim Breitner Date: Tue Nov 7 17:48:42 2017 -0500 Revert "If there is a artificial no-inline-pragma, do not bother creating an unfolding" This reverts commit 1d811710f9681693f3dcdd647a1231dcebc8bce1. >--------------------------------------------------------------- 951b10db1fc720f0fb43d50d8e6515821d48031a compiler/basicTypes/BasicTypes.hs | 8 +------- compiler/simplCore/Simplify.hs | 4 +--- 2 files changed, 2 insertions(+), 10 deletions(-) diff --git a/compiler/basicTypes/BasicTypes.hs b/compiler/basicTypes/BasicTypes.hs index 3e5fbfe..a866153 100644 --- a/compiler/basicTypes/BasicTypes.hs +++ b/compiler/basicTypes/BasicTypes.hs @@ -88,7 +88,7 @@ module BasicTypes( InlineSpec(..), noUserInlineSpec, InlinePragma(..), defaultInlinePragma, alwaysInlinePragma, neverInlinePragma, dfunInlinePragma, - isDefaultInlinePragma, isNeverInlinePragma, + isDefaultInlinePragma, isInlinePragma, isInlinablePragma, isAnyInlinePragma, inlinePragmaSpec, inlinePragmaSat, inlinePragmaActivation, inlinePragmaRuleMatchInfo, @@ -1352,12 +1352,6 @@ isDefaultInlinePragma (InlinePragma { inl_act = activation , inl_inline = inline }) = noUserInlineSpec inline && isAlwaysActive activation && isFunLike match_info -isNeverInlinePragma :: InlinePragma -> Bool -isNeverInlinePragma (InlinePragma { inl_act = activation - , inl_rule = match_info - , inl_inline = inline }) - = noUserInlineSpec inline && isNeverActive activation && isFunLike match_info - isInlinePragma :: InlinePragma -> Bool isInlinePragma prag = case inl_inline prag of Inline -> True diff --git a/compiler/simplCore/Simplify.hs b/compiler/simplCore/Simplify.hs index b576e8a..532b7ee 100644 --- a/compiler/simplCore/Simplify.hs +++ b/compiler/simplCore/Simplify.hs @@ -41,7 +41,7 @@ import CoreOpt ( pushCoTyArg, pushCoValArg import Rules ( mkRuleInfo, lookupRule, getRules ) import Demand ( mkClosedStrictSig, topDmd, exnRes ) import BasicTypes ( TopLevelFlag(..), isNotTopLevel, isTopLevel, - RecFlag(..), Arity, isNeverInlinePragma ) + RecFlag(..), Arity ) import MonadUtils ( mapAccumLM, liftIO ) import Maybes ( orElse ) import Control.Monad @@ -3263,8 +3263,6 @@ simplLetUnfolding env top_lvl cont_mb id new_rhs unf = simplStableUnfolding env top_lvl cont_mb id unf | isExitJoinId id = return noUnfolding -- see Note [Do not inline exit join points] - | isNeverInlinePragma (idInlinePragma id) - = return noUnfolding -- Do not bother creating one if we never inline anyways | otherwise = mkLetUnfolding (seDynFlags env) top_lvl InlineRhs id new_rhs From git at git.haskell.org Wed Nov 8 03:20:48 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 8 Nov 2017 03:20:48 +0000 (UTC) Subject: [commit: ghc] wip/T14068: Invoke lintUnfolding only on top-level unfoldings (#14430) (f350314) Message-ID: <20171108032048.4FD6B3A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14068 Link : http://ghc.haskell.org/trac/ghc/changeset/f350314a1e04be3c76e4ee9c2bcb03bb45fa853a/ghc >--------------------------------------------------------------- commit f350314a1e04be3c76e4ee9c2bcb03bb45fa853a Author: Joachim Breitner Date: Tue Nov 7 22:17:50 2017 -0500 Invoke lintUnfolding only on top-level unfoldings (#14430) as nested unfoldings are linted together with the top-level unfolding, and lintUnfolding does the wrong things for nestd unfoldings that mention join points. The easiest way of doing that was to pass a TopLevel flag through `tcUnfolding`, which is invoked both for top level and nested unfoldings. >--------------------------------------------------------------- f350314a1e04be3c76e4ee9c2bcb03bb45fa853a compiler/iface/TcIface.hs | 34 +++++++++++++++++----------------- 1 file changed, 17 insertions(+), 17 deletions(-) diff --git a/compiler/iface/TcIface.hs b/compiler/iface/TcIface.hs index 6d04171..ebc97d6 100644 --- a/compiler/iface/TcIface.hs +++ b/compiler/iface/TcIface.hs @@ -647,7 +647,7 @@ tc_iface_decl _ ignore_prags (IfaceId {ifName = name, ifType = iface_type, ifIdDetails = details, ifIdInfo = info}) = do { ty <- tcIfaceType iface_type ; details <- tcIdDetails ty details - ; info <- tcIdInfo ignore_prags name ty info + ; info <- tcIdInfo ignore_prags TopLevel name ty info ; return (AnId (mkGlobalId details name ty info)) } tc_iface_decl _ _ (IfaceData {ifName = tc_name, @@ -1461,7 +1461,7 @@ tcIfaceExpr (IfaceLet (IfaceNonRec (IfLetBndr fs ty info ji) rhs) body) = do { name <- newIfaceName (mkVarOccFS fs) ; ty' <- tcIfaceType ty ; id_info <- tcIdInfo False {- Don't ignore prags; we are inside one! -} - name ty' info + NotTopLevel name ty' info ; let id = mkLocalIdOrCoVarWithInfo name ty' id_info `asJoinId_maybe` tcJoinInfo ji ; rhs' <- tcIfaceExpr rhs @@ -1482,7 +1482,7 @@ tcIfaceExpr (IfaceLet (IfaceRec pairs) body) tc_pair (IfLetBndr _ _ info _, rhs) id = do { rhs' <- tcIfaceExpr rhs ; id_info <- tcIdInfo False {- Don't ignore prags; we are inside one! -} - (idName id) (idType id) info + NotTopLevel (idName id) (idType id) info ; return (setIdInfo id id_info, rhs') } tcIfaceExpr (IfaceTick tickish expr) = do @@ -1573,8 +1573,8 @@ tcIdDetails _ (IfRecSelId tc naughty) tyThingPatSyn (AConLike (PatSynCon ps)) = ps tyThingPatSyn _ = panic "tcIdDetails: expecting patsyn" -tcIdInfo :: Bool -> Name -> Type -> IfaceIdInfo -> IfL IdInfo -tcIdInfo ignore_prags name ty info = do +tcIdInfo :: Bool -> TopLevelFlag -> Name -> Type -> IfaceIdInfo -> IfL IdInfo +tcIdInfo ignore_prags toplvl name ty info = do lcl_env <- getLclEnv -- Set the CgInfo to something sensible but uninformative before -- we start; default assumption is that it has CAFs @@ -1595,7 +1595,7 @@ tcIdInfo ignore_prags name ty info = do -- The next two are lazy, so they don't transitively suck stuff in tcPrag info (HsUnfold lb if_unf) - = do { unf <- tcUnfolding name ty info if_unf + = do { unf <- tcUnfolding toplvl name ty info if_unf ; let info1 | lb = info `setOccInfo` strongLoopBreaker | otherwise = info ; return (info1 `setUnfoldingInfo` unf) } @@ -1604,10 +1604,10 @@ tcJoinInfo :: IfaceJoinInfo -> Maybe JoinArity tcJoinInfo (IfaceJoinPoint ar) = Just ar tcJoinInfo IfaceNotJoinPoint = Nothing -tcUnfolding :: Name -> Type -> IdInfo -> IfaceUnfolding -> IfL Unfolding -tcUnfolding name _ info (IfCoreUnfold stable if_expr) +tcUnfolding :: TopLevelFlag -> Name -> Type -> IdInfo -> IfaceUnfolding -> IfL Unfolding +tcUnfolding toplvl name _ info (IfCoreUnfold stable if_expr) = do { dflags <- getDynFlags - ; mb_expr <- tcPragExpr name if_expr + ; mb_expr <- tcPragExpr toplvl name if_expr ; let unf_src | stable = InlineStable | otherwise = InlineRhs ; return $ case mb_expr of @@ -1620,21 +1620,21 @@ tcUnfolding name _ info (IfCoreUnfold stable if_expr) where -- Strictness should occur before unfolding! strict_sig = strictnessInfo info -tcUnfolding name _ _ (IfCompulsory if_expr) - = do { mb_expr <- tcPragExpr name if_expr +tcUnfolding toplvl name _ _ (IfCompulsory if_expr) + = do { mb_expr <- tcPragExpr toplvl name if_expr ; return (case mb_expr of Nothing -> NoUnfolding Just expr -> mkCompulsoryUnfolding expr) } -tcUnfolding name _ _ (IfInlineRule arity unsat_ok boring_ok if_expr) - = do { mb_expr <- tcPragExpr name if_expr +tcUnfolding toplvl name _ _ (IfInlineRule arity unsat_ok boring_ok if_expr) + = do { mb_expr <- tcPragExpr toplvl name if_expr ; return (case mb_expr of Nothing -> NoUnfolding Just expr -> mkCoreUnfolding InlineStable True expr guidance )} where guidance = UnfWhen { ug_arity = arity, ug_unsat_ok = unsat_ok, ug_boring_ok = boring_ok } -tcUnfolding name dfun_ty _ (IfDFunUnfold bs ops) +tcUnfolding _toplvl name dfun_ty _ (IfDFunUnfold bs ops) = bindIfaceBndrs bs $ \ bs' -> do { mb_ops1 <- forkM_maybe doc $ mapM tcIfaceExpr ops ; return (case mb_ops1 of @@ -1649,13 +1649,13 @@ For unfoldings we try to do the job lazily, so that we never type check an unfolding that isn't going to be looked at. -} -tcPragExpr :: Name -> IfaceExpr -> IfL (Maybe CoreExpr) -tcPragExpr name expr +tcPragExpr :: TopLevelFlag -> Name -> IfaceExpr -> IfL (Maybe CoreExpr) +tcPragExpr toplvl name expr = forkM_maybe doc $ do core_expr' <- tcIfaceExpr expr -- Check for type consistency in the unfolding - whenGOptM Opt_DoCoreLinting $ do + when (isTopLevel toplvl) $ whenGOptM Opt_DoCoreLinting $ do in_scope <- get_in_scope dflags <- getDynFlags case lintUnfolding dflags noSrcLoc in_scope core_expr' of From git at git.haskell.org Wed Nov 8 06:19:36 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 8 Nov 2017 06:19:36 +0000 (UTC) Subject: [commit: ghc] master: Set up AppVeyor, Windows CI. (b0cabc9) Message-ID: <20171108061936.B1DDA3A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b0cabc93edff61ba4d9de823171e49e851a1ff17/ghc >--------------------------------------------------------------- commit b0cabc93edff61ba4d9de823171e49e851a1ff17 Author: Mateusz Kowalczyk Date: Fri Oct 27 14:28:43 2017 +0100 Set up AppVeyor, Windows CI. >--------------------------------------------------------------- b0cabc93edff61ba4d9de823171e49e851a1ff17 appveyor.yml | 43 +++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 43 insertions(+) diff --git a/appveyor.yml b/appveyor.yml new file mode 100644 index 0000000..8ded95d --- /dev/null +++ b/appveyor.yml @@ -0,0 +1,43 @@ +version: "{build}" + +build: + verbosity: normal + +environment: + matrix: + - COMPILER: msys2 + PLATFORM: x64 + MSYS2_ARCH: x86_64 + MSYS2_DIR: msys64 + MSYSTEM: MINGW64 + BIT: 64 + +os: Visual Studio 2015 +deploy: off + +install: + - cmd: | + SET "PATH=C:\%MSYS2_DIR%\%MSYSTEM%\bin;C:\%MSYS2_DIR%\usr\bin;%PATH%" + bash -lc "pacman --noconfirm -Syuu" + bash -lc "pacman --noconfirm -S --needed git tar bsdtar binutils autoconf make xz curl libtool automake python python2 p7zip patch mingw-w64-$(uname -m)-gcc mingw-w64-$(uname -m)-python3-sphinx mingw-w64-$(uname -m)-tools-git" + bash -lc "cd $APPVEYOR_BUILD_FOLDER; git config remote.origin.url git://github.com/ghc/ghc.git" + bash -lc "cd $APPVEYOR_BUILD_FOLDER; git config --global url.\"git://github.com/ghc/packages-\".insteadOf git://github.com/ghc/packages/" + bash -lc "cd $APPVEYOR_BUILD_FOLDER; git submodule init" + bash -lc "cd $APPVEYOR_BUILD_FOLDER; git submodule --quiet update --recursive" + bash -lc "curl -L https://downloads.haskell.org/~ghc/8.2.1/ghc-8.2.1-x86_64-unknown-mingw32.tar.xz | tar -xJ -C /mingw64 --strip-components=1" + bash -lc "mkdir -p /usr/local/bin" + bash -lc "curl -L https://www.haskell.org/cabal/release/cabal-install-1.24.0.0/cabal-install-1.24.0.0-x86_64-unknown-mingw32.zip | bsdtar -xzf- -C /usr/local/bin" + bash -lc "cabal update" + bash -lc "cabal install -j --prefix=/usr/local alex happy" + +build_script: + - bash -lc "cd $APPVEYOR_BUILD_FOLDER; ./boot" + - bash -lc "cd $APPVEYOR_BUILD_FOLDER; ./configure --enable-tarballs-autodownload" + - bash -lc "cd $APPVEYOR_BUILD_FOLDER; make -j2" + - bash -lc "cd $APPVEYOR_BUILD_FOLDER; make binary_dist" + bash -lc "cd $APPVEYOR_BUILD_FOLDER; 7z a ghc-windows.zip *.tar.xz" + +artifacts: + - path: C:\projects\ghc\ghc-windows.zip + name: GHC Windows bindist + type: zip From git at git.haskell.org Wed Nov 8 06:19:40 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 8 Nov 2017 06:19:40 +0000 (UTC) Subject: [commit: ghc] master: Set up Linux, OSX and FreeBSD on CircleCI. (7d6fa32) Message-ID: <20171108061940.A0ADD3A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7d6fa329994303a9b647ace58a1959d847bb466c/ghc >--------------------------------------------------------------- commit 7d6fa329994303a9b647ace58a1959d847bb466c Author: Mateusz Kowalczyk Date: Fri Oct 27 18:14:06 2017 +0100 Set up Linux, OSX and FreeBSD on CircleCI. >--------------------------------------------------------------- 7d6fa329994303a9b647ace58a1959d847bb466c .circleci/build.sh | 59 +++++++++++ .circleci/config.yml | 108 ++++++++++++++++----- .circleci/fetch-submodules.sh | 9 ++ .circleci/images/x86_64-freebsd/Dockerfile | 24 +++++ .circleci/images/x86_64-freebsd/build-toolchain.sh | 102 +++++++++++++++++++ .circleci/prepare-system.sh | 46 +++++++++ 6 files changed, 325 insertions(+), 23 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 7d6fa329994303a9b647ace58a1959d847bb466c From git at git.haskell.org Wed Nov 8 06:19:43 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 8 Nov 2017 06:19:43 +0000 (UTC) Subject: [commit: ghc] master: Revert "Sdist -> bindist -> tests" (07e0d0d) Message-ID: <20171108061943.729DB3A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/07e0d0d56eba1c599e93a238c857431d15f33fa1/ghc >--------------------------------------------------------------- commit 07e0d0d56eba1c599e93a238c857431d15f33fa1 Author: Mateusz Kowalczyk Date: Thu Nov 2 11:15:11 2017 +0000 Revert "Sdist -> bindist -> tests" This reverts commit e1d38d6f7decee1e513d44bb3bce08bd004bfa4d. >--------------------------------------------------------------- 07e0d0d56eba1c599e93a238c857431d15f33fa1 .circleci/build.sh | 22 ++++------------------ .circleci/prepare-system.sh | 9 ++------- 2 files changed, 6 insertions(+), 25 deletions(-) diff --git a/.circleci/build.sh b/.circleci/build.sh index 2cc1d0e..74d98fa 100755 --- a/.circleci/build.sh +++ b/.circleci/build.sh @@ -8,6 +8,9 @@ fail() { exit 1 } +echo 'BUILD_SPHINX_HTML = NO' > mk/validate.mk +echo 'BUILD_SPHINX_PDF = NO' >> mk/validate.mk + cat > mk/build.mk < Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/14d885e843f6907dbc5048ae66aca25d738e99f7/ghc >--------------------------------------------------------------- commit 14d885e843f6907dbc5048ae66aca25d738e99f7 Merge: bf9ba7b ed18f47 Author: Ben Gamari Date: Wed Nov 8 01:18:44 2017 -0500 Merge remote-tracking branch 'github/pr/83' >--------------------------------------------------------------- 14d885e843f6907dbc5048ae66aca25d738e99f7 .circleci/config.yml | 151 +++++++++++++++++---- .circleci/fetch-submodules.sh | 9 ++ .circleci/images/x86_64-freebsd/Dockerfile | 24 ++++ .circleci/images/x86_64-freebsd/build-toolchain.sh | 102 ++++++++++++++ .circleci/prepare-system.sh | 64 +++++++++ appveyor.yml | 43 ++++++ 6 files changed, 370 insertions(+), 23 deletions(-) From git at git.haskell.org Wed Nov 8 06:19:48 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 8 Nov 2017 06:19:48 +0000 (UTC) Subject: [commit: ghc] master: Factor out builds into steps. Address ghc/ghc#83 comments. (ed18f47) Message-ID: <20171108061948.E69F33A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ed18f47f931361a9adbb109085c6feb432ec41aa/ghc >--------------------------------------------------------------- commit ed18f47f931361a9adbb109085c6feb432ec41aa Author: Mateusz Kowalczyk Date: Tue Nov 7 10:52:38 2017 +0000 Factor out builds into steps. Address ghc/ghc#83 comments. This should greatly improve log output. >--------------------------------------------------------------- ed18f47f931361a9adbb109085c6feb432ec41aa .circleci/build.sh | 59 ----------------------------- .circleci/config.yml | 91 +++++++++++++++++++++++++++++++++------------ .circleci/prepare-system.sh | 24 ++++++++++-- 3 files changed, 88 insertions(+), 86 deletions(-) diff --git a/.circleci/build.sh b/.circleci/build.sh deleted file mode 100755 index 74d98fa..0000000 --- a/.circleci/build.sh +++ /dev/null @@ -1,59 +0,0 @@ -#!/usr/bin/env bash -# vim: sw=2 et - -set -euo pipefail - -fail() { - echo "ERROR: $*" >&2 - exit 1 -} - -echo 'BUILD_SPHINX_HTML = NO' > mk/validate.mk -echo 'BUILD_SPHINX_PDF = NO' >> mk/validate.mk - -cat > mk/build.mk <> mk/build.mk - echo 'WERROR=' >> mk/build.mk - export PATH=/opt/ghc/bin:$PATH - run_build --target=x86_64-unknown-freebsd10 - else - fail "TARGET=$target not supported" - fi - else - run_build - fi - ;; - Darwin) - if [[ -n ${TARGET:-} ]]; then - fail "uname=$(uname) not supported for cross-compilation" - fi - run_build - ;; - *) - fail "uname=$(uname) not supported" -esac diff --git a/.circleci/config.yml b/.circleci/config.yml index e38d265..c35ac21 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -3,6 +3,16 @@ version: 2 aliases: - &defaults working_directory: ~/ghc + + # Make sure we have proper openssh before checkout: CircleCI git + # does not check the repository out properly without it and also + # takes 20 times longer than it should be. + - &precheckout + run: + name: Install OpenSSH client + command: | + apt-get update -qq + apt-get install -qy openssh-client - &prepare run: name: prepare-system @@ -11,16 +21,40 @@ aliases: run: name: submodules command: .circleci/fetch-submodules.sh - - &build + - &buildenv + THREADS: 8 + SKIP_PERF_TESTS: YES + VERBOSE: 2 + - &boot + run: + name: Boot + command: ./boot + - &configure_unix + run: + name: Configure + command: ./configure + - &configure_bsd + run: + name: Configure + command: ./configure --target=x86_64-unknown-freebsd10 + - &make run: - name: build - command: .circleci/build.sh + name: Build + command: "make -j$THREADS" + - &test + run: + name: Test + command: make test + - &bindist + run: + name: Create bindist + command: make binary-dist # Building bindist takes ~15 minutes without output, account for # that. no_output_timeout: "30m" - &collectartifacts run: - name: collect artifacts + name: Collect artifacts # We need this because CircleCI expects a path without # wildcards but bindist archive name is not static command: | @@ -28,28 +62,29 @@ aliases: pwd find . cp ghc*.tar.xz /tmp/artifacts + - &storeartifacts + store-artifacts: + path: /tmp/artifacts jobs: "validate-x86_64-linux": resource_class: xlarge docker: - image: haskell:8.2 + environment: + <<: *buildenv steps: - # Make sure we have proper openssh before checkout: CircleCI git - # does not check the repository out properly without it and also - # takes 20 times longer than it should be. - - run: - name: install openssh - command: | - apt-get update -qq - apt-get install -y openssh-client + - *precheckout - checkout - *prepare - *submodules - - *build + - *boot + - *configure_unix + - *make + - *test + - *bindist - *collectartifacts - - store-artifacts: - path: /tmp/artifacts + - *storeartifacts "validate-x86_64-freebsd": resource_class: xlarge @@ -57,28 +92,36 @@ jobs: - image: tweag/toolchain-x86_64-freebsd environment: TARGET: FreeBSD + <<: *buildenv steps: - - run: - name: install git - command: | - apt-get update -qq - apt-get install -qy openssh-client + - *precheckout - checkout - *prepare - *submodules - - *build + - *boot + - *configure_bsd + - *make + - *test + - *bindist + - *collectartifacts + - *storeartifacts "validate-x86_64-darwin": macos: xcode: "9.0" + environment: + <<: *buildenv steps: - checkout - *prepare - *submodules - - *build + - *boot + - *configure_unix + - *make + - *test + - *bindist - *collectartifacts - - store-artifacts: - path: /tmp/artifacts + - *storeartifacts workflows: version: 2 diff --git a/.circleci/prepare-system.sh b/.circleci/prepare-system.sh index 5d4d630..063c70a 100755 --- a/.circleci/prepare-system.sh +++ b/.circleci/prepare-system.sh @@ -7,6 +7,18 @@ fail() { exit 1 } +echo 'BUILD_SPHINX_HTML = NO' > mk/validate.mk +echo 'BUILD_SPHINX_PDF = NO' >> mk/validate.mk + +cat > mk/build.mk <> mk/build.mk + echo 'WERROR=' >> mk/build.mk + # https://circleci.com/docs/2.0/env-vars/#interpolating-environment-variables-to-set-other-environment-variables + echo 'export PATH=/opt/ghc/bin:$PATH' >> $BASH_ENV else fail "TARGET=$target not supported" fi else # assuming Ubuntu - apt-get update -qq - apt-get install -qy git openssh-client make automake autoconf gcc perl python3 texinfo xz-utils + apt-get install -qy git make automake autoconf gcc perl python3 texinfo xz-utils cabal update cabal install --reinstall hscolour fi From git at git.haskell.org Wed Nov 8 06:19:46 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 8 Nov 2017 06:19:46 +0000 (UTC) Subject: [commit: ghc] master: Sdist -> bindist -> tests (6f665cc) Message-ID: <20171108061946.338C93A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6f665cccd7ef5cc4806d2c1e46a602bed7a7201d/ghc >--------------------------------------------------------------- commit 6f665cccd7ef5cc4806d2c1e46a602bed7a7201d Author: Mateusz Kowalczyk Date: Fri Oct 27 19:02:33 2017 +0100 Sdist -> bindist -> tests >--------------------------------------------------------------- 6f665cccd7ef5cc4806d2c1e46a602bed7a7201d .circleci/build.sh | 22 ++++++++++++++++++---- .circleci/prepare-system.sh | 9 +++++++-- 2 files changed, 25 insertions(+), 6 deletions(-) diff --git a/.circleci/build.sh b/.circleci/build.sh index 74d5ea7..2cc1d0e 100755 --- a/.circleci/build.sh +++ b/.circleci/build.sh @@ -8,9 +8,6 @@ fail() { exit 1 } -echo 'BUILD_SPHINX_HTML = NO' > mk/validate.mk -echo 'BUILD_SPHINX_PDF = NO' >> mk/validate.mk - cat > mk/build.mk < Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/30058b0e45e920319916be999de9c4d77da136e7/ghc >--------------------------------------------------------------- commit 30058b0e45e920319916be999de9c4d77da136e7 Author: Simon Peyton Jones Date: Wed Nov 8 08:45:53 2017 +0000 Fix another dark corner in the shortcut solver The shortcut solver for type classes (Trac #12791) was eagerly solving a constaint from an OVERLAPPABLE instance. It happened to be the only one in scope, so it was unique, but since it's specfically flagged as overlappable it's really a bad idea to solve using it, rather than using the Given dictionary. This led to Trac #14434, a nasty and hard to identify bug. >--------------------------------------------------------------- 30058b0e45e920319916be999de9c4d77da136e7 compiler/typecheck/TcInteract.hs | 85 +++++++++++++--------- testsuite/tests/typecheck/should_compile/T14434.hs | 17 +++++ .../tests/typecheck/should_compile/T14434.stdout | 2 + testsuite/tests/typecheck/should_compile/all.T | 1 + 4 files changed, 71 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 30058b0e45e920319916be999de9c4d77da136e7 From git at git.haskell.org Wed Nov 8 11:18:22 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 8 Nov 2017 11:18:22 +0000 (UTC) Subject: [commit: ghc] master: Imrpove comments about equality types (21970de) Message-ID: <20171108111822.AE8983A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/21970de8bf810970a9f4d634d53ea02b2cb248db/ghc >--------------------------------------------------------------- commit 21970de8bf810970a9f4d634d53ea02b2cb248db Author: Simon Peyton Jones Date: Wed Nov 8 08:23:53 2017 +0000 Imrpove comments about equality types >--------------------------------------------------------------- 21970de8bf810970a9f4d634d53ea02b2cb248db compiler/prelude/TysPrim.hs | 25 ++++++++++++++----------- compiler/prelude/TysWiredIn.hs | 2 +- 2 files changed, 15 insertions(+), 12 deletions(-) diff --git a/compiler/prelude/TysPrim.hs b/compiler/prelude/TysPrim.hs index 5c099e8..f7a51a5 100644 --- a/compiler/prelude/TysPrim.hs +++ b/compiler/prelude/TysPrim.hs @@ -582,17 +582,19 @@ Note [The equality types story] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ GHC sports a veritable menagerie of equality types: - Built-in tc Hetero? Levity Result Role Defining module + Type or Lifted? Hetero? Role Built in Defining module + class? L/U TyCon ----------------------------------------------------------------------------------------- -~# eqPrimTyCon hetero unlifted # nominal GHC.Prim -~~ hEqTyCon hetero lifted Constraint nominal GHC.Types -~ eqTyCon homo lifted Constraint nominal Data.Type.Equality -:~: - homo lifted * nominal Data.Type.Equality +~# T U hetero nominal eqPrimTyCon GHC.Prim +~~ C L hetero nominal hEqTyCon GHC.Types +~ C L homo nominal eqTyCon Data.Type.Equality +:~: T L homo nominal (not built-in) Data.Type.Equality +:~~: T L hetero nominal (not built-in) Data.Type.Equality -~R# eqReprPrimTy hetero unlifted # repr GHC.Prim -Coercible coercibleTyCon homo lifted Constraint repr GHC.Types -Coercion - homo lifted * repr Data.Type.Coercion -~P# eqPhantPrimTyCon hetero unlifted phantom GHC.Prim +~R# T U hetero repr eqReprPrimTy GHC.Prim +Coercible C L homo repr coercibleTyCon GHC.Types +Coercion T L homo repr (not built-in) Data.Type.Coercion +~P# T U hetero phantom eqPhantPrimTyCon GHC.Prim Recall that "hetero" means the equality can related types of different kinds. Knowing that (t1 ~# t2) or (t1 ~R# t2) or even that (t1 ~P# t2) @@ -676,9 +678,10 @@ it is *not* wired in. -------------------------- (:~:) :: forall k. k -> k -> * + (:~~:) :: forall k1 k2. k1 -> k2 -> * -------------------------- -This is a perfectly ordinary GADT, wrapping (~). It is not defined within -GHC at all. +These are perfectly ordinary GADTs, wrapping (~) and (~~) resp. +They are not defined within GHC at all. -------------------------- diff --git a/compiler/prelude/TysWiredIn.hs b/compiler/prelude/TysWiredIn.hs index 2033fcf..32c6117 100644 --- a/compiler/prelude/TysWiredIn.hs +++ b/compiler/prelude/TysWiredIn.hs @@ -1009,7 +1009,7 @@ mk_sum arity = (tycon, sum_cons) ********************************************************************* -} -- See Note [The equality types story] in TysPrim --- (:~~: :: forall k1 k2 (a :: k1) (b :: k2). a -> b -> Constraint) +-- ((~~) :: forall k1 k2 (a :: k1) (b :: k2). a -> b -> Constraint) -- -- It's tempting to put functional dependencies on (~~), but it's not -- necessary because the functional-dependency coverage check looks From git at git.haskell.org Wed Nov 8 11:18:30 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 8 Nov 2017 11:18:30 +0000 (UTC) Subject: [commit: ghc] master: Minimise provided dictionaries in pattern synonyms (2c2f3ce) Message-ID: <20171108111830.4D27B3A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2c2f3cea93733e0c6dd04e1d891082652dcf5ea1/ghc >--------------------------------------------------------------- commit 2c2f3cea93733e0c6dd04e1d891082652dcf5ea1 Author: Simon Peyton Jones Date: Wed Nov 8 08:52:06 2017 +0000 Minimise provided dictionaries in pattern synonyms Trac #14394 showed that it's possible to get redundant constraints in the inferred provided constraints of a pattern synonym. This patch removes the redundancy with mkMinimalBySCs. To do this I had to generalise the type of mkMinimalBySCs slightly. And, to reduce confusing reversal, I made it stable: it now returns its result in the same order as its input. That led to a raft of error message wibbles, mostly for the better. >--------------------------------------------------------------- 2c2f3cea93733e0c6dd04e1d891082652dcf5ea1 compiler/typecheck/TcDerivInfer.hs | 2 +- compiler/typecheck/TcErrors.hs | 5 +- compiler/typecheck/TcPatSyn.hs | 56 ++++++++++++++++++++-- compiler/typecheck/TcSimplify.hs | 2 +- compiler/typecheck/TcType.hs | 52 +++++++++++++------- testsuite/tests/ado/ado004.stderr | 18 +++---- .../tests/deriving/should_fail/drvfail004.stderr | 2 +- .../tests/determinism/determ021/determ021.stdout | 4 +- testsuite/tests/ghci/scripts/T10963.stdout | 2 +- testsuite/tests/ghci/scripts/T11524a.stdout | 16 +++---- testsuite/tests/ghci/scripts/T11975.stdout | 2 +- testsuite/tests/ghci/scripts/T12550.stdout | 6 +-- .../indexed-types/should_compile/T3017.stderr | 2 +- .../indexed-types/should_compile/T8889.stderr | 2 +- .../tests/indexed-types/should_fail/T1897b.stderr | 2 +- .../should_compile/ExtraConstraints1.stderr | 2 +- .../should_compile/ExtraConstraints3.stderr | 38 +++++++-------- .../partial-sigs/should_compile/T12844.stderr | 6 +-- .../partial-sigs/should_compile/T13482.stderr | 8 ++-- .../partial-sigs/should_compile/T14217.stderr | 46 +++++++++--------- .../tests/patsyn/should_compile/T11213.stderr | 8 ++-- .../tests/patsyn/should_compile/T14394.script | 24 ++++++++++ .../should_compile/T14394.stdout} | 0 testsuite/tests/patsyn/should_compile/all.T | 1 + testsuite/tests/rebindable/rebindable6.stderr | 3 +- testsuite/tests/typecheck/should_compile/Makefile | 4 ++ .../tests/typecheck/should_compile/holes2.stderr | 2 +- testsuite/tests/typecheck/should_fail/T8883.stderr | 2 +- .../tests/typecheck/should_fail/tcfail133.stderr | 2 +- 29 files changed, 205 insertions(+), 114 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 2c2f3cea93733e0c6dd04e1d891082652dcf5ea1 From git at git.haskell.org Wed Nov 8 11:18:33 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 8 Nov 2017 11:18:33 +0000 (UTC) Subject: [commit: ghc] master: Fix in-scope set in simplifier (fe6848f) Message-ID: <20171108111833.27D673A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/fe6848f544c2a14086bcef388c46f4070c22d287/ghc >--------------------------------------------------------------- commit fe6848f544c2a14086bcef388c46f4070c22d287 Author: Simon Peyton Jones Date: Wed Nov 8 11:09:33 2017 +0000 Fix in-scope set in simplifier This patch fixes Trac #14408. The problem was that the StaticEnv field of an ApplyToVar or Select continuation didn't have enough variables in scope. The fix is simple, and I documented the invariant in Note [StaticEnv invariant] in SimplUtils. No change in behaviour: this just stops an ASSERT from tripping. >--------------------------------------------------------------- fe6848f544c2a14086bcef388c46f4070c22d287 compiler/simplCore/SimplEnv.hs | 4 +--- compiler/simplCore/SimplUtils.hs | 30 ++++++++++++++++++++----- compiler/simplCore/Simplify.hs | 47 +++++++++++++++++++++++++--------------- 3 files changed, 56 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 fe6848f544c2a14086bcef388c46f4070c22d287 From git at git.haskell.org Wed Nov 8 15:51:22 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 8 Nov 2017 15:51:22 +0000 (UTC) Subject: [commit: ghc] master: WIP on Doing a combined Step 1 and 3 for Trees That Grow (438dd1c) Message-ID: <20171108155122.07BBA3A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/438dd1cbba13d35f3452b4dcef3f94ce9a216905/ghc >--------------------------------------------------------------- commit 438dd1cbba13d35f3452b4dcef3f94ce9a216905 Author: Alan Zimmerman Date: Sun Nov 5 21:49:11 2017 +0200 WIP on Doing a combined Step 1 and 3 for Trees That Grow See https://ghc.haskell.org/trac/ghc/wiki/ImplementingTreesThatGrow Trees that grow extension points are added for - ValBinds - HsPat - HsLit - HsOverLit - HsType - HsTyVarBndr - HsAppType - FieldOcc - AmbiguousFieldOcc Updates haddock submodule Test Plan: ./validate Reviewers: shayan-najd, simonpj, austin, goldfire, bgamari Subscribers: goldfire, rwbarton, thomie, mpickering Differential Revision: https://phabricator.haskell.org/D4147 >--------------------------------------------------------------- 438dd1cbba13d35f3452b4dcef3f94ce9a216905 compiler/deSugar/Check.hs | 53 +-- compiler/deSugar/Coverage.hs | 8 +- compiler/deSugar/DsArrows.hs | 30 +- compiler/deSugar/DsExpr.hs | 7 +- compiler/deSugar/DsMeta.hs | 112 ++--- compiler/deSugar/DsUtils.hs | 63 +-- compiler/deSugar/Match.hs | 71 +-- compiler/deSugar/MatchLit.hs | 27 +- compiler/hsSyn/Convert.hs | 163 +++---- compiler/hsSyn/HsBinds.hs | 167 ++++--- compiler/hsSyn/HsDecls.hs | 200 ++++----- compiler/hsSyn/HsExpr.hs | 248 ++++++----- compiler/hsSyn/HsExpr.hs-boot | 48 ++- compiler/hsSyn/HsExtension.hs | 330 ++++++++++---- compiler/hsSyn/HsLit.hs | 71 ++- compiler/hsSyn/HsPat.hs | 300 ++++++++----- compiler/hsSyn/HsPat.hs-boot | 8 +- compiler/hsSyn/HsSyn.hs | 7 +- compiler/hsSyn/HsTypes.hs | 478 +++++++++++++-------- compiler/hsSyn/HsUtils.hs | 227 +++++----- compiler/hsSyn/PlaceHolder.hs | 9 +- compiler/main/HscStats.hs | 2 +- compiler/main/InteractiveEval.hs | 3 +- compiler/parser/Parser.y | 99 ++--- compiler/parser/RdrHsSyn.hs | 103 ++--- compiler/rename/RnBinds.hs | 14 +- compiler/rename/RnExpr.hs | 46 +- compiler/rename/RnFixity.hs | 5 +- compiler/rename/RnNames.hs | 20 +- compiler/rename/RnPat.hs | 93 ++-- compiler/rename/RnSource.hs | 14 +- compiler/rename/RnSplice.hs | 16 +- compiler/rename/RnSplice.hs-boot | 4 +- compiler/rename/RnTypes.hs | 283 ++++++------ compiler/typecheck/Inst.hs | 16 +- compiler/typecheck/TcAnnotations.hs | 3 +- compiler/typecheck/TcBinds.hs | 15 +- compiler/typecheck/TcDeriv.hs | 2 +- compiler/typecheck/TcEnv.hs | 6 +- compiler/typecheck/TcExpr.hs | 43 +- compiler/typecheck/TcGenDeriv.hs | 15 +- compiler/typecheck/TcGenFunctor.hs | 1 + compiler/typecheck/TcHsSyn.hs | 130 +++--- compiler/typecheck/TcHsType.hs | 79 ++-- compiler/typecheck/TcInstDcls.hs | 3 +- compiler/typecheck/TcPat.hs | 81 ++-- compiler/typecheck/TcPatSyn.hs | 130 +++--- compiler/typecheck/TcRnDriver.hs | 30 +- compiler/typecheck/TcTyClsDecls.hs | 12 +- compiler/typecheck/TcTyDecls.hs | 7 +- ghc/GHCi/UI/Info.hs | 4 +- .../parser/should_compile/DumpParsedAst.stderr | 33 +- .../parser/should_compile/DumpRenamedAst.stderr | 139 ++++-- .../tests/parser/should_compile/T14189.stderr | 13 +- testsuite/tests/perf/haddock/all.T | 3 +- testsuite/tests/quasiquotation/T7918.hs | 4 +- utils/ghctags/Main.hs | 25 +- utils/haddock | 2 +- 58 files changed, 2433 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 438dd1cbba13d35f3452b4dcef3f94ce9a216905 From git at git.haskell.org Thu Nov 9 00:11:09 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 9 Nov 2017 00:11:09 +0000 (UTC) Subject: [commit: ghc] master: Invoke lintUnfolding only on top-level unfoldings (#14430) (803ed03) Message-ID: <20171109001109.B77283A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/803ed036704aa5bab8b0f1fee407e58d82c85393/ghc >--------------------------------------------------------------- commit 803ed036704aa5bab8b0f1fee407e58d82c85393 Author: Joachim Breitner Date: Tue Nov 7 22:17:50 2017 -0500 Invoke lintUnfolding only on top-level unfoldings (#14430) as nested unfoldings are linted together with the top-level unfolding, and lintUnfolding does the wrong things for nestd unfoldings that mention join points. The easiest way of doing that was to pass a TopLevel flag through `tcUnfolding`, which is invoked both for top level and nested unfoldings. Differential Revision: https://phabricator.haskell.org/D4169 >--------------------------------------------------------------- 803ed036704aa5bab8b0f1fee407e58d82c85393 compiler/coreSyn/CoreLint.hs | 12 ++++++++++-- compiler/iface/TcIface.hs | 37 +++++++++++++++++++------------------ 2 files changed, 29 insertions(+), 20 deletions(-) diff --git a/compiler/coreSyn/CoreLint.hs b/compiler/coreSyn/CoreLint.hs index 20354ec..4b6defd 100644 --- a/compiler/coreSyn/CoreLint.hs +++ b/compiler/coreSyn/CoreLint.hs @@ -458,8 +458,16 @@ lintCoreBindings dflags pass local_in_scope binds * * ************************************************************************ -We use this to check all unfoldings that come in from interfaces -(it is very painful to catch errors otherwise): +Note [Linting Unfoldings from Interfaces] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +We use this to check all top-level unfoldings that come in from interfaces +(it is very painful to catch errors otherwise). + +We do not need to call lintUnfolding on unfoldings that are nested within +top-level unfoldings; they are linted when we lint the top-level unfolding; +hence the `TopLevelFlag` on `tcPragExpr` in TcIface. + -} lintUnfolding :: DynFlags diff --git a/compiler/iface/TcIface.hs b/compiler/iface/TcIface.hs index 6d04171..b41c948 100644 --- a/compiler/iface/TcIface.hs +++ b/compiler/iface/TcIface.hs @@ -647,7 +647,7 @@ tc_iface_decl _ ignore_prags (IfaceId {ifName = name, ifType = iface_type, ifIdDetails = details, ifIdInfo = info}) = do { ty <- tcIfaceType iface_type ; details <- tcIdDetails ty details - ; info <- tcIdInfo ignore_prags name ty info + ; info <- tcIdInfo ignore_prags TopLevel name ty info ; return (AnId (mkGlobalId details name ty info)) } tc_iface_decl _ _ (IfaceData {ifName = tc_name, @@ -1461,7 +1461,7 @@ tcIfaceExpr (IfaceLet (IfaceNonRec (IfLetBndr fs ty info ji) rhs) body) = do { name <- newIfaceName (mkVarOccFS fs) ; ty' <- tcIfaceType ty ; id_info <- tcIdInfo False {- Don't ignore prags; we are inside one! -} - name ty' info + NotTopLevel name ty' info ; let id = mkLocalIdOrCoVarWithInfo name ty' id_info `asJoinId_maybe` tcJoinInfo ji ; rhs' <- tcIfaceExpr rhs @@ -1482,7 +1482,7 @@ tcIfaceExpr (IfaceLet (IfaceRec pairs) body) tc_pair (IfLetBndr _ _ info _, rhs) id = do { rhs' <- tcIfaceExpr rhs ; id_info <- tcIdInfo False {- Don't ignore prags; we are inside one! -} - (idName id) (idType id) info + NotTopLevel (idName id) (idType id) info ; return (setIdInfo id id_info, rhs') } tcIfaceExpr (IfaceTick tickish expr) = do @@ -1573,8 +1573,8 @@ tcIdDetails _ (IfRecSelId tc naughty) tyThingPatSyn (AConLike (PatSynCon ps)) = ps tyThingPatSyn _ = panic "tcIdDetails: expecting patsyn" -tcIdInfo :: Bool -> Name -> Type -> IfaceIdInfo -> IfL IdInfo -tcIdInfo ignore_prags name ty info = do +tcIdInfo :: Bool -> TopLevelFlag -> Name -> Type -> IfaceIdInfo -> IfL IdInfo +tcIdInfo ignore_prags toplvl name ty info = do lcl_env <- getLclEnv -- Set the CgInfo to something sensible but uninformative before -- we start; default assumption is that it has CAFs @@ -1595,7 +1595,7 @@ tcIdInfo ignore_prags name ty info = do -- The next two are lazy, so they don't transitively suck stuff in tcPrag info (HsUnfold lb if_unf) - = do { unf <- tcUnfolding name ty info if_unf + = do { unf <- tcUnfolding toplvl name ty info if_unf ; let info1 | lb = info `setOccInfo` strongLoopBreaker | otherwise = info ; return (info1 `setUnfoldingInfo` unf) } @@ -1604,10 +1604,10 @@ tcJoinInfo :: IfaceJoinInfo -> Maybe JoinArity tcJoinInfo (IfaceJoinPoint ar) = Just ar tcJoinInfo IfaceNotJoinPoint = Nothing -tcUnfolding :: Name -> Type -> IdInfo -> IfaceUnfolding -> IfL Unfolding -tcUnfolding name _ info (IfCoreUnfold stable if_expr) +tcUnfolding :: TopLevelFlag -> Name -> Type -> IdInfo -> IfaceUnfolding -> IfL Unfolding +tcUnfolding toplvl name _ info (IfCoreUnfold stable if_expr) = do { dflags <- getDynFlags - ; mb_expr <- tcPragExpr name if_expr + ; mb_expr <- tcPragExpr toplvl name if_expr ; let unf_src | stable = InlineStable | otherwise = InlineRhs ; return $ case mb_expr of @@ -1620,21 +1620,21 @@ tcUnfolding name _ info (IfCoreUnfold stable if_expr) where -- Strictness should occur before unfolding! strict_sig = strictnessInfo info -tcUnfolding name _ _ (IfCompulsory if_expr) - = do { mb_expr <- tcPragExpr name if_expr +tcUnfolding toplvl name _ _ (IfCompulsory if_expr) + = do { mb_expr <- tcPragExpr toplvl name if_expr ; return (case mb_expr of Nothing -> NoUnfolding Just expr -> mkCompulsoryUnfolding expr) } -tcUnfolding name _ _ (IfInlineRule arity unsat_ok boring_ok if_expr) - = do { mb_expr <- tcPragExpr name if_expr +tcUnfolding toplvl name _ _ (IfInlineRule arity unsat_ok boring_ok if_expr) + = do { mb_expr <- tcPragExpr toplvl name if_expr ; return (case mb_expr of Nothing -> NoUnfolding Just expr -> mkCoreUnfolding InlineStable True expr guidance )} where guidance = UnfWhen { ug_arity = arity, ug_unsat_ok = unsat_ok, ug_boring_ok = boring_ok } -tcUnfolding name dfun_ty _ (IfDFunUnfold bs ops) +tcUnfolding _toplvl name dfun_ty _ (IfDFunUnfold bs ops) = bindIfaceBndrs bs $ \ bs' -> do { mb_ops1 <- forkM_maybe doc $ mapM tcIfaceExpr ops ; return (case mb_ops1 of @@ -1649,13 +1649,14 @@ For unfoldings we try to do the job lazily, so that we never type check an unfolding that isn't going to be looked at. -} -tcPragExpr :: Name -> IfaceExpr -> IfL (Maybe CoreExpr) -tcPragExpr name expr +tcPragExpr :: TopLevelFlag -> Name -> IfaceExpr -> IfL (Maybe CoreExpr) +tcPragExpr toplvl name expr = forkM_maybe doc $ do core_expr' <- tcIfaceExpr expr - -- Check for type consistency in the unfolding - whenGOptM Opt_DoCoreLinting $ do + -- Check for type consistency in the unfolding + -- See Note [Linting Unfoldings from Interfaces] + when (isTopLevel toplvl) $ whenGOptM Opt_DoCoreLinting $ do in_scope <- get_in_scope dflags <- getDynFlags case lintUnfolding dflags noSrcLoc in_scope core_expr' of From git at git.haskell.org Thu Nov 9 00:42:52 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 9 Nov 2017 00:42:52 +0000 (UTC) Subject: [commit: ghc] ghc-8.2: Bump Cabal submodule (913ffc0) Message-ID: <20171109004252.707583A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.2 Link : http://ghc.haskell.org/trac/ghc/changeset/913ffc0cbc8f76f4bba88e8faea5e9b3ffd4677d/ghc >--------------------------------------------------------------- commit 913ffc0cbc8f76f4bba88e8faea5e9b3ffd4677d Author: Ben Gamari Date: Mon Nov 6 13:37:19 2017 -0500 Bump Cabal submodule >--------------------------------------------------------------- 913ffc0cbc8f76f4bba88e8faea5e9b3ffd4677d libraries/Cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/Cabal b/libraries/Cabal index b26a9ee..adae1e7 160000 --- a/libraries/Cabal +++ b/libraries/Cabal @@ -1 +1 @@ -Subproject commit b26a9ee3eb062ac727141fd9fd85835c2349f380 +Subproject commit adae1e7326f70fcc08794b42fa3ab207a69999c1 From git at git.haskell.org Thu Nov 9 00:42:55 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 9 Nov 2017 00:42:55 +0000 (UTC) Subject: [commit: ghc] ghc-8.2: Add a missing zonk in TcDerivInfer.simplifyDeriv (a05d71a) Message-ID: <20171109004255.AE3293A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.2 Link : http://ghc.haskell.org/trac/ghc/changeset/a05d71a73048df005c924f023607005a327e2adf/ghc >--------------------------------------------------------------- commit a05d71a73048df005c924f023607005a327e2adf Author: Simon Peyton Jones Date: Wed Oct 11 16:17:41 2017 +0100 Add a missing zonk in TcDerivInfer.simplifyDeriv I'm astonished that anything worked without this! Fixes Trac #14339 (cherry picked from commit 13fdca3d174ff15ac347c5db78370f457a3013ee) >--------------------------------------------------------------- a05d71a73048df005c924f023607005a327e2adf compiler/typecheck/TcDerivInfer.hs | 2 ++ testsuite/tests/deriving/should_compile/T14339.hs | 17 +++++++++++++++++ testsuite/tests/deriving/should_compile/all.T | 1 + 3 files changed, 20 insertions(+) diff --git a/compiler/typecheck/TcDerivInfer.hs b/compiler/typecheck/TcDerivInfer.hs index 93dcf43..bbd054c 100644 --- a/compiler/typecheck/TcDerivInfer.hs +++ b/compiler/typecheck/TcDerivInfer.hs @@ -622,6 +622,8 @@ simplifyDeriv pred tvs thetas -- Simplify the constraints ; solved_implics <- runTcSDeriveds $ solveWantedsAndDrop $ unionsWC wanteds + -- It's not yet zonked! Obviously zonk it before peering at it + ; solved_implics <- zonkWC solved_implics -- See [STEP DAC HOIST] -- Split the resulting constraints into bad and good constraints, diff --git a/testsuite/tests/deriving/should_compile/T14339.hs b/testsuite/tests/deriving/should_compile/T14339.hs new file mode 100644 index 0000000..e2521f2 --- /dev/null +++ b/testsuite/tests/deriving/should_compile/T14339.hs @@ -0,0 +1,17 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE UndecidableInstances #-} +module Bug where + +import GHC.TypeLits + +newtype Baz = Baz Foo + deriving Bar + +newtype Foo = Foo Int + +class Bar a where + bar :: a + +instance (TypeError (Text "Boo")) => Bar Foo where + bar = undefined diff --git a/testsuite/tests/deriving/should_compile/all.T b/testsuite/tests/deriving/should_compile/all.T index 5f94f9d..86648d3 100644 --- a/testsuite/tests/deriving/should_compile/all.T +++ b/testsuite/tests/deriving/should_compile/all.T @@ -89,3 +89,4 @@ test('T13272', normal, compile, ['']) test('T13272a', normal, compile, ['']) test('T13297', normal, compile, ['']) test('T14331', normal, compile, ['']) +test('T14339', normal, compile, ['']) From git at git.haskell.org Thu Nov 9 00:42:58 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 9 Nov 2017 00:42:58 +0000 (UTC) Subject: [commit: ghc] ghc-8.2: DynFlags: Introduce -show-mods-loaded flag (befd937) Message-ID: <20171109004258.72CF73A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.2 Link : http://ghc.haskell.org/trac/ghc/changeset/befd937353bee0f65197317410cde3f49fca521a/ghc >--------------------------------------------------------------- commit befd937353bee0f65197317410cde3f49fca521a Author: Ben Gamari Date: Mon Nov 6 15:35:19 2017 -0500 DynFlags: Introduce -show-mods-loaded flag This flag reintroduces the verbose module name output produced by GHCi's :load command behind a new flag, -show-mods-loaded. This was originally removed in D3651 but apparently some tools (e.g. haskell-mode) rely on this output. Addresses #14427. Test Plan: Validate Reviewers: svenpanne Reviewed By: svenpanne Subscribers: rwbarton, thomie Differential Revision: https://phabricator.haskell.org/D4164 (cherry picked from commit 8613e61de62178e76cd0f8915bd1fbe9c200a039) >--------------------------------------------------------------- befd937353bee0f65197317410cde3f49fca521a compiler/main/DynFlags.hs | 2 ++ docs/users_guide/ghci.rst | 13 ++++++++++ ghc/GHCi/UI.hs | 38 ++++++++++++++++++++--------- testsuite/tests/driver/T8526/T8526.stdout | 4 +-- testsuite/tests/ghci/scripts/T1914.stdout | 6 ++--- testsuite/tests/ghci/scripts/T6105.stdout | 4 +-- testsuite/tests/ghci/scripts/ghci058.stdout | 4 +-- 7 files changed, 50 insertions(+), 21 deletions(-) diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 4791525..f5f5f00 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -536,6 +536,7 @@ data GeneralFlag | Opt_PprCaseAsLet | Opt_PprShowTicks | Opt_ShowHoleConstraints + | Opt_ShowLoadedModules -- Suppress all coercions, them replacing with '...' | Opt_SuppressCoercions @@ -3762,6 +3763,7 @@ fFlagsDeps = [ flagSpec "show-warning-groups" Opt_ShowWarnGroups, flagSpec "hide-source-paths" Opt_HideSourcePaths, flagSpec "show-hole-constraints" Opt_ShowHoleConstraints, + flagSpec "show-loaded-modules" Opt_ShowLoadedModules, flagSpec "whole-archive-hs-libs" Opt_WholeArchiveHsLibs ] diff --git a/docs/users_guide/ghci.rst b/docs/users_guide/ghci.rst index e2fb361..3bdc863 100644 --- a/docs/users_guide/ghci.rst +++ b/docs/users_guide/ghci.rst @@ -138,6 +138,19 @@ them all in dependency order. Windows, then the current directory is probably something like ``C:\Documents and Settings\user name``. +.. ghc-flag:: -fshow-loaded-modules + :shortdesc: Show the names of modules that GHCi loaded after a + :ghci-cmd:`:load` command. + :type: dynamic + :default: off + + :since: 8.2.2 + + Typically GHCi will show only the number of modules that it loaded after a + :ghci-cmd:`:load` command. With this flag, GHC will also list the loaded + modules' names. This was the default behavior prior to GHC 8.2.1 and can be + useful for some tooling users. + .. _ghci-modules-filenames: diff --git a/ghc/GHCi/UI.hs b/ghc/GHCi/UI.hs index 9173d75..f677e99 100644 --- a/ghc/GHCi/UI.hs +++ b/ghc/GHCi/UI.hs @@ -51,7 +51,7 @@ import GHC ( LoadHowMuch(..), Target(..), TargetId(..), InteractiveImport(..), import HsImpExp import HsSyn import HscTypes ( tyThingParent_maybe, handleFlagWarnings, getSafeMode, hsc_IC, - setInteractivePrintName, hsc_dflags ) + setInteractivePrintName, hsc_dflags, msObjFilePath ) import Module import Name import Packages ( trusted, getPackageDetails, getInstalledPackageDetails, @@ -1721,7 +1721,7 @@ afterLoad ok retain_context = do lift revertCAFs -- always revert CAFs on load. lift discardTickArrays loaded_mods <- getLoadedModules - modulesLoadedMsg ok (length loaded_mods) + modulesLoadedMsg ok loaded_mods lift $ setContextAfterLoad retain_context loaded_mods setContextAfterLoad :: Bool -> [GHC.ModSummary] -> GHCi () @@ -1796,22 +1796,36 @@ keepPackageImports = filterM is_pkg_import mod_name = unLoc (ideclName d) -modulesLoadedMsg :: SuccessFlag -> Int -> InputT GHCi () -modulesLoadedMsg ok num_mods = do +modulesLoadedMsg :: SuccessFlag -> [GHC.ModSummary] -> InputT GHCi () +modulesLoadedMsg ok mods = do dflags <- getDynFlags unqual <- GHC.getPrintUnqual - let status = case ok of - Failed -> text "Failed" - Succeeded -> text "Ok" - num_mods_pp = if num_mods == 1 - then "1 module" - else int num_mods <+> "modules" - msg = status <> text "," <+> num_mods_pp <+> "loaded." + msg <- if gopt Opt_ShowLoadedModules dflags + then do + mod_names <- mapM mod_name mods + let mod_commas + | null mods = text "none." + | otherwise = hsep (punctuate comma mod_names) <> text "." + return $ status <> text ", modules loaded:" <+> mod_commas + else do + return $ status <> text "," + <+> speakNOf (length mods) (text "module") <+> "loaded." when (verbosity dflags > 0) $ liftIO $ putStrLn $ showSDocForUser dflags unqual msg - + where + status = case ok of + Failed -> text "Failed" + Succeeded -> text "Ok" + + mod_name mod = do + is_interpreted <- GHC.moduleIsBootOrNotObjectLinkable mod + return $ if is_interpreted + then ppr (GHC.ms_mod mod) + else ppr (GHC.ms_mod mod) + <+> parens (text $ normalise $ msObjFilePath mod) + -- Fix #9887 -- | Run an 'ExceptT' wrapped 'GhcMonad' while handling source errors -- and printing 'throwE' strings to 'stderr' diff --git a/testsuite/tests/driver/T8526/T8526.stdout b/testsuite/tests/driver/T8526/T8526.stdout index 83b8f95..0255fa3 100644 --- a/testsuite/tests/driver/T8526/T8526.stdout +++ b/testsuite/tests/driver/T8526/T8526.stdout @@ -1,6 +1,6 @@ [1 of 1] Compiling A ( A.hs, interpreted ) -Ok, 1 module loaded. +Ok, one module loaded. True [1 of 1] Compiling A ( A.hs, interpreted ) -Ok, 1 module loaded. +Ok, one module loaded. False diff --git a/testsuite/tests/ghci/scripts/T1914.stdout b/testsuite/tests/ghci/scripts/T1914.stdout index 2d1a82b..6612564 100644 --- a/testsuite/tests/ghci/scripts/T1914.stdout +++ b/testsuite/tests/ghci/scripts/T1914.stdout @@ -1,7 +1,7 @@ [1 of 2] Compiling T1914B ( T1914B.hs, interpreted ) [2 of 2] Compiling T1914A ( T1914A.hs, interpreted ) -Ok, 2 modules loaded. +Ok, two modules loaded. [2 of 2] Compiling T1914A ( T1914A.hs, interpreted ) -Failed, 1 module loaded. +Failed, one module loaded. [2 of 2] Compiling T1914A ( T1914A.hs, interpreted ) -Ok, 2 modules loaded. +Ok, two modules loaded. diff --git a/testsuite/tests/ghci/scripts/T6105.stdout b/testsuite/tests/ghci/scripts/T6105.stdout index 6a846e3..9a8190f 100644 --- a/testsuite/tests/ghci/scripts/T6105.stdout +++ b/testsuite/tests/ghci/scripts/T6105.stdout @@ -1,4 +1,4 @@ [1 of 1] Compiling T6105 ( T6105.hs, interpreted ) -Ok, 1 module loaded. +Ok, one module loaded. [1 of 1] Compiling T6105 ( T6105.hs, interpreted ) -Ok, 1 module loaded. +Ok, one module loaded. diff --git a/testsuite/tests/ghci/scripts/ghci058.stdout b/testsuite/tests/ghci/scripts/ghci058.stdout index 2028aee..83c8bbd 100644 --- a/testsuite/tests/ghci/scripts/ghci058.stdout +++ b/testsuite/tests/ghci/scripts/ghci058.stdout @@ -1,4 +1,4 @@ -Ok, 1 module loaded. +Ok, one module loaded. 'a' -Ok, 1 module loaded. +Ok, one module loaded. 'b' From git at git.haskell.org Thu Nov 9 09:40:50 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 9 Nov 2017 09:40:50 +0000 (UTC) Subject: [commit: ghc] master: Remove left-overs from compareByteArray# inline conversion (6bd352a) Message-ID: <20171109094050.42DAB3A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6bd352a85ffe9a649848dc79b017bb018e246d36/ghc >--------------------------------------------------------------- commit 6bd352a85ffe9a649848dc79b017bb018e246d36 Author: Herbert Valerio Riedel Date: Thu Nov 9 00:38:53 2017 +0100 Remove left-overs from compareByteArray# inline conversion These removes left-overs from e3ba26f8b49700b41ff4672f3f7f6a4e453acdcc where I implemented `compareByteArray#` as an out-of-line primop, which got optimised into an inline primop shortly afterwards (as per 7673561555ae354fd9eed8de1e57c681906e2d49). >--------------------------------------------------------------- 6bd352a85ffe9a649848dc79b017bb018e246d36 includes/stg/MiscClosures.h | 1 - rts/PrimOps.cmm | 14 -------------- rts/RtsSymbols.c | 1 - 3 files changed, 16 deletions(-) diff --git a/includes/stg/MiscClosures.h b/includes/stg/MiscClosures.h index 66e2654..76cfbd6 100644 --- a/includes/stg/MiscClosures.h +++ b/includes/stg/MiscClosures.h @@ -351,7 +351,6 @@ RTS_FUN_DECL(stg_casArrayzh); RTS_FUN_DECL(stg_newByteArrayzh); RTS_FUN_DECL(stg_newPinnedByteArrayzh); RTS_FUN_DECL(stg_newAlignedPinnedByteArrayzh); -RTS_FUN_DECL(stg_compareByteArrayszh); RTS_FUN_DECL(stg_isByteArrayPinnedzh); RTS_FUN_DECL(stg_isMutableByteArrayPinnedzh); RTS_FUN_DECL(stg_shrinkMutableByteArrayzh); diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm index 467353a..1dad14b 100644 --- a/rts/PrimOps.cmm +++ b/rts/PrimOps.cmm @@ -152,20 +152,6 @@ stg_newAlignedPinnedByteArrayzh ( W_ n, W_ alignment ) return (p); } -stg_compareByteArrayszh ( gcptr src1, W_ src1_ofs, gcptr src2, W_ src2_ofs, W_ size ) -// ByteArray# -> Int# -> ByteArray# -> Int# -> Int# -> Int# -{ - CInt res; - W_ src1p, src2p; - - src1p = src1 + SIZEOF_StgHeader + OFFSET_StgArrBytes_payload + src1_ofs; - src2p = src2 + SIZEOF_StgHeader + OFFSET_StgArrBytes_payload + src2_ofs; - - (res) = ccall memcmp(src1p "ptr", src2p "ptr", size); - - return (TO_W_(res)); -} - stg_isByteArrayPinnedzh ( gcptr ba ) // ByteArray# s -> Int# { diff --git a/rts/RtsSymbols.c b/rts/RtsSymbols.c index ff15d77..dd233fa 100644 --- a/rts/RtsSymbols.c +++ b/rts/RtsSymbols.c @@ -674,7 +674,6 @@ SymI_HasProto(stg_casMutVarzh) \ SymI_HasProto(stg_newPinnedByteArrayzh) \ SymI_HasProto(stg_newAlignedPinnedByteArrayzh) \ - SymI_HasProto(stg_compareByteArrayszh) \ SymI_HasProto(stg_isByteArrayPinnedzh) \ SymI_HasProto(stg_isMutableByteArrayPinnedzh) \ SymI_HasProto(stg_shrinkMutableByteArrayzh) \ From git at git.haskell.org Thu Nov 9 22:50:03 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 9 Nov 2017 22:50:03 +0000 (UTC) Subject: [commit: ghc] master: testsuite: Fix output of T14394 (10ff3e3) Message-ID: <20171109225003.63DF23A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/10ff3e3180d1e808dbcff0f92afc5a3b3a8d4e83/ghc >--------------------------------------------------------------- commit 10ff3e3180d1e808dbcff0f92afc5a3b3a8d4e83 Author: Ben Gamari Date: Thu Nov 9 17:07:53 2017 -0500 testsuite: Fix output of T14394 >--------------------------------------------------------------- 10ff3e3180d1e808dbcff0f92afc5a3b3a8d4e83 testsuite/tests/patsyn/should_compile/T14394.stdout | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/testsuite/tests/patsyn/should_compile/T14394.stdout b/testsuite/tests/patsyn/should_compile/T14394.stdout index 0519ecb..2dc3415 100644 --- a/testsuite/tests/patsyn/should_compile/T14394.stdout +++ b/testsuite/tests/patsyn/should_compile/T14394.stdout @@ -1 +1,7 @@ - \ No newline at end of file +pattern Foo :: () => (b ~ a) => a :~~: b + -- Defined at :5:1 +pattern Bar :: forall k2 k1 (a :: k1) (b :: k2). () => (k2 ~ k1, + (b :: k2) ~~ (a :: k1)) => a :~~: b + -- Defined at :11:1 +pattern Bam :: () => Ord a => a -> a -> (S a, S a) + -- Defined at :21:1 From git at git.haskell.org Thu Nov 9 22:50:06 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 9 Nov 2017 22:50:06 +0000 (UTC) Subject: [commit: ghc] master: Update Win32 version for GHC 8.4. (bdd2d28) Message-ID: <20171109225006.30D123A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/bdd2d2862e248948efafa8ba4219e94825ddf21a/ghc >--------------------------------------------------------------- commit bdd2d2862e248948efafa8ba4219e94825ddf21a Author: Tamar Christina Date: Wed Nov 8 01:21:16 2017 -0500 Update Win32 version for GHC 8.4. Update to Win32 2.6 which is the expected version release for 8.4 This involves moving Cabal forward which brings some backwards incompatible changes that needs various fixups. Bump a bunch of submodules Test Plan: ./validate Reviewers: austin, bgamari, angerman Reviewed By: bgamari, angerman Subscribers: angerman, thomie, rwbarton Differential Revision: https://phabricator.haskell.org/D4133 >--------------------------------------------------------------- bdd2d2862e248948efafa8ba4219e94825ddf21a compiler/ghc.cabal.in | 2 +- docs/users_guide/8.4.1-notes.rst | 7 +++++++ ghc/ghc-bin.cabal.in | 2 +- libraries/Cabal | 2 +- libraries/Win32 | 2 +- libraries/directory | 2 +- libraries/process | 2 +- testsuite/tests/cabal/ghcpkg01.stdout | 6 ++++++ testsuite/tests/driver/T4437.hs | 2 -- testsuite/tests/perf/haddock/all.T | 3 ++- utils/check-api-annotations/check-api-annotations.cabal | 2 +- utils/check-ppr/check-ppr.cabal | 2 +- utils/ghc-cabal/Main.hs | 7 ++++--- utils/ghc-cabal/ghc-cabal.cabal | 2 +- utils/ghc-pkg/Main.hs | 8 +++----- utils/ghctags/ghctags.cabal | 2 +- 16 files changed, 32 insertions(+), 21 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 bdd2d2862e248948efafa8ba4219e94825ddf21a From git at git.haskell.org Thu Nov 9 23:35:01 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 9 Nov 2017 23:35:01 +0000 (UTC) Subject: [commit: ghc] master: Merge initial Hadrian snapshot (9773053) Message-ID: <20171109233501.859BF3A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/977305346cffad70f0977467153cce52b2d1ae0b/ghc >--------------------------------------------------------------- commit 977305346cffad70f0977467153cce52b2d1ae0b Merge: bdd2d28 5cee480 Author: Ben Gamari Date: Thu Nov 9 17:50:42 2017 -0500 Merge initial Hadrian snapshot We will continue to pull in squashed snapshots periodically until we eventually discontinue development in Hadrian's GitHub repository. >--------------------------------------------------------------- 977305346cffad70f0977467153cce52b2d1ae0b hadrian/.ghci | 11 + hadrian/.gitignore | 26 ++ hadrian/.travis.yml | 90 +++++ hadrian/LICENSE | 21 + hadrian/README.md | 194 +++++++++ hadrian/appveyor.yml | 39 ++ hadrian/build.bat | 6 + hadrian/build.cabal.sh | 74 ++++ hadrian/build.global-db.bat | 32 ++ hadrian/build.global-db.sh | 52 +++ hadrian/build.sh | 35 ++ hadrian/build.stack.bat | 11 + hadrian/build.stack.nix.sh | 33 ++ hadrian/build.stack.sh | 39 ++ hadrian/cabal.project | 2 + hadrian/cfg/system.config.in | 141 +++++++ hadrian/circle.yml | 41 ++ hadrian/doc/cross-compile.md | 57 +++ hadrian/doc/flavours.md | 176 +++++++++ hadrian/doc/user-settings.md | 212 ++++++++++ hadrian/doc/windows.md | 69 ++++ hadrian/hadrian.cabal | 142 +++++++ hadrian/src/Base.hs | 121 ++++++ hadrian/src/Builder.hs | 296 ++++++++++++++ hadrian/src/CommandLine.hs | 137 +++++++ hadrian/src/Context.hs | 158 ++++++++ hadrian/src/Environment.hs | 16 + hadrian/src/Expression.hs | 123 ++++++ hadrian/src/Flavour.hs | 34 ++ hadrian/src/GHC.hs | 289 ++++++++++++++ hadrian/src/Hadrian/Builder.hs | 125 ++++++ hadrian/src/Hadrian/Builder/Ar.hs | 68 ++++ hadrian/src/Hadrian/Builder/Sphinx.hs | 39 ++ hadrian/src/Hadrian/Builder/Tar.hs | 40 ++ hadrian/src/Hadrian/Expression.hs | 153 +++++++ hadrian/src/Hadrian/Haskell/Cabal.hs | 44 +++ hadrian/src/Hadrian/Haskell/Cabal/Parse.hs | 63 +++ hadrian/src/Hadrian/Oracles/ArgsHash.hs | 51 +++ hadrian/src/Hadrian/Oracles/DirectoryContents.hs | 64 +++ hadrian/src/Hadrian/Oracles/Path.hs | 62 +++ hadrian/src/Hadrian/Oracles/TextFile.hs | 123 ++++++ hadrian/src/Hadrian/Package.hs | 120 ++++++ hadrian/src/Hadrian/Target.hs | 29 ++ hadrian/src/Hadrian/Utilities.hs | 406 +++++++++++++++++++ hadrian/src/Main.hs | 59 +++ hadrian/src/Oracles/Flag.hs | 80 ++++ hadrian/src/Oracles/ModuleFiles.hs | 160 ++++++++ hadrian/src/Oracles/PackageData.hs | 66 ++++ hadrian/src/Oracles/Setting.hs | 236 +++++++++++ hadrian/src/Rules.hs | 123 ++++++ hadrian/src/Rules/Clean.hs | 23 ++ hadrian/src/Rules/Compile.hs | 83 ++++ hadrian/src/Rules/Configure.hs | 42 ++ hadrian/src/Rules/Dependencies.hs | 33 ++ hadrian/src/Rules/Documentation.hs | 197 +++++++++ hadrian/src/Rules/Generate.hs | 482 +++++++++++++++++++++++ hadrian/src/Rules/Gmp.hs | 119 ++++++ hadrian/src/Rules/Install.hs | 336 ++++++++++++++++ hadrian/src/Rules/Libffi.hs | 108 +++++ hadrian/src/Rules/Library.hs | 103 +++++ hadrian/src/Rules/PackageData.hs | 119 ++++++ hadrian/src/Rules/Program.hs | 116 ++++++ hadrian/src/Rules/Register.hs | 44 +++ hadrian/src/Rules/Selftest.hs | 92 +++++ hadrian/src/Rules/SourceDist.hs | 113 ++++++ hadrian/src/Rules/Test.hs | 72 ++++ hadrian/src/Rules/Wrappers.hs | 162 ++++++++ hadrian/src/Settings.hs | 68 ++++ hadrian/src/Settings/Builders/Alex.hs | 8 + hadrian/src/Settings/Builders/Cc.hs | 26 ++ hadrian/src/Settings/Builders/Common.hs | 59 +++ hadrian/src/Settings/Builders/Configure.hs | 25 ++ hadrian/src/Settings/Builders/DeriveConstants.hs | 39 ++ hadrian/src/Settings/Builders/GenPrimopCode.hs | 24 ++ hadrian/src/Settings/Builders/Ghc.hs | 149 +++++++ hadrian/src/Settings/Builders/GhcCabal.hs | 118 ++++++ hadrian/src/Settings/Builders/GhcPkg.hs | 17 + hadrian/src/Settings/Builders/Haddock.hs | 63 +++ hadrian/src/Settings/Builders/Happy.hs | 9 + hadrian/src/Settings/Builders/HsCpp.hs | 16 + hadrian/src/Settings/Builders/Hsc2Hs.hs | 56 +++ hadrian/src/Settings/Builders/Ld.hs | 9 + hadrian/src/Settings/Builders/Make.hs | 16 + hadrian/src/Settings/Builders/Xelatex.hs | 7 + hadrian/src/Settings/Default.hs | 173 ++++++++ hadrian/src/Settings/Default.hs-boot | 20 + hadrian/src/Settings/Flavours/Development.hs | 20 + hadrian/src/Settings/Flavours/Performance.hs | 18 + hadrian/src/Settings/Flavours/Profiled.hs | 19 + hadrian/src/Settings/Flavours/Quick.hs | 22 ++ hadrian/src/Settings/Flavours/QuickCross.hs | 24 ++ hadrian/src/Settings/Flavours/Quickest.hs | 23 ++ hadrian/src/Settings/Packages/Base.hs | 12 + hadrian/src/Settings/Packages/Cabal.hs | 10 + hadrian/src/Settings/Packages/Compiler.hs | 45 +++ hadrian/src/Settings/Packages/Ghc.hs | 13 + hadrian/src/Settings/Packages/GhcCabal.hs | 24 ++ hadrian/src/Settings/Packages/GhcPkg.hs | 7 + hadrian/src/Settings/Packages/GhcPrim.hs | 13 + hadrian/src/Settings/Packages/Ghci.hs | 6 + hadrian/src/Settings/Packages/Haddock.hs | 7 + hadrian/src/Settings/Packages/Haskeline.hs | 8 + hadrian/src/Settings/Packages/IntegerGmp.hs | 24 ++ hadrian/src/Settings/Packages/Rts.hs | 218 ++++++++++ hadrian/src/Settings/Packages/RunGhc.hs | 9 + hadrian/src/Settings/Warnings.hs | 57 +++ hadrian/src/Stage.hs | 31 ++ hadrian/src/Target.hs | 26 ++ hadrian/src/UserSettings.hs | 64 +++ hadrian/src/Utilities.hs | 80 ++++ hadrian/src/Way.hs | 162 ++++++++ hadrian/stack.yaml | 22 ++ 112 files changed, 8898 insertions(+) From git at git.haskell.org Thu Nov 9 23:35:05 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 9 Nov 2017 23:35:05 +0000 (UTC) Subject: [commit: ghc] master: base: Add test for #14425 (ce9a677) Message-ID: <20171109233505.00D323A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ce9a67784390735aa9749667934af49665b8402e/ghc >--------------------------------------------------------------- commit ce9a67784390735aa9749667934af49665b8402e Author: Ben Gamari Date: Thu Nov 9 17:52:26 2017 -0500 base: Add test for #14425 Test Plan: Validate Reviewers: hvr Subscribers: rwbarton, thomie GHC Trac Issues: #14425 Differential Revision: https://phabricator.haskell.org/D4166 >--------------------------------------------------------------- ce9a67784390735aa9749667934af49665b8402e libraries/base/tests/T14425.hs | 5 +++++ libraries/base/tests/T14425.stdout | 2 ++ libraries/base/tests/all.T | 1 + 3 files changed, 8 insertions(+) diff --git a/libraries/base/tests/T14425.hs b/libraries/base/tests/T14425.hs new file mode 100644 index 0000000..0a93569 --- /dev/null +++ b/libraries/base/tests/T14425.hs @@ -0,0 +1,5 @@ +import Data.Ratio + +main = do + print (approxRational (0 % 1 :: Ratio Int) (1 % 10)) -- 0%1, correct + print (approxRational (0 % 1 :: Ratio Word) (1 % 10)) -- 1%1, incorrect diff --git a/libraries/base/tests/T14425.stdout b/libraries/base/tests/T14425.stdout new file mode 100644 index 0000000..2118b0c --- /dev/null +++ b/libraries/base/tests/T14425.stdout @@ -0,0 +1,2 @@ +0 % 1 +0 % 1 diff --git a/libraries/base/tests/all.T b/libraries/base/tests/all.T index 9055bd5..7839076 100644 --- a/libraries/base/tests/all.T +++ b/libraries/base/tests/all.T @@ -221,3 +221,4 @@ test('T3474', [stats_num_field('max_bytes_used', [ (wordsize(64), 44504, 5) ]), only_ways(['normal'])], compile_and_run, ['-O']) +test('T14425', expect_broken(14425), compile_and_run, ['']) From git at git.haskell.org Thu Nov 9 23:35:07 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 9 Nov 2017 23:35:07 +0000 (UTC) Subject: [commit: ghc] master: base: Fix #14425 (5834da4) Message-ID: <20171109233507.C65CE3A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5834da4872877736eefb85daedaf7b137ae702a1/ghc >--------------------------------------------------------------- commit 5834da4872877736eefb85daedaf7b137ae702a1 Author: Ben Gamari Date: Thu Nov 9 17:53:39 2017 -0500 base: Fix #14425 Test Plan: Validate Reviewers: hvr Subscribers: rwbarton, thomie GHC Trac Issues: #14425 Differential Revision: https://phabricator.haskell.org/D4167 >--------------------------------------------------------------- 5834da4872877736eefb85daedaf7b137ae702a1 libraries/base/Data/Ratio.hs | 4 +++- libraries/base/tests/all.T | 2 +- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/libraries/base/Data/Ratio.hs b/libraries/base/Data/Ratio.hs index 8d19506..946824f 100644 --- a/libraries/base/Data/Ratio.hs +++ b/libraries/base/Data/Ratio.hs @@ -49,7 +49,9 @@ import GHC.Real -- The basic defns for Ratio approxRational :: (RealFrac a) => a -> a -> Rational approxRational rat eps = - simplest (rat-eps) (rat+eps) + -- We convert rat and eps to rational *before* subtracting/adding since + -- otherwise we may overflow. This was the cause of #14425. + simplest (toRational rat - toRational eps) (toRational rat + toRational eps) where simplest x y | y < x = simplest y x diff --git a/libraries/base/tests/all.T b/libraries/base/tests/all.T index 7839076..06c7350 100644 --- a/libraries/base/tests/all.T +++ b/libraries/base/tests/all.T @@ -221,4 +221,4 @@ test('T3474', [stats_num_field('max_bytes_used', [ (wordsize(64), 44504, 5) ]), only_ways(['normal'])], compile_and_run, ['-O']) -test('T14425', expect_broken(14425), compile_and_run, ['']) +test('T14425', normal, compile_and_run, ['']) From git at git.haskell.org Thu Nov 9 23:35:10 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 9 Nov 2017 23:35:10 +0000 (UTC) Subject: [commit: ghc] master: base: Normalize style of approxRational (c59d6da) Message-ID: <20171109233510.8A6E03A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c59d6da8639fd88919090b29cf4e76c4d0d8bbde/ghc >--------------------------------------------------------------- commit c59d6da8639fd88919090b29cf4e76c4d0d8bbde Author: Ben Gamari Date: Thu Nov 9 17:53:24 2017 -0500 base: Normalize style of approxRational Stumbled upon this odd bit of style while looking at #14425. Usually I don't like to do this sort of reformatting, but this seemed like it would be necessary in the course fo fixing #14425. Reviewers: hvr Subscribers: rwbarton, thomie Differential Revision: https://phabricator.haskell.org/D4168 >--------------------------------------------------------------- c59d6da8639fd88919090b29cf4e76c4d0d8bbde libraries/base/Data/Ratio.hs | 47 +++++++++++++++++++++++--------------------- 1 file changed, 25 insertions(+), 22 deletions(-) diff --git a/libraries/base/Data/Ratio.hs b/libraries/base/Data/Ratio.hs index 8517e48..8d19506 100644 --- a/libraries/base/Data/Ratio.hs +++ b/libraries/base/Data/Ratio.hs @@ -47,27 +47,30 @@ import GHC.Real -- The basic defns for Ratio -- and abs r' < d', and the simplest rational is q%1 + the reciprocal of -- the simplest rational between d'%r' and d%r. -approxRational :: (RealFrac a) => a -> a -> Rational -approxRational rat eps = simplest (rat-eps) (rat+eps) - where simplest x y | y < x = simplest y x - | x == y = xr - | x > 0 = simplest' n d n' d' - | y < 0 = - simplest' (-n') d' (-n) d - | otherwise = 0 :% 1 - where xr = toRational x - n = numerator xr - d = denominator xr - nd' = toRational y - n' = numerator nd' - d' = denominator nd' +approxRational :: (RealFrac a) => a -> a -> Rational +approxRational rat eps = + simplest (rat-eps) (rat+eps) + where + simplest x y + | y < x = simplest y x + | x == y = xr + | x > 0 = simplest' n d n' d' + | y < 0 = - simplest' (-n') d' (-n) d + | otherwise = 0 :% 1 + where xr = toRational x + n = numerator xr + d = denominator xr + nd' = toRational y + n' = numerator nd' + d' = denominator nd' - simplest' n d n' d' -- assumes 0 < n%d < n'%d' - | r == 0 = q :% 1 - | q /= q' = (q+1) :% 1 - | otherwise = (q*n''+d'') :% n'' - where (q,r) = quotRem n d - (q',r') = quotRem n' d' - nd'' = simplest' d' r' d r - n'' = numerator nd'' - d'' = denominator nd'' + simplest' n d n' d' -- assumes 0 < n%d < n'%d' + | r == 0 = q :% 1 + | q /= q' = (q+1) :% 1 + | otherwise = (q*n''+d'') :% n'' + where (q,r) = quotRem n d + (q',r') = quotRem n' d' + nd'' = simplest' d' r' d r + n'' = numerator nd'' + d'' = denominator nd'' From git at git.haskell.org Thu Nov 9 23:35:13 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 9 Nov 2017 23:35:13 +0000 (UTC) Subject: [commit: ghc] master: Update comment in GHC.Real (trac#14432) (0656cb4) Message-ID: <20171109233513.58B6B3A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/0656cb4add7c45382f6a5c3234ad5c75d3e5f112/ghc >--------------------------------------------------------------- commit 0656cb4add7c45382f6a5c3234ad5c75d3e5f112 Author: Bodigrim Date: Thu Nov 9 17:53:57 2017 -0500 Update comment in GHC.Real (trac#14432) Reviewers: hvr, bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie GHC Trac Issues: #14432 Differential Revision: https://phabricator.haskell.org/D4171 >--------------------------------------------------------------- 0656cb4add7c45382f6a5c3234ad5c75d3e5f112 libraries/base/GHC/Real.hs | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/libraries/base/GHC/Real.hs b/libraries/base/GHC/Real.hs index 85a1602..f30a53e 100644 --- a/libraries/base/GHC/Real.hs +++ b/libraries/base/GHC/Real.hs @@ -527,9 +527,7 @@ x ^^ n = if n >= 0 then x^n else recip (x^(negate n)) be statically resolved to 0 or 1 are rare. It might be desirable to have corresponding rules also for - exponents of other types, in particular Word, but we can't - have those rules here (importing GHC.Word or GHC.Int would - create a cyclic module dependency), and it's doubtful they + exponents of other types (e. g., Word), but it's doubtful they would fire, since the exponents of other types tend to get floated out before the rule has a chance to fire. From git at git.haskell.org Thu Nov 9 23:35:19 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 9 Nov 2017 23:35:19 +0000 (UTC) Subject: [commit: ghc] master: Change `OPTIONS_GHC -O` to `OPTIONS_GHC -O2` (75291ab) Message-ID: <20171109233519.AB8F93A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/75291abaf6db7befbde5b4dadaea0b8047a75e06/ghc >--------------------------------------------------------------- commit 75291abaf6db7befbde5b4dadaea0b8047a75e06 Author: Douglas Wilson Date: Thu Nov 9 17:54:45 2017 -0500 Change `OPTIONS_GHC -O` to `OPTIONS_GHC -O2` These pragmas were having the perverse effect of having these performance critical modules be LESS optimized in builds with -O2. Test Plan: Check on gipedia whether this is worthwhile. Reviewers: austin, bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie Differential Revision: https://phabricator.haskell.org/D4156 >--------------------------------------------------------------- 75291abaf6db7befbde5b4dadaea0b8047a75e06 compiler/iface/BinIface.hs | 2 +- compiler/utils/Binary.hs | 2 +- compiler/utils/Encoding.hs | 2 +- compiler/utils/FastMutInt.hs | 2 +- compiler/utils/FastString.hs | 2 +- compiler/utils/StringBuffer.hs | 2 +- 6 files changed, 6 insertions(+), 6 deletions(-) diff --git a/compiler/iface/BinIface.hs b/compiler/iface/BinIface.hs index 8ab2310..31b5af0 100644 --- a/compiler/iface/BinIface.hs +++ b/compiler/iface/BinIface.hs @@ -4,7 +4,7 @@ -- (c) The University of Glasgow 2002-2006 -- -{-# OPTIONS_GHC -O #-} +{-# OPTIONS_GHC -O2 #-} -- We always optimise this, otherwise performance of a non-optimised -- compiler is severely affected diff --git a/compiler/utils/Binary.hs b/compiler/utils/Binary.hs index a7bbfd5..c3c8ae3 100644 --- a/compiler/utils/Binary.hs +++ b/compiler/utils/Binary.hs @@ -5,7 +5,7 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE MultiWayIf #-} -{-# OPTIONS_GHC -O -funbox-strict-fields #-} +{-# OPTIONS_GHC -O2 -funbox-strict-fields #-} -- We always optimise this, otherwise performance of a non-optimised -- compiler is severely affected diff --git a/compiler/utils/Encoding.hs b/compiler/utils/Encoding.hs index f809ba9..b4af686 100644 --- a/compiler/utils/Encoding.hs +++ b/compiler/utils/Encoding.hs @@ -1,5 +1,5 @@ {-# LANGUAGE BangPatterns, MagicHash, UnboxedTuples #-} -{-# OPTIONS_GHC -O #-} +{-# OPTIONS_GHC -O2 #-} -- We always optimise this, otherwise performance of a non-optimised -- compiler is severely affected diff --git a/compiler/utils/FastMutInt.hs b/compiler/utils/FastMutInt.hs index 6ba139a..20206f8 100644 --- a/compiler/utils/FastMutInt.hs +++ b/compiler/utils/FastMutInt.hs @@ -1,5 +1,5 @@ {-# LANGUAGE BangPatterns, MagicHash, UnboxedTuples #-} -{-# OPTIONS_GHC -O #-} +{-# OPTIONS_GHC -O2 #-} -- We always optimise this, otherwise performance of a non-optimised -- compiler is severely affected -- diff --git a/compiler/utils/FastString.hs b/compiler/utils/FastString.hs index fde4ff0..f16b327 100644 --- a/compiler/utils/FastString.hs +++ b/compiler/utils/FastString.hs @@ -2,7 +2,7 @@ {-# LANGUAGE BangPatterns, CPP, MagicHash, UnboxedTuples, GeneralizedNewtypeDeriving #-} -{-# OPTIONS_GHC -O -funbox-strict-fields #-} +{-# OPTIONS_GHC -O2 -funbox-strict-fields #-} -- We always optimise this, otherwise performance of a non-optimised -- compiler is severely affected diff --git a/compiler/utils/StringBuffer.hs b/compiler/utils/StringBuffer.hs index 0840210..39941e2 100644 --- a/compiler/utils/StringBuffer.hs +++ b/compiler/utils/StringBuffer.hs @@ -7,7 +7,7 @@ Buffers for scanning string input stored in external arrays. -} {-# LANGUAGE BangPatterns, CPP, MagicHash, UnboxedTuples #-} -{-# OPTIONS_GHC -O #-} +{-# OPTIONS_GHC -O2 #-} -- We always optimise this, otherwise performance of a non-optimised -- compiler is severely affected From git at git.haskell.org Thu Nov 9 23:35:16 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 9 Nov 2017 23:35:16 +0000 (UTC) Subject: [commit: ghc] master: testsuite: Add test for #5889 (e6b13c9) Message-ID: <20171109233516.E57683A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e6b13c963d0b54099a41bb1b51fe680644582051/ghc >--------------------------------------------------------------- commit e6b13c963d0b54099a41bb1b51fe680644582051 Author: Douglas Wilson Date: Thu Nov 9 17:54:28 2017 -0500 testsuite: Add test for #5889 Test Plan: make test TEST=5889 Reviewers: austin, bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie GHC Trac Issues: #5889 Differential Revision: https://phabricator.haskell.org/D4158 >--------------------------------------------------------------- e6b13c963d0b54099a41bb1b51fe680644582051 .../tests/profiling/should_compile/T5889/A.hs | 7 +++ .../tests/profiling/should_compile/T5889/B.hs | 65 ++++++++++++++++++++++ testsuite/tests/profiling/should_compile/all.T | 3 +- 3 files changed, 73 insertions(+), 2 deletions(-) diff --git a/testsuite/tests/profiling/should_compile/T5889/A.hs b/testsuite/tests/profiling/should_compile/T5889/A.hs new file mode 100644 index 0000000..98a2d70 --- /dev/null +++ b/testsuite/tests/profiling/should_compile/T5889/A.hs @@ -0,0 +1,7 @@ +import B + +-- See B.hs for an explanation on how this bug is triggered. + +-- This is a linker error, so we have to define a main and link +main :: IO () +main = putStrLn $ show $ bar 100 Nothing diff --git a/testsuite/tests/profiling/should_compile/T5889/B.hs b/testsuite/tests/profiling/should_compile/T5889/B.hs new file mode 100644 index 0000000..fb998cc --- /dev/null +++ b/testsuite/tests/profiling/should_compile/T5889/B.hs @@ -0,0 +1,65 @@ +{-# OPTIONS_GHC -fprof-auto #-} +module B where + +plus_noinline :: Integer -> Integer -> Integer +plus_noinline x y = x + y +{-# NOINLINE plus_noinline #-} + +-- | This is the key function. We do not want this to be inlined into bar, but +-- we DO want it to be inlined into main (in A.hs). Moreover, when it is inlined +-- into main, we don't want the values inside the tuple to be inlined. To +-- achieve this, in main we call bar with Nothing allowing split to be inlined +-- with the first case, where the values in tuple are calls to NOINLINE +-- functions. +split :: Integer -> Maybe Integer -> (Integer, Integer) +split n Nothing = (n `plus_noinline` 1, n `plus_noinline` 2) +split n (Just m) = + if n == 0 then (m, m) else split (n - 1) (Just m) + + +{- | The simplified core for bar is: + +[GblId, + Arity=2, + Str=, + Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False) + Tmpl= \ (n_a1Gq [Occ=OnceL] :: Integer) + (m_a1Gr [Occ=OnceL] :: Maybe Integer) -> + scc + let { + ds_s2rg :: (Integer, Integer) + [LclId] + ds_s2rg = scc split n_a1Gq m_a1Gr } in + plus_noinline + (scc + case ds_s2rg of { (y_a2ps [Occ=Once], _ [Occ=Dead]) + -> y_a2ps }) + (scc + case ds_s2rg of { (_ [Occ=Dead], z_a2pu [Occ=Once]) + -> z_a2pu })}] +bar + = \ (n_a1Gq :: Integer) (m_a1Gr :: Maybe Integer) -> + scc + case scc split n_a1Gq m_a1Gr of + { (ww1_s2s7, ww2_s2s8) -> + plus_noinline ww1_s2s7 ww2_s2s8 + } + +Note that there are sccs around the (x,y) pattern match in the unfolding, but +not in the simplified function. See #5889 for a discussion on why the sccs are +present in one but not the other, and whether this is correct. + +split is not inlined here, because it is a recursive function. + +In A.hs, bar is called with m = Nothing, allowing split to be inlined (as it is +not recursive in that case) and the sccs ARE present in the simplified core of +main (as they are around function calls, not ids). This triggers the linker +error. + +-} +bar :: Integer -> Maybe Integer -> Integer +bar n m = y `plus_noinline` z + where + (y, z) = split n m diff --git a/testsuite/tests/profiling/should_compile/all.T b/testsuite/tests/profiling/should_compile/all.T index 45d0b3a..068b43b 100644 --- a/testsuite/tests/profiling/should_compile/all.T +++ b/testsuite/tests/profiling/should_compile/all.T @@ -1,8 +1,7 @@ - # We need to run prof001 and prof002 the normal way, as the extra flags # added for the profiling ways makes it pass test('prof001', [only_ways(['normal']), req_profiling], compile_and_run, ['-prof -fprof-cafs']) test('prof002', [only_ways(['normal']), req_profiling], compile_and_run, ['-prof -fprof-cafs']) test('T2410', [only_ways(['normal']), req_profiling], compile, ['-O2 -prof -fprof-cafs']) - +test('T5889', [expect_broken(5889), only_ways(['normal']), req_profiling, extra_files(['T5889/A.hs', 'T5889/B.hs'])], multimod_compile, ['A B', '-O -prof -fno-prof-count-entries -v0']) From git at git.haskell.org Thu Nov 9 23:35:23 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 9 Nov 2017 23:35:23 +0000 (UTC) Subject: [commit: ghc] master: Remove unreliable Core Lint empty case checks (6b52b4c) Message-ID: <20171109233523.023C33A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6b52b4c832f888f7741a4ba0fec1fdac10244f6d/ghc >--------------------------------------------------------------- commit 6b52b4c832f888f7741a4ba0fec1fdac10244f6d Author: David Feuer Date: Thu Nov 9 17:54:11 2017 -0500 Remove unreliable Core Lint empty case checks Trac #13990 shows that the Core Lint checks for empty case are unreliable, and very hard to make reliable. The consensus (among simonpj, nomeata, and goldfire) seems to be that they should be removed altogether. Do that. Add test Reviewers: goldfire, bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie GHC Trac Issues: #13990 Differential Revision: https://phabricator.haskell.org/D4161 >--------------------------------------------------------------- 6b52b4c832f888f7741a4ba0fec1fdac10244f6d compiler/coreSyn/CoreLint.hs | 57 ++++++++++++++-------- testsuite/tests/simplCore/should_compile/T13990.hs | 14 ++++++ testsuite/tests/simplCore/should_compile/all.T | 1 + 3 files changed, 53 insertions(+), 19 deletions(-) diff --git a/compiler/coreSyn/CoreLint.hs b/compiler/coreSyn/CoreLint.hs index 4b6defd..7f52dbb 100644 --- a/compiler/coreSyn/CoreLint.hs +++ b/compiler/coreSyn/CoreLint.hs @@ -799,13 +799,9 @@ lintCoreExpr e@(Case scrut var alt_ty alts) = ; (alt_ty, _) <- lintInTy alt_ty ; (var_ty, _) <- lintInTy (idType var) - -- See Note [No alternatives lint check] - ; when (null alts) $ - do { checkL (not (exprIsHNF scrut)) - (text "No alternatives for a case scrutinee in head-normal form:" <+> ppr scrut) - ; checkWarnL scrut_diverges - (text "No alternatives for a case scrutinee not known to diverge for sure:" <+> ppr scrut) - } + -- We used to try to check whether a case expression with no + -- alternatives was legitimate, but this didn't work. + -- See Note [No alternatives lint check] for details. -- See Note [Rules for floating-point comparisons] in PrelRules ; let isLitPat (LitAlt _, _ , _) = True @@ -932,23 +928,46 @@ checkJoinOcc var n_args {- Note [No alternatives lint check] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Case expressions with no alternatives are odd beasts, and worth looking at -in the linter (cf Trac #10180). We check two things: +Case expressions with no alternatives are odd beasts, and it would seem +like they would worth be looking at in the linter (cf Trac #10180). We +used to check two things: -* exprIsHNF is false: certainly, it would be terribly wrong if the - scrutinee was already in head normal form. +* exprIsHNF is false: it would *seem* to be terribly wrong if + the scrutinee was already in head normal form. * exprIsBottom is true: we should be able to see why GHC believes the scrutinee is diverging for sure. -In principle, the first check is redundant: exprIsBottom == True will -always imply exprIsHNF == False. But the first check is reliable: If -exprIsHNF == True, then there definitely is a problem (exprIsHNF errs -on the right side). If the second check triggers then it may be the -case that the compiler got smarter elsewhere, and the empty case is -correct, but that exprIsBottom is unable to see it. In particular, the -empty-type check in exprIsBottom is an approximation. Therefore, this -check is not fully reliable, and we keep both around. +It was already known that the second test was not entirely reliable. +Unfortunately (Trac #13990), the first test turned out not to be reliable +either. Getting the checks right turns out to be somewhat complicated. + +For example, suppose we have (comment 8) + + data T a where + TInt :: T Int + + absurdTBool :: T Bool -> a + absurdTBool v = case v of + + data Foo = Foo !(T Bool) + + absurdFoo :: Foo -> a + absurdFoo (Foo x) = absurdTBool x + +GHC initially accepts the empty case because of the GADT conditions. But then +we inline absurdTBool, getting + + absurdFoo (Foo x) = case x of + +x is in normal form (because the Foo constructor is strict) but the +case is empty. To avoid this problem, GHC would have to recognize +that matching on Foo x is already absurd, which is not so easy. + +More generally, we don't really know all the ways that GHC can +lose track of why an expression is bottom, so we shouldn't make too +much fuss when that happens. + Note [Beta redexes] ~~~~~~~~~~~~~~~~~~~ diff --git a/testsuite/tests/simplCore/should_compile/T13990.hs b/testsuite/tests/simplCore/should_compile/T13990.hs new file mode 100644 index 0000000..cbf3949 --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T13990.hs @@ -0,0 +1,14 @@ +{-# LANGUAGE EmptyCase, GADTs #-} + +module T13990 where + +data T a where + TInt :: T Int + +absurd :: T Bool -> a +absurd v = case v of {} + +data Foo = Foo !(T Bool) + +absurdFoo :: Foo -> a +absurdFoo (Foo x) = absurd x diff --git a/testsuite/tests/simplCore/should_compile/all.T b/testsuite/tests/simplCore/should_compile/all.T index e411a6d..0b85692 100644 --- a/testsuite/tests/simplCore/should_compile/all.T +++ b/testsuite/tests/simplCore/should_compile/all.T @@ -284,3 +284,4 @@ test('T14272', normal, compile, ['']) test('T14270a', normal, compile, ['']) test('T14152', [ only_ways(['optasm']), check_errmsg(r'dead code') ], compile, ['-ddump-simpl']) test('T14152a', [ only_ways(['optasm']), check_errmsg(r'dead code') ], compile, ['-fno-exitification -ddump-simpl']) +test('T13990', normal, compile, ['-dcore-lint -O']) From git at git.haskell.org Thu Nov 9 23:35:25 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 9 Nov 2017 23:35:25 +0000 (UTC) Subject: [commit: ghc] master: Fix PPC NCG after blockID patch (f8e7fec) Message-ID: <20171109233525.C2FBD3A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f8e7fece58fa082b8b5a87fb84ffd5d18500d26a/ghc >--------------------------------------------------------------- commit f8e7fece58fa082b8b5a87fb84ffd5d18500d26a Author: Peter Trommler Date: Thu Nov 9 17:55:01 2017 -0500 Fix PPC NCG after blockID patch Commit rGHC8b007ab assigns the same label to the first basic block of a proc and to the proc entry point. This violates the PPC 64-bit ELF v. 1.9 and v. 2.0 ABIs and leads to duplicate symbols. This patch fixes duplicate symbols caused by block labels In commit rGHCd7b8da1 an info table label is generated from a block id. Getting the entry label from that info label leads to an undefined symbol because a suffix "_entry" that is not present in the block label. To fix that issue add a new info table label flavour for labels derived from block ids. Converting such a label with toEntryLabel produces the original block label. Fixes #14311 Test Plan: ./validate Reviewers: austin, bgamari, simonmar, erikd, hvr, angerman Reviewed By: bgamari Subscribers: rwbarton, thomie GHC Trac Issues: #14311 Differential Revision: https://phabricator.haskell.org/D4149 >--------------------------------------------------------------- f8e7fece58fa082b8b5a87fb84ffd5d18500d26a compiler/cmm/BlockId.hs | 3 ++- compiler/cmm/CLabel.hs | 30 +++++++++++++++++++++++++++++- compiler/nativeGen/PPC/CodeGen.hs | 14 ++++++++++++-- compiler/nativeGen/PPC/Instr.hs | 4 ---- compiler/nativeGen/PPC/Ppr.hs | 22 ++++++++++------------ 5 files changed, 53 insertions(+), 20 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 f8e7fece58fa082b8b5a87fb84ffd5d18500d26a From git at git.haskell.org Thu Nov 9 23:35:28 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 9 Nov 2017 23:35:28 +0000 (UTC) Subject: [commit: ghc] master's head updated: Fix PPC NCG after blockID patch (f8e7fec) Message-ID: <20171109233528.67C2A3A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'master' now includes: 7b0b9f6 Squashed 'hadrian/' content from commit 438dc57 5cee480 Merge commit '7b0b9f603bb1215e2b7af23c2404d637b95a4988' as 'hadrian' 9773053 Merge initial Hadrian snapshot ce9a677 base: Add test for #14425 c59d6da base: Normalize style of approxRational 5834da4 base: Fix #14425 0656cb4 Update comment in GHC.Real (trac#14432) 6b52b4c Remove unreliable Core Lint empty case checks e6b13c9 testsuite: Add test for #5889 75291ab Change `OPTIONS_GHC -O` to `OPTIONS_GHC -O2` f8e7fec Fix PPC NCG after blockID patch From git at git.haskell.org Sat Nov 11 08:34:54 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 11 Nov 2017 08:34:54 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: [reloc] ghc-pkg baseDir (d390e35) Message-ID: <20171111083454.B3DB93A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/d390e35ef7db64975358efc431997c14b843a3be/ghc >--------------------------------------------------------------- commit d390e35ef7db64975358efc431997c14b843a3be Author: Moritz Angermann Date: Sat Oct 28 09:19:18 2017 +0800 [reloc] ghc-pkg baseDir >--------------------------------------------------------------- d390e35ef7db64975358efc431997c14b843a3be utils/ghc-pkg/Main.hs | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/utils/ghc-pkg/Main.hs b/utils/ghc-pkg/Main.hs index 6420dd4..9917621f 100644 --- a/utils/ghc-pkg/Main.hs +++ b/utils/ghc-pkg/Main.hs @@ -2116,6 +2116,12 @@ getExecPath = try_size 2048 -- plenty, PATH_MAX is 512 under Win32. foreign import WINDOWS_CCONV unsafe "windows.h GetModuleFileNameW" c_GetModuleFileName :: Ptr () -> CWString -> Word32 -> IO Word32 +#elfi defined(darwin_HOST_OS) || defined(linux_HOST_OS) +-- TODO: a) this is copy-pasta from SysTools.hs / getBaseDir. Why can't we reuse this here? +-- and parameterise getBaseDir over the executable (for windows)? +-- b) why is the windows getBaseDir logic, not part of getExecutablePath? +-- it would be much wider available then and we could drop all the custom logic? +getBaseDir = Just . (\p -> p "lib") . takeDirectory . takeDirectory <$> getExecutablePath #else getLibDir :: IO (Maybe String) getLibDir = return Nothing From git at git.haskell.org Sat Nov 11 08:34:51 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 11 Nov 2017 08:34:51 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: Relocatable GHC (0c31b32) Message-ID: <20171111083451.53FCB3A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/0c31b32607ca8829793b355420759284d2d64d2e/ghc >--------------------------------------------------------------- commit 0c31b32607ca8829793b355420759284d2d64d2e Author: Moritz Angermann Date: Fri Nov 10 10:00:09 2017 +0800 Relocatable GHC GHC and the binary distribution that's produced is not relocatable outside of Windows. This diff tries to address this for at least Linux and macOS. Reviewers: austin, hvr, bgamari, erikd Subscribers: rwbarton, thomie, erikd Differential Revision: https://phabricator.haskell.org/D4121 >--------------------------------------------------------------- 0c31b32607ca8829793b355420759284d2d64d2e compiler/main/SysTools.hs | 21 +++++++++++++++++++++ 1 file changed, 21 insertions(+) diff --git a/compiler/main/SysTools.hs b/compiler/main/SysTools.hs index 21ed03b..625552b 100644 --- a/compiler/main/SysTools.hs +++ b/compiler/main/SysTools.hs @@ -48,6 +48,7 @@ import Platform import Util import DynFlags +import System.Environment (getExecutablePath) import System.FilePath import System.IO import System.Directory @@ -530,6 +531,26 @@ type GetFinalPath = HANDLE -> LPTSTR -> DWORD -> DWORD -> IO DWORD foreign import WINDOWS_CCONV unsafe "dynamic" makeGetFinalPathNameByHandle :: FunPtr GetFinalPath -> GetFinalPath +#elif defined(darwin_HOST_OS) || defined(linux_HOST_OS) +-- on unix, this is a bit more confusing. +-- The layout right now is somehting like +-- +-- /bin/ghc-X.Y.Z <- wrapper script (1) +-- /bin/ghc <- symlink to wrapper script (2) +-- /lib/ghc-X.Y.Z/bin/ghc <- ghc executable (3) +-- /lib/ghc-X.Y.Z <- $topdir (4) +-- +-- As such, we fist need to find the absolute location to the +-- binary. +-- +-- getExecutablePath will return (3). One takeDirectory will +-- give use /lib/ghc-X.Y.Z/bin, and another will give us (4). +-- +-- This of course only works due to the current layout. If +-- the layout is changed, such that we have ghc-X.Y.Z/{bin,lib} +-- this would need to be changed accordingly. +-- +getBaseDir = Just . (\p -> p "lib") . takeDirectory . takeDirectory <$> getExecutablePath #else getBaseDir = return Nothing #endif From git at git.haskell.org Sat Nov 11 08:34:57 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 11 Nov 2017 08:34:57 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: Adds -ghc-version flag to ghc. (b3321a3) Message-ID: <20171111083457.8F50A3A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/b3321a31d7c986f21bbe9fbc86ee26a290919f63/ghc >--------------------------------------------------------------- commit b3321a31d7c986f21bbe9fbc86ee26a290919f63 Author: Moritz Angermann Date: Sun Oct 29 14:24:50 2017 +0800 Adds -ghc-version flag to ghc. Summary: When building the rts with ghc (e.g. using ghc as a c compiler), ghc's Added Value includes adding `-include /path/to/ghcversion.h`. For this it looksup the rts package in the package database, which--if empty--fails. Thus to allow compiling C files with GHC, we add the `-ghc-version` flag, which takes the path to the `ghcversion.h` file. A `-no-ghc-version` flag was omitted, as at that point it becomes questionable why one would use ghc to compile c if one doesn't any of the added value. Reviewers: bgamari, geekosaur, austin Subscribers: rwbarton, thomie Differential Revision: https://phabricator.haskell.org/D4135 >--------------------------------------------------------------- b3321a31d7c986f21bbe9fbc86ee26a290919f63 compiler/main/DriverPipeline.hs | 11 ++++++++--- compiler/main/DynFlags.hs | 6 ++++++ 2 files changed, 14 insertions(+), 3 deletions(-) diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs index fab7fad..4f7bfbd 100644 --- a/compiler/main/DriverPipeline.hs +++ b/compiler/main/DriverPipeline.hs @@ -2204,11 +2204,16 @@ touchObjectFile dflags path = do -- | Find out path to @ghcversion.h@ file getGhcVersionPathName :: DynFlags -> IO FilePath getGhcVersionPathName dflags = do - dirs <- getPackageIncludePath dflags [toInstalledUnitId rtsUnitId] + candidates <- case ghcVersion dflags of + Just path -> return [path] + Nothing -> (map ( "ghcversion.h")) <$> + (getPackageIncludePath dflags [toInstalledUnitId rtsUnitId]) - found <- filterM doesFileExist (map ( "ghcversion.h") dirs) + found <- filterM doesFileExist candidates case found of - [] -> throwGhcExceptionIO (InstallationError ("ghcversion.h missing")) + [] -> throwGhcExceptionIO (InstallationError + ("ghcversion.h missing; tried: " + ++ intercalate ", " candidates)) (x:_) -> return x -- Note [-fPIC for assembler] diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 0e6310e..bd7b768 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -531,6 +531,7 @@ data GeneralFlag | Opt_ExternalInterpreter | Opt_OptimalApplicativeDo | Opt_VersionMacros + | Opt_GhcVersion | Opt_WholeArchiveHsLibs -- PreInlining is on by default. The option is there just to see how @@ -914,6 +915,7 @@ data DynFlags = DynFlags { flushOut :: FlushOut, flushErr :: FlushErr, + ghcVersion :: Maybe FilePath, haddockOptions :: Maybe String, -- | GHCi scripts specified by -ghci-script, in reverse order @@ -1678,6 +1680,7 @@ defaultDynFlags mySettings myLlvmTargets = filesToClean = panic "defaultDynFlags: No filesToClean", dirsToClean = panic "defaultDynFlags: No dirsToClean", generatedDumps = panic "defaultDynFlags: No generatedDumps", + ghcVersion = Nothing, haddockOptions = Nothing, dumpFlags = EnumSet.empty, generalFlags = EnumSet.fromList (defaultFlags mySettings), @@ -2334,6 +2337,8 @@ addDepSuffix s d = d { depSuffixes = s : depSuffixes d } addCmdlineFramework f d = d { cmdlineFrameworks = f : cmdlineFrameworks d} +addGhcVersion f d = d { ghcVersion = Just f } + addHaddockOpts f d = d { haddockOptions = Just f} addGhciScript f d = d { ghciScripts = f : ghciScripts d} @@ -2861,6 +2866,7 @@ dynamic_flags_deps = [ , make_ord_flag defGhcFlag "no-rtsopts-suggestions" (noArg (\d -> d {rtsOptsSuggestions = False})) + , make_ord_flag defGhcFlag "ghc-version" (hasArg addGhcVersion) , make_ord_flag defGhcFlag "main-is" (SepArg setMainIs) , make_ord_flag defGhcFlag "haddock" (NoArg (setGeneralFlag Opt_Haddock)) , make_ord_flag defGhcFlag "haddock-opts" (hasArg addHaddockOpts) From git at git.haskell.org Sat Nov 11 08:35:00 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 11 Nov 2017 08:35:00 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: Add DynFlags signature. (edfbeb0) Message-ID: <20171111083500.65E733A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/edfbeb0bb23eb6d36c466bd5c6420c600fb75a36/ghc >--------------------------------------------------------------- commit edfbeb0bb23eb6d36c466bd5c6420c600fb75a36 Author: Moritz Angermann Date: Thu Nov 9 14:30:47 2017 +0800 Add DynFlags signature. >--------------------------------------------------------------- edfbeb0bb23eb6d36c466bd5c6420c600fb75a36 compiler/main/DynFlags.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index bd7b768..eb25ead 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -2337,6 +2337,7 @@ addDepSuffix s d = d { depSuffixes = s : depSuffixes d } addCmdlineFramework f d = d { cmdlineFrameworks = f : cmdlineFrameworks d} +addGhcVersion :: FilePath -> DynFlags -> DynFlags addGhcVersion f d = d { ghcVersion = Just f } addHaddockOpts f d = d { haddockOptions = Just f} From git at git.haskell.org Sat Nov 11 08:35:09 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 11 Nov 2017 08:35:09 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: Adds cmm-sources to base (22023fe) Message-ID: <20171111083509.6D5ED3A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/22023fe1e95f29fe23f9624bd95f899e18d3499e/ghc >--------------------------------------------------------------- commit 22023fe1e95f29fe23f9624bd95f899e18d3499e Author: Moritz Angermann Date: Thu Nov 9 14:30:56 2017 +0800 Adds cmm-sources to base Summary: With the introduction of `asm-srouces` and `cmm-sources` in haskell/cabal/pull/4857. Which was merged into `haskell/cabal` HEAD in`357d49d`. We can now declare the `cmm-files` properly, and as such they can be read out by the cabal library. Reviewers: bgamari, hvr Subscribers: rwbarton, thomie Differential Revision: https://phabricator.haskell.org/D4176 >--------------------------------------------------------------- 22023fe1e95f29fe23f9624bd95f899e18d3499e libraries/base/base.cabal | 3 +++ 1 file changed, 3 insertions(+) diff --git a/libraries/base/base.cabal b/libraries/base/base.cabal index 43c7882..e6f6420 100644 --- a/libraries/base/base.cabal +++ b/libraries/base/base.cabal @@ -338,6 +338,9 @@ Library cbits/primFloat.c cbits/sysconf.c + cmm-sources: + cbits/CastFloatWord.cmm + include-dirs: include includes: HsBase.h From git at git.haskell.org Sat Nov 11 08:35:06 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 11 Nov 2017 08:35:06 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: Use LICENSE instead of ../LICENSE in the compiler.cabal file (043bfaf) Message-ID: <20171111083506.AE5A83A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/043bfafb2b6919238e0ef1fa00e902a2f65b06bc/ghc >--------------------------------------------------------------- commit 043bfafb2b6919238e0ef1fa00e902a2f65b06bc Author: Moritz Angermann Date: Tue Nov 7 11:59:55 2017 +0800 Use LICENSE instead of ../LICENSE in the compiler.cabal file Summary: The `compiler` directory contains a `LICENSE` file, which is identical to the one in `../LICENSE`. As such we can just use the LICENSE file that accompanies the `compiler` instead of tyring to fish it out from somewhere higher up in the source tree. This also makes the compiler package more self contained. Reviewers: bgamari Subscribers: rwbarton, thomie Differential Revision: https://phabricator.haskell.org/D4175 >--------------------------------------------------------------- 043bfafb2b6919238e0ef1fa00e902a2f65b06bc compiler/ghc.cabal.in | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in index dce96f4..3b99db1 100644 --- a/compiler/ghc.cabal.in +++ b/compiler/ghc.cabal.in @@ -4,7 +4,7 @@ Name: ghc Version: @ProjectVersionMunged@ License: BSD3 -License-File: ../LICENSE +License-File: LICENSE Author: The GHC Team Maintainer: glasgow-haskell-users at haskell.org Homepage: http://www.haskell.org/ghc/ From git at git.haskell.org Sat Nov 11 08:35:20 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 11 Nov 2017 08:35:20 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: Adds test (f50cdab) Message-ID: <20171111083520.4A5153A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/f50cdab59a68b74beda81b0d279c53e8231c3eaf/ghc >--------------------------------------------------------------- commit f50cdab59a68b74beda81b0d279c53e8231c3eaf Author: Moritz Angermann Date: Thu Sep 21 22:07:44 2017 +0800 Adds test >--------------------------------------------------------------- f50cdab59a68b74beda81b0d279c53e8231c3eaf testsuite/tests/codeGen/should_run/T14251.hs | 22 ++++++++++++++++++++++ testsuite/tests/codeGen/should_run/T14251.stdout | 1 + testsuite/tests/codeGen/should_run/all.T | 1 + 3 files changed, 24 insertions(+) diff --git a/testsuite/tests/codeGen/should_run/T14251.hs b/testsuite/tests/codeGen/should_run/T14251.hs new file mode 100644 index 0000000..6f552e1 --- /dev/null +++ b/testsuite/tests/codeGen/should_run/T14251.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE MagicHash, BangPatterns #-} +module Main where + +-- A minor modification from T8064.hs. +-- +-- The key here is that we ensure that +-- subsequently passed floats do not +-- accidentally end up in previous +-- registers. +-- + +import GHC.Exts + +{-# NOINLINE f #-} +f :: (Int# -> Float# -> Double# -> Float# -> Double# -> String) -> String +f g = g 3# 4.0# 5.0## 6.0# 6.9## ++ " World!" + +{-# NOINLINE q #-} +q :: Int# -> Float# -> Double# -> Float# -> Double# -> String +q i j k l m = "Hello " ++ show (F# l) ++ " " ++ show (D# m) + +main = putStrLn (f $ q) diff --git a/testsuite/tests/codeGen/should_run/T14251.stdout b/testsuite/tests/codeGen/should_run/T14251.stdout new file mode 100644 index 0000000..8ec577b --- /dev/null +++ b/testsuite/tests/codeGen/should_run/T14251.stdout @@ -0,0 +1 @@ +Hello 6.0 6.9 World! diff --git a/testsuite/tests/codeGen/should_run/all.T b/testsuite/tests/codeGen/should_run/all.T index 214a9d5..8f33044 100644 --- a/testsuite/tests/codeGen/should_run/all.T +++ b/testsuite/tests/codeGen/should_run/all.T @@ -163,3 +163,4 @@ test('T13825-unit', extra_run_opts('"' + config.libdir + '"'), compile_and_run, ['-package ghc']) +test('T14251', normal, compile_and_run, ['-O2']) From git at git.haskell.org Sat Nov 11 08:35:14 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 11 Nov 2017 08:35:14 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: Adds `-llvmng` (b3ad08e) Message-ID: <20171111083514.3E2EE3A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/b3ad08ed27d069dcc470619fd1a8f54f60cddbb5/ghc >--------------------------------------------------------------- commit b3ad08ed27d069dcc470619fd1a8f54f60cddbb5 Author: Moritz Angermann Date: Mon Jul 31 15:18:49 2017 +0800 Adds `-llvmng` >--------------------------------------------------------------- b3ad08ed27d069dcc470619fd1a8f54f60cddbb5 .gitmodules | 9 + compiler/cmm/CmmSwitch.hs | 1 + compiler/codeGen/StgCmmPrim.hs | 3 +- compiler/ghc.cabal.in | 8 +- compiler/llvmGen-ng/Data/BitCode/LLVM/Gen.hs | 1783 ++++++++++++++++++++ compiler/llvmGen-ng/Data/BitCode/LLVM/Gen/Monad.hs | 86 + compiler/main/CodeOutput.hs | 10 + compiler/main/DriverPipeline.hs | 5 +- compiler/main/DynFlags.hs | 12 +- compiler/typecheck/TcForeign.hs | 4 +- ghc.mk | 8 + libraries/base/tests/all.T | 2 +- libraries/data-bitcode | 1 + libraries/data-bitcode-edsl | 1 + libraries/data-bitcode-llvm | 1 + mk/build.mk.sample | 13 +- mk/flavours/{prof.mk => prof-llvmng.mk} | 6 +- mk/flavours/{quick-cross.mk => quick-cross-ng.mk} | 4 +- mk/flavours/{quick.mk => quick-llvmng.mk} | 4 +- packages | 3 + testsuite/config/ghc | 16 +- 21 files changed, 1961 insertions(+), 19 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc b3ad08ed27d069dcc470619fd1a8f54f60cddbb5 From git at git.haskell.org Sat Nov 11 08:35:16 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 11 Nov 2017 08:35:16 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: bump submodule. (8af0c1b) Message-ID: <20171111083516.F3C5E3A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/8af0c1bdaf907b15e6d2ecb48fea7cf86eaa5af8/ghc >--------------------------------------------------------------- commit 8af0c1bdaf907b15e6d2ecb48fea7cf86eaa5af8 Author: Moritz Angermann Date: Wed Oct 4 09:48:01 2017 +0800 bump submodule. >--------------------------------------------------------------- 8af0c1bdaf907b15e6d2ecb48fea7cf86eaa5af8 libraries/data-bitcode | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/data-bitcode b/libraries/data-bitcode index c9818de..2039075 160000 --- a/libraries/data-bitcode +++ b/libraries/data-bitcode @@ -1 +1 @@ -Subproject commit c9818debd3dae774967c0507882b6b3bec7f0ee4 +Subproject commit 2039075a4fcb1b0767c1df868b2deda96d6022c4 From git at git.haskell.org Sat Nov 11 08:35:03 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 11 Nov 2017 08:35:03 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: Adds rts/rts.cabal.in file (6ad8d6c) Message-ID: <20171111083503.DE4993A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/6ad8d6c110a5b6f3effc55f2db0cc24a1efa049a/ghc >--------------------------------------------------------------- commit 6ad8d6c110a5b6f3effc55f2db0cc24a1efa049a Author: Moritz Angermann Date: Mon Oct 30 23:15:09 2017 +0800 Adds rts/rts.cabal.in file Summary: This is in prerpation for cabalification of the `rts`. To be actually able to parse this file, a rather recent Cabal is required. One after commit `357d49d` of haskell/cabal. The relevant PR to support the new `asm-srouces` and `cmm-sources` is haskell/cabal/pull/4857. Not that this does *not* allow cabal to build the RTS. It does however provide enough information such that cabal can `copy` and `register` the package properly in the package database, if all the build artifacts have been build properly. As such it does not require any custom handling of the `rts` package. As the rts as well as all the other packages built by the GHC built system are built outside of cabal anyway. Reviewers: bgamari, hvr, erikd, simonmar Subscribers: rwbarton, thomie, erikd Differential Revision: https://phabricator.haskell.org/D4174 >--------------------------------------------------------------- 6ad8d6c110a5b6f3effc55f2db0cc24a1efa049a aclocal.m4 | 9 +- configure.ac | 29 ++++-- rts/rts.cabal.in | 272 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 302 insertions(+), 8 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 6ad8d6c110a5b6f3effc55f2db0cc24a1efa049a From git at git.haskell.org Sat Nov 11 08:35:23 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 11 Nov 2017 08:35:23 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: Use cmmSources (5b22f81) Message-ID: <20171111083523.0FDB83A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/5b22f8183e65cc61357ee93bf9fdfe47a569a8b1/ghc >--------------------------------------------------------------- commit 5b22f8183e65cc61357ee93bf9fdfe47a569a8b1 Author: Moritz Angermann Date: Fri Nov 10 10:43:28 2017 +0800 Use cmmSources >--------------------------------------------------------------- 5b22f8183e65cc61357ee93bf9fdfe47a569a8b1 libraries/Cabal | 2 +- utils/ghc-cabal/Main.hs | 3 ++- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/libraries/Cabal b/libraries/Cabal index 46c79e1..357d49d 160000 --- a/libraries/Cabal +++ b/libraries/Cabal @@ -1 +1 @@ -Subproject commit 46c79e1d8d0ed76b20e8494b697f3057b64aafd5 +Subproject commit 357d49d826004c022f3b4871f16d753e1b932b54 diff --git a/utils/ghc-cabal/Main.hs b/utils/ghc-cabal/Main.hs index 2ba912a..9d0ffcf 100644 --- a/utils/ghc-cabal/Main.hs +++ b/utils/ghc-cabal/Main.hs @@ -406,8 +406,9 @@ generate directory distdir config_args variablePrefix ++ "_INSTALL_INCLUDES = " ++ unwords (installIncludes bi), variablePrefix ++ "_EXTRA_LIBRARIES = " ++ unwords (extraLibs bi), variablePrefix ++ "_EXTRA_LIBDIRS = " ++ unwords (extraLibDirs bi), + variablePrefix ++ "_S_SRCS = " ++ unwords (asmSources bi), variablePrefix ++ "_C_SRCS = " ++ unwords (cSources bi), - variablePrefix ++ "_CMM_SRCS := $(addprefix cbits/,$(notdir $(wildcard " ++ directory ++ "/cbits/*.cmm)))", + variablePrefix ++ "_CMM_SRCS = " ++ unwords (cmmSources bi), variablePrefix ++ "_DATA_FILES = " ++ unwords (dataFiles pd), -- XXX This includes things it shouldn't, like: -- -odir dist-bootstrapping/build From git at git.haskell.org Sat Nov 11 08:35:35 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 11 Nov 2017 08:35:35 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: Merge branches 'feature/D4121-reloc-paths', 'feature/D4135-ghc-version', 'feature/D4174-rts-cabal', 'feature/D4175-compiler-LICENSE' and 'feature/D4176-base-cmm-files' into wip/angerman/llvmng (2d67ef3) Message-ID: <20171111083535.545B93A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/2d67ef358dd83adda497e439a76a75701fabd625/ghc >--------------------------------------------------------------- commit 2d67ef358dd83adda497e439a76a75701fabd625 Merge: 8af0c1b d390e35 edfbeb0 6ad8d6c 043bfaf 5b22f81 Author: Moritz Angermann Date: Fri Nov 10 10:52:31 2017 +0800 Merge branches 'feature/D4121-reloc-paths', 'feature/D4135-ghc-version', 'feature/D4174-rts-cabal', 'feature/D4175-compiler-LICENSE' and 'feature/D4176-base-cmm-files' into wip/angerman/llvmng >--------------------------------------------------------------- 2d67ef358dd83adda497e439a76a75701fabd625 aclocal.m4 | 9 +- compiler/ghc.cabal.in | 2 +- compiler/main/DriverPipeline.hs | 11 +- compiler/main/DynFlags.hs | 7 ++ compiler/main/SysTools.hs | 21 ++++ configure.ac | 29 ++++- libraries/Cabal | 2 +- libraries/base/base.cabal | 3 + rts/rts.cabal.in | 272 ++++++++++++++++++++++++++++++++++++++++ utils/ghc-cabal/Main.hs | 3 +- utils/ghc-pkg/Main.hs | 6 + 11 files changed, 351 insertions(+), 14 deletions(-) From git at git.haskell.org Sat Nov 11 08:35:38 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 11 Nov 2017 08:35:38 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: bump Cabal (07edb3a) Message-ID: <20171111083538.152393A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/07edb3af7fdb132651970928cd89472103fa09ba/ghc >--------------------------------------------------------------- commit 07edb3af7fdb132651970928cd89472103fa09ba Author: Moritz Angermann Date: Fri Nov 10 10:53:25 2017 +0800 bump Cabal >--------------------------------------------------------------- 07edb3af7fdb132651970928cd89472103fa09ba libraries/Cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/Cabal b/libraries/Cabal index 357d49d..369b98d 160000 --- a/libraries/Cabal +++ b/libraries/Cabal @@ -1 +1 @@ -Subproject commit 357d49d826004c022f3b4871f16d753e1b932b54 +Subproject commit 369b98d4374e8fcdc4aee028ba759de220ced008 From git at git.haskell.org Sat Nov 11 08:35:40 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 11 Nov 2017 08:35:40 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: bump submodules. (d5b618b) Message-ID: <20171111083540.DBFA43A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/d5b618b20500cfa244d66caa29fd7d527e8fecc8/ghc >--------------------------------------------------------------- commit d5b618b20500cfa244d66caa29fd7d527e8fecc8 Author: Moritz Angermann Date: Fri Nov 10 14:48:07 2017 +0800 bump submodules. >--------------------------------------------------------------- d5b618b20500cfa244d66caa29fd7d527e8fecc8 libraries/data-bitcode | 2 +- libraries/data-bitcode-edsl | 2 +- libraries/data-bitcode-llvm | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/libraries/data-bitcode b/libraries/data-bitcode index 2039075..b4cdbc1 160000 --- a/libraries/data-bitcode +++ b/libraries/data-bitcode @@ -1 +1 @@ -Subproject commit 2039075a4fcb1b0767c1df868b2deda96d6022c4 +Subproject commit b4cdbc17e77771c1c3c833625b92776aa5bc854b diff --git a/libraries/data-bitcode-edsl b/libraries/data-bitcode-edsl index bc2e3e0..ec6f7fc 160000 --- a/libraries/data-bitcode-edsl +++ b/libraries/data-bitcode-edsl @@ -1 +1 @@ -Subproject commit bc2e3e0a8bfc438ae3ee6ebe5feaa37920e78e43 +Subproject commit ec6f7fc639561b5d02cd07b8b1285d5b4b7d9590 diff --git a/libraries/data-bitcode-llvm b/libraries/data-bitcode-llvm index d03a9b5..b717895 160000 --- a/libraries/data-bitcode-llvm +++ b/libraries/data-bitcode-llvm @@ -1 +1 @@ -Subproject commit d03a9b5c90787910242e8a295f6201d71c6d3a9a +Subproject commit b717895d5e1add7f908fe09b528c7524511ec6f5 From git at git.haskell.org Sat Nov 11 08:35:43 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 11 Nov 2017 08:35:43 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: bump cabal (999a97c) Message-ID: <20171111083543.ADDFF3A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/999a97c5f8a6e0a49fadde935dbd9b31f9a4f211/ghc >--------------------------------------------------------------- commit 999a97c5f8a6e0a49fadde935dbd9b31f9a4f211 Author: Moritz Angermann Date: Fri Nov 10 21:34:52 2017 +0800 bump cabal >--------------------------------------------------------------- 999a97c5f8a6e0a49fadde935dbd9b31f9a4f211 libraries/Cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/Cabal b/libraries/Cabal index 369b98d..d1a099e 160000 --- a/libraries/Cabal +++ b/libraries/Cabal @@ -1 +1 @@ -Subproject commit 369b98d4374e8fcdc4aee028ba759de220ced008 +Subproject commit d1a099e00ea9606164f51b3301f8ce41f898a278 From git at git.haskell.org Sat Nov 11 08:35:46 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 11 Nov 2017 08:35:46 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: GHC.prim use virtual-modules (29704a6) Message-ID: <20171111083546.7BF4D3A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/29704a66137d43e0af74c31e4c148b4ba2b1cc79/ghc >--------------------------------------------------------------- commit 29704a66137d43e0af74c31e4c148b4ba2b1cc79 Author: Moritz Angermann Date: Fri Nov 10 21:37:18 2017 +0800 GHC.prim use virtual-modules >--------------------------------------------------------------- 29704a66137d43e0af74c31e4c148b4ba2b1cc79 ghc.mk | 2 +- libraries/ghc-prim/ghc-prim.cabal | 10 +++------- 2 files changed, 4 insertions(+), 8 deletions(-) diff --git a/ghc.mk b/ghc.mk index bce738f..d273614 100644 --- a/ghc.mk +++ b/ghc.mk @@ -612,7 +612,7 @@ libraries/ghci_dist-install_CONFIGURE_OPTS += --flags=ghci # remains compatible with the old build system for the time being). # GHC.Prim module in the ghc-prim package with a flag: # -libraries/ghc-prim_CONFIGURE_OPTS += --flag=include-ghc-prim +# libraries/ghc-prim_CONFIGURE_OPTS += --flag=include-ghc-prim # And then we strip it out again before building the package: define libraries/ghc-prim_PACKAGE_MAGIC diff --git a/libraries/ghc-prim/ghc-prim.cabal b/libraries/ghc-prim/ghc-prim.cabal index 5b6b857..7d611bf 100644 --- a/libraries/ghc-prim/ghc-prim.cabal +++ b/libraries/ghc-prim/ghc-prim.cabal @@ -19,10 +19,6 @@ source-repository head location: http://git.haskell.org/ghc.git subdir: libraries/ghc-prim -flag include-ghc-prim - Description: Include GHC.Prim in exposed-modules - default: False - custom-setup setup-depends: base >= 4 && < 5, Cabal >= 1.23 @@ -53,6 +49,9 @@ Library GHC.Tuple GHC.Types + virtual-modules: + GHC.Prim + -- OS Specific if os(windows) -- Windows requires some extra libraries for linking because the RTS @@ -67,9 +66,6 @@ Library -- on Windows. Required because of mingw32. extra-libraries: user32, mingw32, mingwex - if flag(include-ghc-prim) - exposed-modules: GHC.Prim - c-sources: cbits/atomic.c cbits/bswap.c From git at git.haskell.org Sat Nov 11 08:35:49 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 11 Nov 2017 08:35:49 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: cleanup (8090e90) Message-ID: <20171111083549.5203F3A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/8090e909234353f97fdbf315e2abc95b6cae758e/ghc >--------------------------------------------------------------- commit 8090e909234353f97fdbf315e2abc95b6cae758e Author: Moritz Angermann Date: Sat Nov 11 14:06:22 2017 +0800 cleanup >--------------------------------------------------------------- 8090e909234353f97fdbf315e2abc95b6cae758e compiler/llvmGen-ng/Data/BitCode/LLVM/Gen.hs | 2 +- compiler/llvmGen-ng/Data/BitCode/LLVM/Gen/Monad.hs | 3 --- 2 files changed, 1 insertion(+), 4 deletions(-) diff --git a/compiler/llvmGen-ng/Data/BitCode/LLVM/Gen.hs b/compiler/llvmGen-ng/Data/BitCode/LLVM/Gen.hs index 2cf5eec..ec5eb3f 100644 --- a/compiler/llvmGen-ng/Data/BitCode/LLVM/Gen.hs +++ b/compiler/llvmGen-ng/Data/BitCode/LLVM/Gen.hs @@ -1,4 +1,4 @@ -{-# OPTIONS_GHC -fprof-auto #-} +{-# OPTIONS_GHC -fprof-auto -Wno-type-defaults -Wno-unused-matches -Wno-unused-local-binds -Wno-overlapping-patterns -Wno-incomplete-patterns -Wno-unused-do-bind -Wno-missing-signatures #-} {-# LANGUAGE CPP, GADTs, GeneralizedNewtypeDeriving, RecursiveDo, LambdaCase, FlexibleInstances, FlexibleContexts, StandaloneDeriving, BangPatterns, TupleSections #-} module Data.BitCode.LLVM.Gen where diff --git a/compiler/llvmGen-ng/Data/BitCode/LLVM/Gen/Monad.hs b/compiler/llvmGen-ng/Data/BitCode/LLVM/Gen/Monad.hs index 880eda4..e82b049 100644 --- a/compiler/llvmGen-ng/Data/BitCode/LLVM/Gen/Monad.hs +++ b/compiler/llvmGen-ng/Data/BitCode/LLVM/Gen/Monad.hs @@ -5,16 +5,13 @@ import GhcPrelude import DynFlags import qualified Stream -import Control.Monad (ap) import Outputable as Outp -import EDSL.Monad import ErrUtils import Control.Monad.IO.Class import Control.Monad.Trans.State -import Data.Functor.Identity import Control.Monad.Trans.Class import Control.Monad.Fix (MonadFix(..)) From git at git.haskell.org Sat Nov 11 08:35:52 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 11 Nov 2017 08:35:52 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: Sharing is caring. (828163e) Message-ID: <20171111083552.9CF333A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/828163ed32de4a589a12b06befe8be55960425ef/ghc >--------------------------------------------------------------- commit 828163ed32de4a589a12b06befe8be55960425ef Author: Moritz Angermann Date: Sat Nov 11 15:16:28 2017 +0800 Sharing is caring. >--------------------------------------------------------------- 828163ed32de4a589a12b06befe8be55960425ef compiler/main/SysTools.hs | 124 +++-------------------------------- libraries/ghc-boot/GHC/BasePath.hs | 122 ++++++++++++++++++++++++++++++++++ libraries/ghc-boot/ghc-boot.cabal.in | 1 + utils/ghc-pkg/Main.hs | 58 +--------------- 4 files changed, 136 insertions(+), 169 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 828163ed32de4a589a12b06befe8be55960425ef From git at git.haskell.org Sat Nov 11 08:35:57 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 11 Nov 2017 08:35:57 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: Merge branch 'feature/D4121-reloc-paths' into wip/angerman/llvmng (3af810d) Message-ID: <20171111083557.C6C2B3A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/3af810de442d5216e74dc7385c2b2596944d7de1/ghc >--------------------------------------------------------------- commit 3af810de442d5216e74dc7385c2b2596944d7de1 Merge: 8090e90 828163e Author: Moritz Angermann Date: Sat Nov 11 15:17:02 2017 +0800 Merge branch 'feature/D4121-reloc-paths' into wip/angerman/llvmng >--------------------------------------------------------------- 3af810de442d5216e74dc7385c2b2596944d7de1 compiler/main/SysTools.hs | 124 +++-------------------------------- libraries/ghc-boot/GHC/BasePath.hs | 122 ++++++++++++++++++++++++++++++++++ libraries/ghc-boot/ghc-boot.cabal.in | 1 + utils/ghc-pkg/Main.hs | 58 +--------------- 4 files changed, 136 insertions(+), 169 deletions(-) From git at git.haskell.org Sat Nov 11 08:36:00 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 11 Nov 2017 08:36:00 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: bump cabal. (2a25a4f) Message-ID: <20171111083600.8BA2F3A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/2a25a4f3af619a0c6dad127b34b01b991a613049/ghc >--------------------------------------------------------------- commit 2a25a4f3af619a0c6dad127b34b01b991a613049 Author: Moritz Angermann Date: Sat Nov 11 15:17:45 2017 +0800 bump cabal. >--------------------------------------------------------------- 2a25a4f3af619a0c6dad127b34b01b991a613049 libraries/Cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/Cabal b/libraries/Cabal index d1a099e..980e253 160000 --- a/libraries/Cabal +++ b/libraries/Cabal @@ -1 +1 @@ -Subproject commit d1a099e00ea9606164f51b3301f8ce41f898a278 +Subproject commit 980e253e8a1024455061cd1f333e9e288543e3f3 From git at git.haskell.org Sat Nov 11 08:36:08 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 11 Nov 2017 08:36:08 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: Merge branch 'feature/D4121-reloc-paths' into wip/angerman/llvmng (d7b848e) Message-ID: <20171111083608.442443A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/d7b848e9e50f1dda2e1493890f1addd299a153f5/ghc >--------------------------------------------------------------- commit d7b848e9e50f1dda2e1493890f1addd299a153f5 Merge: 2a25a4f ae6f4c7 Author: Moritz Angermann Date: Sat Nov 11 15:25:35 2017 +0800 Merge branch 'feature/D4121-reloc-paths' into wip/angerman/llvmng >--------------------------------------------------------------- d7b848e9e50f1dda2e1493890f1addd299a153f5 compiler/main/SysTools.hs | 1 - libraries/ghc-boot/GHC/BasePath.hs | 5 +++++ 2 files changed, 5 insertions(+), 1 deletion(-) From git at git.haskell.org Sat Nov 11 08:36:18 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 11 Nov 2017 08:36:18 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: Merge commit 'ff99230258faf4eb4a75ae5dd708f86256b5f213' as 'hadrian' (f19a8c9) Message-ID: <20171111083618.224263A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/f19a8c9aa9969df3097c62bc3a7420a55842d8b8/ghc >--------------------------------------------------------------- commit f19a8c9aa9969df3097c62bc3a7420a55842d8b8 Merge: f4a11c6 ff99230 Author: Moritz Angermann Date: Sat Nov 11 16:34:24 2017 +0800 Merge commit 'ff99230258faf4eb4a75ae5dd708f86256b5f213' as 'hadrian' >--------------------------------------------------------------- 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 f19a8c9aa9969df3097c62bc3a7420a55842d8b8 From git at git.haskell.org Sat Nov 11 08:36:11 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 11 Nov 2017 08:36:11 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: drop hadrian (f4a11c6) Message-ID: <20171111083611.1C2593A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/f4a11c60dac2641b75fb8362caa9c97c5e146ade/ghc >--------------------------------------------------------------- commit f4a11c60dac2641b75fb8362caa9c97c5e146ade Author: Moritz Angermann Date: Sat Nov 11 15:42:31 2017 +0800 drop hadrian >--------------------------------------------------------------- f4a11c60dac2641b75fb8362caa9c97c5e146ade hadrian/.ghci | 11 - hadrian/.gitignore | 26 -- hadrian/.travis.yml | 90 ----- hadrian/LICENSE | 21 - hadrian/README.md | 194 --------- hadrian/appveyor.yml | 39 -- hadrian/build.bat | 6 - hadrian/build.cabal.sh | 74 ---- hadrian/build.global-db.bat | 32 -- hadrian/build.global-db.sh | 52 --- hadrian/build.sh | 35 -- hadrian/build.stack.bat | 11 - hadrian/build.stack.nix.sh | 33 -- hadrian/build.stack.sh | 39 -- hadrian/cabal.project | 2 - hadrian/cfg/system.config.in | 141 ------- hadrian/circle.yml | 41 -- hadrian/doc/cross-compile.md | 57 --- hadrian/doc/flavours.md | 176 --------- hadrian/doc/user-settings.md | 212 ---------- hadrian/doc/windows.md | 69 ---- hadrian/hadrian.cabal | 142 ------- hadrian/src/Base.hs | 121 ------ hadrian/src/Builder.hs | 296 -------------- hadrian/src/CommandLine.hs | 137 ------- hadrian/src/Context.hs | 158 -------- hadrian/src/Environment.hs | 16 - hadrian/src/Expression.hs | 123 ------ hadrian/src/Flavour.hs | 34 -- hadrian/src/GHC.hs | 289 -------------- hadrian/src/Hadrian/Builder.hs | 125 ------ hadrian/src/Hadrian/Builder/Ar.hs | 68 ---- hadrian/src/Hadrian/Builder/Sphinx.hs | 39 -- hadrian/src/Hadrian/Builder/Tar.hs | 40 -- hadrian/src/Hadrian/Expression.hs | 153 ------- hadrian/src/Hadrian/Haskell/Cabal.hs | 44 --- hadrian/src/Hadrian/Haskell/Cabal/Parse.hs | 63 --- hadrian/src/Hadrian/Oracles/ArgsHash.hs | 51 --- hadrian/src/Hadrian/Oracles/DirectoryContents.hs | 64 --- hadrian/src/Hadrian/Oracles/Path.hs | 62 --- hadrian/src/Hadrian/Oracles/TextFile.hs | 123 ------ hadrian/src/Hadrian/Package.hs | 120 ------ hadrian/src/Hadrian/Target.hs | 29 -- hadrian/src/Hadrian/Utilities.hs | 406 ------------------- hadrian/src/Main.hs | 59 --- hadrian/src/Oracles/Flag.hs | 80 ---- hadrian/src/Oracles/ModuleFiles.hs | 160 -------- hadrian/src/Oracles/PackageData.hs | 66 ---- hadrian/src/Oracles/Setting.hs | 236 ----------- hadrian/src/Rules.hs | 123 ------ hadrian/src/Rules/Clean.hs | 23 -- hadrian/src/Rules/Compile.hs | 83 ---- hadrian/src/Rules/Configure.hs | 42 -- hadrian/src/Rules/Dependencies.hs | 33 -- hadrian/src/Rules/Documentation.hs | 197 --------- hadrian/src/Rules/Generate.hs | 482 ----------------------- hadrian/src/Rules/Gmp.hs | 119 ------ hadrian/src/Rules/Install.hs | 336 ---------------- hadrian/src/Rules/Libffi.hs | 108 ----- hadrian/src/Rules/Library.hs | 103 ----- hadrian/src/Rules/PackageData.hs | 119 ------ hadrian/src/Rules/Program.hs | 116 ------ hadrian/src/Rules/Register.hs | 44 --- hadrian/src/Rules/Selftest.hs | 92 ----- hadrian/src/Rules/SourceDist.hs | 113 ------ hadrian/src/Rules/Test.hs | 72 ---- hadrian/src/Rules/Wrappers.hs | 162 -------- hadrian/src/Settings.hs | 68 ---- hadrian/src/Settings/Builders/Alex.hs | 8 - hadrian/src/Settings/Builders/Cc.hs | 26 -- hadrian/src/Settings/Builders/Common.hs | 59 --- hadrian/src/Settings/Builders/Configure.hs | 25 -- hadrian/src/Settings/Builders/DeriveConstants.hs | 39 -- hadrian/src/Settings/Builders/GenPrimopCode.hs | 24 -- hadrian/src/Settings/Builders/Ghc.hs | 149 ------- hadrian/src/Settings/Builders/GhcCabal.hs | 118 ------ hadrian/src/Settings/Builders/GhcPkg.hs | 17 - hadrian/src/Settings/Builders/Haddock.hs | 63 --- hadrian/src/Settings/Builders/Happy.hs | 9 - hadrian/src/Settings/Builders/HsCpp.hs | 16 - hadrian/src/Settings/Builders/Hsc2Hs.hs | 56 --- hadrian/src/Settings/Builders/Ld.hs | 9 - hadrian/src/Settings/Builders/Make.hs | 16 - hadrian/src/Settings/Builders/Xelatex.hs | 7 - hadrian/src/Settings/Default.hs | 173 -------- hadrian/src/Settings/Default.hs-boot | 20 - hadrian/src/Settings/Flavours/Development.hs | 20 - hadrian/src/Settings/Flavours/Performance.hs | 18 - hadrian/src/Settings/Flavours/Profiled.hs | 19 - hadrian/src/Settings/Flavours/Quick.hs | 22 -- hadrian/src/Settings/Flavours/QuickCross.hs | 24 -- hadrian/src/Settings/Flavours/Quickest.hs | 23 -- hadrian/src/Settings/Packages/Base.hs | 12 - hadrian/src/Settings/Packages/Cabal.hs | 10 - hadrian/src/Settings/Packages/Compiler.hs | 45 --- hadrian/src/Settings/Packages/Ghc.hs | 13 - hadrian/src/Settings/Packages/GhcCabal.hs | 24 -- hadrian/src/Settings/Packages/GhcPkg.hs | 7 - hadrian/src/Settings/Packages/GhcPrim.hs | 13 - hadrian/src/Settings/Packages/Ghci.hs | 6 - hadrian/src/Settings/Packages/Haddock.hs | 7 - hadrian/src/Settings/Packages/Haskeline.hs | 8 - hadrian/src/Settings/Packages/IntegerGmp.hs | 24 -- hadrian/src/Settings/Packages/Rts.hs | 218 ---------- hadrian/src/Settings/Packages/RunGhc.hs | 9 - hadrian/src/Settings/Warnings.hs | 57 --- hadrian/src/Stage.hs | 31 -- hadrian/src/Target.hs | 26 -- hadrian/src/UserSettings.hs | 64 --- hadrian/src/Utilities.hs | 80 ---- hadrian/src/Way.hs | 162 -------- hadrian/stack.yaml | 22 -- 112 files changed, 8898 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 f4a11c60dac2641b75fb8362caa9c97c5e146ade From git at git.haskell.org Sat Nov 11 08:36:14 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 11 Nov 2017 08:36:14 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: Squashed 'hadrian/' content from commit 764d008554 (ff99230) Message-ID: <20171111083614.968793A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/ff99230258faf4eb4a75ae5dd708f86256b5f213/ghc >--------------------------------------------------------------- commit ff99230258faf4eb4a75ae5dd708f86256b5f213 Author: Moritz Angermann Date: Sat Nov 11 16:34:24 2017 +0800 Squashed 'hadrian/' content from commit 764d008554 git-subtree-dir: hadrian git-subtree-split: 764d008554a275a6c2f4351f805639a5ccb6d944 >--------------------------------------------------------------- ff99230258faf4eb4a75ae5dd708f86256b5f213 .ghci | 11 + .gitignore | 26 ++ .travis.yml | 90 ++++++ LICENSE | 21 ++ README.md | 194 ++++++++++++ appveyor.yml | 39 +++ build.bat | 6 + build.cabal.sh | 74 +++++ build.global-db.bat | 32 ++ build.global-db.sh | 52 +++ build.sh | 35 +++ build.stack.bat | 11 + build.stack.nix.sh | 33 ++ build.stack.sh | 39 +++ cabal.project | 9 + cfg/system.config.in | 138 ++++++++ circle.yml | 41 +++ doc/cross-compile.md | 57 ++++ doc/flavours.md | 176 +++++++++++ doc/user-settings.md | 212 +++++++++++++ doc/windows.md | 69 ++++ hadrian.cabal | 152 +++++++++ src/Base.hs | 127 ++++++++ src/Builder.hs | 341 ++++++++++++++++++++ src/Builder.hs-boot | 42 +++ src/CommandLine.hs | 137 ++++++++ src/Context.hs | 145 +++++++++ src/Context/Paths.hs | 40 +++ src/Environment.hs | 16 + src/Expression.hs | 113 +++++++ src/Flavour.hs | 34 ++ src/GHC.hs | 177 +++++++++++ src/GHC/Packages.hs | 114 +++++++ src/Hadrian/Builder.hs | 152 +++++++++ src/Hadrian/Builder/Ar.hs | 68 ++++ src/Hadrian/Builder/Sphinx.hs | 39 +++ src/Hadrian/Builder/Tar.hs | 40 +++ src/Hadrian/Expression.hs | 153 +++++++++ src/Hadrian/Haskell/Cabal.hs | 46 +++ src/Hadrian/Haskell/Cabal/Parse.hs | 291 +++++++++++++++++ src/Hadrian/Haskell/Cabal/Parse.hs-boot | 9 + src/Hadrian/Oracles/ArgsHash.hs | 51 +++ src/Hadrian/Oracles/DirectoryContents.hs | 64 ++++ src/Hadrian/Oracles/Path.hs | 62 ++++ src/Hadrian/Oracles/TextFile.hs | 150 +++++++++ src/Hadrian/Package.hs | 80 +++++ src/Hadrian/Target.hs | 29 ++ src/Hadrian/Utilities.hs | 418 +++++++++++++++++++++++++ src/Main.hs | 57 ++++ src/Oracles/Flag.hs | 74 +++++ src/Oracles/ModuleFiles.hs | 157 ++++++++++ src/Oracles/PackageData.hs | 64 ++++ src/Oracles/Setting.hs | 236 ++++++++++++++ src/Rules.hs | 124 ++++++++ src/Rules/Clean.hs | 23 ++ src/Rules/Compile.hs | 82 +++++ src/Rules/Configure.hs | 42 +++ src/Rules/Dependencies.hs | 35 +++ src/Rules/Documentation.hs | 197 ++++++++++++ src/Rules/Generate.hs | 522 +++++++++++++++++++++++++++++++ src/Rules/Gmp.hs | 122 ++++++++ src/Rules/Install.hs | 1 + src/Rules/Libffi.hs | 108 +++++++ src/Rules/Library.hs | 140 +++++++++ src/Rules/PackageData.hs | 86 +++++ src/Rules/Program.hs | 138 ++++++++ src/Rules/Register.hs | 102 ++++++ src/Rules/Selftest.hs | 92 ++++++ src/Rules/SourceDist.hs | 113 +++++++ src/Rules/Test.hs | 71 +++++ src/Rules/Wrappers.hs | 163 ++++++++++ src/Settings.hs | 68 ++++ src/Settings/Builders/Alex.hs | 8 + src/Settings/Builders/Cc.hs | 27 ++ src/Settings/Builders/Common.hs | 66 ++++ src/Settings/Builders/Configure.hs | 25 ++ src/Settings/Builders/DeriveConstants.hs | 39 +++ src/Settings/Builders/GenPrimopCode.hs | 24 ++ src/Settings/Builders/Ghc.hs | 154 +++++++++ src/Settings/Builders/GhcCabal.hs | 163 ++++++++++ src/Settings/Builders/GhcPkg.hs | 29 ++ src/Settings/Builders/Haddock.hs | 64 ++++ src/Settings/Builders/Happy.hs | 9 + src/Settings/Builders/HsCpp.hs | 16 + src/Settings/Builders/Hsc2Hs.hs | 54 ++++ src/Settings/Builders/Ld.hs | 9 + src/Settings/Builders/Make.hs | 16 + src/Settings/Builders/Xelatex.hs | 7 + src/Settings/Default.hs | 176 +++++++++++ src/Settings/Default.hs-boot | 20 ++ src/Settings/Flavours/Development.hs | 20 ++ src/Settings/Flavours/Performance.hs | 18 ++ src/Settings/Flavours/Profiled.hs | 19 ++ src/Settings/Flavours/Quick.hs | 22 ++ src/Settings/Flavours/QuickCross.hs | 24 ++ src/Settings/Flavours/Quickest.hs | 23 ++ src/Settings/Packages/Base.hs | 12 + src/Settings/Packages/Cabal.hs | 10 + src/Settings/Packages/Compiler.hs | 46 +++ src/Settings/Packages/Ghc.hs | 13 + src/Settings/Packages/GhcCabal.hs | 33 ++ src/Settings/Packages/GhcPkg.hs | 7 + src/Settings/Packages/GhcPrim.hs | 12 + src/Settings/Packages/Ghci.hs | 6 + src/Settings/Packages/Haddock.hs | 7 + src/Settings/Packages/Haskeline.hs | 8 + src/Settings/Packages/IntegerGmp.hs | 25 ++ src/Settings/Packages/Rts.hs | 215 +++++++++++++ src/Settings/Packages/RunGhc.hs | 9 + src/Settings/Warnings.hs | 93 ++++++ src/Stage.hs | 7 + src/Target.hs | 26 ++ src/Types/Cabal.hs | 24 ++ src/Types/ConfiguredCabal.hs | 54 ++++ src/Types/Context.hs | 21 ++ src/Types/Expression.hs | 18 ++ src/Types/Package.hs | 46 +++ src/Types/Stage.hs | 28 ++ src/Types/Way.hs | 112 +++++++ src/UserSettings.hs | 64 ++++ src/Utilities.hs | 85 +++++ src/Way.hs | 52 +++ stack.yaml | 22 ++ 123 files changed, 9359 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 ff99230258faf4eb4a75ae5dd708f86256b5f213 From git at git.haskell.org Sat Nov 11 08:36:03 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 11 Nov 2017 08:36:03 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: Even more sharing. (ae6f4c7) Message-ID: <20171111083603.5C4BC3A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/ae6f4c7df1d251a4381509d675cd3aa973097027/ghc >--------------------------------------------------------------- commit ae6f4c7df1d251a4381509d675cd3aa973097027 Author: Moritz Angermann Date: Sat Nov 11 15:24:28 2017 +0800 Even more sharing. >--------------------------------------------------------------- ae6f4c7df1d251a4381509d675cd3aa973097027 compiler/main/SysTools.hs | 1 - libraries/ghc-boot/GHC/BasePath.hs | 5 +++++ 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/compiler/main/SysTools.hs b/compiler/main/SysTools.hs index 4fe6fe8..07ffea7 100644 --- a/compiler/main/SysTools.hs +++ b/compiler/main/SysTools.hs @@ -48,7 +48,6 @@ import Platform import Util import DynFlags -import System.Environment (getExecutablePath) import System.FilePath import System.IO import System.Directory diff --git a/libraries/ghc-boot/GHC/BasePath.hs b/libraries/ghc-boot/GHC/BasePath.hs index dbe41fb..7a44749 100644 --- a/libraries/ghc-boot/GHC/BasePath.hs +++ b/libraries/ghc-boot/GHC/BasePath.hs @@ -1,6 +1,9 @@ {-# LANGUAGE CPP #-} module GHC.BasePath (getBaseDir) where +import System.Environment (getExecutablePath) +import System.FilePath + #if defined(mingw32_HOST_OS) #if MIN_VERSION_Win32(2,5,0) import qualified System.Win32.Types as Win32 @@ -27,6 +30,8 @@ import System.Win32.DLL (loadLibrary, getProcAddress) # endif #endif +-- | getBaseDir tries to find the base path (@$topdir@), assuming the executable is in @$topdir/bin/@ +-- and the base path is @$topdir/lib at . getBaseDir :: [String] -> IO (Maybe String) #if defined(mingw32_HOST_OS) -- Assuming we are running ghc, accessed by path $(stuff)//ghc.exe, From git at git.haskell.org Sat Nov 11 08:36:21 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 11 Nov 2017 08:36:21 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng's head updated: Merge commit 'ff99230258faf4eb4a75ae5dd708f86256b5f213' as 'hadrian' (f19a8c9) Message-ID: <20171111083621.BC3713A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/angerman/llvmng' now includes: c1efc6e Comments and white space 3acd616 Improve kick-out in the constraint solver e375bd3 Update record-wildcard docs 99c61e2 Add stack traces on crashes on Windows bb537b2 nofib submodule: Fix a problem with fasta-c.c 1e24a24 submodule nofib: Add digits-of-e1.faststdout 052ec24 submodule nofib: Add digits-of-e2.faststdout b10a768 Comments only d1eaead Temporary fix to Trac #14380 671b1ed User’s guide: Properly link to RTS flag -V 8843a39 Include usg_file_hash in ghc --show-iface output 3825b7e Remove the 'legroom' part of the timeout-accurate-pure test. b62097d Windows: Bump to GCC 7.2 for GHC 8.4 e888a1f Revert "Windows: Bump to GCC 7.2 for GHC 8.4" 561bdca Update Win32 version for GHC 8.4. f744261 ghc-cabal: Inline removed function from Cabal. 2e16a57 Revert "ghc-cabal: Inline removed function ..." b1ad0bb Revert "Update Win32 version for GHC 8.4." 61f1b46 Make language extensions their own category in the documentation bf83435 typecheck: Clarify errors mentioned in #14385 bd53b48 Add info about Github pull requests. 2a4c24e Make layLeft and reduceDoc stricter (#7258) 980e127 Windows: Update the mirror script to generate hashes and use mirror fallback 1c15d8e Fix space leak in BinIface.getSymbolTable df63668 Performance improvements linear regAlloc (#7258) f7f270e Implement `-Wpartial-fields` warning (#7169) 821adee Fix a bug in 'alexInputPrevChar' 2c23fff user-guide: Clarify default optimization flags 4c06ccb base: Enable listToMaybe to fuse via foldr/build dbd81f7 Factor out readField (#14364) d91a6b6 Declare upstram repo location for hsc2hs 160a491 users-guide: Disable index node generation 9ae24bb configure: Add Alpine Linux to checkVendor a10c2e6 Don't use $SHELL in wrapper scripts 355318c Add more pprTrace to SpecConstr (debug only) 7d7d94f Fix an exponential-blowup case in SpecConstr 41f9055 ApplicativeDo: handle BodyStmt (#12143) acd355a relnotes: Fix a few minor formatting issues faf60e8 Make tagForCon non-linear 922db3d Manual: The -ddump-cmm-* flags had a wrong spelling in the manual 97ca0d2 simplNonRecJoinPoint: Handle Shadowing correctly 0e953da Implement a dedicated exitfication pass #14152 3b784d4 base: Implement file locking in terms of POSIX locks cecd2f2 Add -falignment-sanitization flag 7673561 Turn `compareByteArrays#` out-of-line primop into inline primop 85aa1f4 Fix #14390 by making toIfaceTyCon aware of equality cca2d6b Allow packing constructor fields 82bad1a A bit more tc-tracing 1b115b1 Fix typo in accessor name ec356e8 Typofix in panic 1569668 Typofixes in comments 53700a9 minor wordsmithing 201b5aa Catch a few more typos in comments 609f284 Add Note [Setting the right in-scope set] af0aea9 core-spec: Add join points to formalism 29ae833 Tidy up IfaceEqualityTyCon 1317ba6 Implement the EmptyDataDeriving proposal 1130c67 PPC NCG: Impl branch prediction, atomic ops. b0b80e9 Implement the basics of hex floating point literals e0df569 Use proper Unique for Name b938576 Add custom exception for fixIO 36f0cb7 TcRnDriver: Bracket family instance consistency output in -ddump-rn-trace cbd6a4d Introduce -dsuppress-stg-free-vars flag bd765f4 Fix atomicread/write operations d9b6015 Revert "Move check-ppr and check-api-annotations to testsuite/utils" 51321cf rts/PrimOps.cmm: add declaration for heapOverflow closure 4353756 CmmSink: Use a IntSet instead of a list 15f788f llvmGen: Pass vector arguments in vector registers by default eb37132 Bump haddock submodule 3c8e55c Name TypeRep constructor fields 19ca2ca Deserialize all function TypeReps 5d48f7c Fix documentation and comment issues df479f7 change example from msum to mfilter 436b3ef Clean up comments about match algorithm a bit. f6521e6 testsuite: Bump metrics of haddock.Cabal 4dfb790 rts/win32: Emit exception handler output to stderr 6f990c5 cmm/CBE: Fix comparison between blocks of different lengths a27056f cmm/CBE: Fix a few more zip uses 2ded536 Typo in glasgow_exts.rst 35642f4 Update ErrorCall documentation for the location argument 8613e61 DynFlags: Introduce -show-mods-loaded flag 59de290 Update autoconf test for gcc to require 4.7 and up 66b5b3e Specialise lcm :: Word -> Word -> Word (trac#14424) 275ac8e base: Add examples to Bifunctor documentation 7b0b9f6 Squashed 'hadrian/' content from commit 438dc57 5cee480 Merge commit '7b0b9f603bb1215e2b7af23c2404d637b95a4988' as 'hadrian' 0ff152c WIP on combining Step 1 and 3 of Trees That Grow 7d6fa32 Set up Linux, OSX and FreeBSD on CircleCI. b0cabc9 Set up AppVeyor, Windows CI. 6f665cc Sdist -> bindist -> tests 07e0d0d Revert "Sdist -> bindist -> tests" ed18f47 Factor out builds into steps. Address ghc/ghc#83 comments. ae7c33f testsuite: Bump haddock.compiler allocations 7d34f69 relnotes: Clarify a few things c1bc923 relnotes: Note enabling of -fllvm-pass-vectorse-in-regs 93b4820 Revert "WIP on combining Step 1 and 3 of Trees That Grow" 9f8dde0 Update link to Haskeline user preferences bf9ba7b base: Escape \ in CallStack example 14d885e Merge remote-tracking branch 'github/pr/83' 21970de Imrpove comments about equality types 30058b0 Fix another dark corner in the shortcut solver 2c2f3ce Minimise provided dictionaries in pattern synonyms fe6848f Fix in-scope set in simplifier 438dd1c WIP on Doing a combined Step 1 and 3 for Trees That Grow 803ed03 Invoke lintUnfolding only on top-level unfoldings (#14430) 6bd352a Remove left-overs from compareByteArray# inline conversion 10ff3e3 testsuite: Fix output of T14394 bdd2d28 Update Win32 version for GHC 8.4. 9773053 Merge initial Hadrian snapshot ce9a677 base: Add test for #14425 c59d6da base: Normalize style of approxRational 5834da4 base: Fix #14425 0656cb4 Update comment in GHC.Real (trac#14432) 6b52b4c Remove unreliable Core Lint empty case checks e6b13c9 testsuite: Add test for #5889 75291ab Change `OPTIONS_GHC -O` to `OPTIONS_GHC -O2` f8e7fec Fix PPC NCG after blockID patch 0c31b32 Relocatable GHC d390e35 [reloc] ghc-pkg baseDir b3321a3 Adds -ghc-version flag to ghc. edfbeb0 Add DynFlags signature. 6ad8d6c Adds rts/rts.cabal.in file 043bfaf Use LICENSE instead of ../LICENSE in the compiler.cabal file 22023fe Adds cmm-sources to base b3ad08e Adds `-llvmng` f50cdab Adds test 8af0c1b bump submodule. 5b22f81 Use cmmSources 2d67ef3 Merge branches 'feature/D4121-reloc-paths', 'feature/D4135-ghc-version', 'feature/D4174-rts-cabal', 'feature/D4175-compiler-LICENSE' and 'feature/D4176-base-cmm-files' into wip/angerman/llvmng 07edb3a bump Cabal d5b618b bump submodules. 999a97c bump cabal 29704a6 GHC.prim use virtual-modules 8090e90 cleanup 828163e Sharing is caring. 3af810d Merge branch 'feature/D4121-reloc-paths' into wip/angerman/llvmng 2a25a4f bump cabal. ae6f4c7 Even more sharing. d7b848e Merge branch 'feature/D4121-reloc-paths' into wip/angerman/llvmng f4a11c6 drop hadrian ff99230 Squashed 'hadrian/' content from commit 764d008554 f19a8c9 Merge commit 'ff99230258faf4eb4a75ae5dd708f86256b5f213' as 'hadrian' From git at git.haskell.org Sat Nov 11 13:08:09 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 11 Nov 2017 13:08:09 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: Adds binary-dist support (dfa2ec7) Message-ID: <20171111130809.0F0EA3A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/dfa2ec73bb4b81ea6b1fe300a0b12c84d5382aa0/ghc >--------------------------------------------------------------- commit dfa2ec73bb4b81ea6b1fe300a0b12c84d5382aa0 Author: Moritz Angermann Date: Sat Nov 11 21:07:43 2017 +0800 Adds binary-dist support >--------------------------------------------------------------- dfa2ec73bb4b81ea6b1fe300a0b12c84d5382aa0 hadrian/src/Builder.hs | 2 +- hadrian/src/Rules.hs | 19 +++++++++++++++++++ 2 files changed, 20 insertions(+), 1 deletion(-) diff --git a/hadrian/src/Builder.hs b/hadrian/src/Builder.hs index 103ec98..7f5ac9d 100644 --- a/hadrian/src/Builder.hs +++ b/hadrian/src/Builder.hs @@ -235,7 +235,7 @@ instance H.Builder Builder where Stdout pkgDesc <- cmd [path] ["--expand-pkgroot", "--no-user-package-db", "describe", input ] cmd (Stdin pkgDesc) [path] (buildArgs ++ ["-"]) - _ -> cmd echo [path] buildArgs + _ -> cmd echo [path] buildOptions buildArgs -- TODO: Some builders are required only on certain platforms. For example, -- 'Objdump' is only required on OpenBSD and AIX. Add support for platform diff --git a/hadrian/src/Rules.hs b/hadrian/src/Rules.hs index e7b2ae6..5fc03d8 100644 --- a/hadrian/src/Rules.hs +++ b/hadrian/src/Rules.hs @@ -22,6 +22,9 @@ import Settings import Target import Utilities +import System.Directory (getCurrentDirectory) + +import Oracles.Setting allStages :: [Stage] allStages = [minBound .. maxBound] @@ -30,6 +33,22 @@ allStages = [minBound .. maxBound] -- 'Stage1Only' flag. topLevelTargets :: Rules () topLevelTargets = do + phony "binary-dist" $ do + -- This is kind of incorrect. We should not "need" a phony rule. + -- Instead we should *need* the libraries and bianries we want to + -- put into the bianry distribution. For now we will just *need* + -- stage2 and package up bin and lib. + need ["stage2"] + version <- setting ProjectVersion + cwd <- liftIO $ getCurrentDirectory + binDistDir <- getEnvWithDefault cwd "BINARY_DIST_DIR" + baseDir <- buildRoot <&> (-/- stageString Stage1) + buildWithCmdOptions [Cwd baseDir] $ + -- ghc is a fake packge here. + target (vanillaContext Stage1 ghc) (Tar Create) + ["bin", "lib"] + [binDistDir -/- "ghc-" ++ version ++ ".tar.xz"] + phony "stage2" $ do putNormal "Building stage2" need =<< mapM (f Stage1) =<< stagePackages Stage1 From git at git.haskell.org Sat Nov 11 15:54:35 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 11 Nov 2017 15:54:35 +0000 (UTC) Subject: [commit: ghc] master: Merge commit '5229c43ccf77bcbffeced01dccb27398d017fa34' (506ba62) Message-ID: <20171111155435.E1EDA3A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/506ba623fd20bfc30794c06d83d1387e3a6bdb8b/ghc >--------------------------------------------------------------- commit 506ba623fd20bfc30794c06d83d1387e3a6bdb8b Merge: f8e7fec 5229c43 Author: Ben Gamari Date: Fri Nov 10 09:28:36 2017 -0500 Merge commit '5229c43ccf77bcbffeced01dccb27398d017fa34' >--------------------------------------------------------------- 506ba623fd20bfc30794c06d83d1387e3a6bdb8b hadrian/cfg/system.config.in | 3 --- hadrian/src/Oracles/Flag.hs | 6 ------ hadrian/src/Settings/Builders/Common.hs | 7 +++---- hadrian/src/Settings/Packages/GhcPrim.hs | 1 - hadrian/src/Settings/Packages/Rts.hs | 4 ++-- hadrian/src/Settings/Warnings.hs | 5 ++--- 6 files changed, 7 insertions(+), 19 deletions(-) From git at git.haskell.org Sat Nov 11 15:54:39 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 11 Nov 2017 15:54:39 +0000 (UTC) Subject: [commit: ghc] master: Squashed 'hadrian/' changes from 438dc576e7..5ebb69ae1e (5229c43) Message-ID: <20171111155439.5B92C3A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5229c43ccf77bcbffeced01dccb27398d017fa34/ghc >--------------------------------------------------------------- commit 5229c43ccf77bcbffeced01dccb27398d017fa34 Author: Ben Gamari Date: Fri Nov 10 09:28:36 2017 -0500 Squashed 'hadrian/' changes from 438dc576e7..5ebb69ae1e 5ebb69ae1e Drop GccLtXX flags, require GCC > 4.7 and up (#450) git-subtree-dir: hadrian git-subtree-split: 5ebb69ae1eb063f25c59383bffb3b5449015c6f9 >--------------------------------------------------------------- 5229c43ccf77bcbffeced01dccb27398d017fa34 cfg/system.config.in | 3 --- src/Oracles/Flag.hs | 6 ------ src/Settings/Builders/Common.hs | 7 +++---- src/Settings/Packages/GhcPrim.hs | 1 - src/Settings/Packages/Rts.hs | 4 ++-- src/Settings/Warnings.hs | 5 ++--- 6 files changed, 7 insertions(+), 19 deletions(-) diff --git a/cfg/system.config.in b/cfg/system.config.in index 913a2b4..b007581 100644 --- a/cfg/system.config.in +++ b/cfg/system.config.in @@ -33,9 +33,6 @@ ar-supports-at-file = @ArSupportsAtFile@ cc-clang-backend = @CC_CLANG_BACKEND@ cc-llvm-backend = @CC_LLVM_BACKEND@ gcc-is-clang = @GccIsClang@ -gcc-lt-34 = @GccLT34@ -gcc-lt-44 = @GccLT44@ -gcc-lt-46 = @GccLT46@ hs-cpp-args = @HaskellCPPArgs@ # Build options: diff --git a/src/Oracles/Flag.hs b/src/Oracles/Flag.hs index 447f0bc..1bd4dfe 100644 --- a/src/Oracles/Flag.hs +++ b/src/Oracles/Flag.hs @@ -11,9 +11,6 @@ import Oracles.Setting data Flag = ArSupportsAtFile | CrossCompiling | GccIsClang - | GccLt34 - | GccLt44 - | GccLt46 | GhcUnregisterised | LeadingUnderscore | SolarisBrokenShld @@ -30,9 +27,6 @@ flag f = do ArSupportsAtFile -> "ar-supports-at-file" CrossCompiling -> "cross-compiling" GccIsClang -> "gcc-is-clang" - GccLt34 -> "gcc-lt-34" - GccLt44 -> "gcc-lt-44" - GccLt46 -> "gcc-lt-46" GhcUnregisterised -> "ghc-unregisterised" LeadingUnderscore -> "leading-underscore" SolarisBrokenShld -> "solaris-broken-shld" diff --git a/src/Settings/Builders/Common.hs b/src/Settings/Builders/Common.hs index 5ca594e..340239a 100644 --- a/src/Settings/Builders/Common.hs +++ b/src/Settings/Builders/Common.hs @@ -40,12 +40,11 @@ cArgs = mempty -- TODO: should be in a different file cWarnings :: Args -cWarnings = do - let gccGe46 = notM (flag GccIsClang ||^ flag GccLt46) +cWarnings = mconcat [ arg "-Wall" , flag GccIsClang ? arg "-Wno-unknown-pragmas" - , gccGe46 ? notM windowsHost ? arg "-Werror=unused-but-set-variable" - , gccGe46 ? arg "-Wno-error=inline" ] + , notM (flag GccIsClang) ? notM windowsHost ? arg "-Werror=unused-but-set-variable" + , notM (flag GccIsClang) ? arg "-Wno-error=inline" ] bootPackageDatabaseArgs :: Args bootPackageDatabaseArgs = do diff --git a/src/Settings/Packages/GhcPrim.hs b/src/Settings/Packages/GhcPrim.hs index df1c553..aed8f2f 100644 --- a/src/Settings/Packages/GhcPrim.hs +++ b/src/Settings/Packages/GhcPrim.hs @@ -8,6 +8,5 @@ ghcPrimPackageArgs = package ghcPrim ? mconcat [ builder GhcCabal ? arg "--flag=include-ghc-prim" , builder (Cc CompileC) ? - (not <$> flag GccLt44) ? (not <$> flag GccIsClang) ? input "//cbits/atomic.c" ? arg "-Wno-sync-nand" ] diff --git a/src/Settings/Packages/Rts.hs b/src/Settings/Packages/Rts.hs index 33169fe..b15bb6a 100644 --- a/src/Settings/Packages/Rts.hs +++ b/src/Settings/Packages/Rts.hs @@ -204,7 +204,7 @@ rtsPackageArgs = package rts ? do rtsWarnings :: Args rtsWarnings = mconcat [ pure ["-Wall", "-Werror"] - , flag GccLt34 ? arg "-W", not <$> flag GccLt34 ? arg "-Wextra" + , arg "-Wextra" , arg "-Wstrict-prototypes" , arg "-Wmissing-prototypes" , arg "-Wmissing-declarations" @@ -214,5 +214,5 @@ rtsWarnings = mconcat , arg "-Wmissing-noreturn" , arg "-Wnested-externs" , arg "-Wredundant-decls" - , not <$> flag GccLt46 ? arg "-Wundef" + , arg "-Wundef" , arg "-fno-strict-aliasing" ] diff --git a/src/Settings/Warnings.hs b/src/Settings/Warnings.hs index f8eb4a5..abbc814 100644 --- a/src/Settings/Warnings.hs +++ b/src/Settings/Warnings.hs @@ -12,9 +12,8 @@ defaultGhcWarningsArgs :: Args defaultGhcWarningsArgs = mconcat [ notStage0 ? pure [ "-Werror", "-Wnoncanonical-monad-instances" ] , (not <$> flag GccIsClang) ? mconcat - [ (not <$> flag GccLt46) ? - (not <$> windowsHost ) ? arg "-optc-Werror=unused-but-set-variable" - , (not <$> flag GccLt44) ? arg "-optc-Wno-error=inline" ] + [ (not <$> windowsHost ) ? arg "-optc-Werror=unused-but-set-variable" + , arg "-optc-Wno-error=inline" ] , flag GccIsClang ? arg "-optc-Wno-unknown-pragmas" ] -- | Package-specific warnings-related arguments, mostly suppressing various warnings. From git at git.haskell.org Sat Nov 11 16:34:48 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 11 Nov 2017 16:34:48 +0000 (UTC) Subject: [commit: ghc] master: Windows: Bump to GCC 7.2 for GHC 8.4 (f11f252) Message-ID: <20171111163448.132013A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f11f2521aff16edca150e6eed5102a3da7e4f59a/ghc >--------------------------------------------------------------- commit f11f2521aff16edca150e6eed5102a3da7e4f59a Author: Tamar Christina Date: Sat Nov 11 10:55:31 2017 -0500 Windows: Bump to GCC 7.2 for GHC 8.4 GHC 8.4 is expected to ship with an updated GCC bindist based on GCC 7.2. I am however at this time not updating the crt due to an issue introduced in September. https://sourceforge.net/p/mingw-w64/mailman/message/36085637/ Unless a favorable fix comes out of the discussion I will just ship the old crt with GHC 8.4. Test Plan: ./validate Reviewers: austin, bgamari Reviewed By: bgamari Subscribers: thomie, rwbarton Differential Revision: https://phabricator.haskell.org/D4125 >--------------------------------------------------------------- f11f2521aff16edca150e6eed5102a3da7e4f59a mk/get-win32-tarballs.sh | 23 ++++++++++---------- mk/win32-tarballs.md5sum | 56 ++++++++++++++++++++++++------------------------ 2 files changed, 39 insertions(+), 40 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc f11f2521aff16edca150e6eed5102a3da7e4f59a From git at git.haskell.org Sat Nov 11 16:34:50 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 11 Nov 2017 16:34:50 +0000 (UTC) Subject: [commit: ghc] master: Adds cmm-sources to base (ba2ae2c) Message-ID: <20171111163450.D892B3A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ba2ae2c8729d5aef2aeb7fb32d6c0ea2a465ea25/ghc >--------------------------------------------------------------- commit ba2ae2c8729d5aef2aeb7fb32d6c0ea2a465ea25 Author: Moritz Angermann Date: Sat Nov 11 10:55:51 2017 -0500 Adds cmm-sources to base Bumps Cabal submodule. Reviewers: bgamari, hvr Reviewed By: bgamari Subscribers: rwbarton, thomie Differential Revision: https://phabricator.haskell.org/D4176 >--------------------------------------------------------------- ba2ae2c8729d5aef2aeb7fb32d6c0ea2a465ea25 libraries/Cabal | 2 +- libraries/base/base.cabal | 3 +++ utils/ghc-cabal/Main.hs | 3 ++- 3 files changed, 6 insertions(+), 2 deletions(-) diff --git a/libraries/Cabal b/libraries/Cabal index 46c79e1..357d49d 160000 --- a/libraries/Cabal +++ b/libraries/Cabal @@ -1 +1 @@ -Subproject commit 46c79e1d8d0ed76b20e8494b697f3057b64aafd5 +Subproject commit 357d49d826004c022f3b4871f16d753e1b932b54 diff --git a/libraries/base/base.cabal b/libraries/base/base.cabal index 43c7882..e6f6420 100644 --- a/libraries/base/base.cabal +++ b/libraries/base/base.cabal @@ -338,6 +338,9 @@ Library cbits/primFloat.c cbits/sysconf.c + cmm-sources: + cbits/CastFloatWord.cmm + include-dirs: include includes: HsBase.h diff --git a/utils/ghc-cabal/Main.hs b/utils/ghc-cabal/Main.hs index 2ba912a..9d0ffcf 100644 --- a/utils/ghc-cabal/Main.hs +++ b/utils/ghc-cabal/Main.hs @@ -406,8 +406,9 @@ generate directory distdir config_args variablePrefix ++ "_INSTALL_INCLUDES = " ++ unwords (installIncludes bi), variablePrefix ++ "_EXTRA_LIBRARIES = " ++ unwords (extraLibs bi), variablePrefix ++ "_EXTRA_LIBDIRS = " ++ unwords (extraLibDirs bi), + variablePrefix ++ "_S_SRCS = " ++ unwords (asmSources bi), variablePrefix ++ "_C_SRCS = " ++ unwords (cSources bi), - variablePrefix ++ "_CMM_SRCS := $(addprefix cbits/,$(notdir $(wildcard " ++ directory ++ "/cbits/*.cmm)))", + variablePrefix ++ "_CMM_SRCS = " ++ unwords (cmmSources bi), variablePrefix ++ "_DATA_FILES = " ++ unwords (dataFiles pd), -- XXX This includes things it shouldn't, like: -- -odir dist-bootstrapping/build From git at git.haskell.org Sat Nov 11 16:34:53 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 11 Nov 2017 16:34:53 +0000 (UTC) Subject: [commit: ghc] master: Use LICENSE instead of ../LICENSE in the compiler.cabal file (426af53) Message-ID: <20171111163453.9FE5A3A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/426af53a754aa7d991d130febdec9b4af4580364/ghc >--------------------------------------------------------------- commit 426af53a754aa7d991d130febdec9b4af4580364 Author: Moritz Angermann Date: Sat Nov 11 10:56:10 2017 -0500 Use LICENSE instead of ../LICENSE in the compiler.cabal file Reviewers: bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie Differential Revision: https://phabricator.haskell.org/D4175 >--------------------------------------------------------------- 426af53a754aa7d991d130febdec9b4af4580364 compiler/ghc.cabal.in | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in index dce96f4..3b99db1 100644 --- a/compiler/ghc.cabal.in +++ b/compiler/ghc.cabal.in @@ -4,7 +4,7 @@ Name: ghc Version: @ProjectVersionMunged@ License: BSD3 -License-File: ../LICENSE +License-File: LICENSE Author: The GHC Team Maintainer: glasgow-haskell-users at haskell.org Homepage: http://www.haskell.org/ghc/ From git at git.haskell.org Sat Nov 11 16:47:00 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 11 Nov 2017 16:47:00 +0000 (UTC) Subject: [commit: ghc] master: circleci: Bump down thread count (5f158bc) Message-ID: <20171111164700.903C83A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5f158bc1a7eedf8680f4a1e612ca34daa05e0029/ghc >--------------------------------------------------------------- commit 5f158bc1a7eedf8680f4a1e612ca34daa05e0029 Author: Ben Gamari Date: Sat Nov 11 11:45:37 2017 -0500 circleci: Bump down thread count It appears that our jobs generally run on VMs with 2 vCPUs. Consequently running with 8 jobs will completely oversubscribe the machine. I suspect this is the cause of #14453. Let's bump this down to 3 for now. Ideally we would determine this from the environment. >--------------------------------------------------------------- 5f158bc1a7eedf8680f4a1e612ca34daa05e0029 .circleci/config.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.circleci/config.yml b/.circleci/config.yml index c35ac21..b2e59eb 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -22,7 +22,7 @@ aliases: name: submodules command: .circleci/fetch-submodules.sh - &buildenv - THREADS: 8 + THREADS: 3 SKIP_PERF_TESTS: YES VERBOSE: 2 - &boot From git at git.haskell.org Sat Nov 11 17:24:32 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 11 Nov 2017 17:24:32 +0000 (UTC) Subject: [commit: ghc] master: Declare proper spec version in `base.cabal` (86c50a1) Message-ID: <20171111172432.A97583A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/86c50a16e6a17349a7662067232236e38e46ba42/ghc >--------------------------------------------------------------- commit 86c50a16e6a17349a7662067232236e38e46ba42 Author: Herbert Valerio Riedel Date: Sat Nov 11 17:40:15 2017 +0100 Declare proper spec version in `base.cabal` This is a follow-up to ba2ae2c8729d5aef2aeb7fb32d6c0ea2a465ea25 which started relying on a new Cabal feature requiring the the cabal spec version declaration to be updated accordingly. >--------------------------------------------------------------- 86c50a16e6a17349a7662067232236e38e46ba42 libraries/base/base.cabal | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/libraries/base/base.cabal b/libraries/base/base.cabal index e6f6420..8817f69 100644 --- a/libraries/base/base.cabal +++ b/libraries/base/base.cabal @@ -1,6 +1,8 @@ +cabal-version: 2.1 name: base version: 4.11.0.0 -- NOTE: Don't forget to update ./changelog.md + license: BSD3 license-file: LICENSE maintainer: libraries at haskell.org @@ -11,7 +13,6 @@ description: This package contains the "Prelude" and its support libraries, and a large collection of useful libraries ranging from data structures to parsing combinators and debugging utilities. -cabal-version: >=1.10 build-type: Configure extra-tmp-files: From git at git.haskell.org Sat Nov 11 21:17:00 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 11 Nov 2017 21:17:00 +0000 (UTC) Subject: [commit: ghc] master: WIP on combined Step 1 and 3 for Trees That Grow, HsExpr (e3ec2e7) Message-ID: <20171111211700.1CCCE3A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e3ec2e7ae94524ebd111963faf34b84d942265b4/ghc >--------------------------------------------------------------- commit e3ec2e7ae94524ebd111963faf34b84d942265b4 Author: Alan Zimmerman Date: Thu Nov 9 23:20:19 2017 +0200 WIP on combined Step 1 and 3 for Trees That Grow, HsExpr See https://ghc.haskell.org/trac/ghc/wiki/ImplementingTreesThatGrow Trees that grow extension points are added for - HsExpr Updates haddock submodule Test Plan: ./validate Reviewers: bgamari, goldfire Subscribers: rwbarton, thomie, shayan-najd, mpickering Differential Revision: https://phabricator.haskell.org/D4177 >--------------------------------------------------------------- e3ec2e7ae94524ebd111963faf34b84d942265b4 compiler/deSugar/Check.hs | 8 +- compiler/deSugar/Coverage.hs | 151 ++++--- compiler/deSugar/DsArrows.hs | 17 +- compiler/deSugar/DsExpr.hs | 112 ++--- compiler/deSugar/DsGRHSs.hs | 15 +- compiler/deSugar/DsMeta.hs | 51 ++- compiler/deSugar/Match.hs | 32 +- compiler/deSugar/MatchLit.hs | 8 +- compiler/deSugar/PmExpr.hs | 37 +- compiler/hsSyn/Convert.hs | 78 ++-- compiler/hsSyn/HsExpr.hs | 480 +++++++++++++-------- compiler/hsSyn/HsExtension.hs | 122 +++++- compiler/hsSyn/HsPat.hs | 10 - compiler/hsSyn/HsUtils.hs | 174 ++++---- compiler/hsSyn/PlaceHolder.hs | 6 - compiler/main/InteractiveEval.hs | 2 +- compiler/parser/Parser.y | 147 ++++--- compiler/parser/RdrHsSyn.hs | 133 +++--- compiler/rename/RnEnv.hs | 4 +- compiler/rename/RnExpr.hs | 200 ++++----- compiler/rename/RnPat.hs | 6 +- compiler/rename/RnSource.hs | 15 +- compiler/rename/RnSplice.hs | 18 +- compiler/rename/RnTypes.hs | 41 +- compiler/typecheck/Inst.hs | 6 +- compiler/typecheck/TcBinds.hs | 4 +- compiler/typecheck/TcExpr.hs | 205 ++++----- compiler/typecheck/TcGenDeriv.hs | 10 +- compiler/typecheck/TcHsSyn.hs | 146 ++++--- compiler/typecheck/TcInstDcls.hs | 18 +- compiler/typecheck/TcMatches.hs | 19 +- compiler/typecheck/TcPatSyn.hs | 32 +- compiler/typecheck/TcRnDriver.hs | 9 +- compiler/typecheck/TcRnTypes.hs | 91 ++-- compiler/typecheck/TcSplice.hs | 9 +- compiler/typecheck/TcTyDecls.hs | 6 +- ghc/GHCi/UI.hs | 4 +- ghc/GHCi/UI/Info.hs | 8 +- testsuite/tests/ghc-api/annotations/parseTree.hs | 6 +- .../tests/ghc-api/annotations/stringSource.hs | 6 +- testsuite/tests/ghc-api/annotations/t11430.hs | 2 +- .../parser/should_compile/DumpParsedAst.stderr | 3 + .../parser/should_compile/DumpRenamedAst.stderr | 3 + .../should_compile/DumpTypecheckedAst.stderr | 73 ++++ testsuite/tests/perf/haddock/all.T | 3 +- testsuite/tests/quasiquotation/T7918.hs | 2 +- utils/haddock | 2 +- 47 files changed, 1452 insertions(+), 1082 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 e3ec2e7ae94524ebd111963faf34b84d942265b4 From git at git.haskell.org Sun Nov 12 00:06:48 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 12 Nov 2017 00:06:48 +0000 (UTC) Subject: [commit: ghc] branch 'wip/circleci-ben' created Message-ID: <20171112000648.5E3A93A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/circleci-ben Referencing: aab88e6fba18a04323b04c5d611c61ad8c7704f8 From git at git.haskell.org Sun Nov 12 00:06:54 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 12 Nov 2017 00:06:54 +0000 (UTC) Subject: [commit: ghc] wip/circleci-ben: Merge commit '81b8b24c15c0f983920b0152f0a076b7a8006bb1' (18638d9) Message-ID: <20171112000654.B550F3A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/circleci-ben Link : http://ghc.haskell.org/trac/ghc/changeset/18638d9c745286cc2e3578769513a157b8ded830/ghc >--------------------------------------------------------------- commit 18638d9c745286cc2e3578769513a157b8ded830 Merge: 5f158bc 81b8b24 Author: Ben Gamari Date: Sat Nov 11 14:46:53 2017 -0500 Merge commit '81b8b24c15c0f983920b0152f0a076b7a8006bb1' >--------------------------------------------------------------- 18638d9c745286cc2e3578769513a157b8ded830 hadrian/.travis.yml | 4 +++- hadrian/appveyor.yml | 24 +++++++++++++----------- hadrian/cabal.project | 8 ++++++-- hadrian/circle.yml | 3 ++- hadrian/hadrian.cabal | 2 +- hadrian/src/Settings/Packages/GhcCabal.hs | 11 +++++++++-- hadrian/stack.yaml | 4 ++++ 7 files changed, 38 insertions(+), 18 deletions(-) From git at git.haskell.org Sun Nov 12 00:06:51 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 12 Nov 2017 00:06:51 +0000 (UTC) Subject: [commit: ghc] wip/circleci-ben: Squashed 'hadrian/' changes from 5ebb69ae1e..5baa8db601 (81b8b24) Message-ID: <20171112000651.DE7F23A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/circleci-ben Link : http://ghc.haskell.org/trac/ghc/changeset/81b8b24c15c0f983920b0152f0a076b7a8006bb1/ghc >--------------------------------------------------------------- commit 81b8b24c15c0f983920b0152f0a076b7a8006bb1 Author: Ben Gamari Date: Sat Nov 11 14:46:53 2017 -0500 Squashed 'hadrian/' changes from 5ebb69ae1e..5baa8db601 5baa8db601 Fix AppVeyor cache failure (#456) 94dbe9d711 Fix ghc-cabal build (#455) a6797641ac Fix CI scripts (#454) 06ec241ec6 Widen bounds on Cabal (#452) git-subtree-dir: hadrian git-subtree-split: 5baa8db6010021b03da6897b2442dacc4b4c07ff >--------------------------------------------------------------- 81b8b24c15c0f983920b0152f0a076b7a8006bb1 .travis.yml | 4 +++- appveyor.yml | 24 +++++++++++++----------- cabal.project | 8 ++++++-- circle.yml | 3 ++- hadrian.cabal | 2 +- src/Settings/Packages/GhcCabal.hs | 11 +++++++++-- stack.yaml | 4 ++++ 7 files changed, 38 insertions(+), 18 deletions(-) diff --git a/.travis.yml b/.travis.yml index e2455b2..1943528 100644 --- a/.travis.yml +++ b/.travis.yml @@ -76,10 +76,12 @@ install: - cabal update - cabal install alex happy + # GHC comes with an older version of Hadrian, so we delete it + - rm -r ghc/hadrian/* + # Travis has already cloned Hadrian into ./ and we need to move it # to ./ghc/hadrian -- one way to do it is to move the .git directory # and perform a hard reset in order to regenerate Hadrian files - - mkdir ghc/hadrian - mv .git ghc/hadrian - cd ghc/hadrian - git reset --hard HEAD diff --git a/appveyor.yml b/appveyor.yml index fbedf8f..bd871ca 100644 --- a/appveyor.yml +++ b/appveyor.yml @@ -1,4 +1,4 @@ -clone_folder: "c:\\ghc\\hadrian" +clone_folder: "c:\\new-hadrian" environment: global: STACK_ROOT: "c:\\sr" @@ -11,24 +11,26 @@ install: - curl -ostack.zip -LsS --insecure https://www.stackage.org/stack/windows-x86_64 - 7z x stack.zip stack.exe + # Note: AppVeyor has already cloned Hadrian into c:\new-hadrian # Fetch GHC sources into c:\ghc - # Note: AppVeyor has already cloned Hadrian into c:\ghc\hadrian, so it's tricky - cd .. - - git init - - git remote add origin git://git.haskell.org/ghc.git - - git pull --recurse-submodules origin master - - git submodule update --init --recursive --quiet + - git clone --recursive git://git.haskell.org/ghc.git + # GHC comes with an older version of Hadrian, so we delete it + - rm -rf ghc\hadrian + # Copy new Hadrian into ./ghc/hadrian + - cp -r new-hadrian ghc\hadrian + + # Install Alex and Happy + - set PATH=C:\Users\appveyor\AppData\Roaming\local\bin;%PATH% + - ghc\hadrian\stack install --install-ghc alex happy > nul # Install all Hadrian and GHC build dependencies - - cd hadrian + - cd ghc\hadrian - stack setup > nul - appveyor-retry stack exec -- pacman -S autoconf automake-wrapper make patch python tar --noconfirm build_script: - # Build Hadrian - - stack build alex happy # Otherwise 'build' fails on AppVeyor - - # Run internal Hadrian tests + # Build Hadrian and run internal Hadrian tests - build selftest # Build GHC diff --git a/cabal.project b/cabal.project index 1ef81ca..317094f 100644 --- a/cabal.project +++ b/cabal.project @@ -1,2 +1,6 @@ -packages: ../libraries/Cabal/Cabal/ - ./ +packages: ./ + ../libraries/Cabal/Cabal/ + ../libraries/filepath/ + ../libraries/text/ + ../libraries/hpc/ + ../libraries/parsec/ diff --git a/circle.yml b/circle.yml index a386d72..763475f 100644 --- a/circle.yml +++ b/circle.yml @@ -21,7 +21,8 @@ compile: - git config --global url."git://github.com/ghc/packages-".insteadOf git://github.com/ghc/packages/ - git clone --depth 1 --recursive git://github.com/ghc/ghc - - mkdir ghc/hadrian + # GHC comes with an older version of Hadrian, so we delete it + - rm -r ghc/hadrian/* # move hadrian's .git into ./ghc/hadrian and perform a hard reset in order to regenerate Hadrian files - mv .git ghc/hadrian # NOTE: we must write them in the same line because each line diff --git a/hadrian.cabal b/hadrian.cabal index 566437e..389f553 100644 --- a/hadrian.cabal +++ b/hadrian.cabal @@ -118,7 +118,7 @@ executable hadrian , TypeFamilies build-depends: base >= 4.8 && < 5 , ansi-terminal == 0.6.* - , Cabal == 2.0.0.2 + , Cabal >= 2.0.0.2 && < 2.2 , containers == 0.5.* , directory >= 1.2 && < 1.4 , extra >= 1.4.7 diff --git a/src/Settings/Packages/GhcCabal.hs b/src/Settings/Packages/GhcCabal.hs index 7d2e99e..0e915b3 100644 --- a/src/Settings/Packages/GhcCabal.hs +++ b/src/Settings/Packages/GhcCabal.hs @@ -11,14 +11,21 @@ ghcCabalPackageArgs = stage0 ? package ghcCabal ? builder Ghc ? do cabalDeps <- expr $ stage1Dependencies cabal cabalVersion <- expr $ pkgVersion (unsafePkgCabalFile cabal) -- TODO: improve mconcat - [ pure [ "-package " ++ pkgName pkg | pkg <- cabalDeps, pkg /= parsec ] + [ pure [ "-package " ++ pkgName pkg | pkg <- cabalDeps \\ [parsec, mtl] ] , arg "--make" , arg "-j" , pure ["-Wall", "-fno-warn-unused-imports", "-fno-warn-warnings-deprecations"] , arg ("-DCABAL_VERSION=" ++ replace "." "," cabalVersion) + , arg "-DCABAL_PARSEC" , arg "-DBOOTSTRAPPING" , arg "-DMIN_VERSION_binary_0_8_0" + , arg "libraries/text/cbits/cbits.c" , arg "-ilibraries/Cabal/Cabal" , arg "-ilibraries/binary/src" , arg "-ilibraries/filepath" - , arg "-ilibraries/hpc" ] + , arg "-ilibraries/hpc" + , arg "-ilibraries/mtl" + , arg "-ilibraries/text" + , arg "-Ilibraries/text/include" + , arg "-ilibraries/parsec" ] + diff --git a/stack.yaml b/stack.yaml index da03763..a1b7413 100644 --- a/stack.yaml +++ b/stack.yaml @@ -7,6 +7,10 @@ resolver: lts-9.0 packages: - '.' - '../libraries/Cabal/Cabal' +- '../libraries/filepath/' +- '../libraries/text/' +- '../libraries/hpc/' +- '../libraries/parsec/' extra-deps: - shake-0.16 From git at git.haskell.org Sun Nov 12 00:06:57 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 12 Nov 2017 00:06:57 +0000 (UTC) Subject: [commit: ghc] wip/circleci-ben: gmp: Pass include directories to Haskell compiler (cbb553e) Message-ID: <20171112000657.813123A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/circleci-ben Link : http://ghc.haskell.org/trac/ghc/changeset/cbb553edfc0033ca86c109694945ab3ad8d6f034/ghc >--------------------------------------------------------------- commit cbb553edfc0033ca86c109694945ab3ad8d6f034 Author: Ben Gamari Date: Thu Oct 12 10:30:31 2017 -0400 gmp: Pass include directories to Haskell compiler Previously the include directories weren't being included in the arguments used to invoke GHC when building the in-tree GMP. This caused the build to fail with missing include files. I considered for a moment using Cabal's `--extra-include-dirs` flag to pass these directories. However, it's important that we Instead of duplicating the include directory logic for the Haskell compiler, I just use Cabal's --extra-include-dirs flag, ensuring that >--------------------------------------------------------------- cbb553edfc0033ca86c109694945ab3ad8d6f034 hadrian/src/Settings/Packages/IntegerGmp.hs | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/hadrian/src/Settings/Packages/IntegerGmp.hs b/hadrian/src/Settings/Packages/IntegerGmp.hs index 7c2b5f6..d584b60 100644 --- a/hadrian/src/Settings/Packages/IntegerGmp.hs +++ b/hadrian/src/Settings/Packages/IntegerGmp.hs @@ -12,13 +12,17 @@ import Rules.Gmp integerGmpPackageArgs :: Args integerGmpPackageArgs = package integerGmp ? do path <- expr gmpBuildPath + topDir <- expr topDirectory let includeGmp = "-I" ++ path -/- "include" gmpIncludeDir <- getSetting GmpIncludeDir gmpLibDir <- getSetting GmpLibDir + let -- are we building an in-tree GMP? + inTreeGmp = null gmpIncludeDir && null gmpLibDir mconcat [ builder Cc ? arg includeGmp , builder GhcCabal ? mconcat - [ (null gmpIncludeDir && null gmpLibDir) ? + [ inTreeGmp ? arg "--configure-option=--with-intree-gmp" , arg ("--configure-option=CFLAGS=" ++ includeGmp) - , arg ("--gcc-options=" ++ includeGmp) ] ] + , arg ("--extra-include-dirs="++ topDir -/- path -/- "include") + ] ] From git at git.haskell.org Sun Nov 12 00:07:00 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 12 Nov 2017 00:07:00 +0000 (UTC) Subject: [commit: ghc] wip/circleci-ben: CircleCI: Perform nightly validation of unregisterised build (cb6dd1b) Message-ID: <20171112000700.535E03A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/circleci-ben Link : http://ghc.haskell.org/trac/ghc/changeset/cb6dd1b84a44500011ad9c338e822d6e1056374a/ghc >--------------------------------------------------------------- commit cb6dd1b84a44500011ad9c338e822d6e1056374a Author: Ben Gamari Date: Sat Nov 11 18:53:56 2017 -0500 CircleCI: Perform nightly validation of unregisterised build >--------------------------------------------------------------- cb6dd1b84a44500011ad9c338e822d6e1056374a .circleci/config.yml | 31 +++++++++++++++++++++++++++++++ 1 file changed, 31 insertions(+) diff --git a/.circleci/config.yml b/.circleci/config.yml index b2e59eb..cf660c0 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -37,6 +37,10 @@ aliases: run: name: Configure command: ./configure --target=x86_64-unknown-freebsd10 + - &configure_unreg + run: + name: Configure + command: ./configure --enable-unregisterised - &make run: name: Build @@ -123,6 +127,22 @@ jobs: - *collectartifacts - *storeartifacts + "validate-x86_64-linux-unreg": + resource_class: xlarge + docker: + - image: haskell:8.2 + environment: + <<: *buildenv + steps: + - *precheckout + - checkout + - *prepare + - *submodules + - *boot + - *configure_unreg + - *make + - *test + workflows: version: 2 validate: @@ -131,3 +151,14 @@ workflows: # FreeBSD disabled: https://github.com/haskell/unix/issues/102 # - validate-x86_64-freebsd - validate-x86_64-darwin + + nightly: + triggers: + - schedule: + cron: "0 0 * * *" + filters: + branches: + only: + - master + jobs: + - validate-x86_64-linux-unreg From git at git.haskell.org Sun Nov 12 00:07:03 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 12 Nov 2017 00:07:03 +0000 (UTC) Subject: [commit: ghc] wip/circleci-ben: CircleCI: Try validating LLVM as well (aab88e6) Message-ID: <20171112000703.5D4343A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/circleci-ben Link : http://ghc.haskell.org/trac/ghc/changeset/aab88e6fba18a04323b04c5d611c61ad8c7704f8/ghc >--------------------------------------------------------------- commit aab88e6fba18a04323b04c5d611c61ad8c7704f8 Author: Ben Gamari Date: Sat Nov 11 19:04:42 2017 -0500 CircleCI: Try validating LLVM as well >--------------------------------------------------------------- aab88e6fba18a04323b04c5d611c61ad8c7704f8 .circleci/config.yml | 31 +++++++++++++++++++++++++++++-- 1 file changed, 29 insertions(+), 2 deletions(-) diff --git a/.circleci/config.yml b/.circleci/config.yml index cf660c0..46ad211 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -143,14 +143,40 @@ jobs: - *make - *test + "validate-x86_64-linux-llvm": + resource_class: xlarge + docker: + - image: haskell:8.2 + environment: + <<: *buildenv + steps: + - run: + name: Install LLVM + command: | + curl http://releases.llvm.org/5.0.0/clang+llvm-5.0.0-x86_64-linux-gnu-debian8.tar.xz | tar -xC .. + # See https://discuss.circleci.com/t/how-to-add-a-path-to-path-in-circle-2-0/11554/3 + echo 'export PATH=`pwd`/clang+llvm-5.0.0-x86_64-linux-gnu-debian8/bin:$PATH' >> ~/.bashrc + - run: + name: Verify that llc works + command: llc + - *precheckout + - checkout + - *prepare + - *submodules + - *boot + - *configure_unreg + - *make + - *test + workflows: version: 2 validate: jobs: - - validate-x86_64-linux + #- validate-x86_64-linux # FreeBSD disabled: https://github.com/haskell/unix/issues/102 # - validate-x86_64-freebsd - - validate-x86_64-darwin + #- validate-x86_64-darwin + - validate-x86_64-linux-llvm nightly: triggers: @@ -162,3 +188,4 @@ workflows: - master jobs: - validate-x86_64-linux-unreg + - validate-x86_64-linux-llvm From git at git.haskell.org Mon Nov 13 02:25:27 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 13 Nov 2017 02:25:27 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: Replace hadrian subtree with submodule (3bc72af) Message-ID: <20171113022527.2854C3A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/3bc72afe48cbe58fc105426a4a3ef268f5e9f959/ghc >--------------------------------------------------------------- commit 3bc72afe48cbe58fc105426a4a3ef268f5e9f959 Author: Moritz Angermann Date: Sun Nov 12 13:27:45 2017 +0800 Replace hadrian subtree with submodule >--------------------------------------------------------------- 3bc72afe48cbe58fc105426a4a3ef268f5e9f959 .gitmodules | 3 + hadrian | 1 + hadrian/.ghci | 11 - hadrian/.gitignore | 26 -- hadrian/.travis.yml | 90 ---- hadrian/LICENSE | 21 - hadrian/README.md | 194 --------- hadrian/appveyor.yml | 39 -- hadrian/build.bat | 6 - hadrian/build.cabal.sh | 74 ---- hadrian/build.global-db.bat | 32 -- hadrian/build.global-db.sh | 52 --- hadrian/build.sh | 35 -- hadrian/build.stack.bat | 11 - hadrian/build.stack.nix.sh | 33 -- hadrian/build.stack.sh | 39 -- hadrian/cabal.project | 9 - hadrian/cfg/system.config.in | 138 ------ hadrian/circle.yml | 41 -- hadrian/doc/cross-compile.md | 57 --- hadrian/doc/flavours.md | 176 -------- hadrian/doc/user-settings.md | 212 --------- hadrian/doc/windows.md | 69 --- hadrian/hadrian.cabal | 152 ------- hadrian/src/Base.hs | 127 ------ hadrian/src/Builder.hs | 341 --------------- hadrian/src/Builder.hs-boot | 42 -- hadrian/src/CommandLine.hs | 137 ------ hadrian/src/Context.hs | 145 ------- hadrian/src/Context/Paths.hs | 40 -- hadrian/src/Environment.hs | 16 - hadrian/src/Expression.hs | 113 ----- hadrian/src/Flavour.hs | 34 -- hadrian/src/GHC.hs | 177 -------- hadrian/src/GHC/Packages.hs | 114 ----- hadrian/src/Hadrian/Builder.hs | 152 ------- hadrian/src/Hadrian/Builder/Ar.hs | 68 --- hadrian/src/Hadrian/Builder/Sphinx.hs | 39 -- hadrian/src/Hadrian/Builder/Tar.hs | 40 -- hadrian/src/Hadrian/Expression.hs | 153 ------- hadrian/src/Hadrian/Haskell/Cabal.hs | 46 -- hadrian/src/Hadrian/Haskell/Cabal/Parse.hs | 291 ------------- hadrian/src/Hadrian/Haskell/Cabal/Parse.hs-boot | 9 - hadrian/src/Hadrian/Oracles/ArgsHash.hs | 51 --- hadrian/src/Hadrian/Oracles/DirectoryContents.hs | 64 --- hadrian/src/Hadrian/Oracles/Path.hs | 62 --- hadrian/src/Hadrian/Oracles/TextFile.hs | 150 ------- hadrian/src/Hadrian/Package.hs | 80 ---- hadrian/src/Hadrian/Target.hs | 29 -- hadrian/src/Hadrian/Utilities.hs | 418 ------------------ hadrian/src/Main.hs | 57 --- hadrian/src/Oracles/Flag.hs | 74 ---- hadrian/src/Oracles/ModuleFiles.hs | 157 ------- hadrian/src/Oracles/PackageData.hs | 64 --- hadrian/src/Oracles/Setting.hs | 236 ---------- hadrian/src/Rules.hs | 143 ------- hadrian/src/Rules/Clean.hs | 23 - hadrian/src/Rules/Compile.hs | 82 ---- hadrian/src/Rules/Configure.hs | 42 -- hadrian/src/Rules/Dependencies.hs | 35 -- hadrian/src/Rules/Documentation.hs | 197 --------- hadrian/src/Rules/Generate.hs | 522 ----------------------- hadrian/src/Rules/Gmp.hs | 122 ------ hadrian/src/Rules/Install.hs | 1 - hadrian/src/Rules/Libffi.hs | 108 ----- hadrian/src/Rules/Library.hs | 140 ------ hadrian/src/Rules/PackageData.hs | 86 ---- hadrian/src/Rules/Program.hs | 138 ------ hadrian/src/Rules/Register.hs | 102 ----- hadrian/src/Rules/Selftest.hs | 92 ---- hadrian/src/Rules/SourceDist.hs | 113 ----- hadrian/src/Rules/Test.hs | 71 --- hadrian/src/Rules/Wrappers.hs | 163 ------- hadrian/src/Settings.hs | 68 --- hadrian/src/Settings/Builders/Alex.hs | 8 - hadrian/src/Settings/Builders/Cc.hs | 27 -- hadrian/src/Settings/Builders/Common.hs | 66 --- hadrian/src/Settings/Builders/Configure.hs | 25 -- hadrian/src/Settings/Builders/DeriveConstants.hs | 39 -- hadrian/src/Settings/Builders/GenPrimopCode.hs | 24 -- hadrian/src/Settings/Builders/Ghc.hs | 154 ------- hadrian/src/Settings/Builders/GhcCabal.hs | 163 ------- hadrian/src/Settings/Builders/GhcPkg.hs | 29 -- hadrian/src/Settings/Builders/Haddock.hs | 64 --- hadrian/src/Settings/Builders/Happy.hs | 9 - hadrian/src/Settings/Builders/HsCpp.hs | 16 - hadrian/src/Settings/Builders/Hsc2Hs.hs | 54 --- hadrian/src/Settings/Builders/Ld.hs | 9 - hadrian/src/Settings/Builders/Make.hs | 16 - hadrian/src/Settings/Builders/Xelatex.hs | 7 - hadrian/src/Settings/Default.hs | 176 -------- hadrian/src/Settings/Default.hs-boot | 20 - hadrian/src/Settings/Flavours/Development.hs | 20 - hadrian/src/Settings/Flavours/Performance.hs | 18 - hadrian/src/Settings/Flavours/Profiled.hs | 19 - hadrian/src/Settings/Flavours/Quick.hs | 22 - hadrian/src/Settings/Flavours/QuickCross.hs | 24 -- hadrian/src/Settings/Flavours/Quickest.hs | 23 - hadrian/src/Settings/Packages/Base.hs | 12 - hadrian/src/Settings/Packages/Cabal.hs | 10 - hadrian/src/Settings/Packages/Compiler.hs | 46 -- hadrian/src/Settings/Packages/Ghc.hs | 13 - hadrian/src/Settings/Packages/GhcCabal.hs | 33 -- hadrian/src/Settings/Packages/GhcPkg.hs | 7 - hadrian/src/Settings/Packages/GhcPrim.hs | 12 - hadrian/src/Settings/Packages/Ghci.hs | 6 - hadrian/src/Settings/Packages/Haddock.hs | 7 - hadrian/src/Settings/Packages/Haskeline.hs | 8 - hadrian/src/Settings/Packages/IntegerGmp.hs | 25 -- hadrian/src/Settings/Packages/Rts.hs | 215 ---------- hadrian/src/Settings/Packages/RunGhc.hs | 9 - hadrian/src/Settings/Warnings.hs | 93 ---- hadrian/src/Stage.hs | 7 - hadrian/src/Target.hs | 26 -- hadrian/src/Types/Cabal.hs | 24 -- hadrian/src/Types/ConfiguredCabal.hs | 54 --- hadrian/src/Types/Context.hs | 21 - hadrian/src/Types/Expression.hs | 18 - hadrian/src/Types/Package.hs | 46 -- hadrian/src/Types/Stage.hs | 28 -- hadrian/src/Types/Way.hs | 112 ----- hadrian/src/UserSettings.hs | 64 --- hadrian/src/Utilities.hs | 85 ---- hadrian/src/Way.hs | 52 --- hadrian/stack.yaml | 22 - 125 files changed, 4 insertions(+), 9378 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 3bc72afe48cbe58fc105426a4a3ef268f5e9f959 From git at git.haskell.org Mon Nov 13 02:25:29 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 13 Nov 2017 02:25:29 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: [rts] ignore generated rts.cabal (eae1fba) Message-ID: <20171113022529.DE9403A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/eae1fba11ce33653129d0a17e6e99f3b6f87eb6d/ghc >--------------------------------------------------------------- commit eae1fba11ce33653129d0a17e6e99f3b6f87eb6d Author: Moritz Angermann Date: Sun Nov 12 13:28:46 2017 +0800 [rts] ignore generated rts.cabal >--------------------------------------------------------------- eae1fba11ce33653129d0a17e6e99f3b6f87eb6d .gitignore | 1 + 1 file changed, 1 insertion(+) diff --git a/.gitignore b/.gitignore index 245b2a5..7115798 100644 --- a/.gitignore +++ b/.gitignore @@ -166,6 +166,7 @@ _darcs/ /mk/project.mk /mk/project.mk.old /mk/validate.mk +/rts/rts.cabal /rts/package.conf.inplace /rts/package.conf.inplace.raw /rts/package.conf.install From git at git.haskell.org Mon Nov 13 02:25:32 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 13 Nov 2017 02:25:32 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: bump sumodules (98c21a4) Message-ID: <20171113022532.A02303A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/98c21a43d324b90aa4355b6e5749dd30da019d28/ghc >--------------------------------------------------------------- commit 98c21a43d324b90aa4355b6e5749dd30da019d28 Author: Moritz Angermann Date: Mon Nov 13 10:25:02 2017 +0800 bump sumodules >--------------------------------------------------------------- 98c21a43d324b90aa4355b6e5749dd30da019d28 hadrian | 2 +- libraries/Cabal | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/hadrian b/hadrian index 610351a..1e9fd7c 160000 --- a/hadrian +++ b/hadrian @@ -1 +1 @@ -Subproject commit 610351a3612c66fbeaab09fd55891fde38b00d19 +Subproject commit 1e9fd7c2e2c31a30b05f6e5499256d87cbd3892f diff --git a/libraries/Cabal b/libraries/Cabal index 980e253..7a1b873 160000 --- a/libraries/Cabal +++ b/libraries/Cabal @@ -1 +1 @@ -Subproject commit 980e253e8a1024455061cd1f333e9e288543e3f3 +Subproject commit 7a1b873a18252d481bbbdaf58a56fc55bc695cf4 From git at git.haskell.org Mon Nov 13 07:42:26 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 13 Nov 2017 07:42:26 +0000 (UTC) Subject: [commit: ghc] branch 'wip/ttg3-2017-11-12' created Message-ID: <20171113074226.9A4B63A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/ttg3-2017-11-12 Referencing: 56bd9bfc1c81cc304a00221be5bb91344f662a78 From git at git.haskell.org Mon Nov 13 07:42:30 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 13 Nov 2017 07:42:30 +0000 (UTC) Subject: [commit: ghc] wip/ttg3-2017-11-12: Combined Step 1 and 3 for Trees That Grow, HsExpr #2 (56bd9bf) Message-ID: <20171113074230.56B7A3A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttg3-2017-11-12 Link : http://ghc.haskell.org/trac/ghc/changeset/56bd9bfc1c81cc304a00221be5bb91344f662a78/ghc >--------------------------------------------------------------- commit 56bd9bfc1c81cc304a00221be5bb91344f662a78 Author: Alan Zimmerman Date: Sun Nov 12 21:56:16 2017 +0200 Combined Step 1 and 3 for Trees That Grow, HsExpr #2 Further progress on implementing Trees that Grow on hsSyn AST. See https://ghc.haskell.org/trac/ghc/wiki/ImplementingTreesThatGrow Trees that grow extension points are added for - Rest of HsExpr.hs Updates haddock submodule >--------------------------------------------------------------- 56bd9bfc1c81cc304a00221be5bb91344f662a78 compiler/deSugar/Coverage.hs | 59 +++--- compiler/deSugar/DsArrows.hs | 33 ++-- compiler/deSugar/DsExpr.hs | 3 +- compiler/deSugar/DsListComp.hs | 20 +- compiler/deSugar/DsMeta.hs | 33 ++-- compiler/deSugar/Match.hs | 4 +- compiler/deSugar/PmExpr.hs | 2 +- compiler/hsSyn/Convert.hs | 17 +- compiler/hsSyn/HsBinds.hs | 36 +--- compiler/hsSyn/HsDecls.hs | 6 +- compiler/hsSyn/HsExpr.hs | 233 ++++++++++++++++------- compiler/hsSyn/HsExtension.hs | 129 ++++++++++++- compiler/hsSyn/HsPat.hs | 2 +- compiler/hsSyn/HsTypes.hs | 14 +- compiler/hsSyn/HsUtils.hs | 46 ++--- compiler/hsSyn/PlaceHolder.hs | 10 +- compiler/parser/Parser.y | 34 ++-- compiler/parser/RdrHsSyn.hs | 30 +-- compiler/rename/RnExpr.hs | 85 +++++---- compiler/rename/RnPat.hs | 6 +- compiler/rename/RnSplice.hs | 67 ++++--- compiler/rename/RnTypes.hs | 15 +- compiler/typecheck/TcArrows.hs | 53 +++--- compiler/typecheck/TcExpr.hs | 7 +- compiler/typecheck/TcHsSyn.hs | 61 +++--- compiler/typecheck/TcHsType.hs | 4 +- compiler/typecheck/TcMatches.hs | 11 +- compiler/typecheck/TcPat.hs | 2 +- compiler/typecheck/TcPatSyn.hs | 8 +- compiler/typecheck/TcRnDriver.hs | 2 +- compiler/typecheck/TcSplice.hs | 20 +- compiler/typecheck/TcTyDecls.hs | 2 +- testsuite/tests/ghc-api/annotations/parseTree.hs | 4 +- testsuite/tests/perf/haddock/all.T | 5 +- 34 files changed, 640 insertions(+), 423 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 56bd9bfc1c81cc304a00221be5bb91344f662a78 From git at git.haskell.org Mon Nov 13 20:56:10 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 13 Nov 2017 20:56:10 +0000 (UTC) Subject: [commit: ghc] branch 'wip/D4170' created Message-ID: <20171113205610.CA3753A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/D4170 Referencing: 667deafa5b13593eb91239856a5f0b8db2ca4d19 From git at git.haskell.org Mon Nov 13 20:56:13 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 13 Nov 2017 20:56:13 +0000 (UTC) Subject: [commit: ghc] wip/D4170: Store ModIface exports in an array (667deaf) Message-ID: <20171113205613.9F0663A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/D4170 Link : http://ghc.haskell.org/trac/ghc/changeset/667deafa5b13593eb91239856a5f0b8db2ca4d19/ghc >--------------------------------------------------------------- commit 667deafa5b13593eb91239856a5f0b8db2ca4d19 Author: Douglas Wilson Date: Mon Nov 13 09:16:01 2017 +1300 Store ModIface exports in an array Summary: To lessen cascading changes, the old field name mi_exports (returning a list) is exported as an accessor function and the field is replaced with mi_exports_arr. There are many more lists that would likely benefit from the same treatment, but one thing at a time. Test Plan: Check gipedia Reviewers: bgamari Subscribers: rwbarton, thomie Differential Revision: https://phabricator.haskell.org/D4170 >--------------------------------------------------------------- 667deafa5b13593eb91239856a5f0b8db2ca4d19 compiler/backpack/RnModIface.hs | 4 ++-- compiler/iface/LoadIface.hs | 2 +- compiler/iface/MkIface.hs | 5 ++++- compiler/main/HscTypes.hs | 16 ++++++++++------ compiler/prelude/PrelInfo.hs | 8 ++++---- compiler/typecheck/TcBackpack.hs | 3 ++- compiler/utils/Binary.hs | 23 +++++++++++++++++++++++ 7 files changed, 46 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 667deafa5b13593eb91239856a5f0b8db2ca4d19 From git at git.haskell.org Mon Nov 13 21:06:32 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 13 Nov 2017 21:06:32 +0000 (UTC) Subject: [commit: ghc] branch 'wip/ttg4-constraints-2017-11-13' created Message-ID: <20171113210632.39ED13A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/ttg4-constraints-2017-11-13 Referencing: 65f4bf3e2930c07982b7267cf7fc7adf16277432 From git at git.haskell.org Mon Nov 13 21:06:38 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 13 Nov 2017 21:06:38 +0000 (UTC) Subject: [commit: ghc] wip/ttg4-constraints-2017-11-13: Remove HasSourceText and SourceTextX classes (65f4bf3) Message-ID: <20171113210638.0614E3A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttg4-constraints-2017-11-13 Link : http://ghc.haskell.org/trac/ghc/changeset/65f4bf3e2930c07982b7267cf7fc7adf16277432/ghc >--------------------------------------------------------------- commit 65f4bf3e2930c07982b7267cf7fc7adf16277432 Author: Alan Zimmerman Date: Mon Nov 13 21:37:14 2017 +0200 Remove HasSourceText and SourceTextX classes >--------------------------------------------------------------- 65f4bf3e2930c07982b7267cf7fc7adf16277432 compiler/deSugar/DsMeta.hs | 6 +- compiler/hsSyn/HsBinds.hs | 32 +++------ compiler/hsSyn/HsDecls.hs | 65 ++++++++--------- compiler/hsSyn/HsExpr.hs | 139 +++++++++++++----------------------- compiler/hsSyn/HsExpr.hs-boot | 26 +++---- compiler/hsSyn/HsExtension.hs | 51 ------------- compiler/hsSyn/HsLit.hs | 37 ++++------ compiler/hsSyn/HsPat.hs | 25 +++---- compiler/hsSyn/HsPat.hs-boot | 5 +- compiler/hsSyn/HsSyn.hs | 2 +- compiler/hsSyn/HsTypes.hs | 44 +++++------- compiler/hsSyn/HsUtils.hs | 38 ++++------ compiler/parser/Parser.y | 25 +++---- compiler/typecheck/Inst.hs | 5 +- compiler/typecheck/TcAnnotations.hs | 3 +- compiler/typecheck/TcBinds.hs | 3 +- compiler/typecheck/TcEnv.hs | 4 +- compiler/typecheck/TcInstDcls.hs | 2 +- compiler/typecheck/TcPatSyn.hs | 5 +- compiler/typecheck/TcTypeable.hs | 8 +-- utils/haddock | 2 +- 21 files changed, 189 insertions(+), 338 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 65f4bf3e2930c07982b7267cf7fc7adf16277432 From git at git.haskell.org Mon Nov 13 21:06:35 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 13 Nov 2017 21:06:35 +0000 (UTC) Subject: [commit: ghc] wip/ttg4-constraints-2017-11-13: TTG3 Combined Step 1 and 3 for Trees That Grow (548c739) Message-ID: <20171113210635.2C89F3A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttg4-constraints-2017-11-13 Link : http://ghc.haskell.org/trac/ghc/changeset/548c739e3d45c7aa2ed23cb78121afdb2fdfb7e3/ghc >--------------------------------------------------------------- commit 548c739e3d45c7aa2ed23cb78121afdb2fdfb7e3 Author: Alan Zimmerman Date: Sun Nov 12 21:56:16 2017 +0200 TTG3 Combined Step 1 and 3 for Trees That Grow Summary: Further progress on implementing Trees that Grow on hsSyn AST. See https://ghc.haskell.org/trac/ghc/wiki/ImplementingTreesThatGrow Trees that grow extension points are added for - Rest of HsExpr.hs Updates haddock submodule Test Plan: ./validate Reviewers: bgamari, shayan-najd, goldfire Subscribers: goldfire, rwbarton, thomie, mpickering Differential Revision: https://phabricator.haskell.org/D4186 >--------------------------------------------------------------- 548c739e3d45c7aa2ed23cb78121afdb2fdfb7e3 compiler/deSugar/Coverage.hs | 59 +++--- compiler/deSugar/DsArrows.hs | 33 ++-- compiler/deSugar/DsExpr.hs | 3 +- compiler/deSugar/DsListComp.hs | 20 +- compiler/deSugar/DsMeta.hs | 33 ++-- compiler/deSugar/Match.hs | 4 +- compiler/deSugar/PmExpr.hs | 2 +- compiler/hsSyn/Convert.hs | 17 +- compiler/hsSyn/HsBinds.hs | 36 +--- compiler/hsSyn/HsDecls.hs | 6 +- compiler/hsSyn/HsExpr.hs | 233 ++++++++++++++++------- compiler/hsSyn/HsExtension.hs | 129 ++++++++++++- compiler/hsSyn/HsPat.hs | 2 +- compiler/hsSyn/HsTypes.hs | 14 +- compiler/hsSyn/HsUtils.hs | 46 ++--- compiler/hsSyn/PlaceHolder.hs | 10 +- compiler/parser/Parser.y | 34 ++-- compiler/parser/RdrHsSyn.hs | 30 +-- compiler/rename/RnExpr.hs | 85 +++++---- compiler/rename/RnPat.hs | 6 +- compiler/rename/RnSplice.hs | 67 ++++--- compiler/rename/RnTypes.hs | 15 +- compiler/typecheck/TcArrows.hs | 53 +++--- compiler/typecheck/TcExpr.hs | 7 +- compiler/typecheck/TcHsSyn.hs | 61 +++--- compiler/typecheck/TcHsType.hs | 4 +- compiler/typecheck/TcMatches.hs | 11 +- compiler/typecheck/TcPat.hs | 2 +- compiler/typecheck/TcPatSyn.hs | 8 +- compiler/typecheck/TcRnDriver.hs | 2 +- compiler/typecheck/TcSplice.hs | 20 +- compiler/typecheck/TcTyDecls.hs | 2 +- testsuite/tests/ghc-api/annotations/parseTree.hs | 4 +- testsuite/tests/perf/haddock/all.T | 5 +- utils/haddock | 2 +- 35 files changed, 641 insertions(+), 424 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 548c739e3d45c7aa2ed23cb78121afdb2fdfb7e3 From git at git.haskell.org Tue Nov 14 11:12:59 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 14 Nov 2017 11:12:59 +0000 (UTC) Subject: [commit: ghc] master: A bit more tc-tracing (f570000) Message-ID: <20171114111259.4639A3A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f57000014e5c27822c9c618204a7b3fe0cb0f158/ghc >--------------------------------------------------------------- commit f57000014e5c27822c9c618204a7b3fe0cb0f158 Author: Simon Peyton Jones Date: Tue Nov 14 09:21:39 2017 +0000 A bit more tc-tracing >--------------------------------------------------------------- f57000014e5c27822c9c618204a7b3fe0cb0f158 compiler/typecheck/TcHsType.hs | 4 +++- compiler/typecheck/TcType.hs | 5 ++++- 2 files changed, 7 insertions(+), 2 deletions(-) diff --git a/compiler/typecheck/TcHsType.hs b/compiler/typecheck/TcHsType.hs index 19fd5c1..07cd4d2 100644 --- a/compiler/typecheck/TcHsType.hs +++ b/compiler/typecheck/TcHsType.hs @@ -1451,7 +1451,9 @@ kcHsTyVarBndrs name flav cusk all_kind_vars tycon = mkTcTyCon name binders res_kind (scoped_kvs ++ binderVars binders) flav - ; traceTc "kcHsTyVarBndrs: not-cusk" (ppr name <+> ppr binders) + ; traceTc "kcHsTyVarBndrs: not-cusk" $ + vcat [ ppr name, ppr kv_ns, ppr hs_tvs, ppr dep_names + , ppr binders, ppr (mkTyConKind binders res_kind) ] ; return (tycon, stuff) } where open_fam = tcFlavourIsOpen flav diff --git a/compiler/typecheck/TcType.hs b/compiler/typecheck/TcType.hs index d781aec..f1ea864 100644 --- a/compiler/typecheck/TcType.hs +++ b/compiler/typecheck/TcType.hs @@ -1634,7 +1634,10 @@ tcGetTyVar_maybe (TyVarTy tv) = Just tv tcGetTyVar_maybe _ = Nothing tcGetTyVar :: String -> Type -> TyVar -tcGetTyVar msg ty = expectJust msg (tcGetTyVar_maybe ty) +tcGetTyVar msg ty + = case tcGetTyVar_maybe ty of + Just tv -> tv + Nothing -> pprPanic msg (ppr ty) tcIsTyVarTy :: Type -> Bool tcIsTyVarTy ty | Just ty' <- tcView ty = tcIsTyVarTy ty' From git at git.haskell.org Tue Nov 14 11:12:56 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 14 Nov 2017 11:12:56 +0000 (UTC) Subject: [commit: ghc] master: Fix a TyVar bug in the flattener (0a85190) Message-ID: <20171114111256.7F4F73A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/0a85190312a1de3d300912051309b94589c08683/ghc >--------------------------------------------------------------- commit 0a85190312a1de3d300912051309b94589c08683 Author: Simon Peyton Jones Date: Tue Nov 14 09:16:22 2017 +0000 Fix a TyVar bug in the flattener A year ago I gave up on trying to rigorously separate TyVars from TcTyVars, and instead allowed TyVars to appear rather more freely in types examined by the constraint solver: commit 18d0bdd3848201882bae167e3b15fd797d217e93 Author: Simon Peyton Jones Date: Wed Nov 23 16:00:00 2016 +0000 Allow TyVars in TcTypes See Note [TcTyVars in the typechecker] in TcType. However, TcFlatten.flatten_tyvar1 turned out to treat a TyVar specially, and implicitly assumed that it could not have an equality constraint in the inert set. Wrong! This caused Trac #14450. Fortunately it is easily fixed, by deleting code. >--------------------------------------------------------------- 0a85190312a1de3d300912051309b94589c08683 compiler/typecheck/TcFlatten.hs | 7 +------ compiler/typecheck/TcType.hs | 4 ++++ compiler/typecheck/TcUnify.hs | 2 +- testsuite/tests/polykinds/T14450.hs | 31 +++++++++++++++++++++++++++++++ testsuite/tests/polykinds/T14450.stderr | 8 ++++++++ testsuite/tests/polykinds/all.T | 1 + 6 files changed, 46 insertions(+), 7 deletions(-) diff --git a/compiler/typecheck/TcFlatten.hs b/compiler/typecheck/TcFlatten.hs index 3c44cde..c8479a6 100644 --- a/compiler/typecheck/TcFlatten.hs +++ b/compiler/typecheck/TcFlatten.hs @@ -1371,15 +1371,10 @@ flatten_tyvar1 :: TcTyVar -> FlatM FlattenTvResult -- See also the documentation for FlattenTvResult flatten_tyvar1 tv - | not (isTcTyVar tv) -- Happens when flatten under a (forall a. ty) - = return FTRNotFollowed - -- So ty contains references to the non-TcTyVar a - - | otherwise = do { mb_ty <- liftTcS $ isFilledMetaTyVar_maybe tv - ; role <- getRole ; case mb_ty of Just ty -> do { traceFlat "Following filled tyvar" (ppr tv <+> equals <+> ppr ty) + ; role <- getRole ; return (FTRFollowed ty (mkReflCo role ty)) } ; Nothing -> do { traceFlat "Unfilled tyvar" (ppr tv) ; fr <- getFlavourRole diff --git a/compiler/typecheck/TcType.hs b/compiler/typecheck/TcType.hs index 5e1e4be..d781aec 100644 --- a/compiler/typecheck/TcType.hs +++ b/compiler/typecheck/TcType.hs @@ -294,6 +294,10 @@ reasons: solve any kind equalities in foo's signature. So the solver may see free occurrences of 'k'. + See calls to tcExtendTyVarEnv for other places that ordinary + TyVars are bought into scope, and hence may show up in the types + and inds generated by TcHsType. + It's convenient to simply treat these TyVars as skolem constants, which of course they are. So diff --git a/compiler/typecheck/TcUnify.hs b/compiler/typecheck/TcUnify.hs index 926db6e..0b2151b 100644 --- a/compiler/typecheck/TcUnify.hs +++ b/compiler/typecheck/TcUnify.hs @@ -1814,7 +1814,7 @@ matchExpectedFunKind hs_ty = go go k | Just k' <- tcView k = go k' go k@(TyVarTy kvar) - | isTcTyVar kvar, isMetaTyVar kvar + | isMetaTyVar kvar = do { maybe_kind <- readMetaTyVar kvar ; case maybe_kind of Indirect fun_kind -> go fun_kind diff --git a/testsuite/tests/polykinds/T14450.hs b/testsuite/tests/polykinds/T14450.hs new file mode 100644 index 0000000..3b8f5b7 --- /dev/null +++ b/testsuite/tests/polykinds/T14450.hs @@ -0,0 +1,31 @@ +{-# Language KindSignatures, TypeOperators, PolyKinds, TypeOperators, ConstraintKinds, TypeFamilies, DataKinds, TypeInType, GADTs, AllowAmbiguousTypes, InstanceSigs #-} + +module T14450 where + +import Data.Kind + +data TyFun :: Type -> Type -> Type + +type a ~> b = TyFun a b -> Type + +type Cat ob = ob -> ob -> Type + +type SameKind (a :: k) (b :: k) = (() :: Constraint) + +type family Apply (f :: a ~> b) (x :: a) :: b where + Apply IddSym0 x = Idd x + +class Varpi (f :: i ~> j) where + type Dom (f :: i ~> j) :: Cat i + type Cod (f :: i ~> j) :: Cat j + + varpa :: Dom f a a' -> Cod f (Apply f a) (Apply f a') + +type family Idd (a::k) :: k where + Idd (a::k) = a + +data IddSym0 :: k ~> k where + IddSym0KindInference :: IddSym0 l + +instance Varpi (IddSym0 :: k ~> k) where + type Dom (IddSym0 :: Type ~> Type) = (->) diff --git a/testsuite/tests/polykinds/T14450.stderr b/testsuite/tests/polykinds/T14450.stderr new file mode 100644 index 0000000..c7caf04 --- /dev/null +++ b/testsuite/tests/polykinds/T14450.stderr @@ -0,0 +1,8 @@ + +T14450.hs:31:12: error: + • Expected kind ‘k ~> k’, + but ‘(IddSym0 :: Type ~> Type)’ has kind ‘* ~> *’ + • In the first argument of ‘Dom’, namely + ‘(IddSym0 :: Type ~> Type)’ + In the type instance declaration for ‘Dom’ + In the instance declaration for ‘Varpi (IddSym0 :: k ~> k)’ diff --git a/testsuite/tests/polykinds/all.T b/testsuite/tests/polykinds/all.T index 66bd9b1..73408e8 100644 --- a/testsuite/tests/polykinds/all.T +++ b/testsuite/tests/polykinds/all.T @@ -173,3 +173,4 @@ test('T14265', normal, compile_fail, ['']) test('T13391', normal, compile_fail, ['']) test('T13391a', normal, compile, ['']) test('T14270', normal, compile, ['']) +test('T14450', normal, compile_fail, ['']) From git at git.haskell.org Tue Nov 14 14:26:20 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 14 Nov 2017 14:26:20 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: Allow the rts lib to be called rts-1.0 (023bcda) Message-ID: <20171114142620.808603A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/023bcdaf8e08aad45bf17db780a91b091ebeab4b/ghc >--------------------------------------------------------------- commit 023bcdaf8e08aad45bf17db780a91b091ebeab4b Author: Moritz Angermann Date: Mon Nov 13 17:39:19 2017 +0800 Allow the rts lib to be called rts-1.0 Summary: When using the `rts.cabal` file the rts lirbary ends up being `rts-1.0` instead of `rts`. As sucht it's called `libHSrts-1.0` instead of `libHSrts`. A fun consequence of this is, that when asking ghc to link a `-treaded` program, it fails to mutate the `rts` lib selection into the threaded variant. Reviewers: bgamari, simonmar Subscribers: rwbarton, thomie Differential Revision: https://phabricator.haskell.org/D4187 # Conflicts: # hadrian >--------------------------------------------------------------- 023bcdaf8e08aad45bf17db780a91b091ebeab4b compiler/main/Packages.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/compiler/main/Packages.hs b/compiler/main/Packages.hs index 949cc0f..6effbab 100644 --- a/compiler/main/Packages.hs +++ b/compiler/main/Packages.hs @@ -1730,6 +1730,7 @@ packageHsLibs dflags p = map (mkDynName . addSuffix) (hsLibraries p) = panic ("Don't understand library name " ++ x) addSuffix rts@"HSrts" = rts ++ (expandTag rts_tag) + addSuffix rts@"HSrts-1.0"= rts ++ (expandTag rts_tag) addSuffix other_lib = other_lib ++ (expandTag tag) expandTag t | null t = "" From git at git.haskell.org Tue Nov 14 14:26:26 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 14 Nov 2017 14:26:26 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: bump hsc2hs (3335ad1) Message-ID: <20171114142626.2DF293A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/3335ad17e4cb95c976d5a6827abf7f0f357b241d/ghc >--------------------------------------------------------------- commit 3335ad17e4cb95c976d5a6827abf7f0f357b241d Author: Moritz Angermann Date: Tue Nov 14 14:20:04 2017 +0800 bump hsc2hs >--------------------------------------------------------------- 3335ad17e4cb95c976d5a6827abf7f0f357b241d utils/hsc2hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/utils/hsc2hs b/utils/hsc2hs index 936b088..37b439b 160000 --- a/utils/hsc2hs +++ b/utils/hsc2hs @@ -1 +1 @@ -Subproject commit 936b0885ee794db83dc8473e17e153936e56d62f +Subproject commit 37b439bf945334d50d85b523868041d83d17a10c From git at git.haskell.org Tue Nov 14 14:26:29 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 14 Nov 2017 14:26:29 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: Cabalify all the things (bebe112) Message-ID: <20171114142629.A4FD03A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/bebe1126754ebef0b80829af4b6c3adaa6303671/ghc >--------------------------------------------------------------- commit bebe1126754ebef0b80829af4b6c3adaa6303671 Author: Moritz Angermann Date: Tue Nov 14 14:25:23 2017 +0800 Cabalify all the things Summary: Adding caba files to `unlit`, `touchy` and `hp2ps`, allows us to treat them uniformally across the build system. Reviewers: bgamari Subscribers: rwbarton, thomie Differential Revision: https://phabricator.haskell.org/D4192 # Conflicts: # hadrian >--------------------------------------------------------------- bebe1126754ebef0b80829af4b6c3adaa6303671 utils/hp2ps/hp2ps.cabal | 22 ++++++++++++++++++++++ utils/touchy/touchy.cabal | 16 ++++++++++++++++ utils/unlit/unlit.cabal | 16 ++++++++++++++++ 3 files changed, 54 insertions(+) diff --git a/utils/hp2ps/hp2ps.cabal b/utils/hp2ps/hp2ps.cabal new file mode 100644 index 0000000..ba5db04 --- /dev/null +++ b/utils/hp2ps/hp2ps.cabal @@ -0,0 +1,22 @@ +cabal-version: >=2.1 +Name: hp2ps +Version: 0.1 +Copyright: XXX +License: BSD3 +Author: XXX +Maintainer: XXX +Synopsis: Heap Profile to PostScript converter +Description: XXX +Category: Development +build-type: Simple + +Executable unlit + Default-Language: Haskell2010 + Main-Is: Main.c + extra-libraries: m + C-Sources: + AreaBelow.c Curves.c Error.c Main.c + Reorder.c TopTwenty.c AuxFile.c Deviation.c + HpFile.c Marks.c Scale.c TraceElement.c + Axes.c Dimensions.c Key.c PsFile.c Shade.c + Utilities.c diff --git a/utils/touchy/touchy.cabal b/utils/touchy/touchy.cabal new file mode 100644 index 0000000..ab025e4 --- /dev/null +++ b/utils/touchy/touchy.cabal @@ -0,0 +1,16 @@ +cabal-version: >=2.1 +Name: touchy +Version: 0.1 +Copyright: XXX +License: BSD3 +Author: XXX +Maintainer: XXX +Synopsis: @touch@ for windows +Description: XXX +Category: Development +build-type: Simple + +Executable unlit + Default-Language: Haskell2010 + Main-Is: touchy.c + C-Sources: touchy.c diff --git a/utils/unlit/unlit.cabal b/utils/unlit/unlit.cabal new file mode 100644 index 0000000..e15a075 --- /dev/null +++ b/utils/unlit/unlit.cabal @@ -0,0 +1,16 @@ +cabal-version: >=2.1 +Name: unlit +Version: 0.1 +Copyright: XXX +License: BSD3 +Author: XXX +Maintainer: XXX +Synopsis: Literate program filter +Description: XXX +Category: Development +build-type: Simple + +Executable unlit + Default-Language: Haskell2010 + Main-Is: unlit.c + C-Sources: unlit.c From git at git.haskell.org Tue Nov 14 14:26:23 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 14 Nov 2017 14:26:23 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: Adds comments. (5b4e192) Message-ID: <20171114142623.5E45C3A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/5b4e19240e44eac2293355a08ac9019327da7661/ghc >--------------------------------------------------------------- commit 5b4e19240e44eac2293355a08ac9019327da7661 Author: Moritz Angermann Date: Tue Nov 14 09:41:11 2017 +0800 Adds comments. # Conflicts: # hadrian >--------------------------------------------------------------- 5b4e19240e44eac2293355a08ac9019327da7661 compiler/main/Packages.hs | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/compiler/main/Packages.hs b/compiler/main/Packages.hs index 6effbab..c49581b 100644 --- a/compiler/main/Packages.hs +++ b/compiler/main/Packages.hs @@ -1729,6 +1729,17 @@ packageHsLibs dflags p = map (mkDynName . addSuffix) (hsLibraries p) | otherwise = panic ("Don't understand library name " ++ x) + -- Add _thr and other rts suffixes to packages named + -- `rts` or `rts-1.0`. Why both? Traditionally the rts + -- package is called `rts` only. However the tooling + -- usually expects a package name to have a version. + -- As such we will gradually move towards the `rts-1.0` + -- package name, at which point the `rts` package name + -- will eventually be unused. + -- + -- This change elevates the need to add custom hooks + -- and handling specifically for the `rts` package for + -- example in ghc-cabal. addSuffix rts@"HSrts" = rts ++ (expandTag rts_tag) addSuffix rts@"HSrts-1.0"= rts ++ (expandTag rts_tag) addSuffix other_lib = other_lib ++ (expandTag tag) From git at git.haskell.org Tue Nov 14 14:26:32 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 14 Nov 2017 14:26:32 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: bump hadrian (77aff2b) Message-ID: <20171114142632.6B2C23A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/77aff2b0e03874554c50cab94e7dbf66c897d7d0/ghc >--------------------------------------------------------------- commit 77aff2b0e03874554c50cab94e7dbf66c897d7d0 Author: Moritz Angermann Date: Tue Nov 14 15:12:12 2017 +0800 bump hadrian >--------------------------------------------------------------- 77aff2b0e03874554c50cab94e7dbf66c897d7d0 hadrian | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/hadrian b/hadrian index 1e9fd7c..6633cb7 160000 --- a/hadrian +++ b/hadrian @@ -1 +1 @@ -Subproject commit 1e9fd7c2e2c31a30b05f6e5499256d87cbd3892f +Subproject commit 6633cb7bfa403776c3d79784f2070d80ca74734c From git at git.haskell.org Tue Nov 14 14:26:35 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 14 Nov 2017 14:26:35 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: bump (3c72083) Message-ID: <20171114142635.5D7963A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/3c72083df72cf764e66973d6201e645cd7fbb92b/ghc >--------------------------------------------------------------- commit 3c72083df72cf764e66973d6201e645cd7fbb92b Author: Moritz Angermann Date: Tue Nov 14 17:41:12 2017 +0800 bump >--------------------------------------------------------------- 3c72083df72cf764e66973d6201e645cd7fbb92b utils/hsc2hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/utils/hsc2hs b/utils/hsc2hs index 37b439b..d578ac5 160000 --- a/utils/hsc2hs +++ b/utils/hsc2hs @@ -1 +1 @@ -Subproject commit 37b439bf945334d50d85b523868041d83d17a10c +Subproject commit d578ac5c5083561507607dc738640fb912b58c7c From git at git.haskell.org Tue Nov 14 14:26:38 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 14 Nov 2017 14:26:38 +0000 (UTC) Subject: [commit: ghc] wip/angerman/llvmng: bump (ebc8237) Message-ID: <20171114142638.222573A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/angerman/llvmng Link : http://ghc.haskell.org/trac/ghc/changeset/ebc8237d2e9adda0ff4a59ec64b3155418f899cf/ghc >--------------------------------------------------------------- commit ebc8237d2e9adda0ff4a59ec64b3155418f899cf Author: Moritz Angermann Date: Tue Nov 14 22:26:04 2017 +0800 bump >--------------------------------------------------------------- ebc8237d2e9adda0ff4a59ec64b3155418f899cf hadrian | 2 +- utils/hsc2hs | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/hadrian b/hadrian index 6633cb7..c14cf2c 160000 --- a/hadrian +++ b/hadrian @@ -1 +1 @@ -Subproject commit 6633cb7bfa403776c3d79784f2070d80ca74734c +Subproject commit c14cf2cc9953b39803d9db21c6d4832255463583 diff --git a/utils/hsc2hs b/utils/hsc2hs index d578ac5..2a759cb 160000 --- a/utils/hsc2hs +++ b/utils/hsc2hs @@ -1 +1 @@ -Subproject commit d578ac5c5083561507607dc738640fb912b58c7c +Subproject commit 2a759cb365e9a223ea94f900b91bde757469a7ae From git at git.haskell.org Tue Nov 14 21:55:09 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 14 Nov 2017 21:55:09 +0000 (UTC) Subject: [commit: ghc] master: TTG3 Combined Step 1 and 3 for Trees That Grow (47ad657) Message-ID: <20171114215509.D73053A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/47ad6578ea460999b53eb4293c3a3b3017a56d65/ghc >--------------------------------------------------------------- commit 47ad6578ea460999b53eb4293c3a3b3017a56d65 Author: Alan Zimmerman Date: Sun Nov 12 21:56:16 2017 +0200 TTG3 Combined Step 1 and 3 for Trees That Grow Further progress on implementing Trees that Grow on hsSyn AST. See https://ghc.haskell.org/trac/ghc/wiki/ImplementingTreesThatGrow Trees that grow extension points are added for - Rest of HsExpr.hs Updates haddock submodule Test Plan: ./validate Reviewers: bgamari, shayan-najd, goldfire Subscribers: goldfire, rwbarton, thomie, mpickering Differential Revision: https://phabricator.haskell.org/D4186 >--------------------------------------------------------------- 47ad6578ea460999b53eb4293c3a3b3017a56d65 compiler/deSugar/Coverage.hs | 59 +++--- compiler/deSugar/DsArrows.hs | 33 ++-- compiler/deSugar/DsExpr.hs | 3 +- compiler/deSugar/DsListComp.hs | 20 +- compiler/deSugar/DsMeta.hs | 33 ++-- compiler/deSugar/Match.hs | 4 +- compiler/deSugar/PmExpr.hs | 2 +- compiler/hsSyn/Convert.hs | 17 +- compiler/hsSyn/HsBinds.hs | 36 +--- compiler/hsSyn/HsDecls.hs | 6 +- compiler/hsSyn/HsExpr.hs | 233 ++++++++++++++++------- compiler/hsSyn/HsExtension.hs | 129 ++++++++++++- compiler/hsSyn/HsPat.hs | 2 +- compiler/hsSyn/HsTypes.hs | 14 +- compiler/hsSyn/HsUtils.hs | 46 ++--- compiler/hsSyn/PlaceHolder.hs | 10 +- compiler/parser/Parser.y | 34 ++-- compiler/parser/RdrHsSyn.hs | 30 +-- compiler/rename/RnExpr.hs | 85 +++++---- compiler/rename/RnPat.hs | 6 +- compiler/rename/RnSplice.hs | 67 ++++--- compiler/rename/RnTypes.hs | 15 +- compiler/typecheck/TcArrows.hs | 53 +++--- compiler/typecheck/TcExpr.hs | 7 +- compiler/typecheck/TcHsSyn.hs | 61 +++--- compiler/typecheck/TcHsType.hs | 4 +- compiler/typecheck/TcMatches.hs | 11 +- compiler/typecheck/TcPat.hs | 2 +- compiler/typecheck/TcPatSyn.hs | 8 +- compiler/typecheck/TcRnDriver.hs | 2 +- compiler/typecheck/TcSplice.hs | 20 +- compiler/typecheck/TcTyDecls.hs | 2 +- testsuite/tests/ghc-api/annotations/parseTree.hs | 4 +- testsuite/tests/perf/haddock/all.T | 5 +- utils/haddock | 2 +- 35 files changed, 641 insertions(+), 424 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 47ad6578ea460999b53eb4293c3a3b3017a56d65 From git at git.haskell.org Wed Nov 15 15:47:33 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 15 Nov 2017 15:47:33 +0000 (UTC) Subject: [commit: ghc] branch 'wip/ttg5-data-2017-11-15' created Message-ID: <20171115154733.734933A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/ttg5-data-2017-11-15 Referencing: 12028239b597e17fb3f3734c6b494e127be58e0c From git at git.haskell.org Wed Nov 15 15:47:36 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 15 Nov 2017 15:47:36 +0000 (UTC) Subject: [commit: ghc] wip/ttg5-data-2017-11-15: WIP on splitting out Data instance generation for hsSyn AST (1202823) Message-ID: <20171115154736.BD41D3A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttg5-data-2017-11-15 Link : http://ghc.haskell.org/trac/ghc/changeset/12028239b597e17fb3f3734c6b494e127be58e0c/ghc >--------------------------------------------------------------- commit 12028239b597e17fb3f3734c6b494e127be58e0c Author: Alan Zimmerman Date: Wed Nov 15 17:46:41 2017 +0200 WIP on splitting out Data instance generation for hsSyn AST >--------------------------------------------------------------- 12028239b597e17fb3f3734c6b494e127be58e0c compiler/ghc.cabal.in | 2 + compiler/hsSyn/HsBinds.hs | 22 +++---- compiler/hsSyn/HsDecls.hs | 58 +++++++++--------- compiler/hsSyn/HsExpr.hs | 43 ++++++------- compiler/hsSyn/HsExpr.hs-boot | 14 ++--- compiler/hsSyn/HsInstances.hs | 132 ++++++++++++++++++++++++++++++++++++++++ compiler/hsSyn/HsInstances2.hs | 133 +++++++++++++++++++++++++++++++++++++++++ compiler/hsSyn/HsLit.hs | 4 +- compiler/hsSyn/HsPat.hs | 4 +- compiler/hsSyn/HsPat.hs-boot | 3 +- compiler/hsSyn/HsSyn.hs | 5 +- compiler/hsSyn/HsTypes.hs | 20 +++---- 12 files changed, 355 insertions(+), 85 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 12028239b597e17fb3f3734c6b494e127be58e0c From git at git.haskell.org Wed Nov 15 20:05:35 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 15 Nov 2017 20:05:35 +0000 (UTC) Subject: [commit: ghc] master: Add new mbmi and mbmi2 compiler flags (f5dc8cc) Message-ID: <20171115200535.489143A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f5dc8ccc29429d0a1d011f62b6b430f6ae50290c/ghc >--------------------------------------------------------------- commit f5dc8ccc29429d0a1d011f62b6b430f6ae50290c Author: John Ky Date: Wed Nov 15 11:35:42 2017 -0500 Add new mbmi and mbmi2 compiler flags This adds support for the bit deposit and extraction operations provided by the BMI and BMI2 instruction set extensions on modern amd64 machines. Test Plan: Validate Reviewers: austin, simonmar, bgamari, hvr, goldfire, erikd Reviewed By: bgamari Subscribers: goldfire, erikd, trommler, newhoggy, rwbarton, thomie GHC Trac Issues: #14206 Differential Revision: https://phabricator.haskell.org/D4063 >--------------------------------------------------------------- f5dc8ccc29429d0a1d011f62b6b430f6ae50290c compiler/cmm/CmmMachOp.hs | 2 + compiler/cmm/CmmParse.y | 10 ++ compiler/cmm/PprC.hs | 2 + compiler/codeGen/StgCmmPrim.hs | 78 ++++++++++++++ compiler/coreSyn/MkCore.hs | 1 - compiler/llvmGen/LlvmCodeGen/CodeGen.hs | 6 ++ compiler/main/DynFlags.hs | 27 +++++ compiler/nativeGen/CPrim.hs | 20 ++++ compiler/nativeGen/PPC/CodeGen.hs | 2 + compiler/nativeGen/SPARC/CodeGen.hs | 2 + compiler/nativeGen/X86/CodeGen.hs | 69 +++++++++++++ compiler/nativeGen/X86/Instr.hs | 9 ++ compiler/nativeGen/X86/Ppr.hs | 13 +++ compiler/prelude/primops.txt.pp | 22 ++++ libraries/ghc-prim/cbits/pdep.c | 71 +++++++++++++ libraries/ghc-prim/cbits/pext.c | 67 ++++++++++++ libraries/ghc-prim/ghc-prim.cabal | 2 + testsuite/tests/codeGen/should_run/all.T | 2 + testsuite/tests/codeGen/should_run/cgrun075.hs | 115 +++++++++++++++++++++ .../{cgrun071.stdout => cgrun075.stdout} | 0 testsuite/tests/codeGen/should_run/cgrun076.hs | 115 +++++++++++++++++++++ .../{cgrun071.stdout => cgrun076.stdout} | 0 22 files changed, 634 insertions(+), 1 deletion(-) 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 f5dc8ccc29429d0a1d011f62b6b430f6ae50290c From git at git.haskell.org Wed Nov 15 20:05:38 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 15 Nov 2017 20:05:38 +0000 (UTC) Subject: [commit: ghc] master: StaticPointers: Clarify documentation (6dfe982) Message-ID: <20171115200538.2D0FB3A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6dfe9828e2b3bd79e22e89c919b0d1b92273b718/ghc >--------------------------------------------------------------- commit 6dfe9828e2b3bd79e22e89c919b0d1b92273b718 Author: Facundo Domínguez Date: Wed Nov 15 11:37:32 2017 -0500 StaticPointers: Clarify documentation * Document requirement to use the same binaries. * Fix some code comments. Test Plan: ./validate Reviewers: bgamari, mboes, hvr Reviewed By: bgamari, mboes Subscribers: rwbarton, thomie Differential Revision: https://phabricator.haskell.org/D4172 >--------------------------------------------------------------- 6dfe9828e2b3bd79e22e89c919b0d1b92273b718 compiler/main/StaticPtrTable.hs | 6 +++--- compiler/rename/RnExpr.hs | 6 +++--- compiler/typecheck/TcRnTypes.hs | 4 ++-- docs/users_guide/glasgow_exts.rst | 7 +++++++ libraries/base/GHC/StaticPtr.hs | 5 +++++ 5 files changed, 20 insertions(+), 8 deletions(-) diff --git a/compiler/main/StaticPtrTable.hs b/compiler/main/StaticPtrTable.hs index 23d02f8..47547fc 100644 --- a/compiler/main/StaticPtrTable.hs +++ b/compiler/main/StaticPtrTable.hs @@ -60,13 +60,13 @@ Here is a running example: in ...(static k)... * The renamer looks for out-of-scope names in the body of the static - form, as always If all names are in scope, the free variables of the + form, as always. If all names are in scope, the free variables of the body are stored in AST at the location of the static form. * The typechecker verifies that all free variables occurring in the static form are floatable to top level (see Note [Meaning of - IdBindingInfo] in TcRnTypes). In our example, 'k' is floatable, even - though it is bound in a nested let, we are fine. + IdBindingInfo] in TcRnTypes). In our example, 'k' is floatable. + Even though it is bound in a nested let, we are fine. * The desugarer replaces the static form with an application of the function 'makeStatic' (defined in module GHC.StaticPtr.Internal of diff --git a/compiler/rename/RnExpr.hs b/compiler/rename/RnExpr.hs index 8f719c4..22e474b 100644 --- a/compiler/rename/RnExpr.hs +++ b/compiler/rename/RnExpr.hs @@ -371,9 +371,9 @@ rnExpr e@(ELazyPat {}) = patSynErr e empty * * ************************************************************************ -For the static form we check that the free variables are all top-level -value bindings. This is done by checking that the name is external or -wired-in. See the Notes about the NameSorts in Name.hs. +For the static form we check that it is not used in splices. +We also collect the free variables of the term which come from +this module. See Note [Grand plan for static forms] in StaticPtrTable. -} rnExpr e@(HsStatic _ expr) = do diff --git a/compiler/typecheck/TcRnTypes.hs b/compiler/typecheck/TcRnTypes.hs index f2309c8..7e347ff 100644 --- a/compiler/typecheck/TcRnTypes.hs +++ b/compiler/typecheck/TcRnTypes.hs @@ -1176,8 +1176,8 @@ ClosedLet means that - For the ClosedTypeId field see Note [Bindings with closed types] For (static e) to be valid, we need for every 'x' free in 'e', -x's binding must be floatable to top level. Specifically: - * x's RhsNames must be non-empty +that x's binding is floatable to the top level. Specifically: + * x's RhsNames must be empty * x's type has no free variables See Note [Grand plan for static forms] in StaticPtrTable.hs. This test is made in TcExpr.checkClosedInStaticForm. diff --git a/docs/users_guide/glasgow_exts.rst b/docs/users_guide/glasgow_exts.rst index ab92375..3edb8d6 100644 --- a/docs/users_guide/glasgow_exts.rst +++ b/docs/users_guide/glasgow_exts.rst @@ -12937,6 +12937,13 @@ While the following definitions are rejected: :: entered on the REPL may not. This is a limitation of GHCi; see :ghc-ticket:`12356` for details. +.. note:: + + The set of keys used for locating static pointers in the Static Pointer + Table is not guaranteed to remain stable for different program binaries. + Or in other words, only processes launched from the same program binary + are guaranteed to use the same set of keys. + .. _typechecking-static-pointers: Static semantics of static pointers diff --git a/libraries/base/GHC/StaticPtr.hs b/libraries/base/GHC/StaticPtr.hs index 65ec483..92829ac 100644 --- a/libraries/base/GHC/StaticPtr.hs +++ b/libraries/base/GHC/StaticPtr.hs @@ -28,6 +28,11 @@ -- table is known as the Static Pointer Table. The reference can then be -- dereferenced to obtain the value. -- +-- The various communicating processes need to aggree on the keys used to refer +-- to the values in the Static Pointer Table, or lookups will fail. Only +-- processes launched from the same program binary are guaranteed to use the +-- same set of keys. +-- ----------------------------------------------------------------------------- module GHC.StaticPtr From git at git.haskell.org Wed Nov 15 20:05:41 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 15 Nov 2017 20:05:41 +0000 (UTC) Subject: [commit: ghc] master: Adds rts/rts.cabal.in file (5dea62f) Message-ID: <20171115200541.86CD13A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5dea62fbbc5b8fa19503a814c3915331e54ac899/ghc >--------------------------------------------------------------- commit 5dea62fbbc5b8fa19503a814c3915331e54ac899 Author: Moritz Angermann Date: Wed Nov 15 11:38:04 2017 -0500 Adds rts/rts.cabal.in file This is in preparation for cabalification of the `rts`. To be actually able to parse this file, a rather recent Cabal is required. One after commit 357d49d of haskell/cabal. The relevant PR to support the new `asm-sources` and `cmm-sources` is haskell/cabal/pull/4857. Not that this does *not* allow cabal to build the RTS. It does however provide enough information such that cabal can `copy` and `register` the package properly in the package database, if all the build artifacts have been build properly. As such it does not require any custom handling of the `rts` package. As the rts as well as all the other packages built by the GHC built system are built outside of cabal anyway. Reviewers: bgamari, hvr, erikd, simonmar Reviewed By: bgamari Subscribers: rwbarton, thomie, erikd Differential Revision: https://phabricator.haskell.org/D4174 >--------------------------------------------------------------- 5dea62fbbc5b8fa19503a814c3915331e54ac899 aclocal.m4 | 9 +- configure.ac | 29 +++- rts/rts.cabal.in | 441 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 471 insertions(+), 8 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 5dea62fbbc5b8fa19503a814c3915331e54ac899 From git at git.haskell.org Wed Nov 15 20:05:44 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 15 Nov 2017 20:05:44 +0000 (UTC) Subject: [commit: ghc] master: RTS: Disable warnings in ffi.h (8b1020e) Message-ID: <20171115200544.4B9373A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8b1020ed21ec8af1accdd900f0d48c3c92b6ed83/ghc >--------------------------------------------------------------- commit 8b1020ed21ec8af1accdd900f0d48c3c92b6ed83 Author: Peter Trommler Date: Wed Nov 15 11:38:50 2017 -0500 RTS: Disable warnings in ffi.h The update of GHC's in-tree libffi causes warnings about undefined macros and hence validate fails. Also mark broken tests that have a ticket. Fixes #14353 Test Plan: ./validate (on AIX and powerpc if possible) Reviewers: bgamari, hvr, erikd, simonmar Reviewed By: bgamari Subscribers: snowleopard, rwbarton, thomie GHC Trac Issues: #14353, #11259, #14455, #11261 Differential Revision: https://phabricator.haskell.org/D4181 >--------------------------------------------------------------- 8b1020ed21ec8af1accdd900f0d48c3c92b6ed83 rts/ghc.mk | 9 ++++++++- testsuite/tests/driver/linkwhole/all.T | 6 ++++-- testsuite/tests/ghci.debugger/scripts/all.T | 6 ++++-- testsuite/tests/simplCore/should_compile/all.T | 4 +++- 4 files changed, 19 insertions(+), 6 deletions(-) diff --git a/rts/ghc.mk b/rts/ghc.mk index 3ba7e53..690a883 100644 --- a/rts/ghc.mk +++ b/rts/ghc.mk @@ -457,15 +457,22 @@ endif endif # add CFLAGS for libffi -# ffi.h triggers prototype warnings, so disable them here: ifeq "$(UseSystemLibFFI)" "YES" LIBFFI_CFLAGS = $(addprefix -I,$(FFIIncludeDir)) else LIBFFI_CFLAGS = endif +# ffi.h triggers prototype warnings, so disable them here: rts/Interpreter_CC_OPTS += -Wno-strict-prototypes $(LIBFFI_CFLAGS) rts/Adjustor_CC_OPTS += -Wno-strict-prototypes $(LIBFFI_CFLAGS) rts/sm/Storage_CC_OPTS += -Wno-strict-prototypes $(LIBFFI_CFLAGS) +# ffi.h triggers undefined macro warnings on PowerPC, disable those: +# this matches substrings of powerpc64le, including "powerpc" and "powerpc64" +ifneq "$(findstring $(TargetArch_CPP), powerpc64le)" "" +rts/Interpreter_CC_OPTS += -Wno-undef +rts/Adjustor_CC_OPTS += -Wno-undef +rts/sm/Storage_CC_OPTS += -Wno-undef +endif # inlining warnings happen in Compact rts/sm/Compact_CC_OPTS += -Wno-inline diff --git a/testsuite/tests/driver/linkwhole/all.T b/testsuite/tests/driver/linkwhole/all.T index 294a879..1562aa8 100644 --- a/testsuite/tests/driver/linkwhole/all.T +++ b/testsuite/tests/driver/linkwhole/all.T @@ -1,3 +1,5 @@ -test('linkwhole', [extra_files(['Types.hs','Main.hs','MyCode.hs','Handles.hs']), - when(opsys('mingw32'), skip)], +test('linkwhole', + [extra_files(['Types.hs','Main.hs','MyCode.hs','Handles.hs']), + when(arch('powerpc64') or arch('powerpc64le'), expect_broken(11259)), + when(opsys('mingw32'), skip)], run_command, ['$MAKE -s --no-print-directory linkwhole']) diff --git a/testsuite/tests/ghci.debugger/scripts/all.T b/testsuite/tests/ghci.debugger/scripts/all.T index de3e7e3..a24a254 100644 --- a/testsuite/tests/ghci.debugger/scripts/all.T +++ b/testsuite/tests/ghci.debugger/scripts/all.T @@ -21,7 +21,8 @@ test('print018', extra_files(['../Test.hs']), ghci_script, ['print018.script']) test('print019', extra_files(['../Test.hs']), ghci_script, ['print019.script']) test('print020', extra_files(['../HappyTest.hs']), ghci_script, ['print020.script']) test('print021', normal, ghci_script, ['print021.script']) -test('print022', normal, ghci_script, ['print022.script']) +test('print022', when(arch('powerpc64'), expect_broken(14455)), ghci_script, + ['print022.script']) test('print023', extra_files(['../Test.hs']), ghci_script, ['print023.script']) test('print024', extra_files(['../Test.hs']), ghci_script, ['print024.script']) test('print025', normal, ghci_script, ['print025.script']) @@ -95,4 +96,5 @@ test('getargs', extra_files(['../getargs.hs']), ghci_script, ['getargs.script']) test('T7386', normal, ghci_script, ['T7386.script']) test('T8557', normal, ghci_script, ['T8557.script']) test('T12458', normal, ghci_script, ['T12458.script']) -test('T13825-debugger', normal, ghci_script, ['T13825-debugger.script']) +test('T13825-debugger', when(arch('powerpc64'), expect_broken(14455)), + ghci_script, ['T13825-debugger.script']) diff --git a/testsuite/tests/simplCore/should_compile/all.T b/testsuite/tests/simplCore/should_compile/all.T index 0b85692..2761a06 100644 --- a/testsuite/tests/simplCore/should_compile/all.T +++ b/testsuite/tests/simplCore/should_compile/all.T @@ -267,7 +267,9 @@ test('T12600', normal, run_command, ['$MAKE -s --no-print-directory T12600']) -test('T13658', normal, compile, ['-dcore-lint']) +test('T13658', + [when((arch('powerpc64') or arch('powerpc64le')), expect_broken(11261))], + compile, ['-dcore-lint']) test('T13708', normal, compile, ['']) # thunk should inline here, so check whether or not it appears in the Core From git at git.haskell.org Wed Nov 15 20:05:47 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 15 Nov 2017 20:05:47 +0000 (UTC) Subject: [commit: ghc] master: CLabel: Clean up unused label types (ea26162) Message-ID: <20171115200547.1386B3A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ea26162226fa04d3d21f6ce3fdf36e83355274c9/ghc >--------------------------------------------------------------- commit ea26162226fa04d3d21f6ce3fdf36e83355274c9 Author: Ben Gamari Date: Wed Nov 15 11:39:11 2017 -0500 CLabel: Clean up unused label types Test Plan: Validate Reviewers: trommler, simonmar Reviewed By: trommler Subscribers: rwbarton, thomie GHC Trac Issues: #14454 Differential Revision: https://phabricator.haskell.org/D4182 >--------------------------------------------------------------- ea26162226fa04d3d21f6ce3fdf36e83355274c9 compiler/cmm/CLabel.hs | 50 +++++--------------------------------------------- 1 file changed, 5 insertions(+), 45 deletions(-) diff --git a/compiler/cmm/CLabel.hs b/compiler/cmm/CLabel.hs index c4c5eb8..3a8f41f 100644 --- a/compiler/cmm/CLabel.hs +++ b/compiler/cmm/CLabel.hs @@ -14,12 +14,9 @@ module CLabel ( pprDebugCLabel, mkClosureLabel, - mkSRTLabel, mkTopSRTLabel, mkInfoTableLabel, mkEntryLabel, - mkSlowEntryLabel, - mkConEntryLabel, mkRednCountsLabel, mkConInfoTableLabel, mkLargeSRTLabel, @@ -30,17 +27,10 @@ module CLabel ( mkLocalClosureLabel, mkLocalInfoTableLabel, - mkLocalEntryLabel, - mkLocalConEntryLabel, - mkLocalConInfoTableLabel, mkLocalClosureTableLabel, mkBlockInfoTableLabel, - mkReturnPtLabel, - mkReturnInfoLabel, - mkAltLabel, - mkDefaultLabel, mkBitmapLabel, mkStringLitLabel, @@ -62,12 +52,10 @@ module CLabel ( mkSMAP_FROZEN0_infoLabel, mkSMAP_DIRTY_infoLabel, mkBadAlignmentLabel, - mkEMPTY_MVAR_infoLabel, mkArrWords_infoLabel, mkTopTickyCtrLabel, mkCAFBlackHoleInfoTableLabel, - mkCAFBlackHoleEntryLabel, mkRtsPrimOpLabel, mkRtsSlowFastTickyCtrLabel, @@ -111,7 +99,7 @@ module CLabel ( isCFunctionLabel, isGcPtrLabel, labelDynamic, -- * Conversions - toClosureLbl, toSlowEntryLbl, toEntryLbl, toInfoLbl, toRednCountsLbl, hasHaskellName, + toClosureLbl, toSlowEntryLbl, toEntryLbl, toInfoLbl, hasHaskellName, pprCLabel ) where @@ -452,48 +440,35 @@ data DynamicLinkerLabelInfo -- Constructing IdLabels -- These are always local: -mkSlowEntryLabel :: Name -> CafInfo -> CLabel -mkSlowEntryLabel name c = IdLabel name c Slow mkTopSRTLabel :: Unique -> CLabel mkTopSRTLabel u = SRTLabel u -mkSRTLabel :: Name -> CafInfo -> CLabel mkRednCountsLabel :: Name -> CLabel -mkSRTLabel name c = IdLabel name c SRT mkRednCountsLabel name = IdLabel name NoCafRefs RednCounts -- Note [ticky for LNE] -- These have local & (possibly) external variants: mkLocalClosureLabel :: Name -> CafInfo -> CLabel mkLocalInfoTableLabel :: Name -> CafInfo -> CLabel -mkLocalEntryLabel :: Name -> CafInfo -> CLabel mkLocalClosureTableLabel :: Name -> CafInfo -> CLabel mkLocalClosureLabel name c = IdLabel name c Closure mkLocalInfoTableLabel name c = IdLabel name c LocalInfoTable -mkLocalEntryLabel name c = IdLabel name c LocalEntry mkLocalClosureTableLabel name c = IdLabel name c ClosureTable mkClosureLabel :: Name -> CafInfo -> CLabel mkInfoTableLabel :: Name -> CafInfo -> CLabel mkEntryLabel :: Name -> CafInfo -> CLabel mkClosureTableLabel :: Name -> CafInfo -> CLabel -mkLocalConInfoTableLabel :: CafInfo -> Name -> CLabel -mkLocalConEntryLabel :: CafInfo -> Name -> CLabel mkConInfoTableLabel :: Name -> CafInfo -> CLabel mkBytesLabel :: Name -> CLabel mkClosureLabel name c = IdLabel name c Closure mkInfoTableLabel name c = IdLabel name c InfoTable mkEntryLabel name c = IdLabel name c Entry mkClosureTableLabel name c = IdLabel name c ClosureTable -mkLocalConInfoTableLabel c con = IdLabel con c ConInfoTable -mkLocalConEntryLabel c con = IdLabel con c ConEntry mkConInfoTableLabel name c = IdLabel name c ConInfoTable mkBytesLabel name = IdLabel name NoCafRefs Bytes -mkConEntryLabel :: Name -> CafInfo -> CLabel -mkConEntryLabel name c = IdLabel name c ConEntry - mkBlockInfoTableLabel :: Name -> CafInfo -> CLabel mkBlockInfoTableLabel name c = IdLabel name c BlockInfoTable -- See Note [Proc-point local block entry-point]. @@ -502,9 +477,10 @@ mkBlockInfoTableLabel name c = IdLabel name c BlockInfoTable mkDirty_MUT_VAR_Label, mkSplitMarkerLabel, mkUpdInfoLabel, mkBHUpdInfoLabel, mkIndStaticInfoLabel, mkMainCapabilityLabel, mkMAP_FROZEN_infoLabel, mkMAP_FROZEN0_infoLabel, mkMAP_DIRTY_infoLabel, - mkEMPTY_MVAR_infoLabel, mkTopTickyCtrLabel, - mkCAFBlackHoleInfoTableLabel, mkCAFBlackHoleEntryLabel, - mkArrWords_infoLabel, mkSMAP_FROZEN_infoLabel, mkSMAP_FROZEN0_infoLabel, + mkArrWords_infoLabel, + mkTopTickyCtrLabel, + mkCAFBlackHoleInfoTableLabel, + mkSMAP_FROZEN_infoLabel, mkSMAP_FROZEN0_infoLabel, mkSMAP_DIRTY_infoLabel, mkBadAlignmentLabel :: CLabel mkDirty_MUT_VAR_Label = mkForeignLabel (fsLit "dirty_MUT_VAR") Nothing ForeignLabelInExternalPackage IsFunction mkSplitMarkerLabel = CmmLabel rtsUnitId (fsLit "__stg_split_marker") CmmCode @@ -515,10 +491,8 @@ mkMainCapabilityLabel = CmmLabel rtsUnitId (fsLit "MainCapability") mkMAP_FROZEN_infoLabel = CmmLabel rtsUnitId (fsLit "stg_MUT_ARR_PTRS_FROZEN") CmmInfo mkMAP_FROZEN0_infoLabel = CmmLabel rtsUnitId (fsLit "stg_MUT_ARR_PTRS_FROZEN0") CmmInfo mkMAP_DIRTY_infoLabel = CmmLabel rtsUnitId (fsLit "stg_MUT_ARR_PTRS_DIRTY") CmmInfo -mkEMPTY_MVAR_infoLabel = CmmLabel rtsUnitId (fsLit "stg_EMPTY_MVAR") CmmInfo mkTopTickyCtrLabel = CmmLabel rtsUnitId (fsLit "top_ct") CmmData mkCAFBlackHoleInfoTableLabel = CmmLabel rtsUnitId (fsLit "stg_CAF_BLACKHOLE") CmmInfo -mkCAFBlackHoleEntryLabel = CmmLabel rtsUnitId (fsLit "stg_CAF_BLACKHOLE") CmmEntry mkArrWords_infoLabel = CmmLabel rtsUnitId (fsLit "stg_ARR_WORDS") CmmInfo mkSMAP_FROZEN_infoLabel = CmmLabel rtsUnitId (fsLit "stg_SMALL_MUT_ARR_PTRS_FROZEN") CmmInfo mkSMAP_FROZEN0_infoLabel = CmmLabel rtsUnitId (fsLit "stg_SMALL_MUT_ARR_PTRS_FROZEN0") CmmInfo @@ -625,17 +599,6 @@ mkBitmapLabel :: Unique -> CLabel mkLargeSRTLabel uniq = LargeSRTLabel uniq mkBitmapLabel uniq = LargeBitmapLabel uniq - --- Constructin CaseLabels -mkReturnPtLabel :: Unique -> CLabel -mkReturnInfoLabel :: Unique -> CLabel -mkAltLabel :: Unique -> ConTag -> CLabel -mkDefaultLabel :: Unique -> CLabel -mkReturnPtLabel uniq = CaseLabel uniq CaseReturnPt -mkReturnInfoLabel uniq = CaseLabel uniq CaseReturnInfo -mkAltLabel uniq tag = CaseLabel uniq (CaseAlt tag) -mkDefaultLabel uniq = CaseLabel uniq CaseDefault - -- Constructing Cost Center Labels mkCCLabel :: CostCentre -> CLabel mkCCSLabel :: CostCentreStack -> CLabel @@ -723,9 +686,6 @@ toInfoLbl (CmmLabel m str CmmEntry) = CmmLabel m str CmmInfo toInfoLbl (CmmLabel m str CmmRet) = CmmLabel m str CmmRetInfo toInfoLbl l = pprPanic "CLabel.toInfoLbl" (ppr l) -toRednCountsLbl :: CLabel -> Maybe CLabel -toRednCountsLbl = fmap mkRednCountsLabel . hasHaskellName - hasHaskellName :: CLabel -> Maybe Name hasHaskellName (IdLabel n _ _) = Just n hasHaskellName _ = Nothing From git at git.haskell.org Wed Nov 15 20:05:52 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 15 Nov 2017 20:05:52 +0000 (UTC) Subject: [commit: ghc] master: Add dump flag for timing output (383016b) Message-ID: <20171115200552.A8FDA3A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/383016b8ec3af3b0b1370e8966bba00397ddb848/ghc >--------------------------------------------------------------- commit 383016b8ec3af3b0b1370e8966bba00397ddb848 Author: Ben Gamari Date: Wed Nov 15 11:40:16 2017 -0500 Add dump flag for timing output This allows you to use `-ddump-to-file -ddump-timings` for more useful dump output. Test Plan: Try it Subscribers: rwbarton, thomie Differential Revision: https://phabricator.haskell.org/D4195 >--------------------------------------------------------------- 383016b8ec3af3b0b1370e8966bba00397ddb848 compiler/main/DynFlags.hs | 3 +++ compiler/main/ErrUtils.hs | 27 ++++++++++++++++++--------- 2 files changed, 21 insertions(+), 9 deletions(-) diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 53a4033..5888acc 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -392,6 +392,7 @@ data DumpFlag | Opt_D_dump_hi_diffs | Opt_D_dump_mod_cycles | Opt_D_dump_mod_map + | Opt_D_dump_timings | Opt_D_dump_view_pattern_commoning | Opt_D_verbose_core2core | Opt_D_dump_debug @@ -3081,6 +3082,8 @@ dynamic_flags_deps = [ (setDumpFlag Opt_D_dump_mod_cycles) , make_ord_flag defGhcFlag "ddump-mod-map" (setDumpFlag Opt_D_dump_mod_map) + , make_ord_flag defGhcFlag "ddump-timings" + (setDumpFlag Opt_D_dump_timings) , make_ord_flag defGhcFlag "ddump-view-pattern-commoning" (setDumpFlag Opt_D_dump_view_pattern_commoning) , make_ord_flag defGhcFlag "ddump-to-file" diff --git a/compiler/main/ErrUtils.hs b/compiler/main/ErrUtils.hs index 258fc11..1aa5238 100644 --- a/compiler/main/ErrUtils.hs +++ b/compiler/main/ErrUtils.hs @@ -614,7 +614,7 @@ withTiming :: MonadIO m -> m a withTiming getDFlags what force_result action = do dflags <- getDFlags - if verbosity dflags >= 2 + if verbosity dflags >= 2 || dopt Opt_D_dump_timings dflags then do liftIO $ logInfo dflags (defaultUserStyle dflags) $ text "***" <+> what <> colon alloc0 <- liftIO getAllocationCounter @@ -625,14 +625,23 @@ withTiming getDFlags what force_result action alloc1 <- liftIO getAllocationCounter -- recall that allocation counter counts down let alloc = alloc0 - alloc1 - liftIO $ logInfo dflags (defaultUserStyle dflags) - (text "!!!" <+> what <> colon <+> text "finished in" - <+> doublePrec 2 (realToFrac (end - start) * 1e-9) - <+> text "milliseconds" - <> comma - <+> text "allocated" - <+> doublePrec 3 (realToFrac alloc / 1024 / 1024) - <+> text "megabytes") + time = realToFrac (end - start) * 1e-9 + + when (verbosity dflags >= 2) + $ liftIO $ logInfo dflags (defaultUserStyle dflags) + (text "!!!" <+> what <> colon <+> text "finished in" + <+> doublePrec 2 time + <+> text "milliseconds" + <> comma + <+> text "allocated" + <+> doublePrec 3 (realToFrac alloc / 1024 / 1024) + <+> text "megabytes") + + liftIO $ dumpIfSet_dyn dflags Opt_D_dump_timings "" + $ hsep [ what <> colon + , text "alloc=" <> ppr alloc + , text "time=" <> doublePrec 3 time + ] pure r else action From git at git.haskell.org Wed Nov 15 20:05:49 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 15 Nov 2017 20:05:49 +0000 (UTC) Subject: [commit: ghc] master: CLabels: Remove CaseLabel (1aba27a) Message-ID: <20171115200549.E3E713A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1aba27a3c71b2a571f19d8a72c5918e165d26db5/ghc >--------------------------------------------------------------- commit 1aba27a3c71b2a571f19d8a72c5918e165d26db5 Author: Ben Gamari Date: Wed Nov 15 11:39:31 2017 -0500 CLabels: Remove CaseLabel Reviewers: simonmar Subscribers: rwbarton, thomie Differential Revision: https://phabricator.haskell.org/D4188 >--------------------------------------------------------------- 1aba27a3c71b2a571f19d8a72c5918e165d26db5 compiler/cmm/CLabel.hs | 32 -------------------------------- 1 file changed, 32 deletions(-) diff --git a/compiler/cmm/CLabel.hs b/compiler/cmm/CLabel.hs index 3a8f41f..81d00f4 100644 --- a/compiler/cmm/CLabel.hs +++ b/compiler/cmm/CLabel.hs @@ -184,10 +184,6 @@ data CLabel FunctionOrData -- | A family of labels related to a particular case expression. - | CaseLabel - {-# UNPACK #-} !Unique -- Unique says which case expression - CaseLabelInfo - -- | Local temporary label used for native (or LLVM) code generation | AsmTempLabel {-# UNPACK #-} !Unique @@ -255,9 +251,6 @@ instance Ord CLabel where compare b1 b2 `thenCmp` compare c1 c2 `thenCmp` compare d1 d2 - compare (CaseLabel u1 a1) (CaseLabel u2 a2) = - nonDetCmpUnique u1 u2 `thenCmp` - compare a1 a2 compare (AsmTempLabel u1) (AsmTempLabel u2) = nonDetCmpUnique u1 u2 compare (AsmTempDerivedLabel a1 b1) (AsmTempDerivedLabel a2 b2) = compare a1 a2 `thenCmp` @@ -290,8 +283,6 @@ instance Ord CLabel where compare _ RtsLabel{} = GT compare ForeignLabel{} _ = LT compare _ ForeignLabel{} = GT - compare CaseLabel{} _ = LT - compare _ CaseLabel{} = GT compare AsmTempLabel{} _ = LT compare _ AsmTempLabel{} = GT compare AsmTempDerivedLabel{} _ = LT @@ -387,14 +378,6 @@ data IdLabelInfo deriving (Eq, Ord) -data CaseLabelInfo - = CaseReturnPt - | CaseReturnInfo - | CaseAlt ConTag - | CaseDefault - deriving (Eq, Ord) - - data RtsLabelInfo = RtsSelectorInfoTable Bool{-updatable-} Int{-offset-} -- ^ Selector thunks | RtsSelectorEntry Bool{-updatable-} Int{-offset-} @@ -672,7 +655,6 @@ toEntryLbl (IdLabel n c ConInfoTable) = IdLabel n c ConEntry toEntryLbl (IdLabel n _ BlockInfoTable) = mkAsmTempLabel (nameUnique n) -- See Note [Proc-point local block entry-point]. toEntryLbl (IdLabel n c _) = IdLabel n c Entry -toEntryLbl (CaseLabel n CaseReturnInfo) = CaseLabel n CaseReturnPt toEntryLbl (CmmLabel m str CmmInfo) = CmmLabel m str CmmEntry toEntryLbl (CmmLabel m str CmmRetInfo) = CmmLabel m str CmmRet toEntryLbl l = pprPanic "toEntryLbl" (ppr l) @@ -681,7 +663,6 @@ toInfoLbl :: CLabel -> CLabel toInfoLbl (IdLabel n c LocalEntry) = IdLabel n c LocalInfoTable toInfoLbl (IdLabel n c ConEntry) = IdLabel n c ConInfoTable toInfoLbl (IdLabel n c _) = IdLabel n c InfoTable -toInfoLbl (CaseLabel n CaseReturnPt) = CaseLabel n CaseReturnInfo toInfoLbl (CmmLabel m str CmmEntry) = CmmLabel m str CmmInfo toInfoLbl (CmmLabel m str CmmRet) = CmmLabel m str CmmRetInfo toInfoLbl l = pprPanic "CLabel.toInfoLbl" (ppr l) @@ -729,7 +710,6 @@ needsCDecl (SRTLabel _) = True needsCDecl (LargeSRTLabel _) = False needsCDecl (LargeBitmapLabel _) = False needsCDecl (IdLabel _ _ _) = True -needsCDecl (CaseLabel _ _) = True needsCDecl (StringLitLabel _) = False needsCDecl (AsmTempLabel _) = False @@ -859,7 +839,6 @@ math_funs = mkUniqSet [ -- externally visible if it has to be declared as exported -- in the .o file's symbol table; that is, made non-static. externallyVisibleCLabel :: CLabel -> Bool -- not C "static" -externallyVisibleCLabel (CaseLabel _ _) = False externallyVisibleCLabel (StringLitLabel _) = False externallyVisibleCLabel (AsmTempLabel _) = False externallyVisibleCLabel (AsmTempDerivedLabel _ _)= False @@ -919,8 +898,6 @@ labelType (CmmLabel _ _ CmmRet) = CodeLabel labelType (RtsLabel (RtsSelectorInfoTable _ _)) = DataLabel labelType (RtsLabel (RtsApInfoTable _ _)) = DataLabel labelType (RtsLabel (RtsApFast _)) = CodeLabel -labelType (CaseLabel _ CaseReturnInfo) = DataLabel -labelType (CaseLabel _ _) = CodeLabel labelType (SRTLabel _) = DataLabel labelType (LargeSRTLabel _) = DataLabel labelType (LargeBitmapLabel _) = DataLabel @@ -1136,15 +1113,6 @@ pprCLbl :: CLabel -> SDoc pprCLbl (StringLitLabel u) = pprUniqueAlways u <> text "_str" -pprCLbl (CaseLabel u CaseReturnPt) - = hcat [pprUniqueAlways u, text "_ret"] -pprCLbl (CaseLabel u CaseReturnInfo) - = hcat [pprUniqueAlways u, text "_info"] -pprCLbl (CaseLabel u (CaseAlt tag)) - = hcat [pprUniqueAlways u, pp_cSEP, int tag, text "_alt"] -pprCLbl (CaseLabel u CaseDefault) - = hcat [pprUniqueAlways u, text "_dflt"] - pprCLbl (SRTLabel u) = pprUniqueAlways u <> pp_cSEP <> text "srt" From git at git.haskell.org Wed Nov 15 20:05:55 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 15 Nov 2017 20:05:55 +0000 (UTC) Subject: [commit: ghc] master: Allow the rts lib to be called rts-1.0 (d0a641a) Message-ID: <20171115200555.76BF43A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d0a641a33d1f3c722813b95ac81ca207071cbf83/ghc >--------------------------------------------------------------- commit d0a641a33d1f3c722813b95ac81ca207071cbf83 Author: Moritz Angermann Date: Wed Nov 15 11:41:15 2017 -0500 Allow the rts lib to be called rts-1.0 Reviewers: bgamari, simonmar Reviewed By: bgamari Subscribers: rwbarton, thomie Differential Revision: https://phabricator.haskell.org/D4187 >--------------------------------------------------------------- d0a641a33d1f3c722813b95ac81ca207071cbf83 compiler/main/Packages.hs | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/compiler/main/Packages.hs b/compiler/main/Packages.hs index 949cc0f..c49581b 100644 --- a/compiler/main/Packages.hs +++ b/compiler/main/Packages.hs @@ -1729,7 +1729,19 @@ packageHsLibs dflags p = map (mkDynName . addSuffix) (hsLibraries p) | otherwise = panic ("Don't understand library name " ++ x) + -- Add _thr and other rts suffixes to packages named + -- `rts` or `rts-1.0`. Why both? Traditionally the rts + -- package is called `rts` only. However the tooling + -- usually expects a package name to have a version. + -- As such we will gradually move towards the `rts-1.0` + -- package name, at which point the `rts` package name + -- will eventually be unused. + -- + -- This change elevates the need to add custom hooks + -- and handling specifically for the `rts` package for + -- example in ghc-cabal. addSuffix rts@"HSrts" = rts ++ (expandTag rts_tag) + addSuffix rts@"HSrts-1.0"= rts ++ (expandTag rts_tag) addSuffix other_lib = other_lib ++ (expandTag tag) expandTag t | null t = "" From git at git.haskell.org Wed Nov 15 20:05:58 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 15 Nov 2017 20:05:58 +0000 (UTC) Subject: [commit: ghc] master: rts: Fix gc timing (d9f0c24) Message-ID: <20171115200558.3E75B3A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d9f0c24dd01b2f2a9a5ccc2fc45e93064d4ba0c1/ghc >--------------------------------------------------------------- commit d9f0c24dd01b2f2a9a5ccc2fc45e93064d4ba0c1 Author: Douglas Wilson Date: Wed Nov 15 11:40:54 2017 -0500 rts: Fix gc timing We were accumulating the gc times of the previous gc. `stats.gc.{cpu,elappsed}_ns` were being accumulated into `stats.gc_{cpu,elapsed}_ns` before they were set. There is also a change in that heap profiling will no longer cause gc events to be emitted. Reviewers: bgamari, erikd, simonmar Reviewed By: bgamari Subscribers: rwbarton, thomie GHC Trac Issues: #14257, #14445 Differential Revision: https://phabricator.haskell.org/D4184 >--------------------------------------------------------------- d9f0c24dd01b2f2a9a5ccc2fc45e93064d4ba0c1 rts/Stats.c | 37 +++++++++++++++++++++---------------- 1 file changed, 21 insertions(+), 16 deletions(-) diff --git a/rts/Stats.c b/rts/Stats.c index 6a5f801..8f7865b 100644 --- a/rts/Stats.c +++ b/rts/Stats.c @@ -310,6 +310,26 @@ stat_endGC (Capability *cap, gc_thread *gct, stats.gc.par_max_copied_bytes = par_max_copied * sizeof(W_); stats.gc.par_balanced_copied_bytes = par_balanced_copied * sizeof(W_); + bool stats_enabled = + RtsFlags.GcFlags.giveStats != NO_GC_STATS || + rtsConfig.gcDoneHook != NULL; + + if (stats_enabled + || RtsFlags.ProfFlags.doHeapProfile) // heap profiling needs GC_tot_time + { + // We only update the times when stats are explicitly enabled since + // getProcessTimes (e.g. requiring a system call) can be expensive on + // some platforms. + Time current_cpu, current_elapsed; + getProcessTimes(¤t_cpu, ¤t_elapsed); + stats.cpu_ns = current_cpu - start_init_cpu; + stats.elapsed_ns = current_elapsed - start_init_elapsed; + + stats.gc.sync_elapsed_ns = + gct->gc_start_elapsed - gct->gc_sync_start_elapsed; + stats.gc.elapsed_ns = current_elapsed - gct->gc_start_elapsed; + stats.gc.cpu_ns = current_cpu - gct->gc_start_cpu; + } // ------------------------------------------------- // Update the cumulative stats @@ -354,23 +374,8 @@ stat_endGC (Capability *cap, gc_thread *gct, // ------------------------------------------------- // Do the more expensive bits only when stats are enabled. - if (RtsFlags.GcFlags.giveStats != NO_GC_STATS || - rtsConfig.gcDoneHook != NULL || - RtsFlags.ProfFlags.doHeapProfile) // heap profiling needs GC_tot_time + if (stats_enabled) { - // We only update the times when stats are explicitly enabled since - // getProcessTimes (e.g. requiring a system call) can be expensive on - // some platforms. - Time current_cpu, current_elapsed; - getProcessTimes(¤t_cpu, ¤t_elapsed); - stats.cpu_ns = current_cpu - start_init_cpu; - stats.elapsed_ns = current_elapsed - start_init_elapsed; - - stats.gc.sync_elapsed_ns = - gct->gc_start_elapsed - gct->gc_sync_start_elapsed; - stats.gc.elapsed_ns = current_elapsed - gct->gc_start_elapsed; - stats.gc.cpu_ns = current_cpu - gct->gc_start_cpu; - // ------------------------------------------------- // Emit events to the event log From git at git.haskell.org Wed Nov 15 20:06:01 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 15 Nov 2017 20:06:01 +0000 (UTC) Subject: [commit: ghc] master: Cabalify all the things (3bed4aa) Message-ID: <20171115200601.B8C483A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3bed4aa703c41ccbd310496420fbb71afdfd99e7/ghc >--------------------------------------------------------------- commit 3bed4aa703c41ccbd310496420fbb71afdfd99e7 Author: Moritz Angermann Date: Wed Nov 15 11:41:34 2017 -0500 Cabalify all the things Adding cabal files to `unlit`, `touchy` and `hp2ps`, allows us to treat them uniformally across the build system. In particular Hadrian will use these. Reviewers: bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie Differential Revision: https://phabricator.haskell.org/D4192 >--------------------------------------------------------------- 3bed4aa703c41ccbd310496420fbb71afdfd99e7 utils/hp2ps/hp2ps.cabal | 22 ++++++++++++++++++++++ utils/touchy/touchy.cabal | 16 ++++++++++++++++ utils/unlit/unlit.cabal | 16 ++++++++++++++++ 3 files changed, 54 insertions(+) diff --git a/utils/hp2ps/hp2ps.cabal b/utils/hp2ps/hp2ps.cabal new file mode 100644 index 0000000..ba5db04 --- /dev/null +++ b/utils/hp2ps/hp2ps.cabal @@ -0,0 +1,22 @@ +cabal-version: >=2.1 +Name: hp2ps +Version: 0.1 +Copyright: XXX +License: BSD3 +Author: XXX +Maintainer: XXX +Synopsis: Heap Profile to PostScript converter +Description: XXX +Category: Development +build-type: Simple + +Executable unlit + Default-Language: Haskell2010 + Main-Is: Main.c + extra-libraries: m + C-Sources: + AreaBelow.c Curves.c Error.c Main.c + Reorder.c TopTwenty.c AuxFile.c Deviation.c + HpFile.c Marks.c Scale.c TraceElement.c + Axes.c Dimensions.c Key.c PsFile.c Shade.c + Utilities.c diff --git a/utils/touchy/touchy.cabal b/utils/touchy/touchy.cabal new file mode 100644 index 0000000..ab025e4 --- /dev/null +++ b/utils/touchy/touchy.cabal @@ -0,0 +1,16 @@ +cabal-version: >=2.1 +Name: touchy +Version: 0.1 +Copyright: XXX +License: BSD3 +Author: XXX +Maintainer: XXX +Synopsis: @touch@ for windows +Description: XXX +Category: Development +build-type: Simple + +Executable unlit + Default-Language: Haskell2010 + Main-Is: touchy.c + C-Sources: touchy.c diff --git a/utils/unlit/unlit.cabal b/utils/unlit/unlit.cabal new file mode 100644 index 0000000..e15a075 --- /dev/null +++ b/utils/unlit/unlit.cabal @@ -0,0 +1,16 @@ +cabal-version: >=2.1 +Name: unlit +Version: 0.1 +Copyright: XXX +License: BSD3 +Author: XXX +Maintainer: XXX +Synopsis: Literate program filter +Description: XXX +Category: Development +build-type: Simple + +Executable unlit + Default-Language: Haskell2010 + Main-Is: unlit.c + C-Sources: unlit.c From git at git.haskell.org Wed Nov 15 20:06:04 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 15 Nov 2017 20:06:04 +0000 (UTC) Subject: [commit: ghc] master: users_guide: Fix "CancelSynchronousIo" casing (ec080ea) Message-ID: <20171115200604.8186A3A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ec080ea1f160263282500b30444cb2db857f2f93/ghc >--------------------------------------------------------------- commit ec080ea1f160263282500b30444cb2db857f2f93 Author: Niklas Hambüchen Date: Wed Nov 15 11:43:04 2017 -0500 users_guide: Fix "CancelSynchronousIo" casing Reviewers: bgamari, angerman Reviewed By: angerman Subscribers: angerman, rwbarton, thomie Differential Revision: https://phabricator.haskell.org/D4200 >--------------------------------------------------------------- ec080ea1f160263282500b30444cb2db857f2f93 docs/users_guide/ffi-chap.rst | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/docs/users_guide/ffi-chap.rst b/docs/users_guide/ffi-chap.rst index 9beb4be..e844fac 100644 --- a/docs/users_guide/ffi-chap.rst +++ b/docs/users_guide/ffi-chap.rst @@ -160,7 +160,7 @@ Unix systems Windows systems [Vista and later only] The RTS calls the Win32 function - ``CancelSynchronousIO``, which will cause a blocking I/O operation + ``CancelSynchronousIo``, which will cause a blocking I/O operation to return with the error ``ERROR_OPERATION_ABORTED``. If the system call is successfully interrupted, it will return to From git at git.haskell.org Wed Nov 15 20:06:07 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 15 Nov 2017 20:06:07 +0000 (UTC) Subject: [commit: ghc] master: Adjust AltCon Ord instance to match Core linter requirements. (e14945c) Message-ID: <20171115200607.4AE843A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e14945ce046a000f1542818cd5cb6007cf2e2422/ghc >--------------------------------------------------------------- commit e14945ce046a000f1542818cd5cb6007cf2e2422 Author: klebinger.andreas at gmx.at Date: Wed Nov 15 11:42:48 2017 -0500 Adjust AltCon Ord instance to match Core linter requirements. When sorting by the Ord instance put DEFAULT before other constructors. This is in line with what the core linter requests allowing the use of the instance for putting alternatives in the correct order. This implements #14464. Reviewers: bgamari, simonpj Reviewed By: simonpj Subscribers: simonpj, rwbarton, thomie GHC Trac Issues: #14464 Differential Revision: https://phabricator.haskell.org/D4198 >--------------------------------------------------------------- e14945ce046a000f1542818cd5cb6007cf2e2422 compiler/coreSyn/CoreSyn.hs | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/compiler/coreSyn/CoreSyn.hs b/compiler/coreSyn/CoreSyn.hs index c931bf1..1462aef 100644 --- a/compiler/coreSyn/CoreSyn.hs +++ b/compiler/coreSyn/CoreSyn.hs @@ -313,16 +313,17 @@ data AltCon -- This instance is a bit shady. It can only be used to compare AltCons for -- a single type constructor. Fortunately, it seems quite unlikely that we'll -- ever need to compare AltCons for different type constructors. +-- The instance adheres to the order described in [CoreSyn case invariants] instance Ord AltCon where compare (DataAlt con1) (DataAlt con2) = ASSERT( dataConTyCon con1 == dataConTyCon con2 ) compare (dataConTag con1) (dataConTag con2) - compare (DataAlt _) _ = LT - compare _ (DataAlt _) = GT + compare (DataAlt _) _ = GT + compare _ (DataAlt _) = LT compare (LitAlt l1) (LitAlt l2) = compare l1 l2 - compare (LitAlt _) DEFAULT = LT + compare (LitAlt _) DEFAULT = GT compare DEFAULT DEFAULT = EQ - compare DEFAULT _ = GT + compare DEFAULT _ = LT -- | Binding, used for top level bindings in a module and local bindings in a @let at . From git at git.haskell.org Wed Nov 15 20:58:36 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 15 Nov 2017 20:58:36 +0000 (UTC) Subject: [commit: ghc] wip/ttg5-data-2017-11-15: Reduce compile time memory usage by splitting HsInstances (75a4a5d) Message-ID: <20171115205836.7B0A73A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ttg5-data-2017-11-15 Link : http://ghc.haskell.org/trac/ghc/changeset/75a4a5d4b373a512fbebf8bc79f1d2da1ac394b7/ghc >--------------------------------------------------------------- commit 75a4a5d4b373a512fbebf8bc79f1d2da1ac394b7 Author: Alan Zimmerman Date: Wed Nov 15 20:49:54 2017 +0200 Reduce compile time memory usage by splitting HsInstances On my machine, compiling with GHC 8.2.1, Compililing HsInstances.hs takes around 3.2G (via top, rss) compiling using the generated ghc-stage1 uses 5.9G >--------------------------------------------------------------- 75a4a5d4b373a512fbebf8bc79f1d2da1ac394b7 compiler/hsSyn/HsExpr.hs-boot | 8 -------- compiler/hsSyn/HsInstances.hs | 18 +++++++++--------- compiler/hsSyn/HsInstances.hs-boot | 20 ++++++++++++++++++++ compiler/hsSyn/HsInstances2.hs | 11 +++++------ compiler/hsSyn/HsInstances2.hs-boot | 31 +++++++++++++++++++++++++++++++ compiler/hsSyn/HsPat.hs-boot | 1 - compiler/hsSyn/HsSyn.hs | 1 - 7 files changed, 65 insertions(+), 25 deletions(-) diff --git a/compiler/hsSyn/HsExpr.hs-boot b/compiler/hsSyn/HsExpr.hs-boot index 03a18a3..b149151 100644 --- a/compiler/hsSyn/HsExpr.hs-boot +++ b/compiler/hsSyn/HsExpr.hs-boot @@ -14,7 +14,6 @@ import Outputable ( SDoc, Outputable ) import {-# SOURCE #-} HsPat ( LPat ) import BasicTypes ( SpliceExplicitFlag(..)) import HsExtension ( OutputableBndrId, SourceTextX, GhcPass ) -import Data.Data hiding ( Fixity ) type role HsExpr nominal type role HsCmd nominal @@ -29,13 +28,6 @@ data MatchGroup (a :: *) (body :: *) data GRHSs (a :: *) (body :: *) data SyntaxExpr (i :: *) --- instance (DataIdLR p p) => Data (HsSplice p) --- instance (DataIdLR p p) => Data (HsExpr p) --- instance (DataIdLR p p) => Data (HsCmd p) --- instance (Data body,DataIdLR p p) => Data (MatchGroup p body) --- instance (Data body,DataIdLR p p) => Data (GRHSs p body) --- instance (DataIdLR p p) => Data (SyntaxExpr p) - instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) => Outputable (HsExpr (GhcPass p)) instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) diff --git a/compiler/hsSyn/HsInstances.hs b/compiler/hsSyn/HsInstances.hs index fc871f1..169199e 100644 --- a/compiler/hsSyn/HsInstances.hs +++ b/compiler/hsSyn/HsInstances.hs @@ -4,7 +4,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-} -{-# GHC_OPTIONS -fno-warn-orphans #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} module HsInstances where -- This module defines the Data instances for the hsSyn AST. @@ -14,16 +14,16 @@ module HsInstances where -- UndecidableInstances ? -import GhcPrelude +import {-# SOURCE #-} HsInstances2 () import Data.Data hiding ( Fixity ) import HsExtension import HsBinds import HsDecls -import HsExpr -import HsLit +-- import HsExpr +-- import HsLit import HsTypes -import HsPat +-- import HsPat -- Data derivations from HsBinds --------------------------------------- @@ -55,8 +55,9 @@ deriving instance (DataIdLR p p) => Data (HsDerivingClause p) deriving instance (DataIdLR p p) => Data (ConDecl p) deriving instance DataIdLR p p => Data (TyFamInstDecl p) deriving instance DataIdLR p p => Data (DataFamInstDecl p) +deriving instance (DataIdLR p p) => Data (FamEqn p (HsTyPats p) (HsDataDefn p)) +deriving instance (DataIdLR p p) => Data (FamEqn p (HsTyPats p) (LHsType p)) deriving instance (DataIdLR p p) => Data (FamEqn p (LHsQTyVars p) (LHsType p)) -deriving instance (DataIdLR p p) => Data (FamEqn p (HsTyPats p) (HsDataDefn p)) deriving instance (DataIdLR p p) => Data (ClsInstDecl p) deriving instance (DataIdLR p p) => Data (InstDecl p) deriving instance (DataIdLR p p) => Data (DerivDecl p) @@ -70,10 +71,9 @@ deriving instance (DataId p) => Data (WarnDecls p) deriving instance (DataId p) => Data (WarnDecl p) deriving instance (DataIdLR p p) => Data (AnnDecl p) deriving instance (DataId p) => Data (RoleAnnotDecl p) -deriving instance (DataIdLR p p) => Data (FamEqn p (HsTyPats p) (LHsType p)) -- Data derivations from HsExpr ---------------------------------------- - +{- deriving instance (DataIdLR p p) => Data (SyntaxExpr p) deriving instance (DataIdLR p p) => Data (HsExpr p) deriving instance (DataIdLR p p) => Data (HsTupArg p) @@ -128,5 +128,5 @@ deriving instance DataId p => Data (AmbiguousFieldOcc p) deriving instance (DataIdLR p p) => Data (Pat p) deriving instance (DataIdLR p p) => Data (HsRecFields p (LPat p)) deriving instance (DataIdLR p p) => Data (HsRecFields p (LHsExpr p)) - +-} -- --------------------------------------------------------------------- diff --git a/compiler/hsSyn/HsInstances.hs-boot b/compiler/hsSyn/HsInstances.hs-boot new file mode 100644 index 0000000..3dda7e8 --- /dev/null +++ b/compiler/hsSyn/HsInstances.hs-boot @@ -0,0 +1,20 @@ +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE UndecidableInstances #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +module HsInstances where + +import Data.Data hiding ( Fixity ) +import HsExtension ( DataIdLR ) +import HsBinds +import HsDecls +import HsTypes + +instance (DataIdLR p p) => Data (VectDecl p) +instance (DataIdLR pL pR) => Data (HsLocalBindsLR pL pR) +instance (DataIdLR p p) => Data (HsDecl p) +instance (DataIdLR p p) => Data (HsGroup p) +instance (DataIdLR pL pL) => Data (NHsValBindsLR pL) +instance (DataIdLR p p) => Data (FamEqn p (HsTyPats p) (HsDataDefn p)) +instance (DataIdLR p p) => Data (FamEqn p (HsTyPats p) (LHsType p)) diff --git a/compiler/hsSyn/HsInstances2.hs b/compiler/hsSyn/HsInstances2.hs index 1e5ee72..2250387 100644 --- a/compiler/hsSyn/HsInstances2.hs +++ b/compiler/hsSyn/HsInstances2.hs @@ -4,8 +4,8 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-} -{-# GHC_OPTIONS -fno-warn-orphans #-} -module HsInstances where +{-# OPTIONS_GHC -fno-warn-orphans #-} +module HsInstances2 where -- This module defines the Data instances for the hsSyn AST. @@ -14,12 +14,11 @@ module HsInstances where -- UndecidableInstances ? -import GhcPrelude import Data.Data hiding ( Fixity ) -import {-# +import {-# SOURCE #-} HsInstances () import HsExtension -import HsBinds +-- import HsBinds import HsDecls import HsExpr import HsLit @@ -72,7 +71,7 @@ deriving instance (DataId p) => Data (WarnDecl p) deriving instance (DataIdLR p p) => Data (AnnDecl p) deriving instance (DataId p) => Data (RoleAnnotDecl p) deriving instance (DataIdLR p p) => Data (FamEqn p (HsTyPats p) (LHsType p)) - +-} -- Data derivations from HsExpr ---------------------------------------- deriving instance (DataIdLR p p) => Data (SyntaxExpr p) diff --git a/compiler/hsSyn/HsInstances2.hs-boot b/compiler/hsSyn/HsInstances2.hs-boot new file mode 100644 index 0000000..16ac7ee --- /dev/null +++ b/compiler/hsSyn/HsInstances2.hs-boot @@ -0,0 +1,31 @@ +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE UndecidableInstances #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +module HsInstances2 where + + +import Data.Data hiding ( Fixity ) +import HsExtension ( DataIdLR ) +import HsDecls +import HsExpr +import HsTypes +import HsPat + +instance (DataIdLR p p) => Data (HsExpr p) +instance (DataIdLR p p) => Data (HsTyVarBndr p) +instance (DataIdLR p p) => Data (HsType p) +instance (DataIdLR p p) => Data (LHsQTyVars p) +instance (DataIdLR p p) => Data (HsImplicitBndrs p (LHsType p)) +instance (DataIdLR p p) => Data (HsImplicitBndrs p (FamEqn p (HsTyPats p) (HsDataDefn p))) +instance (DataIdLR p p) => Data (HsImplicitBndrs p (FamEqn p (HsTyPats p) (LHsType p))) +instance (DataIdLR p p) => Data (HsWildCardBndrs p (LHsSigType p)) +instance (DataIdLR p p) => Data (ConDeclField p) + +instance (DataIdLR p p) => Data (HsSplice p) +instance (DataIdLR p p) => Data (MatchGroup p (LHsExpr p)) + +instance (DataIdLR p p) => Data (Pat p) + +instance (DataIdLR p p) => Data (GRHSs p (LHsExpr p)) diff --git a/compiler/hsSyn/HsPat.hs-boot b/compiler/hsSyn/HsPat.hs-boot index dfd5359..203209d 100644 --- a/compiler/hsSyn/HsPat.hs-boot +++ b/compiler/hsSyn/HsPat.hs-boot @@ -9,7 +9,6 @@ module HsPat where import SrcLoc( Located ) -import Data.Data hiding (Fixity) import Outputable import HsExtension ( SourceTextX, OutputableBndrId, GhcPass ) diff --git a/compiler/hsSyn/HsSyn.hs b/compiler/hsSyn/HsSyn.hs index 83147b6..54ba278 100644 --- a/compiler/hsSyn/HsSyn.hs +++ b/compiler/hsSyn/HsSyn.hs @@ -32,7 +32,6 @@ module HsSyn ( Fixity, HsModule(..), - HsInstances ) where -- friends: From git at git.haskell.org Wed Nov 15 21:59:49 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 15 Nov 2017 21:59:49 +0000 (UTC) Subject: [commit: ghc] master: Squashed 'hadrian/' changes from 5ebb69a..fa3771f (c1fcd9b) Message-ID: <20171115215949.8DA903A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c1fcd9b3f60e8420dd228cd4e3efeb9cfa793aa5/ghc >--------------------------------------------------------------- commit c1fcd9b3f60e8420dd228cd4e3efeb9cfa793aa5 Author: Andrey Mokhov Date: Wed Nov 15 21:58:18 2017 +0000 Squashed 'hadrian/' changes from 5ebb69a..fa3771f fa3771f hadrian: Disable -Wno-undef in files which include ffi.h (#459) f15e851 Do not run configure by default (#458) 5baa8db Fix AppVeyor cache failure (#456) 94dbe9d Fix ghc-cabal build (#455) a679764 Fix CI scripts (#454) 06ec241 Widen bounds on Cabal (#452) git-subtree-dir: hadrian git-subtree-split: fa3771fe6baf5008a8506fec48220f8347ac59af >--------------------------------------------------------------- c1fcd9b3f60e8420dd228cd4e3efeb9cfa793aa5 .travis.yml | 12 +++++++----- README.md | 28 ++++++++++++++-------------- appveyor.yml | 28 +++++++++++++++------------- cabal.project | 8 ++++++-- circle.yml | 7 ++++--- doc/cross-compile.md | 4 ++-- hadrian.cabal | 2 +- src/CommandLine.hs | 32 ++++++++++++++++---------------- src/Rules/Configure.hs | 15 ++++++++------- src/Settings/Packages/GhcCabal.hs | 11 +++++++++-- src/Settings/Packages/Rts.hs | 8 +++++++- stack.yaml | 4 ++++ 12 files changed, 93 insertions(+), 66 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc c1fcd9b3f60e8420dd228cd4e3efeb9cfa793aa5 From git at git.haskell.org Wed Nov 15 21:59:52 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 15 Nov 2017 21:59:52 +0000 (UTC) Subject: [commit: ghc] master: Pull recent Hadrian changes from upstream (07ac921) Message-ID: <20171115215952.6A5663A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/07ac921f48baea84b40835b0b7c476806f7f63f6/ghc >--------------------------------------------------------------- commit 07ac921f48baea84b40835b0b7c476806f7f63f6 Merge: ec080ea c1fcd9b Author: Andrey Mokhov Date: Wed Nov 15 21:58:19 2017 +0000 Pull recent Hadrian changes from upstream Merge commit 'c1fcd9b3f60e8420dd228cd4e3efeb9cfa793aa5' >--------------------------------------------------------------- 07ac921f48baea84b40835b0b7c476806f7f63f6 hadrian/.travis.yml | 12 +++++++----- hadrian/README.md | 28 +++++++++++++-------------- hadrian/appveyor.yml | 28 ++++++++++++++------------- hadrian/cabal.project | 8 ++++++-- hadrian/circle.yml | 7 ++++--- hadrian/doc/cross-compile.md | 4 ++-- hadrian/hadrian.cabal | 2 +- hadrian/src/CommandLine.hs | 32 +++++++++++++++---------------- hadrian/src/Rules/Configure.hs | 15 ++++++++------- hadrian/src/Settings/Packages/GhcCabal.hs | 11 +++++++++-- hadrian/src/Settings/Packages/Rts.hs | 8 +++++++- hadrian/stack.yaml | 4 ++++ 12 files changed, 93 insertions(+), 66 deletions(-) From git at git.haskell.org Thu Nov 16 13:49:25 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 16 Nov 2017 13:49:25 +0000 (UTC) Subject: [commit: ghc] master: Detect overly long GC sync (2f46387) Message-ID: <20171116134925.706363A5EA@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2f4638735ad1526d6502a4706bffafffb93e24da/ghc >--------------------------------------------------------------- commit 2f4638735ad1526d6502a4706bffafffb93e24da Author: Simon Marlow Date: Wed Feb 11 14:19:21 2015 +0000 Detect overly long GC sync Summary: GC sync is the time between a GC being intiated and all the mutator threads finally stopping so that the GC can start. Problems that cause the GC sync to be delayed are hard to find and can cause dramatic slowdowns for heavily parallel programs. The new flag --long-gc-sync=