From git at git.haskell.org Mon Aug 1 00:05:48 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 1 Aug 2016 00:05:48 +0000 (UTC) Subject: [commit: ghc] wip/12368: Dmd Anal: Fix refactoring fallout (3708db4) Message-ID: <20160801000548.B45B43A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/12368 Link : http://ghc.haskell.org/trac/ghc/changeset/3708db4c1966ede3fe92f33cc17e5e9ef0933c40/ghc >--------------------------------------------------------------- commit 3708db4c1966ede3fe92f33cc17e5e9ef0933c40 Author: Joachim Breitner Date: Sun Jul 31 20:04:54 2016 -0400 Dmd Anal: Fix refactoring fallout This one-character typo (id instead of id1) was really hard to track down :-(. Lets see if this finally works now. >--------------------------------------------------------------- 3708db4c1966ede3fe92f33cc17e5e9ef0933c40 compiler/stranal/DmdAnal.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/compiler/stranal/DmdAnal.hs b/compiler/stranal/DmdAnal.hs index 9bdc233..64c6850 100644 --- a/compiler/stranal/DmdAnal.hs +++ b/compiler/stranal/DmdAnal.hs @@ -284,7 +284,8 @@ dmdAnal' env dmd (Let (NonRec id rhs) body) = (body_ty2, Let (NonRec id2 rhs') body') where (lazy_fv, id1, rhs') = dmdAnalRhsLetDown NotTopLevel Nothing env id rhs - (body_ty, body') = dmdAnal (extendAnalEnv NotTopLevel env id (idStrictness id)) dmd body + env1 = extendAnalEnv NotTopLevel env id1 (idStrictness id1) + (body_ty, body') = dmdAnal env1 dmd body (body_ty1, id2) = annotateBndr env body_ty id1 body_ty2 = addLazyFVs body_ty1 lazy_fv -- see Note [Lazy and unleasheable free variables] From git at git.haskell.org Mon Aug 1 01:00:12 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 1 Aug 2016 01:00:12 +0000 (UTC) Subject: [commit: ghc] wip/12368: Dmd Anal: Fix refactoring fallout (7ed1d0e) Message-ID: <20160801010012.54FB23A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/12368 Link : http://ghc.haskell.org/trac/ghc/changeset/7ed1d0e2c557e932a209f586593a8ef987ccdb34/ghc >--------------------------------------------------------------- commit 7ed1d0e2c557e932a209f586593a8ef987ccdb34 Author: Joachim Breitner Date: Sun Jul 31 20:04:54 2016 -0400 Dmd Anal: Fix refactoring fallout This one-character typo (id instead of id1) was really hard to track down :-(. Lets see if this finally works now. >--------------------------------------------------------------- 7ed1d0e2c557e932a209f586593a8ef987ccdb34 compiler/stranal/DmdAnal.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/compiler/stranal/DmdAnal.hs b/compiler/stranal/DmdAnal.hs index 22e1faa..7fdd58c 100644 --- a/compiler/stranal/DmdAnal.hs +++ b/compiler/stranal/DmdAnal.hs @@ -284,7 +284,8 @@ dmdAnal' env dmd (Let (NonRec id rhs) body) = (body_ty2, Let (NonRec id2 rhs') body') where (lazy_fv, id1, rhs') = dmdAnalRhsLetDown NotTopLevel Nothing env id rhs - (body_ty, body') = dmdAnal (extendAnalEnv NotTopLevel env id (idStrictness id)) dmd body + env1 = extendAnalEnv NotTopLevel env id1 (idStrictness id1) + (body_ty, body') = dmdAnal env1 dmd body (body_ty1, id2) = annotateBndr env body_ty id1 body_ty2 = addLazyFVs body_ty1 lazy_fv -- see Note [Lazy and unleasheable free variables] From git at git.haskell.org Mon Aug 1 01:00:15 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 1 Aug 2016 01:00:15 +0000 (UTC) Subject: [commit: ghc] wip/12368: Comments only: Refer to actually existing Notes (581022b) Message-ID: <20160801010015.3B1DC3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/12368 Link : http://ghc.haskell.org/trac/ghc/changeset/581022b43a80288051a0e2c2c22a4d8fff8d4a43/ghc >--------------------------------------------------------------- commit 581022b43a80288051a0e2c2c22a4d8fff8d4a43 Author: Joachim Breitner Date: Sun Jul 31 20:59:54 2016 -0400 Comments only: Refer to actually existing Notes >--------------------------------------------------------------- 581022b43a80288051a0e2c2c22a4d8fff8d4a43 compiler/stranal/DmdAnal.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/compiler/stranal/DmdAnal.hs b/compiler/stranal/DmdAnal.hs index 7fdd58c..721833a 100644 --- a/compiler/stranal/DmdAnal.hs +++ b/compiler/stranal/DmdAnal.hs @@ -67,8 +67,9 @@ dmdAnalTopBind sigs (NonRec id rhs) ( _, _, rhs1) = dmdAnalRhsLetDown TopLevel Nothing sigs id rhs ( _, id2, rhs2) = dmdAnalRhsLetDown TopLevel Nothing (nonVirgin sigs) id rhs1 -- Do two passes to improve CPR information - -- See comments with ignore_cpr_info in mk_sig_ty - -- and with extendSigsWithLam + -- See Note [CPR for thunks] + -- See Note [Optimistic CPR in the "virgin" case] + -- See Note [Initial CPR for strict binders] dmdAnalTopBind sigs (Rec pairs) = (sigs', Rec pairs') From git at git.haskell.org Mon Aug 1 08:36:20 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 1 Aug 2016 08:36:20 +0000 (UTC) Subject: [commit: ghc] master: Relevant Bindings no longer reports shadowed bindings (fixes #12176) (89ae1e8) Message-ID: <20160801083620.B6F1A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/89ae1e858f6eed42cebd9af01b30e239d4543faf/ghc >--------------------------------------------------------------- commit 89ae1e858f6eed42cebd9af01b30e239d4543faf Author: Annie Cherkaev Date: Sun Jul 31 23:30:42 2016 -0700 Relevant Bindings no longer reports shadowed bindings (fixes #12176) Summary: Modified the RelevantBindings method in TcErrors.hs to only search over non-shadowed bindings. Test Plan: Wrote 2 simple test cases, verified that it worked with multiple shadowed bindings, and also non-shadowed bindings. Reviewers: austin, bgamari, ezyang Reviewed By: ezyang Subscribers: ezyang, thomie Differential Revision: https://phabricator.haskell.org/D2434 GHC Trac Issues: #12177 >--------------------------------------------------------------- 89ae1e858f6eed42cebd9af01b30e239d4543faf compiler/typecheck/TcErrors.hs | 12 +++++++++- compiler/typecheck/TcRnTypes.hs | 6 ++++- testsuite/tests/typecheck/should_fail/T12177.hs | 5 ++++ .../tests/typecheck/should_fail/T12177.stderr | 28 ++++++++++++++++++++++ testsuite/tests/typecheck/should_fail/all.T | 1 + 5 files changed, 50 insertions(+), 2 deletions(-) diff --git a/compiler/typecheck/TcErrors.hs b/compiler/typecheck/TcErrors.hs index 9cccb63..1906729 100644 --- a/compiler/typecheck/TcErrors.hs +++ b/compiler/typecheck/TcErrors.hs @@ -2546,7 +2546,7 @@ relevantBindings want_filtering ctxt ct ; (tidy_env', docs, discards) <- go env1 ct_tvs (maxRelevantBinds dflags) emptyVarSet [] False - (tcl_bndrs lcl_env) + (remove_shadowing $ tcl_bndrs lcl_env) -- tcl_bndrs has the innermost bindings first, -- which are probably the most relevant ones @@ -2572,6 +2572,16 @@ relevantBindings want_filtering ctxt ct dec_max :: Maybe Int -> Maybe Int dec_max = fmap (\n -> n - 1) + ---- fixes #12177 + ---- builds up a list of bindings whose OccName has not been seen before + remove_shadowing :: [TcIdBinder] -> [TcIdBinder] + remove_shadowing bindings = reverse $ fst $ foldl + (\(bindingAcc, seenNames) binding -> + if (occName binding) `elemOccSet` seenNames -- if we've seen it + then (bindingAcc, seenNames) -- skip it + else (binding:bindingAcc, extendOccSet seenNames (occName binding))) + ([], emptyOccSet) bindings + go :: TidyEnv -> TcTyVarSet -> Maybe Int -> TcTyVarSet -> [SDoc] -> Bool -- True <=> some filtered out due to lack of fuel -> [TcIdBinder] diff --git a/compiler/typecheck/TcRnTypes.hs b/compiler/typecheck/TcRnTypes.hs index cc94001..e69e115 100644 --- a/compiler/typecheck/TcRnTypes.hs +++ b/compiler/typecheck/TcRnTypes.hs @@ -142,7 +142,7 @@ import Coercion ( Coercion, mkHoleCo ) import ConLike ( ConLike(..) ) import DataCon ( DataCon, dataConUserType, dataConOrigArgTys ) import PatSyn ( PatSyn, pprPatSynType ) -import Id ( idType ) +import Id ( idType, idName ) import FieldLabel ( FieldLabel ) import TcType import Annotations @@ -779,6 +779,10 @@ instance Outputable TcIdBinder where ppr (TcIdBndr id top_lvl) = ppr id <> brackets (ppr top_lvl) ppr (TcIdBndr_ExpType id _ top_lvl) = ppr id <> brackets (ppr top_lvl) +instance HasOccName TcIdBinder where + occName (TcIdBndr id _) = (occName (idName id)) + occName (TcIdBndr_ExpType name _ _) = (occName name) + --------------------------- -- Template Haskell stages and levels --------------------------- diff --git a/testsuite/tests/typecheck/should_fail/T12177.hs b/testsuite/tests/typecheck/should_fail/T12177.hs new file mode 100644 index 0000000..4845e7f --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T12177.hs @@ -0,0 +1,5 @@ +module Foo where + +bar = \x -> \x -> _ + +baz = \x -> \y -> \z -> \x -> \z -> _ diff --git a/testsuite/tests/typecheck/should_fail/T12177.stderr b/testsuite/tests/typecheck/should_fail/T12177.stderr new file mode 100644 index 0000000..48bf94d --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T12177.stderr @@ -0,0 +1,28 @@ + +T12177.hs:3:19: error: + • Found hole: _ :: t + Where: ‘t’ is a rigid type variable bound by + the inferred type of bar :: t2 -> t1 -> t + at T12177.hs:3:1-19 + • In the expression: _ + In the expression: \ x -> _ + In the expression: \ x -> \ x -> _ + • Relevant bindings include + x :: t1 (bound at T12177.hs:3:14) + bar :: t2 -> t1 -> t (bound at T12177.hs:3:1) + +T12177.hs:5:37: error: + • Found hole: _ :: t + Where: ‘t’ is a rigid type variable bound by + the inferred type of baz :: t5 -> t4 -> t3 -> t2 -> t1 -> t + at T12177.hs:5:1-37 + • In the expression: _ + In the expression: \ z -> _ + In the expression: \ x -> \ z -> _ + • Relevant bindings include + z :: t1 (bound at T12177.hs:5:32) + x :: t2 (bound at T12177.hs:5:26) + y :: t4 (bound at T12177.hs:5:14) + baz :: t5 -> t4 -> t3 -> t2 -> t1 -> t + (bound at T12177.hs:5:1) + \ No newline at end of file diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T index 41dcca7..acc3f9f 100644 --- a/testsuite/tests/typecheck/should_fail/all.T +++ b/testsuite/tests/typecheck/should_fail/all.T @@ -423,3 +423,4 @@ test('T12063', [ expect_broken(12063), extra_clean(['T12063.hi-boot', 'T12063.o- test('T11974b', normal, compile_fail, ['']) test('T12151', normal, compile_fail, ['']) test('T7437', normal, compile_fail, ['']) +test('T12177', normal, compile_fail, ['']) \ No newline at end of file From git at git.haskell.org Mon Aug 1 08:47:19 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 1 Aug 2016 08:47:19 +0000 (UTC) Subject: [commit: ghc] master: Use MO_Cmpxchg in Primops.cmm instead of ccall cas(..) (750553a) Message-ID: <20160801084719.38ECA3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/750553a68c126bdbee3d325a606a9537a8d53141/ghc >--------------------------------------------------------------- commit 750553a68c126bdbee3d325a606a9537a8d53141 Author: alexbiehl Date: Mon Aug 1 18:46:29 2016 +1000 Use MO_Cmpxchg in Primops.cmm instead of ccall cas(..) Adjust `CmmParse.y` to parse the `cmpxchg{8, 16, 32, 64}` instructions and use the 32 respectively the 64 bit variant in `Primops.cmm`. This effectively eliminates the compare-and-swap ccall to the rts. Based off the mailing list question from @osa1 (https://mail.haskell.org/pipermail/ghc-devs/2016-July/012506.html). Reviewers: simonmar, austin, erikd, bgamari, trommler Reviewed By: erikd, bgamari, trommler Subscribers: carter, trommler, osa1, thomie Differential Revision: https://phabricator.haskell.org/D2431 >--------------------------------------------------------------- 750553a68c126bdbee3d325a606a9537a8d53141 compiler/cmm/CmmParse.y | 7 ++++++- includes/Cmm.h | 10 ++++++++++ rts/PrimOps.cmm | 10 +++++----- 3 files changed, 21 insertions(+), 6 deletions(-) diff --git a/compiler/cmm/CmmParse.y b/compiler/cmm/CmmParse.y index 128cc4e..b8c100a 100644 --- a/compiler/cmm/CmmParse.y +++ b/compiler/cmm/CmmParse.y @@ -987,7 +987,12 @@ callishMachOps = listToUFM $ ( "popcnt8", (,) $ MO_PopCnt W8 ), ( "popcnt16", (,) $ MO_PopCnt W16 ), ( "popcnt32", (,) $ MO_PopCnt W32 ), - ( "popcnt64", (,) $ MO_PopCnt W64 ) + ( "popcnt64", (,) $ MO_PopCnt W64 ), + + ( "cmpxchg8", (,) $ MO_Cmpxchg W8 ), + ( "cmpxchg16", (,) $ MO_Cmpxchg W16 ), + ( "cmpxchg32", (,) $ MO_Cmpxchg W32 ), + ( "cmpxchg64", (,) $ MO_Cmpxchg W64 ) -- ToDo: the rest, maybe -- edit: which rest? diff --git a/includes/Cmm.h b/includes/Cmm.h index 3b9a5a6..9b7a4e4 100644 --- a/includes/Cmm.h +++ b/includes/Cmm.h @@ -179,6 +179,16 @@ #endif /* ----------------------------------------------------------------------------- + Atomic memory operations. + -------------------------------------------------------------------------- */ + +#if SIZEOF_W == 4 +#define cmpxchgW cmpxchg32 +#elif SIZEOF_W == 8 +#define cmpxchgW cmpxchg64 +#endif + +/* ----------------------------------------------------------------------------- Heap/stack access, and adjusting the heap/stack pointers. -------------------------------------------------------------------------- */ diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm index 60d8106..b468c33 100644 --- a/rts/PrimOps.cmm +++ b/rts/PrimOps.cmm @@ -221,7 +221,7 @@ stg_casIntArrayzh( gcptr arr, W_ ind, W_ old, W_ new ) W_ p, h; p = arr + SIZEOF_StgArrBytes + WDS(ind); - (h) = ccall cas(p, old, new); + (h) = prim %cmpxchgW(p, old, new); return(h); } @@ -338,7 +338,7 @@ stg_casArrayzh ( gcptr arr, W_ ind, gcptr old, gcptr new ) W_ p, len; p = arr + SIZEOF_StgMutArrPtrs + WDS(ind); - (h) = ccall cas(p, old, new); + (h) = prim %cmpxchgW(p, old, new); if (h != old) { // Failure, return what was there instead of 'old': @@ -490,7 +490,7 @@ stg_casSmallArrayzh ( gcptr arr, W_ ind, gcptr old, gcptr new ) W_ p, len; p = arr + SIZEOF_StgSmallMutArrPtrs + WDS(ind); - (h) = ccall cas(p, old, new); + (h) = prim %cmpxchgW(p, old, new); if (h != old) { // Failure, return what was there instead of 'old': @@ -530,7 +530,7 @@ stg_casMutVarzh ( gcptr mv, gcptr old, gcptr new ) { gcptr h; - (h) = ccall cas(mv + SIZEOF_StgHeader + OFFSET_StgMutVar_var, old, new); + (h) = prim %cmpxchgW(mv + SIZEOF_StgHeader + OFFSET_StgMutVar_var, old, new); if (h != old) { return (1,h); } else { @@ -606,7 +606,7 @@ stg_atomicModifyMutVarzh ( gcptr mv, gcptr f ) x = StgMutVar_var(mv); StgThunk_payload(z,1) = x; #ifdef THREADED_RTS - (h) = ccall cas(mv + SIZEOF_StgHeader + OFFSET_StgMutVar_var, x, y); + (h) = prim %cmpxchgW(mv + SIZEOF_StgHeader + OFFSET_StgMutVar_var, x, y); if (h != x) { goto retry; } #else StgMutVar_var(mv) = y; From git at git.haskell.org Mon Aug 1 10:55:27 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 1 Aug 2016 10:55:27 +0000 (UTC) Subject: [commit: ghc] wip/12368: DmdAnal: Testcase about splitFVs and dmdFix abortion (bf40ea3) Message-ID: <20160801105527.D2CDC3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/12368 Link : http://ghc.haskell.org/trac/ghc/changeset/bf40ea34354760028acea69a822eca6ee621b7db/ghc >--------------------------------------------------------------- commit bf40ea34354760028acea69a822eca6ee621b7db Author: Joachim Breitner Date: Thu Jul 21 17:44:25 2016 +0200 DmdAnal: Testcase about splitFVs and dmdFix abortion Any variable with useful information (strict or used-once) will not be included in lazy_fv (according to splitFVs). If we now also remove them from the strictness signatures, their uses are not recorded anywhere – and then probably considered absent. >--------------------------------------------------------------- bf40ea34354760028acea69a822eca6ee621b7db testsuite/tests/stranal/should_run/T12368a.hs | 27 +++++++++++++++++++++++ testsuite/tests/stranal/should_run/T12368a.stderr | 3 +++ 2 files changed, 30 insertions(+) diff --git a/testsuite/tests/stranal/should_run/T12368a.hs b/testsuite/tests/stranal/should_run/T12368a.hs new file mode 100644 index 0000000..738e8ef --- /dev/null +++ b/testsuite/tests/stranal/should_run/T12368a.hs @@ -0,0 +1,27 @@ +-- Needs to be a product type +data Stream = S Int Stream + +-- a is wrongly recorded abstent if the non-lazy-fv from foo are thrown away. +bar :: Int -> Int -> Stream -> Int +bar a n s = foo n s + where + -- Non terminating local rec, strict in a + foo :: Int -> Stream -> Int + foo 0 (S n s) = a + foo i (S n s) = a `seq` n + foo (i-1) s +{-# NOINLINE bar #-} + + +baz :: Int -> Int -> Int +baz 0 not_absent = 0 +baz 1 not_absent = baz 2 not_absent +baz x not_absent = bar not_absent 1000 arg + where + arg = S 1 arg + +bamf x = baz x (error "This is good!") +{-# NOINLINE bamf #-} + + +main :: IO () +main = bamf 10 `seq` return () diff --git a/testsuite/tests/stranal/should_run/T12368a.stderr b/testsuite/tests/stranal/should_run/T12368a.stderr new file mode 100644 index 0000000..98246d3 --- /dev/null +++ b/testsuite/tests/stranal/should_run/T12368a.stderr @@ -0,0 +1,3 @@ +T12368a: This is good! +CallStack (from HasCallStack): + error, called at T12368a.hs:22:17 in main:Main From git at git.haskell.org Mon Aug 1 10:55:30 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 1 Aug 2016 10:55:30 +0000 (UTC) Subject: [commit: ghc] wip/12368: Degrade "case scrutinee not known to diverge for sure" Lint error (d1f5ff4) Message-ID: <20160801105530.923413A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/12368 Link : http://ghc.haskell.org/trac/ghc/changeset/d1f5ff40718a4bdf8b6acb15a963ae661cb5310e/ghc >--------------------------------------------------------------- commit d1f5ff40718a4bdf8b6acb15a963ae661cb5310e Author: Joachim Breitner Date: Tue Jul 26 11:44:53 2016 +0200 Degrade "case scrutinee not known to diverge for sure" Lint error as proposed in #12435. For now, this is just on my branch to be able to continue compilation on the auto-builders. >--------------------------------------------------------------- d1f5ff40718a4bdf8b6acb15a963ae661cb5310e compiler/coreSyn/CoreLint.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/coreSyn/CoreLint.hs b/compiler/coreSyn/CoreLint.hs index dead929..d13d186 100644 --- a/compiler/coreSyn/CoreLint.hs +++ b/compiler/coreSyn/CoreLint.hs @@ -715,7 +715,7 @@ lintCoreExpr e@(Case scrut var alt_ty alts) = ; when (null alts) $ do { checkL (not (exprIsHNF scrut)) (text "No alternatives for a case scrutinee in head-normal form:" <+> ppr scrut) - ; checkL scrut_diverges + ; checkWarnL scrut_diverges (text "No alternatives for a case scrutinee not known to diverge for sure:" <+> ppr scrut) } From git at git.haskell.org Mon Aug 1 10:55:33 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 1 Aug 2016 10:55:33 +0000 (UTC) Subject: [commit: ghc] wip/12368: WwLib: Add strictness signature to "let x = absentError …" (f0fc168) Message-ID: <20160801105533.4FFA83A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/12368 Link : http://ghc.haskell.org/trac/ghc/changeset/f0fc168305ab8550413f446dd45eaebecd009aac/ghc >--------------------------------------------------------------- commit f0fc168305ab8550413f446dd45eaebecd009aac Author: Joachim Breitner Date: Tue Jul 26 12:08:59 2016 +0200 WwLib: Add strictness signature to "let x = absentError …" indicating that it is bottom. This should help making the "empty cases" lint error give less false alarms. >--------------------------------------------------------------- f0fc168305ab8550413f446dd45eaebecd009aac compiler/basicTypes/Demand.hs | 9 ++++++--- compiler/stranal/WwLib.hs | 11 ++++++----- 2 files changed, 12 insertions(+), 8 deletions(-) diff --git a/compiler/basicTypes/Demand.hs b/compiler/basicTypes/Demand.hs index 2ada6b3..d79fa6e 100644 --- a/compiler/basicTypes/Demand.hs +++ b/compiler/basicTypes/Demand.hs @@ -35,7 +35,8 @@ module Demand ( vanillaCprProdRes, cprSumRes, appIsBottom, isBottomingSig, pprIfaceStrictSig, trimCPRInfo, returnsCPR_maybe, - StrictSig(..), mkStrictSig, mkClosedStrictSig, nopSig, botSig, cprProdSig, + StrictSig(..), mkStrictSig, mkClosedStrictSig, + nopSig, botSig, exnSig, cprProdSig, isTopSig, hasDemandEnvSig, splitStrictSig, strictSigDmdEnv, increaseStrictSigArity, @@ -1264,9 +1265,10 @@ emptyDmdEnv = emptyVarEnv -- (lazy, absent, no CPR information, no termination information). -- Note that it is ''not'' the top of the lattice (which would be "may use everything"), -- so it is (no longer) called topDmd -nopDmdType, botDmdType :: DmdType +nopDmdType, botDmdType, exnDmdType :: DmdType nopDmdType = DmdType emptyDmdEnv [] topRes botDmdType = DmdType emptyDmdEnv [] botRes +exnDmdType = DmdType emptyDmdEnv [] exnRes cprProdDmdType :: Arity -> DmdType cprProdDmdType arity @@ -1691,9 +1693,10 @@ isBottomingSig :: StrictSig -> Bool -- True if the signature diverges or throws an exception isBottomingSig (StrictSig (DmdType _ _ res)) = isBotRes res -nopSig, botSig :: StrictSig +nopSig, botSig, exnSig :: StrictSig nopSig = StrictSig nopDmdType botSig = StrictSig botDmdType +exnSig = StrictSig exnDmdType cprProdSig :: Arity -> StrictSig cprProdSig arity = StrictSig (cprProdDmdType arity) diff --git a/compiler/stranal/WwLib.hs b/compiler/stranal/WwLib.hs index 812252c..c0b1af3 100644 --- a/compiler/stranal/WwLib.hs +++ b/compiler/stranal/WwLib.hs @@ -709,7 +709,7 @@ every primitive type, so the function is partial. mk_absent_let :: DynFlags -> Id -> Maybe (CoreExpr -> CoreExpr) mk_absent_let dflags arg | not (isUnliftedType arg_ty) - = Just (Let (NonRec arg abs_rhs)) + = Just (Let (NonRec lifted_arg abs_rhs)) | Just tc <- tyConAppTyCon_maybe arg_ty , Just lit <- absentLiteralOf tc = Just (Let (NonRec arg (Lit lit))) @@ -719,10 +719,11 @@ mk_absent_let dflags arg = WARN( True, text "No absent value for" <+> ppr arg_ty ) Nothing where - arg_ty = idType arg - abs_rhs = mkRuntimeErrorApp aBSENT_ERROR_ID arg_ty msg - msg = showSDoc (gopt_set dflags Opt_SuppressUniques) - (ppr arg <+> ppr (idType arg)) + arg_ty = idType arg + abs_rhs = mkRuntimeErrorApp aBSENT_ERROR_ID arg_ty msg + lifted_arg = arg `setIdStrictness` exnSig + msg = showSDoc (gopt_set dflags Opt_SuppressUniques) + (ppr arg <+> ppr (idType arg)) -- We need to suppress uniques here because otherwise they'd -- end up in the generated code as strings. This is bad for -- determinism, because with different uniques the strings From git at git.haskell.org Mon Aug 1 10:55:35 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 1 Aug 2016 10:55:35 +0000 (UTC) Subject: [commit: ghc] wip/12368: Comments only: Refer to actually existing Notes (0dd9079) Message-ID: <20160801105535.E31FC3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/12368 Link : http://ghc.haskell.org/trac/ghc/changeset/0dd90792a263b0382449ac721df788ad4a86c154/ghc >--------------------------------------------------------------- commit 0dd90792a263b0382449ac721df788ad4a86c154 Author: Joachim Breitner Date: Sun Jul 31 20:59:54 2016 -0400 Comments only: Refer to actually existing Notes >--------------------------------------------------------------- 0dd90792a263b0382449ac721df788ad4a86c154 compiler/stranal/DmdAnal.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/compiler/stranal/DmdAnal.hs b/compiler/stranal/DmdAnal.hs index c7f0767..44d2d20 100644 --- a/compiler/stranal/DmdAnal.hs +++ b/compiler/stranal/DmdAnal.hs @@ -67,8 +67,9 @@ dmdAnalTopBind sigs (NonRec id rhs) ( _, _, _, rhs1) = dmdAnalRhsLetDown TopLevel Nothing sigs id rhs (sig, _, id2, rhs2) = dmdAnalRhsLetDown TopLevel Nothing (nonVirgin sigs) id rhs1 -- Do two passes to improve CPR information - -- See comments with ignore_cpr_info in mk_sig_ty - -- and with extendSigsWithLam + -- See Note [CPR for thunks] + -- See Note [Optimistic CPR in the "virgin" case] + -- See Note [Initial CPR for strict binders] dmdAnalTopBind sigs (Rec pairs) = (sigs', Rec pairs') From git at git.haskell.org Mon Aug 1 10:55:38 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 1 Aug 2016 10:55:38 +0000 (UTC) Subject: [commit: ghc] wip/12368: DmdAnal: Add a final, safe iteration (6889763) Message-ID: <20160801105538.96D703A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/12368 Link : http://ghc.haskell.org/trac/ghc/changeset/6889763ea73b64214ddd21762f55b990ec15a42c/ghc >--------------------------------------------------------------- commit 6889763ea73b64214ddd21762f55b990ec15a42c Author: Joachim Breitner Date: Thu Jul 7 11:23:48 2016 +0200 DmdAnal: Add a final, safe iteration this fixes #12368. It also refactors dmdFix a bit, removes some redundancies (such as passing around an strictness signature right next to an id, when that id is guaranteed to have been annotated with that strictness signature). Note that when fixed-point iteration does not terminate, we conservatively delete their strictness signatures (set them to nopSig). But this loses the information on how its strict free variables are used! Lazily used variables already escape via lazy_fvs. We ensure that in the case of an aborted fixed-point iteration, also the strict variables are put there (with a conservative demand of topDmd). Differential Revision: https://phabricator.haskell.org/D2392 >--------------------------------------------------------------- 6889763ea73b64214ddd21762f55b990ec15a42c compiler/basicTypes/Demand.hs | 7 +- compiler/basicTypes/VarEnv.hs | 5 +- compiler/stranal/DmdAnal.hs | 181 ++++++++++++++++++------------- compiler/utils/UniqFM.hs | 6 + testsuite/tests/stranal/should_run/all.T | 3 +- 5 files changed, 121 insertions(+), 81 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 6889763ea73b64214ddd21762f55b990ec15a42c From git at git.haskell.org Mon Aug 1 10:55:41 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 1 Aug 2016 10:55:41 +0000 (UTC) Subject: [commit: ghc] wip/12368's head updated: WwLib: Add strictness signature to "let x = absentError …" (f0fc168) Message-ID: <20160801105541.046DF3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/12368' now includes: 8265c78 Fix and document Unique generation for sum TyCon and DataCons e710f8f Correct a few mistyped words in prose/comments bbf36f8 More typos in comments fb34b27 Revert "Cleanup PosixSource.h" 86b1522 Unboxed sums: More unit tests bfef2eb StgCmmBind: Some minor simplifications c4f3d91 Add deepseq dependency and a few NFData instances 648fd73 Squash space leaks in the result of byteCodeGen 7f0f1d7 -fprof-auto-top 1fe5c89 UNPACK the size field of SizedSeq d068220 Fix the non-Linux build 4036c1f Testsuite: fix T10482a 1967d74 Some typos in comments a9251c6 MonadUtils: Typos in comments 1783011 Fix productivity calculation (#12424) 9d62f0d Accept better stats for T9675 8f63ba3 Compute boot-defined TyCon names from ModIface. b0a5144 Add mblocks_allocated to GC stats API e98edbd Move stat_startGCSync d3feb16 Make Unique a newtype c06e3f4 Add atomic operations to package.conf.in 89ae1e8 Relevant Bindings no longer reports shadowed bindings (fixes #12176) 750553a Use MO_Cmpxchg in Primops.cmm instead of ccall cas(..) 0dd9079 Comments only: Refer to actually existing Notes 6889763 DmdAnal: Add a final, safe iteration bf40ea3 DmdAnal: Testcase about splitFVs and dmdFix abortion d1f5ff4 Degrade "case scrutinee not known to diverge for sure" Lint error f0fc168 WwLib: Add strictness signature to "let x = absentError …" From git at git.haskell.org Mon Aug 1 11:02:22 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 1 Aug 2016 11:02:22 +0000 (UTC) Subject: [commit: ghc] wip/12368: WwLib: Add strictness signature to "let x = absentError …" (555b201) Message-ID: <20160801110222.86B003A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/12368 Link : http://ghc.haskell.org/trac/ghc/changeset/555b201e4f7571fb873f86b17bdd727378d34425/ghc >--------------------------------------------------------------- commit 555b201e4f7571fb873f86b17bdd727378d34425 Author: Joachim Breitner Date: Tue Jul 26 12:08:59 2016 +0200 WwLib: Add strictness signature to "let x = absentError …" indicating that it is bottom. This should help making the "empty cases" lint error give less false alarms. >--------------------------------------------------------------- 555b201e4f7571fb873f86b17bdd727378d34425 compiler/basicTypes/Demand.hs | 9 ++++++--- compiler/stranal/WwLib.hs | 11 ++++++----- 2 files changed, 12 insertions(+), 8 deletions(-) diff --git a/compiler/basicTypes/Demand.hs b/compiler/basicTypes/Demand.hs index 2ada6b3..d79fa6e 100644 --- a/compiler/basicTypes/Demand.hs +++ b/compiler/basicTypes/Demand.hs @@ -35,7 +35,8 @@ module Demand ( vanillaCprProdRes, cprSumRes, appIsBottom, isBottomingSig, pprIfaceStrictSig, trimCPRInfo, returnsCPR_maybe, - StrictSig(..), mkStrictSig, mkClosedStrictSig, nopSig, botSig, cprProdSig, + StrictSig(..), mkStrictSig, mkClosedStrictSig, + nopSig, botSig, exnSig, cprProdSig, isTopSig, hasDemandEnvSig, splitStrictSig, strictSigDmdEnv, increaseStrictSigArity, @@ -1264,9 +1265,10 @@ emptyDmdEnv = emptyVarEnv -- (lazy, absent, no CPR information, no termination information). -- Note that it is ''not'' the top of the lattice (which would be "may use everything"), -- so it is (no longer) called topDmd -nopDmdType, botDmdType :: DmdType +nopDmdType, botDmdType, exnDmdType :: DmdType nopDmdType = DmdType emptyDmdEnv [] topRes botDmdType = DmdType emptyDmdEnv [] botRes +exnDmdType = DmdType emptyDmdEnv [] exnRes cprProdDmdType :: Arity -> DmdType cprProdDmdType arity @@ -1691,9 +1693,10 @@ isBottomingSig :: StrictSig -> Bool -- True if the signature diverges or throws an exception isBottomingSig (StrictSig (DmdType _ _ res)) = isBotRes res -nopSig, botSig :: StrictSig +nopSig, botSig, exnSig :: StrictSig nopSig = StrictSig nopDmdType botSig = StrictSig botDmdType +exnSig = StrictSig exnDmdType cprProdSig :: Arity -> StrictSig cprProdSig arity = StrictSig (cprProdDmdType arity) diff --git a/compiler/stranal/WwLib.hs b/compiler/stranal/WwLib.hs index 812252c..c0b1af3 100644 --- a/compiler/stranal/WwLib.hs +++ b/compiler/stranal/WwLib.hs @@ -709,7 +709,7 @@ every primitive type, so the function is partial. mk_absent_let :: DynFlags -> Id -> Maybe (CoreExpr -> CoreExpr) mk_absent_let dflags arg | not (isUnliftedType arg_ty) - = Just (Let (NonRec arg abs_rhs)) + = Just (Let (NonRec lifted_arg abs_rhs)) | Just tc <- tyConAppTyCon_maybe arg_ty , Just lit <- absentLiteralOf tc = Just (Let (NonRec arg (Lit lit))) @@ -719,10 +719,11 @@ mk_absent_let dflags arg = WARN( True, text "No absent value for" <+> ppr arg_ty ) Nothing where - arg_ty = idType arg - abs_rhs = mkRuntimeErrorApp aBSENT_ERROR_ID arg_ty msg - msg = showSDoc (gopt_set dflags Opt_SuppressUniques) - (ppr arg <+> ppr (idType arg)) + arg_ty = idType arg + abs_rhs = mkRuntimeErrorApp aBSENT_ERROR_ID arg_ty msg + lifted_arg = arg `setIdStrictness` exnSig + msg = showSDoc (gopt_set dflags Opt_SuppressUniques) + (ppr arg <+> ppr (idType arg)) -- We need to suppress uniques here because otherwise they'd -- end up in the generated code as strings. This is bad for -- determinism, because with different uniques the strings From git at git.haskell.org Mon Aug 1 11:02:25 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 1 Aug 2016 11:02:25 +0000 (UTC) Subject: [commit: ghc] wip/12368: DmdAnal: Add a final, safe iteration (6c358b7) Message-ID: <20160801110225.3ECEE3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/12368 Link : http://ghc.haskell.org/trac/ghc/changeset/6c358b788f2043f7562d178cbefaad370f9386ac/ghc >--------------------------------------------------------------- commit 6c358b788f2043f7562d178cbefaad370f9386ac Author: Joachim Breitner Date: Thu Jul 7 11:23:48 2016 +0200 DmdAnal: Add a final, safe iteration this fixes #12368. It also refactors dmdFix a bit, removes some redundancies (such as passing around an strictness signature right next to an id, when that id is guaranteed to have been annotated with that strictness signature). Note that when fixed-point iteration does not terminate, we conservatively delete their strictness signatures (set them to nopSig). But this loses the information on how its strict free variables are used! Lazily used variables already escape via lazy_fvs. We ensure that in the case of an aborted fixed-point iteration, also the strict variables are put there (with a conservative demand of topDmd). Differential Revision: https://phabricator.haskell.org/D2392 >--------------------------------------------------------------- 6c358b788f2043f7562d178cbefaad370f9386ac compiler/basicTypes/Demand.hs | 7 +- compiler/basicTypes/VarEnv.hs | 5 +- compiler/stranal/DmdAnal.hs | 188 ++++++++++++++++++------------- compiler/utils/UniqFM.hs | 6 + testsuite/tests/stranal/should_run/all.T | 3 +- 5 files changed, 128 insertions(+), 81 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 6c358b788f2043f7562d178cbefaad370f9386ac From git at git.haskell.org Mon Aug 1 11:02:28 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 1 Aug 2016 11:02:28 +0000 (UTC) Subject: [commit: ghc] wip/12368: DmdAnal: Testcase about splitFVs and dmdFix abortion (570120d) Message-ID: <20160801110228.A1E4D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/12368 Link : http://ghc.haskell.org/trac/ghc/changeset/570120d3c99d1cf7e4e67cba39700970446fe86b/ghc >--------------------------------------------------------------- commit 570120d3c99d1cf7e4e67cba39700970446fe86b Author: Joachim Breitner Date: Thu Jul 21 17:44:25 2016 +0200 DmdAnal: Testcase about splitFVs and dmdFix abortion Any variable with useful information (strict or used-once) will not be included in lazy_fv (according to splitFVs). If we now also remove them from the strictness signatures, their uses are not recorded anywhere – and then probably considered absent. >--------------------------------------------------------------- 570120d3c99d1cf7e4e67cba39700970446fe86b testsuite/tests/stranal/should_run/T12368a.hs | 27 +++++++++++++++++++++++ testsuite/tests/stranal/should_run/T12368a.stderr | 3 +++ 2 files changed, 30 insertions(+) diff --git a/testsuite/tests/stranal/should_run/T12368a.hs b/testsuite/tests/stranal/should_run/T12368a.hs new file mode 100644 index 0000000..738e8ef --- /dev/null +++ b/testsuite/tests/stranal/should_run/T12368a.hs @@ -0,0 +1,27 @@ +-- Needs to be a product type +data Stream = S Int Stream + +-- a is wrongly recorded abstent if the non-lazy-fv from foo are thrown away. +bar :: Int -> Int -> Stream -> Int +bar a n s = foo n s + where + -- Non terminating local rec, strict in a + foo :: Int -> Stream -> Int + foo 0 (S n s) = a + foo i (S n s) = a `seq` n + foo (i-1) s +{-# NOINLINE bar #-} + + +baz :: Int -> Int -> Int +baz 0 not_absent = 0 +baz 1 not_absent = baz 2 not_absent +baz x not_absent = bar not_absent 1000 arg + where + arg = S 1 arg + +bamf x = baz x (error "This is good!") +{-# NOINLINE bamf #-} + + +main :: IO () +main = bamf 10 `seq` return () diff --git a/testsuite/tests/stranal/should_run/T12368a.stderr b/testsuite/tests/stranal/should_run/T12368a.stderr new file mode 100644 index 0000000..98246d3 --- /dev/null +++ b/testsuite/tests/stranal/should_run/T12368a.stderr @@ -0,0 +1,3 @@ +T12368a: This is good! +CallStack (from HasCallStack): + error, called at T12368a.hs:22:17 in main:Main From git at git.haskell.org Mon Aug 1 11:02:31 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 1 Aug 2016 11:02:31 +0000 (UTC) Subject: [commit: ghc] wip/12368: Degrade "case scrutinee not known to diverge for sure" Lint error (f7161d3) Message-ID: <20160801110231.588893A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/12368 Link : http://ghc.haskell.org/trac/ghc/changeset/f7161d38ddce35a4febce413a3ab02febef068fe/ghc >--------------------------------------------------------------- commit f7161d38ddce35a4febce413a3ab02febef068fe Author: Joachim Breitner Date: Tue Jul 26 11:44:53 2016 +0200 Degrade "case scrutinee not known to diverge for sure" Lint error as proposed in #12435. For now, this is just on my branch to be able to continue compilation on the auto-builders. >--------------------------------------------------------------- f7161d38ddce35a4febce413a3ab02febef068fe compiler/coreSyn/CoreLint.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/coreSyn/CoreLint.hs b/compiler/coreSyn/CoreLint.hs index dead929..d13d186 100644 --- a/compiler/coreSyn/CoreLint.hs +++ b/compiler/coreSyn/CoreLint.hs @@ -715,7 +715,7 @@ lintCoreExpr e@(Case scrut var alt_ty alts) = ; when (null alts) $ do { checkL (not (exprIsHNF scrut)) (text "No alternatives for a case scrutinee in head-normal form:" <+> ppr scrut) - ; checkL scrut_diverges + ; checkWarnL scrut_diverges (text "No alternatives for a case scrutinee not known to diverge for sure:" <+> ppr scrut) } From git at git.haskell.org Mon Aug 1 13:25:58 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 1 Aug 2016 13:25:58 +0000 (UTC) Subject: [commit: ghc] master: Typo in comment (2078909) Message-ID: <20160801132558.B1EBB3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/207890919e9718da71f0c0cf69fc7ff1b9490b85/ghc >--------------------------------------------------------------- commit 207890919e9718da71f0c0cf69fc7ff1b9490b85 Author: Gabor Greif Date: Mon Aug 1 15:25:10 2016 +0200 Typo in comment >--------------------------------------------------------------- 207890919e9718da71f0c0cf69fc7ff1b9490b85 compiler/utils/GraphColor.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/utils/GraphColor.hs b/compiler/utils/GraphColor.hs index 8a1cdd0..056ce0d 100644 --- a/compiler/utils/GraphColor.hs +++ b/compiler/utils/GraphColor.hs @@ -184,7 +184,7 @@ colorScan_spin iterative triv spill graph kksCoalesce -- Coalesce: - -- If we're doing iterative coalescing and no triv nodes are avaliable + -- If we're doing iterative coalescing and no triv nodes are available -- then it's time for a coalescing pass. | iterative = case coalesceGraph False triv graph of From git at git.haskell.org Tue Aug 2 13:04:00 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 2 Aug 2016 13:04:00 +0000 (UTC) Subject: [commit: ghc] master: ForeignCall.hs: Remove DrIFT directives (36565a9) Message-ID: <20160802130400.5156F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/36565a9ba200d40e0be8407e57ada1b4a1c55814/ghc >--------------------------------------------------------------- commit 36565a9ba200d40e0be8407e57ada1b4a1c55814 Author: Ömer Sinan Ağacan Date: Tue Aug 2 13:03:32 2016 +0000 ForeignCall.hs: Remove DrIFT directives >--------------------------------------------------------------- 36565a9ba200d40e0be8407e57ada1b4a1c55814 compiler/prelude/ForeignCall.hs | 7 ------- 1 file changed, 7 deletions(-) diff --git a/compiler/prelude/ForeignCall.hs b/compiler/prelude/ForeignCall.hs index f26298f..8411f11 100644 --- a/compiler/prelude/ForeignCall.hs +++ b/compiler/prelude/ForeignCall.hs @@ -37,7 +37,6 @@ import Data.Data newtype ForeignCall = CCall CCallSpec deriving Eq - {-! derive: Binary !-} isSafeForeignCall :: ForeignCall -> Bool isSafeForeignCall (CCall (CCallSpec _ _ safe)) = playSafe safe @@ -64,7 +63,6 @@ data Safety -- without interacting with the runtime system at all deriving ( Eq, Show, Data ) -- Show used just for Show Lex.Token, I think - {-! derive: Binary !-} instance Outputable Safety where ppr PlaySafe = text "safe" @@ -95,14 +93,12 @@ data CExportSpec CLabelString -- C Name of exported function CCallConv deriving Data - {-! derive: Binary !-} data CCallSpec = CCallSpec CCallTarget -- What to call CCallConv -- Calling convention to use. Safety deriving( Eq ) - {-! derive: Binary !-} -- The call target: @@ -130,7 +126,6 @@ data CCallTarget | DynamicTarget deriving( Eq, Data ) - {-! derive: Binary !-} isDynamicTarget :: CCallTarget -> Bool isDynamicTarget DynamicTarget = True @@ -151,7 +146,6 @@ See: http://www.programmersheaven.com/2/Calling-conventions -- any changes here should be replicated in the CallConv type in template haskell data CCallConv = CCallConv | CApiConv | StdCallConv | PrimCallConv | JavaScriptCallConv deriving (Eq, Data) - {-! derive: Binary !-} instance Outputable CCallConv where ppr StdCallConv = text "stdcall" @@ -255,7 +249,6 @@ instance Outputable CType where ************************************************************************ -} -{-* Generated by DrIFT-v1.0 : Look, but Don't Touch. *-} instance Binary ForeignCall where put_ bh (CCall aa) = put_ bh aa get bh = do aa <- get bh; return (CCall aa) From git at git.haskell.org Wed Aug 3 07:07:54 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 3 Aug 2016 07:07:54 +0000 (UTC) Subject: [commit: ghc] master: Only trace cap/capset events if we're tracing anything else (d1fe08e) Message-ID: <20160803070754.933993A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d1fe08ec15230d5a6c3025ef798a8c911d2fa1c7/ghc >--------------------------------------------------------------- commit d1fe08ec15230d5a6c3025ef798a8c911d2fa1c7 Author: Simon Marlow Date: Tue Aug 2 09:57:19 2016 +0100 Only trace cap/capset events if we're tracing anything else Summary: I was getting annoyed by cap/capset messages when using +RTS -DS, which doesn't cause any other trace messages to be emitted. This makes it possible to add --with-rtsopts=-DS when running tests, and not have all the tests fail due to spurious trace messages. Test Plan: validate Reviewers: duncan, bgamari, ezyang, austin, erikd Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2438 >--------------------------------------------------------------- d1fe08ec15230d5a6c3025ef798a8c911d2fa1c7 rts/Trace.c | 19 ++++++++++++++----- rts/Trace.h | 25 +++++++++++++++---------- 2 files changed, 29 insertions(+), 15 deletions(-) diff --git a/rts/Trace.c b/rts/Trace.c index fdf8049..0dc05d5 100644 --- a/rts/Trace.c +++ b/rts/Trace.c @@ -51,6 +51,7 @@ int TRACE_gc; int TRACE_spark_sampled; int TRACE_spark_full; int TRACE_user; +int TRACE_cap; #ifdef THREADED_RTS static Mutex trace_utx; @@ -114,6 +115,14 @@ void initTracing (void) TRACE_user = RtsFlags.TraceFlags.user; + // We trace cap events if we're tracing anything else + TRACE_cap = + TRACE_sched || + TRACE_gc || + TRACE_spark_sampled || + TRACE_spark_full || + TRACE_user; + eventlog_enabled = RtsFlags.TraceFlags.tracing == TRACE_EVENTLOG; /* Note: we can have any of the TRACE_* flags turned on even when @@ -378,8 +387,8 @@ void traceEventGcStats_ (Capability *cap, } } -void traceCapEvent (Capability *cap, - EventTypeNum tag) +void traceCapEvent_ (Capability *cap, + EventTypeNum tag) { #ifdef DEBUG if (RtsFlags.TraceFlags.tracing == TRACE_STDERR) { @@ -410,9 +419,9 @@ void traceCapEvent (Capability *cap, } } -void traceCapsetEvent (EventTypeNum tag, - CapsetID capset, - StgWord info) +void traceCapsetEvent_ (EventTypeNum tag, + CapsetID capset, + StgWord info) { #ifdef DEBUG if (RtsFlags.TraceFlags.tracing == TRACE_STDERR && TRACE_sched) diff --git a/rts/Trace.h b/rts/Trace.h index ab79671..8b531f1 100644 --- a/rts/Trace.h +++ b/rts/Trace.h @@ -69,6 +69,7 @@ extern int TRACE_gc; extern int TRACE_spark_sampled; extern int TRACE_spark_full; /* extern int TRACE_user; */ // only used in Trace.c +extern int TRACE_cap; // ----------------------------------------------------------------------------- // Posting events @@ -244,19 +245,23 @@ void traceThreadStatus_ (StgTSO *tso); /* * Events for describing capabilities and capability sets in the eventlog - * - * Note: unlike other events, these are not conditional on TRACE_sched or - * similar because capabilities and capability sets are important - * context for other events. Since other events depend on these events - * then for simplicity we always emit them, rather than working out if - * they're necessary . They should be very low volume. */ -void traceCapEvent (Capability *cap, +#define traceCapEvent(cap, tag) \ + if (RTS_UNLIKELY(TRACE_cap)) { \ + traceCapEvent_(cap, tag); \ + } + +void traceCapEvent_ (Capability *cap, EventTypeNum tag); -void traceCapsetEvent (EventTypeNum tag, - CapsetID capset, - StgWord info); +#define traceCapsetEvent(cap, capset, info) \ + if (RTS_UNLIKELY(TRACE_cap)) { \ + traceCapsetEvent_(cap, capset, info); \ + } + +void traceCapsetEvent_ (EventTypeNum tag, + CapsetID capset, + StgWord info); void traceWallClockTime_(void); From git at git.haskell.org Wed Aug 3 07:07:57 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 3 Aug 2016 07:07:57 +0000 (UTC) Subject: [commit: ghc] master: Remove the DEBUG_ variables, use RtsFlags directly (4dcbbd1) Message-ID: <20160803070757.45BCA3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4dcbbd1db1dc18aa07b031fcbad2cf94c0334d3f/ghc >--------------------------------------------------------------- commit 4dcbbd1db1dc18aa07b031fcbad2cf94c0334d3f Author: Simon Marlow Date: Tue Aug 2 13:09:32 2016 +0100 Remove the DEBUG_ variables, use RtsFlags directly >--------------------------------------------------------------- 4dcbbd1db1dc18aa07b031fcbad2cf94c0334d3f rts/Trace.c | 41 ----------------------------------------- rts/Trace.h | 34 +++++++++++++++++----------------- 2 files changed, 17 insertions(+), 58 deletions(-) diff --git a/rts/Trace.c b/rts/Trace.c index 0dc05d5..4eee026 100644 --- a/rts/Trace.c +++ b/rts/Trace.c @@ -25,26 +25,6 @@ #include #endif -#ifdef DEBUG -// debugging flags, set with +RTS -D -int DEBUG_sched; -int DEBUG_interp; -int DEBUG_weak; -int DEBUG_gccafs; -int DEBUG_gc; -int DEBUG_block_alloc; -int DEBUG_sanity; -int DEBUG_stable; -int DEBUG_stm; -int DEBUG_prof; -int DEBUG_gran; -int DEBUG_par; -int DEBUG_linker; -int DEBUG_squeeze; -int DEBUG_hpc; -int DEBUG_sparks; -#endif - // events int TRACE_sched; int TRACE_gc; @@ -69,27 +49,6 @@ void initTracing (void) initMutex(&trace_utx); #endif -#ifdef DEBUG -#define DEBUG_FLAG(name, class) \ - class = RtsFlags.DebugFlags.name ? 1 : 0; - - DEBUG_FLAG(scheduler, DEBUG_sched); - - DEBUG_FLAG(interpreter, DEBUG_interp); - DEBUG_FLAG(weak, DEBUG_weak); - DEBUG_FLAG(gccafs, DEBUG_gccafs); - DEBUG_FLAG(gc, DEBUG_gc); - DEBUG_FLAG(block_alloc, DEBUG_block_alloc); - DEBUG_FLAG(sanity, DEBUG_sanity); - DEBUG_FLAG(stable, DEBUG_stable); - DEBUG_FLAG(stm, DEBUG_stm); - DEBUG_FLAG(prof, DEBUG_prof); - DEBUG_FLAG(linker, DEBUG_linker); - DEBUG_FLAG(squeeze, DEBUG_squeeze); - DEBUG_FLAG(hpc, DEBUG_hpc); - DEBUG_FLAG(sparks, DEBUG_sparks); -#endif - // -Ds turns on scheduler tracing too TRACE_sched = RtsFlags.TraceFlags.scheduler || diff --git a/rts/Trace.h b/rts/Trace.h index 8b531f1..ccdad7a 100644 --- a/rts/Trace.h +++ b/rts/Trace.h @@ -45,23 +45,23 @@ enum CapsetType { CapsetTypeCustom = CAPSET_TYPE_CUSTOM, // Message classes // ----------------------------------------------------------------------------- -// debugging flags, set with +RTS -D -extern int DEBUG_sched; -extern int DEBUG_interp; -extern int DEBUG_weak; -extern int DEBUG_gccafs; -extern int DEBUG_gc; -extern int DEBUG_block_alloc; -extern int DEBUG_sanity; -extern int DEBUG_stable; -extern int DEBUG_stm; -extern int DEBUG_prof; -extern int DEBUG_gran; -extern int DEBUG_par; -extern int DEBUG_linker; -extern int DEBUG_squeeze; -extern int DEBUG_hpc; -extern int DEBUG_sparks; +// shorthand for RtsFlags.DebugFlags., useful with debugTrace() +#define DEBUG_sched RtsFlags.DebugFlags.scheduler +#define DEBUG_interp RtsFlags.DebugFlags.interp +#define DEBUG_weak RtsFlags.DebugFlags.weak +#define DEBUG_gccafs RtsFlags.DebugFlags.gccafs +#define DEBUG_gc RtsFlags.DebugFlags.gc +#define DEBUG_block_alloc RtsFlags.DebugFlags.alloc +#define DEBUG_sanity RtsFlags.DebugFlags.sanity +#define DEBUG_stable RtsFlags.DebugFlags.stable +#define DEBUG_stm RtsFlags.DebugFlags.stm +#define DEBUG_prof RtsFlags.DebugFlags.prof +#define DEBUG_gran RtsFlags.DebugFlags.gran +#define DEBUG_par RtsFlags.DebugFlags.par +#define DEBUG_linker RtsFlags.DebugFlags.linker +#define DEBUG_squeeze RtsFlags.DebugFlags.squeeze +#define DEBUG_hpc RtsFlags.DebugFlags.hpc +#define DEBUG_sparks RtsFlags.DebugFlags.sparks // events extern int TRACE_sched; From git at git.haskell.org Wed Aug 3 07:07:59 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 3 Aug 2016 07:07:59 +0000 (UTC) Subject: [commit: ghc] master: Fix to thread migration (988ad8b) Message-ID: <20160803070759.E7DEF3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/988ad8ba8e709eff3cea59728e481bb269fa6185/ghc >--------------------------------------------------------------- commit 988ad8ba8e709eff3cea59728e481bb269fa6185 Author: Simon Marlow Date: Wed Jul 27 16:00:08 2016 +0100 Fix to thread migration Summary: If we had 2 threads on the run queue, say [A,B], and B is bound to the current Task, then we would fail to migrate any threads. This fixes it so that we would migrate A in that case. This will help parallelism a bit in programs that have lots of bound threads. Test Plan: Test program in #12419, which is actually not a great program but it does behave a bit better after this change. Reviewers: ezyang, niteria, bgamari, austin, erikd Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2430 GHC Trac Issues: #12419 >--------------------------------------------------------------- 988ad8ba8e709eff3cea59728e481bb269fa6185 rts/Schedule.c | 87 ++++++++++++++++++++++++++++++++++++++++++---------------- 1 file changed, 63 insertions(+), 24 deletions(-) diff --git a/rts/Schedule.c b/rts/Schedule.c index ee2d7db..908acf2 100644 --- a/rts/Schedule.c +++ b/rts/Schedule.c @@ -702,13 +702,16 @@ schedulePushWork(Capability *cap USED_IF_THREADS, Capability *free_caps[n_capabilities], *cap0; uint32_t i, n_wanted_caps, n_free_caps; + uint32_t spare_threads = cap->n_run_queue > 0 ? cap->n_run_queue - 1 : 0; + // migration can be turned off with +RTS -qm - if (!RtsFlags.ParFlags.migrate) return; + if (!RtsFlags.ParFlags.migrate) { + spare_threads = 0; + } // Figure out how many capabilities we want to wake up. We need at least // sparkPoolSize(cap) plus the number of spare threads we have. - n_wanted_caps = sparkPoolSizeCap(cap) + cap->n_run_queue - 1; - + n_wanted_caps = sparkPoolSizeCap(cap) + spare_threads; if (n_wanted_caps == 0) return; // First grab as many free Capabilities as we can. ToDo: we should use @@ -730,10 +733,22 @@ schedulePushWork(Capability *cap USED_IF_THREADS, } } - // we now have n_free_caps free capabilities stashed in - // free_caps[]. Share our run queue equally with them. This is - // probably the simplest thing we could do; improvements we might - // want to do include: + // We now have n_free_caps free capabilities stashed in + // free_caps[]. Attempt to share our run queue equally with them. + // This is complicated slightly by the fact that we can't move + // some threads: + // + // - threads that have TSO_LOCKED cannot migrate + // - a thread that is bound to the current Task cannot be migrated + // + // So we walk through the run queue, migrating threads to + // free_caps[] round-robin, skipping over immovable threads. Each + // time through free_caps[] we keep one thread for ourselves, + // provided we haven't encountered one or more immovable threads + // in this pass. + // + // This is about the simplest thing we could do; improvements we + // might want to do include: // // - giving high priority to moving relatively new threads, on // the gournds that they haven't had time to build up a @@ -748,10 +763,8 @@ schedulePushWork(Capability *cap USED_IF_THREADS, #endif debugTrace(DEBUG_sched, - "cap %d: %s and %d free capabilities, sharing...", - cap->no, - (cap->n_run_queue > 1)? - "excess threads on run queue":"sparks to share (>=2)", + "cap %d: %d threads, %d sparks, and %d free capabilities, sharing...", + cap->no, cap->n_run_queue, sparkPoolSizeCap(cap), n_free_caps); i = 0; @@ -759,27 +772,56 @@ schedulePushWork(Capability *cap USED_IF_THREADS, pushed_to_all = rtsFalse; #endif - if (cap->run_queue_hd != END_TSO_QUEUE) { - prev = cap->run_queue_hd; - t = prev->_link; - prev->_link = END_TSO_QUEUE; + // We want to share threads equally amongst free_caps[] and the + // current capability, but sometimes we encounter immovable + // threads. This counter tracks the number of threads we have kept + // for the current capability minus the number of passes over + // free_caps[]. If it is great than zero (due to immovable + // threads), we should try to bring it back to zero again by not + // keeping any threads for the current capability. + uint32_t imbalance = 0; + + // n_free_caps may be larger than the number of spare threads we have, + // if there were sparks in the spark pool. To avoid giving away all our + // threads in this case, we limit the number of caps that we give + // threads to, to the number of spare threads (n_run_queue-1). + uint32_t thread_recipients = stg_min(spare_threads, n_free_caps); + + if (thread_recipients > 0) { + prev = END_TSO_QUEUE; + t = cap->run_queue_hd; for (; t != END_TSO_QUEUE; t = next) { next = t->_link; t->_link = END_TSO_QUEUE; if (t->bound == task->incall // don't move my bound thread || tsoLocked(t)) { // don't move a locked thread - setTSOLink(cap, prev, t); + if (prev == END_TSO_QUEUE) { + cap->run_queue_hd = t; + } else { + setTSOLink(cap, prev, t); + } setTSOPrev(cap, t, prev); prev = t; - } else if (i == n_free_caps) { + imbalance++; + } else if (i == thread_recipients) { #ifdef SPARK_PUSHING pushed_to_all = rtsTrue; #endif + // If we have not already kept any threads for this + // capability during the current pass over free_caps[], + // keep one now. + if (imbalance == 0) { + if (prev == END_TSO_QUEUE) { + cap->run_queue_hd = t; + } else { + setTSOLink(cap, prev, t); + } + setTSOPrev(cap, t, prev); + prev = t; + } else { + imbalance--; + } i = 0; - // keep one for us - setTSOLink(cap, prev, t); - setTSOPrev(cap, t, prev); - prev = t; } else { appendToRunQueue(free_caps[i],t); cap->n_run_queue--; @@ -2194,9 +2236,6 @@ setNumCapabilities (uint32_t new_n_capabilities USED_IF_THREADS) n_capabilities = enabled_capabilities = new_n_capabilities; } - // Start worker tasks on the new Capabilities - startWorkerTasks(old_n_capabilities, new_n_capabilities); - // We're done: release the original Capabilities releaseAllCapabilities(old_n_capabilities, cap,task); From git at git.haskell.org Wed Aug 3 07:08:02 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 3 Aug 2016 07:08:02 +0000 (UTC) Subject: [commit: ghc] master: Track the lengths of the thread queues (55f5aed) Message-ID: <20160803070802.A1D843A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/55f5aed756cd5d464942dddcb33e0bd19b05f2a4/ghc >--------------------------------------------------------------- commit 55f5aed756cd5d464942dddcb33e0bd19b05f2a4 Author: Simon Marlow Date: Tue Aug 2 09:55:31 2016 +0100 Track the lengths of the thread queues Summary: Knowing the length of the run queue in O(1) time is useful: for example we don't have to traverse the run queue to know how many threads we have to migrate in schedulePushWork(). Test Plan: validate Reviewers: ezyang, erikd, bgamari, austin Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2437 >--------------------------------------------------------------- 55f5aed756cd5d464942dddcb33e0bd19b05f2a4 rts/Capability.c | 9 +++++++-- rts/Capability.h | 23 +++++++++++++++++++---- rts/Schedule.c | 35 +++++++++++++---------------------- rts/Schedule.h | 15 +++++---------- rts/sm/Sanity.c | 6 ++++-- 5 files changed, 48 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 55f5aed756cd5d464942dddcb33e0bd19b05f2a4 From git at git.haskell.org Wed Aug 3 08:51:36 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 3 Aug 2016 08:51:36 +0000 (UTC) Subject: [commit: ghc] master: StgSyn: Remove unused StgLiveVars types (9df9490) Message-ID: <20160803085136.64D223A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9df9490c4b30bdbd3e0031f7bf2ccd9ba8d867a2/ghc >--------------------------------------------------------------- commit 9df9490c4b30bdbd3e0031f7bf2ccd9ba8d867a2 Author: Ömer Sinan Ağacan Date: Wed Aug 3 08:50:31 2016 +0000 StgSyn: Remove unused StgLiveVars types >--------------------------------------------------------------- 9df9490c4b30bdbd3e0031f7bf2ccd9ba8d867a2 compiler/stgSyn/StgSyn.hs | 19 ++----------------- 1 file changed, 2 insertions(+), 17 deletions(-) diff --git a/compiler/stgSyn/StgSyn.hs b/compiler/stgSyn/StgSyn.hs index 2f29f1e..60147bc 100644 --- a/compiler/stgSyn/StgSyn.hs +++ b/compiler/stgSyn/StgSyn.hs @@ -13,7 +13,6 @@ generation. module StgSyn ( GenStgArg(..), - GenStgLiveVars, GenStgBinding(..), GenStgExpr(..), GenStgRhs(..), GenStgAlt, AltType(..), @@ -25,7 +24,7 @@ module StgSyn ( combineStgBinderInfo, -- a set of synonyms for the most common (only :-) parameterisation - StgArg, StgLiveVars, + StgArg, StgBinding, StgExpr, StgRhs, StgAlt, -- StgOp @@ -37,8 +36,7 @@ module StgSyn ( stgArgType, stripStgTicksTop, - pprStgBinding, pprStgBindings, - pprStgLVs + pprStgBinding, pprStgBindings ) where #include "HsVersions.h" @@ -62,8 +60,6 @@ import PrimOp ( PrimOp, PrimCall ) import TyCon ( PrimRep(..), TyCon ) import Type ( Type ) import RepType ( typePrimRep ) -import UniqFM -import UniqSet import Unique ( Unique ) import Util @@ -176,8 +172,6 @@ There is no constructor for a lone variable; it would appear as @StgApp var []@. -} -type GenStgLiveVars occ = UniqSet occ - data GenStgExpr bndr occ = StgApp occ -- function @@ -560,7 +554,6 @@ This happens to be the only one we use at the moment. type StgBinding = GenStgBinding Id Id type StgArg = GenStgArg Id -type StgLiveVars = GenStgLiveVars Id type StgExpr = GenStgExpr Id Id type StgRhs = GenStgRhs Id Id type StgAlt = GenStgAlt Id Id @@ -762,14 +755,6 @@ instance Outputable AltType where ppr (AlgAlt tc) = text "Alg" <+> ppr tc ppr (PrimAlt tc) = text "Prim" <+> ppr tc -pprStgLVs :: Outputable occ => GenStgLiveVars occ -> SDoc -pprStgLVs lvs - = getPprStyle $ \ sty -> - if userStyle sty || isEmptyUniqSet lvs then - empty - else - hcat [text "{-lvs:", pprUFM lvs interpp'SP, text "-}"] - pprStgRhs :: (OutputableBndr bndr, Outputable bdee, Ord bdee) => GenStgRhs bndr bdee -> SDoc From git at git.haskell.org Wed Aug 3 10:30:01 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 3 Aug 2016 10:30:01 +0000 (UTC) Subject: [commit: ghc] master: Add comment about lexing of INLINE and INLINABLE pragma (2f79e79) Message-ID: <20160803103001.99F123A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2f79e79ca367b438a2eb60711784b862b1077dae/ghc >--------------------------------------------------------------- commit 2f79e79ca367b438a2eb60711784b862b1077dae Author: Matthew Pickering Date: Wed Aug 3 11:29:26 2016 +0100 Add comment about lexing of INLINE and INLINABLE pragma >--------------------------------------------------------------- 2f79e79ca367b438a2eb60711784b862b1077dae compiler/parser/Parser.y | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y index cd10a29..b9479d9 100644 --- a/compiler/parser/Parser.y +++ b/compiler/parser/Parser.y @@ -369,7 +369,7 @@ output it generates. 'pattern' { L _ ITpattern } -- for pattern synonyms 'static' { L _ ITstatic } -- for static pointers extension - '{-# INLINE' { L _ (ITinline_prag _ _ _) } + '{-# INLINE' { L _ (ITinline_prag _ _ _) } -- INLINE or INLINABLE '{-# SPECIALISE' { L _ (ITspec_prag _) } '{-# SPECIALISE_INLINE' { L _ (ITspec_inline_prag _ _) } '{-# SOURCE' { L _ (ITsource_prag _) } @@ -2058,6 +2058,7 @@ sigdecl :: { LHsDecl RdrName } | pattern_synonym_sig { sLL $1 $> . SigD . unLoc $ $1 } + -- This rule is for both INLINE and INLINABLE pragmas | '{-# INLINE' activation qvar '#-}' {% ams ((sLL $1 $> $ SigD (InlineSig $3 (mkInlinePragma (getINLINE_PRAGs $1) (getINLINE $1) From git at git.haskell.org Wed Aug 3 10:38:26 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 3 Aug 2016 10:38:26 +0000 (UTC) Subject: [commit: ghc] master: Update old comment InlinePragma (0c37aef) Message-ID: <20160803103826.7E93A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/0c37aef24c7727b2ee6ade41a7a2e2c7b9d7af36/ghc >--------------------------------------------------------------- commit 0c37aef24c7727b2ee6ade41a7a2e2c7b9d7af36 Author: Matthew Pickering Date: Wed Aug 3 11:37:05 2016 +0100 Update old comment InlinePragma >--------------------------------------------------------------- 0c37aef24c7727b2ee6ade41a7a2e2c7b9d7af36 compiler/basicTypes/BasicTypes.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/compiler/basicTypes/BasicTypes.hs b/compiler/basicTypes/BasicTypes.hs index 9711edb..92a1740 100644 --- a/compiler/basicTypes/BasicTypes.hs +++ b/compiler/basicTypes/BasicTypes.hs @@ -971,14 +971,14 @@ This data type mirrors what you can write in an INLINE or NOINLINE pragma in the source program. If you write nothing at all, you get defaultInlinePragma: - inl_inline = False + inl_inline = EmptyInlineSpec inl_act = AlwaysActive inl_rule = FunLike It's not possible to get that combination by *writing* something, so if an Id has defaultInlinePragma it means the user didn't specify anything. -If inl_inline = True, then the Id should have an InlineRule unfolding. +If inl_inline = Inline or Inlineable, then the Id should have an InlineRule unfolding. Note [CONLIKE pragma] ~~~~~~~~~~~~~~~~~~~~~ From git at git.haskell.org Wed Aug 3 13:05:44 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 3 Aug 2016 13:05:44 +0000 (UTC) Subject: [commit: ghc] master: More comments about InlinePragmas (b1e6415) Message-ID: <20160803130544.4C80F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b1e641558239b41825372db239cabbe2c42f7b5f/ghc >--------------------------------------------------------------- commit b1e641558239b41825372db239cabbe2c42f7b5f Author: Matthew Pickering Date: Wed Aug 3 14:04:53 2016 +0100 More comments about InlinePragmas Just pointers about where to look in the source code. >--------------------------------------------------------------- b1e641558239b41825372db239cabbe2c42f7b5f compiler/basicTypes/BasicTypes.hs | 2 ++ compiler/deSugar/DsBinds.hs | 5 +++++ 2 files changed, 7 insertions(+) diff --git a/compiler/basicTypes/BasicTypes.hs b/compiler/basicTypes/BasicTypes.hs index 92a1740..f72625b 100644 --- a/compiler/basicTypes/BasicTypes.hs +++ b/compiler/basicTypes/BasicTypes.hs @@ -980,6 +980,8 @@ if an Id has defaultInlinePragma it means the user didn't specify anything. If inl_inline = Inline or Inlineable, then the Id should have an InlineRule unfolding. +If you want to know where InlinePragmas take effect: Look in DsBinds.mkCorePair + Note [CONLIKE pragma] ~~~~~~~~~~~~~~~~~~~~~ The ConLike constructor of a RuleMatchInfo is aimed at the following. diff --git a/compiler/deSugar/DsBinds.hs b/compiler/deSugar/DsBinds.hs index 30e1707..f5211d2 100644 --- a/compiler/deSugar/DsBinds.hs +++ b/compiler/deSugar/DsBinds.hs @@ -347,6 +347,11 @@ dsHsBind dflags (AbsBindsSig { abs_tvs = tyvars, abs_ev_vars = dicts dsHsBind _ (PatSynBind{}) = panic "dsHsBind: PatSynBind" + +-- | This is where we apply INLINE and INLINABLE pragmas. All we need to +-- do is to attach the unfolding information to the Id. When the interface +-- files are created, unfoldings are only attached if the information is +-- present. ------------------------ makeCorePair :: DynFlags -> Id -> Bool -> Arity -> CoreExpr -> (Id, CoreExpr) makeCorePair dflags gbl_id is_default_method dict_arity rhs From git at git.haskell.org Wed Aug 3 13:07:29 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 3 Aug 2016 13:07:29 +0000 (UTC) Subject: [commit: ghc] master: Typo in comment [skip ci] (7a06b22) Message-ID: <20160803130729.C88133A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7a06b220447ecaf603e3c9d420ecb34b9d5609f1/ghc >--------------------------------------------------------------- commit 7a06b220447ecaf603e3c9d420ecb34b9d5609f1 Author: Matthew Pickering Date: Wed Aug 3 14:06:57 2016 +0100 Typo in comment [skip ci] >--------------------------------------------------------------- 7a06b220447ecaf603e3c9d420ecb34b9d5609f1 compiler/basicTypes/BasicTypes.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/basicTypes/BasicTypes.hs b/compiler/basicTypes/BasicTypes.hs index f72625b..2fc3833 100644 --- a/compiler/basicTypes/BasicTypes.hs +++ b/compiler/basicTypes/BasicTypes.hs @@ -980,7 +980,7 @@ if an Id has defaultInlinePragma it means the user didn't specify anything. If inl_inline = Inline or Inlineable, then the Id should have an InlineRule unfolding. -If you want to know where InlinePragmas take effect: Look in DsBinds.mkCorePair +If you want to know where InlinePragmas take effect: Look in DsBinds.makeCorePair Note [CONLIKE pragma] ~~~~~~~~~~~~~~~~~~~~~ From git at git.haskell.org Wed Aug 3 14:05:28 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 3 Aug 2016 14:05:28 +0000 (UTC) Subject: [commit: ghc] wip/12368: Comments only: Refer to actually existing Notes (17112bd) Message-ID: <20160803140528.435313A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/12368 Link : http://ghc.haskell.org/trac/ghc/changeset/17112bd400b8cc7e30b23b4f023aaafc667b6053/ghc >--------------------------------------------------------------- commit 17112bd400b8cc7e30b23b4f023aaafc667b6053 Author: Joachim Breitner Date: Sun Jul 31 20:59:54 2016 -0400 Comments only: Refer to actually existing Notes >--------------------------------------------------------------- 17112bd400b8cc7e30b23b4f023aaafc667b6053 compiler/stranal/DmdAnal.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/compiler/stranal/DmdAnal.hs b/compiler/stranal/DmdAnal.hs index c7f0767..44d2d20 100644 --- a/compiler/stranal/DmdAnal.hs +++ b/compiler/stranal/DmdAnal.hs @@ -67,8 +67,9 @@ dmdAnalTopBind sigs (NonRec id rhs) ( _, _, _, rhs1) = dmdAnalRhsLetDown TopLevel Nothing sigs id rhs (sig, _, id2, rhs2) = dmdAnalRhsLetDown TopLevel Nothing (nonVirgin sigs) id rhs1 -- Do two passes to improve CPR information - -- See comments with ignore_cpr_info in mk_sig_ty - -- and with extendSigsWithLam + -- See Note [CPR for thunks] + -- See Note [Optimistic CPR in the "virgin" case] + -- See Note [Initial CPR for strict binders] dmdAnalTopBind sigs (Rec pairs) = (sigs', Rec pairs') From git at git.haskell.org Wed Aug 3 14:05:30 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 3 Aug 2016 14:05:30 +0000 (UTC) Subject: [commit: ghc] wip/12368: Degrade "case scrutinee not known to diverge for sure" Lint error to warning (85ac1ca) Message-ID: <20160803140530.E60973A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/12368 Link : http://ghc.haskell.org/trac/ghc/changeset/85ac1ca1a95030885c5331e306ae1e8dfc2664a8/ghc >--------------------------------------------------------------- commit 85ac1ca1a95030885c5331e306ae1e8dfc2664a8 Author: Joachim Breitner Date: Tue Jul 26 11:44:53 2016 +0200 Degrade "case scrutinee not known to diverge for sure" Lint error to warning as prroposed in #12435, as it easily gets in the way of development when reporting false positives. >--------------------------------------------------------------- 85ac1ca1a95030885c5331e306ae1e8dfc2664a8 compiler/coreSyn/CoreLint.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/coreSyn/CoreLint.hs b/compiler/coreSyn/CoreLint.hs index dead929..d13d186 100644 --- a/compiler/coreSyn/CoreLint.hs +++ b/compiler/coreSyn/CoreLint.hs @@ -715,7 +715,7 @@ lintCoreExpr e@(Case scrut var alt_ty alts) = ; when (null alts) $ do { checkL (not (exprIsHNF scrut)) (text "No alternatives for a case scrutinee in head-normal form:" <+> ppr scrut) - ; checkL scrut_diverges + ; checkWarnL scrut_diverges (text "No alternatives for a case scrutinee not known to diverge for sure:" <+> ppr scrut) } From git at git.haskell.org Wed Aug 3 14:05:33 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 3 Aug 2016 14:05:33 +0000 (UTC) Subject: [commit: ghc] wip/12368: DmdAnal: Add a final, safe iteration (78c5dd6) Message-ID: <20160803140533.A8B4C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/12368 Link : http://ghc.haskell.org/trac/ghc/changeset/78c5dd690ef1240a0481285343e5e7111f71104d/ghc >--------------------------------------------------------------- commit 78c5dd690ef1240a0481285343e5e7111f71104d Author: Joachim Breitner Date: Thu Jul 7 11:23:48 2016 +0200 DmdAnal: Add a final, safe iteration this fixes #12368. It also refactors dmdFix a bit, removes some redundancies (such as passing around an strictness signature right next to an id, when that id is guaranteed to have been annotated with that strictness signature). Note that when fixed-point iteration does not terminate, we conservatively delete their strictness signatures (set them to nopSig). But this loses the information on how its strict free variables are used! Lazily used variables already escape via lazy_fvs. We ensure that in the case of an aborted fixed-point iteration, also the strict variables are put there (with a conservative demand of topDmd). Differential Revision: https://phabricator.haskell.org/D2392 >--------------------------------------------------------------- 78c5dd690ef1240a0481285343e5e7111f71104d compiler/basicTypes/Demand.hs | 7 +- compiler/basicTypes/VarEnv.hs | 5 +- compiler/stranal/DmdAnal.hs | 188 ++++++++++++++++++------------- compiler/utils/UniqFM.hs | 6 + testsuite/tests/stranal/should_run/all.T | 3 +- 5 files changed, 128 insertions(+), 81 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 78c5dd690ef1240a0481285343e5e7111f71104d From git at git.haskell.org Wed Aug 3 14:05:37 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 3 Aug 2016 14:05:37 +0000 (UTC) Subject: [commit: ghc] wip/12368: DmdAnal: Testcase about splitFVs and dmdFix abortion (a266195) Message-ID: <20160803140537.127DD3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/12368 Link : http://ghc.haskell.org/trac/ghc/changeset/a26619539e370be80ffdd8f80c1d005ac8d123a3/ghc >--------------------------------------------------------------- commit a26619539e370be80ffdd8f80c1d005ac8d123a3 Author: Joachim Breitner Date: Thu Jul 21 17:44:25 2016 +0200 DmdAnal: Testcase about splitFVs and dmdFix abortion Any variable with useful information (strict or used-once) will not be included in lazy_fv (according to splitFVs). If we now also remove them from the strictness signatures, their uses are not recorded anywhere – and then probably considered absent. >--------------------------------------------------------------- a26619539e370be80ffdd8f80c1d005ac8d123a3 testsuite/tests/stranal/should_run/T12368a.hs | 27 +++++++++++++++++++++++ testsuite/tests/stranal/should_run/T12368a.stderr | 3 +++ 2 files changed, 30 insertions(+) diff --git a/testsuite/tests/stranal/should_run/T12368a.hs b/testsuite/tests/stranal/should_run/T12368a.hs new file mode 100644 index 0000000..738e8ef --- /dev/null +++ b/testsuite/tests/stranal/should_run/T12368a.hs @@ -0,0 +1,27 @@ +-- Needs to be a product type +data Stream = S Int Stream + +-- a is wrongly recorded abstent if the non-lazy-fv from foo are thrown away. +bar :: Int -> Int -> Stream -> Int +bar a n s = foo n s + where + -- Non terminating local rec, strict in a + foo :: Int -> Stream -> Int + foo 0 (S n s) = a + foo i (S n s) = a `seq` n + foo (i-1) s +{-# NOINLINE bar #-} + + +baz :: Int -> Int -> Int +baz 0 not_absent = 0 +baz 1 not_absent = baz 2 not_absent +baz x not_absent = bar not_absent 1000 arg + where + arg = S 1 arg + +bamf x = baz x (error "This is good!") +{-# NOINLINE bamf #-} + + +main :: IO () +main = bamf 10 `seq` return () diff --git a/testsuite/tests/stranal/should_run/T12368a.stderr b/testsuite/tests/stranal/should_run/T12368a.stderr new file mode 100644 index 0000000..98246d3 --- /dev/null +++ b/testsuite/tests/stranal/should_run/T12368a.stderr @@ -0,0 +1,3 @@ +T12368a: This is good! +CallStack (from HasCallStack): + error, called at T12368a.hs:22:17 in main:Main From git at git.haskell.org Wed Aug 3 14:05:39 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 3 Aug 2016 14:05:39 +0000 (UTC) Subject: [commit: ghc] wip/12368: WwLib: Add strictness signature to "let x = absentError …" (e6cb493) Message-ID: <20160803140539.C79D93A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/12368 Link : http://ghc.haskell.org/trac/ghc/changeset/e6cb493d3fc8142f2a2e221d32e2c85d97aafc24/ghc >--------------------------------------------------------------- commit e6cb493d3fc8142f2a2e221d32e2c85d97aafc24 Author: Joachim Breitner Date: Tue Jul 26 12:08:59 2016 +0200 WwLib: Add strictness signature to "let x = absentError …" indicating that it is bottom. This should help making the "empty cases" lint error give less false alarms. >--------------------------------------------------------------- e6cb493d3fc8142f2a2e221d32e2c85d97aafc24 compiler/basicTypes/Demand.hs | 9 ++++++--- compiler/stranal/WwLib.hs | 11 ++++++----- 2 files changed, 12 insertions(+), 8 deletions(-) diff --git a/compiler/basicTypes/Demand.hs b/compiler/basicTypes/Demand.hs index 2ada6b3..d79fa6e 100644 --- a/compiler/basicTypes/Demand.hs +++ b/compiler/basicTypes/Demand.hs @@ -35,7 +35,8 @@ module Demand ( vanillaCprProdRes, cprSumRes, appIsBottom, isBottomingSig, pprIfaceStrictSig, trimCPRInfo, returnsCPR_maybe, - StrictSig(..), mkStrictSig, mkClosedStrictSig, nopSig, botSig, cprProdSig, + StrictSig(..), mkStrictSig, mkClosedStrictSig, + nopSig, botSig, exnSig, cprProdSig, isTopSig, hasDemandEnvSig, splitStrictSig, strictSigDmdEnv, increaseStrictSigArity, @@ -1264,9 +1265,10 @@ emptyDmdEnv = emptyVarEnv -- (lazy, absent, no CPR information, no termination information). -- Note that it is ''not'' the top of the lattice (which would be "may use everything"), -- so it is (no longer) called topDmd -nopDmdType, botDmdType :: DmdType +nopDmdType, botDmdType, exnDmdType :: DmdType nopDmdType = DmdType emptyDmdEnv [] topRes botDmdType = DmdType emptyDmdEnv [] botRes +exnDmdType = DmdType emptyDmdEnv [] exnRes cprProdDmdType :: Arity -> DmdType cprProdDmdType arity @@ -1691,9 +1693,10 @@ isBottomingSig :: StrictSig -> Bool -- True if the signature diverges or throws an exception isBottomingSig (StrictSig (DmdType _ _ res)) = isBotRes res -nopSig, botSig :: StrictSig +nopSig, botSig, exnSig :: StrictSig nopSig = StrictSig nopDmdType botSig = StrictSig botDmdType +exnSig = StrictSig exnDmdType cprProdSig :: Arity -> StrictSig cprProdSig arity = StrictSig (cprProdDmdType arity) diff --git a/compiler/stranal/WwLib.hs b/compiler/stranal/WwLib.hs index 812252c..c0b1af3 100644 --- a/compiler/stranal/WwLib.hs +++ b/compiler/stranal/WwLib.hs @@ -709,7 +709,7 @@ every primitive type, so the function is partial. mk_absent_let :: DynFlags -> Id -> Maybe (CoreExpr -> CoreExpr) mk_absent_let dflags arg | not (isUnliftedType arg_ty) - = Just (Let (NonRec arg abs_rhs)) + = Just (Let (NonRec lifted_arg abs_rhs)) | Just tc <- tyConAppTyCon_maybe arg_ty , Just lit <- absentLiteralOf tc = Just (Let (NonRec arg (Lit lit))) @@ -719,10 +719,11 @@ mk_absent_let dflags arg = WARN( True, text "No absent value for" <+> ppr arg_ty ) Nothing where - arg_ty = idType arg - abs_rhs = mkRuntimeErrorApp aBSENT_ERROR_ID arg_ty msg - msg = showSDoc (gopt_set dflags Opt_SuppressUniques) - (ppr arg <+> ppr (idType arg)) + arg_ty = idType arg + abs_rhs = mkRuntimeErrorApp aBSENT_ERROR_ID arg_ty msg + lifted_arg = arg `setIdStrictness` exnSig + msg = showSDoc (gopt_set dflags Opt_SuppressUniques) + (ppr arg <+> ppr (idType arg)) -- We need to suppress uniques here because otherwise they'd -- end up in the generated code as strings. This is bad for -- determinism, because with different uniques the strings From git at git.haskell.org Wed Aug 3 14:05:42 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 3 Aug 2016 14:05:42 +0000 (UTC) Subject: [commit: ghc] wip/12368's head updated: WwLib: Add strictness signature to "let x = absentError …" (e6cb493) Message-ID: <20160803140542.29CE93A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/12368' now includes: 2078909 Typo in comment 36565a9 ForeignCall.hs: Remove DrIFT directives 55f5aed Track the lengths of the thread queues 988ad8b Fix to thread migration d1fe08e Only trace cap/capset events if we're tracing anything else 4dcbbd1 Remove the DEBUG_ variables, use RtsFlags directly 9df9490 StgSyn: Remove unused StgLiveVars types 2f79e79 Add comment about lexing of INLINE and INLINABLE pragma 0c37aef Update old comment InlinePragma b1e6415 More comments about InlinePragmas 7a06b22 Typo in comment [skip ci] 17112bd Comments only: Refer to actually existing Notes 78c5dd6 DmdAnal: Add a final, safe iteration a266195 DmdAnal: Testcase about splitFVs and dmdFix abortion 85ac1ca Degrade "case scrutinee not known to diverge for sure" Lint error to warning e6cb493 WwLib: Add strictness signature to "let x = absentError …" From git at git.haskell.org Wed Aug 3 15:00:14 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 3 Aug 2016 15:00:14 +0000 (UTC) Subject: [commit: ghc] master: Remove `setUnfoldingInfoLazily` (7a8ef01) Message-ID: <20160803150014.6D29B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7a8ef01920731f0afa45f3589fcb4a89d5eb125c/ghc >--------------------------------------------------------------- commit 7a8ef01920731f0afa45f3589fcb4a89d5eb125c Author: Matthew Pickering Date: Wed Aug 3 14:22:21 2016 +0100 Remove `setUnfoldingInfoLazily` The definition of `setUnfoldingInfoLazily` is exactly the same as `setUnfoldingInfo` and is only used in one place, `TcIface`. They were made equivalent in 2010 in 2ff2497dc374175b8ed81446258baf208d1f3e6e with the commit message. {{{ commit 2ff2497dc374175b8ed81446258baf208d1f3e6e Author: Ian Lynagh Wed Oct 20 15:37:10 2010 Committer: Ian Lynagh Wed Oct 20 15:37:10 2010 Original File: compiler/basicTypes/IdInfo.lhs Don't seq unfoldings We generate intermediate unfoldings which are just thrown away, so evaluating them is a waste of time. }}} Closes #12453 >--------------------------------------------------------------- 7a8ef01920731f0afa45f3589fcb4a89d5eb125c compiler/basicTypes/Id.hs | 7 +------ compiler/basicTypes/IdInfo.hs | 7 +------ compiler/iface/TcIface.hs | 2 +- compiler/vectorise/Vectorise.hs | 2 +- 4 files changed, 4 insertions(+), 14 deletions(-) diff --git a/compiler/basicTypes/Id.hs b/compiler/basicTypes/Id.hs index 387de1e..4e8847b 100644 --- a/compiler/basicTypes/Id.hs +++ b/compiler/basicTypes/Id.hs @@ -90,7 +90,6 @@ module Id ( idOccInfo, -- ** Writing 'IdInfo' fields - setIdUnfoldingLazily, setIdUnfolding, setIdArity, setIdCallArity, @@ -139,8 +138,7 @@ import Util import StaticFlags -- infixl so you can say (id `set` a `set` b) -infixl 1 `setIdUnfoldingLazily`, - `setIdUnfolding`, +infixl 1 `setIdUnfolding`, `setIdArity`, `setIdCallArity`, `setIdOccInfo`, @@ -606,9 +604,6 @@ realIdUnfolding :: Id -> Unfolding -- Expose the unfolding if there is one, including for loop breakers realIdUnfolding id = unfoldingInfo (idInfo id) -setIdUnfoldingLazily :: Id -> Unfolding -> Id -setIdUnfoldingLazily id unfolding = modifyIdInfo (`setUnfoldingInfoLazily` unfolding) id - setIdUnfolding :: Id -> Unfolding -> Id setIdUnfolding id unfolding = modifyIdInfo (`setUnfoldingInfo` unfolding) id diff --git a/compiler/basicTypes/IdInfo.hs b/compiler/basicTypes/IdInfo.hs index 0cd2e95..4d10f20 100644 --- a/compiler/basicTypes/IdInfo.hs +++ b/compiler/basicTypes/IdInfo.hs @@ -38,7 +38,7 @@ module IdInfo ( demandInfo, setDemandInfo, pprStrictness, -- ** Unfolding Info - unfoldingInfo, setUnfoldingInfo, setUnfoldingInfoLazily, + unfoldingInfo, setUnfoldingInfo, -- ** The InlinePragInfo type InlinePragInfo, @@ -230,11 +230,6 @@ setOccInfo :: IdInfo -> OccInfo -> IdInfo setOccInfo info oc = oc `seq` info { occInfo = oc } -- Try to avoid spack leaks by seq'ing -setUnfoldingInfoLazily :: IdInfo -> Unfolding -> IdInfo -setUnfoldingInfoLazily info uf -- Lazy variant to avoid looking at the - = -- unfolding of an imported Id unless necessary - info { unfoldingInfo = uf } -- (In this case the demand-zapping is redundant.) - setUnfoldingInfo :: IdInfo -> Unfolding -> IdInfo setUnfoldingInfo info uf = -- We don't seq the unfolding, as we generate intermediate diff --git a/compiler/iface/TcIface.hs b/compiler/iface/TcIface.hs index f8e9505..56c5a5a 100644 --- a/compiler/iface/TcIface.hs +++ b/compiler/iface/TcIface.hs @@ -1232,7 +1232,7 @@ tcIdInfo ignore_prags name ty info = do { unf <- tcUnfolding name ty info if_unf ; let info1 | lb = info `setOccInfo` strongLoopBreaker | otherwise = info - ; return (info1 `setUnfoldingInfoLazily` unf) } + ; return (info1 `setUnfoldingInfo` unf) } tcUnfolding :: Name -> Type -> IdInfo -> IfaceUnfolding -> IfL Unfolding tcUnfolding name _ info (IfCoreUnfold stable if_expr) diff --git a/compiler/vectorise/Vectorise.hs b/compiler/vectorise/Vectorise.hs index 77561ff..b78db7c 100644 --- a/compiler/vectorise/Vectorise.hs +++ b/compiler/vectorise/Vectorise.hs @@ -315,7 +315,7 @@ vectTopBinder var inline expr (text "Inferred type" <+> ppr vdty) } -- Make the vectorised version of binding's name, and set the unfolding used for inlining - ; var' <- liftM (`setIdUnfoldingLazily` unfolding) + ; var' <- liftM (`setIdUnfolding` unfolding) $ mkVectId var vty -- Add the mapping between the plain and vectorised name to the state. From git at git.haskell.org Wed Aug 3 16:06:54 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 3 Aug 2016 16:06:54 +0000 (UTC) Subject: [commit: ghc] master: Clarify comment on makeCorePair (a13fda7) Message-ID: <20160803160654.38DE53A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a13fda71b02cdaa840f8040b392777272a0d7794/ghc >--------------------------------------------------------------- commit a13fda71b02cdaa840f8040b392777272a0d7794 Author: Matthew Pickering Date: Wed Aug 3 17:06:42 2016 +0100 Clarify comment on makeCorePair >--------------------------------------------------------------- a13fda71b02cdaa840f8040b392777272a0d7794 compiler/deSugar/DsBinds.hs | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/compiler/deSugar/DsBinds.hs b/compiler/deSugar/DsBinds.hs index f5211d2..8c05f43 100644 --- a/compiler/deSugar/DsBinds.hs +++ b/compiler/deSugar/DsBinds.hs @@ -349,9 +349,12 @@ dsHsBind _ (PatSynBind{}) = panic "dsHsBind: PatSynBind" -- | This is where we apply INLINE and INLINABLE pragmas. All we need to --- do is to attach the unfolding information to the Id. When the interface --- files are created, unfoldings are only attached if the information is --- present. +-- do is to attach the unfolding information to the Id. +-- +-- Other decisions about whether to inline are made in +-- `calcUnfoldingGuidance` but the decision about whether to then expose +-- the unfolding in the interface file is made in `TidyPgm.addExternal` +-- using this information. ------------------------ makeCorePair :: DynFlags -> Id -> Bool -> Arity -> CoreExpr -> (Id, CoreExpr) makeCorePair dflags gbl_id is_default_method dict_arity rhs From git at git.haskell.org Thu Aug 4 10:11:18 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 4 Aug 2016 10:11:18 +0000 (UTC) Subject: [commit: ghc] master: CmmLive: Remove some redundant exports (d85b26d) Message-ID: <20160804101118.4342A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d85b26d3dcd3efad87b31e185860645af3882d39/ghc >--------------------------------------------------------------- commit d85b26d3dcd3efad87b31e185860645af3882d39 Author: Ömer Sinan Ağacan Date: Thu Aug 4 10:09:56 2016 +0000 CmmLive: Remove some redundant exports >--------------------------------------------------------------- d85b26d3dcd3efad87b31e185860645af3882d39 compiler/cmm/CmmLive.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/cmm/CmmLive.hs b/compiler/cmm/CmmLive.hs index 80aceaf..bbb36cb 100644 --- a/compiler/cmm/CmmLive.hs +++ b/compiler/cmm/CmmLive.hs @@ -11,7 +11,7 @@ module CmmLive , cmmLocalLiveness , cmmGlobalLiveness , liveLattice - , gen, kill, gen_kill + , gen_kill ) where From git at git.haskell.org Thu Aug 4 10:11:20 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 4 Aug 2016 10:11:20 +0000 (UTC) Subject: [commit: ghc] master: CmmLayoutStack: Minor simplification (8ecac25) Message-ID: <20160804101120.E46F23A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8ecac2512aed557b4f59fd697eabd3ef9ddfd6e9/ghc >--------------------------------------------------------------- commit 8ecac2512aed557b4f59fd697eabd3ef9ddfd6e9 Author: Ömer Sinan Ağacan Date: Thu Aug 4 10:10:41 2016 +0000 CmmLayoutStack: Minor simplification >--------------------------------------------------------------- 8ecac2512aed557b4f59fd697eabd3ef9ddfd6e9 compiler/cmm/CmmLayoutStack.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/compiler/cmm/CmmLayoutStack.hs b/compiler/cmm/CmmLayoutStack.hs index 37bd7a0..2536030 100644 --- a/compiler/cmm/CmmLayoutStack.hs +++ b/compiler/cmm/CmmLayoutStack.hs @@ -190,11 +190,11 @@ instance Outputable StackMap where cmmLayoutStack :: DynFlags -> ProcPointSet -> ByteOff -> CmmGraph -> UniqSM (CmmGraph, BlockEnv StackMap) cmmLayoutStack dflags procpoints entry_args - graph0@(CmmGraph { g_entry = entry }) + graph@(CmmGraph { g_entry = entry }) = do -- We need liveness info. Dead assignments are removed later -- by the sinking pass. - let (graph, liveness) = (graph0, cmmLocalLiveness dflags graph0) + let liveness = cmmLocalLiveness dflags graph blocks = postorderDfs graph (final_stackmaps, _final_high_sp, new_blocks) <- From git at git.haskell.org Thu Aug 4 14:28:27 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 4 Aug 2016 14:28:27 +0000 (UTC) Subject: [commit: ghc] master: Replace an unsafeCoerce with coerce (fc66415) Message-ID: <20160804142827.21B6A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/fc66415b11523dcd0bff267225cc901203515060/ghc >--------------------------------------------------------------- commit fc66415b11523dcd0bff267225cc901203515060 Author: Ryan Scott Date: Thu Aug 4 10:25:10 2016 -0400 Replace an unsafeCoerce with coerce This matches the implementations of `castPtr` and `castFunPtr`. >--------------------------------------------------------------- fc66415b11523dcd0bff267225cc901203515060 libraries/base/GHC/ForeignPtr.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/base/GHC/ForeignPtr.hs b/libraries/base/GHC/ForeignPtr.hs index aaad3c6..b9b29ea 100644 --- a/libraries/base/GHC/ForeignPtr.hs +++ b/libraries/base/GHC/ForeignPtr.hs @@ -432,7 +432,7 @@ unsafeForeignPtrToPtr (ForeignPtr fo _) = Ptr fo castForeignPtr :: ForeignPtr a -> ForeignPtr b -- ^This function casts a 'ForeignPtr' -- parameterised by one type into another type. -castForeignPtr f = unsafeCoerce# f +castForeignPtr = coerce -- | Causes the finalizers associated with a foreign pointer to be run -- immediately. From git at git.haskell.org Fri Aug 5 07:06:42 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 5 Aug 2016 07:06:42 +0000 (UTC) Subject: [commit: ghc] master: Fix omission in haddock instance head (db5a226) Message-ID: <20160805070642.ED4DB3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/db5a22627b3e6bcc9fa17fbc070daac0919b552a/ghc >--------------------------------------------------------------- commit db5a22627b3e6bcc9fa17fbc070daac0919b552a Author: Gabor Greif Date: Fri Aug 5 09:00:51 2016 +0200 Fix omission in haddock instance head >--------------------------------------------------------------- db5a22627b3e6bcc9fa17fbc070daac0919b552a libraries/ghc-prim/GHC/Types.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/ghc-prim/GHC/Types.hs b/libraries/ghc-prim/GHC/Types.hs index fe21e41..06fc793 100644 --- a/libraries/ghc-prim/GHC/Types.hs +++ b/libraries/ghc-prim/GHC/Types.hs @@ -229,7 +229,7 @@ class a ~~ b -- Nevertheless one can pretend that the following three kinds of instances -- exist. First, as a trivial base-case: -- --- @instance a a@ +-- @instance Coercible a a@ -- -- Furthermore, for every type constructor there is -- an instance that allows to coerce under the type constructor. For From git at git.haskell.org Fri Aug 5 07:47:09 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 5 Aug 2016 07:47:09 +0000 (UTC) Subject: [commit: ghc] master: Trim all spaces after 'version:' (1101045) Message-ID: <20160805074709.C67393A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1101045cbdbd6f240fa7e2438d9488822cd604fb/ghc >--------------------------------------------------------------- commit 1101045cbdbd6f240fa7e2438d9488822cd604fb Author: Gabor Greif Date: Fri Aug 5 09:42:09 2016 +0200 Trim all spaces after 'version:' ... that we grep out of libraries/Cabal/Cabal/Cabal.cabal This is necessary because the file got reformatted in the 'master' branch. >--------------------------------------------------------------- 1101045cbdbd6f240fa7e2438d9488822cd604fb utils/ghc-cabal/ghc.mk | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/utils/ghc-cabal/ghc.mk b/utils/ghc-cabal/ghc.mk index c06a011..62338ee 100644 --- a/utils/ghc-cabal/ghc.mk +++ b/utils/ghc-cabal/ghc.mk @@ -14,7 +14,7 @@ # Euch, hideous hack: # XXX This should be in a different Makefile -CABAL_DOTTED_VERSION := $(shell grep "^version:" libraries/Cabal/Cabal/Cabal.cabal | sed "s/^version: //") +CABAL_DOTTED_VERSION := $(shell grep "^version:" libraries/Cabal/Cabal/Cabal.cabal | sed "s/^version: *//") CABAL_VERSION := $(subst .,$(comma),$(CABAL_DOTTED_VERSION)) CABAL_CONSTRAINT := --constraint="Cabal == $(CABAL_DOTTED_VERSION)" From git at git.haskell.org Fri Aug 5 08:06:01 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 5 Aug 2016 08:06:01 +0000 (UTC) Subject: [commit: ghc] master: Remove identity update of field componentsConfigs (fe4008f) Message-ID: <20160805080601.21CBD3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/fe4008f6cc51612c2511cf23fcd646bc23ef91b8/ghc >--------------------------------------------------------------- commit fe4008f6cc51612c2511cf23fcd646bc23ef91b8 Author: Gabor Greif Date: Fri Aug 5 09:52:26 2016 +0200 Remove identity update of field componentsConfigs ... in LocalBuildInfo, getting rid of a TODO in the process. Turns out that componentsConfigs won't be a field in Cabal 2.0 any more, so this can be seen as a preparation for it. >--------------------------------------------------------------- fe4008f6cc51612c2511cf23fcd646bc23ef91b8 utils/ghc-cabal/Main.hs | 7 +------ 1 file changed, 1 insertion(+), 6 deletions(-) diff --git a/utils/ghc-cabal/Main.hs b/utils/ghc-cabal/Main.hs index 99f34d9..8cc1d1a 100644 --- a/utils/ghc-cabal/Main.hs +++ b/utils/ghc-cabal/Main.hs @@ -229,12 +229,7 @@ doRegister directory distDir ghc ghcpkg topdir progs' <- configurePrograms [ghcProgram', ghcPkgProgram'] progs instInfos <- dump (hcPkgInfo progs') verbosity GlobalPackageDB let installedPkgs' = PackageIndex.fromList instInfos - let updateComponentConfig (clbi, deps) - = (updateComponentLocalBuildInfo clbi, deps) - updateComponentLocalBuildInfo clbi = clbi -- TODO: remove - ccs' = map updateComponentConfig (componentsConfigs lbi) - lbi' = lbi { - componentsConfigs = ccs', + let lbi' = lbi { installedPkgs = installedPkgs', installDirTemplates = idts, withPrograms = progs' From git at git.haskell.org Fri Aug 5 08:41:02 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 5 Aug 2016 08:41:02 +0000 (UTC) Subject: [commit: ghc] master: codeGen: Remove binutils<2.17 hack, fixes T11758 (e3e2e49) Message-ID: <20160805084102.B925A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e3e2e49a8f6952e1c8a19321c729c17b294d8c92/ghc >--------------------------------------------------------------- commit e3e2e49a8f6952e1c8a19321c729c17b294d8c92 Author: Alex Dzyoba Date: Thu Aug 4 13:42:21 2016 +0200 codeGen: Remove binutils<2.17 hack, fixes T11758 There was a complication on the x86_64 platform, where pointers were 64 bits, but the tools didn't support 64-bit relative relocations. This was true before binutils 2.17, which nowadays is quite standart (even CentOs 5 is shipped with 2.17). Hacks were removed from x86 genSwitch and asm pretty printer. Also [x86-64-relative] note was dropped from includes/rts/storage/InfoTables.h as it's not referenced anywhere now. Reviewers: austin, simonmar, rwbarton, erikd, bgamari Reviewed By: simonmar, erikd, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2426 >--------------------------------------------------------------- e3e2e49a8f6952e1c8a19321c729c17b294d8c92 compiler/nativeGen/X86/CodeGen.hs | 15 +-------------- compiler/nativeGen/X86/Ppr.hs | 23 ++--------------------- includes/rts/storage/InfoTables.h | 11 ----------- 3 files changed, 3 insertions(+), 46 deletions(-) diff --git a/compiler/nativeGen/X86/CodeGen.hs b/compiler/nativeGen/X86/CodeGen.hs index cd45d92..2bfcd9a 100644 --- a/compiler/nativeGen/X86/CodeGen.hs +++ b/compiler/nativeGen/X86/CodeGen.hs @@ -2624,23 +2624,10 @@ genSwitch dflags expr targets let op = OpAddr (AddrBaseIndex (EABaseReg tableReg) (EAIndex reg (wORD_SIZE dflags)) (ImmInt 0)) - return $ if is32bit || os == OSDarwin - then e_code `appOL` t_code `appOL` toOL [ + return $ e_code `appOL` t_code `appOL` toOL [ ADD (intFormat (wordWidth dflags)) op (OpReg tableReg), JMP_TBL (OpReg tableReg) ids rosection lbl ] - else -- HACK: On x86_64 binutils<2.17 is only able to generate - -- PC32 relocations, hence we only get 32-bit offsets in - -- the jump table. As these offsets are always negative - -- we need to properly sign extend them to 64-bit. This - -- hack should be removed in conjunction with the hack in - -- PprMach.hs/pprDataItem once binutils 2.17 is standard. - e_code `appOL` t_code `appOL` toOL [ - MOVSxL II32 op (OpReg reg), - ADD (intFormat (wordWidth dflags)) (OpReg reg) - (OpReg tableReg), - JMP_TBL (OpReg tableReg) ids rosection lbl - ] | otherwise = do (reg,e_code) <- getSomeReg (cmmOffset dflags expr offset) diff --git a/compiler/nativeGen/X86/Ppr.hs b/compiler/nativeGen/X86/Ppr.hs index 7809ae1..090ff53 100644 --- a/compiler/nativeGen/X86/Ppr.hs +++ b/compiler/nativeGen/X86/Ppr.hs @@ -454,27 +454,8 @@ pprDataItem' dflags lit _ -> panic "X86.Ppr.ppr_item: no match for II64" | otherwise -> [text "\t.quad\t" <> pprImm imm] - _ - | target32Bit platform -> - [text "\t.quad\t" <> pprImm imm] - | otherwise -> - -- x86_64: binutils can't handle the R_X86_64_PC64 - -- relocation type, which means we can't do - -- pc-relative 64-bit addresses. Fortunately we're - -- assuming the small memory model, in which all such - -- offsets will fit into 32 bits, so we have to stick - -- to 32-bit offset fields and modify the RTS - -- appropriately - -- - -- See Note [x86-64-relative] in includes/rts/storage/InfoTables.h - -- - case lit of - -- A relative relocation: - CmmLabelDiffOff _ _ _ -> - [text "\t.long\t" <> pprImm imm, - text "\t.long\t0"] - _ -> - [text "\t.quad\t" <> pprImm imm] + + _ -> [text "\t.quad\t" <> pprImm imm] ppr_item _ _ = panic "X86.Ppr.ppr_item: no match" diff --git a/includes/rts/storage/InfoTables.h b/includes/rts/storage/InfoTables.h index fb14ac5..e6bd15c 100644 --- a/includes/rts/storage/InfoTables.h +++ b/includes/rts/storage/InfoTables.h @@ -15,17 +15,6 @@ Several pointer fields in info tables are expressed as offsets relative to the info pointer, so that we can generate position-independent code. - - Note [x86-64-relative] - There is a complication on the x86_64 platform, where pointers are - 64 bits, but the tools don't support 64-bit relative relocations. - However, the default memory model (small) ensures that all symbols - have values in the lower 2Gb of the address space, so offsets all - fit in 32 bits. Hence we can use 32-bit offset fields. - - Somewhere between binutils-2.16.1 and binutils-2.16.91.0.6, - support for 64-bit PC-relative relocations was added, so maybe this - hackery can go away sometime. ------------------------------------------------------------------------- */ #if x86_64_TARGET_ARCH From git at git.haskell.org Fri Aug 5 08:41:06 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 5 Aug 2016 08:41:06 +0000 (UTC) Subject: [commit: ghc] master: check that the number of parallel build is greater than 0 (f09d654) Message-ID: <20160805084106.17BD13A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f09d65474ed042360999cb88221d65b07bfb4b5f/ghc >--------------------------------------------------------------- commit f09d65474ed042360999cb88221d65b07bfb4b5f Author: Ruey-Lin Hsu Date: Thu Aug 4 13:41:57 2016 +0200 check that the number of parallel build is greater than 0 Fixes #12062. Reviewers: bgamari, thomie, austin, simonmar Reviewed By: bgamari, thomie, simonmar Subscribers: simonmar, thomie Differential Revision: https://phabricator.haskell.org/D2415 GHC Trac Issues: #12062 >--------------------------------------------------------------- f09d65474ed042360999cb88221d65b07bfb4b5f compiler/main/DynFlags.hs | 13 +++++++++++-- docs/users_guide/using.rst | 10 ++++++---- testsuite/driver/extra_files.py | 1 + .../{programs/hs-boot/A.hs-boot => driver/T12062/A.hs} | 2 -- testsuite/tests/{th/T2014 => driver/T12062}/A.hs-boot | 0 .../{th/TH_import_loop/ModuleC.hs => driver/T12062/C.hs} | 6 ++---- .../scripts/break022 => driver/T12062}/Makefile | 0 .../TH_import_loop/ModuleB.hs => driver/T12062/T12062.hs} | 7 ++----- testsuite/tests/driver/T12062/T12062.stderr | 2 ++ testsuite/tests/driver/T12062/all.T | 2 ++ 10 files changed, 26 insertions(+), 17 deletions(-) diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 744562e..c1ccfcd 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -2343,8 +2343,17 @@ dynamic_flags_deps = [ "deprecated: They no longer have any effect")))) , make_ord_flag defFlag "v" (OptIntSuffix setVerbosity) - , make_ord_flag defGhcFlag "j" (OptIntSuffix (\n -> - upd (\d -> d {parMakeCount = n}))) + , make_ord_flag defGhcFlag "j" (OptIntSuffix + (\n -> case n of + Just n + | n > 0 -> upd (\d -> d { parMakeCount = Just n }) + | otherwise -> addErr "Syntax: -j[n] where n > 0" + Nothing -> upd (\d -> d { parMakeCount = Nothing }))) + -- When the number of parallel builds + -- is omitted, it is the same + -- as specifing that the number of + -- parallel builds is equal to the + -- result of getNumProcessors , make_ord_flag defFlag "sig-of" (sepArg setSigOf) -- RTS options ------------------------------------------------------------- diff --git a/docs/users_guide/using.rst b/docs/users_guide/using.rst index 3d3ef34..1d7f52c 100644 --- a/docs/users_guide/using.rst +++ b/docs/users_guide/using.rst @@ -418,7 +418,8 @@ The main advantages to using ``ghc --make`` over traditional dependencies never get out of sync with the source. - Using the :ghc-flag:`-j` flag, you can compile modules in parallel. Specify - ``-j⟨N⟩`` to compile ⟨N⟩ jobs in parallel. + ``-j⟨N⟩`` to compile ⟨N⟩ jobs in parallel. If N is omitted, + then it defaults to the number of processors. Any of the command-line options described in the rest of this chapter can be used with ``--make``, but note that any options you give on the @@ -444,11 +445,12 @@ The source files for the program don't all need to be in the same directory; the :ghc-flag:`-i` option can be used to add directories to the search path (see :ref:`search-path`). -.. ghc-flag:: -j +.. ghc-flag:: -j [N] Perform compilation in parallel when possible. GHC will use up to ⟨N⟩ - threads during compilation. Note that compilation of a module may not - begin until its dependencies have been built. + threads during compilation. If N is omitted, then it defaults to the + number of processors. Note that compilation of a module may not begin + until its dependencies have been built. .. _eval-mode: diff --git a/testsuite/driver/extra_files.py b/testsuite/driver/extra_files.py index bc5d460..ee09182 100644 --- a/testsuite/driver/extra_files.py +++ b/testsuite/driver/extra_files.py @@ -82,6 +82,7 @@ extra_src_files = { 'T11430': ['Test11430.hs', 't11430.hs'], 'T11824': ['TyCon.hs', 'Type.hs', 'Type.hs-boot', 'Unbound/'], 'T11827': ['A.hs', 'A.hs-boot', 'B.hs'], + 'T12062': ['A.hs', 'A.hs-boot', 'C.hs'], 'T1372': ['p1/', 'p2/'], 'T1407': ['A.c'], 'T1959': ['B.hs', 'C.hs', 'D.hs', 'E1.hs', 'E2.hs'], diff --git a/testsuite/tests/programs/hs-boot/A.hs-boot b/testsuite/tests/driver/T12062/A.hs similarity index 92% copy from testsuite/tests/programs/hs-boot/A.hs-boot copy to testsuite/tests/driver/T12062/A.hs index c80b00d..b1ea7a4 100644 --- a/testsuite/tests/programs/hs-boot/A.hs-boot +++ b/testsuite/tests/driver/T12062/A.hs @@ -1,4 +1,2 @@ - module A where - import C diff --git a/testsuite/tests/th/T2014/A.hs-boot b/testsuite/tests/driver/T12062/A.hs-boot similarity index 100% copy from testsuite/tests/th/T2014/A.hs-boot copy to testsuite/tests/driver/T12062/A.hs-boot diff --git a/testsuite/tests/th/TH_import_loop/ModuleC.hs b/testsuite/tests/driver/T12062/C.hs similarity index 53% copy from testsuite/tests/th/TH_import_loop/ModuleC.hs copy to testsuite/tests/driver/T12062/C.hs index 3047a8f..0f2a5b3 100644 --- a/testsuite/tests/th/TH_import_loop/ModuleC.hs +++ b/testsuite/tests/driver/T12062/C.hs @@ -1,9 +1,7 @@ - -module ModuleC where +module C where import Language.Haskell.TH -import {-# SOURCE #-} ModuleA +import {-# SOURCE #-} A nothing = return [] :: Q [Dec] - diff --git a/testsuite/tests/ghci.debugger/scripts/break022/Makefile b/testsuite/tests/driver/T12062/Makefile similarity index 100% copy from testsuite/tests/ghci.debugger/scripts/break022/Makefile copy to testsuite/tests/driver/T12062/Makefile diff --git a/testsuite/tests/th/TH_import_loop/ModuleB.hs b/testsuite/tests/driver/T12062/T12062.hs similarity index 54% copy from testsuite/tests/th/TH_import_loop/ModuleB.hs copy to testsuite/tests/driver/T12062/T12062.hs index 9aaffb6..ed581c0 100644 --- a/testsuite/tests/th/TH_import_loop/ModuleB.hs +++ b/testsuite/tests/driver/T12062/T12062.hs @@ -1,9 +1,6 @@ - {-# LANGUAGE TemplateHaskell #-} +module T12062 where -module ModuleB where - -import ModuleC +import C $(nothing) - diff --git a/testsuite/tests/driver/T12062/T12062.stderr b/testsuite/tests/driver/T12062/T12062.stderr new file mode 100644 index 0000000..8262940 --- /dev/null +++ b/testsuite/tests/driver/T12062/T12062.stderr @@ -0,0 +1,2 @@ +ghc-stage2: on the commandline: Syntax: -j[n] where n > 0 +Usage: For basic information, try the `--help' option. diff --git a/testsuite/tests/driver/T12062/all.T b/testsuite/tests/driver/T12062/all.T new file mode 100644 index 0000000..1372ae3 --- /dev/null +++ b/testsuite/tests/driver/T12062/all.T @@ -0,0 +1,2 @@ +test('T12062', extra_clean(['T12062.o','T12062.hi', 'A.hi', 'A.o', 'A.hi-boot', 'A.o-boot', 'C.hi', 'C.o']), + multimod_compile_fail, ['T12062', '-v0 -j0']) From git at git.haskell.org Fri Aug 5 08:41:08 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 5 Aug 2016 08:41:08 +0000 (UTC) Subject: [commit: ghc] master: Expanded abbreviations in Haddock documentation (ca7e1ad) Message-ID: <20160805084108.CCCF13A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ca7e1ad346362ba68b430550110e74421b19193f/ghc >--------------------------------------------------------------- commit ca7e1ad346362ba68b430550110e74421b19193f Author: Ben Gamari Date: Thu Aug 4 14:36:09 2016 +0200 Expanded abbreviations in Haddock documentation This adds notes to the Haddock documentation for various core datatypes expanding abbreviations. Reviewers: bgamari, thomie Differential Revision: https://phabricator.haskell.org/D2406 GHC Trac Issues: #12405 >--------------------------------------------------------------- ca7e1ad346362ba68b430550110e74421b19193f compiler/basicTypes/BasicTypes.hs | 26 ++++++++-- compiler/basicTypes/DataCon.hs | 23 ++++++--- compiler/basicTypes/IdInfo.hs | 25 ++++++--- compiler/basicTypes/MkId.hs | 1 + compiler/basicTypes/Module.hs | 4 +- compiler/basicTypes/NameEnv.hs | 4 +- compiler/basicTypes/OccName.hs | 5 ++ compiler/basicTypes/PatSyn.hs | 3 +- compiler/basicTypes/RdrName.hs | 42 +++++++++++---- compiler/basicTypes/SrcLoc.hs | 11 +++- compiler/basicTypes/UniqSupply.hs | 4 +- compiler/basicTypes/Unique.hs | 4 +- compiler/basicTypes/Var.hs | 38 ++++++++++++-- compiler/basicTypes/VarEnv.hs | 22 +++++++- compiler/basicTypes/VarSet.hs | 19 ++++++- compiler/hsSyn/HsBinds.hs | 74 +++++++++++++++++++++------ compiler/hsSyn/HsDecls.hs | 104 +++++++++++++++++++++++++++++++------- compiler/hsSyn/HsDoc.hs | 2 + compiler/hsSyn/HsExpr.hs | 79 ++++++++++++++++++++++++----- compiler/hsSyn/HsImpExp.hs | 32 +++++++++--- compiler/hsSyn/HsLit.hs | 60 ++++++++++++++-------- compiler/hsSyn/HsPat.hs | 73 ++++++++++++++++++-------- compiler/hsSyn/HsSyn.hs | 4 +- compiler/hsSyn/HsTypes.hs | 40 ++++++++++++++- 24 files changed, 559 insertions(+), 140 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 ca7e1ad346362ba68b430550110e74421b19193f From git at git.haskell.org Fri Aug 5 09:13:49 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 5 Aug 2016 09:13:49 +0000 (UTC) Subject: [commit: ghc] master: Fix an assertion that could randomly fail (ce13a9a) Message-ID: <20160805091349.3E1913A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ce13a9a9f57d61170837532948fed8bc1924a7ab/ghc >--------------------------------------------------------------- commit ce13a9a9f57d61170837532948fed8bc1924a7ab Author: Simon Marlow Date: Thu Aug 4 15:57:37 2016 +0100 Fix an assertion that could randomly fail Summary: ASSERT_THREADED_CAPABILITY_INVARIANTS was testing properties of the returning_tasks queue, but that requires cap->lock to access safely. This assertion would randomly fail if stressed enough. Instead I've removed it from the catch-all ASSERT_PARTIAL_CAPABILITIY_INVARIANTS and made it a separate assertion only called under cap->lock. Test Plan: ``` cd testsuite/tests/concurrent/should_run make TEST=setnumcapabilities001 WAY=threaded1 EXTRA_HC_OPTS=-with-rtsopts=-DS CLEANUP=0 while true; do ./setnumcapabilities001.run/setnumcapabilities001 4 9 2000 || break; done ``` Reviewers: niteria, bgamari, ezyang, austin, erikd Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2440 GHC Trac Issues: #10860 >--------------------------------------------------------------- ce13a9a9f57d61170837532948fed8bc1924a7ab rts/Capability.c | 3 +++ rts/Capability.h | 7 ++++--- 2 files changed, 7 insertions(+), 3 deletions(-) diff --git a/rts/Capability.c b/rts/Capability.c index f2220f0..681797b 100644 --- a/rts/Capability.c +++ b/rts/Capability.c @@ -213,6 +213,7 @@ newReturningTask (Capability *cap, Task *task) } cap->returning_tasks_tl = task; cap->n_returning_tasks++; + ASSERT_RETURNING_TASKS(cap,task); } STATIC_INLINE Task * @@ -228,6 +229,7 @@ popReturningTask (Capability *cap) } task->next = NULL; cap->n_returning_tasks--; + ASSERT_RETURNING_TASKS(cap,task); return task; } #endif @@ -507,6 +509,7 @@ releaseCapability_ (Capability* cap, task = cap->running_task; ASSERT_PARTIAL_CAPABILITY_INVARIANTS(cap,task); + ASSERT_RETURNING_TASKS(cap,task); cap->running_task = NULL; diff --git a/rts/Capability.h b/rts/Capability.h index 6779624..8e0288b 100644 --- a/rts/Capability.h +++ b/rts/Capability.h @@ -174,13 +174,15 @@ struct Capability_ { ASSERT(task->cap == cap); \ ASSERT_PARTIAL_CAPABILITY_INVARIANTS(cap,task) +// This assert requires cap->lock to be held, so it can't be part of +// ASSERT_PARTIAL_CAPABILITY_INVARIANTS() #if defined(THREADED_RTS) -#define ASSERT_THREADED_CAPABILITY_INVARIANTS(cap,task) \ +#define ASSERT_RETURNING_TASKS(cap,task) \ ASSERT(cap->returning_tasks_hd == NULL ? \ cap->returning_tasks_tl == NULL && cap->n_returning_tasks == 0 \ : 1); #else -#define ASSERT_THREADED_CAPABILITY_INVARIANTS(cap,task) /* nothing */ +#define ASSERT_RETURNING_TASKS(cap,task) /* nothing */ #endif // Sometimes a Task holds a Capability, but the Task is not associated @@ -193,7 +195,6 @@ struct Capability_ { cap->run_queue_tl == END_TSO_QUEUE && cap->n_run_queue == 0 \ : 1); \ ASSERT(cap->suspended_ccalls == NULL ? cap->n_suspended_ccalls == 0 : 1); \ - ASSERT_THREADED_CAPABILITY_INVARIANTS(cap,task); \ ASSERT(myTask() == task); \ ASSERT_TASK_ID(task); From git at git.haskell.org Fri Aug 5 09:13:51 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 5 Aug 2016 09:13:51 +0000 (UTC) Subject: [commit: ghc] master: Another try to get thread migration right (89fa4e9) Message-ID: <20160805091351.DD1073A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/89fa4e968f47cfb42d0dc33fc3bfffdce31d850e/ghc >--------------------------------------------------------------- commit 89fa4e968f47cfb42d0dc33fc3bfffdce31d850e Author: Simon Marlow Date: Thu Aug 4 15:59:43 2016 +0100 Another try to get thread migration right Summary: This is surprisingly tricky. There were linked list bugs in the previous version (D2430) that showed up as a test failure in setnumcapabilities001 (that's a great stress test!). This new version uses a different strategy that doesn't suffer from the problem that @ezyang pointed out in D2430. We now pre-calculate how many threads to keep for this capability, and then migrate any surplus threads off the front of the queue, taking care to account for threads that can't be migrated. Test Plan: 1. setnumcapabilities001 stress test with sanity checking (+RTS -DS) turned on: ``` cd testsuite/tests/concurrent/should_run make TEST=setnumcapabilities001 WAY=threaded1 EXTRA_HC_OPTS=-with-rtsopts=-DS CLEANUP=0 while true; do ./setnumcapabilities001.run/setnumcapabilities001 4 9 2000 || break; done ``` 2. The test case from #12419 Reviewers: niteria, ezyang, rwbarton, austin, bgamari, erikd Subscribers: thomie, ezyang Differential Revision: https://phabricator.haskell.org/D2441 GHC Trac Issues: #12419 >--------------------------------------------------------------- 89fa4e968f47cfb42d0dc33fc3bfffdce31d850e rts/Schedule.c | 161 ++++++++++++++++++++++----------------------------------- 1 file changed, 62 insertions(+), 99 deletions(-) diff --git a/rts/Schedule.c b/rts/Schedule.c index 908acf2..544b9c2 100644 --- a/rts/Schedule.c +++ b/rts/Schedule.c @@ -741,12 +741,6 @@ schedulePushWork(Capability *cap USED_IF_THREADS, // - threads that have TSO_LOCKED cannot migrate // - a thread that is bound to the current Task cannot be migrated // - // So we walk through the run queue, migrating threads to - // free_caps[] round-robin, skipping over immovable threads. Each - // time through free_caps[] we keep one thread for ourselves, - // provided we haven't encountered one or more immovable threads - // in this pass. - // // This is about the simplest thing we could do; improvements we // might want to do include: // @@ -758,112 +752,81 @@ schedulePushWork(Capability *cap USED_IF_THREADS, if (n_free_caps > 0) { StgTSO *prev, *t, *next; -#ifdef SPARK_PUSHING - rtsBool pushed_to_all; -#endif debugTrace(DEBUG_sched, "cap %d: %d threads, %d sparks, and %d free capabilities, sharing...", cap->no, cap->n_run_queue, sparkPoolSizeCap(cap), n_free_caps); - i = 0; -#ifdef SPARK_PUSHING - pushed_to_all = rtsFalse; -#endif - - // We want to share threads equally amongst free_caps[] and the - // current capability, but sometimes we encounter immovable - // threads. This counter tracks the number of threads we have kept - // for the current capability minus the number of passes over - // free_caps[]. If it is great than zero (due to immovable - // threads), we should try to bring it back to zero again by not - // keeping any threads for the current capability. - uint32_t imbalance = 0; - - // n_free_caps may be larger than the number of spare threads we have, - // if there were sparks in the spark pool. To avoid giving away all our - // threads in this case, we limit the number of caps that we give - // threads to, to the number of spare threads (n_run_queue-1). - uint32_t thread_recipients = stg_min(spare_threads, n_free_caps); - - if (thread_recipients > 0) { - prev = END_TSO_QUEUE; - t = cap->run_queue_hd; - for (; t != END_TSO_QUEUE; t = next) { - next = t->_link; - t->_link = END_TSO_QUEUE; - if (t->bound == task->incall // don't move my bound thread - || tsoLocked(t)) { // don't move a locked thread - if (prev == END_TSO_QUEUE) { - cap->run_queue_hd = t; - } else { - setTSOLink(cap, prev, t); - } - setTSOPrev(cap, t, prev); - prev = t; - imbalance++; - } else if (i == thread_recipients) { -#ifdef SPARK_PUSHING - pushed_to_all = rtsTrue; -#endif - // If we have not already kept any threads for this - // capability during the current pass over free_caps[], - // keep one now. - if (imbalance == 0) { - if (prev == END_TSO_QUEUE) { - cap->run_queue_hd = t; - } else { - setTSOLink(cap, prev, t); - } - setTSOPrev(cap, t, prev); - prev = t; - } else { - imbalance--; - } - i = 0; + // There are n_free_caps+1 caps in total. We will share the threads + // evently between them, *except* that if the run queue does not divide + // evenly by n_free_caps+1 then we bias towards the current capability. + // e.g. with n_run_queue=4, n_free_caps=2, we will keep 2. + uint32_t keep_threads = + (cap->n_run_queue + n_free_caps) / (n_free_caps + 1); + + // This also ensures that we don't give away all our threads, since + // (x + y) / (y + 1) >= 1 when x >= 1. + + // The number of threads we have left. + uint32_t n = cap->n_run_queue; + + // prev = the previous thread on this cap's run queue + prev = END_TSO_QUEUE; + + // We're going to walk through the run queue, migrating threads to other + // capabilities until we have only keep_threads left. We might + // encounter a thread that cannot be migrated, in which case we add it + // to the current run queue and decrement keep_threads. + for (t = cap->run_queue_hd, i = 0; + t != END_TSO_QUEUE && n > keep_threads; + t = next) + { + next = t->_link; + t->_link = END_TSO_QUEUE; + + // Should we keep this thread? + if (t->bound == task->incall // don't move my bound thread + || tsoLocked(t) // don't move a locked thread + ) { + if (prev == END_TSO_QUEUE) { + cap->run_queue_hd = t; } else { - appendToRunQueue(free_caps[i],t); - cap->n_run_queue--; - - traceEventMigrateThread (cap, t, free_caps[i]->no); - - if (t->bound) { t->bound->task->cap = free_caps[i]; } - t->cap = free_caps[i]; - i++; + setTSOLink(cap, prev, t); } + setTSOPrev(cap, t, prev); + prev = t; + if (keep_threads > 0) keep_threads--; } - cap->run_queue_tl = prev; - IF_DEBUG(sanity, checkRunQueue(cap)); - } + // Or migrate it? + else { + appendToRunQueue(free_caps[i],t); + traceEventMigrateThread (cap, t, free_caps[i]->no); -#ifdef SPARK_PUSHING - /* JB I left this code in place, it would work but is not necessary */ - - // If there are some free capabilities that we didn't push any - // threads to, then try to push a spark to each one. - if (!pushed_to_all) { - StgClosure *spark; - // i is the next free capability to push to - for (; i < n_free_caps; i++) { - if (emptySparkPoolCap(free_caps[i])) { - spark = tryStealSpark(cap->sparks); - if (spark != NULL) { - /* TODO: if anyone wants to re-enable this code then - * they must consider the fizzledSpark(spark) case - * and update the per-cap spark statistics. - */ - debugTrace(DEBUG_sched, "pushing spark %p to capability %d", spark, free_caps[i]->no); - - traceEventStealSpark(free_caps[i], t, cap->no); - - newSpark(&(free_caps[i]->r), spark); - } - } + if (t->bound) { t->bound->task->cap = free_caps[i]; } + t->cap = free_caps[i]; + n--; // we have one fewer threads now + i++; // move on to the next free_cap + if (i == n_free_caps) i = 0; } } -#endif /* SPARK_PUSHING */ + + // Join up the beginning of the queue (prev) + // with the rest of the queue (t) + if (t == END_TSO_QUEUE) { + cap->run_queue_tl = prev; + } else { + setTSOPrev(cap, t, prev); + } + if (prev == END_TSO_QUEUE) { + cap->run_queue_hd = t; + } else { + setTSOLink(cap, prev, t); + } + cap->n_run_queue = n; + + IF_DEBUG(sanity, checkRunQueue(cap)); // release the capabilities for (i = 0; i < n_free_caps; i++) { From git at git.haskell.org Fri Aug 5 10:40:16 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 5 Aug 2016 10:40:16 +0000 (UTC) Subject: [commit: ghc] master: Bump `hoopl` submodule, mostly cosmetics (8fe1672) Message-ID: <20160805104016.F05963A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8fe1672a9c4229b884b8dcebb9be57efa4c1fdb8/ghc >--------------------------------------------------------------- commit 8fe1672a9c4229b884b8dcebb9be57efa4c1fdb8 Author: Gabor Greif Date: Fri Aug 5 12:39:21 2016 +0200 Bump `hoopl` submodule, mostly cosmetics >--------------------------------------------------------------- 8fe1672a9c4229b884b8dcebb9be57efa4c1fdb8 libraries/hoopl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/hoopl b/libraries/hoopl index b4477e8..4478ec0 160000 --- a/libraries/hoopl +++ b/libraries/hoopl @@ -1 +1 @@ -Subproject commit b4477e825a93373124ec5cf29b9850df9608f5bd +Subproject commit 4478ec0b6d38bcd26c66ad09eb512e6952ab7e19 From git at git.haskell.org Fri Aug 5 15:29:30 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 5 Aug 2016 15:29:30 +0000 (UTC) Subject: [commit: ghc] master: Temporarily mark T1969 perf test as broken (#12437) (253fc38) Message-ID: <20160805152930.5A1993A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/253fc3888dc170feb8adcd05067020a2ee1ea53e/ghc >--------------------------------------------------------------- commit 253fc3888dc170feb8adcd05067020a2ee1ea53e Author: Ömer Sinan Ağacan Date: Fri Aug 5 15:28:26 2016 +0000 Temporarily mark T1969 perf test as broken (#12437) >--------------------------------------------------------------- 253fc3888dc170feb8adcd05067020a2ee1ea53e testsuite/tests/perf/compiler/all.T | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T index 4efc409..e9e2493 100644 --- a/testsuite/tests/perf/compiler/all.T +++ b/testsuite/tests/perf/compiler/all.T @@ -28,7 +28,8 @@ setTestOpts(no_lint) # really changed, then you know there's an issue. test('T1969', - [compiler_stats_num_field('peak_megabytes_allocated', # Note [residency] + [expect_broken(12437), + compiler_stats_num_field('peak_megabytes_allocated', # Note [residency] [(wordsize(32), 30, 15), # 2010-05-17 14 (x86/Windows) # 15 (x86/OS X) From git at git.haskell.org Fri Aug 5 16:20:35 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 5 Aug 2016 16:20:35 +0000 (UTC) Subject: [commit: ghc] branch 'wip/ggreif-new-cabal' created Message-ID: <20160805162035.54B633A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/ggreif-new-cabal Referencing: 8640b7e8042b006845f9871f12df0dc42a502526 From git at git.haskell.org Fri Aug 5 16:20:38 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 5 Aug 2016 16:20:38 +0000 (UTC) Subject: [commit: ghc] wip/ggreif-new-cabal: Some raw fixed to compile with TOT Cabal (8640b7e) Message-ID: <20160805162038.26B223A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ggreif-new-cabal Link : http://ghc.haskell.org/trac/ghc/changeset/8640b7e8042b006845f9871f12df0dc42a502526/ghc >--------------------------------------------------------------- commit 8640b7e8042b006845f9871f12df0dc42a502526 Author: Gabor Greif Date: Fri Aug 5 18:16:20 2016 +0200 Some raw fixed to compile with TOT Cabal >--------------------------------------------------------------- 8640b7e8042b006845f9871f12df0dc42a502526 libraries/Cabal | 2 +- utils/ghc-cabal/Main.hs | 6 +++--- utils/ghc-pkg/Main.hs | 12 ++++++------ utils/ghctags/Main.hs | 2 +- 4 files changed, 11 insertions(+), 11 deletions(-) diff --git a/libraries/Cabal b/libraries/Cabal index 40d6f0a..27b4aa8 160000 --- a/libraries/Cabal +++ b/libraries/Cabal @@ -1 +1 @@ -Subproject commit 40d6f0afd5b86d698abb876d4f5ed0bb452b0c4b +Subproject commit 27b4aa80e4aa8235cd011467485badc64469fc7a diff --git a/utils/ghc-cabal/Main.hs b/utils/ghc-cabal/Main.hs index 8cc1d1a..2595693 100644 --- a/utils/ghc-cabal/Main.hs +++ b/utils/ghc-cabal/Main.hs @@ -150,12 +150,12 @@ doCopy directory distDir noGhcPrimHook f pd lbi us flags = let pd' | packageName pd == PackageName "ghc-prim" = - case libraries pd of + case allLibraries pd of [lib] -> let ghcPrim = fromJust (simpleParse "GHC.Prim") ems = filter (ghcPrim /=) (exposedModules lib) lib' = lib { exposedModules = ems } - in pd { libraries = [lib'] } + in pd { subLibraries = [lib'], library = Nothing } [] -> error "Expected a library, but none found" _ -> @@ -326,7 +326,7 @@ generate directory distdir dll0Modules config_args comp = compiler lbi libBiModules lib = (libBuildInfo lib, libModules lib) exeBiModules exe = (buildInfo exe, ModuleName.main : exeModules exe) - biModuless = (map libBiModules $ libraries pd) + biModuless = (map libBiModules $ allLibraries pd) ++ (map exeBiModules $ executables pd) buildableBiModuless = filter isBuildable biModuless where isBuildable (bi', _) = buildable bi' diff --git a/utils/ghc-pkg/Main.hs b/utils/ghc-pkg/Main.hs index e0625fe..332891b 100644 --- a/utils/ghc-pkg/Main.hs +++ b/utils/ghc-pkg/Main.hs @@ -1079,7 +1079,7 @@ type PackageCacheFormat = GhcPkg.InstalledPackageInfo PackageName UnitId ModuleName - OriginalModule + Module convertPackageInfoToCacheFormat :: InstalledPackageInfo -> PackageCacheFormat convertPackageInfoToCacheFormat pkg = @@ -1132,9 +1132,9 @@ instance GhcPkg.BinaryStringRep String where fromStringRep = fromUTF8 . BS.unpack toStringRep = BS.pack . toUTF8 -instance GhcPkg.DbModuleRep UnitId ModuleName OriginalModule where - fromDbModule (GhcPkg.DbModule uid mod_name) = OriginalModule uid mod_name - toDbModule (OriginalModule uid mod_name) = GhcPkg.DbModule uid mod_name +instance GhcPkg.DbModuleRep UnitId ModuleName Module where + fromDbModule (GhcPkg.DbModule uid mod_name) = Module uid mod_name + toDbModule (Module uid mod_name) = GhcPkg.DbModule uid mod_name -- ----------------------------------------------------------------------------- -- Exposing, Hiding, Trusting, Distrusting, Unregistering are all similar @@ -1782,10 +1782,10 @@ checkDuplicateModules pkg checkOriginalModule :: String -> PackageDBStack -> InstalledPackageInfo - -> OriginalModule + -> Module -> Validate () checkOriginalModule field_name db_stack pkg - (OriginalModule definingPkgId definingModule) = + (Module definingPkgId definingModule) = let mpkg = if definingPkgId == installedUnitId pkg then Just pkg else PackageIndex.lookupUnitId ipix definingPkgId diff --git a/utils/ghctags/Main.hs b/utils/ghctags/Main.hs index 9a2ab2c..1612f42 100644 --- a/utils/ghctags/Main.hs +++ b/utils/ghctags/Main.hs @@ -179,7 +179,7 @@ flagsFromCabal :: FilePath -> IO [String] flagsFromCabal distPref = do lbi <- getPersistBuildConfig distPref let pd = localPkgDescr lbi - case maybeGetDefaultLibraryLocalBuildInfo lbi of + case undefined lbi of Just clbi -> let CLib lib = getComponent pd (componentLocalName clbi) bi = libBuildInfo lib From git at git.haskell.org Fri Aug 5 18:53:36 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 5 Aug 2016 18:53:36 +0000 (UTC) Subject: [commit: ghc] master: StgCmm: Remove unused Bool field of Return sequel (7354f93) Message-ID: <20160805185336.1C4C73A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7354f93c8158b699c7fc1e7592e5826c1b9a22d9/ghc >--------------------------------------------------------------- commit 7354f93c8158b699c7fc1e7592e5826c1b9a22d9 Author: Ömer Sinan Ağacan Date: Fri Aug 5 18:52:46 2016 +0000 StgCmm: Remove unused Bool field of Return sequel >--------------------------------------------------------------- 7354f93c8158b699c7fc1e7592e5826c1b9a22d9 compiler/codeGen/StgCmmExpr.hs | 2 +- compiler/codeGen/StgCmmLayout.hs | 4 ++-- compiler/codeGen/StgCmmMonad.hs | 7 +++---- 3 files changed, 6 insertions(+), 7 deletions(-) diff --git a/compiler/codeGen/StgCmmExpr.hs b/compiler/codeGen/StgCmmExpr.hs index 1965754..005e332 100644 --- a/compiler/codeGen/StgCmmExpr.hs +++ b/compiler/codeGen/StgCmmExpr.hs @@ -854,7 +854,7 @@ emitEnter fun = do -- -- Right now, we do what the old codegen did, and omit the tag -- test, just generating an enter. - Return _ -> do + Return -> do { let entry = entryCode dflags $ closureInfoPtr dflags $ CmmReg nodeReg ; emit $ mkJump dflags NativeNodeCall entry [CmmExprArg (cmmUntag dflags fun)] updfr_off diff --git a/compiler/codeGen/StgCmmLayout.hs b/compiler/codeGen/StgCmmLayout.hs index 713d542..39f3cd7 100644 --- a/compiler/codeGen/StgCmmLayout.hs +++ b/compiler/codeGen/StgCmmLayout.hs @@ -74,7 +74,7 @@ emitReturn results ; sequel <- getSequel ; updfr_off <- getUpdFrameOff ; case sequel of - Return _ -> + Return -> do { adjustHpBackwards ; let e = CmmLoad (CmmStackSlot Old updfr_off) (gcWord dflags) ; emit (mkReturn dflags (entryCode dflags e) results updfr_off) @@ -109,7 +109,7 @@ emitCallWithExtraStack (callConv, retConv) fun args extra_stack ; sequel <- getSequel ; updfr_off <- getUpdFrameOff ; case sequel of - Return _ -> do + Return -> do emit $ mkJumpExtra dflags callConv fun args updfr_off extra_stack return AssignedDirectly AssignTo res_regs _ -> do diff --git a/compiler/codeGen/StgCmmMonad.hs b/compiler/codeGen/StgCmmMonad.hs index 8f66cfa..471a94d 100644 --- a/compiler/codeGen/StgCmmMonad.hs +++ b/compiler/codeGen/StgCmmMonad.hs @@ -219,8 +219,7 @@ instance Outputable CgIdInfo where -- Sequel tells what to do with the result of this expression data Sequel - = Return Bool -- Return result(s) to continuation found on the stack. - -- True <=> the continuation is update code (???) + = Return -- Return result(s) to continuation found on the stack. | AssignTo [LocalReg] -- Put result(s) in these regs and fall through @@ -233,7 +232,7 @@ data Sequel -- allocating primOp) instance Outputable Sequel where - ppr (Return b) = text "Return" <+> ppr b + ppr Return = text "Return" ppr (AssignTo regs b) = text "AssignTo" <+> ppr regs <+> ppr b -- See Note [sharing continuations] below @@ -320,7 +319,7 @@ initCgInfoDown dflags mod , cgd_tick_scope= GlobalScope } initSequel :: Sequel -initSequel = Return False +initSequel = Return initUpdFrameOff :: DynFlags -> UpdFrameOffset initUpdFrameOff dflags = widthInBytes (wordWidth dflags) -- space for the RA From git at git.haskell.org Fri Aug 5 22:41:42 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 5 Aug 2016 22:41:42 +0000 (UTC) Subject: [commit: ghc] master: Replace some `length . filter` with `count` (02614fd) Message-ID: <20160805224142.3F6ED3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/02614fd61f57b599c5e4fd5e85f00a4e1ce37bc7/ghc >--------------------------------------------------------------- commit 02614fd61f57b599c5e4fd5e85f00a4e1ce37bc7 Author: Ömer Sinan Ağacan Date: Fri Aug 5 20:58:02 2016 +0000 Replace some `length . filter` with `count` >--------------------------------------------------------------- 02614fd61f57b599c5e4fd5e85f00a4e1ce37bc7 compiler/coreSyn/CoreSubst.hs | 2 +- compiler/simplCore/SAT.hs | 2 +- compiler/typecheck/TcExpr.hs | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/compiler/coreSyn/CoreSubst.hs b/compiler/coreSyn/CoreSubst.hs index 7723b71..ffd8c2a 100644 --- a/compiler/coreSyn/CoreSubst.hs +++ b/compiler/coreSyn/CoreSubst.hs @@ -1434,7 +1434,7 @@ exprIsLambda_maybe (in_scope_set, id_unf) (Cast casted_e co) -- Another attempt: See if we find a partial unfolding exprIsLambda_maybe (in_scope_set, id_unf) e | (Var f, as, ts) <- collectArgsTicks tickishFloatable e - , idArity f > length (filter isValArg as) + , idArity f > count isValArg as -- Make sure there is hope to get a lambda , Just rhs <- expandUnfolding_maybe (id_unf f) -- Optimize, for beta-reduction diff --git a/compiler/simplCore/SAT.hs b/compiler/simplCore/SAT.hs index 38ae144..923d3a4 100644 --- a/compiler/simplCore/SAT.hs +++ b/compiler/simplCore/SAT.hs @@ -373,7 +373,7 @@ saTransformMaybe binder maybe_arg_staticness rhs_binders rhs_body where should_transform staticness = n_static_args > 1 -- THIS IS THE DECISION POINT where - n_static_args = length (filter isStaticValue staticness) + n_static_args = count isStaticValue staticness saTransform :: Id -> SATInfo -> [Id] -> CoreExpr -> SatM CoreBind saTransform binder arg_staticness rhs_binders rhs_body diff --git a/compiler/typecheck/TcExpr.hs b/compiler/typecheck/TcExpr.hs index 54d0254..dc1a90f 100644 --- a/compiler/typecheck/TcExpr.hs +++ b/compiler/typecheck/TcExpr.hs @@ -2455,7 +2455,7 @@ badFieldsUpd rbinds data_cons sortBy (compare `on` fst) . map (\ item@(_, membershipRow) -> (countTrue membershipRow, item)) - countTrue = length . filter id + countTrue = count id {- Note [Finding the conflicting fields] From git at git.haskell.org Sat Aug 6 01:39:54 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 6 Aug 2016 01:39:54 +0000 (UTC) Subject: [commit: ghc] master: Util.count: Implement as a left-fold instead of a right-fold (9aa5d87) Message-ID: <20160806013954.52AD53A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9aa5d87a28fbc328660829ec2e4841ea1a7a1440/ghc >--------------------------------------------------------------- commit 9aa5d87a28fbc328660829ec2e4841ea1a7a1440 Author: Joachim Breitner Date: Fri Aug 5 21:39:07 2016 -0400 Util.count: Implement as a left-fold instead of a right-fold >--------------------------------------------------------------- 9aa5d87a28fbc328660829ec2e4841ea1a7a1440 compiler/utils/Util.hs | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/compiler/utils/Util.hs b/compiler/utils/Util.hs index d20a604..121fdbb 100644 --- a/compiler/utils/Util.hs +++ b/compiler/utils/Util.hs @@ -1,6 +1,6 @@ -- (c) The University of Glasgow 2006 -{-# LANGUAGE CPP #-} +{-# LANGUAGE CPP, BangPatterns #-} -- | Highly random utility functions -- @@ -619,9 +619,10 @@ all2 _ _ _ = False -- Count the number of times a predicate is true count :: (a -> Bool) -> [a] -> Int -count _ [] = 0 -count p (x:xs) | p x = 1 + count p xs - | otherwise = count p xs +count p = go 0 + where go !n [] = n + go !n (x:xs) | p x = go (n+1) xs + | otherwise = go n xs {- @splitAt@, @take@, and @drop@ but with length of another From git at git.haskell.org Sat Aug 6 11:07:02 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 6 Aug 2016 11:07:02 +0000 (UTC) Subject: [commit: ghc] master: rts/Printer.h: fix constness of argument declaration (affcec7) Message-ID: <20160806110702.13CB63A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/affcec7d5b0426be332022d546486bef31248b72/ghc >--------------------------------------------------------------- commit affcec7d5b0426be332022d546486bef31248b72 Author: Sergei Trofimovich Date: Sat Aug 6 11:55:14 2016 +0100 rts/Printer.h: fix constness of argument declaration Noticed on today's build failure: rts/Printer.c:659:13: error: error: conflicting types for 'DEBUG_LoadSymbols' extern void DEBUG_LoadSymbols( const char *name ) ^~~~~~~~~~~~~~~~~ In file included from rts/Printer.c:17:0: error: rts/Printer.h:29:13: error: note: previous declaration of 'DEBUG_LoadSymbols' was here extern void DEBUG_LoadSymbols( char *name ); ^~~~~~~~~~~~~~~~~ Signed-off-by: Sergei Trofimovich >--------------------------------------------------------------- affcec7d5b0426be332022d546486bef31248b72 rts/Printer.c | 2 +- rts/Printer.h | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/rts/Printer.c b/rts/Printer.c index 6789225..95dd854 100644 --- a/rts/Printer.c +++ b/rts/Printer.c @@ -714,7 +714,7 @@ extern void DEBUG_LoadSymbols( const char *name ) #else /* USING_LIBBFD */ -extern void DEBUG_LoadSymbols( char *name STG_UNUSED ) +extern void DEBUG_LoadSymbols( const char *name STG_UNUSED ) { /* nothing, yet */ } diff --git a/rts/Printer.h b/rts/Printer.h index 4db7605..e72fdb0 100644 --- a/rts/Printer.h +++ b/rts/Printer.h @@ -26,7 +26,7 @@ extern void printClosure ( const StgClosure *obj ); extern void printStackChunk ( StgPtr sp, StgPtr spLim ); extern void printTSO ( StgTSO *tso ); -extern void DEBUG_LoadSymbols( char *name ); +extern void DEBUG_LoadSymbols( const char *name ); extern const char *lookupGHCName( void *addr ); From git at git.haskell.org Sat Aug 6 13:44:34 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 6 Aug 2016 13:44:34 +0000 (UTC) Subject: [commit: ghc] master: AsmCodeGen: Give linear-scan and coloring reg. allocators different cc names (03af399) Message-ID: <20160806134434.E803D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/03af3990e65093ff8230ceab67f0c9bcf3ce8684/ghc >--------------------------------------------------------------- commit 03af3990e65093ff8230ceab67f0c9bcf3ce8684 Author: Ömer Sinan Ağacan Date: Sat Aug 6 12:55:54 2016 +0000 AsmCodeGen: Give linear-scan and coloring reg. allocators different cc names >--------------------------------------------------------------- 03af3990e65093ff8230ceab67f0c9bcf3ce8684 compiler/nativeGen/AsmCodeGen.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/compiler/nativeGen/AsmCodeGen.hs b/compiler/nativeGen/AsmCodeGen.hs index 46c6fa47..24a9db9 100644 --- a/compiler/nativeGen/AsmCodeGen.hs +++ b/compiler/nativeGen/AsmCodeGen.hs @@ -549,7 +549,7 @@ cmmNativeGen dflags this_mod modLoc ncgImpl us fileIds dbgMap cmm count -- do the graph coloring register allocation let ((alloced, regAllocStats), usAlloc) - = {-# SCC "RegAlloc" #-} + = {-# SCC "RegAlloc-color" #-} initUs usLive $ Color.regAlloc dflags @@ -593,7 +593,7 @@ cmmNativeGen dflags this_mod modLoc ncgImpl us fileIds dbgMap cmm count return (alloced', ra_stats ) let ((alloced, regAllocStats), usAlloc) - = {-# SCC "RegAlloc" #-} + = {-# SCC "RegAlloc-linear" #-} initUs usLive $ liftM unzip $ mapM reg_alloc withLiveness From git at git.haskell.org Sat Aug 6 13:44:37 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 6 Aug 2016 13:44:37 +0000 (UTC) Subject: [commit: ghc] master: RegAlloc: Use IntSet/IntMaps instead of generic Set/Maps (bd51064) Message-ID: <20160806134437.97A683A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/bd5106441bb91bbadadd2ffd4e9b77bd8f50772c/ghc >--------------------------------------------------------------- commit bd5106441bb91bbadadd2ffd4e9b77bd8f50772c Author: Ömer Sinan Ağacan Date: Sat Aug 6 13:10:03 2016 +0000 RegAlloc: Use IntSet/IntMaps instead of generic Set/Maps >--------------------------------------------------------------- bd5106441bb91bbadadd2ffd4e9b77bd8f50772c compiler/cmm/BlockId.hs | 8 +++++++- compiler/nativeGen/RegAlloc/Graph/Spill.hs | 20 +++++++++----------- compiler/nativeGen/RegAlloc/Graph/SpillClean.hs | 18 ++++++++---------- compiler/nativeGen/RegAlloc/Liveness.hs | 12 +++++------- 4 files changed, 29 insertions(+), 29 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc bd5106441bb91bbadadd2ffd4e9b77bd8f50772c From git at git.haskell.org Sat Aug 6 13:44:40 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 6 Aug 2016 13:44:40 +0000 (UTC) Subject: [commit: ghc] master: RegAlloc: Remove duplicate seqList (use seqList from Util) (3bfe6a5) Message-ID: <20160806134440.42B423A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3bfe6a52783d00d0f7231a2d58c6279c8a580812/ghc >--------------------------------------------------------------- commit 3bfe6a52783d00d0f7231a2d58c6279c8a580812 Author: Ömer Sinan Ağacan Date: Sat Aug 6 12:56:50 2016 +0000 RegAlloc: Remove duplicate seqList (use seqList from Util) >--------------------------------------------------------------- 3bfe6a52783d00d0f7231a2d58c6279c8a580812 compiler/nativeGen/RegAlloc/Graph/Main.hs | 21 +++++++-------------- 1 file changed, 7 insertions(+), 14 deletions(-) diff --git a/compiler/nativeGen/RegAlloc/Graph/Main.hs b/compiler/nativeGen/RegAlloc/Graph/Main.hs index 0b10f3c..97c2b42 100644 --- a/compiler/nativeGen/RegAlloc/Graph/Main.hs +++ b/compiler/nativeGen/RegAlloc/Graph/Main.hs @@ -16,13 +16,14 @@ import TargetReg import RegClass import Reg -import UniqSupply -import UniqSet -import UniqFM import Bag +import DynFlags import Outputable import Platform -import DynFlags +import UniqFM +import UniqSet +import UniqSupply +import Util (seqList) import Data.List import Data.Maybe @@ -221,7 +222,7 @@ regAlloc_spin dflags spinCount triv regsFree slotsFree debug_codeGraphs code else [] -- Ensure all the statistics are evaluated, to avoid space leaks. - seqList statList `seq` return () + seqList statList (return ()) return ( code_final , statList @@ -268,7 +269,7 @@ regAlloc_spin dflags spinCount triv regsFree slotsFree debug_codeGraphs code else [] -- Ensure all the statistics are evaluated, to avoid space leaks. - seqList statList `seq` return () + seqList statList (return ()) regAlloc_spin dflags (spinCount + 1) triv regsFree slotsFree' statList @@ -447,11 +448,3 @@ seqRealRegList rs = case rs of [] -> () (r : rs) -> seqRealReg r `seq` seqRealRegList rs - -seqList :: [a] -> () -seqList ls - = case ls of - [] -> () - (r : rs) -> r `seq` seqList rs - - From git at git.haskell.org Sat Aug 6 15:11:03 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 6 Aug 2016 15:11:03 +0000 (UTC) Subject: [commit: ghc] master: Use Data.Functor.Const to implement Data.Data internals (7a2e933) Message-ID: <20160806151103.534223A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7a2e933b77a67d64e80559674852c5a308cde976/ghc >--------------------------------------------------------------- commit 7a2e933b77a67d64e80559674852c5a308cde976 Author: Ryan Scott Date: Sat Aug 6 11:08:31 2016 -0400 Use Data.Functor.Const to implement Data.Data internals Summary: `Data.Data` uses an internal datatype `CONST`, which can be replaced completely by `Const` from `Data.Functor.Const`. Reviewers: austin, bgamari, hvr Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2396 >--------------------------------------------------------------- 7a2e933b77a67d64e80559674852c5a308cde976 libraries/base/Data/Data.hs | 15 ++++++--------- 1 file changed, 6 insertions(+), 9 deletions(-) diff --git a/libraries/base/Data/Data.hs b/libraries/base/Data/Data.hs index 0e40b17..df37ab1 100644 --- a/libraries/base/Data/Data.hs +++ b/libraries/base/Data/Data.hs @@ -114,6 +114,7 @@ module Data.Data ( ------------------------------------------------------------------------------ +import Data.Functor.Const import Data.Either import Data.Eq import Data.Maybe @@ -323,12 +324,12 @@ class Typeable a => Data a where -- | A generic query with a left-associative binary operator gmapQl :: forall r r'. (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r - gmapQl o r f = unCONST . gfoldl k z + gmapQl o r f = getConst . gfoldl k z where - k :: Data d => CONST r (d->b) -> d -> CONST r b - k c x = CONST $ (unCONST c) `o` f x - z :: g -> CONST r g - z _ = CONST r + k :: Data d => Const r (d->b) -> d -> Const r b + k c x = Const $ (getConst c) `o` f x + z :: g -> Const r g + z _ = Const r -- | A generic query with a right-associative binary operator gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r @@ -424,10 +425,6 @@ was transformed successfully. ) --- | The constant type constructor needed for the definition of gmapQl -newtype CONST c a = CONST { unCONST :: c } - - -- | Type constructor for adding counters to queries data Qi q a = Qi Int (Maybe q) From git at git.haskell.org Sat Aug 6 22:26:11 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 6 Aug 2016 22:26:11 +0000 (UTC) Subject: [commit: ghc] master: configure.ac: Remove checks for bug 9439 (6fe2355) Message-ID: <20160806222611.72C743A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6fe235543de7ea4319269f164ea444e4af68f759/ghc >--------------------------------------------------------------- commit 6fe235543de7ea4319269f164ea444e4af68f759 Author: Erik de Castro Lopo Date: Sun Aug 7 08:24:16 2016 +1000 configure.ac: Remove checks for bug 9439 Bug #9439 only affects some ghc 7.8 versions of the compiler and since git HEAD no longer builds with ghc-7.8 we can drop this check. Test Plan: Works here! Reviewers: hvr, austin, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2427 >--------------------------------------------------------------- 6fe235543de7ea4319269f164ea444e4af68f759 Makefile | 7 ------- configure.ac | 67 ------------------------------------------------------------ 2 files changed, 74 deletions(-) diff --git a/Makefile b/Makefile index 82ab2f7..9b888e7 100644 --- a/Makefile +++ b/Makefile @@ -77,13 +77,6 @@ default : all help: @cat MAKEHELP.md -# Verify that stage 0 LLVM backend isn't affected by Bug #9439 if needed -ifeq "$(GHC_LLVM_AFFECTED_BY_9439)" "1" -ifneq "$(findstring -fllvm,$(SRC_HC_OPTS) $(GhcHcOpts) $(GhcStage1HcOpts))" "" -$(error Stage 0 compiler is affected by Bug #9439. Refusing to bootstrap with -fllvm) -endif -endif - # No need to update makefiles for these targets: # (the ones we're filtering out) REALGOALS=$(filter-out \ diff --git a/configure.ac b/configure.ac index f4b839e..e9569e9 100644 --- a/configure.ac +++ b/configure.ac @@ -544,73 +544,6 @@ dnl -------------------------------------------------------------- dnl -------------------------------------------------------------- -dnl * General configuration checks -dnl -------------------------------------------------------------- - -dnl ** Bug 9439: Some GHC 7.8 releases had broken LLVM code generator. -dnl Unfortunately we don't know whether the user is going to request a -dnl build with the LLVM backend as this is only given in build.mk. -dnl -dnl Instead, we try to do as much work as possible here, checking -dnl whether -fllvm is the stage 0 compiler's default. If so we -dnl fail. If not, we check whether -fllvm is affected explicitly and -dnl if so set a flag. The build system will later check this flag -dnl after the desired build flags are known. - -dnl This problem is further complicated by the fact that the llvm -dnl version used by the bootstrap compiler may be different from the -dnl version we arre trying to compile GHC against. Therefore, we need -dnl to find the boostrap compiler's `settings` file then check to see -dnl if the `opt` and `llc` command strings are non-empty and if these -dnl programs exist. Only if they exist to we test for bug #9439. - -FIND_GHC_BOOTSTRAP_PROG([BootstrapLlcCmd], [${WithGhc}], "LLVM llc command") -FIND_GHC_BOOTSTRAP_PROG([BootstrapOptCmd], [${WithGhc}], "LLVM opt command") - -if test -n "$BootstrapLlcCmd" && test -n "$BootstrapOptCmd" -then - AC_MSG_CHECKING(whether bootstrap compiler is affected by bug 9439) - echo "main = putStrLn \"%function\"" > conftestghc.hs - - # Check whether LLVM backend is default for this platform - "${WithGhc}" -pgmlc="${BootstrapLlcCmd}" -pgmlo="${BootstrapOptCmd}" conftestghc.hs 2>&1 >/dev/null - res=`./conftestghc` - if test "x$res" = "x%object" - then - AC_MSG_RESULT(yes) - echo "Buggy bootstrap compiler" - echo "" - echo "The stage 0 compiler $WithGhc is affected by GHC Bug \#9439" - echo "and therefore will miscompile the LLVM backend if -fllvm is" - echo "used." - echo - echo "Please use another bootstrap compiler" - exit 1 - fi - - # -fllvm is not the default, but set a flag so the Makefile can check - # -for it in the build flags later on - "${WithGhc}" -fforce-recomp -pgmlc="${BootstrapLlcCmd}" -pgmlo="${BootstrapOptCmd}" -fllvm conftestghc.hs 2>&1 >/dev/null - if test $? = 0 - then - res=`./conftestghc` - if test "x$res" = "x%object" - then - AC_MSG_RESULT(yes) - GHC_LLVM_AFFECTED_BY_9439=1 - elif test "x$res" = "x%function" - then - AC_MSG_RESULT(no) - GHC_LLVM_AFFECTED_BY_9439=0 - else - AC_MSG_WARN(unexpected output $res) - fi - else - AC_MSG_RESULT(failed to compile, assuming no) - fi -fi -AC_SUBST([GHC_LLVM_AFFECTED_BY_9439]) - dnl ** Can the unix package be built? dnl -------------------------------------------------------------- From git at git.haskell.org Sun Aug 7 11:59:04 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 7 Aug 2016 11:59:04 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: rts: mark 'ccs_mutex' and 'prof_arena' as static (bc939b8) Message-ID: <20160807115904.98FED3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/bc939b8a09a180eb9e46d349b02ab0cc76bd563b/ghc >--------------------------------------------------------------- commit bc939b8a09a180eb9e46d349b02ab0cc76bd563b Author: Sergei Trofimovich Date: Sun Feb 7 18:00:00 2016 +0000 rts: mark 'ccs_mutex' and 'prof_arena' as static Noticed by uselex.rb: ccs_mutex: [R]: exported from: ./rts/dist/build/Profiling.thr_p_o prof_arena: [R]: exported from: ./rts/dist/build/Profiling.p_o Signed-off-by: Sergei Trofimovich (cherry picked from commit e1ca583855fc26f1e1a3a4e7fd6c54d302b4625c) >--------------------------------------------------------------- bc939b8a09a180eb9e46d349b02ab0cc76bd563b rts/Profiling.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/rts/Profiling.c b/rts/Profiling.c index 4f2606c..5dca8c0 100644 --- a/rts/Profiling.c +++ b/rts/Profiling.c @@ -29,7 +29,7 @@ /* * Profiling allocation arena. */ -Arena *prof_arena; +static Arena *prof_arena; /* * Global variables used to assign unique IDs to cc's, ccs's, and @@ -59,7 +59,7 @@ CostCentre *CC_LIST = NULL; CostCentreStack *CCS_LIST = NULL; #ifdef THREADED_RTS -Mutex ccs_mutex; +static Mutex ccs_mutex; #endif /* From git at git.haskell.org Sun Aug 7 11:59:07 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 7 Aug 2016 11:59:07 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Show sources of cost centers in .prof (7fc7538) Message-ID: <20160807115907.5D87F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/7fc7538fffb9ad4ad2132a8a9ef8cb6543d0b2fc/ghc >--------------------------------------------------------------- commit 7fc7538fffb9ad4ad2132a8a9ef8cb6543d0b2fc Author: Ömer Sinan Ağacan Date: Wed Jun 8 09:30:32 2016 -0400 Show sources of cost centers in .prof This fixes the problem with duplicate cost-centre names that was reported a couple of times before. When a module implements a typeclass multiple times for different types, methods of different implementations get same cost-centre names and are reported like this: COST CENTRE MODULE %time %alloc CAF GHC.IO.Handle.FD 0.0 32.8 CAF GHC.Read 0.0 1.0 CAF GHC.IO.Encoding 0.0 1.8 showsPrec Main 0.0 1.2 readPrec Main 0.0 19.4 readPrec Main 0.0 20.5 main Main 0.0 20.2 individual inherited COST CENTRE MODULE no. entries %time %alloc %time %alloc MAIN MAIN 53 0 0.0 0.2 0.0 100.0 CAF Main 105 0 0.0 0.3 0.0 62.5 readPrec Main 109 1 0.0 0.6 0.0 0.6 readPrec Main 107 1 0.0 0.6 0.0 0.6 main Main 106 1 0.0 20.2 0.0 61.0 == Main 114 1 0.0 0.0 0.0 0.0 == Main 113 1 0.0 0.0 0.0 0.0 showsPrec Main 112 2 0.0 1.2 0.0 1.2 showsPrec Main 111 2 0.0 0.9 0.0 0.9 readPrec Main 110 0 0.0 18.8 0.0 18.8 readPrec Main 108 0 0.0 19.9 0.0 19.9 It's not possible to tell from the report which `==` took how long. This patch adds one more column at the cost of making outputs wider. The report now looks like this: COST CENTRE MODULE SRC %time %alloc CAF GHC.IO.Handle.FD 0.0 32.9 CAF GHC.IO.Encoding 0.0 1.8 CAF GHC.Read 0.0 1.0 showsPrec Main Main_1.hs:7:19-22 0.0 1.2 readPrec Main Main_1.hs:7:13-16 0.0 19.5 readPrec Main Main_1.hs:4:13-16 0.0 20.5 main Main Main_1.hs:(10,1)-(20,20) 0.0 20.2 individual inherited COST CENTRE MODULE SRC no. entries %time %alloc %time %alloc MAIN MAIN 53 0 0.0 0.2 0.0 100.0 CAF Main 105 0 0.0 0.3 0.0 62.5 readPrec Main Main_1.hs:7:13-16 109 1 0.0 0.6 0.0 0.6 readPrec Main Main_1.hs:4:13-16 107 1 0.0 0.6 0.0 0.6 main Main Main_1.hs:(10,1)-(20,20) 106 1 0.0 20.2 0.0 61.0 == Main Main_1.hs:7:25-26 114 1 0.0 0.0 0.0 0.0 == Main Main_1.hs:4:25-26 113 1 0.0 0.0 0.0 0.0 showsPrec Main Main_1.hs:7:19-22 112 2 0.0 1.2 0.0 1.2 showsPrec Main Main_1.hs:4:19-22 111 2 0.0 0.9 0.0 0.9 readPrec Main Main_1.hs:7:13-16 110 0 0.0 18.8 0.0 18.8 readPrec Main Main_1.hs:4:13-16 108 0 0.0 19.9 0.0 19.9 CAF Text.Read.Lex 102 0 0.0 0.5 0.0 0.5 To fix failing test cases because of different orderings of cost centres (e.g. optimized and non-optimized build printing in different order), with this patch we also start sorting cost centres before printing. The order depends on 1) entries (more entered cost centres come first) 2) names (using strcmp() on cost centre names). Reviewers: simonmar, austin, erikd, bgamari Reviewed By: simonmar, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2282 GHC Trac Issues: #11543, #8473, #7105 (cherry picked from commit d7933cbc28f4f094eba3d128bc147920f68c965b) >--------------------------------------------------------------- 7fc7538fffb9ad4ad2132a8a9ef8cb6543d0b2fc rts/Profiling.c | 133 ++++++++++++++++----- testsuite/driver/testlib.py | 47 +++++--- .../tests/profiling/should_run/T2552.prof.sample | 56 ++++----- .../tests/profiling/should_run/T5559.prof.sample | 33 +++-- .../profiling/should_run/T5654b-O0.prof.sample | 40 +++---- .../profiling/should_run/T5654b-O1.prof.sample | 40 +++---- .../tests/profiling/should_run/T680.prof.sample | 65 +++++----- testsuite/tests/profiling/should_run/all.T | 6 +- .../tests/profiling/should_run/ioprof.prof.sample | 74 ++++++------ .../profiling/should_run/prof-doc-fib.prof.sample | 41 +++---- .../profiling/should_run/prof-doc-last.prof.sample | 54 ++++----- .../profiling/should_run/profinline001.prof.sample | 39 +++--- .../tests/profiling/should_run/scc001.prof.sample | 48 ++++---- .../tests/profiling/should_run/scc002.prof.sample | 45 +++---- .../tests/profiling/should_run/scc003.prof.sample | 54 ++++----- .../tests/profiling/should_run/scc005.prof.sample | 35 +++--- 16 files changed, 456 insertions(+), 354 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 7fc7538fffb9ad4ad2132a8a9ef8cb6543d0b2fc From git at git.haskell.org Sun Aug 7 11:59:10 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 7 Aug 2016 11:59:10 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Failing test case for #12076. (df1cac9) Message-ID: <20160807115910.948343A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/df1cac90c03456dc3783267a220085b3cc2b860a/ghc >--------------------------------------------------------------- commit df1cac90c03456dc3783267a220085b3cc2b860a Author: Edward Z. Yang Date: Mon May 16 21:05:24 2016 -0700 Failing test case for #12076. Signed-off-by: Edward Z. Yang Test Plan: validate Reviewers: austin, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2229 GHC Trac Issues: #12076 (cherry picked from commit 5f1557eea2c1a5cf09321d9dc01070b6c068e2fa) >--------------------------------------------------------------- df1cac90c03456dc3783267a220085b3cc2b860a testsuite/tests/simplCore/should_compile/T12076.hs | 2 ++ testsuite/tests/simplCore/should_compile/T12076a.hs | 15 +++++++++++++++ testsuite/tests/simplCore/should_compile/all.T | 1 + 3 files changed, 18 insertions(+) diff --git a/testsuite/tests/simplCore/should_compile/T12076.hs b/testsuite/tests/simplCore/should_compile/T12076.hs new file mode 100644 index 0000000..8b35039 --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T12076.hs @@ -0,0 +1,2 @@ +import T12076a +main = f `seq` return () diff --git a/testsuite/tests/simplCore/should_compile/T12076a.hs b/testsuite/tests/simplCore/should_compile/T12076a.hs new file mode 100644 index 0000000..2e5acc9 --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T12076a.hs @@ -0,0 +1,15 @@ +{-# OPTIONS_GHC -O0 #-} +module T12076a(f) where + +import GHC.Exts + +{-# NOINLINE z #-} +z = () + +f :: () -> () +f _ = let x = lazy z + in g x x + +{-# NOINLINE g #-} +g :: () -> () -> () +g _ _ = () diff --git a/testsuite/tests/simplCore/should_compile/all.T b/testsuite/tests/simplCore/should_compile/all.T index 36b94c7..ae41d58 100644 --- a/testsuite/tests/simplCore/should_compile/all.T +++ b/testsuite/tests/simplCore/should_compile/all.T @@ -233,3 +233,4 @@ test('T11562', normal, compile, ['-O2']) test('T11644', normal, compile, ['-O2']) test('T11742', normal, compile, ['-O2']) test('T12212', normal, compile, ['-O']) +test('T12076', [expect_broken(12076), extra_clean(['T12076a.hi', 'T12076a.o'])], multimod_compile, ['T12076', '-v0']) From git at git.haskell.org Sun Aug 7 11:59:13 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 7 Aug 2016 11:59:13 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: hp2ps: fix invalid PostScript for names with parentheses (11200a0) Message-ID: <20160807115913.5055D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/11200a08a14751c59ee70018c5078e85abebdb2f/ghc >--------------------------------------------------------------- commit 11200a08a14751c59ee70018c5078e85abebdb2f Author: Ben Gamari Date: Sun Jul 17 00:14:04 2016 +0200 hp2ps: fix invalid PostScript for names with parentheses The names in the .hp files may contain un-matched opening parentheses, so escape them. GHC Trac: #9517 Reviewers: bgamari, austin Reviewed By: bgamari, austin Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2398 GHC Trac Issues: #9517 (cherry picked from commit 5df92f6776b31b375a80865e7db1f330d929c18f) >--------------------------------------------------------------- 11200a08a14751c59ee70018c5078e85abebdb2f utils/hp2ps/Key.c | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/utils/hp2ps/Key.c b/utils/hp2ps/Key.c index 22ad106..b7742cf 100644 --- a/utils/hp2ps/Key.c +++ b/utils/hp2ps/Key.c @@ -44,7 +44,8 @@ escape(char *result, const char *name) { while (*name != '\0') { - if (*name == '\\') + // escape parentheses too, because "name" could contain un-matched ones + if (*name == '\\' || *name == '(' || *name == ')') { *result++ = '\\'; } From git at git.haskell.org Sun Aug 7 11:59:16 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 7 Aug 2016 11:59:16 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Check generic-default method for ambiguity (8540c65) Message-ID: <20160807115916.DD3A13A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/8540c65a61e92e9c4bedb934c241e8e3eaa67047/ghc >--------------------------------------------------------------- commit 8540c65a61e92e9c4bedb934c241e8e3eaa67047 Author: Simon Peyton Jones Date: Fri Jul 1 22:33:33 2016 +0100 Check generic-default method for ambiguity Fixes Trac #7497 and #12151. In some earlier upheaval I introduced a bug in the ambiguity check for genreric-default method. This patch fixes it. But in fixing it I realised that the sourc-location of any such error message was bogus, so I fixed that too, which involved a slightly wider change; see the comments with TcMethInfo. (cherry picked from commit 85aa6ef09346e841abf4e089b24c7f783286cd74) >--------------------------------------------------------------- 8540c65a61e92e9c4bedb934c241e8e3eaa67047 compiler/iface/BuildTyCl.hs | 47 +++++++++++++++++----- compiler/iface/TcIface.hs | 4 +- compiler/typecheck/TcClassDcl.hs | 8 ++-- compiler/typecheck/TcTyClsDecls.hs | 16 +++++--- compiler/typecheck/TcTyDecls.hs | 19 ++++----- compiler/types/Class.hs | 10 +---- compiler/vectorise/Vectorise/Type/TyConDecl.hs | 9 +++++ testsuite/tests/typecheck/should_fail/T12151.hs | 10 +++++ .../tests/typecheck/should_fail/T12151.stderr | 12 ++++++ testsuite/tests/typecheck/should_fail/T7437.hs | 15 +++++++ testsuite/tests/typecheck/should_fail/T7437.stderr | 12 ++++++ testsuite/tests/typecheck/should_fail/all.T | 2 + 12 files changed, 125 insertions(+), 39 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 8540c65a61e92e9c4bedb934c241e8e3eaa67047 From git at git.haskell.org Sun Aug 7 11:59:19 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 7 Aug 2016 11:59:19 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: UNPACK the size field of SizedSeq (864053f) Message-ID: <20160807115919.837863A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/864053f967b43c255fc26dd8568cdf4abcd12950/ghc >--------------------------------------------------------------- commit 864053f967b43c255fc26dd8568cdf4abcd12950 Author: Simon Marlow Date: Thu Jul 21 05:47:47 2016 -0700 UNPACK the size field of SizedSeq (cherry picked from commit 1fe5c8916a2bdf90ed2d9c70f900642b56650592) >--------------------------------------------------------------- 864053f967b43c255fc26dd8568cdf4abcd12950 libraries/ghci/SizedSeq.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/ghci/SizedSeq.hs b/libraries/ghci/SizedSeq.hs index 503544a..55433c2 100644 --- a/libraries/ghci/SizedSeq.hs +++ b/libraries/ghci/SizedSeq.hs @@ -13,7 +13,7 @@ import Data.Binary import Data.List import GHC.Generics -data SizedSeq a = SizedSeq !Word [a] +data SizedSeq a = SizedSeq {-# UNPACK #-} !Word [a] deriving (Generic, Show) instance Functor SizedSeq where From git at git.haskell.org Sun Aug 7 11:59:22 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 7 Aug 2016 11:59:22 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Squash space leaks in the result of byteCodeGen (7a21ffc) Message-ID: <20160807115922.2B0903A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/7a21ffc6ba8196cbc9bd0511b34b104c252b09b7/ghc >--------------------------------------------------------------- commit 7a21ffc6ba8196cbc9bd0511b34b104c252b09b7 Author: Simon Marlow Date: Thu Jul 21 04:51:05 2016 -0700 Squash space leaks in the result of byteCodeGen When loading a large number of modules into GHCi, we collect CompiledByteCode for every module and then link it all at the end. Space leaks in the CompiledByteCode linger until we traverse it all for linking, and possibly longer, if there are bits we don't look at. This is the nuke-it-from-orbit approach: we deepseq the whole thing after code generation. It's the only way to be sure. Test Plan: Heap profile of GHCi while loading nofib/real/anna into GHCi, this patch reduces the peak heap usage from ~100M to ~50M. Reviewers: hvr, austin, bgamari, erikd Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2419 (cherry picked from commit 648fd73a7b8fbb7955edc83330e2910428e76147) >--------------------------------------------------------------- 7a21ffc6ba8196cbc9bd0511b34b104c252b09b7 compiler/ghci/ByteCodeGen.hs | 15 ++++++++- compiler/ghci/ByteCodeTypes.hs | 73 ++++++++++++++++++++++++++++++++---------- 2 files changed, 70 insertions(+), 18 deletions(-) diff --git a/compiler/ghci/ByteCodeGen.hs b/compiler/ghci/ByteCodeGen.hs index 9a78054..0b4d625 100644 --- a/compiler/ghci/ByteCodeGen.hs +++ b/compiler/ghci/ByteCodeGen.hs @@ -1,4 +1,5 @@ {-# LANGUAGE CPP, MagicHash, RecordWildCards #-} +{-# OPTIONS_GHC -fprof-auto-top #-} -- -- (c) The University of Glasgow 2002-2006 -- @@ -60,6 +61,7 @@ import UniqSupply import Module import Control.Arrow ( second ) +import Control.Exception import Data.Array import Data.Map (Map) import Data.IntMap (IntMap) @@ -96,10 +98,21 @@ byteCodeGen hsc_env this_mod binds tycs mb_modBreaks dumpIfSet_dyn dflags Opt_D_dump_BCOs "Proto-BCOs" (vcat (intersperse (char ' ') (map ppr proto_bcos))) - assembleBCOs hsc_env proto_bcos tycs + cbc <- assembleBCOs hsc_env proto_bcos tycs (case modBreaks of Nothing -> Nothing Just mb -> Just mb{ modBreaks_breakInfo = breakInfo }) + + -- Squash space leaks in the CompiledByteCode. This is really + -- important, because when loading a set of modules into GHCi + -- we don't touch the CompiledByteCode until the end when we + -- do linking. Forcing out the thunks here reduces space + -- usage by more than 50% when loading a large number of + -- modules. + evaluate (seqCompiledByteCode cbc) + + return cbc + where dflags = hsc_dflags hsc_env -- ----------------------------------------------------------------------------- diff --git a/compiler/ghci/ByteCodeTypes.hs b/compiler/ghci/ByteCodeTypes.hs index 99e2ba2..3537a2b 100644 --- a/compiler/ghci/ByteCodeTypes.hs +++ b/compiler/ghci/ByteCodeTypes.hs @@ -1,11 +1,11 @@ -{-# LANGUAGE MagicHash, RecordWildCards #-} +{-# LANGUAGE MagicHash, RecordWildCards, GeneralizedNewtypeDeriving #-} -- -- (c) The University of Glasgow 2002-2006 -- -- | Bytecode assembler types module ByteCodeTypes - ( CompiledByteCode(..), FFIInfo(..) + ( CompiledByteCode(..), seqCompiledByteCode, FFIInfo(..) , UnlinkedBCO(..), BCOPtr(..), BCONPtr(..) , ItblEnv, ItblPtr(..) , CgBreakInfo(..) @@ -26,6 +26,7 @@ import GHCi.BreakArray import GHCi.RemoteTypes import GHCi.FFI import GHCi.InfoTable +import Control.DeepSeq import Foreign import Data.Array @@ -48,38 +49,61 @@ data CompiledByteCode = CompiledByteCode } -- ToDo: we're not tracking strings that we malloc'd newtype FFIInfo = FFIInfo (RemotePtr C_ffi_cif) - deriving Show + deriving (Show, NFData) instance Outputable CompiledByteCode where ppr CompiledByteCode{..} = ppr bc_bcos +-- Not a real NFData instance, because ModBreaks contains some things +-- we can't rnf +seqCompiledByteCode :: CompiledByteCode -> () +seqCompiledByteCode CompiledByteCode{..} = + rnf bc_bcos `seq` + rnf (nameEnvElts bc_itbls) `seq` + rnf bc_ffis `seq` + rnf bc_strs `seq` + rnf (fmap seqModBreaks bc_breaks) + type ItblEnv = NameEnv (Name, ItblPtr) -- We need the Name in the range so we know which -- elements to filter out when unloading a module -newtype ItblPtr = ItblPtr (RemotePtr StgInfoTable) deriving Show +newtype ItblPtr = ItblPtr (RemotePtr StgInfoTable) + deriving (Show, NFData) data UnlinkedBCO = UnlinkedBCO { - unlinkedBCOName :: Name, - unlinkedBCOArity :: Int, - unlinkedBCOInstrs :: UArray Int Word16, -- insns - unlinkedBCOBitmap :: UArray Int Word, -- bitmap - unlinkedBCOLits :: (SizedSeq BCONPtr), -- non-ptrs - unlinkedBCOPtrs :: (SizedSeq BCOPtr) -- ptrs + unlinkedBCOName :: !Name, + unlinkedBCOArity :: {-# UNPACK #-} !Int, + unlinkedBCOInstrs :: !(UArray Int Word16), -- insns + unlinkedBCOBitmap :: !(UArray Int Word), -- bitmap + unlinkedBCOLits :: !(SizedSeq BCONPtr), -- non-ptrs + unlinkedBCOPtrs :: !(SizedSeq BCOPtr) -- ptrs } +instance NFData UnlinkedBCO where + rnf UnlinkedBCO{..} = + rnf unlinkedBCOLits `seq` + rnf unlinkedBCOPtrs + data BCOPtr - = BCOPtrName Name - | BCOPtrPrimOp PrimOp - | BCOPtrBCO UnlinkedBCO + = BCOPtrName !Name + | BCOPtrPrimOp !PrimOp + | BCOPtrBCO !UnlinkedBCO | BCOPtrBreakArray -- a pointer to this module's BreakArray +instance NFData BCOPtr where + rnf (BCOPtrBCO bco) = rnf bco + rnf x = x `seq` () + data BCONPtr - = BCONPtrWord Word - | BCONPtrLbl FastString - | BCONPtrItbl Name - | BCONPtrStr ByteString + = BCONPtrWord {-# UNPACK #-} !Word + | BCONPtrLbl !FastString + | BCONPtrItbl !Name + | BCONPtrStr !ByteString + +instance NFData BCONPtr where + rnf x = x `seq` () -- | Information about a breakpoint that we know at code-generation time data CgBreakInfo @@ -88,6 +112,12 @@ data CgBreakInfo , cgb_resty :: Type } +-- Not a real NFData instance because we can't rnf Id or Type +seqCgBreakInfo :: CgBreakInfo -> () +seqCgBreakInfo CgBreakInfo{..} = + rnf (map snd cgb_vars) `seq` + seqType cgb_resty + instance Outputable UnlinkedBCO where ppr (UnlinkedBCO nm _arity _insns _bitmap lits ptrs) = sep [text "BCO", ppr nm, text "with", @@ -126,6 +156,15 @@ data ModBreaks -- ^ info about each breakpoint from the bytecode generator } +seqModBreaks :: ModBreaks -> () +seqModBreaks ModBreaks{..} = + rnf modBreaks_flags `seq` + rnf modBreaks_locs `seq` + rnf modBreaks_vars `seq` + rnf modBreaks_decls `seq` + rnf modBreaks_ccs `seq` + rnf (fmap seqCgBreakInfo modBreaks_breakInfo) + -- | Construct an empty ModBreaks emptyModBreaks :: ModBreaks emptyModBreaks = ModBreaks From git at git.haskell.org Sun Aug 7 11:59:24 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 7 Aug 2016 11:59:24 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Add deepseq dependency and a few NFData instances (2c44744) Message-ID: <20160807115924.C97753A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/2c447448b347bb438b18d29f82cd8b8fc2a397b1/ghc >--------------------------------------------------------------- commit 2c447448b347bb438b18d29f82cd8b8fc2a397b1 Author: Simon Marlow Date: Thu Jul 21 04:32:55 2016 -0700 Add deepseq dependency and a few NFData instances I needed to rnf a data structure (CompiledByteCode) but we don't have any good deepseq infrastructure in the compiler yet. There are bits and pieces, but nothing consistent, so this is a start. We already had a dependency on deepseq indirectly via other packages (e.g. containers). Includes an update to the haddock submodule, to remove orphan NFData instances in there. Test Plan: validate Reviewers: austin, bgamari, erikd, hvr Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2418 (cherry picked from commit c4f3d91b6b32a27c2e00506de532e90c595de2d1) >--------------------------------------------------------------- 2c447448b347bb438b18d29f82cd8b8fc2a397b1 compiler/basicTypes/Module.hs | 12 +++++++++++- compiler/basicTypes/Name.hs | 13 +++++++++++++ compiler/basicTypes/OccName.hs | 4 ++++ compiler/basicTypes/SrcLoc.hs | 4 ++++ compiler/ghc.cabal.in | 1 + compiler/utils/FastString.hs | 5 ++++- libraries/ghci/GHCi/RemoteTypes.hs | 5 +++++ libraries/ghci/SizedSeq.hs | 4 ++++ utils/haddock | 2 +- 9 files changed, 47 insertions(+), 3 deletions(-) diff --git a/compiler/basicTypes/Module.hs b/compiler/basicTypes/Module.hs index c8504fd..145321e 100644 --- a/compiler/basicTypes/Module.hs +++ b/compiler/basicTypes/Module.hs @@ -91,6 +91,7 @@ import Data.Ord import {-# SOURCE #-} Packages import GHC.PackageDb (BinaryStringRep(..)) +import Control.DeepSeq import Data.Coerce import Data.Data import Data.Map (Map) @@ -266,6 +267,9 @@ instance Data ModuleName where gunfold _ _ = error "gunfold" dataTypeOf _ = mkNoRepType "ModuleName" +instance NFData ModuleName where + rnf x = x `seq` () + stableModuleNameCmp :: ModuleName -> ModuleName -> Ordering -- ^ Compares module names lexically, rather than by their 'Unique's stableModuleNameCmp n1 n2 = moduleNameFS n1 `compare` moduleNameFS n2 @@ -319,7 +323,7 @@ moduleNameColons = dots_to_colons . moduleNameString -- | A Module is a pair of a 'UnitId' and a 'ModuleName'. data Module = Module { moduleUnitId :: !UnitId, -- pkg-1.0 - moduleName :: !ModuleName -- A.B.C + moduleName :: !ModuleName -- A.B.C } deriving (Eq, Ord, Typeable) @@ -339,6 +343,9 @@ instance Data Module where gunfold _ _ = error "gunfold" dataTypeOf _ = mkNoRepType "Module" +instance NFData Module where + rnf x = x `seq` () + -- | This gives a stable ordering, as opposed to the Ord instance which -- gives an ordering based on the 'Unique's of the components, which may -- not be stable from run to run of the compiler. @@ -400,6 +407,9 @@ instance Data UnitId where gunfold _ _ = error "gunfold" dataTypeOf _ = mkNoRepType "UnitId" +instance NFData UnitId where + rnf x = x `seq` () + stableUnitIdCmp :: UnitId -> UnitId -> Ordering -- ^ Compares package ids lexically, rather than by their 'Unique's stableUnitIdCmp p1 p2 = unitIdFS p1 `compare` unitIdFS p2 diff --git a/compiler/basicTypes/Name.hs b/compiler/basicTypes/Name.hs index 5ae8557..3ac70f3 100644 --- a/compiler/basicTypes/Name.hs +++ b/compiler/basicTypes/Name.hs @@ -91,6 +91,7 @@ import DynFlags import FastString import Outputable +import Control.DeepSeq import Data.Data {- @@ -133,6 +134,18 @@ instance Outputable NameSort where ppr Internal = text "internal" ppr System = text "system" +instance NFData Name where + rnf Name{..} = rnf n_sort + +instance NFData NameSort where + rnf (External m) = rnf m + rnf (WiredIn m t b) = rnf m `seq` t `seq` b `seq` () + -- XXX this is a *lie*, we're not going to rnf the TyThing, but + -- since the TyThings for WiredIn Names are all static they can't + -- be hiding space leaks or errors. + rnf Internal = () + rnf System = () + -- | BuiltInSyntax is for things like @(:)@, @[]@ and tuples, -- which have special syntactic forms. They aren't in scope -- as such. diff --git a/compiler/basicTypes/OccName.hs b/compiler/basicTypes/OccName.hs index e5aa860..09c5fc9 100644 --- a/compiler/basicTypes/OccName.hs +++ b/compiler/basicTypes/OccName.hs @@ -112,6 +112,7 @@ import FastStringEnv import Outputable import Lexeme import Binary +import Control.DeepSeq import Module import Data.Char import Data.Data @@ -246,6 +247,9 @@ instance Data OccName where instance HasOccName OccName where occName = id +instance NFData OccName where + rnf x = x `seq` () + {- ************************************************************************ * * diff --git a/compiler/basicTypes/SrcLoc.hs b/compiler/basicTypes/SrcLoc.hs index 524da78..7b1a5eb 100644 --- a/compiler/basicTypes/SrcLoc.hs +++ b/compiler/basicTypes/SrcLoc.hs @@ -89,6 +89,7 @@ import FastString import Data.Foldable ( Foldable ) import Data.Traversable ( Traversable ) #endif +import Control.DeepSeq import Data.Bits import Data.Data import Data.List @@ -269,6 +270,9 @@ data SrcSpan = deriving (Eq, Ord, Typeable, Show) -- Show is used by Lexer.x, because we -- derive Show for Token +instance NFData SrcSpan where + rnf x = x `seq` () + -- | Built-in "bad" 'SrcSpan's for common sources of location uncertainty noSrcSpan, wiredInSrcSpan, interactiveSrcSpan :: SrcSpan noSrcSpan = UnhelpfulSpan (fsLit "") diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in index ca250a8..d6a4944 100644 --- a/compiler/ghc.cabal.in +++ b/compiler/ghc.cabal.in @@ -45,6 +45,7 @@ Library Exposed: False Build-Depends: base >= 4 && < 5, + deepseq >= 1.4 && < 1.5, directory >= 1 && < 1.3, process >= 1 && < 1.5, bytestring >= 0.9 && < 0.11, diff --git a/compiler/utils/FastString.hs b/compiler/utils/FastString.hs index e1ef46a..6e692f2 100644 --- a/compiler/utils/FastString.hs +++ b/compiler/utils/FastString.hs @@ -1,6 +1,7 @@ -- (c) The University of Glasgow, 1997-2006 -{-# LANGUAGE BangPatterns, CPP, DeriveDataTypeable, MagicHash, UnboxedTuples #-} +{-# LANGUAGE BangPatterns, CPP, DeriveDataTypeable, MagicHash, UnboxedTuples, + GeneralizedNewtypeDeriving #-} {-# OPTIONS_GHC -O -funbox-strict-fields #-} -- We always optimise this, otherwise performance of a non-optimised -- compiler is severely affected @@ -97,6 +98,7 @@ import FastFunctions import Panic import Util +import Control.DeepSeq import Control.Monad import Data.ByteString (ByteString) import qualified Data.ByteString as BS @@ -149,6 +151,7 @@ hashByteString bs -- ----------------------------------------------------------------------------- newtype FastZString = FastZString ByteString + deriving NFData hPutFZS :: Handle -> FastZString -> IO () hPutFZS handle (FastZString bs) = BS.hPut handle bs diff --git a/libraries/ghci/GHCi/RemoteTypes.hs b/libraries/ghci/GHCi/RemoteTypes.hs index ea91f19..32156aa 100644 --- a/libraries/ghci/GHCi/RemoteTypes.hs +++ b/libraries/ghci/GHCi/RemoteTypes.hs @@ -9,6 +9,7 @@ module GHCi.RemoteTypes , unsafeForeignRefToRemoteRef, finalizeForeignRef ) where +import Control.DeepSeq import Data.Word import Foreign hiding (newForeignPtr) import Foreign.Concurrent @@ -41,6 +42,7 @@ castRemotePtr (RemotePtr a) = RemotePtr a deriving instance Show (RemotePtr a) deriving instance Binary (RemotePtr a) +deriving instance NFData (RemotePtr a) -- ----------------------------------------------------------------------------- -- HValueRef @@ -83,6 +85,9 @@ freeRemoteRef (RemoteRef w) = -- | An HValueRef with a finalizer newtype ForeignRef a = ForeignRef (ForeignPtr ()) +instance NFData (ForeignRef a) where + rnf x = x `seq` () + type ForeignHValue = ForeignRef HValue -- | Create a 'ForeignRef' from a 'RemoteRef'. The finalizer diff --git a/libraries/ghci/SizedSeq.hs b/libraries/ghci/SizedSeq.hs index e5bb37c..503544a 100644 --- a/libraries/ghci/SizedSeq.hs +++ b/libraries/ghci/SizedSeq.hs @@ -8,6 +8,7 @@ module SizedSeq , sizeSS ) where +import Control.DeepSeq import Data.Binary import Data.List import GHC.Generics @@ -26,6 +27,9 @@ instance Traversable SizedSeq where instance Binary a => Binary (SizedSeq a) +instance NFData a => NFData (SizedSeq a) where + rnf (SizedSeq _ xs) = rnf xs + emptySS :: SizedSeq a emptySS = SizedSeq 0 [] diff --git a/utils/haddock b/utils/haddock index 6db811a..08aa479 160000 --- a/utils/haddock +++ b/utils/haddock @@ -1 +1 @@ -Subproject commit 6db811aefb9cba65c8efe3876e850c813f280b6c +Subproject commit 08aa47916d6bb5a0f65d4da1021e0700b30b4b3b From git at git.haskell.org Sun Aug 7 11:59:28 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 7 Aug 2016 11:59:28 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Fix #12076 by inlining trivial expressions in CorePrep. (2a9767e) Message-ID: <20160807115928.566A73A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/2a9767ed596679ddf21b7edfa9fc6410443c2a01/ghc >--------------------------------------------------------------- commit 2a9767ed596679ddf21b7edfa9fc6410443c2a01 Author: Edward Z. Yang Date: Mon May 16 21:05:24 2016 -0700 Fix #12076 by inlining trivial expressions in CorePrep. Summary: This mostly follows the plan detailed by the discussion Simon and I had, with one difference: instead of grabbing the free variables of the trivial expressions to get the embedded Ids, we just use getIdFromTrivialExpr_maybe to extract out the Id. If there is no Id, the expression cannot refer to a function (as there are no literal functions) and thus we do not need to saturate. Signed-off-by: Edward Z. Yang Test Plan: validate Reviewers: simonpj, austin, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2309 GHC Trac Issues: #12076 (cherry picked from commit 11ff1df8a7c25485c9c7508d65bcb380e592010d) >--------------------------------------------------------------- 2a9767ed596679ddf21b7edfa9fc6410443c2a01 compiler/basicTypes/BasicTypes.hs | 1 + compiler/coreSyn/CoreArity.hs | 4 +- compiler/coreSyn/CorePrep.hs | 126 +++++++++++++++++++-- compiler/coreSyn/CoreUtils.hs | 25 +++- compiler/main/TidyPgm.hs | 4 +- .../tests/simplCore/should_compile/T12076lit.hs | 19 ++++ .../tests/simplCore/should_compile/T12076sat.hs | 9 ++ testsuite/tests/simplCore/should_compile/all.T | 4 +- 8 files changed, 172 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 2a9767ed596679ddf21b7edfa9fc6410443c2a01 From git at git.haskell.org Sun Aug 7 15:23:53 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 7 Aug 2016 15:23:53 +0000 (UTC) Subject: [commit: ghc] master: T1969: Enable it again but bump the max residency temporarily (773e3aa) Message-ID: <20160807152353.63C0C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/773e3aadac4bbee9a0173ebc90ffdc9458a2a3a9/ghc >--------------------------------------------------------------- commit 773e3aadac4bbee9a0173ebc90ffdc9458a2a3a9 Author: Ömer Sinan Ağacan Date: Sun Aug 7 15:19:01 2016 +0000 T1969: Enable it again but bump the max residency temporarily T1969 was broken by 714beb (which actually reduced allocations but residency was increased). Instead of disabling it completely, just bump the number a little bit to avoid making things even worse in the meantime. See also #12437. >--------------------------------------------------------------- 773e3aadac4bbee9a0173ebc90ffdc9458a2a3a9 testsuite/tests/perf/compiler/all.T | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T index e9e2493..4aff4fb 100644 --- a/testsuite/tests/perf/compiler/all.T +++ b/testsuite/tests/perf/compiler/all.T @@ -28,8 +28,7 @@ setTestOpts(no_lint) # really changed, then you know there's an issue. test('T1969', - [expect_broken(12437), - compiler_stats_num_field('peak_megabytes_allocated', # Note [residency] + [compiler_stats_num_field('peak_megabytes_allocated', # Note [residency] [(wordsize(32), 30, 15), # 2010-05-17 14 (x86/Windows) # 15 (x86/OS X) @@ -65,7 +64,7 @@ test('T1969', # 2014-06-29 5949188 (x86/Linux) # 2015-07-11 6241108 (x86/Linux, 64bit machine) use +RTS -G1 # 2016-04-06 9093608 (x86/Linux, 64bit machine) - (wordsize(64), 15017528, 15)]), + (wordsize(64), 15017528, 20)]), # 2014-09-10 10463640, 10 # post-AMP-update (somewhat stabelish) # looks like the peak is around ~10M, but we're # unlikely to GC exactly on the peak. From git at git.haskell.org Mon Aug 8 17:00:34 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 8 Aug 2016 17:00:34 +0000 (UTC) Subject: [commit: ghc] master: Fix typo in Data.Bitraversable Haddocks (4d9c22d) Message-ID: <20160808170034.8C4673A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4d9c22d01561bda90632d9a470fd2a2bb167658a/ghc >--------------------------------------------------------------- commit 4d9c22d01561bda90632d9a470fd2a2bb167658a Author: Ryan Scott Date: Mon Aug 8 12:59:17 2016 -0400 Fix typo in Data.Bitraversable Haddocks [ci skip] >--------------------------------------------------------------- 4d9c22d01561bda90632d9a470fd2a2bb167658a libraries/base/Data/Bitraversable.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/base/Data/Bitraversable.hs b/libraries/base/Data/Bitraversable.hs index f185044..19d4ba2 100644 --- a/libraries/base/Data/Bitraversable.hs +++ b/libraries/base/Data/Bitraversable.hs @@ -40,7 +40,7 @@ import GHC.Generics (K1(..)) -- element on which an action can be performed, 'Bitraversable' data structures -- have two such varieties of elements. -- --- A definition of 'traverse' must satisfy the following laws: +-- A definition of 'bitraverse' must satisfy the following laws: -- -- [/naturality/] -- @'bitraverse' (t . f) (t . g) ≡ t . 'bitraverse' f g@ From git at git.haskell.org Mon Aug 8 21:14:58 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 8 Aug 2016 21:14:58 +0000 (UTC) Subject: [commit: ghc] master: Cabal submodule update. (fe19be2) Message-ID: <20160808211458.9E00C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/fe19be2de14a5506c1af21dc4d574f5ffd6acbdf/ghc >--------------------------------------------------------------- commit fe19be2de14a5506c1af21dc4d574f5ffd6acbdf Author: Edward Z. Yang Date: Wed May 4 14:55:59 2016 -0700 Cabal submodule update. There's a substantial bump to the haddock.Cabal allocation stats, because we added 50% more modules, so of course allocations are going to increase 50%. (But perhaps this is indicative of some bad constant factor in Haddock related to modules.) Signed-off-by: Edward Z. Yang Test Plan: validate Reviewers: ggreif, austin, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2442 >--------------------------------------------------------------- fe19be2de14a5506c1af21dc4d574f5ffd6acbdf compiler/main/HscTypes.hs | 2 +- libraries/Cabal | 2 +- testsuite/tests/driver/recomp007/recomp007.stdout | 1 - testsuite/tests/perf/haddock/all.T | 5 +++++ utils/ghc-cabal/Main.hs | 13 ++++++------- utils/ghc-pkg/Main.hs | 18 +++++++++--------- utils/ghctags/Main.hs | 12 ++++++++---- 7 files changed, 30 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 fe19be2de14a5506c1af21dc4d574f5ffd6acbdf From git at git.haskell.org Mon Aug 8 23:07:13 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 8 Aug 2016 23:07:13 +0000 (UTC) Subject: [commit: ghc] master: Actually update haddock.Cabal stats. (dd23a4c) Message-ID: <20160808230713.2F4CF3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/dd23a4c067323cdc948a66f1c19fbd6b94374759/ghc >--------------------------------------------------------------- commit dd23a4c067323cdc948a66f1c19fbd6b94374759 Author: Edward Z. Yang Date: Mon Aug 8 16:06:45 2016 -0700 Actually update haddock.Cabal stats. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- dd23a4c067323cdc948a66f1c19fbd6b94374759 testsuite/tests/perf/haddock/all.T | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/testsuite/tests/perf/haddock/all.T b/testsuite/tests/perf/haddock/all.T index 89d6ecd..918f968 100644 --- a/testsuite/tests/perf/haddock/all.T +++ b/testsuite/tests/perf/haddock/all.T @@ -52,7 +52,7 @@ test('haddock.base', test('haddock.Cabal', [unless(in_tree_compiler(), skip), req_haddock ,stats_num_field('bytes allocated', - [(wordsize(64), 10070330520, 5) + [(wordsize(64), 16014171248, 5) # 2012-08-14: 3255435248 (amd64/Linux) # 2012-08-29: 3324606664 (amd64/Linux, new codegen) # 2012-10-08: 3373401360 (amd64/Linux) From git at git.haskell.org Tue Aug 9 09:51:37 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 9 Aug 2016 09:51:37 +0000 (UTC) Subject: [commit: ghc] branch 'wip/ggreif-new-cabal' deleted Message-ID: <20160809095137.42CB23A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Deleted branch: wip/ggreif-new-cabal From git at git.haskell.org Tue Aug 9 22:32:14 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 9 Aug 2016 22:32:14 +0000 (UTC) Subject: [commit: ghc] master: Fix a bug in unboxed sum layout generation (e79bb2c) Message-ID: <20160809223214.2C9253A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e79bb2c10d66ec8f0c037e66c7d0a22aa887fdc1/ghc >--------------------------------------------------------------- commit e79bb2c10d66ec8f0c037e66c7d0a22aa887fdc1 Author: Ömer Sinan Ağacan Date: Tue Aug 9 22:30:56 2016 +0000 Fix a bug in unboxed sum layout generation We need to maintain the invariant that the layout fields are always sorted. Two tests that were previously broken are added. >--------------------------------------------------------------- e79bb2c10d66ec8f0c037e66c7d0a22aa887fdc1 compiler/simplStg/RepType.hs | 4 +++- testsuite/tests/unboxedsums/unboxedsums_unit_tests.hs | 14 +++++++++++++- 2 files changed, 16 insertions(+), 2 deletions(-) diff --git a/compiler/simplStg/RepType.hs b/compiler/simplStg/RepType.hs index 7e42a86..ca8438e 100644 --- a/compiler/simplStg/RepType.hs +++ b/compiler/simplStg/RepType.hs @@ -199,7 +199,9 @@ ubxSumRepType constrs0 = | Just s' <- s `fitsIn` es = -- found a slot, use it s' : merge ess ss - + | s < es + = -- we need a new slot and this is the right place for it + s : merge (es : ess) ss | otherwise = -- keep searching for a slot es : merge ess (s : ss) diff --git a/testsuite/tests/unboxedsums/unboxedsums_unit_tests.hs b/testsuite/tests/unboxedsums/unboxedsums_unit_tests.hs index 5c0b929..399e074 100644 --- a/testsuite/tests/unboxedsums/unboxedsums_unit_tests.hs +++ b/testsuite/tests/unboxedsums/unboxedsums_unit_tests.hs @@ -42,7 +42,7 @@ uniq_tests = do layout_tests :: IO () layout_tests = sequence_ - [ layout1, layout2, layout3, enum_layout ] + [ layout1, layout2, layout3, layout4, layout5, enum_layout ] where assert_layout tn tys layout = let @@ -75,6 +75,18 @@ layout_tests = sequence_ , ubxtup [ intPrimTy, intTy, intPrimTy, intTy ] ] [ WordSlot, PtrSlot, PtrSlot, WordSlot, WordSlot ] + layout4 = + assert_layout "layout4" + [ ubxtup [ floatPrimTy, floatPrimTy ] + , ubxtup [ intPrimTy, intPrimTy ] ] + [ WordSlot, WordSlot, WordSlot, FloatSlot, FloatSlot ] + + layout5 = + assert_layout "layout5" + [ ubxtup [ intPrimTy, intPrimTy ] + , ubxtup [ floatPrimTy, floatPrimTy ] ] + [ WordSlot, WordSlot, WordSlot, FloatSlot, FloatSlot ] + enum_layout = assert_layout "enum" (replicate 10 (ubxtup [])) From git at git.haskell.org Wed Aug 10 13:20:47 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 10 Aug 2016 13:20:47 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Widen deepseq lower bound (2930a5b) Message-ID: <20160810132047.2F58D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/2930a5bd9fddbec6ee3add64ac0c7debbe17ac24/ghc >--------------------------------------------------------------- commit 2930a5bd9fddbec6ee3add64ac0c7debbe17ac24 Author: Ben Gamari Date: Tue Aug 9 11:46:38 2016 +0200 Widen deepseq lower bound >--------------------------------------------------------------- 2930a5bd9fddbec6ee3add64ac0c7debbe17ac24 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 d6a4944..b3ac89c 100644 --- a/compiler/ghc.cabal.in +++ b/compiler/ghc.cabal.in @@ -45,7 +45,7 @@ Library Exposed: False Build-Depends: base >= 4 && < 5, - deepseq >= 1.4 && < 1.5, + deepseq >= 1.3 && < 1.5, directory >= 1 && < 1.3, process >= 1 && < 1.5, bytestring >= 0.9 && < 0.11, From git at git.haskell.org Wed Aug 10 16:48:54 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 10 Aug 2016 16:48:54 +0000 (UTC) Subject: [commit: ghc] master: Remove StgRubbishArg and CmmArg (9684dbb) Message-ID: <20160810164855.00A2F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9684dbb1d776a8e086f8db4191b3bcf826867dda/ghc >--------------------------------------------------------------- commit 9684dbb1d776a8e086f8db4191b3bcf826867dda Author: Ömer Sinan Ağacan Date: Wed Aug 10 16:47:47 2016 +0000 Remove StgRubbishArg and CmmArg The idea behind adding special "rubbish" arguments was in unboxed sum types depending on the tag some arguments are not used and we don't want to move some special values (like 0 for literals and some special pointer for boxed slots) for those arguments (to stack locations or registers). "StgRubbishArg" was an indicator to the code generator that the value won't be used. During Stg-to-Cmm we were then not generating any move or store instructions at all. This caused problems in the register allocator because some variables were only initialized in some code paths. As an example, suppose we have this STG: (after unarise) Lib.$WT = \r [dt_sit] case case dt_sit of { Lib.F dt_siv [Occ=Once] -> (#,,#) [1# dt_siv StgRubbishArg::GHC.Prim.Int#]; Lib.I dt_siw [Occ=Once] -> (#,,#) [2# StgRubbishArg::GHC.Types.Any dt_siw]; } of dt_six { (#,,#) us_giC us_giD us_giE -> Lib.T [us_giC us_giD us_giE]; }; This basically unpacks a sum type to an unboxed sum with 3 fields, and then moves the unboxed sum to a constructor (`Lib.T`). This is the Cmm for the inner case expression (case expression in the scrutinee position of the outer case): ciN: ... -- look at dt_sit's tag if (_ciT::P64 != 1) goto ciS; else goto ciR; ciS: -- Tag is 2, i.e. Lib.F _siw::I64 = I64[_siu::P64 + 6]; _giE::I64 = _siw::I64; _giD::P64 = stg_RUBBISH_ENTRY_info; _giC::I64 = 2; goto ciU; ciR: -- Tag is 1, i.e. Lib.I _siv::P64 = P64[_siu::P64 + 7]; _giD::P64 = _siv::P64; _giC::I64 = 1; goto ciU; Here one of the blocks `ciS` and `ciR` is executed and then the execution continues to `ciR`, but only `ciS` initializes `_giE`, in the other branch `_giE` is not initialized, because it's "rubbish" in the STG and so we don't generate an assignment during code generator. The code generator then panics during the register allocations: ghc-stage1: panic! (the 'impossible' happened) (GHC version 8.1.20160722 for x86_64-unknown-linux): LocalReg's live-in to graph ciY {_giE::I64} (`_giD` is also "rubbish" in `ciS`, but it's still initialized because it's a pointer slot, we have to initialize it otherwise garbage collector follows the pointer to some random place. So we only remove assignment if the "rubbish" arg has unboxed type.) This patch removes `StgRubbishArg` and `CmmArg`. We now always initialize rubbish slots. If the slot is for boxed types we use the existing `absentError`, otherwise we initialize the slot with literal 0. Reviewers: simonpj, erikd, austin, simonmar, bgamari Reviewed By: erikd Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2446 >--------------------------------------------------------------- 9684dbb1d776a8e086f8db4191b3bcf826867dda compiler/cmm/CLabel.hs | 4 +- compiler/cmm/CmmExpr.hs | 6 --- compiler/cmm/CmmLayoutStack.hs | 2 +- compiler/cmm/CmmParse.y | 8 ++-- compiler/cmm/CmmUtils.hs | 6 +-- compiler/cmm/MkGraph.hs | 71 +++++++++------------------- compiler/cmm/PprCmmExpr.hs | 9 ---- compiler/codeGen/StgCmm.hs | 2 +- compiler/codeGen/StgCmmBind.hs | 2 +- compiler/codeGen/StgCmmCon.hs | 2 +- compiler/codeGen/StgCmmEnv.hs | 28 +++-------- compiler/codeGen/StgCmmExpr.hs | 14 +++--- compiler/codeGen/StgCmmForeign.hs | 6 +-- compiler/codeGen/StgCmmHeap.hs | 20 ++++---- compiler/codeGen/StgCmmLayout.hs | 28 +++++------ compiler/codeGen/StgCmmMonad.hs | 17 ++----- compiler/codeGen/StgCmmPrim.hs | 25 +++++----- compiler/codeGen/StgCmmUtils.hs | 22 ++++----- compiler/coreSyn/MkCore.hs | 5 +- compiler/prelude/PrelNames.hs | 3 +- compiler/simplStg/UnariseStg.hs | 15 ++++-- compiler/stgSyn/StgLint.hs | 1 - compiler/stgSyn/StgSyn.hs | 8 +--- rts/StgMiscClosures.cmm | 3 -- testsuite/tests/unboxedsums/all.T | 1 + testsuite/tests/unboxedsums/unboxedsums12.hs | 19 ++++++++ 26 files changed, 130 insertions(+), 197 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 9684dbb1d776a8e086f8db4191b3bcf826867dda From git at git.haskell.org Fri Aug 12 16:34:48 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 12 Aug 2016 16:34:48 +0000 (UTC) Subject: [commit: ghc] master: Improve missing-sig warning (ac0e112) Message-ID: <20160812163448.2FEDE3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ac0e11252af149f085e2262200b7a1638b4a1553/ghc >--------------------------------------------------------------- commit ac0e11252af149f085e2262200b7a1638b4a1553 Author: Simon Peyton Jones Date: Fri Aug 12 15:52:07 2016 +0100 Improve missing-sig warning Fixes Trac #12484 >--------------------------------------------------------------- ac0e11252af149f085e2262200b7a1638b4a1553 compiler/rename/RnNames.hs | 20 ++++---- .../tests/patsyn/should_compile/T11213.stderr | 53 ++++++++++++---------- testsuite/tests/patsyn/should_compile/T12484.hs | 7 +++ .../tests/patsyn/should_compile/T12484.stderr | 4 ++ testsuite/tests/patsyn/should_compile/all.T | 1 + testsuite/tests/patsyn/should_fail/T11053.stderr | 18 ++++---- 6 files changed, 61 insertions(+), 42 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc ac0e11252af149f085e2262200b7a1638b4a1553 From git at git.haskell.org Sat Aug 13 18:13:59 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 13 Aug 2016 18:13:59 +0000 (UTC) Subject: [commit: nofib] master: Fix parsing cachegrind output. (6dc2b46) Message-ID: <20160813181359.9CBD63A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/nofib On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6dc2b467c71cf7c7e8f99ba4e60ca4b32a90236a/nofib >--------------------------------------------------------------- commit 6dc2b467c71cf7c7e8f99ba4e60ca4b32a90236a Author: Peter Trommler Date: Sat Aug 13 13:17:09 2016 +0200 Fix parsing cachegrind output. On architectures with more than two levels of cache cachegrind reports the last level data cache miss rate as `LLd` and not `L2d`. This changes the regular expression to work in both cases. >--------------------------------------------------------------- 6dc2b467c71cf7c7e8f99ba4e60ca4b32a90236a runstdtest/runstdtest.prl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/runstdtest/runstdtest.prl b/runstdtest/runstdtest.prl index 10a419b..538dfa9 100644 --- a/runstdtest/runstdtest.prl +++ b/runstdtest/runstdtest.prl @@ -598,7 +598,7 @@ sub process_cachegrind_files { $TotWrites =~ s/,//g; }; - /^==\d+==\s+L2d\s+misses:\s+([0-9,]+)/ && do { + /^==\d+==\s+L2|Ld\s+misses:\s+([0-9,]+)/ && do { $TotMisses = $1; $TotMisses =~ s/,//g; }; From git at git.haskell.org Sat Aug 13 21:25:19 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 13 Aug 2016 21:25:19 +0000 (UTC) Subject: [commit: ghc] master: Fix GHCi perf-llvm build on x86_64 (bd0c310) Message-ID: <20160813212519.6DEF13A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/bd0c31063551744d00796219174739216c398da5/ghc >--------------------------------------------------------------- commit bd0c31063551744d00796219174739216c398da5 Author: Erik de Castro Lopo Date: Sun Aug 14 07:23:35 2016 +1000 Fix GHCi perf-llvm build on x86_64 With BuildFlavour set to `perf-llvm`, GHCi would fail as soon as it was run with: ghc-stage2: .../ghc-prim/dist-install/build/HSghc-prim-0.5.0.0.o: unknown symbol `__udivti3' ghc-stage2: unable to load package `ghc-prim-0.5.0.0' Fix this by adding `__udivti3` and `__umodti3` to RtsSymbols.c. Test Plan: Validate Reviewers: simonmar, austin, bgamari, Phyx, trofi Reviewed By: Phyx, trofi Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2449 GHC Trac Issues: #11981 >--------------------------------------------------------------- bd0c31063551744d00796219174739216c398da5 rts/RtsSymbols.c | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/rts/RtsSymbols.c b/rts/RtsSymbols.c index ed9bdfb..cc26ecb 100644 --- a/rts/RtsSymbols.c +++ b/rts/RtsSymbols.c @@ -762,6 +762,10 @@ SymI_NeedsProto(__ashrdi3) \ SymI_NeedsProto(__lshrdi3) \ SymI_NeedsProto(__fixunsdfdi) +#elif defined(__GNUC__) && SIZEOF_VOID_P == 8 +#define RTS_LIBGCC_SYMBOLS \ + SymI_NeedsProto(__udivti3) \ + SymI_NeedsProto(__umodti3) #else #define RTS_LIBGCC_SYMBOLS #endif From git at git.haskell.org Sun Aug 14 07:51:56 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 14 Aug 2016 07:51:56 +0000 (UTC) Subject: [commit: ghc] master: Update `nofib` submodule to newest commit (37a7bcb) Message-ID: <20160814075156.9573D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/37a7bcbcbd9f68167c9c03fbd415e62919739d2d/ghc >--------------------------------------------------------------- commit 37a7bcbcbd9f68167c9c03fbd415e62919739d2d Author: Gabor Greif Date: Sun Aug 14 09:50:49 2016 +0200 Update `nofib` submodule to newest commit >--------------------------------------------------------------- 37a7bcbcbd9f68167c9c03fbd415e62919739d2d nofib | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/nofib b/nofib index 35fc121..6dc2b46 160000 --- a/nofib +++ b/nofib @@ -1 +1 @@ -Subproject commit 35fc121fc8cc501ea2713c579a053be7ea65b16e +Subproject commit 6dc2b467c71cf7c7e8f99ba4e60ca4b32a90236a From git at git.haskell.org Sun Aug 14 11:04:27 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 14 Aug 2016 11:04:27 +0000 (UTC) Subject: [commit: ghc] master: Misspellings in comments [skip ci] (7ad3b49) Message-ID: <20160814110427.CC21B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7ad3b49161587f937facd1852742cc3fbaf1ffce/ghc >--------------------------------------------------------------- commit 7ad3b49161587f937facd1852742cc3fbaf1ffce Author: Gabor Greif Date: Sun Aug 14 13:03:23 2016 +0200 Misspellings in comments [skip ci] >--------------------------------------------------------------- 7ad3b49161587f937facd1852742cc3fbaf1ffce compiler/coreSyn/CoreLint.hs | 2 +- compiler/typecheck/TcEvidence.hs | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/compiler/coreSyn/CoreLint.hs b/compiler/coreSyn/CoreLint.hs index dead929..9700522 100644 --- a/compiler/coreSyn/CoreLint.hs +++ b/compiler/coreSyn/CoreLint.hs @@ -1287,7 +1287,7 @@ lintCoercion :: OutCoercion -> LintM (LintedKind, LintedKind, LintedType, Linted -- Check the kind of a coercion term, returning the kind -- Post-condition: the returned OutTypes are lint-free -- --- If lintCorecion co = (k1, k2, s1, s2, r) +-- If lintCoercion co = (k1, k2, s1, s2, r) -- then co :: s1 ~r s2 -- s1 :: k2 -- s2 :: k2 diff --git a/compiler/typecheck/TcEvidence.hs b/compiler/typecheck/TcEvidence.hs index 71f5bb7..aaa1f0c 100644 --- a/compiler/typecheck/TcEvidence.hs +++ b/compiler/typecheck/TcEvidence.hs @@ -80,8 +80,8 @@ kosher free variables. -} type TcCoercion = Coercion -type TcCoercionN = CoercionN -- A Nominal corecion ~N -type TcCoercionR = CoercionR -- A Representational corecion ~R +type TcCoercionN = CoercionN -- A Nominal coercion ~N +type TcCoercionR = CoercionR -- A Representational coercion ~R type TcCoercionP = CoercionP -- a phantom coercion mkTcReflCo :: Role -> TcType -> TcCoercion From git at git.haskell.org Sun Aug 14 17:41:29 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 14 Aug 2016 17:41:29 +0000 (UTC) Subject: [commit: ghc] master: Fix configure detection. (18f0687) Message-ID: <20160814174129.E758D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/18f06878ed5d8cb0cf366a876f2bfea29647e5f0/ghc >--------------------------------------------------------------- commit 18f06878ed5d8cb0cf366a876f2bfea29647e5f0 Author: Tamar Christina Date: Sat Aug 13 16:27:30 2016 +0100 Fix configure detection. Summary: GHC's configure script seems to normalize the values returned from config.guess. So for Windows it turns x86_64-pc-mingw64 into x86_64-unknown-mingw32. These mangled names are stored in the values $BuildPlatform, $HostPlatform and $TargetPlatform. However further down the file when the comparison is done between the stage0 compiler and the host the normalized versions are not used. So when normalization actually changes the triple this check will fail. Not sure why it's worked for all this time.. Nor if this is the right fix? Does it still work for cross compiling correctly? Test Plan: ./configure Reviewers: hvr, austin, thomie, bgamari, erikd Reviewed By: erikd Subscribers: erikd, #ghc_windows_task_force Differential Revision: https://phabricator.haskell.org/D2452 GHC Trac Issues: #12487 >--------------------------------------------------------------- 18f06878ed5d8cb0cf366a876f2bfea29647e5f0 configure.ac | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/configure.ac b/configure.ac index e9569e9..acd33cf 100644 --- a/configure.ac +++ b/configure.ac @@ -410,20 +410,20 @@ dnl ** Building a cross compiler? dnl -------------------------------------------------------------- CrossCompiling=NO # If 'host' and 'target' differ, then this means we are building a cross-compiler. -if test "$target" != "$host" ; then +if test "$TargetPlatform" != "$HostPlatform" ; then CrossCompiling=YES cross_compiling=yes # This tells configure that it can accept just 'target', # otherwise you get # configure: error: cannot run C compiled programs. # If you meant to cross compile, use `--host'. fi -if test "$build" != "$host" ; then +if test "$BuildPlatform" != "$host" ; then AC_MSG_ERROR([ You've selected: - BUILD: $build (the architecture we're building on) - HOST: $host (the architecture the compiler we're building will execute on) - TARGET: $target (the architecture the compiler we're building will produce code for) + BUILD: $BuildPlatform (the architecture we're building on) + HOST: $HostPlatform (the architecture the compiler we're building will execute on) + TARGET: $TargetPlatform (the architecture the compiler we're building will produce code for) BUILD must equal HOST; that is, we do not support building GHC itself with a cross-compiler. To cross-compile GHC itself, set TARGET: stage @@ -437,7 +437,7 @@ then else CrossCompilePrefix="" fi -TargetPlatformFull="${target}" +TargetPlatformFull="${TargetPlatform}" AC_SUBST(CrossCompiling) AC_SUBST(CrossCompilePrefix) AC_SUBST(TargetPlatformFull) From git at git.haskell.org Sun Aug 14 19:57:51 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 14 Aug 2016 19:57:51 +0000 (UTC) Subject: [commit: ghc] master: fix compilation failure on OpenBSD with system supplied GNU C 4.2.1 (ffd4029) Message-ID: <20160814195751.17A953A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ffd4029c5bc581ac749f5cdc3d8e085c80add585/ghc >--------------------------------------------------------------- commit ffd4029c5bc581ac749f5cdc3d8e085c80add585 Author: Karel Gardas Date: Sat Aug 13 18:46:43 2016 +0200 fix compilation failure on OpenBSD with system supplied GNU C 4.2.1 Summary: This patch fixes compilation failure on OpenBSD. The OpenBSD's GNU C compiler is of 4.2.1 version and problematic __builtin_unreachable was added in GNU C 4.5 release. Let's use pure abort() call on OpenBSD instead of __builtin_unreachable Reviewers: bgamari, austin, erikd, simonmar Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2453 >--------------------------------------------------------------- ffd4029c5bc581ac749f5cdc3d8e085c80add585 rts/sm/CNF.c | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/rts/sm/CNF.c b/rts/sm/CNF.c index 4689b46..0594a6e 100644 --- a/rts/sm/CNF.c +++ b/rts/sm/CNF.c @@ -164,8 +164,11 @@ compactAllocateBlockInternal(Capability *cap, default: #ifdef DEBUG ASSERT(!"code should not be reached"); -#else +#elif __GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 5) + /* __builtin_unreachable is supported since GNU C 4.5 */ __builtin_unreachable(); +#else + abort(); #endif } RELEASE_SM_LOCK; From git at git.haskell.org Mon Aug 15 10:13:55 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 15 Aug 2016 10:13:55 +0000 (UTC) Subject: [commit: ghc] master: Update hoopl submodule (extra .gitignore entry) (fc1432a) Message-ID: <20160815101355.AE9F43A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/fc1432aa57b01c1e3b936dcee0eb419a8c2bb2c8/ghc >--------------------------------------------------------------- commit fc1432aa57b01c1e3b936dcee0eb419a8c2bb2c8 Author: Edward Z. Yang Date: Mon Aug 15 03:13:43 2016 -0700 Update hoopl submodule (extra .gitignore entry) Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- fc1432aa57b01c1e3b936dcee0eb419a8c2bb2c8 libraries/hoopl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/hoopl b/libraries/hoopl index 4478ec0..67dff9a 160000 --- a/libraries/hoopl +++ b/libraries/hoopl @@ -1 +1 @@ -Subproject commit 4478ec0b6d38bcd26c66ad09eb512e6952ab7e19 +Subproject commit 67dff9a7db8e103d379068df0323bbc97452e769 From git at git.haskell.org Mon Aug 15 20:26:24 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 15 Aug 2016 20:26:24 +0000 (UTC) Subject: [commit: ghc] master: refactor test for __builtin_unreachable into Rts.h macro RTS_UNREACHABLE (3551e62) Message-ID: <20160815202624.7DB443A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3551e622ab3a833589a069b473a4dfb3f171e5b8/ghc >--------------------------------------------------------------- commit 3551e622ab3a833589a069b473a4dfb3f171e5b8 Author: Karel Gardas Date: Mon Aug 15 22:26:04 2016 +0200 refactor test for __builtin_unreachable into Rts.h macro RTS_UNREACHABLE Summary: This patch refactors GNU C version test (for 4.5 and more modern) due to usage of __builtin_unreachable done in the CNF.c code directly into the new RTS_UNREACHABLE macro placed into Rts.h Reviewers: bgamari, austin, simonmar, erikd Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2457 >--------------------------------------------------------------- 3551e622ab3a833589a069b473a4dfb3f171e5b8 includes/Rts.h | 7 +++++++ rts/sm/CNF.c | 5 +---- 2 files changed, 8 insertions(+), 4 deletions(-) diff --git a/includes/Rts.h b/includes/Rts.h index 3d4538f..be81b0d 100644 --- a/includes/Rts.h +++ b/includes/Rts.h @@ -61,6 +61,13 @@ extern "C" { #define RTS_UNLIKELY(p) p #endif +/* __builtin_unreachable is supported since GNU C 4.5 */ +#if __GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 5) +#define RTS_UNREACHABLE __builtin_unreachable() +#else +#define RTS_UNREACHABLE abort() +#endif + /* Fix for mingw stat problem (done here so it's early enough) */ #ifdef mingw32_HOST_OS #define __MSVCRT__ 1 diff --git a/rts/sm/CNF.c b/rts/sm/CNF.c index 0594a6e..f8e706a 100644 --- a/rts/sm/CNF.c +++ b/rts/sm/CNF.c @@ -164,11 +164,8 @@ compactAllocateBlockInternal(Capability *cap, default: #ifdef DEBUG ASSERT(!"code should not be reached"); -#elif __GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 5) - /* __builtin_unreachable is supported since GNU C 4.5 */ - __builtin_unreachable(); #else - abort(); + RTS_UNREACHABLE; #endif } RELEASE_SM_LOCK; From git at git.haskell.org Mon Aug 15 20:43:46 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 15 Aug 2016 20:43:46 +0000 (UTC) Subject: [commit: ghc] master: Darwin: Detect broken NM program at configure time (da99a7f) Message-ID: <20160815204346.DFDB43A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/da99a7f515cddb7e9eebd81283375c245e1625d4/ghc >--------------------------------------------------------------- commit da99a7f515cddb7e9eebd81283375c245e1625d4 Author: Erik de Castro Lopo Date: Tue Aug 16 06:41:19 2016 +1000 Darwin: Detect broken NM program at configure time Some recent versions of XCode ship a broken version of `nm`. Detect this at configure time, and error out with a suggestion to rerun configure with a `--with-nm=...` argument. Test Plan: Test of Linux and OS X Reviewers: carter, hvr, austin, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2425 >--------------------------------------------------------------- da99a7f515cddb7e9eebd81283375c245e1625d4 configure.ac | 26 ++++++++++++++++++++++++++ 1 file changed, 26 insertions(+) diff --git a/configure.ac b/configure.ac index acd33cf..ea3ba4e 100644 --- a/configure.ac +++ b/configure.ac @@ -483,6 +483,32 @@ AC_SUBST([LdCmd]) dnl ** Which nm to use? dnl -------------------------------------------------------------- FP_ARG_WITH_PATH_GNU_PROG([NM], [nm], [nm]) + +if test "$TargetOS_CPP" = "darwin" +then + AC_MSG_CHECKING(whether nm program is broken) + # Some versions of XCode ship a broken version of `nm`. Detect and work + # around this issue. See : https://ghc.haskell.org/trac/ghc/ticket/11744 + nmver=$(${NM} --version | grep version | sed 's/ //g') + case "$nmver" in + LLVMversion7.3.0|LLVMversion7.3.1) + AC_MSG_RESULT(yes) + echo "The detected nm program is broken." + echo + echo "See: https://ghc.haskell.org/trac/ghc/ticket/11744" + echo + echo "Try re-running configure with:" + echo + echo ' ./configure --with-nm=$(xcrun --find nm-classic)' + echo + exit 1 + ;; + *) + AC_MSG_RESULT(no) + ;; + esac +fi + NmCmd="$NM" AC_SUBST([NmCmd]) From git at git.haskell.org Tue Aug 16 01:06:03 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 16 Aug 2016 01:06:03 +0000 (UTC) Subject: [commit: ghc] master: When in sanity mode, un-zero malloc'd memory; fix uninitialized memory bugs. (f9a11a2) Message-ID: <20160816010603.DEF873A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f9a11a241b8056ac2b9c771172a48919fb3d0ed1/ghc >--------------------------------------------------------------- commit f9a11a241b8056ac2b9c771172a48919fb3d0ed1 Author: Edward Z. Yang Date: Mon Aug 15 02:22:28 2016 -0700 When in sanity mode, un-zero malloc'd memory; fix uninitialized memory bugs. malloc'd memory is not guaranteed to be zeroed. On Linux, however, it is often zeroed, leading to latent bugs. In fact, with this patch I fix two uninitialized memory bugs stemming from this. Signed-off-by: Edward Z. Yang Test Plan: validate Reviewers: simonmar, austin, Phyx, bgamari, erikd Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2455 >--------------------------------------------------------------- f9a11a241b8056ac2b9c771172a48919fb3d0ed1 rts/RtsUtils.c | 1 + rts/sm/Storage.c | 2 ++ 2 files changed, 3 insertions(+) diff --git a/rts/RtsUtils.c b/rts/RtsUtils.c index 716d203..3a97427 100644 --- a/rts/RtsUtils.c +++ b/rts/RtsUtils.c @@ -79,6 +79,7 @@ stgMallocBytes (size_t n, char *msg) rtsConfig.mallocFailHook((W_) n, msg); /*msg*/ stg_exit(EXIT_INTERNAL_ERROR); } + IF_DEBUG(sanity, memset(space, 0xbb, n)); return space; } diff --git a/rts/sm/Storage.c b/rts/sm/Storage.c index 3f88896..4d0c8d5 100644 --- a/rts/sm/Storage.c +++ b/rts/sm/Storage.c @@ -106,6 +106,8 @@ initGeneration (generation *gen, int g) gen->n_scavenged_large_blocks = 0; gen->live_compact_objects = NULL; gen->n_live_compact_blocks = 0; + gen->compact_blocks_in_import = NULL; + gen->n_compact_blocks_in_import = 0; gen->mark = 0; gen->compact = 0; gen->bitmap = NULL; From git at git.haskell.org Tue Aug 16 09:37:32 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 16 Aug 2016 09:37:32 +0000 (UTC) Subject: [commit: ghc] master: Minor typofix. (d331ace) Message-ID: <20160816093732.3D9D83A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d331ace4fd2a8728bb2c6ed829a0beb4fac6a76e/ghc >--------------------------------------------------------------- commit d331ace4fd2a8728bb2c6ed829a0beb4fac6a76e Author: Edward Z. Yang Date: Fri Jul 1 20:00:01 2016 -0400 Minor typofix. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- d331ace4fd2a8728bb2c6ed829a0beb4fac6a76e compiler/types/TyCon.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/types/TyCon.hs b/compiler/types/TyCon.hs index 195c3a7..d0ecb70 100644 --- a/compiler/types/TyCon.hs +++ b/compiler/types/TyCon.hs @@ -2281,7 +2281,7 @@ Notice that twice at the outer level, because Id is non-recursive So, when expanding, we keep track of when we've seen a recursive -newtype at outermost level; and bale out if we see it again. +newtype at outermost level; and bail out if we see it again. We sometimes want to do the same for product types, so that the strictness analyser doesn't unbox infinitely deeply. From git at git.haskell.org Tue Aug 16 09:38:14 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 16 Aug 2016 09:38:14 +0000 (UTC) Subject: [commit: ghc] master: Typofix in System.Environment docs. (b222ef7) Message-ID: <20160816093814.A371D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b222ef7b9bdb42d5aabf94ce0eafe7808a16af39/ghc >--------------------------------------------------------------- commit b222ef7b9bdb42d5aabf94ce0eafe7808a16af39 Author: Edward Z. Yang Date: Tue Aug 16 02:38:02 2016 -0700 Typofix in System.Environment docs. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- b222ef7b9bdb42d5aabf94ce0eafe7808a16af39 libraries/base/System/Environment.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/base/System/Environment.hs b/libraries/base/System/Environment.hs index b3fbaf8..242845a 100644 --- a/libraries/base/System/Environment.hs +++ b/libraries/base/System/Environment.hs @@ -305,7 +305,7 @@ putEnv keyvalue = do foreign import ccall unsafe "putenv" c_putenv :: CString -> IO CInt #endif --- | @unSet name@ removes the specified environment variable from the +-- | @unsetEnv name@ removes the specified environment variable from the -- environment of the current process. -- -- Throws `Control.Exception.IOException` if @name@ is the empty string or From git at git.haskell.org Tue Aug 16 09:49:36 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 16 Aug 2016 09:49:36 +0000 (UTC) Subject: [commit: ghc] master: Typo in comment (34da8e5) Message-ID: <20160816094936.D8A9D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/34da8e5127d2c65ca219162ae5cd122dd9af5e25/ghc >--------------------------------------------------------------- commit 34da8e5127d2c65ca219162ae5cd122dd9af5e25 Author: Gabor Greif Date: Thu Aug 11 10:14:25 2016 +0200 Typo in comment >--------------------------------------------------------------- 34da8e5127d2c65ca219162ae5cd122dd9af5e25 compiler/typecheck/TcRnTypes.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/typecheck/TcRnTypes.hs b/compiler/typecheck/TcRnTypes.hs index e69e115..02e53af 100644 --- a/compiler/typecheck/TcRnTypes.hs +++ b/compiler/typecheck/TcRnTypes.hs @@ -3163,7 +3163,7 @@ data TcPluginResult = TcPluginContradiction [Ct] -- ^ The plugin found a contradiction. -- The returned constraints are removed from the inert set, - -- and recorded as insoluable. + -- and recorded as insoluble. | TcPluginOk [(EvTerm,Ct)] [Ct] -- ^ The first field is for constraints that were solved. From git at git.haskell.org Wed Aug 17 15:09:26 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 17 Aug 2016 15:09:26 +0000 (UTC) Subject: [commit: ghc] master: Not-in-scope variables are always errors (efc0372) Message-ID: <20160817150926.098C43A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/efc0372a157eadeee58bbada77c64d53590e04af/ghc >--------------------------------------------------------------- commit efc0372a157eadeee58bbada77c64d53590e04af Author: Simon Peyton Jones Date: Wed Aug 17 12:04:30 2016 +0100 Not-in-scope variables are always errors This fixes Trac #12406. A not-in-scope error shoudl be an error even if you have -fdefer-typed-holes. >--------------------------------------------------------------- efc0372a157eadeee58bbada77c64d53590e04af compiler/typecheck/TcErrors.hs | 10 ++++++++-- .../tests/partial-sigs/should_compile/T12156.stderr | 3 +-- testsuite/tests/partial-sigs/should_compile/all.T | 2 +- testsuite/tests/typecheck/should_fail/T12406.hs | 20 ++++++++++++++++++++ testsuite/tests/typecheck/should_fail/T12406.stderr | 12 ++++++++++++ testsuite/tests/typecheck/should_fail/all.T | 1 + 6 files changed, 43 insertions(+), 5 deletions(-) diff --git a/compiler/typecheck/TcErrors.hs b/compiler/typecheck/TcErrors.hs index 1906729..f3f5b12 100644 --- a/compiler/typecheck/TcErrors.hs +++ b/compiler/typecheck/TcErrors.hs @@ -621,9 +621,15 @@ maybeReportHoleError ctxt ct err HoleWarn -> reportWarning (Reason Opt_WarnPartialTypeSignatures) err HoleDefer -> return () - -- Otherwise this is a typed hole in an expression + | isOutOfScopeCt ct + = -- Always report an error for out-of-scope variables + -- See Trac #12170, #12406 + reportError err + + -- Otherwise this is a typed hole in an expression, + -- but not for an out-of-scope variable | otherwise - = -- If deferring, report a warning only if -Wtyped-holds is on + = -- If deferring, report a warning only if -Wtyped-holes is on case cec_expr_holes ctxt of HoleError -> reportError err HoleWarn -> reportWarning (Reason Opt_WarnTypedHoles) err diff --git a/testsuite/tests/partial-sigs/should_compile/T12156.stderr b/testsuite/tests/partial-sigs/should_compile/T12156.stderr index 6508d8a..f1a5b9d 100644 --- a/testsuite/tests/partial-sigs/should_compile/T12156.stderr +++ b/testsuite/tests/partial-sigs/should_compile/T12156.stderr @@ -1,3 +1,2 @@ -T12156.hs:3:14: warning: [-Wtyped-holes (in -Wdefault)] - Variable not in scope: v +T12156.hs:3:14: error: Variable not in scope: v diff --git a/testsuite/tests/partial-sigs/should_compile/all.T b/testsuite/tests/partial-sigs/should_compile/all.T index f4b869c..104c2ad 100644 --- a/testsuite/tests/partial-sigs/should_compile/all.T +++ b/testsuite/tests/partial-sigs/should_compile/all.T @@ -64,4 +64,4 @@ test('SuperCls', normal, compile, ['']) test('T12033', normal, compile, ['']) test('T11339a', normal, compile, ['']) test('T11670', normal, compile, ['']) -test('T12156', normal, compile, ['-fdefer-typed-holes']) +test('T12156', normal, compile_fail, ['-fdefer-typed-holes']) diff --git a/testsuite/tests/typecheck/should_fail/T12406.hs b/testsuite/tests/typecheck/should_fail/T12406.hs new file mode 100644 index 0000000..20264cc --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T12406.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE TypeFamilies #-} +{-# OPTIONS_GHC -fdefer-typed-holes #-} + +module T12406 where + +-- import Control.Monad -- comment this out to cause error +import Data.IORef + +class MonadRef m where + type Ref m :: * -> * + newRef :: a -> m (Ref m a) + readRef :: Ref m a -> m a + +instance MonadRef IO where + type Ref IO = IORef + newRef = newIORef + readRef = readIORef + +foo :: IO () +foo = newRef (pure ()) >>= join . readRef diff --git a/testsuite/tests/typecheck/should_fail/T12406.stderr b/testsuite/tests/typecheck/should_fail/T12406.stderr new file mode 100644 index 0000000..85096e6 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T12406.stderr @@ -0,0 +1,12 @@ + +T12406.hs:20:7: error: + • Couldn't match type ‘Ref m0’ with ‘IORef’ + Expected type: IO (Ref m0 (f0 ())) + Actual type: IO (Ref IO (f0 ())) + The type variable ‘m0’ is ambiguous + • In the first argument of ‘(>>=)’, namely ‘newRef (pure ())’ + In the expression: newRef (pure ()) >>= join . readRef + In an equation for ‘foo’: foo = newRef (pure ()) >>= join . readRef + +T12406.hs:20:28: error: + Variable not in scope: join :: m0 (f0 ()) -> IO () diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T index acc3f9f..b064c56 100644 --- a/testsuite/tests/typecheck/should_fail/all.T +++ b/testsuite/tests/typecheck/should_fail/all.T @@ -424,3 +424,4 @@ test('T11974b', normal, compile_fail, ['']) test('T12151', normal, compile_fail, ['']) test('T7437', normal, compile_fail, ['']) test('T12177', normal, compile_fail, ['']) +test('T12406', normal, compile_fail, ['']) From git at git.haskell.org Wed Aug 17 15:09:28 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 17 Aug 2016 15:09:28 +0000 (UTC) Subject: [commit: ghc] master: Refactor nestImplicTcS (58e7316) Message-ID: <20160817150928.AE4D23A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/58e7316e919abac55bf3ea0213bc92521ec94081/ghc >--------------------------------------------------------------- commit 58e7316e919abac55bf3ea0213bc92521ec94081 Author: Simon Peyton Jones Date: Wed Aug 17 14:38:02 2016 +0100 Refactor nestImplicTcS Simpler code, and simpler to understand. No change in behaviour. >--------------------------------------------------------------- 58e7316e919abac55bf3ea0213bc92521ec94081 compiler/typecheck/TcSMonad.hs | 62 ++++++++++++++++++++++-------------------- 1 file changed, 32 insertions(+), 30 deletions(-) diff --git a/compiler/typecheck/TcSMonad.hs b/compiler/typecheck/TcSMonad.hs index 29837a9..687168b 100644 --- a/compiler/typecheck/TcSMonad.hs +++ b/compiler/typecheck/TcSMonad.hs @@ -2380,8 +2380,11 @@ bumpStepCountTcS = TcS $ \env -> do { let ref = tcs_count env -- | Mark variables as used filling a coercion hole useVars :: TyCoVarSet -> TcS () -useVars vars = TcS $ \env -> do { let ref = tcs_used_tcvs env - ; TcM.updTcRef ref (`unionVarSet` vars) } +useVars vars = TcS $ \env -> useVarsTcM (tcs_used_tcvs env) vars + +-- | Like 'useVars' but in the TcM monad +useVarsTcM :: IORef TyCoVarSet -> TyCoVarSet -> TcM () +useVarsTcM ref vars = TcM.updTcRef ref (`unionVarSet` vars) csTraceTcS :: SDoc -> TcS () csTraceTcS doc @@ -2497,45 +2500,44 @@ nestImplicTcS :: Maybe EvBindsVar -> TyCoVarSet -- bound in this implication -- coercion holes (for redundant-constraint -- tracking) nestImplicTcS m_ref bound_tcvs inner_tclvl (TcS thing_inside) - = do { (res, used_tcvs) <- - TcS $ \ TcSEnv { tcs_unified = unified_var - , tcs_inerts = old_inert_var - , tcs_count = count - , tcs_need_deriveds = solve_deriveds - } -> - do { inerts <- TcM.readTcRef old_inert_var - ; let nest_inert = inerts { inert_flat_cache = emptyExactFunEqs } + = TcS $ \ TcSEnv { tcs_unified = unified_var + , tcs_inerts = old_inert_var + , tcs_count = count + , tcs_used_tcvs = used_var + , tcs_need_deriveds = solve_deriveds + } -> + do { inerts <- TcM.readTcRef old_inert_var + ; let nest_inert = inerts { inert_flat_cache = emptyExactFunEqs } -- See Note [Do not inherit the flat cache] - ; new_inert_var <- TcM.newTcRef nest_inert - ; new_wl_var <- TcM.newTcRef emptyWorkList - ; new_used_var <- TcM.newTcRef emptyVarSet - ; let nest_env = TcSEnv { tcs_ev_binds = m_ref - , tcs_unified = unified_var - , tcs_count = count - , tcs_inerts = new_inert_var - , tcs_worklist = new_wl_var - , tcs_used_tcvs = new_used_var - , tcs_need_deriveds = solve_deriveds } - ; res <- TcM.setTcLevel inner_tclvl $ - thing_inside nest_env + ; new_inert_var <- TcM.newTcRef nest_inert + ; new_wl_var <- TcM.newTcRef emptyWorkList + ; new_used_var <- TcM.newTcRef emptyVarSet + ; let nest_env = TcSEnv { tcs_ev_binds = m_ref + , tcs_unified = unified_var + , tcs_count = count + , tcs_inerts = new_inert_var + , tcs_worklist = new_wl_var + , tcs_used_tcvs = new_used_var + , tcs_need_deriveds = solve_deriveds } + ; res <- TcM.setTcLevel inner_tclvl $ + thing_inside nest_env #ifdef DEBUG - -- Perform a check that the thing_inside did not cause cycles - ; whenIsJust m_ref $ \ ref -> - do { ev_binds <- TcM.getTcEvBinds ref - ; checkForCyclicBinds ev_binds } + -- Perform a check that the thing_inside did not cause cycles + ; whenIsJust m_ref $ \ ref -> + do { ev_binds <- TcM.getTcEvBinds ref + ; checkForCyclicBinds ev_binds } #endif - ; used_tcvs <- TcM.readTcRef new_used_var - ; return (res, used_tcvs) } + ; used_tcvs <- TcM.readTcRef new_used_var ; local_ev_vars <- case m_ref of Nothing -> return emptyVarSet - Just ref -> do { binds <- wrapTcS $ TcM.getTcEvBinds ref + Just ref -> do { binds <- TcM.getTcEvBinds ref ; return $ mkVarSet $ map evBindVar $ bagToList binds } ; let all_locals = bound_tcvs `unionVarSet` local_ev_vars (inner_used_tcvs, outer_used_tcvs) = partitionVarSet (`elemVarSet` all_locals) used_tcvs - ; useVars outer_used_tcvs + ; useVarsTcM used_var outer_used_tcvs ; return (res, inner_used_tcvs) } From git at git.haskell.org Wed Aug 17 15:09:31 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 17 Aug 2016 15:09:31 +0000 (UTC) Subject: [commit: ghc] master: Keep the bindings local during defaultCallStacks (f352e5c) Message-ID: <20160817150931.C7A0E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f352e5cd7bb629fe0ca3b913bfbe7bee43d62f3a/ghc >--------------------------------------------------------------- commit f352e5cd7bb629fe0ca3b913bfbe7bee43d62f3a Author: Simon Peyton Jones Date: Wed Aug 17 14:35:19 2016 +0100 Keep the bindings local during defaultCallStacks defaultCallStacks generates evidence bindings for call stacks, but wasn't setting the binding site correctly. As a result they were simply discarded in the case of pattern synonyms, giving rise to Trac #12489. The fix is easy; and I added an ASSERT to catch the error earlier. >--------------------------------------------------------------- f352e5cd7bb629fe0ca3b913bfbe7bee43d62f3a compiler/typecheck/TcPatSyn.hs | 4 +++- compiler/typecheck/TcSMonad.hs | 6 +++++- compiler/typecheck/TcSimplify.hs | 9 ++++++--- testsuite/tests/patsyn/should_compile/T12489.hs | 5 +++++ testsuite/tests/patsyn/should_compile/all.T | 1 + 5 files changed, 20 insertions(+), 5 deletions(-) diff --git a/compiler/typecheck/TcPatSyn.hs b/compiler/typecheck/TcPatSyn.hs index 171c1ad..81a2029 100644 --- a/compiler/typecheck/TcPatSyn.hs +++ b/compiler/typecheck/TcPatSyn.hs @@ -176,8 +176,10 @@ tcCheckPatSynDecl psb at PSB{ psb_id = lname@(L _ name), psb_args = details -- Solve the constraints now, because we are about to make a PatSyn, -- which should not contain unification variables and the like (Trac #10997) + ; empty_binds <- simplifyTop (mkImplicWC implics) + -- Since all the inputs are implications the returned bindings will be empty - ; _ <- simplifyTop (mkImplicWC implics) + ; MASSERT2( isEmptyBag empty_binds, ppr empty_binds ) -- ToDo: in the bidirectional case, check that the ex_tvs' are all distinct -- Otherwise we may get a type error when typechecking the builder, diff --git a/compiler/typecheck/TcSMonad.hs b/compiler/typecheck/TcSMonad.hs index 4c854c2..29837a9 100644 --- a/compiler/typecheck/TcSMonad.hs +++ b/compiler/typecheck/TcSMonad.hs @@ -16,7 +16,7 @@ module TcSMonad ( TcS, runTcS, runTcSDeriveds, runTcSWithEvBinds, failTcS, warnTcS, addErrTcS, runTcSEqualities, - nestTcS, nestImplicTcS, + nestTcS, nestImplicTcS, setEvBindsTcS, runTcPluginTcS, addUsedGREs, deferTcSForAllEq, @@ -2487,6 +2487,10 @@ checkForCyclicBinds ev_binds -- Note [Deterministic SCC] in Digraph. #endif +setEvBindsTcS :: Maybe EvBindsVar -> TcS a -> TcS a +setEvBindsTcS m_ref (TcS thing_inside) + = TcS $ \ env -> thing_inside (env { tcs_ev_binds = m_ref }) + nestImplicTcS :: Maybe EvBindsVar -> TyCoVarSet -- bound in this implication -> TcLevel -> TcS a -> TcS (a, TyCoVarSet) -- also returns any vars used when filling diff --git a/compiler/typecheck/TcSimplify.hs b/compiler/typecheck/TcSimplify.hs index a2e306d..6ebf9f1 100644 --- a/compiler/typecheck/TcSimplify.hs +++ b/compiler/typecheck/TcSimplify.hs @@ -170,9 +170,12 @@ defaultCallStacks wanteds handle_simples simples = catBagMaybes <$> mapBagM defaultCallStack simples - handle_implic implic = do - wanteds <- defaultCallStacks (ic_wanted implic) - return (implic { ic_wanted = wanteds }) + handle_implic implic + = do { wanteds <- setEvBindsTcS (ic_binds implic) $ + -- defaultCallStack sets a binding, so + -- we must set the correct binding group + defaultCallStacks (ic_wanted implic) + ; return (implic { ic_wanted = wanteds }) } defaultCallStack ct | Just _ <- isCallStackPred (ctPred ct) diff --git a/testsuite/tests/patsyn/should_compile/T12489.hs b/testsuite/tests/patsyn/should_compile/T12489.hs new file mode 100644 index 0000000..205799b --- /dev/null +++ b/testsuite/tests/patsyn/should_compile/T12489.hs @@ -0,0 +1,5 @@ +{-# LANGUAGE PatternSynonyms, ViewPatterns #-} + +module T12489 where +pattern P :: a -> b +pattern P a <- (undefined -> a) diff --git a/testsuite/tests/patsyn/should_compile/all.T b/testsuite/tests/patsyn/should_compile/all.T index 78320c7..7551eb9 100644 --- a/testsuite/tests/patsyn/should_compile/all.T +++ b/testsuite/tests/patsyn/should_compile/all.T @@ -58,3 +58,4 @@ test('T12094', normal, compile, ['']) test('T11977', normal, compile, ['']) test('T12108', normal, compile, ['']) test('T12484', normal, compile, ['']) +test('T12489', normal, compile, ['']) From git at git.haskell.org Wed Aug 17 20:49:15 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 17 Aug 2016 20:49:15 +0000 (UTC) Subject: [commit: ghc] master: Revert "T1969: Enable it again but bump the max residency temporarily" (d610274) Message-ID: <20160817204915.7B6043A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d61027438102e212c47721306d4f294278e95b57/ghc >--------------------------------------------------------------- commit d61027438102e212c47721306d4f294278e95b57 Author: Matthew Pickering Date: Wed Aug 17 21:48:57 2016 +0100 Revert "T1969: Enable it again but bump the max residency temporarily" This reverts commit 773e3aadac4bbee9a0173ebc90ffdc9458a2a3a9. >--------------------------------------------------------------- d61027438102e212c47721306d4f294278e95b57 testsuite/tests/perf/compiler/all.T | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T index 4aff4fb..e9e2493 100644 --- a/testsuite/tests/perf/compiler/all.T +++ b/testsuite/tests/perf/compiler/all.T @@ -28,7 +28,8 @@ setTestOpts(no_lint) # really changed, then you know there's an issue. test('T1969', - [compiler_stats_num_field('peak_megabytes_allocated', # Note [residency] + [expect_broken(12437), + compiler_stats_num_field('peak_megabytes_allocated', # Note [residency] [(wordsize(32), 30, 15), # 2010-05-17 14 (x86/Windows) # 15 (x86/OS X) @@ -64,7 +65,7 @@ test('T1969', # 2014-06-29 5949188 (x86/Linux) # 2015-07-11 6241108 (x86/Linux, 64bit machine) use +RTS -G1 # 2016-04-06 9093608 (x86/Linux, 64bit machine) - (wordsize(64), 15017528, 20)]), + (wordsize(64), 15017528, 15)]), # 2014-09-10 10463640, 10 # post-AMP-update (somewhat stabelish) # looks like the peak is around ~10M, but we're # unlikely to GC exactly on the peak. From git at git.haskell.org Thu Aug 18 13:12:36 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Aug 2016 13:12:36 +0000 (UTC) Subject: [commit: ghc] master: Add gcoerceWith to Data.Type.Coercion (113d50b) Message-ID: <20160818131236.992003A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/113d50b791c469394d38fab6ce5b760e5e8c35e2/ghc >--------------------------------------------------------------- commit 113d50b791c469394d38fab6ce5b760e5e8c35e2 Author: Ryan Scott Date: Thu Aug 18 09:11:03 2016 -0400 Add gcoerceWith to Data.Type.Coercion Summary: For symmetry with `gcastWith` in `Data.Type.Equality`. Fixes #12493. Test Plan: It compiles Reviewers: bgamari, goldfire, hvr, austin Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2456 GHC Trac Issues: #12493 >--------------------------------------------------------------- 113d50b791c469394d38fab6ce5b760e5e8c35e2 docs/users_guide/8.2.1-notes.rst | 3 +++ libraries/base/Data/Type/Coercion.hs | 8 ++++++++ libraries/base/changelog.md | 2 ++ 3 files changed, 13 insertions(+) diff --git a/docs/users_guide/8.2.1-notes.rst b/docs/users_guide/8.2.1-notes.rst index 27b49ef..0126427 100644 --- a/docs/users_guide/8.2.1-notes.rst +++ b/docs/users_guide/8.2.1-notes.rst @@ -100,6 +100,9 @@ See ``changelog.md`` in the ``base`` package for full release notes. - ``Data.Either`` now provides ``fromLeft`` and ``fromRight`` +- ``Data.Type.Coercion`` now provides ``gcoerceWith``, which is analogous to + ``gcastWith`` from ``Data.Type.Equality``. + binary ~~~~~~ diff --git a/libraries/base/Data/Type/Coercion.hs b/libraries/base/Data/Type/Coercion.hs index 254bb9a..318d098 100644 --- a/libraries/base/Data/Type/Coercion.hs +++ b/libraries/base/Data/Type/Coercion.hs @@ -7,6 +7,7 @@ {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE PolyKinds #-} +{-# LANGUAGE RankNTypes #-} ----------------------------------------------------------------------------- -- | @@ -25,6 +26,7 @@ module Data.Type.Coercion ( Coercion(..) , coerceWith + , gcoerceWith , sym , trans , repr @@ -56,6 +58,12 @@ data Coercion a b where coerceWith :: Coercion a b -> a -> b coerceWith Coercion x = coerce x +-- | Generalized form of type-safe cast using representational equality +-- +-- @since 4.10.0.0 +gcoerceWith :: Coercion a b -> (Coercible a b => r) -> r +gcoerceWith Coercion x = x + -- | Symmetry of representational equality sym :: Coercion a b -> Coercion b a sym Coercion = Coercion diff --git a/libraries/base/changelog.md b/libraries/base/changelog.md index 996456f..f8f6b10 100644 --- a/libraries/base/changelog.md +++ b/libraries/base/changelog.md @@ -16,6 +16,8 @@ * `Data.Either` now provides `fromLeft` and `fromRight` (#12402) + * `Data.Type.Coercion` now provides `gcoerceWith` (#12493) + ## 4.9.0.0 *May 2016* * Bundled with GHC 8.0 From git at git.haskell.org Thu Aug 18 13:28:13 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Aug 2016 13:28:13 +0000 (UTC) Subject: [commit: ghc] wip/12368: DmdAnal: Testcase about splitFVs and dmdFix abortion (ccb9cb4) Message-ID: <20160818132813.5217D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/12368 Link : http://ghc.haskell.org/trac/ghc/changeset/ccb9cb4fb0ae2f8bf53a5f18fa6a0ff7d34b22f0/ghc >--------------------------------------------------------------- commit ccb9cb4fb0ae2f8bf53a5f18fa6a0ff7d34b22f0 Author: Joachim Breitner Date: Thu Jul 21 17:44:25 2016 +0200 DmdAnal: Testcase about splitFVs and dmdFix abortion Any variable with useful information (strict or used-once) will not be included in lazy_fv (according to splitFVs). If we now also remove them from the strictness signatures, their uses are not recorded anywhere – and then probably considered absent. >--------------------------------------------------------------- ccb9cb4fb0ae2f8bf53a5f18fa6a0ff7d34b22f0 testsuite/tests/stranal/should_run/T12368a.hs | 27 +++++++++++++++++++++++ testsuite/tests/stranal/should_run/T12368a.stderr | 3 +++ 2 files changed, 30 insertions(+) diff --git a/testsuite/tests/stranal/should_run/T12368a.hs b/testsuite/tests/stranal/should_run/T12368a.hs new file mode 100644 index 0000000..738e8ef --- /dev/null +++ b/testsuite/tests/stranal/should_run/T12368a.hs @@ -0,0 +1,27 @@ +-- Needs to be a product type +data Stream = S Int Stream + +-- a is wrongly recorded abstent if the non-lazy-fv from foo are thrown away. +bar :: Int -> Int -> Stream -> Int +bar a n s = foo n s + where + -- Non terminating local rec, strict in a + foo :: Int -> Stream -> Int + foo 0 (S n s) = a + foo i (S n s) = a `seq` n + foo (i-1) s +{-# NOINLINE bar #-} + + +baz :: Int -> Int -> Int +baz 0 not_absent = 0 +baz 1 not_absent = baz 2 not_absent +baz x not_absent = bar not_absent 1000 arg + where + arg = S 1 arg + +bamf x = baz x (error "This is good!") +{-# NOINLINE bamf #-} + + +main :: IO () +main = bamf 10 `seq` return () diff --git a/testsuite/tests/stranal/should_run/T12368a.stderr b/testsuite/tests/stranal/should_run/T12368a.stderr new file mode 100644 index 0000000..98246d3 --- /dev/null +++ b/testsuite/tests/stranal/should_run/T12368a.stderr @@ -0,0 +1,3 @@ +T12368a: This is good! +CallStack (from HasCallStack): + error, called at T12368a.hs:22:17 in main:Main From git at git.haskell.org Thu Aug 18 13:28:16 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Aug 2016 13:28:16 +0000 (UTC) Subject: [commit: ghc] wip/12368: DmdAnal: Add a final, safe iteration (98da9fa) Message-ID: <20160818132816.0F4C83A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/12368 Link : http://ghc.haskell.org/trac/ghc/changeset/98da9faa633a7faa20c320a7eae8c3f8646c186f/ghc >--------------------------------------------------------------- commit 98da9faa633a7faa20c320a7eae8c3f8646c186f Author: Joachim Breitner Date: Thu Jul 7 11:23:48 2016 +0200 DmdAnal: Add a final, safe iteration this fixes #12368. It also refactors dmdFix a bit, removes some redundancies (such as passing around an strictness signature right next to an id, when that id is guaranteed to have been annotated with that strictness signature). Note that when fixed-point iteration does not terminate, we conservatively delete their strictness signatures (set them to nopSig). But this loses the information on how its strict free variables are used! Lazily used variables already escape via lazy_fvs. We ensure that in the case of an aborted fixed-point iteration, also the strict variables are put there (with a conservative demand of topDmd). Differential Revision: https://phabricator.haskell.org/D2392 >--------------------------------------------------------------- 98da9faa633a7faa20c320a7eae8c3f8646c186f compiler/basicTypes/Demand.hs | 7 +- compiler/basicTypes/VarEnv.hs | 5 +- compiler/stranal/DmdAnal.hs | 188 ++++++++++++++++++------------- compiler/utils/UniqFM.hs | 6 + testsuite/tests/stranal/should_run/all.T | 3 +- 5 files changed, 128 insertions(+), 81 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 98da9faa633a7faa20c320a7eae8c3f8646c186f From git at git.haskell.org Thu Aug 18 13:28:18 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Aug 2016 13:28:18 +0000 (UTC) Subject: [commit: ghc] wip/12368: Comments only: Refer to actually existing Notes (7fd2585) Message-ID: <20160818132818.B2F9E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/12368 Link : http://ghc.haskell.org/trac/ghc/changeset/7fd2585c2a4fe47d8f4e028e672071d2d044f343/ghc >--------------------------------------------------------------- commit 7fd2585c2a4fe47d8f4e028e672071d2d044f343 Author: Joachim Breitner Date: Sun Jul 31 20:59:54 2016 -0400 Comments only: Refer to actually existing Notes >--------------------------------------------------------------- 7fd2585c2a4fe47d8f4e028e672071d2d044f343 compiler/stranal/DmdAnal.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/compiler/stranal/DmdAnal.hs b/compiler/stranal/DmdAnal.hs index c7f0767..44d2d20 100644 --- a/compiler/stranal/DmdAnal.hs +++ b/compiler/stranal/DmdAnal.hs @@ -67,8 +67,9 @@ dmdAnalTopBind sigs (NonRec id rhs) ( _, _, _, rhs1) = dmdAnalRhsLetDown TopLevel Nothing sigs id rhs (sig, _, id2, rhs2) = dmdAnalRhsLetDown TopLevel Nothing (nonVirgin sigs) id rhs1 -- Do two passes to improve CPR information - -- See comments with ignore_cpr_info in mk_sig_ty - -- and with extendSigsWithLam + -- See Note [CPR for thunks] + -- See Note [Optimistic CPR in the "virgin" case] + -- See Note [Initial CPR for strict binders] dmdAnalTopBind sigs (Rec pairs) = (sigs', Rec pairs') From git at git.haskell.org Thu Aug 18 13:28:21 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Aug 2016 13:28:21 +0000 (UTC) Subject: [commit: ghc] wip/12368: Degrade "case scrutinee not known to diverge for sure" Lint error to warning (d9cb266) Message-ID: <20160818132821.626033A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/12368 Link : http://ghc.haskell.org/trac/ghc/changeset/d9cb26677b03f2a3d52182f4a5d77ae9d2197f44/ghc >--------------------------------------------------------------- commit d9cb26677b03f2a3d52182f4a5d77ae9d2197f44 Author: Joachim Breitner Date: Tue Jul 26 11:44:53 2016 +0200 Degrade "case scrutinee not known to diverge for sure" Lint error to warning as proposed in #12435, as it easily gets in the way of development when it reports false positives. >--------------------------------------------------------------- d9cb26677b03f2a3d52182f4a5d77ae9d2197f44 compiler/coreSyn/CoreLint.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/coreSyn/CoreLint.hs b/compiler/coreSyn/CoreLint.hs index 9700522..74f8a61 100644 --- a/compiler/coreSyn/CoreLint.hs +++ b/compiler/coreSyn/CoreLint.hs @@ -715,7 +715,7 @@ lintCoreExpr e@(Case scrut var alt_ty alts) = ; when (null alts) $ do { checkL (not (exprIsHNF scrut)) (text "No alternatives for a case scrutinee in head-normal form:" <+> ppr scrut) - ; checkL scrut_diverges + ; checkWarnL scrut_diverges (text "No alternatives for a case scrutinee not known to diverge for sure:" <+> ppr scrut) } From git at git.haskell.org Thu Aug 18 13:28:24 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Aug 2016 13:28:24 +0000 (UTC) Subject: [commit: ghc] wip/12368: WwLib: Add strictness signature to "let x = absentError …" (6b4f035) Message-ID: <20160818132824.1808E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/12368 Link : http://ghc.haskell.org/trac/ghc/changeset/6b4f0359f5dfa8c357423b07c5ba0345cd185734/ghc >--------------------------------------------------------------- commit 6b4f0359f5dfa8c357423b07c5ba0345cd185734 Author: Joachim Breitner Date: Tue Jul 26 12:08:59 2016 +0200 WwLib: Add strictness signature to "let x = absentError …" indicating that it is bottom. This should help making the "empty cases" lint error give less false alarms. >--------------------------------------------------------------- 6b4f0359f5dfa8c357423b07c5ba0345cd185734 compiler/basicTypes/Demand.hs | 9 ++++++--- compiler/stranal/WwLib.hs | 14 +++++++++----- 2 files changed, 15 insertions(+), 8 deletions(-) diff --git a/compiler/basicTypes/Demand.hs b/compiler/basicTypes/Demand.hs index 2ada6b3..d79fa6e 100644 --- a/compiler/basicTypes/Demand.hs +++ b/compiler/basicTypes/Demand.hs @@ -35,7 +35,8 @@ module Demand ( vanillaCprProdRes, cprSumRes, appIsBottom, isBottomingSig, pprIfaceStrictSig, trimCPRInfo, returnsCPR_maybe, - StrictSig(..), mkStrictSig, mkClosedStrictSig, nopSig, botSig, cprProdSig, + StrictSig(..), mkStrictSig, mkClosedStrictSig, + nopSig, botSig, exnSig, cprProdSig, isTopSig, hasDemandEnvSig, splitStrictSig, strictSigDmdEnv, increaseStrictSigArity, @@ -1264,9 +1265,10 @@ emptyDmdEnv = emptyVarEnv -- (lazy, absent, no CPR information, no termination information). -- Note that it is ''not'' the top of the lattice (which would be "may use everything"), -- so it is (no longer) called topDmd -nopDmdType, botDmdType :: DmdType +nopDmdType, botDmdType, exnDmdType :: DmdType nopDmdType = DmdType emptyDmdEnv [] topRes botDmdType = DmdType emptyDmdEnv [] botRes +exnDmdType = DmdType emptyDmdEnv [] exnRes cprProdDmdType :: Arity -> DmdType cprProdDmdType arity @@ -1691,9 +1693,10 @@ isBottomingSig :: StrictSig -> Bool -- True if the signature diverges or throws an exception isBottomingSig (StrictSig (DmdType _ _ res)) = isBotRes res -nopSig, botSig :: StrictSig +nopSig, botSig, exnSig :: StrictSig nopSig = StrictSig nopDmdType botSig = StrictSig botDmdType +exnSig = StrictSig exnDmdType cprProdSig :: Arity -> StrictSig cprProdSig arity = StrictSig (cprProdDmdType arity) diff --git a/compiler/stranal/WwLib.hs b/compiler/stranal/WwLib.hs index 812252c..5d9d7f6 100644 --- a/compiler/stranal/WwLib.hs +++ b/compiler/stranal/WwLib.hs @@ -709,7 +709,7 @@ every primitive type, so the function is partial. mk_absent_let :: DynFlags -> Id -> Maybe (CoreExpr -> CoreExpr) mk_absent_let dflags arg | not (isUnliftedType arg_ty) - = Just (Let (NonRec arg abs_rhs)) + = Just (Let (NonRec lifted_arg abs_rhs)) | Just tc <- tyConAppTyCon_maybe arg_ty , Just lit <- absentLiteralOf tc = Just (Let (NonRec arg (Lit lit))) @@ -719,10 +719,14 @@ mk_absent_let dflags arg = WARN( True, text "No absent value for" <+> ppr arg_ty ) Nothing where - arg_ty = idType arg - abs_rhs = mkRuntimeErrorApp aBSENT_ERROR_ID arg_ty msg - msg = showSDoc (gopt_set dflags Opt_SuppressUniques) - (ppr arg <+> ppr (idType arg)) + arg_ty = idType arg + abs_rhs = mkRuntimeErrorApp aBSENT_ERROR_ID arg_ty msg + lifted_arg = arg `setIdStrictness` exnSig + -- Note in strictness signature that this is bottoming + -- (for the sake of the "empty case scrutinee not known to + -- diverge for sure lint" warning + msg = showSDoc (gopt_set dflags Opt_SuppressUniques) + (ppr arg <+> ppr (idType arg)) -- We need to suppress uniques here because otherwise they'd -- end up in the generated code as strings. This is bad for -- determinism, because with different uniques the strings From git at git.haskell.org Thu Aug 18 13:28:26 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 18 Aug 2016 13:28:26 +0000 (UTC) Subject: [commit: ghc] wip/12368's head updated: WwLib: Add strictness signature to "let x = absentError …" (6b4f035) Message-ID: <20160818132826.983103A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/12368' now includes: 7a8ef01 Remove `setUnfoldingInfoLazily` a13fda7 Clarify comment on makeCorePair d85b26d CmmLive: Remove some redundant exports 8ecac25 CmmLayoutStack: Minor simplification fc66415 Replace an unsafeCoerce with coerce db5a226 Fix omission in haddock instance head 1101045 Trim all spaces after 'version:' fe4008f Remove identity update of field componentsConfigs f09d654 check that the number of parallel build is greater than 0 e3e2e49 codeGen: Remove binutils<2.17 hack, fixes T11758 ca7e1ad Expanded abbreviations in Haddock documentation ce13a9a Fix an assertion that could randomly fail 89fa4e9 Another try to get thread migration right 8fe1672 Bump `hoopl` submodule, mostly cosmetics 253fc38 Temporarily mark T1969 perf test as broken (#12437) 7354f93 StgCmm: Remove unused Bool field of Return sequel 02614fd Replace some `length . filter` with `count` 9aa5d87 Util.count: Implement as a left-fold instead of a right-fold affcec7 rts/Printer.h: fix constness of argument declaration 03af399 AsmCodeGen: Give linear-scan and coloring reg. allocators different cc names 3bfe6a5 RegAlloc: Remove duplicate seqList (use seqList from Util) bd51064 RegAlloc: Use IntSet/IntMaps instead of generic Set/Maps 7a2e933 Use Data.Functor.Const to implement Data.Data internals 6fe2355 configure.ac: Remove checks for bug 9439 773e3aa T1969: Enable it again but bump the max residency temporarily 4d9c22d Fix typo in Data.Bitraversable Haddocks fe19be2 Cabal submodule update. dd23a4c Actually update haddock.Cabal stats. e79bb2c Fix a bug in unboxed sum layout generation 9684dbb Remove StgRubbishArg and CmmArg ac0e112 Improve missing-sig warning bd0c310 Fix GHCi perf-llvm build on x86_64 37a7bcb Update `nofib` submodule to newest commit 7ad3b49 Misspellings in comments [skip ci] 18f0687 Fix configure detection. ffd4029 fix compilation failure on OpenBSD with system supplied GNU C 4.2.1 fc1432a Update hoopl submodule (extra .gitignore entry) 3551e62 refactor test for __builtin_unreachable into Rts.h macro RTS_UNREACHABLE da99a7f Darwin: Detect broken NM program at configure time f9a11a2 When in sanity mode, un-zero malloc'd memory; fix uninitialized memory bugs. d331ace Minor typofix. b222ef7 Typofix in System.Environment docs. 34da8e5 Typo in comment efc0372 Not-in-scope variables are always errors f352e5c Keep the bindings local during defaultCallStacks 58e7316 Refactor nestImplicTcS d610274 Revert "T1969: Enable it again but bump the max residency temporarily" 113d50b Add gcoerceWith to Data.Type.Coercion 7fd2585 Comments only: Refer to actually existing Notes 98da9fa DmdAnal: Add a final, safe iteration ccb9cb4 DmdAnal: Testcase about splitFVs and dmdFix abortion d9cb266 Degrade "case scrutinee not known to diverge for sure" Lint error to warning 6b4f035 WwLib: Add strictness signature to "let x = absentError …" From git at git.haskell.org Fri Aug 19 08:01:28 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 19 Aug 2016 08:01:28 +0000 (UTC) Subject: [commit: ghc] master: Revert "codeGen: Remove binutils<2.17 hack, fixes T11758" (b2c5e4c) Message-ID: <20160819080128.DFAFA3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b2c5e4ce5c44a7be7c2b81c2600cae40c5b225ad/ghc >--------------------------------------------------------------- commit b2c5e4ce5c44a7be7c2b81c2600cae40c5b225ad Author: Simon Peyton Jones Date: Thu Aug 18 18:16:01 2016 +0100 Revert "codeGen: Remove binutils<2.17 hack, fixes T11758" This reverts commit e3e2e49a8f6952e1c8a19321c729c17b294d8c92. I'm reverting because it makes ghc-stage2 seg-fault on 64-bit Windows machines. Even ghc-stage2 --version seg-faults. >--------------------------------------------------------------- b2c5e4ce5c44a7be7c2b81c2600cae40c5b225ad compiler/nativeGen/X86/CodeGen.hs | 15 ++++++++++++++- compiler/nativeGen/X86/Ppr.hs | 23 +++++++++++++++++++++-- includes/rts/storage/InfoTables.h | 11 +++++++++++ 3 files changed, 46 insertions(+), 3 deletions(-) diff --git a/compiler/nativeGen/X86/CodeGen.hs b/compiler/nativeGen/X86/CodeGen.hs index 2bfcd9a..cd45d92 100644 --- a/compiler/nativeGen/X86/CodeGen.hs +++ b/compiler/nativeGen/X86/CodeGen.hs @@ -2624,10 +2624,23 @@ genSwitch dflags expr targets let op = OpAddr (AddrBaseIndex (EABaseReg tableReg) (EAIndex reg (wORD_SIZE dflags)) (ImmInt 0)) - return $ e_code `appOL` t_code `appOL` toOL [ + return $ if is32bit || os == OSDarwin + then e_code `appOL` t_code `appOL` toOL [ ADD (intFormat (wordWidth dflags)) op (OpReg tableReg), JMP_TBL (OpReg tableReg) ids rosection lbl ] + else -- HACK: On x86_64 binutils<2.17 is only able to generate + -- PC32 relocations, hence we only get 32-bit offsets in + -- the jump table. As these offsets are always negative + -- we need to properly sign extend them to 64-bit. This + -- hack should be removed in conjunction with the hack in + -- PprMach.hs/pprDataItem once binutils 2.17 is standard. + e_code `appOL` t_code `appOL` toOL [ + MOVSxL II32 op (OpReg reg), + ADD (intFormat (wordWidth dflags)) (OpReg reg) + (OpReg tableReg), + JMP_TBL (OpReg tableReg) ids rosection lbl + ] | otherwise = do (reg,e_code) <- getSomeReg (cmmOffset dflags expr offset) diff --git a/compiler/nativeGen/X86/Ppr.hs b/compiler/nativeGen/X86/Ppr.hs index 090ff53..7809ae1 100644 --- a/compiler/nativeGen/X86/Ppr.hs +++ b/compiler/nativeGen/X86/Ppr.hs @@ -454,8 +454,27 @@ pprDataItem' dflags lit _ -> panic "X86.Ppr.ppr_item: no match for II64" | otherwise -> [text "\t.quad\t" <> pprImm imm] - - _ -> [text "\t.quad\t" <> pprImm imm] + _ + | target32Bit platform -> + [text "\t.quad\t" <> pprImm imm] + | otherwise -> + -- x86_64: binutils can't handle the R_X86_64_PC64 + -- relocation type, which means we can't do + -- pc-relative 64-bit addresses. Fortunately we're + -- assuming the small memory model, in which all such + -- offsets will fit into 32 bits, so we have to stick + -- to 32-bit offset fields and modify the RTS + -- appropriately + -- + -- See Note [x86-64-relative] in includes/rts/storage/InfoTables.h + -- + case lit of + -- A relative relocation: + CmmLabelDiffOff _ _ _ -> + [text "\t.long\t" <> pprImm imm, + text "\t.long\t0"] + _ -> + [text "\t.quad\t" <> pprImm imm] ppr_item _ _ = panic "X86.Ppr.ppr_item: no match" diff --git a/includes/rts/storage/InfoTables.h b/includes/rts/storage/InfoTables.h index e6bd15c..fb14ac5 100644 --- a/includes/rts/storage/InfoTables.h +++ b/includes/rts/storage/InfoTables.h @@ -15,6 +15,17 @@ Several pointer fields in info tables are expressed as offsets relative to the info pointer, so that we can generate position-independent code. + + Note [x86-64-relative] + There is a complication on the x86_64 platform, where pointers are + 64 bits, but the tools don't support 64-bit relative relocations. + However, the default memory model (small) ensures that all symbols + have values in the lower 2Gb of the address space, so offsets all + fit in 32 bits. Hence we can use 32-bit offset fields. + + Somewhere between binutils-2.16.1 and binutils-2.16.91.0.6, + support for 64-bit PC-relative relocations was added, so maybe this + hackery can go away sometime. ------------------------------------------------------------------------- */ #if x86_64_TARGET_ARCH From git at git.haskell.org Sun Aug 21 09:46:24 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 21 Aug 2016 09:46:24 +0000 (UTC) Subject: [commit: ghc] master: Axe initIfaceTc, tie the knot through HPT (or if_rec_types). (e907e1f) Message-ID: <20160821094624.3C4603A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e907e1f12f4dedc0ec13c7a501c8810bcfc03583/ghc >--------------------------------------------------------------- commit e907e1f12f4dedc0ec13c7a501c8810bcfc03583 Author: Edward Z. Yang Date: Sun Jun 19 14:28:55 2016 -0700 Axe initIfaceTc, tie the knot through HPT (or if_rec_types). Summary: initIfaceTc was originally used to make sure when we typecheck an interface, it can find the TyThings for things it itself defined. However, in the case of retypecheckLoop, this wasn't necessary because we ALREADY tied the knot through the HPT. This commit removes initIfaceTc, instead relying on the HPT to tie the knot. genModDetails' caller needed to be modified to tie the knot, but there are not that many call-sites of typecheckIface so the change is quite reasonable. We also introduce a new 'initIfaceLoad', which does NOT set up 'if_rec_types'. It's used when we're typechecking old, up-to-date interfaces in, since we're never going to update the type environment. The full details are in Note [Knot-tying typecheckIface]. Displeasingly, we need a special case to handle DFuns in the case of tcHiBootIface, see Note [DFun knot-tying special case] for the gory details. I also added another test which tickles a bug in a buggy version of this patch (see "Why the seq?") Signed-off-by: Edward Z. Yang Test Plan: validate Reviewers: simonpj, austin, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2349 >--------------------------------------------------------------- e907e1f12f4dedc0ec13c7a501c8810bcfc03583 compiler/iface/TcIface.hs | 68 ++++++++++++++------ compiler/main/HscMain.hs | 34 +++++++--- compiler/main/HscTypes.hs | 45 +++++++++++++- compiler/typecheck/TcRnDriver.hs | 72 ++++++++++++++++++---- compiler/typecheck/TcRnMonad.hs | 32 ++++------ compiler/typecheck/TcRnTypes.hs | 1 + testsuite/driver/extra_files.py | 1 + testsuite/tests/typecheck/should_compile/Makefile | 6 ++ testsuite/tests/typecheck/should_compile/Tc266.hs | 4 ++ .../tests/typecheck/should_compile/Tc266.hs-boot | 3 + testsuite/tests/typecheck/should_compile/Tc266a.hs | 2 + testsuite/tests/typecheck/should_compile/all.T | 4 ++ 12 files changed, 214 insertions(+), 58 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 e907e1f12f4dedc0ec13c7a501c8810bcfc03583 From git at git.haskell.org Sun Aug 21 09:46:26 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 21 Aug 2016 09:46:26 +0000 (UTC) Subject: [commit: ghc] master: Fix #12472 by looking for noinline/lazy inside oversaturated applications. (0d3bf62) Message-ID: <20160821094626.E58253A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/0d3bf62092de83375025edca6f7242812338542d/ghc >--------------------------------------------------------------- commit 0d3bf62092de83375025edca6f7242812338542d Author: Edward Z. Yang Date: Sat Aug 6 13:47:05 2016 -0700 Fix #12472 by looking for noinline/lazy inside oversaturated applications. Signed-off-by: Edward Z. Yang Test Plan: validate Reviewers: simonpj, austin, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2444 GHC Trac Issues: #12472 >--------------------------------------------------------------- 0d3bf62092de83375025edca6f7242812338542d compiler/coreSyn/CorePrep.hs | 188 +++++++++++---------- .../simplCore/should_compile/noinline01.stderr | 31 +++- 2 files changed, 128 insertions(+), 91 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 0d3bf62092de83375025edca6f7242812338542d From git at git.haskell.org Sun Aug 21 09:46:29 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 21 Aug 2016 09:46:29 +0000 (UTC) Subject: [commit: ghc] master: Introduce BootUnfolding, set when unfolding is absent due to hs-boot file. (1f1bd92) Message-ID: <20160821094629.A71153A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1f1bd920047fa083de29eba7cedafbe37d350b73/ghc >--------------------------------------------------------------- commit 1f1bd920047fa083de29eba7cedafbe37d350b73 Author: Edward Z. Yang Date: Thu May 12 12:47:16 2016 -0700 Introduce BootUnfolding, set when unfolding is absent due to hs-boot file. Signed-off-by: Edward Z. Yang Test Plan: validate Reviewers: simonpj, austin, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2246 >--------------------------------------------------------------- 1f1bd920047fa083de29eba7cedafbe37d350b73 compiler/coreSyn/CoreSyn.hs | 22 ++++++++++++++++++---- compiler/coreSyn/CoreUnfold.hs | 1 + compiler/coreSyn/CoreUtils.hs | 1 + compiler/coreSyn/PprCore.hs | 1 + compiler/deSugar/DsMonad.hs | 1 + compiler/iface/LoadIface.hs | 2 +- compiler/iface/TcIface.hs | 20 +++++++++++--------- compiler/main/TidyPgm.hs | 5 +++-- compiler/simplCore/Simplify.hs | 1 + compiler/specialise/Specialise.hs | 1 + compiler/typecheck/TcRnMonad.hs | 12 +++++++----- compiler/typecheck/TcRnTypes.hs | 5 +++++ compiler/vectorise/Vectorise/Exp.hs | 1 + 13 files changed, 52 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 1f1bd920047fa083de29eba7cedafbe37d350b73 From git at git.haskell.org Sun Aug 21 09:46:33 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 21 Aug 2016 09:46:33 +0000 (UTC) Subject: [commit: ghc] master: Support for noinline magic function. (704913c) Message-ID: <20160821094633.417AD3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/704913cf79c7dbf9bf622fb3cfe476edd478b5a2/ghc >--------------------------------------------------------------- commit 704913cf79c7dbf9bf622fb3cfe476edd478b5a2 Author: Edward Z. Yang Date: Thu May 12 19:38:57 2016 -0700 Support for noinline magic function. Signed-off-by: Edward Z. Yang Test Plan: validate Reviewers: simonpj, austin, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2209 >--------------------------------------------------------------- 704913cf79c7dbf9bf622fb3cfe476edd478b5a2 compiler/basicTypes/MkId.hs | 32 ++++++++++++++++++++-- compiler/coreSyn/CorePrep.hs | 4 ++- compiler/prelude/PrelNames.hs | 5 +++- docs/users_guide/8.2.1-notes.rst | 3 ++ libraries/ghc-prim/GHC/Magic.hs | 9 +++++- testsuite/tests/simplCore/should_compile/all.T | 2 ++ .../tests/simplCore/should_compile/noinline01.hs | 7 +++++ .../simplCore/should_compile/noinline01.stderr | 29 ++++++++++++++++++++ 8 files changed, 85 insertions(+), 6 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 704913cf79c7dbf9bf622fb3cfe476edd478b5a2 From git at git.haskell.org Sun Aug 21 09:46:35 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 21 Aug 2016 09:46:35 +0000 (UTC) Subject: [commit: ghc] master: Annotate initIfaceCheck with usage information. (896d216) Message-ID: <20160821094635.F1B9F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/896d216d47cf185d071e0388acbbaef10abada88/ghc >--------------------------------------------------------------- commit 896d216d47cf185d071e0388acbbaef10abada88 Author: Edward Z. Yang Date: Sun Jun 19 22:31:06 2016 -0700 Annotate initIfaceCheck with usage information. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- 896d216d47cf185d071e0388acbbaef10abada88 compiler/ghci/Linker.hs | 2 +- compiler/iface/MkIface.hs | 2 +- compiler/main/GhcMake.hs | 2 +- compiler/main/HscMain.hs | 2 +- compiler/typecheck/TcRnMonad.hs | 6 +++--- ghc/Main.hs | 2 +- 6 files changed, 8 insertions(+), 8 deletions(-) diff --git a/compiler/ghci/Linker.hs b/compiler/ghci/Linker.hs index f018a2e..251d9a8 100644 --- a/compiler/ghci/Linker.hs +++ b/compiler/ghci/Linker.hs @@ -610,7 +610,7 @@ getLinkDeps hsc_env hpt pls replace_osuf span mods = return (uniqDSetToList acc_mods, uniqDSetToList acc_pkgs) follow_deps (mod:mods) acc_mods acc_pkgs = do - mb_iface <- initIfaceCheck hsc_env $ + mb_iface <- initIfaceCheck (text "getLinkDeps") hsc_env $ loadInterface msg mod (ImportByUser False) iface <- case mb_iface of Maybes.Failed err -> throwGhcExceptionIO (ProgramError (showSDoc dflags err)) diff --git a/compiler/iface/MkIface.hs b/compiler/iface/MkIface.hs index edab350..e78975b 100644 --- a/compiler/iface/MkIface.hs +++ b/compiler/iface/MkIface.hs @@ -952,7 +952,7 @@ checkOldIface hsc_env mod_summary source_modified maybe_iface showPass dflags $ "Checking old interface for " ++ (showPpr dflags $ ms_mod mod_summary) - initIfaceCheck hsc_env $ + initIfaceCheck (text "checkOldIface") hsc_env $ check_old_iface hsc_env mod_summary source_modified maybe_iface check_old_iface diff --git a/compiler/main/GhcMake.hs b/compiler/main/GhcMake.hs index 93f1cd4..7f7773c 100644 --- a/compiler/main/GhcMake.hs +++ b/compiler/main/GhcMake.hs @@ -1422,7 +1422,7 @@ typecheckLoop dflags hsc_env mods = do new_hpt <- fixIO $ \new_hpt -> do let new_hsc_env = hsc_env{ hsc_HPT = new_hpt } - mds <- initIfaceCheck new_hsc_env $ + mds <- initIfaceCheck (text "typecheckLoop") new_hsc_env $ mapM (typecheckIface . hm_iface) hmis let new_hpt = addListToHpt old_hpt (zip mods [ hmi{ hm_details = details } diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs index 94ab42e..9e4142b 100644 --- a/compiler/main/HscMain.hs +++ b/compiler/main/HscMain.hs @@ -739,7 +739,7 @@ genModDetails :: HscEnv -> ModIface -> IO ModDetails genModDetails hsc_env old_iface = do new_details <- {-# SCC "tcRnIface" #-} - initIfaceCheck hsc_env (typecheckIface old_iface) + initIfaceCheck (text "genModDetails") hsc_env (typecheckIface old_iface) dumpIfaceStats hsc_env return new_details diff --git a/compiler/typecheck/TcRnMonad.hs b/compiler/typecheck/TcRnMonad.hs index e8513d3..2e89852 100644 --- a/compiler/typecheck/TcRnMonad.hs +++ b/compiler/typecheck/TcRnMonad.hs @@ -1619,15 +1619,15 @@ initIfaceTcRn thing_inside ; get_type_env = readTcRef (tcg_type_env_var tcg_env) } ; setEnvs (if_env, ()) thing_inside } -initIfaceCheck :: HscEnv -> IfG a -> IO a +initIfaceCheck :: SDoc -> HscEnv -> IfG a -> IO a -- Used when checking the up-to-date-ness of the old Iface -- Initialise the environment with no useful info at all -initIfaceCheck hsc_env do_this +initIfaceCheck doc hsc_env do_this = do let rec_types = case hsc_type_env_var hsc_env of Just (mod,var) -> Just (mod, readTcRef var) Nothing -> Nothing gbl_env = IfGblEnv { - if_doc = text "initIfaceCheck", + if_doc = text "initIfaceCheck" <+> doc, if_rec_types = rec_types } initTcRnIf 'i' hsc_env gbl_env () do_this diff --git a/ghc/Main.hs b/ghc/Main.hs index 4870ce4..aa5f83f 100644 --- a/ghc/Main.hs +++ b/ghc/Main.hs @@ -891,7 +891,7 @@ abiHash strs = do mods <- mapM find_it strs let get_iface modl = loadUserInterface False (text "abiHash") modl - ifaces <- initIfaceCheck hsc_env $ mapM get_iface mods + ifaces <- initIfaceCheck (text "abiHash") hsc_env $ mapM get_iface mods bh <- openBinMem (3*1024) -- just less than a block put_ bh hiVersion From git at git.haskell.org Sun Aug 21 09:46:39 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 21 Aug 2016 09:46:39 +0000 (UTC) Subject: [commit: ghc] master: Retypecheck both before and after finishing hs-boot loops in --make. (8fd1848) Message-ID: <20160821094639.790D33A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8fd184887e7c240c7089367c6f737fa66cf409fc/ghc >--------------------------------------------------------------- commit 8fd184887e7c240c7089367c6f737fa66cf409fc Author: Edward Z. Yang Date: Fri May 13 00:10:47 2016 -0700 Retypecheck both before and after finishing hs-boot loops in --make. Summary: This makes ghc --make's retypecheck behavior more in line with ghc -c, which is able to tie the knot as we are typechecking. Signed-off-by: Edward Z. Yang Test Plan: validate Reviewers: simonpj, austin, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2213 GHC Trac Issues: #12035 >--------------------------------------------------------------- 8fd184887e7c240c7089367c6f737fa66cf409fc compiler/main/GhcMake.hs | 34 +++++++++++++++++----- compiler/main/HscMain.hs | 5 +++- testsuite/tests/typecheck/should_fail/T12035.hs | 10 +++++++ .../tests/typecheck/should_fail/T12035.hs-boot | 2 ++ .../tests/typecheck/should_fail/T12035.stderr | 6 ++++ testsuite/tests/typecheck/should_fail/T12035a.hs | 4 +++ testsuite/tests/typecheck/should_fail/all.T | 2 ++ 7 files changed, 55 insertions(+), 8 deletions(-) diff --git a/compiler/main/GhcMake.hs b/compiler/main/GhcMake.hs index 7f7773c..1130d6f 100644 --- a/compiler/main/GhcMake.hs +++ b/compiler/main/GhcMake.hs @@ -57,6 +57,7 @@ import SysTools import UniqFM import Util import qualified GHC.LanguageExtensions as LangExt +import NameEnv import Data.Either ( rights, partitionEithers ) import qualified Data.Map as Map @@ -1139,10 +1140,23 @@ upsweep old_hpt stable_mods cleanup sccs = do -- Remove unwanted tmp files between compilations liftIO (cleanup hsc_env) + -- Get ready to tie the knot + type_env_var <- liftIO $ newIORef emptyNameEnv + let hsc_env1 = hsc_env { hsc_type_env_var = + Just (ms_mod mod, type_env_var) } + setSession hsc_env1 + + -- Lazily reload the HPT modules participating in the loop. + -- See Note [Tying the knot]--if we don't throw out the old HPT + -- and reinitalize the knot-tying process, anything that was forced + -- while we were previously typechecking won't get updated. + hsc_env2 <- liftIO $ reTypecheckLoop hsc_env1 mod done + setSession hsc_env2 + mb_mod_info <- handleSourceError (\err -> do logger mod (Just err); return Nothing) $ do - mod_info <- liftIO $ upsweep_mod hsc_env old_hpt stable_mods + mod_info <- liftIO $ upsweep_mod hsc_env2 old_hpt stable_mods mod mod_index nmods logger mod Nothing -- log warnings return (Just mod_info) @@ -1153,8 +1167,8 @@ upsweep old_hpt stable_mods cleanup sccs = do let this_mod = ms_mod_name mod -- Add new info to hsc_env - hpt1 = addToHpt (hsc_HPT hsc_env) this_mod mod_info - hsc_env1 = hsc_env { hsc_HPT = hpt1 } + hpt1 = addToHpt (hsc_HPT hsc_env2) this_mod mod_info + hsc_env3 = hsc_env2 { hsc_HPT = hpt1, hsc_type_env_var = Nothing } -- Space-saving: delete the old HPT entry -- for mod BUT if mod is a hs-boot @@ -1169,9 +1183,12 @@ upsweep old_hpt stable_mods cleanup sccs = do done' = mod:done -- fixup our HomePackageTable after we've finished compiling - -- a mutually-recursive loop. See reTypecheckLoop, below. - hsc_env2 <- liftIO $ reTypecheckLoop hsc_env1 mod done' - setSession hsc_env2 + -- a mutually-recursive loop. We have to do this again + -- to make sure we have the final unfoldings, which may + -- not have been computed accurately in the previous + -- retypecheck. + hsc_env4 <- liftIO $ reTypecheckLoop hsc_env3 mod done' + setSession hsc_env4 upsweep' old_hpt1 done' mods (mod_index+1) nmods @@ -1399,7 +1416,10 @@ Following this fix, GHC can compile itself with --make -O2. reTypecheckLoop :: HscEnv -> ModSummary -> ModuleGraph -> IO HscEnv reTypecheckLoop hsc_env ms graph | Just loop <- getModLoop ms graph - , let non_boot = filter (not.isBootSummary) loop + -- SOME hs-boot files should still + -- get used, just not the loop-closer. + , let non_boot = filter (\l -> not (isBootSummary l && + ms_mod l == ms_mod ms)) loop = typecheckLoop (hsc_dflags hsc_env) hsc_env (map ms_mod_name non_boot) | otherwise = return hsc_env diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs index 1d0758e..5e14e77 100644 --- a/compiler/main/HscMain.hs +++ b/compiler/main/HscMain.hs @@ -649,7 +649,10 @@ hscIncrementalCompile always_do_basic_recompilation_check m_tc_result -- See also Note [hsc_type_env_var hack] type_env_var <- newIORef emptyNameEnv let mod = ms_mod mod_summary - hsc_env = hsc_env'{ hsc_type_env_var = Just (mod, type_env_var) } + hsc_env | isOneShot (ghcMode (hsc_dflags hsc_env')) + = hsc_env' { hsc_type_env_var = Just (mod, type_env_var) } + | otherwise + = hsc_env' -- NB: enter Hsc monad here so that we don't bail out early with -- -Werror on typechecker warnings; we also want to run the desugarer diff --git a/testsuite/tests/typecheck/should_fail/T12035.hs b/testsuite/tests/typecheck/should_fail/T12035.hs new file mode 100644 index 0000000..87e20ff --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T12035.hs @@ -0,0 +1,10 @@ +module T12035 where +import T12035a +type T = Bool +y = f True + +-- This should error that 'type T = Int' doesn't match 'data T', +-- NOT that f expects argument of type T but got Bool. +-- +-- NB: This test will start passing if we allow abstract data +-- types to be implemented using type synonyms. diff --git a/testsuite/tests/typecheck/should_fail/T12035.hs-boot b/testsuite/tests/typecheck/should_fail/T12035.hs-boot new file mode 100644 index 0000000..1eb9094 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T12035.hs-boot @@ -0,0 +1,2 @@ +module T12035 where +data T diff --git a/testsuite/tests/typecheck/should_fail/T12035.stderr b/testsuite/tests/typecheck/should_fail/T12035.stderr new file mode 100644 index 0000000..7086785 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T12035.stderr @@ -0,0 +1,6 @@ + +T12035.hs-boot:2:1: error: + Type constructor ‘T’ has conflicting definitions in the module + and its hs-boot file + Main module: type T = Bool + Boot file: abstract T diff --git a/testsuite/tests/typecheck/should_fail/T12035a.hs b/testsuite/tests/typecheck/should_fail/T12035a.hs new file mode 100644 index 0000000..37d6bc0 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T12035a.hs @@ -0,0 +1,4 @@ +module T12035a where +import {-# SOURCE #-} T12035 +f :: T -> T +f x = x diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T index b064c56..37d74c6 100644 --- a/testsuite/tests/typecheck/should_fail/all.T +++ b/testsuite/tests/typecheck/should_fail/all.T @@ -418,6 +418,8 @@ test('T11947a', normal, compile_fail, ['']) test('T11948', normal, compile_fail, ['']) test('T11990a', normal, compile_fail, ['']) test('T11990b', normal, compile_fail, ['']) +test('T12035', extra_clean(['T12035.hi-boot', 'T12035.o-boot', 'T12035a.hi', 'T12035a.o']), + multimod_compile_fail, ['T12035', '-v0']) test('T12063', [ expect_broken(12063), extra_clean(['T12063.hi-boot', 'T12063.o-boot', 'T12063a.hi', 'T12063a.o']) ], multimod_compile_fail, ['T12063', '-v0']) test('T11974b', normal, compile_fail, ['']) From git at git.haskell.org Sun Aug 21 09:46:42 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 21 Aug 2016 09:46:42 +0000 (UTC) Subject: [commit: ghc] master: When a value Id comes from hi-boot, insert noinline. Fixes #10083. (5a8fa2e) Message-ID: <20160821094642.320C53A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5a8fa2e662fce9ef03f0ec7891d7f81740e630bc/ghc >--------------------------------------------------------------- commit 5a8fa2e662fce9ef03f0ec7891d7f81740e630bc Author: Edward Z. Yang Date: Thu May 12 20:33:43 2016 -0700 When a value Id comes from hi-boot, insert noinline. Fixes #10083. Summary: This also drops the parked fix from efa7b3a474bc373201ab145c129262a73c86f959 (though I didn't revert the refactoring). Signed-off-by: Edward Z. Yang Test Plan: validate Reviewers: simonpj, austin, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2211 GHC Trac Issues: #10083 >--------------------------------------------------------------- 5a8fa2e662fce9ef03f0ec7891d7f81740e630bc compiler/coreSyn/CoreSyn.hs | 2 + compiler/iface/MkIface.hs | 76 ++++++++++++++++++++++++++ compiler/typecheck/TcBinds.hs | 59 -------------------- testsuite/tests/perf/compiler/all.T | 12 +++- testsuite/tests/simplCore/should_compile/all.T | 2 +- 5 files changed, 89 insertions(+), 62 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 5a8fa2e662fce9ef03f0ec7891d7f81740e630bc From git at git.haskell.org Sun Aug 21 09:46:45 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 21 Aug 2016 09:46:45 +0000 (UTC) Subject: [commit: ghc] master: We also need to retypecheck before when we do parallel make. (e528061) Message-ID: <20160821094645.58A413A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e528061e2779ce475927f44d817eaf15a02cbac7/ghc >--------------------------------------------------------------- commit e528061e2779ce475927f44d817eaf15a02cbac7 Author: Edward Z. Yang Date: Fri May 13 19:32:37 2016 -0700 We also need to retypecheck before when we do parallel make. Summary: Kept this seperate from the previous patch for clarity. Comes with a test. Signed-off-by: Edward Z. Yang Test Plan: validate Reviewers: simonpj, austin, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2220 GHC Trac Issues: #12035 >--------------------------------------------------------------- e528061e2779ce475927f44d817eaf15a02cbac7 compiler/main/GhcMake.hs | 13 +++++++++++-- testsuite/driver/extra_files.py | 1 + .../typecheck/should_fail/{T12035.stderr => T12035j.stderr} | 2 +- testsuite/tests/typecheck/should_fail/all.T | 2 ++ 4 files changed, 15 insertions(+), 3 deletions(-) diff --git a/compiler/main/GhcMake.hs b/compiler/main/GhcMake.hs index 1130d6f..d67a120 100644 --- a/compiler/main/GhcMake.hs +++ b/compiler/main/GhcMake.hs @@ -1048,9 +1048,18 @@ parUpsweep_one mod home_mod_map comp_graph_loops lcl_dflags cleanup par_sem let lcl_mod = localize_mod mod let lcl_hsc_env = localize_hsc_env hsc_env + -- Re-typecheck the loop + type_env_var <- liftIO $ newIORef emptyNameEnv + let lcl_hsc_env' = lcl_hsc_env { hsc_type_env_var = + Just (ms_mod lcl_mod, type_env_var) } + lcl_hsc_env'' <- case finish_loop of + Nothing -> return lcl_hsc_env' + Just loop -> typecheckLoop lcl_dflags lcl_hsc_env' $ + map (moduleName . fst) loop + -- Compile the module. - mod_info <- upsweep_mod lcl_hsc_env old_hpt stable_mods lcl_mod - mod_index num_mods + mod_info <- upsweep_mod lcl_hsc_env'' old_hpt stable_mods + lcl_mod mod_index num_mods return (Just mod_info) case mb_mod_info of diff --git a/testsuite/driver/extra_files.py b/testsuite/driver/extra_files.py index 49cf901..acf4802 100644 --- a/testsuite/driver/extra_files.py +++ b/testsuite/driver/extra_files.py @@ -83,6 +83,7 @@ extra_src_files = { 'T11824': ['TyCon.hs', 'Type.hs', 'Type.hs-boot', 'Unbound/'], 'T11827': ['A.hs', 'A.hs-boot', 'B.hs'], 'T12062': ['A.hs', 'A.hs-boot', 'C.hs'], + 'T12035j': ['T12035.hs', 'T12035a.hs', 'T12035.hs-boot'], 'T1372': ['p1/', 'p2/'], 'T1407': ['A.c'], 'T1959': ['B.hs', 'C.hs', 'D.hs', 'E1.hs', 'E2.hs'], diff --git a/testsuite/tests/typecheck/should_fail/T12035.stderr b/testsuite/tests/typecheck/should_fail/T12035j.stderr similarity index 85% copy from testsuite/tests/typecheck/should_fail/T12035.stderr copy to testsuite/tests/typecheck/should_fail/T12035j.stderr index 7086785..c05966e 100644 --- a/testsuite/tests/typecheck/should_fail/T12035.stderr +++ b/testsuite/tests/typecheck/should_fail/T12035j.stderr @@ -1,5 +1,5 @@ -T12035.hs-boot:2:1: error: +T12035.hs:3:1: error: Type constructor ‘T’ has conflicting definitions in the module and its hs-boot file Main module: type T = Bool diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T index 37d74c6..dda2a7d 100644 --- a/testsuite/tests/typecheck/should_fail/all.T +++ b/testsuite/tests/typecheck/should_fail/all.T @@ -420,6 +420,8 @@ test('T11990a', normal, compile_fail, ['']) test('T11990b', normal, compile_fail, ['']) test('T12035', extra_clean(['T12035.hi-boot', 'T12035.o-boot', 'T12035a.hi', 'T12035a.o']), multimod_compile_fail, ['T12035', '-v0']) +test('T12035j', extra_clean(['T12035.hi-boot', 'T12035.o-boot', 'T12035a.hi', 'T12035a.o']), + multimod_compile_fail, ['T12035', '-j2 -v0']) test('T12063', [ expect_broken(12063), extra_clean(['T12063.hi-boot', 'T12063.o-boot', 'T12063a.hi', 'T12063a.o']) ], multimod_compile_fail, ['T12063', '-v0']) test('T11974b', normal, compile_fail, ['']) From git at git.haskell.org Mon Aug 22 13:35:18 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 22 Aug 2016 13:35:18 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: rts/Profiling: Fix C99-ism (b5ec09d) Message-ID: <20160822133518.DF0AD3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/b5ec09dff6b865550f3bd225f86028a304596c61/ghc >--------------------------------------------------------------- commit b5ec09dff6b865550f3bd225f86028a304596c61 Author: Ben Gamari Date: Sun Aug 21 09:30:42 2016 -0400 rts/Profiling: Fix C99-ism GHC 8.0 isn't C99. >--------------------------------------------------------------- b5ec09dff6b865550f3bd225f86028a304596c61 rts/Profiling.c | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/rts/Profiling.c b/rts/Profiling.c index 57d38c5..099778b 100644 --- a/rts/Profiling.c +++ b/rts/Profiling.c @@ -1119,9 +1119,11 @@ insertIndexTableInSortedList(IndexTable* tbl, IndexTable* sortedList) static void sortCCSTree(CostCentreStack *ccs) { + IndexTable *tbl; + if (ccs->indexTable == NULL) return; - for (IndexTable *tbl = ccs->indexTable; tbl != NULL; tbl = tbl->next) + for (tbl = ccs->indexTable; tbl != NULL; tbl = tbl->next) if (!tbl->back_edge) sortCCSTree(tbl->ccs); From git at git.haskell.org Mon Aug 22 14:14:10 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 22 Aug 2016 14:14:10 +0000 (UTC) Subject: [commit: ghc] master: pass -z wxneeded or -Wl, -zwxneeded for linking on OpenBSD (f9aa996) Message-ID: <20160822141410.26AFF3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f9aa996f0af59f32dc7b1528ff78be41413a9c27/ghc >--------------------------------------------------------------- commit f9aa996f0af59f32dc7b1528ff78be41413a9c27 Author: Karel Gardas Date: Sat Aug 13 18:49:53 2016 +0200 pass -z wxneeded or -Wl,-zwxneeded for linking on OpenBSD Summary: This patch fixes issue with abort in GHCi on OpenBSD current as of Aug 12 2016. The OpenBSD is more and more strict about usage of writable and executable memory. Programs/applications which requires such functionality need to be linked with -z wxneeded linker flag and need to be run from the file-system mounted with wxallowed mount option. If either of those options in not met, then problematic program/application usually fail on some mmap/mprotect call which fail. Reviewers: bgamari, austin, hvr Subscribers: thomie, erikd Differential Revision: https://phabricator.haskell.org/D2454 >--------------------------------------------------------------- f9aa996f0af59f32dc7b1528ff78be41413a9c27 aclocal.m4 | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/aclocal.m4 b/aclocal.m4 index ce8944c..df9d420 100644 --- a/aclocal.m4 +++ b/aclocal.m4 @@ -653,6 +653,13 @@ AC_DEFUN([FPTOOLS_SET_C_LD_FLAGS], $5="$$5 -D_THREAD_SAFE" ;; + x86_64-*-openbsd*) + # We need -z wxneeded at least to link ghc-stage2 to workaround + # W^X issue in GHCi on OpenBSD current (as of Aug 2016) + $3="$$3 -Wl,-zwxneeded" + $4="$$4 -z wxneeded" + ;; + esac # If gcc knows about the stack protector, turn it off. From git at git.haskell.org Mon Aug 22 14:40:48 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 22 Aug 2016 14:40:48 +0000 (UTC) Subject: [commit: ghc] master: Splice singleton unboxed tuples correctly with Template Haskell (fb0d87f) Message-ID: <20160822144048.B0F903A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/fb0d87f1c4a35fa2aaf7f6dd55edbc71c7c3b44d/ghc >--------------------------------------------------------------- commit fb0d87f1c4a35fa2aaf7f6dd55edbc71c7c3b44d Author: Ryan Scott Date: Mon Aug 22 10:39:12 2016 -0400 Splice singleton unboxed tuples correctly with Template Haskell Summary: Previously, TH would implicitly remove the parentheses when splicing in singleton unboxed tuple types (e.g., turning `(# Int #)` into `Int`). Luckily, the fix is simply to delete some code. Fixes #12513. Test Plan: make test TEST=T12513 Reviewers: hvr, bgamari, austin, goldfire Reviewed By: goldfire Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2462 GHC Trac Issues: #12513 >--------------------------------------------------------------- fb0d87f1c4a35fa2aaf7f6dd55edbc71c7c3b44d compiler/hsSyn/Convert.hs | 4 +--- docs/users_guide/8.0.2-notes.rst | 4 ++++ testsuite/tests/th/T12513.hs | 12 ++++++++++++ testsuite/tests/th/T12513.stderr | 10 ++++++++++ testsuite/tests/th/all.T | 1 + 5 files changed, 28 insertions(+), 3 deletions(-) diff --git a/compiler/hsSyn/Convert.hs b/compiler/hsSyn/Convert.hs index ad51f9d..ee1f106 100644 --- a/compiler/hsSyn/Convert.hs +++ b/compiler/hsSyn/Convert.hs @@ -1134,9 +1134,7 @@ cvtTypeKind ty_str ty -> mk_apps (HsTyVar (noLoc (getRdrName (tupleTyCon Boxed n)))) tys' UnboxedTupleT n | length tys' == n -- Saturated - -> if n==1 then return (head tys') -- Singleton tuples treated - -- like nothing (ie just parens) - else returnL (HsTupleTy HsUnboxedTuple tys') + -> returnL (HsTupleTy HsUnboxedTuple tys') | otherwise -> mk_apps (HsTyVar (noLoc (getRdrName (tupleTyCon Unboxed n)))) tys' diff --git a/docs/users_guide/8.0.2-notes.rst b/docs/users_guide/8.0.2-notes.rst index 39ad028..f75c684 100644 --- a/docs/users_guide/8.0.2-notes.rst +++ b/docs/users_guide/8.0.2-notes.rst @@ -39,6 +39,10 @@ Template Haskell Template Haskell reified unboxed tuples as boxed tuples with twice their appropriate arity.) +- Splicing singleton unboxed tuple types (e.g., ``(# Int #)``) now works + correctly. Previously, Template Haskell would implicitly remove the + parentheses when splicing, which would turn ``(# Int #)`` into ``Int``. + TODO FIXME Heading title ~~~~~~~~~~~~~~~~~~~~~~~~ diff --git a/testsuite/tests/th/T12513.hs b/testsuite/tests/th/T12513.hs new file mode 100644 index 0000000..625e4c4 --- /dev/null +++ b/testsuite/tests/th/T12513.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE UnboxedTuples #-} +module T12513 where + +import Language.Haskell.TH.Lib +import Language.Haskell.TH.Syntax + +f :: $([t| (# Int #) |]) -> Int +f x = x + +g :: $(unboxedTupleT 1 `appT` conT ''Int) -> Int +g x = x diff --git a/testsuite/tests/th/T12513.stderr b/testsuite/tests/th/T12513.stderr new file mode 100644 index 0000000..26a2dbb --- /dev/null +++ b/testsuite/tests/th/T12513.stderr @@ -0,0 +1,10 @@ + +T12513.hs:9:7: error: + • Couldn't match expected type ‘Int’ with actual type ‘(# Int #)’ + • In the expression: x + In an equation for ‘f’: f x = x + +T12513.hs:12:7: error: + • Couldn't match expected type ‘Int’ with actual type ‘(# Int #)’ + • In the expression: x + In an equation for ‘g’: g x = x diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T index 5cece92..b05d601 100644 --- a/testsuite/tests/th/all.T +++ b/testsuite/tests/th/all.T @@ -421,3 +421,4 @@ test('T12130', extra_clean(['T12130a.hi','T12130a.o']), test('T12403', omit_ways(['ghci']), compile_and_run, ['-v0 -ddump-splices -dsuppress-uniques']) test('T12407', omit_ways(['ghci']), compile, ['-v0']) +test('T12513', omit_ways(['ghci']), compile_fail, ['-v0']) From git at git.haskell.org Mon Aug 22 20:34:58 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 22 Aug 2016 20:34:58 +0000 (UTC) Subject: [commit: ghc] master: Extra comments, as per SPJ in #12035. (1f75440) Message-ID: <20160822203458.121873A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1f75440fc7e4577190d98c0f4643d54d9c934540/ghc >--------------------------------------------------------------- commit 1f75440fc7e4577190d98c0f4643d54d9c934540 Author: Edward Z. Yang Date: Mon Aug 22 13:34:43 2016 -0700 Extra comments, as per SPJ in #12035. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- 1f75440fc7e4577190d98c0f4643d54d9c934540 compiler/iface/TcIface.hs | 4 ++++ compiler/main/GhcMake.hs | 5 ++++- 2 files changed, 8 insertions(+), 1 deletion(-) diff --git a/compiler/iface/TcIface.hs b/compiler/iface/TcIface.hs index fa8e26a..5b31b7a 100644 --- a/compiler/iface/TcIface.hs +++ b/compiler/iface/TcIface.hs @@ -1421,6 +1421,10 @@ ifKnotErr name env_doc type_env = vcat -- * Note [Knot-tying typecheckIface] -- * Note [DFun knot-tying] -- * Note [hsc_type_env_var hack] +-- +-- There is also a wiki page on the subject, see: +-- +-- https://ghc.haskell.org/trac/ghc/wiki/Commentary/Compiler/TyingTheKnot tcIfaceTyConByName :: IfExtName -> IfL TyCon tcIfaceTyConByName name diff --git a/compiler/main/GhcMake.hs b/compiler/main/GhcMake.hs index d67a120..bb1c8e3 100644 --- a/compiler/main/GhcMake.hs +++ b/compiler/main/GhcMake.hs @@ -1049,6 +1049,8 @@ parUpsweep_one mod home_mod_map comp_graph_loops lcl_dflags cleanup par_sem let lcl_hsc_env = localize_hsc_env hsc_env -- Re-typecheck the loop + -- This is necessary to make sure the knot is tied when + -- we close a recursive module loop, see bug #12035. type_env_var <- liftIO $ newIORef emptyNameEnv let lcl_hsc_env' = lcl_hsc_env { hsc_type_env_var = Just (ms_mod lcl_mod, type_env_var) } @@ -1158,7 +1160,8 @@ upsweep old_hpt stable_mods cleanup sccs = do -- Lazily reload the HPT modules participating in the loop. -- See Note [Tying the knot]--if we don't throw out the old HPT -- and reinitalize the knot-tying process, anything that was forced - -- while we were previously typechecking won't get updated. + -- while we were previously typechecking won't get updated, this + -- was bug #12035. hsc_env2 <- liftIO $ reTypecheckLoop hsc_env1 mod done setSession hsc_env2 From git at git.haskell.org Mon Aug 22 23:05:12 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 22 Aug 2016 23:05:12 +0000 (UTC) Subject: [commit: ghc] master: Move #12403, #12513 users guide notes to 8.2.1 release notes (acdbd16) Message-ID: <20160822230512.AB7EE3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/acdbd16ffca4f13cfae6eeed045a6fc5969adee2/ghc >--------------------------------------------------------------- commit acdbd16ffca4f13cfae6eeed045a6fc5969adee2 Author: Ryan Scott Date: Mon Aug 22 19:01:01 2016 -0400 Move #12403, #12513 users guide notes to 8.2.1 release notes The changes in #12403 and #12513 subtly changed the behavior of Template Haskell reification and splicing. While the old behavior was certainly buggy, it's possible that there's code in the wild that depended on the old behavior to work. To err on the side of caution, I'll postpone these changes to GHC 8.2.1 instead of having them merged into GHC 8.0.2. >--------------------------------------------------------------- acdbd16ffca4f13cfae6eeed045a6fc5969adee2 docs/users_guide/8.0.2-notes.rst | 11 ----------- docs/users_guide/8.2.1-notes.rst | 8 ++++++++ 2 files changed, 8 insertions(+), 11 deletions(-) diff --git a/docs/users_guide/8.0.2-notes.rst b/docs/users_guide/8.0.2-notes.rst index f75c684..2846d5c 100644 --- a/docs/users_guide/8.0.2-notes.rst +++ b/docs/users_guide/8.0.2-notes.rst @@ -32,17 +32,6 @@ Compiler initial cmm from STG-to-C-- code generation and :ghc-flag:`-ddump-cmm-verbose` to obtain the intermediates from all C-- pipeline stages. -Template Haskell -~~~~~~~~~~~~~~~~ - -- Reifying types that contain unboxed tuples now works correctly. (Previously, - Template Haskell reified unboxed tuples as boxed tuples with twice their - appropriate arity.) - -- Splicing singleton unboxed tuple types (e.g., ``(# Int #)``) now works - correctly. Previously, Template Haskell would implicitly remove the - parentheses when splicing, which would turn ``(# Int #)`` into ``Int``. - TODO FIXME Heading title ~~~~~~~~~~~~~~~~~~~~~~~~ diff --git a/docs/users_guide/8.2.1-notes.rst b/docs/users_guide/8.2.1-notes.rst index d9dd74c..a9b3050 100644 --- a/docs/users_guide/8.2.1-notes.rst +++ b/docs/users_guide/8.2.1-notes.rst @@ -56,6 +56,14 @@ Template Haskell f x = $(addModFinalizer (reify 'x >>= runIO . print) >> [| x |]) +- Reifying types that contain unboxed tuples now works correctly. (Previously, + Template Haskell reified unboxed tuples as boxed tuples with twice their + appropriate arity.) + +- Splicing singleton unboxed tuple types (e.g., ``(# Int #)``) now works + correctly. Previously, Template Haskell would implicitly remove the + parentheses when splicing, which would turn ``(# Int #)`` into ``Int``. + Runtime system ~~~~~~~~~~~~~~ From git at git.haskell.org Tue Aug 23 02:00:02 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 23 Aug 2016 02:00:02 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Improve accuracy of suggestion to use TypeApplications (0241540) Message-ID: <20160823020002.20F3E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/02415404ab26a5f12dffd9c98f2a923dbdde2329/ghc >--------------------------------------------------------------- commit 02415404ab26a5f12dffd9c98f2a923dbdde2329 Author: Matthew Pickering Date: Thu Feb 25 15:51:46 2016 +0100 Improve accuracy of suggestion to use TypeApplications The suggestion only makes sense when we try to use an as pattern in an expression context. It is misleading in the case of a lazy pattern and view pattern. Reviewers: austin, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1948 (cherry picked from commit e38c07bf5ceb8f50fa5110b70b3b83f0ce1358ba) >--------------------------------------------------------------- 02415404ab26a5f12dffd9c98f2a923dbdde2329 compiler/rename/RnExpr.hs | 13 +++++++------ testsuite/tests/module/mod70.stderr | 4 +--- testsuite/tests/rename/should_fail/rnfail016.stderr | 4 +--- testsuite/tests/rename/should_fail/rnfail051.stderr | 1 - 4 files changed, 9 insertions(+), 13 deletions(-) diff --git a/compiler/rename/RnExpr.hs b/compiler/rename/RnExpr.hs index 5d97332..077d5bb 100644 --- a/compiler/rename/RnExpr.hs +++ b/compiler/rename/RnExpr.hs @@ -333,9 +333,10 @@ We return a (bogus) EWildPat in each case. -} rnExpr EWildPat = return (hsHoleExpr, emptyFVs) -- "_" is just a hole -rnExpr e@(EAsPat {}) = patSynErr e -rnExpr e@(EViewPat {}) = patSynErr e -rnExpr e@(ELazyPat {}) = patSynErr e +rnExpr e@(EAsPat {}) = + patSynErr e (text "Did you mean to enable TypeApplications?") +rnExpr e@(EViewPat {}) = patSynErr e empty +rnExpr e@(ELazyPat {}) = patSynErr e empty {- ************************************************************************ @@ -1967,10 +1968,10 @@ sectionErr expr = hang (text "A section must be enclosed in parentheses") 2 (text "thus:" <+> (parens (ppr expr))) -patSynErr :: HsExpr RdrName -> RnM (HsExpr Name, FreeVars) -patSynErr e = do { addErr (sep [text "Pattern syntax in expression context:", +patSynErr :: HsExpr RdrName -> SDoc -> RnM (HsExpr Name, FreeVars) +patSynErr e explanation = do { addErr (sep [text "Pattern syntax in expression context:", nest 4 (ppr e)] $$ - text "Did you mean to enable TypeApplications?") + explanation) ; return (EWildPat, emptyFVs) } badIpBinds :: Outputable a => SDoc -> a -> SDoc diff --git a/testsuite/tests/module/mod70.stderr b/testsuite/tests/module/mod70.stderr index f0e3042..616ef12 100644 --- a/testsuite/tests/module/mod70.stderr +++ b/testsuite/tests/module/mod70.stderr @@ -1,4 +1,2 @@ -mod70.hs:3:8: error: - Pattern syntax in expression context: ~1 - Did you mean to enable TypeApplications? +mod70.hs:3:8: error: Pattern syntax in expression context: ~1 diff --git a/testsuite/tests/rename/should_fail/rnfail016.stderr b/testsuite/tests/rename/should_fail/rnfail016.stderr index 2193ffb..4013255 100644 --- a/testsuite/tests/rename/should_fail/rnfail016.stderr +++ b/testsuite/tests/rename/should_fail/rnfail016.stderr @@ -3,6 +3,4 @@ rnfail016.hs:6:7: error: Pattern syntax in expression context: x at x Did you mean to enable TypeApplications? -rnfail016.hs:7:7: error: - Pattern syntax in expression context: ~x - Did you mean to enable TypeApplications? +rnfail016.hs:7:7: error: Pattern syntax in expression context: ~x diff --git a/testsuite/tests/rename/should_fail/rnfail051.stderr b/testsuite/tests/rename/should_fail/rnfail051.stderr index a06ddc5..9c45a61 100644 --- a/testsuite/tests/rename/should_fail/rnfail051.stderr +++ b/testsuite/tests/rename/should_fail/rnfail051.stderr @@ -1,4 +1,3 @@ rnfail051.hs:7:17: error: Pattern syntax in expression context: _ -> putStrLn "_" - Did you mean to enable TypeApplications? From git at git.haskell.org Tue Aug 23 02:00:06 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 23 Aug 2016 02:00:06 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Add Windows import library support to the Runtime Linker (4f6960b) Message-ID: <20160823020006.05ACB3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/4f6960bff673525ba399f769e1e585c0475c8ca9/ghc >--------------------------------------------------------------- commit 4f6960bff673525ba399f769e1e585c0475c8ca9 Author: Tamar Christina Date: Sun Apr 17 13:03:17 2016 +0200 Add Windows import library support to the Runtime Linker Summary: Import libraries are files ending in `.dll.a` and `.lib` depending on which compiler creates them (GCC, vs MSVC). Import Libraries are standard `archive` files that contain object files. These object files can have two different formats: 1) The normal COFF Object format for object files (contains all ascii data and very little program code, so do not try to execute.) 2) "short import" format which just contains a symbol name and the dll in which the symbol can be found. Import Libraries are useful for two things: 1) Allowing applications that don't support dynamic linking to link against the import lib (non-short format) which then makes calls into the DLL by loading it at runtime. 2) Allow linking of mutually recursive dlls. if `A.DLL` requires `B.DLL` and vice versa, import libs can be used to break the cycle as they can be created from the expected exports of the DLLs. A side effect of having these two capabilities is that Import libs are often used to hide specific versions of DLLs behind a non-versioned import lib. e.g. GCC_S.a (non-conventional import lib) will point to the correct `libGCC` DLL. With this support Windows Haskell files can now just link to `-lGCC_S` and not have to worry about what the actual name of libGCC is. Also third party libraries such as `icuuc` use import libs to forward to versioned DLLs. e.g. `icuuc.lib` points to `icuuc51.dll` etc. Test Plan: ./validate Two new tests added T11072gcc T11072msvc Two binary files have been added to the test folder because the "short" import library format doesn't seem to be creatable via `dlltool` and requires Microsoft's `lib.exe`. Reviewers: bgamari, RyanGlScott, erikd, goldfire, austin, hvr Reviewed By: RyanGlScott, erikd Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1696 GHC Trac Issues: #11072 (cherry picked from commit 97f2b16483aae28dc8fd60b6d2e1e283618f2390) >--------------------------------------------------------------- 4f6960bff673525ba399f769e1e585c0475c8ca9 compiler/ghci/Linker.hs | 50 ++- rts/Linker.c | 385 +++++++++++++-------- rts/LinkerInternals.h | 125 ++++++- testsuite/tests/ghci/linking/dyn/Makefile | 16 + .../ghci/linking/dyn/{T1407.script => T11072.hs} | 5 +- .../linking/dyn/T11072gcc.stdout} | 0 .../linking/dyn/T11072msvc.stdout} | 0 testsuite/tests/ghci/linking/dyn/all.T | 10 + testsuite/tests/ghci/linking/dyn/i686/libAS.lib | Bin 0 -> 1698 bytes testsuite/tests/ghci/linking/dyn/libAS.def | 3 + testsuite/tests/ghci/linking/dyn/x86_64/libAS.lib | Bin 0 -> 1700 bytes 11 files changed, 440 insertions(+), 154 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 4f6960bff673525ba399f769e1e585c0475c8ca9 From git at git.haskell.org Tue Aug 23 02:00:09 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 23 Aug 2016 02:00:09 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Do not use defaulting in ambiguity check (6f6287a) Message-ID: <20160823020009.645813A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/6f6287a3ebb8c9dca917479961da81142c02ce0f/ghc >--------------------------------------------------------------- commit 6f6287a3ebb8c9dca917479961da81142c02ce0f Author: Simon Peyton Jones Date: Thu Apr 21 13:03:29 2016 +0100 Do not use defaulting in ambiguity check This fixes Trac #11947. See TcSimplify Note [No defaulting in the ambiguity check] (cherry picked from commit edf54d72b5b8a6dd0deafa036dc16dcfc3fcb29f) >--------------------------------------------------------------- 6f6287a3ebb8c9dca917479961da81142c02ce0f compiler/typecheck/TcSimplify.hs | 14 +++++++++++++- testsuite/tests/typecheck/should_compile/T11947.hs | 10 ++++++++++ testsuite/tests/typecheck/should_compile/all.T | 1 + testsuite/tests/typecheck/should_fail/T11947a.hs | 6 ++++++ testsuite/tests/typecheck/should_fail/T11947a.stderr | 12 ++++++++++++ testsuite/tests/typecheck/should_fail/all.T | 1 + 6 files changed, 43 insertions(+), 1 deletion(-) diff --git a/compiler/typecheck/TcSimplify.hs b/compiler/typecheck/TcSimplify.hs index 39923cf..41a54b3 100644 --- a/compiler/typecheck/TcSimplify.hs +++ b/compiler/typecheck/TcSimplify.hs @@ -393,13 +393,25 @@ How is this implemented? It's complicated! So we'll step through it all: 9) `HscMain.tcRnModule'` -- Reads `tcg_safeInfer` after type-checking, calling `HscMain.markUnsafeInfer` (passing the reason along) when safe-inferrence failed. + +Note [No defaulting in the ambiguity check] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When simplifying constraints for the ambiguity check, we use +solveWantedsAndDrop, not simpl_top, so that we do no defaulting. +Trac #11947 was an example: + f :: Num a => Int -> Int +This is ambiguous of course, but we don't want to default the +(Num alpha) constraint to (Num Int)! Doing so gives a defaulting +warning, but no error. -} ------------------ simplifyAmbiguityCheck :: Type -> WantedConstraints -> TcM () simplifyAmbiguityCheck ty wanteds = do { traceTc "simplifyAmbiguityCheck {" (text "type = " <+> ppr ty $$ text "wanted = " <+> ppr wanteds) - ; ((final_wc, _), _) <- runTcS $ simpl_top wanteds + ; (final_wc, _) <- runTcS $ solveWantedsAndDrop wanteds + -- NB: no defaulting! See Note [No defaulting in the ambiguity check] + ; traceTc "End simplifyAmbiguityCheck }" empty -- Normally report all errors; but with -XAllowAmbiguousTypes diff --git a/testsuite/tests/typecheck/should_compile/T11947.hs b/testsuite/tests/typecheck/should_compile/T11947.hs new file mode 100644 index 0000000..75817c8 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T11947.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE TypeApplications, ScopedTypeVariables, AllowAmbiguousTypes #-} +module T11947 where + +theFloatDigits :: forall a. RealFloat a => Int +-- The type is ambiguous +theFloatDigits = floatDigits (undefined @_ @a) + +foo :: IO () +foo = print (theFloatDigits @Double, theFloatDigits @Float) +-- But the applications are not diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index f6c9d2e..e298a52 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -511,3 +511,4 @@ test('T11512', normal, compile, ['']) test('T11754', normal, compile, ['']) test('T11811', normal, compile, ['']) test('T11793', normal, compile, ['']) +test('T11947', normal, compile, ['']) diff --git a/testsuite/tests/typecheck/should_fail/T11947a.hs b/testsuite/tests/typecheck/should_fail/T11947a.hs new file mode 100644 index 0000000..0d8a0d9 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T11947a.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE TypeApplications, ScopedTypeVariables #-} +module T11947 where + +theFloatDigits :: forall a. RealFloat a => Int +-- The type is ambiguous, despite potential defaulting +theFloatDigits = floatDigits (undefined @_ @a) diff --git a/testsuite/tests/typecheck/should_fail/T11947a.stderr b/testsuite/tests/typecheck/should_fail/T11947a.stderr new file mode 100644 index 0000000..4f6a4a7 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T11947a.stderr @@ -0,0 +1,12 @@ + +T11947a.hs:4:19: error: + • Could not deduce (RealFloat a0) + from the context: RealFloat a + bound by the type signature for: + theFloatDigits :: RealFloat a => Int + at T11947a.hs:4:19-46 + The type variable ‘a0’ is ambiguous + • In the ambiguity check for ‘theFloatDigits’ + To defer the ambiguity check to use sites, enable AllowAmbiguousTypes + In the type signature: + theFloatDigits :: forall a. RealFloat a => Int diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T index 04e32ed..1ba517f 100644 --- a/testsuite/tests/typecheck/should_fail/all.T +++ b/testsuite/tests/typecheck/should_fail/all.T @@ -417,3 +417,4 @@ test('T11724', normal, compile_fail, ['']) test('BadUnboxedTuple', normal, compile_fail, ['']) test('T12151', normal, compile_fail, ['']) test('T7437', normal, compile_fail, ['']) +test('T11947a', normal, compile_fail, ['']) From git at git.haskell.org Tue Aug 23 02:00:12 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 23 Aug 2016 02:00:12 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Add missing solveEqualities (7a69acc) Message-ID: <20160823020012.CD72E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/7a69acc846e19562a0e07f8f5f9a5c01f8084e83/ghc >--------------------------------------------------------------- commit 7a69acc846e19562a0e07f8f5f9a5c01f8084e83 Author: Simon Peyton Jones Date: Mon Apr 25 16:17:34 2016 +0100 Add missing solveEqualities I'd missed a call to solveEqualities in the partial-type-sig case of TcBinds.tcUserTypeSig. Also the checkValidType test done there best done after inference, in checkInferredPolyId (and is already done there). Fixes Trac #11976 (cherry picked from commit 4c746cb2886b06ca53a2edb62188827c3dbccce0) >--------------------------------------------------------------- 7a69acc846e19562a0e07f8f5f9a5c01f8084e83 compiler/typecheck/TcBinds.hs | 15 +++++---------- testsuite/tests/partial-sigs/should_fail/T11976.hs | 7 +++++++ testsuite/tests/partial-sigs/should_fail/T11976.stderr | 7 +++++++ testsuite/tests/partial-sigs/should_fail/all.T | 1 + 4 files changed, 20 insertions(+), 10 deletions(-) diff --git a/compiler/typecheck/TcBinds.hs b/compiler/typecheck/TcBinds.hs index 7215571..a1ad6be 100644 --- a/compiler/typecheck/TcBinds.hs +++ b/compiler/typecheck/TcBinds.hs @@ -1772,8 +1772,9 @@ tcUserTypeSig hs_sig_ty mb_name <- pushTcLevelM_ $ -- When instantiating the signature, do so "one level in" -- so that they can be unified under the forall - tcImplicitTKBndrs vars $ - tcWildCardBinders wcs $ \ wcs -> + solveEqualities $ + tcImplicitTKBndrs vars $ + tcWildCardBinders wcs $ \ wcs -> tcExplicitTKBndrs hs_tvs $ \ tvs2 -> do { -- Instantiate the type-class context; but if there -- is an extra-constraints wildcard, just discard it here @@ -1790,20 +1791,14 @@ tcUserTypeSig hs_sig_ty mb_name ; theta <- zonkTcTypes theta ; tau <- zonkTcType tau - -- Check for validity (eg rankN etc) - -- The ambiguity check will happen (from checkValidType), - -- but unnecessarily; it will always succeed because there - -- is no quantification - ; checkValidType ctxt_F (mkPhiTy theta tau) - -- NB: Do this in the context of the pushTcLevel so that - -- the TcLevel invariant is respected - ; let bound_tvs = unionVarSets [ allBoundVariabless theta , allBoundVariables tau , mkVarSet (map snd wcs) ] ; return ((wcs, tvs2, theta, tau), bound_tvs) } + -- NB: checkValidType on the final inferred type will + -- be done later by checkInferredPolyId ; loc <- getSrcSpanM ; return $ TISI { sig_bndr = PartialSig { sig_name = name, sig_hs_ty = hs_ty diff --git a/testsuite/tests/partial-sigs/should_fail/T11976.hs b/testsuite/tests/partial-sigs/should_fail/T11976.hs new file mode 100644 index 0000000..ce6e904 --- /dev/null +++ b/testsuite/tests/partial-sigs/should_fail/T11976.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE PartialTypeSignatures, RankNTypes #-} + +module T11976 where + +type Lens s a = forall f. Functor f => (a -> f a) -> (s -> f s) + +foo = undefined :: Lens _ _ _ diff --git a/testsuite/tests/partial-sigs/should_fail/T11976.stderr b/testsuite/tests/partial-sigs/should_fail/T11976.stderr new file mode 100644 index 0000000..c77e448 --- /dev/null +++ b/testsuite/tests/partial-sigs/should_fail/T11976.stderr @@ -0,0 +1,7 @@ + +T11976.hs:7:20: error: + • Expecting one fewer argument to ‘Lens t0 t1’ + Expected kind ‘k0 -> *’, but ‘Lens t0 t1’ has kind ‘*’ + • In the type ‘Lens _ _ _’ + In the expression: undefined :: Lens _ _ _ + In an equation for ‘foo’: foo = undefined :: Lens _ _ _ diff --git a/testsuite/tests/partial-sigs/should_fail/all.T b/testsuite/tests/partial-sigs/should_fail/all.T index 649079e..a676a02 100644 --- a/testsuite/tests/partial-sigs/should_fail/all.T +++ b/testsuite/tests/partial-sigs/should_fail/all.T @@ -60,3 +60,4 @@ test('T10615', normal, compile_fail, ['']) test('T10045', normal, compile_fail, ['']) test('T10999', normal, compile_fail, ['']) test('T11122', normal, compile, ['']) +test('T11976', normal, compile_fail, ['']) From git at git.haskell.org Tue Aug 23 06:53:42 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 23 Aug 2016 06:53:42 +0000 (UTC) Subject: [commit: ghc] master: Add T12520 as a test (89facad) Message-ID: <20160823065342.468153A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/89facad267ff79f1f20b4866428693f423c2d0cc/ghc >--------------------------------------------------------------- commit 89facad267ff79f1f20b4866428693f423c2d0cc Author: Ömer Sinan Ağacan Date: Tue Aug 23 06:53:11 2016 +0000 Add T12520 as a test #12520 was already fixed in HEAD. Adding a test to make sure it stays fixed. >--------------------------------------------------------------- 89facad267ff79f1f20b4866428693f423c2d0cc testsuite/tests/ghci/scripts/T12520.hs | 14 ++++++++++++++ testsuite/tests/ghci/scripts/T12520.script | 2 ++ .../ghci/{prog012/prog012.stdout => scripts/T12520.stdout} | 0 testsuite/tests/ghci/scripts/all.T | 1 + 4 files changed, 17 insertions(+) diff --git a/testsuite/tests/ghci/scripts/T12520.hs b/testsuite/tests/ghci/scripts/T12520.hs new file mode 100644 index 0000000..cedf587 --- /dev/null +++ b/testsuite/tests/ghci/scripts/T12520.hs @@ -0,0 +1,14 @@ +{-# LANGUAGE MagicHash, UnboxedTuples #-} + +module Bug ( box, wrap, proxy ) where + +import GHC.Prim + +box :: (# Proxy# a, b #) -> b +box (# x, y #) = y + +wrap :: b -> Proxy# a -> (# Proxy# a, b #) +wrap x = \i# -> (# i#, x #) + +proxy :: () -> Proxy# a +proxy () = proxy# diff --git a/testsuite/tests/ghci/scripts/T12520.script b/testsuite/tests/ghci/scripts/T12520.script new file mode 100644 index 0000000..6d6b683 --- /dev/null +++ b/testsuite/tests/ghci/scripts/T12520.script @@ -0,0 +1,2 @@ +:load T12520 +box (wrap "foo" (proxy ())) diff --git a/testsuite/tests/ghci/prog012/prog012.stdout b/testsuite/tests/ghci/scripts/T12520.stdout similarity index 100% copy from testsuite/tests/ghci/prog012/prog012.stdout copy to testsuite/tests/ghci/scripts/T12520.stdout diff --git a/testsuite/tests/ghci/scripts/all.T b/testsuite/tests/ghci/scripts/all.T index 303fd39..70422dc 100755 --- a/testsuite/tests/ghci/scripts/all.T +++ b/testsuite/tests/ghci/scripts/all.T @@ -258,3 +258,4 @@ test('T11376', normal, ghci_script, ['T11376.script']) test('T12007', normal, ghci_script, ['T12007.script']) test('T11975', normal, ghci_script, ['T11975.script']) test('T10963', normal, ghci_script, ['T10963.script']) +test('T12520', normal, ghci_script, ['T12520.script']) From git at git.haskell.org Tue Aug 23 20:34:22 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 23 Aug 2016 20:34:22 +0000 (UTC) Subject: [commit: ghc] master: RtClosureInspect: Fix off-by-one error in cvReconstructType (1766bb3) Message-ID: <20160823203422.674D33A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1766bb3cfd1460796c78bd5651f89d53603586f9/ghc >--------------------------------------------------------------- commit 1766bb3cfd1460796c78bd5651f89d53603586f9 Author: mniip Date: Tue Aug 23 13:19:02 2016 -0400 RtClosureInspect: Fix off-by-one error in cvReconstructType Replaced error-prone index manipulation on a pointer array with a simple fold on the array elements. Test Plan: Added a test case that triggers the bug Reviewers: hvr, austin, bgamari Reviewed By: bgamari Subscribers: simonpj, thomie Differential Revision: https://phabricator.haskell.org/D2439 GHC Trac Issues: #12458 >--------------------------------------------------------------- 1766bb3cfd1460796c78bd5651f89d53603586f9 compiler/ghci/RtClosureInspect.hs | 7 +++---- testsuite/tests/ghci.debugger/scripts/T12458.script | 4 ++++ testsuite/tests/ghci.debugger/scripts/T12458.stdout | 2 ++ testsuite/tests/ghci.debugger/scripts/all.T | 1 + 4 files changed, 10 insertions(+), 4 deletions(-) diff --git a/compiler/ghci/RtClosureInspect.hs b/compiler/ghci/RtClosureInspect.hs index 7a59847..c487bc1 100644 --- a/compiler/ghci/RtClosureInspect.hs +++ b/compiler/ghci/RtClosureInspect.hs @@ -898,10 +898,9 @@ cvReconstructType hsc_env max_depth old_ty hval = runTR_maybe hsc_env $ do (_,mb_dc) <- tryTcErrs (tcLookupDataCon dcname) case mb_dc of Nothing-> do - -- TODO: Check this case - forM [0..length (elems $ ptrs clos)] $ \i -> do - tv <- newVar liftedTypeKind - return$ appArr (\e->(tv,e)) (ptrs clos) i + forM (elems $ ptrs clos) $ \a -> do + tv <- newVar liftedTypeKind + return (tv, a) Just dc -> do arg_tys <- getDataConArgTys dc my_ty diff --git a/testsuite/tests/ghci.debugger/scripts/T12458.script b/testsuite/tests/ghci.debugger/scripts/T12458.script new file mode 100644 index 0000000..5d4120d --- /dev/null +++ b/testsuite/tests/ghci.debugger/scripts/T12458.script @@ -0,0 +1,4 @@ +data D a = D +d = D +:print d +d `seq` () diff --git a/testsuite/tests/ghci.debugger/scripts/T12458.stdout b/testsuite/tests/ghci.debugger/scripts/T12458.stdout new file mode 100644 index 0000000..2a616b0 --- /dev/null +++ b/testsuite/tests/ghci.debugger/scripts/T12458.stdout @@ -0,0 +1,2 @@ +d = (_t1::D a) +() diff --git a/testsuite/tests/ghci.debugger/scripts/all.T b/testsuite/tests/ghci.debugger/scripts/all.T index b17d205..6571c7f 100644 --- a/testsuite/tests/ghci.debugger/scripts/all.T +++ b/testsuite/tests/ghci.debugger/scripts/all.T @@ -86,3 +86,4 @@ test('T2740', normal, ghci_script, ['T2740.script']) test('getargs', normal, 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']) From git at git.haskell.org Tue Aug 23 20:34:26 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 23 Aug 2016 20:34:26 +0000 (UTC) Subject: [commit: ghc] master: Template Haskell support for unboxed sums (613d745) Message-ID: <20160823203426.328853A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/613d745523f181991f6f916bbe58082b7970f7e6/ghc >--------------------------------------------------------------- commit 613d745523f181991f6f916bbe58082b7970f7e6 Author: Ryan Scott Date: Tue Aug 23 14:20:36 2016 -0400 Template Haskell support for unboxed sums This adds new constructors `UnboxedSumE`, `UnboxedSumT`, and `UnboxedSumP` to represent unboxed sums in Template Haskell. One thing you can't currently do is, e.g., `reify ''(#||#)`, since I don't believe unboxed sum type/data constructors can be written in prefix form. I will look at fixing that as part of #12514. Fixes #12478. Test Plan: make test TEST=T12478_{1,2,3} Reviewers: osa1, goldfire, austin, bgamari Reviewed By: goldfire, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2448 GHC Trac Issues: #12478 >--------------------------------------------------------------- 613d745523f181991f6f916bbe58082b7970f7e6 compiler/deSugar/DsMeta.hs | 29 +++++ compiler/hsSyn/Convert.hs | 34 ++++++ compiler/prelude/THNames.hs | 122 +++++++++++---------- compiler/typecheck/TcSplice.hs | 3 +- docs/users_guide/8.2.1-notes.rst | 2 + libraries/template-haskell/Language/Haskell/TH.hs | 11 +- .../template-haskell/Language/Haskell/TH/Lib.hs | 13 +++ .../template-haskell/Language/Haskell/TH/Ppr.hs | 29 +++-- .../template-haskell/Language/Haskell/TH/Syntax.hs | 58 ++++++---- libraries/template-haskell/changelog.md | 2 + .../tests/th/{T10697_decided_1.hs => T12478_1.hs} | 5 +- testsuite/tests/th/T12478_1.stdout | 1 + testsuite/tests/th/T12478_2.hs | 20 ++++ .../should_run/T3279.stdout => th/T12478_2.stdout} | 0 testsuite/tests/th/T12478_3.hs | 14 +++ testsuite/tests/th/T12478_4.hs | 8 ++ testsuite/tests/th/T12478_4.stderr | 6 + testsuite/tests/th/all.T | 5 + 18 files changed, 267 insertions(+), 95 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 613d745523f181991f6f916bbe58082b7970f7e6 From git at git.haskell.org Wed Aug 24 00:22:18 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 24 Aug 2016 00:22:18 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Add Edward Kmett's example as a test case (6a4326e) Message-ID: <20160824002218.CD7D93A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/6a4326ec1dc86122a731a30697b02a1cfa1a52fb/ghc >--------------------------------------------------------------- commit 6a4326ec1dc86122a731a30697b02a1cfa1a52fb Author: Simon Peyton Jones Date: Mon Feb 1 13:59:11 2016 +0000 Add Edward Kmett's example as a test case This is a more stressful example of T11480. (cherry picked from commit 4e6530122ab458211add07a7167d077eba3eea21) >--------------------------------------------------------------- 6a4326ec1dc86122a731a30697b02a1cfa1a52fb testsuite/tests/polykinds/T11480b.hs | 196 +++++++++++++++++++++++++++++++++++ testsuite/tests/polykinds/all.T | 1 + 2 files changed, 197 insertions(+) diff --git a/testsuite/tests/polykinds/T11480b.hs b/testsuite/tests/polykinds/T11480b.hs new file mode 100644 index 0000000..12802e8 --- /dev/null +++ b/testsuite/tests/polykinds/T11480b.hs @@ -0,0 +1,196 @@ +{-# language KindSignatures #-} +{-# language PolyKinds #-} +{-# language DataKinds #-} +{-# language TypeFamilies #-} +{-# language RankNTypes #-} +{-# language NoImplicitPrelude #-} +{-# language FlexibleContexts #-} +{-# language MultiParamTypeClasses #-} +{-# language GADTs #-} +{-# language ConstraintKinds #-} +{-# language FlexibleInstances #-} +{-# language TypeOperators #-} +{-# language ScopedTypeVariables #-} +{-# language DefaultSignatures #-} +{-# language FunctionalDependencies #-} +{-# language UndecidableSuperClasses #-} + +-- This code, supplied by Edward Kmett, uses UndecidableSuperClasses along +-- with a bunch of other stuff, so it's a useful stress test. +-- See Trac #11480 comment:12. + +module T11480b where + +import GHC.Types (Constraint) +import Data.Type.Equality as Equality +import Data.Type.Coercion as Coercion +import qualified Prelude +import Prelude (Either(..)) + +newtype Y (p :: i -> j -> *) (a :: j) (b :: i) = Y { getY :: p b a } + +type family Op (p :: i -> j -> *) :: j -> i -> * where + Op (Y p) = p + Op p = Y p + +class Vacuous (p :: i -> i -> *) (a :: i) +instance Vacuous p a + +data Dict (p :: Constraint) where + Dict :: p => Dict p + +class Functor (Op p) (Nat p (->)) p => Category (p :: i -> i -> *) where + type Ob p :: i -> Constraint + type Ob p = Vacuous p + + id :: Ob p a => p a a + (.) :: p b c -> p a b -> p a c + + source :: p a b -> Dict (Ob p a) + default source :: (Ob p ~ Vacuous p) => p a b -> Dict (Ob p a) + source _ = Dict + + target :: p a b -> Dict (Ob p b) + default target :: (Ob p ~ Vacuous p) => p a b -> Dict (Ob p b) + target _ = Dict + + op :: p b a -> Op p a b + default op :: Op p ~ Y p => p b a -> Op p a b + op = Y + + unop :: Op p b a -> p a b + default unop :: Op p ~ Y p => Op p b a -> p a b + unop = getY + +class (Category p, Category q) => Functor (p :: i -> i -> *) (q :: j -> j -> *) (f :: i -> j) | f -> p q where + fmap :: p a b -> q (f a) (f b) + +data Nat (p :: i -> i -> *) (q :: j -> j -> *) (f :: i -> j) (g :: i -> j) where + Nat :: (Functor p q f, Functor p q g) => { runNat :: forall a. Ob p a => q (f a) (g a) } -> Nat p q f g + +instance (Category p, Category q) => Category (Nat p q) where + type Ob (Nat p q) = Functor p q + id = Nat id1 where + id1 :: forall f x. (Functor p q f, Ob p x) => q (f x) (f x) + id1 = id \\ (ob :: Ob p x :- Ob q (f x)) + Nat f . Nat g = Nat (f . g) + source Nat{} = Dict + target Nat{} = Dict + +ob :: forall p q f a. Functor p q f => Ob p a :- Ob q (f a) +ob = Sub (case source (fmap (id :: p a a) :: q (f a) (f a)) of Dict -> Dict) + +instance (Category p, Category q) => Functor (Y (Nat p q)) (Nat (Nat p q) (->)) (Nat p q) where + fmap (Y f) = Nat (. f) + +instance (Category p, Category q) => Functor (Nat p q) (->) (Nat p q f) where + fmap = (.) + +contramap :: Functor p q f => Op p b a -> q (f a) (f b) +contramap = fmap . unop + +instance Category (->) where + id = Prelude.id + (.) = (Prelude..) + +instance Functor (->) (->) ((->) e) where + fmap = (.) + +instance Functor (Y (->)) (Nat (->) (->)) (->) where + fmap (Y f) = Nat (. f) + +instance (Category p, Op p ~ Y p) => Category (Y p) where + type Ob (Y p) = Ob p + id = Y id + Y f . Y g = Y (g . f) + source (Y f) = target f + target (Y f) = source f + unop = Y + op = getY + +instance (Category p, Op p ~ Y p) => Functor (Y p) (->) (Y p a) where + fmap = (.) + +instance (Category p, Op p ~ Y p) => Functor p (Nat (Y p) (->)) (Y p) where + fmap f = Nat (. Y f) + +-------------------------------------------------------------------------------- +-- * Constraints +-------------------------------------------------------------------------------- + +infixl 1 \\ -- comment required for cpp +(\\) :: a => (b => r) -> (a :- b) -> r +r \\ Sub Dict = r + +newtype p :- q = Sub (p => Dict q) + +instance Functor (:-) (->) Dict where + fmap p Dict = case p of + Sub q -> q + +instance Category (:-) where + id = Sub Dict + f . g = Sub (Dict \\ f \\ g) + +instance Functor (:-) (->) ((:-) e) where + fmap = (.) + +instance Functor (Y (:-)) (Nat (:-) (->)) (:-) where + fmap (Y f) = Nat (. f) + +-------------------------------------------------------------------------------- +-- * Common Functors +-------------------------------------------------------------------------------- + +instance Functor (->) (->) ((,) e) where + fmap f ~(a,b) = (a, f b) + +instance Functor (->) (->) (Either e) where + fmap _ (Left a) = Left a + fmap f (Right b) = Right (f b) + +instance Functor (->) (->) [] where + fmap = Prelude.fmap + +instance Functor (->) (->) Prelude.Maybe where + fmap = Prelude.fmap + +instance Functor (->) (->) Prelude.IO where + fmap = Prelude.fmap + +instance Functor (->) (Nat (->) (->)) (,) where + fmap f = Nat (\(a,b) -> (f a, b)) + +instance Functor (->) (Nat (->) (->)) Either where + fmap f0 = Nat (go f0) where + go :: (a -> b) -> Either a c -> Either b c + go f (Left a) = Left (f a) + go _ (Right b) = Right b + +-------------------------------------------------------------------------------- +-- * Type Equality +-------------------------------------------------------------------------------- + +instance Category (:~:) where + id = Refl + (.) = Prelude.flip Equality.trans + +instance Functor (Y (:~:)) (Nat (:~:) (->)) (:~:) where + fmap (Y f) = Nat (. f) + +instance Functor (:~:) (->) ((:~:) e) where + fmap = (.) + +-------------------------------------------------------------------------------- +-- * Type Coercions +-------------------------------------------------------------------------------- + +instance Category Coercion where + id = Coercion + (.) = Prelude.flip Coercion.trans + +instance Functor (Y Coercion) (Nat Coercion (->)) Coercion where + fmap (Y f) = Nat (. f) + +instance Functor Coercion (->) (Coercion e) where + fmap = (.) diff --git a/testsuite/tests/polykinds/all.T b/testsuite/tests/polykinds/all.T index b2e1c7b..4a2ade3 100644 --- a/testsuite/tests/polykinds/all.T +++ b/testsuite/tests/polykinds/all.T @@ -135,6 +135,7 @@ test('T11255', normal, compile, ['']) test('T11459', normal, compile_fail, ['']) test('T11466', normal, compile_fail, ['']) test('T11480a', normal, compile, ['']) +test('T11480b', normal, compile, ['']) test('T11523', normal, compile, ['']) test('T11520', normal, compile_fail, ['']) test('T11516', normal, compile_fail, ['']) From git at git.haskell.org Wed Aug 24 00:22:22 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 24 Aug 2016 00:22:22 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Remove the incredibly hairy splitTelescopeTvs. (ced7cc0) Message-ID: <20160824002222.0BEC43A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/ced7cc010785df5968d15b24703d8f01328a82ba/ghc >--------------------------------------------------------------- commit ced7cc010785df5968d15b24703d8f01328a82ba Author: Richard Eisenberg Date: Tue Apr 26 10:50:33 2016 -0400 Remove the incredibly hairy splitTelescopeTvs. This patch removes splitTelescopeTvs by adding information about scoped type variables to TcTyCon. Vast simplification! This also fixes #11821 by bringing only unzonked vars into scope. Test case: polykinds/T11821 (cherry picked from commit c5919f75afab9dd6f0a4a2670402024cece5da57) >--------------------------------------------------------------- ced7cc010785df5968d15b24703d8f01328a82ba compiler/typecheck/TcHsType.hs | 411 ++++++++---------------------- compiler/typecheck/TcMType.hs | 10 +- compiler/typecheck/TcTyClsDecls.hs | 107 ++++---- compiler/typecheck/TcValidity.hs | 1 + compiler/types/TyCon.hs | 79 ++++-- testsuite/tests/ghci/scripts/T7873.stderr | 9 +- testsuite/tests/polykinds/T11821.hs | 31 +++ testsuite/tests/polykinds/all.T | 1 + 8 files changed, 272 insertions(+), 377 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 ced7cc010785df5968d15b24703d8f01328a82ba From git at git.haskell.org Wed Aug 24 00:22:25 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 24 Aug 2016 00:22:25 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Test #11484 in th/T11484 (9994285) Message-ID: <20160824002225.282E63A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/999428588c2eb20f66b7dc1a1021aeee759e1df2/ghc >--------------------------------------------------------------- commit 999428588c2eb20f66b7dc1a1021aeee759e1df2 Author: Richard Eisenberg Date: Tue Apr 26 14:07:08 2016 -0400 Test #11484 in th/T11484 (cherry picked from commit 7242582b2fad6e0a734c012da25e66fe6f2ef11a) >--------------------------------------------------------------- 999428588c2eb20f66b7dc1a1021aeee759e1df2 testsuite/tests/th/T11484.hs | 9 +++++++++ testsuite/tests/th/all.T | 1 + 2 files changed, 10 insertions(+) diff --git a/testsuite/tests/th/T11484.hs b/testsuite/tests/th/T11484.hs new file mode 100644 index 0000000..d8c0708 --- /dev/null +++ b/testsuite/tests/th/T11484.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE TypeInType #-} + +module T11484 where + +import Data.Kind + +type TySyn (k :: *) (a :: k) = () + +$([d| type TySyn2 (k :: *) (a :: k) = () |]) diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T index 2e7a6ba..f502252 100644 --- a/testsuite/tests/th/all.T +++ b/testsuite/tests/th/all.T @@ -408,5 +408,6 @@ test('T11680', normal, compile_fail, ['-v0']) test('T11809', normal, compile, ['-v0']) test('T11797', normal, compile, ['-v0 -dsuppress-uniques']) test('T11941', normal, compile_fail, ['-v0']) +test('T11484', normal, compile, ['-v0']) test('T12130', extra_clean(['T12130a.hi','T12130a.o']), multimod_compile, ['T12130', '-v0 ' + config.ghc_th_way_flags]) From git at git.haskell.org Wed Aug 24 00:22:28 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 24 Aug 2016 00:22:28 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Fix deriveTyData's kind unification when two kind variables are unified (ee4c583) Message-ID: <20160824002228.81FB03A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/ee4c5833b363bbea7a381766d4e11d5ff4737c22/ghc >--------------------------------------------------------------- commit ee4c5833b363bbea7a381766d4e11d5ff4737c22 Author: RyanGlScott Date: Wed May 11 15:57:24 2016 +0200 Fix deriveTyData's kind unification when two kind variables are unified When `deriveTyData` attempts to unify two kind variables (which can happen if both the typeclass and the datatype are poly-kinded), it mistakenly adds an extra mapping to its substitution which causes the unification to fail when applying the substitution. This can be prevented by checking both the domain and the range of the original substitution to see which kind variables shouldn't be put into the domain of the substitution. A more in-depth explanation is included in `Note [Unification of two kind variables in deriving]`. Fixes #11837. Test Plan: ./validate Reviewers: simonpj, hvr, goldfire, niteria, austin, bgamari Reviewed By: bgamari Subscribers: niteria, thomie Differential Revision: https://phabricator.haskell.org/D2117 GHC Trac Issues: #11837 (cherry picked from commit e53f2180e89652c72e51ffa614c56294ba67cf37) >--------------------------------------------------------------- ee4c5833b363bbea7a381766d4e11d5ff4737c22 compiler/typecheck/TcDeriv.hs | 60 ++++++++++++++++++++-- compiler/types/TyCoRep.hs | 12 ++++- compiler/types/Type.hs | 2 +- .../should_compile/{T11833.hs => T11837.hs} | 4 +- testsuite/tests/deriving/should_compile/all.T | 1 + 5 files changed, 70 insertions(+), 9 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc ee4c5833b363bbea7a381766d4e11d5ff4737c22 From git at git.haskell.org Wed Aug 24 00:22:31 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 24 Aug 2016 00:22:31 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Fix pretty printing of IEThingWith (1d46fd5) Message-ID: <20160824002231.2D7D43A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/1d46fd5e4897301f3def5267e46e7d07fb85590b/ghc >--------------------------------------------------------------- commit 1d46fd5e4897301f3def5267e46e7d07fb85590b Author: Matthew Pickering Date: Fri May 6 17:15:54 2016 +0100 Fix pretty printing of IEThingWith [skip ci] (cherry picked from commit 018487e686793e22efd595491be5b5305ed2b9c0) >--------------------------------------------------------------- 1d46fd5e4897301f3def5267e46e7d07fb85590b compiler/hsSyn/HsImpExp.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/compiler/hsSyn/HsImpExp.hs b/compiler/hsSyn/HsImpExp.hs index 493a92b..4c72b35 100644 --- a/compiler/hsSyn/HsImpExp.hs +++ b/compiler/hsSyn/HsImpExp.hs @@ -228,8 +228,8 @@ instance (HasOccName name, OutputableBndr name) => Outputable (IE name) where ppr (IEThingAll thing) = hcat [pprImpExp (unLoc thing), text "(..)"] ppr (IEThingWith thing wc withs flds) = pprImpExp (unLoc thing) <> parens (fsep (punctuate comma - ppWiths ++ - map (ppr . flLabel . unLoc) flds)) + (ppWiths ++ + map (ppr . flLabel . unLoc) flds))) where ppWiths = case wc of From git at git.haskell.org Wed Aug 24 00:22:34 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 24 Aug 2016 00:22:34 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Make validDerivPred ignore non-visible arguments to a class type constructor (9cf69d3) Message-ID: <20160824002234.4D8983A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/9cf69d33102aeae925c59d0ccc43a983f1c93081/ghc >--------------------------------------------------------------- commit 9cf69d33102aeae925c59d0ccc43a983f1c93081 Author: RyanGlScott Date: Mon May 2 12:38:04 2016 -0400 Make validDerivPred ignore non-visible arguments to a class type constructor Summary: GHC choked when trying to derive the following: ``` {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE PolyKinds #-} module Example where class Category (cat :: k -> k -> *) where catId :: cat a a catComp :: cat b c -> cat a b -> cat a c newtype T (c :: * -> * -> *) a b = MkT (c a b) deriving Category ``` Unlike in #8865, where we were deriving `Category` for a concrete type like `Either`, in the above example we are attempting to derive an instance of the form: ``` instance Category * c => Category (T * c) where ... ``` (using `-fprint-explicit-kinds` syntax). But `validDerivPred` is checking if `sizePred (Category * c)` equals the number of free type variables in `Category * c`. But note that `sizePred` counts both type variables //and// type constructors, and `*` is a type constructor! So `validDerivPred` erroneously rejects the above instance. The fix is to make `validDerivPred` ignore non-visible arguments to the class type constructor (e.g., ignore `*` is `Category * c`) by using `filterOutInvisibleTypes`. Fixes #11833. Test Plan: ./validate Reviewers: goldfire, hvr, simonpj, austin, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2112 GHC Trac Issues: #11833 (cherry picked from commit fa86ac7c14b67f27017d795811265c3a9750024b) >--------------------------------------------------------------- 9cf69d33102aeae925c59d0ccc43a983f1c93081 compiler/typecheck/TcValidity.hs | 22 ++++++++++++++++------ testsuite/tests/deriving/should_compile/T11833.hs | 9 +++++++++ testsuite/tests/deriving/should_compile/all.T | 1 + 3 files changed, 26 insertions(+), 6 deletions(-) diff --git a/compiler/typecheck/TcValidity.hs b/compiler/typecheck/TcValidity.hs index 359e643..b3bc558 100644 --- a/compiler/typecheck/TcValidity.hs +++ b/compiler/typecheck/TcValidity.hs @@ -1136,6 +1136,15 @@ It checks for three things So if they are the same, there must be no constructors. But there might be applications thus (f (g x)). + Note that tys only includes the visible arguments of the class type + constructor. Including the non-vivisble arguments can cause the following, + perfectly valid instance to be rejected: + class Category (cat :: k -> k -> *) where ... + newtype T (c :: * -> * -> *) a b = MkT (c a b) + instance Category c => Category (T c) where ... + since the first argument to Category is a non-visible *, which sizeTypes + would count as a constructor! See Trac #11833. + * Also check for a bizarre corner case, when the derived instance decl would look like instance C a b => D (T a) where ... @@ -1156,19 +1165,20 @@ validDerivPred :: TyVarSet -> PredType -> Bool -- See Note [Valid 'deriving' predicate] validDerivPred tv_set pred = case classifyPredType pred of - ClassPred cls _ -> cls `hasKey` typeableClassKey + ClassPred cls tys -> cls `hasKey` typeableClassKey -- Typeable constraints are bigger than they appear due -- to kind polymorphism, but that's OK - || check_tys + || check_tys cls tys EqPred {} -> False -- reject equality constraints _ -> True -- Non-class predicates are ok where - check_tys = hasNoDups fvs + check_tys cls tys + = hasNoDups fvs -- use sizePred to ignore implicit args && sizePred pred == fromIntegral (length fvs) && all (`elemVarSet` tv_set) fvs - - fvs = fvType pred + where tys' = filterOutInvisibleTypes (classTyCon cls) tys + fvs = fvTypes tys' {- ************************************************************************ @@ -1866,7 +1876,7 @@ sizePred ty = goClass ty go (ClassPred cls tys') | isTerminatingClass cls = 0 - | otherwise = sizeTypes tys' + | otherwise = sizeTypes (filterOutInvisibleTypes (classTyCon cls) tys') go (EqPred {}) = 0 go (IrredPred ty) = sizeType ty diff --git a/testsuite/tests/deriving/should_compile/T11833.hs b/testsuite/tests/deriving/should_compile/T11833.hs new file mode 100644 index 0000000..75d2a2d --- /dev/null +++ b/testsuite/tests/deriving/should_compile/T11833.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE PolyKinds #-} +module T11833 where + +class Category (cat :: k -> k -> *) where + catId :: cat a a + catComp :: cat b c -> cat a b -> cat a c + +newtype T (c :: * -> * -> *) a b = MkT (c a b) deriving Category diff --git a/testsuite/tests/deriving/should_compile/all.T b/testsuite/tests/deriving/should_compile/all.T index cfbb977..07242ec 100644 --- a/testsuite/tests/deriving/should_compile/all.T +++ b/testsuite/tests/deriving/should_compile/all.T @@ -69,3 +69,4 @@ test('T11357', normal, compile, ['']) test('T11732a', normal, compile, ['']) test('T11732b', normal, compile, ['']) test('T11732c', normal, compile, ['']) +test('T11833', normal, compile, ['']) From git at git.haskell.org Wed Aug 24 00:22:37 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 24 Aug 2016 00:22:37 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: FunDep printer: Fix unicode arrow (38036f0) Message-ID: <20160824002237.618BC3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/38036f0d3f0a3776e8aba561f4572a426bb29ee4/ghc >--------------------------------------------------------------- commit 38036f0d3f0a3776e8aba561f4572a426bb29ee4 Author: Ömer Sinan Ağacan Date: Fri May 20 04:39:57 2016 -0400 FunDep printer: Fix unicode arrow The arrow should be printed in unicode arrow syntax when -fprint-unicode-syntax is used. Reviewers: austin, bgamari, thomie Reviewed By: thomie Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2243 GHC Trac Issues: #11825 (cherry picked from commit 08e47ca9849ab986d0367746a003754fcf0d4176) >--------------------------------------------------------------- 38036f0d3f0a3776e8aba561f4572a426bb29ee4 compiler/types/Class.hs | 2 +- testsuite/tests/ghci/should_run/T11825.hs | 4 ++++ .../tests/ghci/{scripts/T8959b.script => should_run/T11825.script} | 3 ++- testsuite/tests/ghci/should_run/T11825.stdout | 4 ++++ testsuite/tests/ghci/should_run/all.T | 1 + 5 files changed, 12 insertions(+), 2 deletions(-) diff --git a/compiler/types/Class.hs b/compiler/types/Class.hs index b182e46..77bae72 100644 --- a/compiler/types/Class.hs +++ b/compiler/types/Class.hs @@ -300,7 +300,7 @@ pprFundeps [] = empty pprFundeps fds = hsep (vbar : punctuate comma (map pprFunDep fds)) pprFunDep :: Outputable a => FunDep a -> SDoc -pprFunDep (us, vs) = hsep [interppSP us, text "->", interppSP vs] +pprFunDep (us, vs) = hsep [interppSP us, arrow, interppSP vs] instance Data.Data Class where -- don't traverse? diff --git a/testsuite/tests/ghci/should_run/T11825.hs b/testsuite/tests/ghci/should_run/T11825.hs new file mode 100644 index 0000000..c3dd32e --- /dev/null +++ b/testsuite/tests/ghci/should_run/T11825.hs @@ -0,0 +1,4 @@ +{-# LANGUAGE FunctionalDependencies #-} + +class X a b | a -> b where + to :: a -> b diff --git a/testsuite/tests/ghci/scripts/T8959b.script b/testsuite/tests/ghci/should_run/T11825.script similarity index 53% copy from testsuite/tests/ghci/scripts/T8959b.script copy to testsuite/tests/ghci/should_run/T11825.script index e4d0df6..7c9d10a 100644 --- a/testsuite/tests/ghci/scripts/T8959b.script +++ b/testsuite/tests/ghci/should_run/T11825.script @@ -1,2 +1,3 @@ :set -fprint-unicode-syntax -:l T8959b.hs +:load T11825.hs +:info X diff --git a/testsuite/tests/ghci/should_run/T11825.stdout b/testsuite/tests/ghci/should_run/T11825.stdout new file mode 100644 index 0000000..9ab7b1b --- /dev/null +++ b/testsuite/tests/ghci/should_run/T11825.stdout @@ -0,0 +1,4 @@ +class X a b | a → b where + to ∷ a → b + {-# MINIMAL to #-} + -- Defined at T11825.hs:3:1 diff --git a/testsuite/tests/ghci/should_run/all.T b/testsuite/tests/ghci/should_run/all.T index 930f14b..08fe33d 100644 --- a/testsuite/tests/ghci/should_run/all.T +++ b/testsuite/tests/ghci/should_run/all.T @@ -23,3 +23,4 @@ test('T9915', just_ghci, ghci_script, ['T9915.script']) test('T10145', just_ghci, ghci_script, ['T10145.script']) test('T7253', just_ghci, ghci_script, ['T7253.script']) test('T11328', just_ghci, ghci_script, ['T11328.script']) +test('T11825', just_ghci, ghci_script, ['T11825.script']) From git at git.haskell.org Wed Aug 24 00:22:40 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 24 Aug 2016 00:22:40 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Improve pretty-printing of equalities (e9f2900) Message-ID: <20160824002240.960433A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/e9f29008ed5ab4d368138f04338e93dee2713257/ghc >--------------------------------------------------------------- commit e9f29008ed5ab4d368138f04338e93dee2713257 Author: Simon Peyton Jones Date: Mon May 16 13:42:22 2016 +0100 Improve pretty-printing of equalities The previous pretty-printer didn't account for partially applied equalities, causing Trac #12041 (cherry picked from commit ad7f12260e227e849b815f4959df0f886ecbe807) >--------------------------------------------------------------- e9f29008ed5ab4d368138f04338e93dee2713257 compiler/types/TyCoRep.hs | 107 ++++++++++----------- .../tests/indexed-types/should_fail/T12041.hs | 12 +++ .../tests/indexed-types/should_fail/T12041.stderr | 7 ++ testsuite/tests/indexed-types/should_fail/all.T | 1 + 4 files changed, 70 insertions(+), 57 deletions(-) diff --git a/compiler/types/TyCoRep.hs b/compiler/types/TyCoRep.hs index 470b240..c6b8abf 100644 --- a/compiler/types/TyCoRep.hs +++ b/compiler/types/TyCoRep.hs @@ -2881,12 +2881,14 @@ pprTcApp_help :: (a -> Type) -> TyPrec -> (TyPrec -> a -> SDoc) -> TyCon -> [a] -> DynFlags -> PprStyle -> SDoc -- This one has accss to the DynFlags pprTcApp_help to_type p pp tc tys dflags style - | is_equality - = print_equality - - | print_prefix + | not (isSymOcc (nameOccName tc_name)) -- Print prefix = pprPrefixApp p pp_tc (map (pp TyConPrec) tys_wo_kinds) + | Just args <- mb_saturated_equality + = print_equality args + + -- So we have an operator symbol of some kind + | [ty1,ty2] <- tys_wo_kinds -- Infix, two arguments; -- we know nothing of precedence though = pprInfixApp p pp pp_tc ty1 ty2 @@ -2896,66 +2898,57 @@ pprTcApp_help to_type p pp tc tys dflags style || tc_name `hasKey` unliftedTypeKindTyConKey = pp_tc -- Do not wrap *, # in parens - | otherwise + | otherwise -- Unsaturated operator = pprPrefixApp p (parens (pp_tc)) (map (pp TyConPrec) tys_wo_kinds) where - tc_name = tyConName tc + tc_name = tyConName tc + pp_tc = ppr tc + tys_wo_kinds = suppressInvisibles to_type dflags tc tys - is_equality = tc `hasKey` eqPrimTyConKey || - tc `hasKey` heqTyConKey || - tc `hasKey` eqReprPrimTyConKey || - tc `hasKey` eqTyConKey - -- don't include Coercible here, which should be printed - -- normally + mb_saturated_equality + | hetero_eq_tc + , [k1, k2, t1, t2] <- tys + = Just (k1, k2, t1, t2) + | homo_eq_tc + , [k, t1, t2] <- tys -- we must have (~) + = Just (k, k, t1, t2) + | otherwise + = Nothing + + homo_eq_tc = tc `hasKey` eqTyConKey -- ~ + hetero_eq_tc = tc `hasKey` eqPrimTyConKey -- ~# + || tc `hasKey` eqReprPrimTyConKey -- ~R# + || tc `hasKey` heqTyConKey -- ~~ -- This is all a bit ad-hoc, trying to print out the best representation -- of equalities. If you see a better design, go for it. - print_equality = case either_op_msg of - Left op -> - sep [ parens (pp TyOpPrec ty1 <+> dcolon <+> pp TyOpPrec ki1) - , op - , parens (pp TyOpPrec ty2 <+> dcolon <+> pp TyOpPrec ki2)] - Right msg -> - msg + + print_equality (ki1, ki2, ty1, ty2) + | print_eqs + = ppr_infix_eq pp_tc + + | hetero_eq_tc + , print_kinds || not (to_type ki1 `eqType` to_type ki2) + = ppr_infix_eq $ if tc `hasKey` eqPrimTyConKey + then text "~~" + else pp_tc + + | otherwise + = if tc `hasKey` eqReprPrimTyConKey + then text "Coercible" <+> (sep [ pp TyConPrec ty1 + , pp TyConPrec ty2 ]) + else sep [pp TyOpPrec ty1, text "~", pp TyOpPrec ty2] + where - hetero_tc = tc `hasKey` eqPrimTyConKey - || tc `hasKey` eqReprPrimTyConKey - || tc `hasKey` heqTyConKey - - print_kinds = gopt Opt_PrintExplicitKinds dflags - print_eqs = gopt Opt_PrintEqualityRelations dflags || - dumpStyle style || - debugStyle style - - (ki1, ki2, ty1, ty2) - | hetero_tc - , [k1, k2, t1, t2] <- tys - = (k1, k2, t1, t2) - | [k, t1, t2] <- tys -- we must have (~) - = (k, k, t1, t2) - | otherwise - = pprPanic "print_equality" pp_tc - - -- if "Left", print hetero equality; if "Right" just print that msg - either_op_msg - | print_eqs - = Left pp_tc - - | hetero_tc - , print_kinds || not (to_type ki1 `eqType` to_type ki2) - = Left $ if tc `hasKey` eqPrimTyConKey - then text "~~" - else pp_tc - - | otherwise - = Right $ if tc `hasKey` eqReprPrimTyConKey - then text "Coercible" <+> (sep [ pp TyConPrec ty1 - , pp TyConPrec ty2 ]) - else sep [pp TyOpPrec ty1, text "~", pp TyOpPrec ty2] - - print_prefix = not (isSymOcc (nameOccName tc_name)) - tys_wo_kinds = suppressInvisibles to_type dflags tc tys - pp_tc = ppr tc + ppr_infix_eq eq_op + = sep [ parens (pp TyOpPrec ty1 <+> dcolon <+> pp TyOpPrec ki1) + , eq_op + , parens (pp TyOpPrec ty2 <+> dcolon <+> pp TyOpPrec ki2)] + + print_kinds = gopt Opt_PrintExplicitKinds dflags + print_eqs = gopt Opt_PrintEqualityRelations dflags || + dumpStyle style || + debugStyle style ------------------ -- | Given a 'TyCon',and the args to which it is applied, diff --git a/testsuite/tests/indexed-types/should_fail/T12041.hs b/testsuite/tests/indexed-types/should_fail/T12041.hs new file mode 100644 index 0000000..9210280 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T12041.hs @@ -0,0 +1,12 @@ +{-# Language PolyKinds, TypeFamilies #-} + +module T12041 where + +import Data.Kind + +class Category (p :: i -> i -> Type) where + type Ob p :: i -> Constraint + +data I a b +instance Category I where + type Ob I = (~) Int diff --git a/testsuite/tests/indexed-types/should_fail/T12041.stderr b/testsuite/tests/indexed-types/should_fail/T12041.stderr new file mode 100644 index 0000000..006ca37 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T12041.stderr @@ -0,0 +1,7 @@ + +T12041.hs:12:15: error: + • Expected kind ‘i -> Constraint’, + but ‘(~) Int’ has kind ‘* -> Constraint’ + • In the type ‘(~) Int’ + In the type instance declaration for ‘Ob’ + In the instance declaration for ‘Category I’ diff --git a/testsuite/tests/indexed-types/should_fail/all.T b/testsuite/tests/indexed-types/should_fail/all.T index c6f29a4..83dd708 100644 --- a/testsuite/tests/indexed-types/should_fail/all.T +++ b/testsuite/tests/indexed-types/should_fail/all.T @@ -139,3 +139,4 @@ test('T10817', normal, compile_fail, ['']) test('T10899', normal, compile_fail, ['']) test('T11136', normal, compile_fail, ['']) test('T7788', normal, compile_fail, ['']) +test('T12041', normal, compile_fail, ['']) From git at git.haskell.org Wed Aug 24 00:22:43 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 24 Aug 2016 00:22:43 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Build system: temp solution for parallelisation bug (#11960) (13ae3e4) Message-ID: <20160824002243.441E83A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/13ae3e4ae2101f63a6919d983941b09943511310/ghc >--------------------------------------------------------------- commit 13ae3e4ae2101f63a6919d983941b09943511310 Author: Thomas Miedema Date: Sun May 22 10:14:44 2016 +0200 Build system: temp solution for parallelisation bug (#11960) (cherry picked from commit c81e7b2014e284774eecf5e48e42aab31892cec1) >--------------------------------------------------------------- 13ae3e4ae2101f63a6919d983941b09943511310 libffi/ghc.mk | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/libffi/ghc.mk b/libffi/ghc.mk index 404cce9..7c5bc9e 100644 --- a/libffi/ghc.mk +++ b/libffi/ghc.mk @@ -111,7 +111,8 @@ $(libffi_STAMP_CONFIGURE): $(TOUCH_DEP) "$(TOUCH_CMD)" $@ $(libffi_STAMP_BUILD): $(libffi_STAMP_CONFIGURE) $(TOUCH_DEP) - $(MAKE) -C libffi/build MAKEFLAGS= + # Use 'sync' as a temporary solution for #11960 (parallelisation bug). + sync; $(MAKE) -C libffi/build MAKEFLAGS= "$(TOUCH_CMD)" $@ $(libffi_STAMP_INSTALL): $(libffi_STAMP_BUILD) $(TOUCH_DEP) From git at git.haskell.org Wed Aug 24 22:18:19 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 24 Aug 2016 22:18:19 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Testsuite: check actual_prof_file only when needed (d552896) Message-ID: <20160824221819.193DE3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/d552896c3afb7ec0f2a955b6756c6b09a92b6906/ghc >--------------------------------------------------------------- commit d552896c3afb7ec0f2a955b6756c6b09a92b6906 Author: Thomas Miedema Date: Fri Feb 26 11:23:28 2016 +0100 Testsuite: check actual_prof_file only when needed Might be a little faster. Avoids testing for #6113 (.prof file not written when process is killed with any signal but SIGINT) for tests that don't have a .prof.sample file (which is almost all of them) when running the profiling ways. Tests that were failing because of #6113: T8089, overflow1, overflow2 and overflow3. (cherry picked from commit e3b9dbf48c7b7b1ac4a5d6ecf1411469b5f7666c) >--------------------------------------------------------------- d552896c3afb7ec0f2a955b6756c6b09a92b6906 testsuite/driver/testlib.py | 21 +++++++++++---------- 1 file changed, 11 insertions(+), 10 deletions(-) diff --git a/testsuite/driver/testlib.py b/testsuite/driver/testlib.py index afea594..ba39268 100644 --- a/testsuite/driver/testlib.py +++ b/testsuite/driver/testlib.py @@ -1598,6 +1598,14 @@ def check_hp_ok(name): return(False) def check_prof_ok(name, way): + (_, expected_prof_file) = find_expected_file(name, 'prof.sample') + expected_prof_path = in_testdir(expected_prof_file) + + # Check actual prof file only if we have an expected prof file to + # compare it with. + if not os.path.exists(expected_prof_path): + return True + actual_prof_file = add_suffix(name, 'prof') actual_prof_path = in_testdir(actual_prof_file) @@ -1609,16 +1617,9 @@ def check_prof_ok(name, way): print(actual_prof_path + " is empty") return(False) - (_, expected_prof_file) = find_expected_file(name, 'prof.sample') - expected_prof_path = in_testdir(expected_prof_file) - - # sample prof file is not required - if not os.path.exists(expected_prof_path): - return True - else: - return compare_outputs(way, 'prof', normalise_prof, - expected_prof_file, actual_prof_file, - whitespace_normaliser=normalise_whitespace) + return compare_outputs(way, 'prof', normalise_prof, + expected_prof_file, actual_prof_file, + whitespace_normaliser=normalise_whitespace) # Compare expected output to actual output, and optionally accept the # new output. Returns true if output matched or was accepted, false From git at git.haskell.org Wed Aug 24 22:18:21 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 24 Aug 2016 22:18:21 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: More fixes for unboxed tuples (e9c5ca8) Message-ID: <20160824221821.BE37D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/e9c5ca8aa750b1583f19da195e1e7268ac4a35ff/ghc >--------------------------------------------------------------- commit e9c5ca8aa750b1583f19da195e1e7268ac4a35ff Author: Simon Peyton Jones Date: Fri May 27 14:34:45 2016 +0100 More fixes for unboxed tuples This is a continuation of commit e9e61f18a548b70693f4ccd245bc56335c94b498 Date: Thu May 26 15:24:53 2016 +0100 Reduce special-casing for nullary unboxed tuple which related to Trac #12115. But typecheck/should_run/tcrun051 revealed that my patch was incomplete. This fixes it, by removing another special case in Type.repType. I had also missed a case in UnariseStg.unariseIdBinder. I took the opportunity to add explanatory notes Note [Unarisation] Note [Unarisation and nullary tuples] in UnariseStg (cherry picked from commit b43a7936ebf77bce744d50a131d686c83f63e60b) >--------------------------------------------------------------- e9c5ca8aa750b1583f19da195e1e7268ac4a35ff compiler/simplStg/UnariseStg.hs | 87 +++++++++++++++++++++++++++++++++-------- compiler/types/Type.hs | 10 ++--- 2 files changed, 76 insertions(+), 21 deletions(-) diff --git a/compiler/simplStg/UnariseStg.hs b/compiler/simplStg/UnariseStg.hs index b162201..7aa9e0b 100644 --- a/compiler/simplStg/UnariseStg.hs +++ b/compiler/simplStg/UnariseStg.hs @@ -4,8 +4,8 @@ Note [Unarisation] ~~~~~~~~~~~~~~~~~~ - -The idea of this pass is to translate away *all* unboxed-tuple binders. So for example: +The idea of this pass is to translate away *all* unboxed-tuple binders. +So for example: f (x :: (# Int, Bool #)) = f x + f (# 1, True #) ==> @@ -17,10 +17,55 @@ because it would be very hard to make this pass Core-type-preserving. STG fed to the code generators *must* be unarised because the code generators do not support unboxed tuple binders natively. +In more detail: + +Suppose that a variable x : (# t1, t2 #). + + * At the binding site for x, make up fresh vars x1:t1, x2:t2 + + * Extend the UniariseEnv x :-> [x1,x2] + + * Replace the binding with a curried binding for x1,x2 + Lambda: \x.e ==> \x1 x2. e + Case alt: MkT a b x c d -> e ==> MkT a b x1 x2 c d -> e + + * Replace argument occurrences with a sequence of args + via a lookup in UnariseEnv + f a b x c d ==> f a b x1 x2 c d + + * Replace tail-call occurrences with an unboxed tuple + via a lookup in UnariseEnv + x ==> (# x1, x2 #) + So, for example + f x = x ==> f x1 x2 = (# x1, x2 #) + + This applies to case scrutinees too + case x of (# a,b #) -> e ==> case (# x1,x2 #) of (# a,b #) -> e + I think we rely on the code generator to short-circuit this + case without generating any actual code. + +Of course all this applies recursively, so that we flattn out nested tuples. + +Note [Unarisation and nullary tuples] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The above scheme has a special cases for nullary unboxed tuples, x :: (# #) + + * Extend the UnariseEnv with x :-> [voidPrimId] + + * Replace bindings with a binding for void:Void# + \x. e => \void. e + and similarly case alternatives + + * If we find (# #) as an argument all by itself + f ...(# #)... + it looks like an Id, so we look up in UnariseEnv. We want to replace it + with voidPrimId, so the convenient thing is to initalise the UniariseEnv + with (# #) :-> [voidPrimId] + +See also Note [Nullary unboxed tuple] in Type.hs. Note [Unarisation and arity] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - Because of unarisation, the arity that will be recorded in the generated info table for an Id may be larger than the idArity. Instead we record what we call the RepArity, which is the Arity taking into account any expanded arguments, and corresponds to @@ -38,7 +83,7 @@ import StgSyn import VarEnv import UniqSupply import Id -import MkId (realWorldPrimId) +import MkId ( voidPrimId, voidArgId ) import Type import TysWiredIn import DataCon @@ -58,13 +103,12 @@ import BasicTypes -- the domain of the mapping at all. type UnariseEnv = VarEnv [Id] -ubxTupleId0 :: Id -ubxTupleId0 = dataConWorkId (tupleDataCon Unboxed 0) - unarise :: UniqSupply -> [StgBinding] -> [StgBinding] unarise us binds = zipWith (\us -> unariseBinding us init_env) (listSplitUniqSupply us) binds - where -- See Note [Nullary unboxed tuple] in Type.hs - init_env = unitVarEnv ubxTupleId0 [realWorldPrimId] + where + -- See Note [Unarisation and nullary tuples] + nullary_tup = dataConWorkId unboxedUnitDataCon + init_env = unitVarEnv nullary_tup [voidPrimId] unariseBinding :: UniqSupply -> UnariseEnv -> StgBinding -> StgBinding unariseBinding us rho bind = case bind of @@ -181,7 +225,7 @@ unariseIds rho = concatMap (unariseId rho) unariseId :: UnariseEnv -> Id -> [Id] unariseId rho x | Just ys <- lookupVarEnv rho x - = ASSERT2( case repType (idType x) of UbxTupleRep _ -> True; _ -> x == ubxTupleId0 + = ASSERT2( case repType (idType x) of UbxTupleRep _ -> True; _ -> False , text "unariseId: not unboxed tuple" <+> ppr x ) ys @@ -201,13 +245,24 @@ unariseUsedIdBinders us rho xs uses unariseIdBinders :: UniqSupply -> UnariseEnv -> [Id] -> (UniqSupply, UnariseEnv, [Id]) unariseIdBinders us rho xs = third3 concat $ mapAccumL2 unariseIdBinder us rho xs -unariseIdBinder :: UniqSupply -> UnariseEnv -> Id -> (UniqSupply, UnariseEnv, [Id]) +unariseIdBinder :: UniqSupply -> UnariseEnv + -> Id -- Binder + -> (UniqSupply, + UnariseEnv, -- What to expand to at occurrence sites + [Id]) -- What to expand to at binding site unariseIdBinder us rho x = case repType (idType x) of - UnaryRep _ -> (us, rho, [x]) - UbxTupleRep tys -> let (us0, us1) = splitUniqSupply us - ys = unboxedTupleBindersFrom us0 x tys - rho' = extendVarEnv rho x ys - in (us1, rho', ys) + UnaryRep {} -> (us, rho, [x]) + + UbxTupleRep tys + | null tys -> -- See Note [Unarisation and nullary tuples] + let ys = [voidPrimId] + rho' = extendVarEnv rho x ys + in (us, rho', [voidArgId]) + + | otherwise -> let (us0, us1) = splitUniqSupply us + ys = unboxedTupleBindersFrom us0 x tys + rho' = extendVarEnv rho x ys + in (us1, rho', ys) unboxedTupleBindersFrom :: UniqSupply -> Id -> [UnaryType] -> [Id] unboxedTupleBindersFrom us x tys = zipWith (mkSysLocalOrCoVar fs) (uniqsFromSupply us) tys diff --git a/compiler/types/Type.hs b/compiler/types/Type.hs index 44eb0a2..8b06d44 100644 --- a/compiler/types/Type.hs +++ b/compiler/types/Type.hs @@ -143,7 +143,7 @@ module Type ( tyConsOfType, -- * Type representation for the code generator - typePrimRep, typeRepArity, kindPrimRep, tyConPrimRep, + typePrimRep, typeRepArity, tyConPrimRep, -- * Main type substitution data types TvSubstEnv, -- Representation widely visible @@ -1741,7 +1741,7 @@ typeSize (CoercionTy co) = coercionSize co ********************************************************************** -} {- Note [Nullary unboxed tuple] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ At runtime we represent the nullary unboxed tuple as the type Void#. To see why, consider f2 :: (# Int, Int #) -> Int @@ -1757,6 +1757,8 @@ we'll transform to We do not want to give f0 zero arguments, otherwise a lambda will turn into a thunk! So we want to get f0 :: Void# -> Int + +See Note [Unarisation and nullary tuples] in UnariseStg for more detail. -} type UnaryType = Type @@ -1803,9 +1805,7 @@ repType ty = go rec_nts' (newTyConInstRhs tc tys) | isUnboxedTupleTyCon tc - = if null tys - then UnaryRep voidPrimTy -- See Note [Nullary unboxed tuple] - else UbxTupleRep (concatMap (flattenRepType . go rec_nts) non_rr_tys) + = UbxTupleRep (concatMap (flattenRepType . go rec_nts) non_rr_tys) where -- See Note [Unboxed tuple RuntimeRep vars] in TyCon non_rr_tys = dropRuntimeRepArgs tys From git at git.haskell.org Wed Aug 24 22:18:24 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 24 Aug 2016 22:18:24 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Testsuite: also normalise platform-dependent .stdout/stderr (43eef43) Message-ID: <20160824221824.68AA43A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/43eef4353790d1311b29cff28b23cd2e006e633b/ghc >--------------------------------------------------------------- commit 43eef4353790d1311b29cff28b23cd2e006e633b Author: Thomas Miedema Date: Wed May 25 16:03:19 2016 +0200 Testsuite: also normalise platform-dependent .stdout/stderr This effectively reverses commit 429f0099ab9adfadc779ca76f3aae1c9c160fb8c (2006). I don't see why platform-dependent .stdout/stderr files should //not// get normalised. It fixes T11223_link_order_a_b_2_fail on Windows, by normalising `ghc-stage2.exe` to `ghc` when comparing stderr with .stderr-mingw32. Reviewed by: Phyx Differential Revision: https://phabricator.haskell.org/D2267 GHC Trac Issues: #12118 (cherry picked from commit 6a5bce14ffb8b10def150b185fc95d7b2ebab263) >--------------------------------------------------------------- 43eef4353790d1311b29cff28b23cd2e006e633b testsuite/driver/testlib.py | 38 ++++++++++++-------------------------- 1 file changed, 12 insertions(+), 26 deletions(-) diff --git a/testsuite/driver/testlib.py b/testsuite/driver/testlib.py index ba39268..12a8ebd 100644 --- a/testsuite/driver/testlib.py +++ b/testsuite/driver/testlib.py @@ -1045,7 +1045,7 @@ def do_compile( name, way, should_fail, top_mod, extra_mods, extra_hc_opts, over # of whether we expected the compilation to fail or not (successful # compilations may generate warnings). - (_, expected_stderr_file) = find_expected_file(name, 'stderr') + expected_stderr_file = find_expected_file(name, 'stderr') actual_stderr_file = add_suffix(name, 'comp.stderr') if not compare_outputs(way, 'stderr', @@ -1070,7 +1070,7 @@ def compile_cmp_asm( name, way, extra_hc_opts ): # of whether we expected the compilation to fail or not (successful # compilations may generate warnings). - (_, expected_asm_file) = find_expected_file(name, 'asm') + expected_asm_file = find_expected_file(name, 'asm') actual_asm_file = add_suffix(name, 's') if not compare_outputs(way, 'asm', @@ -1514,15 +1514,9 @@ def get_compiler_flags(override_flags, noforce): def check_stdout_ok(name, way): actual_stdout_file = add_suffix(name, 'run.stdout') - (platform_specific, expected_stdout_file) = find_expected_file(name, 'stdout') + expected_stdout_file = find_expected_file(name, 'stdout') - def norm(str): - if platform_specific: - return str - else: - return normalise_output(str) - - extra_norm = join_normalisers(norm, getTestOpts().extra_normaliser) + extra_norm = join_normalisers(normalise_output, getTestOpts().extra_normaliser) check_stdout = getTestOpts().check_stdout if check_stdout: @@ -1538,16 +1532,10 @@ def dump_stdout( name ): def check_stderr_ok(name, way): actual_stderr_file = add_suffix(name, 'run.stderr') - (platform_specific, expected_stderr_file) = find_expected_file(name, 'stderr') - - def norm(str): - if platform_specific: - return str - else: - return normalise_errmsg(str) + expected_stderr_file = find_expected_file(name, 'stderr') return compare_outputs(way, 'stderr', - join_normalisers(norm, getTestOpts().extra_errmsg_normaliser), \ + join_normalisers(normalise_errmsg, getTestOpts().extra_errmsg_normaliser), \ expected_stderr_file, actual_stderr_file, whitespace_normaliser=normalise_whitespace) @@ -1598,7 +1586,7 @@ def check_hp_ok(name): return(False) def check_prof_ok(name, way): - (_, expected_prof_file) = find_expected_file(name, 'prof.sample') + expected_prof_file = find_expected_file(name, 'prof.sample') expected_prof_path = in_testdir(expected_prof_file) # Check actual prof file only if we have an expected prof file to @@ -2194,20 +2182,18 @@ def find_expected_file(name, suff): basename = add_suffix(name, suff) basepath = in_testdir(basename) - files = [(platformSpecific, basename + ws + plat) - for (platformSpecific, plat) in [(1, '-' + config.platform), - (1, '-' + config.os), - (0, '')] + files = [basename + ws + plat + for plat in ['-' + config.platform, '-' + config.os, ''] for ws in ['-ws-' + config.wordsize, '']] dir = glob.glob(basepath + '*') dir = [normalise_slashes_(d) for d in dir] - for (platformSpecific, f) in files: + for f in files: if in_testdir(f) in dir: - return (platformSpecific,f) + return f - return (0, basename) + return basename # Clean up prior to the test, so that we can't spuriously conclude # that it passed on the basis of old run outputs. From git at git.haskell.org Wed Aug 24 22:18:27 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 24 Aug 2016 22:18:27 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Reduce special-casing for nullary unboxed tuple (9ddb933) Message-ID: <20160824221827.ACBAC3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/9ddb9338aa052ef06849c8d6cd8846916d7b2f23/ghc >--------------------------------------------------------------- commit 9ddb9338aa052ef06849c8d6cd8846916d7b2f23 Author: Simon Peyton Jones Date: Thu May 26 15:24:53 2016 +0100 Reduce special-casing for nullary unboxed tuple When we built the kind of a nullary unboxed tuple, we said, in TysWiredIn.mk_tuple: res_rep | arity == 0 = voidRepDataConTy -- See Note [Nullary unboxed tuple] in Type | otherwise = unboxedTupleRepDataConTy But this is bogus. The Note deals with what the 'unarise' transformation does, and up to that point it's simpler and more uniform to treat nullary unboxed tuples the same as all the others. Nicer now. And it fixes the Lint error in Trac #12115 (cherry picked from commit e9e61f18a548b70693f4ccd245bc56335c94b498) >--------------------------------------------------------------- 9ddb9338aa052ef06849c8d6cd8846916d7b2f23 compiler/prelude/TysWiredIn.hs | 11 +- compiler/typecheck/TcHsType.hs | 2 +- compiler/types/TyCoRep.hs | 7 + compiler/types/Type.hs | 254 ++++++++++++----------- testsuite/tests/codeGen/should_compile/T12115.hs | 9 + testsuite/tests/codeGen/should_compile/all.T | 1 + 6 files changed, 153 insertions(+), 131 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 9ddb9338aa052ef06849c8d6cd8846916d7b2f23 From git at git.haskell.org Wed Aug 24 22:18:30 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 24 Aug 2016 22:18:30 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Add relocation type R_X86_64_REX_GOTPCRELX (efc7ef6) Message-ID: <20160824221830.5B1D63A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/efc7ef67d3fe2064dc8f40e73d88026d57bd836f/ghc >--------------------------------------------------------------- commit efc7ef67d3fe2064dc8f40e73d88026d57bd836f Author: Tamar Christina Date: Sun Jun 5 09:59:05 2016 +0200 Add relocation type R_X86_64_REX_GOTPCRELX Summary: Adding support for the `R_X86_64_REX_GOTPCRELX` relocation type. This relocation is treated by the linker the same as the `R_X86_64_GOTPCRELX` type `G + GOT + A - P` to generate relative offsets to the GOT. The `REX` prefix has no influence in this stage. This is based on https://github.com/hjl-tools/x86-psABI/wiki/x86-64-psABI-r252.pdf Test Plan: ./validate Reviewers: erikd, austin, bgamari, simonmar Reviewed By: erikd Subscribers: thomie, #ghc_windows_task_force Differential Revision: https://phabricator.haskell.org/D2303 GHC Trac Issues: #12147 (cherry picked from commit 0d963caf40da4391028a3beb95b5082c87985e7d) >--------------------------------------------------------------- efc7ef67d3fe2064dc8f40e73d88026d57bd836f rts/Linker.c | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/rts/Linker.c b/rts/Linker.c index d670f1d..7e80664 100644 --- a/rts/Linker.c +++ b/rts/Linker.c @@ -5968,7 +5968,13 @@ do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC, *(Elf64_Sword *)P = (Elf64_Sword)value; #endif break; - +/* These two relocations were introduced in glibc 2.23 and binutils 2.26. + But in order to use them the system which compiles the bindist for GHC needs + to have glibc >= 2.23. So only use them if they're defined. */ +#if defined(R_X86_64_REX_GOTPCRELX) && defined(R_X86_64_GOTPCRELX) + case R_X86_64_REX_GOTPCRELX: + case R_X86_64_GOTPCRELX: +#endif case R_X86_64_GOTPCREL: { StgInt64 gotAddress = (StgInt64) &makeSymbolExtra(oc, ELF_R_SYM(info), S)->addr; From git at git.haskell.org Wed Aug 24 22:18:33 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 24 Aug 2016 22:18:33 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Fix #12064 by making IfaceClass typechecking more lazy. (479e0bc) Message-ID: <20160824221833.7F0503A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/479e0bce4729b84eea6baa29ceee30dc5f99806b/ghc >--------------------------------------------------------------- commit 479e0bce4729b84eea6baa29ceee30dc5f99806b Author: Edward Z. Yang Date: Sun May 15 16:13:51 2016 -0700 Fix #12064 by making IfaceClass typechecking more lazy. Summary: Comes with a test based off of prog006. Signed-off-by: Edward Z. Yang Test Plan: validate Reviewers: simonpj, austin, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2221 GHC Trac Issues: #12064 (cherry picked from commit 8f6d292746217f1fa9f645ff8d191943af1c5771) >--------------------------------------------------------------- 479e0bce4729b84eea6baa29ceee30dc5f99806b compiler/iface/TcIface.hs | 41 ++++++++++++++-------- compiler/typecheck/TcRnDriver.hs | 2 +- testsuite/tests/typecheck/should_compile/T12064.hs | 4 +++ .../tests/typecheck/should_compile/T12064.hs-boot | 2 ++ .../tests/typecheck/should_compile/T12064a.hs | 4 +++ testsuite/tests/typecheck/should_compile/all.T | 2 ++ 6 files changed, 39 insertions(+), 16 deletions(-) diff --git a/compiler/iface/TcIface.hs b/compiler/iface/TcIface.hs index 22ecae7..13df037 100644 --- a/compiler/iface/TcIface.hs +++ b/compiler/iface/TcIface.hs @@ -147,7 +147,10 @@ typecheckIface iface -- Finished ; traceIf (vcat [text "Finished typechecking interface for" <+> ppr (mi_module iface), - text "Type envt:" <+> ppr type_env]) + -- Careful! If we tug on the TyThing thunks too early + -- we'll infinite loop with hs-boot. See #10083 for + -- an example where this would cause non-termination. + text "Type envt:" <+> ppr (map fst names_w_things)]) ; return $ ModDetails { md_types = type_env , md_insts = insts , md_fam_insts = fam_insts @@ -189,7 +192,7 @@ tcHiBootIface hsc_src mod -- And that's fine, because if M's ModInfo is in the HPT, then -- it's been compiled once, and we don't need to check the boot iface then do { hpt <- getHpt - ; case lookupUFM hpt (moduleName mod) of + ; case lookupHptByModule hpt mod of Just info | mi_boot (hm_iface info) -> return (mkSelfBootInfo (hm_details info)) _ -> return NoSelfBoot } @@ -426,20 +429,23 @@ tc_iface_decl _parent ignore_prags tc_sig :: IfaceClassOp -> IfL TcMethInfo tc_sig (IfaceClassOp occ rdr_ty dm) = do { op_name <- lookupIfaceTop occ - ; ~(op_ty, dm') <- forkM (mk_op_doc op_name rdr_ty) $ - do { ty <- tcIfaceType rdr_ty - ; dm' <- tc_dm dm - ; return (ty, dm') } + ; let doc = mk_op_doc op_name rdr_ty + ; op_ty <- forkM (doc <+> text "ty") $ tcIfaceType rdr_ty -- Must be done lazily for just the same reason as the -- type of a data con; to avoid sucking in types that -- it mentions unless it's necessary to do so + ; dm' <- tc_dm doc dm ; return (op_name, op_ty, dm') } - tc_dm :: Maybe (DefMethSpec IfaceType) -> IfL (Maybe (DefMethSpec (SrcSpan, Type))) - tc_dm Nothing = return Nothing - tc_dm (Just VanillaDM) = return (Just VanillaDM) - tc_dm (Just (GenericDM ty)) = do { ty' <- tcIfaceType ty - ; return (Just (GenericDM (noSrcSpan, ty'))) } + tc_dm :: SDoc + -> Maybe (DefMethSpec IfaceType) + -> IfL (Maybe (DefMethSpec (SrcSpan, Type))) + tc_dm _ Nothing = return Nothing + tc_dm _ (Just VanillaDM) = return (Just VanillaDM) + tc_dm doc (Just (GenericDM ty)) + = do { -- Must be done lazily to avoid sucking in types + ; ty' <- forkM (doc <+> text "dm") $ tcIfaceType ty + ; return (Just (GenericDM (noSrcSpan, ty'))) } tc_at cls (IfaceAT tc_decl if_def) = do ATyCon tc <- tc_iface_decl (Just cls) ignore_prags tc_decl @@ -1277,7 +1283,7 @@ tcPragExpr name expr where doc = text "Unfolding of" <+> ppr name - get_in_scope :: IfL [Var] -- Totally disgusting; but just for linting + get_in_scope :: IfL VarSet -- Totally disgusting; but just for linting get_in_scope = do { (gbl_env, lcl_env) <- getEnvs ; rec_ids <- case if_rec_types gbl_env of @@ -1285,9 +1291,14 @@ tcPragExpr name expr Just (_, get_env) -> do { type_env <- setLclEnv () get_env ; return (typeEnvIds type_env) } - ; return (varEnvElts (if_tv_env lcl_env) ++ - varEnvElts (if_id_env lcl_env) ++ - rec_ids) } + ; return (bindingsVars (if_tv_env lcl_env) `unionVarSet` + bindingsVars (if_id_env lcl_env) `unionVarSet` + mkVarSet rec_ids) } + + bindingsVars :: FastStringEnv Var -> VarSet + bindingsVars ufm = mkVarSet $ nonDetEltsUFM ufm + -- It's OK to use nonDetEltsUFM here because we immediately forget + -- the ordering by creating a set {- ************************************************************************ diff --git a/compiler/typecheck/TcRnDriver.hs b/compiler/typecheck/TcRnDriver.hs index e7328b9..b05e4b4 100644 --- a/compiler/typecheck/TcRnDriver.hs +++ b/compiler/typecheck/TcRnDriver.hs @@ -367,7 +367,7 @@ tcRnModuleTcRnM hsc_env hsc_src Nothing -> return tcg_env) ; -- The new type env is already available to stuff slurped from - -- interface files, via TcEnv.updateGlobalTypeEnv + -- interface files, via TcEnv.setGlobalTypeEnv -- It's important that this includes the stuff in checkHiBootIface, -- because the latter might add new bindings for boot_dfuns, -- which may be mentioned in imported unfoldings diff --git a/testsuite/tests/typecheck/should_compile/T12064.hs b/testsuite/tests/typecheck/should_compile/T12064.hs new file mode 100644 index 0000000..0c3d1b3 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T12064.hs @@ -0,0 +1,4 @@ +{-# LANGUAGE ExistentialQuantification #-} +module T12064 where +import T12064a +data D = forall n. K n => DCon n diff --git a/testsuite/tests/typecheck/should_compile/T12064.hs-boot b/testsuite/tests/typecheck/should_compile/T12064.hs-boot new file mode 100644 index 0000000..4536cf3 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T12064.hs-boot @@ -0,0 +1,2 @@ +module T12064 where +data D diff --git a/testsuite/tests/typecheck/should_compile/T12064a.hs b/testsuite/tests/typecheck/should_compile/T12064a.hs new file mode 100644 index 0000000..381edfc --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T12064a.hs @@ -0,0 +1,4 @@ +module T12064a where +import {-# SOURCE #-} T12064 +class K a where + kfun :: D -> a diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index e298a52..fd62707 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -512,3 +512,5 @@ test('T11754', normal, compile, ['']) test('T11811', normal, compile, ['']) test('T11793', normal, compile, ['']) test('T11947', normal, compile, ['']) +test('T12064', extra_clean(['T12064.hi-boot', 'T12064.o-boot', 'T11062a.hi', 'T11062a.o']), + multimod_compile, ['T12064', '-v0']) From git at git.haskell.org Wed Aug 24 22:18:36 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 24 Aug 2016 22:18:36 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Improve failed knot-tying error message. (9038a3f) Message-ID: <20160824221836.303143A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/9038a3f343d086cdffe0ae4a8341fbad230c56b5/ghc >--------------------------------------------------------------- commit 9038a3f343d086cdffe0ae4a8341fbad230c56b5 Author: Edward Z. Yang Date: Mon May 30 14:21:36 2016 +0200 Improve failed knot-tying error message. Test Plan: validate Reviewers: simonpj, austin, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2207 (cherry picked from commit f2b3be031075156cf128aba127bdddb84f8b2eb8) >--------------------------------------------------------------- 9038a3f343d086cdffe0ae4a8341fbad230c56b5 compiler/deSugar/DsMonad.hs | 3 ++- compiler/iface/TcIface.hs | 24 ++++++++++++++++++++---- compiler/typecheck/TcRnMonad.hs | 7 ++++++- compiler/typecheck/TcRnTypes.hs | 3 +++ 4 files changed, 31 insertions(+), 6 deletions(-) diff --git a/compiler/deSugar/DsMonad.hs b/compiler/deSugar/DsMonad.hs index 79ca265..672238c 100644 --- a/compiler/deSugar/DsMonad.hs +++ b/compiler/deSugar/DsMonad.hs @@ -266,7 +266,8 @@ mkDsEnvs :: DynFlags -> Module -> GlobalRdrEnv -> TypeEnv -> FamInstEnv -> IORef Messages -> IORef [(Fingerprint, (Id, CoreExpr))] -> IORef Int -> (DsGblEnv, DsLclEnv) mkDsEnvs dflags mod rdr_env type_env fam_inst_env msg_var static_binds_var pmvar - = let if_genv = IfGblEnv { if_rec_types = Just (mod, return type_env) } + = let if_genv = IfGblEnv { if_doc = text "mkDsEnvs", + if_rec_types = Just (mod, return type_env) } if_lenv = mkIfLclEnv mod (text "GHC error in desugarer lookup in" <+> ppr mod) real_span = realSrcLocSpan (mkRealSrcLoc (moduleNameFS (moduleName mod)) 1 1) gbl_env = DsGblEnv { ds_mod = mod diff --git a/compiler/iface/TcIface.hs b/compiler/iface/TcIface.hs index f60822f..22ecae7 100644 --- a/compiler/iface/TcIface.hs +++ b/compiler/iface/TcIface.hs @@ -1314,9 +1314,11 @@ tcIfaceGlobal name -> do -- It's defined in the module being compiled { type_env <- setLclEnv () get_type_env -- yuk ; case lookupNameEnv type_env name of - Just thing -> return thing - Nothing -> pprPanic "tcIfaceGlobal (local): not found:" - (ppr name $$ ppr type_env) } + Just thing -> return thing + Nothing -> + pprPanic "tcIfaceGlobal (local): not found" + (ifKnotErr name (if_doc env) type_env) + } ; _ -> do @@ -1332,11 +1334,25 @@ tcIfaceGlobal name Succeeded thing -> return thing }}}}} +ifKnotErr :: Name -> SDoc -> TypeEnv -> SDoc +ifKnotErr name env_doc type_env = vcat + [ text "You are in a maze of twisty little passages, all alike." + , text "While forcing the thunk for TyThing" <+> ppr name + , text "which was lazily initialized by" <+> env_doc <> text "," + , text "I tried to tie the knot, but I couldn't find" <+> ppr name + , text "in the current type environment." + , text "If you are developing GHC, please read Note [Tying the knot]" + , text "and Note [Type-checking inside the knot]." + , text "Consider rebuilding GHC with profiling for a better stack trace." + , hang (text "Contents of current type environment:") + 2 (ppr type_env) + ] + -- Note [Tying the knot] -- ~~~~~~~~~~~~~~~~~~~~~ -- The if_rec_types field is used in two situations: -- --- a) Compiling M.hs, which indiretly imports Foo.hi, which mentions M.T +-- a) Compiling M.hs, which indirectly imports Foo.hi, which mentions M.T -- Then we look up M.T in M's type environment, which is splatted into if_rec_types -- after we've built M's type envt. -- diff --git a/compiler/typecheck/TcRnMonad.hs b/compiler/typecheck/TcRnMonad.hs index 5e8028e..6b01a87 100644 --- a/compiler/typecheck/TcRnMonad.hs +++ b/compiler/typecheck/TcRnMonad.hs @@ -1469,6 +1469,7 @@ initIfaceTcRn :: IfG a -> TcRn a initIfaceTcRn thing_inside = do { tcg_env <- getGblEnv ; let { if_env = IfGblEnv { + if_doc = text "initIfaceTcRn", if_rec_types = Just (tcg_mod tcg_env, get_type_env) } ; get_type_env = readTcRef (tcg_type_env_var tcg_env) } @@ -1481,7 +1482,10 @@ initIfaceCheck hsc_env do_this = do let rec_types = case hsc_type_env_var hsc_env of Just (mod,var) -> Just (mod, readTcRef var) Nothing -> Nothing - gbl_env = IfGblEnv { if_rec_types = rec_types } + gbl_env = IfGblEnv { + if_doc = text "initIfaceCheck", + if_rec_types = rec_types + } initTcRnIf 'i' hsc_env gbl_env () do_this initIfaceTc :: ModIface @@ -1491,6 +1495,7 @@ initIfaceTc :: ModIface initIfaceTc iface do_this = do { tc_env_var <- newTcRef emptyTypeEnv ; let { gbl_env = IfGblEnv { + if_doc = text "initIfaceTc", if_rec_types = Just (mod, readTcRef tc_env_var) } ; ; if_lenv = mkIfLclEnv mod doc diff --git a/compiler/typecheck/TcRnTypes.hs b/compiler/typecheck/TcRnTypes.hs index 4755f8d..019bd08 100644 --- a/compiler/typecheck/TcRnTypes.hs +++ b/compiler/typecheck/TcRnTypes.hs @@ -255,6 +255,9 @@ instance ContainsModule gbl => ContainsModule (Env gbl lcl) where data IfGblEnv = IfGblEnv { + -- Some information about where this environment came from; + -- useful for debugging. + if_doc :: SDoc, -- The type environment for the module being compiled, -- in case the interface refers back to it via a reference that -- was originally a hi-boot file. From git at git.haskell.org Wed Aug 24 22:18:38 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 24 Aug 2016 22:18:38 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Kill varEnvElts in tcPragExpr (8cd76a4) Message-ID: <20160824221838.D1BDB3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/8cd76a475822e35b903505b4dd1f2f95d847288b/ghc >--------------------------------------------------------------- commit 8cd76a475822e35b903505b4dd1f2f95d847288b Author: Bartosz Nitka Date: Wed May 18 16:47:29 2016 -0700 Kill varEnvElts in tcPragExpr I had to refactor some things to take VarSet instead of [Var], but I think it's more precise this way. Test Plan: ./validate Reviewers: simonmar, simonpj, austin, bgamari, goldfire Reviewed By: simonpj Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2227 GHC Trac Issues: #4012 (cherry picked from commit 13e40f998e15a626a4212bde0987ddbc98b3f56f) >--------------------------------------------------------------- 8cd76a475822e35b903505b4dd1f2f95d847288b compiler/coreSyn/CoreLint.hs | 10 ++++++++-- compiler/iface/IfaceEnv.hs | 16 ++++++++-------- compiler/typecheck/TcRnMonad.hs | 5 ++--- compiler/typecheck/TcRnTypes.hs | 4 ++-- 4 files changed, 20 insertions(+), 15 deletions(-) diff --git a/compiler/coreSyn/CoreLint.hs b/compiler/coreSyn/CoreLint.hs index 2106e2d..e1b106c 100644 --- a/compiler/coreSyn/CoreLint.hs +++ b/compiler/coreSyn/CoreLint.hs @@ -417,7 +417,7 @@ We use this to check all unfoldings that come in from interfaces lintUnfolding :: DynFlags -> SrcLoc - -> [Var] -- Treat these as in scope + -> VarSet -- Treat these as in scope -> CoreExpr -> Maybe MsgDoc -- Nothing => OK @@ -427,7 +427,7 @@ lintUnfolding dflags locn vars expr where (_warns, errs) = initL dflags defaultLintFlags linter linter = addLoc (ImportedUnfolding locn) $ - addInScopeVars vars $ + addInScopeVarSet vars $ lintCoreExpr expr lintExpr :: DynFlags @@ -1678,6 +1678,12 @@ addInScopeVars vars m unLintM m (env { le_subst = extendTCvInScopeList (le_subst env) vars }) errs +addInScopeVarSet :: VarSet -> LintM a -> LintM a +addInScopeVarSet vars m + = LintM $ \ env errs -> + unLintM m (env { le_subst = extendTCvInScopeSet (le_subst env) vars }) + errs + addInScopeVar :: Var -> LintM a -> LintM a addInScopeVar var m = LintM $ \ env errs -> diff --git a/compiler/iface/IfaceEnv.hs b/compiler/iface/IfaceEnv.hs index 20b497b..0c8d8e9 100644 --- a/compiler/iface/IfaceEnv.hs +++ b/compiler/iface/IfaceEnv.hs @@ -30,8 +30,8 @@ import Var import Name import Avail import Module -import UniqFM import FastString +import FastStringEnv import IfaceType import UniqSupply import SrcLoc @@ -259,7 +259,7 @@ initOrigNames names = foldl extendOrigNameCache emptyModuleEnv names tcIfaceLclId :: FastString -> IfL Id tcIfaceLclId occ = do { lcl <- getLclEnv - ; case (lookupUFM (if_id_env lcl) occ) of + ; case (lookupFsEnv (if_id_env lcl) occ) of Just ty_var -> return ty_var Nothing -> failIfM (text "Iface id out of scope: " <+> ppr occ) } @@ -267,7 +267,7 @@ tcIfaceLclId occ extendIfaceIdEnv :: [Id] -> IfL a -> IfL a extendIfaceIdEnv ids thing_inside = do { env <- getLclEnv - ; let { id_env' = addListToUFM (if_id_env env) pairs + ; let { id_env' = extendFsEnvList (if_id_env env) pairs ; pairs = [(occNameFS (getOccName id), id) | id <- ids] } ; setLclEnv (env { if_id_env = id_env' }) thing_inside } @@ -275,7 +275,7 @@ extendIfaceIdEnv ids thing_inside tcIfaceTyVar :: FastString -> IfL TyVar tcIfaceTyVar occ = do { lcl <- getLclEnv - ; case (lookupUFM (if_tv_env lcl) occ) of + ; case (lookupFsEnv (if_tv_env lcl) occ) of Just ty_var -> return ty_var Nothing -> failIfM (text "Iface type variable out of scope: " <+> ppr occ) } @@ -283,20 +283,20 @@ tcIfaceTyVar occ lookupIfaceTyVar :: IfaceTvBndr -> IfL (Maybe TyVar) lookupIfaceTyVar (occ, _) = do { lcl <- getLclEnv - ; return (lookupUFM (if_tv_env lcl) occ) } + ; return (lookupFsEnv (if_tv_env lcl) occ) } lookupIfaceVar :: IfaceBndr -> IfL (Maybe TyCoVar) lookupIfaceVar (IfaceIdBndr (occ, _)) = do { lcl <- getLclEnv - ; return (lookupUFM (if_id_env lcl) occ) } + ; return (lookupFsEnv (if_id_env lcl) occ) } lookupIfaceVar (IfaceTvBndr (occ, _)) = do { lcl <- getLclEnv - ; return (lookupUFM (if_tv_env lcl) occ) } + ; return (lookupFsEnv (if_tv_env lcl) occ) } extendIfaceTyVarEnv :: [TyVar] -> IfL a -> IfL a extendIfaceTyVarEnv tyvars thing_inside = do { env <- getLclEnv - ; let { tv_env' = addListToUFM (if_tv_env env) pairs + ; let { tv_env' = extendFsEnvList (if_tv_env env) pairs ; pairs = [(occNameFS (getOccName tv), tv) | tv <- tyvars] } ; setLclEnv (env { if_tv_env = tv_env' }) thing_inside } diff --git a/compiler/typecheck/TcRnMonad.hs b/compiler/typecheck/TcRnMonad.hs index 6b01a87..c0d5d64 100644 --- a/compiler/typecheck/TcRnMonad.hs +++ b/compiler/typecheck/TcRnMonad.hs @@ -42,7 +42,6 @@ import NameSet import Bag import Outputable import UniqSupply -import UniqFM import DynFlags import StaticFlags import FastString @@ -1459,8 +1458,8 @@ setLocalRdrEnv rdr_env thing_inside mkIfLclEnv :: Module -> SDoc -> IfLclEnv mkIfLclEnv mod loc = IfLclEnv { if_mod = mod, if_loc = loc, - if_tv_env = emptyUFM, - if_id_env = emptyUFM } + if_tv_env = emptyFsEnv, + if_id_env = emptyFsEnv } -- | Run an 'IfG' (top-level interface monad) computation inside an existing -- 'TcRn' (typecheck-renaming monad) computation by initializing an 'IfGblEnv' diff --git a/compiler/typecheck/TcRnTypes.hs b/compiler/typecheck/TcRnTypes.hs index 019bd08..f99f49f 100644 --- a/compiler/typecheck/TcRnTypes.hs +++ b/compiler/typecheck/TcRnTypes.hs @@ -283,8 +283,8 @@ data IfLclEnv -- .hi file, or GHCi state, or ext core -- plus which bit is currently being examined - if_tv_env :: UniqFM TyVar, -- Nested tyvar bindings - if_id_env :: UniqFM Id -- Nested id binding + if_tv_env :: FastStringEnv TyVar, -- Nested tyvar bindings + if_id_env :: FastStringEnv Id -- Nested id binding } {- From git at git.haskell.org Wed Aug 24 23:14:50 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 24 Aug 2016 23:14:50 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Don't GC sparks for CAFs (381d451) Message-ID: <20160824231450.C5D4C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/381d451f67e8aecb39bd08db2182ee93138f7ea7/ghc >--------------------------------------------------------------- commit 381d451f67e8aecb39bd08db2182ee93138f7ea7 Author: Simon Marlow Date: Fri Jun 10 17:07:13 2016 +0100 Don't GC sparks for CAFs We can't tell whether the CAF is actually garbage or not. (cherry picked from commit 23b73c97312e4d812812ed25a6396fff44d1da28) >--------------------------------------------------------------- 381d451f67e8aecb39bd08db2182ee93138f7ea7 rts/Sparks.c | 15 ++++++--------- 1 file changed, 6 insertions(+), 9 deletions(-) diff --git a/rts/Sparks.c b/rts/Sparks.c index ec07580..85b59d0 100644 --- a/rts/Sparks.c +++ b/rts/Sparks.c @@ -211,15 +211,12 @@ pruneSparkQueue (Capability *cap) } } else { if (INFO_PTR_TO_STRUCT(info)->type == THUNK_STATIC) { - if (*THUNK_STATIC_LINK(spark) != NULL) { - elements[botInd] = spark; // keep entry (new address) - botInd++; - n++; - } else { - pruned_sparks++; // discard spark - cap->spark_stats.gcd++; - traceEventSparkGC(cap); - } + // We can't tell whether a THUNK_STATIC is garbage or not. + // See also Note [STATIC_LINK fields] + // isAlive() also ignores static closures (see GCAux.c) + elements[botInd] = spark; // keep entry (new address) + botInd++; + n++; } else { pruned_sparks++; // discard spark cap->spark_stats.fizzled++; From git at git.haskell.org Wed Aug 24 23:14:53 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 24 Aug 2016 23:14:53 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Refactor derived Generic instances to reduce allocations (1c31013) Message-ID: <20160824231453.87DCC3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/1c310133bbea168356e86aa38771f0da0d1315af/ghc >--------------------------------------------------------------- commit 1c310133bbea168356e86aa38771f0da0d1315af Author: Ryan Scott Date: Sat Jun 18 12:23:12 2016 +0200 Refactor derived Generic instances to reduce allocations Previously, derived implementations of `to`/`from` in `Generic` instances were wastefully putting extra `M1`s in every case, which led to an O(n) increase in the number of coercions, resulting in a slowdown during the typechecker phase. This factors out the common `M1` in every case of a `to`/`from` definition so that the typechecker has far fewer coercions to deal with. For a datatype with 300 constructors, this change has been observed to save almost 3 seconds of compilation time. This is one step towards coming up with a solution for #5642. Test Plan: ./validate Reviewers: hvr, austin, simonpj, bgamari Reviewed By: bgamari Subscribers: basvandijk, carter, thomie, osa1 Differential Revision: https://phabricator.haskell.org/D2304 GHC Trac Issues: #5642 (cherry picked from commit 9649fc0ae45e006c2ed54cc5ea2414158949fadb) >--------------------------------------------------------------- 1c310133bbea168356e86aa38771f0da0d1315af compiler/typecheck/TcGenGenerics.hs | 112 +++++- testsuite/tests/generics/GenDerivOutput.stderr | 144 ++++---- testsuite/tests/generics/GenDerivOutput1_0.stderr | 35 +- testsuite/tests/generics/GenDerivOutput1_1.stderr | 264 +++++++------- testsuite/tests/perf/compiler/T5642.hs | 402 +++++++++++----------- testsuite/tests/perf/compiler/all.T | 3 +- 6 files changed, 538 insertions(+), 422 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 1c310133bbea168356e86aa38771f0da0d1315af From git at git.haskell.org Thu Aug 25 15:04:22 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 25 Aug 2016 15:04:22 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: PPC NCG: Fix float parameter passing on 64-bit. (7f373fb) Message-ID: <20160825150422.5E3AD3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/7f373fb1b9aea45db94f04267427c5629b73f25c/ghc >--------------------------------------------------------------- commit 7f373fb1b9aea45db94f04267427c5629b73f25c Author: Peter Trommler Date: Sat Jun 18 12:28:41 2016 +0200 PPC NCG: Fix float parameter passing on 64-bit. On Linux 64-bit PowerPC the first 13 floating point parameters are passed in registers. We only passed the first 8 floating point params. The alignment of a floating point single precision value in ELF v1.9 is the second word of a doubleword. For ELF v2 we support only little endian and the least significant word of a doubleword is the first word, so no special handling is required. Add a regression test. Test Plan: validate on powerpc Linux and AIX Reviewers: erikd, hvr, austin, simonmar, bgamari Reviewed By: simonmar Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2327 GHC Trac Issues: #12134 (cherry picked from commit 2897be77123bf31cad1c60dd5560eba7f2f021ce) >--------------------------------------------------------------- 7f373fb1b9aea45db94f04267427c5629b73f25c compiler/nativeGen/PPC/CodeGen.hs | 24 ++++++++++++++++++------ compiler/nativeGen/PPC/Regs.hs | 5 ++++- testsuite/tests/ffi/should_run/T12134.hs | 8 ++++++++ testsuite/tests/ffi/should_run/T12134.stdout | 15 +++++++++++++++ testsuite/tests/ffi/should_run/T12134_c.c | 8 ++++++++ testsuite/tests/ffi/should_run/all.T | 6 ++++++ 6 files changed, 59 insertions(+), 7 deletions(-) diff --git a/compiler/nativeGen/PPC/CodeGen.hs b/compiler/nativeGen/PPC/CodeGen.hs index d8e3286..ef54562 100644 --- a/compiler/nativeGen/PPC/CodeGen.hs +++ b/compiler/nativeGen/PPC/CodeGen.hs @@ -1250,10 +1250,12 @@ genCCall' dflags gcp target dest_regs args GCPLinux -> roundTo 16 finalStack GCPLinux64ELF 1 -> roundTo 16 $ (48 +) $ max 64 $ sum $ - map (widthInBytes . typeWidth) argReps + map (roundTo 8 . widthInBytes . typeWidth) + argReps GCPLinux64ELF 2 -> roundTo 16 $ (32 +) $ max 64 $ sum $ - map (widthInBytes . typeWidth) argReps + map (roundTo 8 . widthInBytes . typeWidth) + argReps _ -> panic "genCall': unknown calling conv." argReps = map (cmmExprType dflags) args @@ -1404,11 +1406,21 @@ genCCall' dflags gcp target dest_regs args | otherwise -> stackOffset GCPLinux64ELF _ -> - -- everything on the stack is 8-byte - -- aligned on a 64 bit system - -- (except vector status, not used now) + -- Everything on the stack is mapped to + -- 8-byte aligned doublewords stackOffset - stackSlot = AddrRegImm sp (ImmInt stackOffset') + stackOffset'' + | isFloatType rep && typeWidth rep == W32 = + case gcp of + -- The ELF v1 ABI Section 3.2.3 requires: + -- "Single precision floating point values + -- are mapped to the second word in a single + -- doubleword" + GCPLinux64ELF 1 -> stackOffset' + 4 + _ -> stackOffset' + | otherwise = stackOffset' + + stackSlot = AddrRegImm sp (ImmInt stackOffset'') (nGprs, nFprs, stackBytes, regs) = case gcp of GCPAIX -> diff --git a/compiler/nativeGen/PPC/Regs.hs b/compiler/nativeGen/PPC/Regs.hs index 780aecc..a1befc7 100644 --- a/compiler/nativeGen/PPC/Regs.hs +++ b/compiler/nativeGen/PPC/Regs.hs @@ -263,7 +263,10 @@ allFPArgRegs platform = case platformOS platform of OSAIX -> map (regSingle . fReg) [1..13] OSDarwin -> map (regSingle . fReg) [1..13] - OSLinux -> map (regSingle . fReg) [1..8] + OSLinux -> case platformArch platform of + ArchPPC -> map (regSingle . fReg) [1..8] + ArchPPC_64 _ -> map (regSingle . fReg) [1..13] + _ -> panic "PPC.Regs.allFPArgRegs: unknown PPC Linux" _ -> panic "PPC.Regs.allFPArgRegs: not defined for this architecture" fits16Bits :: Integral a => a -> Bool diff --git a/testsuite/tests/ffi/should_run/T12134.hs b/testsuite/tests/ffi/should_run/T12134.hs new file mode 100644 index 0000000..f07d892 --- /dev/null +++ b/testsuite/tests/ffi/should_run/T12134.hs @@ -0,0 +1,8 @@ +import Foreign.C.Types + +foreign import ccall "many_floats" many :: CFloat -> CFloat -> + CFloat -> CFloat -> CFloat -> CFloat -> CFloat -> CFloat -> + CFloat -> CFloat -> CFloat -> CFloat -> CFloat -> CFloat -> + CDouble -> IO () + +main = many 1.5 2.5 3.5 4.5 5.5 6.5 7.5 8.5 9.5 10.5 11.5 12.5 13.5 14.5 15.5 diff --git a/testsuite/tests/ffi/should_run/T12134.stdout b/testsuite/tests/ffi/should_run/T12134.stdout new file mode 100644 index 0000000..798f1a2 --- /dev/null +++ b/testsuite/tests/ffi/should_run/T12134.stdout @@ -0,0 +1,15 @@ +1.500000 +2.500000 +3.500000 +4.500000 +5.500000 +6.500000 +7.500000 +8.500000 +9.500000 +10.500000 +11.500000 +12.500000 +13.500000 +14.500000 +15.500000 diff --git a/testsuite/tests/ffi/should_run/T12134_c.c b/testsuite/tests/ffi/should_run/T12134_c.c new file mode 100644 index 0000000..0e61670 --- /dev/null +++ b/testsuite/tests/ffi/should_run/T12134_c.c @@ -0,0 +1,8 @@ +#include + +void many_floats(float f1, float f2, float f3, float f4, float f5, + float f6, float f7, float f8, float f9, float f10, + float f11, float f12, float f13, float f14, double f15) { + printf("%f\n%f\n%f\n%f\n%f\n%f\n%f\n%f\n%f\n%f\n%f\n%f\n%f\n%f\n%f\n", + f1, f2, f3, f4, f5, f6, f7, f8, f9, f10, f11, f12, f13, f14, f15); +} diff --git a/testsuite/tests/ffi/should_run/all.T b/testsuite/tests/ffi/should_run/all.T index eb2c152..efb6969 100644 --- a/testsuite/tests/ffi/should_run/all.T +++ b/testsuite/tests/ffi/should_run/all.T @@ -217,3 +217,9 @@ test('ffi023', [ omit_ways(['ghci']), # ffi023_stub.h before compiling ffi023_c.c, which # needs it. compile_and_run, ['ffi023_c.c']) + +test('T12134', + [omit_ways(['ghci']), extra_clean(['T12134_c.o'])], + compile_and_run, + ['T12134_c.c']) + From git at git.haskell.org Thu Aug 25 15:04:25 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 25 Aug 2016 15:04:25 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: PPC NCG: Fix and refactor TOC handling. (929c5c5) Message-ID: <20160825150425.0BCB43A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/929c5c5fce455b2cc15015246938e9048d4a9686/ghc >--------------------------------------------------------------- commit 929c5c5fce455b2cc15015246938e9048d4a9686 Author: Peter Trommler Date: Sat Jun 18 12:29:12 2016 +0200 PPC NCG: Fix and refactor TOC handling. In a call to a fixed function the TOC does not need to be saved. The linker handles TOC saving. Refactor TOC handling by folding the two functions toc_before and toc_after into the code generating the call sequence. This saves repeating the case distinction in those two functions. Test Plan: validate on PowerPC 32-bit Linux and AIX Reviewers: hvr, simonmar, austin, erikd, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2328 (cherry picked from commit f4b0488dba4c97630ed1e4417eef546abd5c3df5) >--------------------------------------------------------------- 929c5c5fce455b2cc15015246938e9048d4a9686 compiler/nativeGen/PPC/CodeGen.hs | 56 +++++++++++++++++++-------------------- 1 file changed, 28 insertions(+), 28 deletions(-) diff --git a/compiler/nativeGen/PPC/CodeGen.hs b/compiler/nativeGen/PPC/CodeGen.hs index ef54562..9bcbd18 100644 --- a/compiler/nativeGen/PPC/CodeGen.hs +++ b/compiler/nativeGen/PPC/CodeGen.hs @@ -1140,7 +1140,13 @@ genCCall' PowerPC 64 Linux uses the System V Release 4 Calling Convention for 64-bit PowerPC. It is specified in - "64-bit PowerPC ELF Application Binary Interface Supplement 1.9". + "64-bit PowerPC ELF Application Binary Interface Supplement 1.9" + (PPC64 ELF v1.9). + PowerPC 64 Linux in little endian mode uses the "Power Architecture 64-Bit + ELF V2 ABI Specification -- OpenPOWER ABI for Linux Supplement" + (PPC64 ELF v2). + AIX follows the "PowerOpen ABI: Application Binary Interface Big-Endian + 32-Bit Hardware Implementation" According to all conventions, the parameter area should be part of the caller's stack frame, allocated in the caller's prologue code (large enough @@ -1181,41 +1187,46 @@ genCCall' dflags gcp target dest_regs args PrimTarget mop -> outOfLineMachOp mop let codeBefore = move_sp_down finalStack `appOL` passArgumentsCode - `appOL` toc_before - codeAfter = toc_after labelOrExpr `appOL` move_sp_up finalStack - `appOL` moveResult reduceToFF32 + codeAfter = move_sp_up finalStack `appOL` moveResult reduceToFF32 case labelOrExpr of Left lbl -> do -- the linker does all the work for us return ( codeBefore `snocOL` BL lbl usedRegs + `appOL` maybeNOP -- some ABI require a NOP after BL `appOL` codeAfter) Right dyn -> do -- implement call through function pointer (dynReg, dynCode) <- getSomeReg dyn case gcp of GCPLinux64ELF 1 -> return ( dynCode `appOL` codeBefore + `snocOL` ST spFormat toc (AddrRegImm sp (ImmInt 40)) `snocOL` LD II64 r11 (AddrRegImm dynReg (ImmInt 0)) `snocOL` LD II64 toc (AddrRegImm dynReg (ImmInt 8)) `snocOL` MTCTR r11 `snocOL` LD II64 r11 (AddrRegImm dynReg (ImmInt 16)) `snocOL` BCTRL usedRegs + `snocOL` LD spFormat toc (AddrRegImm sp (ImmInt 40)) `appOL` codeAfter) GCPLinux64ELF 2 -> return ( dynCode `appOL` codeBefore + `snocOL` ST spFormat toc (AddrRegImm sp (ImmInt 24)) `snocOL` MR r12 dynReg `snocOL` MTCTR r12 `snocOL` BCTRL usedRegs + `snocOL` LD spFormat toc (AddrRegImm sp (ImmInt 24)) `appOL` codeAfter) GCPAIX -> return ( dynCode -- AIX/XCOFF follows the PowerOPEN ABI -- which is quite similiar to LinuxPPC64/ELFv1 `appOL` codeBefore + `snocOL` ST spFormat toc (AddrRegImm sp (ImmInt 20)) `snocOL` LD II32 r11 (AddrRegImm dynReg (ImmInt 0)) `snocOL` LD II32 toc (AddrRegImm dynReg (ImmInt 4)) `snocOL` MTCTR r11 `snocOL` LD II32 r11 (AddrRegImm dynReg (ImmInt 8)) `snocOL` BCTRL usedRegs + `snocOL` LD spFormat toc (AddrRegImm sp (ImmInt 20)) `appOL` codeAfter) _ -> return ( dynCode `snocOL` MTCTR dynReg @@ -1271,30 +1282,6 @@ genCCall' dflags gcp target dest_regs args DELTA (-delta)] | otherwise = nilOL where delta = stackDelta finalStack - toc_before = case gcp of - GCPLinux64ELF 1 -> unitOL $ ST spFormat toc (AddrRegImm sp (ImmInt 40)) - GCPLinux64ELF 2 -> unitOL $ ST spFormat toc (AddrRegImm sp (ImmInt 24)) - GCPAIX -> unitOL $ ST spFormat toc (AddrRegImm sp (ImmInt 20)) - _ -> nilOL - toc_after labelOrExpr = case gcp of - GCPLinux64ELF 1 -> case labelOrExpr of - Left _ -> toOL [ NOP ] - Right _ -> toOL [ LD spFormat toc - (AddrRegImm sp - (ImmInt 40)) - ] - GCPLinux64ELF 2 -> case labelOrExpr of - Left _ -> toOL [ NOP ] - Right _ -> toOL [ LD spFormat toc - (AddrRegImm sp - (ImmInt 24)) - ] - GCPAIX -> case labelOrExpr of - Left _ -> unitOL NOP - Right _ -> unitOL (LD spFormat toc - (AddrRegImm sp - (ImmInt 20))) - _ -> nilOL move_sp_up finalStack | delta > 64 = -- TODO: fix-up stack back-chain toOL [ADD sp sp (RIImm (ImmInt delta)), @@ -1302,6 +1289,19 @@ genCCall' dflags gcp target dest_regs args | otherwise = nilOL where delta = stackDelta finalStack + -- A NOP instruction is required after a call (bl instruction) + -- on AIX and 64-Bit Linux. + -- If the call is to a function with a different TOC (r2) the + -- link editor replaces the NOP instruction with a load of the TOC + -- from the stack to restore the TOC. + maybeNOP = case gcp of + -- See Section 3.9.4 of OpenPower ABI + GCPAIX -> unitOL NOP + -- See Section 3.5.11 of PPC64 ELF v1.9 + GCPLinux64ELF 1 -> unitOL NOP + -- See Section 2.3.6 of PPC64 ELF v2 + GCPLinux64ELF 2 -> unitOL NOP + _ -> nilOL passArguments [] _ _ stackOffset accumCode accumUsed = return (stackOffset, accumCode, accumUsed) passArguments ((arg,arg_ty):args) gprs fprs stackOffset From git at git.haskell.org Thu Aug 25 15:04:27 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 25 Aug 2016 15:04:27 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Second attempt to fix sizeExpr (498009a) Message-ID: <20160825150427.B74FC3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/498009a904a1e8910f9e0e527f6eb6c8073c8a76/ghc >--------------------------------------------------------------- commit 498009a904a1e8910f9e0e527f6eb6c8073c8a76 Author: Simon Marlow Date: Fri Jun 17 11:21:52 2016 +0100 Second attempt to fix sizeExpr Summary: Background: * sizeExpr was calculating expressions like ((e `cast` T) x) wrongly * Fixing it caused regressions in compile performance, and one nofib program (k-nucleotide) I managed to fix the source of the compiler regressions. I think it was due to traceTc not being inlined, which I fixed in a more robust way by putting an export list on TcRnMonad. The k-nucleotide regression is more difficult. I don't think anything is actually going wrong, but this program has been highly tuned and is quite sensitive to changing in inlining behaviour. I managed to recover most of the performance by manual lambda-lifting which makes it a bit less fragile, but the end result was a bit slower. I don't think this is disastrous, the program is pretty horrible to begin with and we could probably make a faster one by starting from scratch. Test Plan: validate, nofib Reviewers: simonpj, bgamari, niteria, austin, erikd Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2338 GHC Trac Issues: #11564 (cherry picked from commit a47b62cb36853d03c77ef63b3208b3d869fb687e) >--------------------------------------------------------------- 498009a904a1e8910f9e0e527f6eb6c8073c8a76 compiler/coreSyn/CoreUnfold.hs | 66 ++++++++++++++------- compiler/typecheck/TcRnMonad.hs | 127 +++++++++++++++++++++++++++++++++++++--- 2 files changed, 163 insertions(+), 30 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 498009a904a1e8910f9e0e527f6eb6c8073c8a76 From git at git.haskell.org Thu Aug 25 15:04:31 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 25 Aug 2016 15:04:31 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Fix #11974 by adding a more smarts to TcDefaults. (37bfc6c) Message-ID: <20160825150431.8EBBF3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/37bfc6c91f02f6696aee875fbcc8acd0f7a6317b/ghc >--------------------------------------------------------------- commit 37bfc6c91f02f6696aee875fbcc8acd0f7a6317b Author: Richard Eisenberg Date: Fri Apr 22 22:28:35 2016 -0400 Fix #11974 by adding a more smarts to TcDefaults. Test cases: typecheck/should_compile/T11974 typecheck/should_fail/T11974b (cherry picked from commit 9a34bf1985035858ece043bf38b47b6ff4b88efb) >--------------------------------------------------------------- 37bfc6c91f02f6696aee875fbcc8acd0f7a6317b compiler/prelude/PrelNames.hs | 12 +++++++ compiler/typecheck/TcDefaults.hs | 37 ++++++++++++---------- compiler/typecheck/TcSimplify.hs | 2 +- testsuite/tests/typecheck/should_compile/T11974.hs | 5 +++ testsuite/tests/typecheck/should_compile/all.T | 1 + testsuite/tests/typecheck/should_fail/T11974b.hs | 7 ++++ .../tests/typecheck/should_fail/T11974b.stderr | 15 +++++++++ testsuite/tests/typecheck/should_fail/all.T | 1 + 8 files changed, 62 insertions(+), 18 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 37bfc6c91f02f6696aee875fbcc8acd0f7a6317b From git at git.haskell.org Thu Aug 25 15:04:35 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 25 Aug 2016 15:04:35 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Deal correctly with unused imports for 'coerce' (6c28f24) Message-ID: <20160825150435.034953A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/6c28f24aa8202f79db49b85b815011703d647fd9/ghc >--------------------------------------------------------------- commit 6c28f24aa8202f79db49b85b815011703d647fd9 Author: Simon Peyton Jones Date: Tue Jun 28 12:13:13 2016 +0100 Deal correctly with unused imports for 'coerce' We only do newtype unwrapping for Coercible constraints if the newtype's data constructor is in scope. We were trying to record the fact that the data constructor was thereby 'used', so that an import statement would not be flagged as unnecsssary (by -Wunused-imports). But the code was simply wrong. It was wrong because it assumed that only one level of unwrapping happened, whereas tcTopNormaliseNewTypeTF_maybe actually unwraps multiple layers. So we need to return a /list/ of data constructors that are used. This entailed a bit of refactoring, as usual. Fixes Trac #12067 (cherry picked from commit 23b80ac41cc945cea0fc6ff9ade6b4be8aa81b7f) >--------------------------------------------------------------- 6c28f24aa8202f79db49b85b815011703d647fd9 compiler/typecheck/FamInst.hs | 36 ++++++---- compiler/typecheck/TcCanonical.hs | 22 +++--- compiler/typecheck/TcSMonad.hs | 8 +-- compiler/types/Coercion.hs | 80 ++++++++++++---------- compiler/types/FamInstEnv.hs | 2 +- compiler/types/TyCon.hs | 5 ++ testsuite/tests/typecheck/should_compile/T12067.hs | 9 +++ .../tests/typecheck/should_compile/T12067a.hs | 6 ++ testsuite/tests/typecheck/should_compile/all.T | 2 + 9 files changed, 102 insertions(+), 68 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 6c28f24aa8202f79db49b85b815011703d647fd9 From git at git.haskell.org Thu Aug 25 15:04:37 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 25 Aug 2016 15:04:37 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Fix pretty-printer for IfaceCo (ba9dd63) Message-ID: <20160825150437.AE2AD3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/ba9dd63ad8e3498268db24ab66bcae002a9d5120/ghc >--------------------------------------------------------------- commit ba9dd63ad8e3498268db24ab66bcae002a9d5120 Author: Simon Peyton Jones Date: Wed Jun 29 23:21:49 2016 +0100 Fix pretty-printer for IfaceCo As Trac #12242 showed, there was a missing case in the pretty printer for IfaceCo. I've refactored it so that the pattern-match ovelap checker will spot it next time. (cherry picked from commit 24194a6aed950ed4c3733e3c582abf8a15d98ffd) >--------------------------------------------------------------- ba9dd63ad8e3498268db24ab66bcae002a9d5120 compiler/iface/IfaceType.hs | 27 ++++++++++++++++----------- 1 file changed, 16 insertions(+), 11 deletions(-) diff --git a/compiler/iface/IfaceType.hs b/compiler/iface/IfaceType.hs index 45732ca..608762d 100644 --- a/compiler/iface/IfaceType.hs +++ b/compiler/iface/IfaceType.hs @@ -922,17 +922,22 @@ ppr_co ctxt_prec (IfaceInstCo co ty) ppr_co ctxt_prec (IfaceAxiomRuleCo tc cos) = maybeParen ctxt_prec TyConPrec $ ppr tc <+> parens (interpp'SP cos) -ppr_co ctxt_prec co - = ppr_special_co ctxt_prec doc cos - where (doc, cos) = case co of - { IfaceAxiomInstCo n i cos -> (ppr n <> brackets (ppr i), cos) - ; IfaceSymCo co -> (text "Sym", [co]) - ; IfaceTransCo co1 co2 -> (text "Trans", [co1,co2]) - ; IfaceNthCo d co -> (text "Nth:" <> int d, - [co]) - ; IfaceLRCo lr co -> (ppr lr, [co]) - ; IfaceSubCo co -> (text "Sub", [co]) - ; _ -> panic "pprIfaceCo" } +ppr_co ctxt_prec (IfaceAxiomInstCo n i cos) + = ppr_special_co ctxt_prec (ppr n <> brackets (ppr i)) cos +ppr_co ctxt_prec (IfaceSymCo co) + = ppr_special_co ctxt_prec (text "Sym") [co] +ppr_co ctxt_prec (IfaceTransCo co1 co2) + = ppr_special_co ctxt_prec (text "Trans") [co1,co2] +ppr_co ctxt_prec (IfaceNthCo d co) + = ppr_special_co ctxt_prec (text "Nth:" <> int d) [co] +ppr_co ctxt_prec (IfaceLRCo lr co) + = ppr_special_co ctxt_prec (ppr lr) [co] +ppr_co ctxt_prec (IfaceSubCo co) + = ppr_special_co ctxt_prec (text "Sub") [co] +ppr_co ctxt_prec (IfaceCoherenceCo co1 co2) + = ppr_special_co ctxt_prec (text "Coh") [co1,co2] +ppr_co ctxt_prec (IfaceKindCo co) + = ppr_special_co ctxt_prec (text "Kind") [co] ppr_special_co :: TyPrec -> SDoc -> [IfaceCoercion] -> SDoc ppr_special_co ctxt_prec doc cos From git at git.haskell.org Thu Aug 25 15:04:40 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 25 Aug 2016 15:04:40 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Pretty: delete really old changelog (f4c7d37) Message-ID: <20160825150440.640B93A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/f4c7d37a3603af7459ab7c1f9ebcdf157251af0b/ghc >--------------------------------------------------------------- commit f4c7d37a3603af7459ab7c1f9ebcdf157251af0b Author: Thomas Miedema Date: Mon Jul 11 17:59:59 2016 +0200 Pretty: delete really old changelog This changelog is very incomplete, and basically useless. I'm removing it, because it made it harder to compare this copy of `Pretty.hs` with the copy in `libraries/pretty` (from which a similar changelog was deleted some time ago). (cherry picked from commit 372dbc4e78abfb6b5d72c0fea27a1c858c5cd797) >--------------------------------------------------------------- f4c7d37a3603af7459ab7c1f9ebcdf157251af0b compiler/utils/Pretty.hs | 174 ++++++----------------------------------------- 1 file changed, 20 insertions(+), 154 deletions(-) diff --git a/compiler/utils/Pretty.hs b/compiler/utils/Pretty.hs index 74d69f2..ab7db59 100644 --- a/compiler/utils/Pretty.hs +++ b/compiler/utils/Pretty.hs @@ -1,161 +1,27 @@ {-# LANGUAGE BangPatterns #-} -{- -********************************************************************************* -* * -* John Hughes's and Simon Peyton Jones's Pretty Printer Combinators * -* * -* based on "The Design of a Pretty-printing Library" * -* in Advanced Functional Programming, * -* Johan Jeuring and Erik Meijer (eds), LNCS 925 * -* http://www.cs.chalmers.se/~rjmh/Papers/pretty.ps * -* * -* Heavily modified by Simon Peyton Jones, Dec 96 * -* * -********************************************************************************* - -Version 3.0 28 May 1997 - * Cured massive performance bug. If you write - - foldl <> empty (map (text.show) [1..10000]) - - you get quadratic behaviour with V2.0. Why? For just the same reason as you get - quadratic behaviour with left-associated (++) chains. - - This is really bad news. One thing a pretty-printer abstraction should - certainly guarantee is insensivity to associativity. It matters: suddenly - GHC's compilation times went up by a factor of 100 when I switched to the - new pretty printer. - - I fixed it with a bit of a hack (because I wanted to get GHC back on the - road). I added two new constructors to the Doc type, Above and Beside: - - <> = Beside - $$ = Above - - Then, where I need to get to a "TextBeside" or "NilAbove" form I "force" - the Doc to squeeze out these suspended calls to Beside and Above; but in so - doing I re-associate. It's quite simple, but I'm not satisfied that I've done - the best possible job. I'll send you the code if you are interested. - - * Added new exports: - punctuate, hang - int, integer, float, double, rational, - lparen, rparen, lbrack, rbrack, lbrace, rbrace, - - * fullRender's type signature has changed. Rather than producing a string it - now takes an extra couple of arguments that tells it how to glue fragments - of output together: - - fullRender :: Mode - -> Int -- Line length - -> Float -- Ribbons per line - -> (TextDetails -> a -> a) -- What to do with text - -> a -- What to do at the end - -> Doc - -> a -- Result - - The "fragments" are encapsulated in the TextDetails data type: - data TextDetails = Chr Char - | Str String - | PStr FastString - - The Chr and Str constructors are obvious enough. The PStr constructor has a packed - string (FastString) inside it. It's generated by using the new "ptext" export. - - An advantage of this new setup is that you can get the renderer to do output - directly (by passing in a function of type (TextDetails -> IO () -> IO ()), - rather than producing a string that you then print. - - -Version 2.0 24 April 1997 - * Made empty into a left unit for <> as well as a right unit; - it is also now true that - nest k empty = empty - which wasn't true before. - - * Fixed an obscure bug in sep that occasionally gave very weird behaviour - - * Added $+$ - - * Corrected and tidied up the laws and invariants - -====================================================================== -Relative to John's original paper, there are the following new features: - -1. There's an empty document, "empty". It's a left and right unit for - both <> and $$, and anywhere in the argument list for - sep, hcat, hsep, vcat, fcat etc. - - It is Really Useful in practice. - -2. There is a paragraph-fill combinator, fsep, that's much like sep, - only it keeps fitting things on one line until it can't fit any more. - -3. Some random useful extra combinators are provided. - <+> puts its arguments beside each other with a space between them, - unless either argument is empty in which case it returns the other - +{-# LANGUAGE MagicHash #-} - hcat is a list version of <> - hsep is a list version of <+> - vcat is a list version of $$ - - sep (separate) is either like hsep or like vcat, depending on what fits - - cat is behaves like sep, but it uses <> for horizontal conposition - fcat is behaves like fsep, but it uses <> for horizontal conposition - - These new ones do the obvious things: - char, semi, comma, colon, space, - parens, brackets, braces, - quotes, quote, doubleQuotes - -4. The "above" combinator, $$, now overlaps its two arguments if the - last line of the top argument stops before the first line of the second begins. - For example: text "hi" $$ nest 5 "there" - lays out as - hi there - rather than - hi - there - - There are two places this is really useful - - a) When making labelled blocks, like this: - Left -> code for left - Right -> code for right - LongLongLongLabel -> - code for longlonglonglabel - The block is on the same line as the label if the label is - short, but on the next line otherwise. - - b) When laying out lists like this: - [ first - , second - , third - ] - which some people like. But if the list fits on one line - you want [first, second, third]. You can't do this with - John's original combinators, but it's quite easy with the - new $$. - - The combinator $+$ gives the original "never-overlap" behaviour. - -5. Several different renderers are provided: - * a standard one - * one that uses cut-marks to avoid deeply-nested documents - simply piling up in the right-hand margin - * one that ignores indentation (fewer chars output; good for machines) - * one that ignores indentation and newlines (ditto, only more so) - -6. Numerous implementation tidy-ups - Use of unboxed data types to speed up the implementation --} - - -{-# LANGUAGE BangPatterns, CPP, MagicHash #-} +----------------------------------------------------------------------------- +-- | +-- Module : Pretty +-- Copyright : (c) The University of Glasgow 2001 +-- License : BSD-style (see the file LICENSE) +-- +-- Maintainer : David Terei +-- Stability : stable +-- Portability : portable +-- +-- John Hughes's and Simon Peyton Jones's Pretty Printer Combinators +-- +-- Based on /The Design of a Pretty-printing Library/ +-- in Advanced Functional Programming, +-- Johan Jeuring and Erik Meijer (eds), LNCS 925 +-- +-- +----------------------------------------------------------------------------- module Pretty ( + -- * The document type Doc, TextDetails(..), From git at git.haskell.org Thu Aug 25 15:04:43 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 25 Aug 2016 15:04:43 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Enum: Ensure that operations on Word fuse (f26e58b) Message-ID: <20160825150443.1F7753A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/f26e58bfcad4155d5e2cefcaba5408f0466bfb5e/ghc >--------------------------------------------------------------- commit f26e58bfcad4155d5e2cefcaba5408f0466bfb5e Author: Ben Gamari Date: Mon Jul 4 14:36:44 2016 +0200 Enum: Ensure that operations on Word fuse Test Plan: Validate, verify fusion Reviewers: austin, hvr Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2376 GHC Trac Issues: #12354 (cherry picked from commit 0bd7c4b4240a27d4e26290741394b31b48db7671) >--------------------------------------------------------------- f26e58bfcad4155d5e2cefcaba5408f0466bfb5e libraries/base/GHC/Enum.hs | 152 ++++++++++++++++++++++++++++++++++++++++----- 1 file changed, 138 insertions(+), 14 deletions(-) diff --git a/libraries/base/GHC/Enum.hs b/libraries/base/GHC/Enum.hs index 729b801..97049a0 100644 --- a/libraries/base/GHC/Enum.hs +++ b/libraries/base/GHC/Enum.hs @@ -636,26 +636,150 @@ instance Enum Word where | x <= maxIntWord = I# (word2Int# x#) | otherwise = fromEnumError "Word" x - enumFrom n = map integerToWordX [wordToIntegerX n .. wordToIntegerX (maxBound :: Word)] - enumFromTo n1 n2 = map integerToWordX [wordToIntegerX n1 .. wordToIntegerX n2] - enumFromThenTo n1 n2 m = map integerToWordX [wordToIntegerX n1, wordToIntegerX n2 .. wordToIntegerX m] - enumFromThen n1 n2 = map integerToWordX [wordToIntegerX n1, wordToIntegerX n2 .. wordToIntegerX limit] - where - limit :: Word - limit | n2 >= n1 = maxBound - | otherwise = minBound + {-# INLINE enumFrom #-} + enumFrom (W# x#) = eftWord x# maxWord# + where !(W# maxWord#) = maxBound + -- Blarg: technically I guess enumFrom isn't strict! + + {-# INLINE enumFromTo #-} + enumFromTo (W# x) (W# y) = eftWord x y + + {-# INLINE enumFromThen #-} + enumFromThen (W# x1) (W# x2) = efdWord x1 x2 + + {-# INLINE enumFromThenTo #-} + enumFromThenTo (W# x1) (W# x2) (W# y) = efdtWord x1 x2 y maxIntWord :: Word -- The biggest word representable as an Int maxIntWord = W# (case maxInt of I# i -> int2Word# i) --- For some reason integerToWord and wordToInteger (GHC.Integer.Type) --- work over Word# -integerToWordX :: Integer -> Word -integerToWordX i = W# (integerToWord i) +----------------------------------------------------- +-- eftWord and eftWordFB deal with [a..b], which is the +-- most common form, so we take a lot of care +-- In particular, we have rules for deforestation + +{-# RULES +"eftWord" [~1] forall x y. eftWord x y = build (\ c n -> eftWordFB c n x y) +"eftWordList" [1] eftWordFB (:) [] = eftWord + #-} + +-- The Enum rules for Word work much the same way that they do for Int. +-- See Note [How the Enum rules work]. -wordToIntegerX :: Word -> Integer -wordToIntegerX (W# x#) = wordToInteger x# +{-# NOINLINE [1] eftWord #-} +eftWord :: Word# -> Word# -> [Word] +-- [x1..x2] +eftWord x0 y | isTrue# (x0 `gtWord#` y) = [] + | otherwise = go x0 + where + go x = W# x : if isTrue# (x `eqWord#` y) + then [] + else go (x `plusWord#` 1##) + +{-# INLINE [0] eftWordFB #-} +eftWordFB :: (Word -> r -> r) -> r -> Word# -> Word# -> r +eftWordFB c n x0 y | isTrue# (x0 `gtWord#` y) = n + | otherwise = go x0 + where + go x = W# x `c` if isTrue# (x `eqWord#` y) + then n + else go (x `plusWord#` 1##) + -- Watch out for y=maxBound; hence ==, not > + -- Be very careful not to have more than one "c" + -- so that when eftInfFB is inlined we can inline + -- whatever is bound to "c" + + +----------------------------------------------------- +-- efdWord and efdtWord deal with [a,b..] and [a,b..c]. +-- The code is more complicated because of worries about Word overflow. + +-- See Note [How the Enum rules work] +{-# RULES +"efdtWord" [~1] forall x1 x2 y. + efdtWord x1 x2 y = build (\ c n -> efdtWordFB c n x1 x2 y) +"efdtWordUpList" [1] efdtWordFB (:) [] = efdtWord + #-} + +efdWord :: Word# -> Word# -> [Word] +-- [x1,x2..maxWord] +efdWord x1 x2 + | isTrue# (x2 `geWord#` x1) = case maxBound of W# y -> efdtWordUp x1 x2 y + | otherwise = case minBound of W# y -> efdtWordDn x1 x2 y + +{-# NOINLINE [1] efdtWord #-} +efdtWord :: Word# -> Word# -> Word# -> [Word] +-- [x1,x2..y] +efdtWord x1 x2 y + | isTrue# (x2 `geWord#` x1) = efdtWordUp x1 x2 y + | otherwise = efdtWordDn x1 x2 y + +{-# INLINE [0] efdtWordFB #-} +efdtWordFB :: (Word -> r -> r) -> r -> Word# -> Word# -> Word# -> r +efdtWordFB c n x1 x2 y + | isTrue# (x2 `geWord#` x1) = efdtWordUpFB c n x1 x2 y + | otherwise = efdtWordDnFB c n x1 x2 y + +-- Requires x2 >= x1 +efdtWordUp :: Word# -> Word# -> Word# -> [Word] +efdtWordUp x1 x2 y -- Be careful about overflow! + | isTrue# (y `ltWord#` x2) = if isTrue# (y `ltWord#` x1) then [] else [W# x1] + | otherwise = -- Common case: x1 <= x2 <= y + let !delta = x2 `minusWord#` x1 -- >= 0 + !y' = y `minusWord#` delta -- x1 <= y' <= y; hence y' is representable + + -- Invariant: x <= y + -- Note that: z <= y' => z + delta won't overflow + -- so we are guaranteed not to overflow if/when we recurse + go_up x | isTrue# (x `gtWord#` y') = [W# x] + | otherwise = W# x : go_up (x `plusWord#` delta) + in W# x1 : go_up x2 + +-- Requires x2 >= x1 +efdtWordUpFB :: (Word -> r -> r) -> r -> Word# -> Word# -> Word# -> r +efdtWordUpFB c n x1 x2 y -- Be careful about overflow! + | isTrue# (y `ltWord#` x2) = if isTrue# (y `ltWord#` x1) then n else W# x1 `c` n + | otherwise = -- Common case: x1 <= x2 <= y + let !delta = x2 `minusWord#` x1 -- >= 0 + !y' = y `minusWord#` delta -- x1 <= y' <= y; hence y' is representable + + -- Invariant: x <= y + -- Note that: z <= y' => z + delta won't overflow + -- so we are guaranteed not to overflow if/when we recurse + go_up x | isTrue# (x `gtWord#` y') = W# x `c` n + | otherwise = W# x `c` go_up (x `plusWord#` delta) + in W# x1 `c` go_up x2 + +-- Requires x2 <= x1 +efdtWordDn :: Word# -> Word# -> Word# -> [Word] +efdtWordDn x1 x2 y -- Be careful about underflow! + | isTrue# (y `gtWord#` x2) = if isTrue# (y `gtWord#` x1) then [] else [W# x1] + | otherwise = -- Common case: x1 >= x2 >= y + let !delta = x2 `minusWord#` x1 -- <= 0 + !y' = y `minusWord#` delta -- y <= y' <= x1; hence y' is representable + + -- Invariant: x >= y + -- Note that: z >= y' => z + delta won't underflow + -- so we are guaranteed not to underflow if/when we recurse + go_dn x | isTrue# (x `ltWord#` y') = [W# x] + | otherwise = W# x : go_dn (x `plusWord#` delta) + in W# x1 : go_dn x2 + +-- Requires x2 <= x1 +efdtWordDnFB :: (Word -> r -> r) -> r -> Word# -> Word# -> Word# -> r +efdtWordDnFB c n x1 x2 y -- Be careful about underflow! + | isTrue# (y `gtWord#` x2) = if isTrue# (y `gtWord#` x1) then n else W# x1 `c` n + | otherwise = -- Common case: x1 >= x2 >= y + let !delta = x2 `minusWord#` x1 -- <= 0 + !y' = y `minusWord#` delta -- y <= y' <= x1; hence y' is representable + + -- Invariant: x >= y + -- Note that: z >= y' => z + delta won't underflow + -- so we are guaranteed not to underflow if/when we recurse + go_dn x | isTrue# (x `ltWord#` y') = W# x `c` n + | otherwise = W# x `c` go_dn (x `plusWord#` delta) + in W# x1 `c` go_dn x2 ------------------------------------------------------------------------ -- Integer From git at git.haskell.org Thu Aug 25 15:04:46 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 25 Aug 2016 15:04:46 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Make DeriveFunctor work with unboxed tuples (1f862ac) Message-ID: <20160825150446.48ABC3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/1f862acbd7d38b28a205002cded4f7b8824262e5/ghc >--------------------------------------------------------------- commit 1f862acbd7d38b28a205002cded4f7b8824262e5 Author: Ryan Scott Date: Mon Jul 18 09:28:42 2016 -0400 Make DeriveFunctor work with unboxed tuples Summary: Unboxed tuples have `RuntimeRep` arguments which `-XDeriveFunctor` was mistaking for actual data constructor arguments. As a result, a derived `Functor` instance for a datatype that contained an unboxed tuple would generate twice as many arguments as it needed for an unboxed tuple pattern match or expression. The solution is to simply put `dropRuntimeRepArgs` in the right place. Fixes #12399. Test Plan: ./validate Reviewers: austin, hvr, bgamari Reviewed By: bgamari Subscribers: thomie, osa1 Differential Revision: https://phabricator.haskell.org/D2404 GHC Trac Issues: #12399 (cherry picked from commit 3fa3fe8a9a8afa67829e12efa5d25b76e58a185a) >--------------------------------------------------------------- 1f862acbd7d38b28a205002cded4f7b8824262e5 compiler/typecheck/TcGenDeriv.hs | 8 ++++++-- testsuite/tests/deriving/should_compile/T12399.hs | 7 +++++++ testsuite/tests/deriving/should_compile/all.T | 1 + 3 files changed, 14 insertions(+), 2 deletions(-) diff --git a/compiler/typecheck/TcGenDeriv.hs b/compiler/typecheck/TcGenDeriv.hs index e5b7ba2..f2da4dd 100644 --- a/compiler/typecheck/TcGenDeriv.hs +++ b/compiler/typecheck/TcGenDeriv.hs @@ -1658,7 +1658,11 @@ functorLikeTraverse var (FT { ft_triv = caseTrivial, ft_var = caseVar = (caseTyApp fun_ty (last xrs), True) | otherwise = (caseWrongArg, True) -- Non-decomposable (eg type function) where - (xrs,xcs) = unzip (map (go co) args) + -- When folding over an unboxed tuple, we must explicitly drop the + -- runtime rep arguments, or else GHC will generate twice as many + -- variables in a unboxed tuple pattern match and expression as it + -- actually needs. See Trac #12399 + (xrs,xcs) = unzip (map (go co) (dropRuntimeRepArgs args)) go _ (ForAllTy (Named _ Visible) _) = panic "unexpected visible binder" go co (ForAllTy (Named v _) x) | v /= var && xc = (caseForAll v xr,True) where (xr,xc) = go co x @@ -2727,7 +2731,7 @@ a is the last type variable in a given datatype): * ft_tup: A tuple type which mentions the last type variable in at least one of its fields. The TyCon argument of ft_tup represents the particular tuple's type constructor. - Examples: (a, Int), (Maybe a, [a], Either a Int) + Examples: (a, Int), (Maybe a, [a], Either a Int), (# Int, a #) * ft_ty_app: A type is being applied to the last type parameter, where the applied type does not mention the last type parameter (if it diff --git a/testsuite/tests/deriving/should_compile/T12399.hs b/testsuite/tests/deriving/should_compile/T12399.hs new file mode 100644 index 0000000..c3429f8 --- /dev/null +++ b/testsuite/tests/deriving/should_compile/T12399.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE DeriveFunctor, MagicHash, UnboxedTuples #-} +module T12399 where + +import GHC.Exts + +newtype RmLoopsM a = RmLoopsM { runRmLoops :: Int# -> (# Int#, a #) } + deriving Functor diff --git a/testsuite/tests/deriving/should_compile/all.T b/testsuite/tests/deriving/should_compile/all.T index 9017687..6b37420 100644 --- a/testsuite/tests/deriving/should_compile/all.T +++ b/testsuite/tests/deriving/should_compile/all.T @@ -71,3 +71,4 @@ test('T11732b', normal, compile, ['']) test('T11732c', normal, compile, ['']) test('T11833', normal, compile, ['']) test('T11837', normal, compile, ['']) +test('T12399', normal, compile, ['']) From git at git.haskell.org Thu Aug 25 15:04:48 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 25 Aug 2016 15:04:48 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Bugfix for bug 11632: `readLitChar` should consume null characters (1c53ac1) Message-ID: <20160825150448.EE73E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/1c53ac17ee8716ec07d782079462f4218d8f0606/ghc >--------------------------------------------------------------- commit 1c53ac17ee8716ec07d782079462f4218d8f0606 Author: Ben Gamari Date: Sun Jul 17 00:12:52 2016 +0200 Bugfix for bug 11632: `readLitChar` should consume null characters Test Plan: The tests have been included. This change deals with a relatively minor edge case and should not break unrelated functionality. Reviewers: thomie, #core_libraries_committee, ekmett, bgamari Reviewed By: #core_libraries_committee, ekmett, bgamari Subscribers: bgamari, ekmett Differential Revision: https://phabricator.haskell.org/D2391 GHC Trac Issues: #11632 (cherry picked from commit 0f0cdb6827803015a9a3924fdafaef8dbcde048f) >--------------------------------------------------------------- 1c53ac17ee8716ec07d782079462f4218d8f0606 libraries/base/GHC/Read.hs | 8 +++++++- libraries/base/Text/Read/Lex.hs | 11 ++++++++++- libraries/base/tests/readLitChar.hs | 5 ++++- libraries/base/tests/readLitChar.stdout | 4 ++++ 4 files changed, 25 insertions(+), 3 deletions(-) diff --git a/libraries/base/GHC/Read.hs b/libraries/base/GHC/Read.hs index b4b88c0..5681899 100644 --- a/libraries/base/GHC/Read.hs +++ b/libraries/base/GHC/Read.hs @@ -229,7 +229,13 @@ lex s = readP_to_S L.hsLex s -- lexLitChar :: ReadS String -- As defined by H2010 lexLitChar = readP_to_S (do { (s, _) <- P.gather L.lexChar ; - return s }) + let s' = removeNulls s in + return s' }) + where + -- remove nulls from end of the character if they exist + removeNulls [] = [] + removeNulls ('\\':'&':xs) = removeNulls xs + removeNulls (first:rest) = first : removeNulls rest -- There was a skipSpaces before the P.gather L.lexChar, -- but that seems inconsistent with readLitChar diff --git a/libraries/base/Text/Read/Lex.hs b/libraries/base/Text/Read/Lex.hs index 7054be9..d0d39c6 100644 --- a/libraries/base/Text/Read/Lex.hs +++ b/libraries/base/Text/Read/Lex.hs @@ -253,7 +253,16 @@ lexLitChar = return (Char c) lexChar :: ReadP Char -lexChar = do { (c,_) <- lexCharE; return c } +lexChar = do { (c,_) <- lexCharE; consumeEmpties; return c } + where + -- Consumes the string "\&" repeatedly and greedily (will only produce one match) + consumeEmpties :: ReadP () + consumeEmpties = do + rest <- look + case rest of + ('\\':'&':_) -> string "\\&" >> consumeEmpties + _ -> return () + lexCharE :: ReadP (Char, Bool) -- "escaped or not"? lexCharE = diff --git a/libraries/base/tests/readLitChar.hs b/libraries/base/tests/readLitChar.hs index 7dc01e3..e287d22 100644 --- a/libraries/base/tests/readLitChar.hs +++ b/libraries/base/tests/readLitChar.hs @@ -9,4 +9,7 @@ main = putStrLn (show $ readLitChar "'A'") putStrLn (show $ lexLitChar "A") putStrLn (show $ lexLitChar "'A'") - + putStrLn (show $ lexLitChar "\\243\\&1") + putStrLn (show $ lexLitChar "a\\&1") + putStrLn (show $ lexLitChar "a\\&\\&1") + putStrLn (show $ lexLitChar "a\\&\\&") diff --git a/libraries/base/tests/readLitChar.stdout b/libraries/base/tests/readLitChar.stdout index 649c342..db7bc5b 100644 --- a/libraries/base/tests/readLitChar.stdout +++ b/libraries/base/tests/readLitChar.stdout @@ -2,3 +2,7 @@ [('\'',"A'")] [("A","")] [("'","A'")] +[("\\243","1")] +[("a","1")] +[("a","1")] +[("a","")] From git at git.haskell.org Thu Aug 25 15:04:52 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 25 Aug 2016 15:04:52 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Pretty: remove a harmful $! (#12227) (2756af8) Message-ID: <20160825150452.104B13A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/2756af87aebee769ffca959adc4b9dc607a49fdb/ghc >--------------------------------------------------------------- commit 2756af87aebee769ffca959adc4b9dc607a49fdb Author: Thomas Miedema Date: Sun Jul 17 00:13:45 2016 +0200 Pretty: remove a harmful $! (#12227) This is backport of [1] for GHC's copy of Pretty. See Note [Differences between libraries/pretty and compiler/utils/Pretty.hs]. [1] http://git.haskell.org/packages/pretty.git/commit/bbe9270c5f849a5bb74c9166a5f4202cfb0dba22 https://github.com/haskell/pretty/issues/32 https://github.com/haskell/pretty/pull/35 Reviewers: bgamari, austin Reviewed By: austin Differential Revision: https://phabricator.haskell.org/D2397 GHC Trac Issues: #12227 (cherry picked from commit 89a8be71a3715c948cebcb19ac81f84da0e6270e) >--------------------------------------------------------------- 2756af87aebee769ffca959adc4b9dc607a49fdb compiler/utils/Pretty.hs | 45 ++++++++++- testsuite/tests/perf/compiler/T12227.hs | 137 ++++++++++++++++++++++++++++++++ testsuite/tests/perf/compiler/all.T | 21 ++++- 3 files changed, 200 insertions(+), 3 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 2756af87aebee769ffca959adc4b9dc607a49fdb From git at git.haskell.org Thu Aug 25 15:04:55 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 25 Aug 2016 15:04:55 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Fix Template Haskell reification of unboxed tuple types (3470f82) Message-ID: <20160825150455.9E9343A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/3470f82fbd7039f9957761c5a12988fd558d6cb8/ghc >--------------------------------------------------------------- commit 3470f82fbd7039f9957761c5a12988fd558d6cb8 Author: Ryan Scott Date: Mon Jul 18 09:29:05 2016 -0400 Fix Template Haskell reification of unboxed tuple types Summary: Previously, Template Haskell reified unboxed tuple types as boxed tuples with twice the appropriate arity. Fixes #12403. Test Plan: make test TEST=T12403 Reviewers: hvr, goldfire, austin, bgamari Reviewed By: goldfire Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2405 GHC Trac Issues: #12403 (cherry picked from commit 514c4a4741f3881672f1ccc1fe6d08a5d596bb87) >--------------------------------------------------------------- 3470f82fbd7039f9957761c5a12988fd558d6cb8 compiler/typecheck/TcSplice.hs | 4 +- docs/users_guide/8.0.2-notes.rst | 59 ++++++++++++++++++++++ .../tests/th/{T10697_decided_1.hs => T12403.hs} | 5 +- testsuite/tests/th/T12403.stdout | 1 + testsuite/tests/th/all.T | 2 + 5 files changed, 68 insertions(+), 3 deletions(-) diff --git a/compiler/typecheck/TcSplice.hs b/compiler/typecheck/TcSplice.hs index 82853e1..06b4932 100644 --- a/compiler/typecheck/TcSplice.hs +++ b/compiler/typecheck/TcSplice.hs @@ -1733,7 +1733,9 @@ reify_tc_app tc tys tc_binders = tyConBinders tc tc_res_kind = tyConResKind tc - r_tc | isTupleTyCon tc = if isPromotedDataCon tc + r_tc | isUnboxedTupleTyCon tc = TH.UnboxedTupleT (arity `div` 2) + -- See Note [Unboxed tuple RuntimeRep vars] in TyCon + | isTupleTyCon tc = if isPromotedDataCon tc then TH.PromotedTupleT arity else TH.TupleT arity | tc `hasKey` listTyConKey = TH.ListT diff --git a/docs/users_guide/8.0.2-notes.rst b/docs/users_guide/8.0.2-notes.rst new file mode 100644 index 0000000..39ad028 --- /dev/null +++ b/docs/users_guide/8.0.2-notes.rst @@ -0,0 +1,59 @@ +.. _release-8-0-2: + +Release notes for version 8.0.2 +=============================== + +TODO FIXME + +Highlights +---------- + +TODO FIXME. + +Full details +------------ + +Language +~~~~~~~~ + +- TODO FIXME. + +- :ghc-flag:`-XStaticPointers` now allows the body of the ``static`` form to + refer to closed local bindings. For instance, this is now permitted: + ``f = static x where x = 'a'``. + +Compiler +~~~~~~~~ + +- TODO FIXME. + +- The :ghc-flag:`-ddump-cmm` now dumps the result after C-- pipeline pass. Two + more flags were added: :ghc-flag:`-ddump-cmm-from-stg` to allow to get the + initial cmm from STG-to-C-- code generation and :ghc-flag:`-ddump-cmm-verbose` + to obtain the intermediates from all C-- pipeline stages. + +Template Haskell +~~~~~~~~~~~~~~~~ + +- Reifying types that contain unboxed tuples now works correctly. (Previously, + Template Haskell reified unboxed tuples as boxed tuples with twice their + appropriate arity.) + +TODO FIXME Heading title +~~~~~~~~~~~~~~~~~~~~~~~~ + +- GHCi now supports two new commands. :ghci-cmd:`:type` ``+d`` performs + defaulting on the type before reporting it to the user, and + :ghci-cmd:`:type` ``+v`` refrains from instantiating any variables before + reporting, which is useful in concert with :ghc-flag:`-XTypeApplications`. + + .. code-block:: none + + *X> :type +d length + length :: [a] -> Int + + *X> :set -fprint-explicit-foralls + *X> :type length + length :: forall {a} {t :: * -> *}. Foldable t => t a -> Int + *X> :type +v length + length :: forall (t :: * -> *). Foldable t => forall a. t a -> Int diff --git a/testsuite/tests/th/T10697_decided_1.hs b/testsuite/tests/th/T12403.hs similarity index 50% copy from testsuite/tests/th/T10697_decided_1.hs copy to testsuite/tests/th/T12403.hs index 241cec3..d4aad62 100644 --- a/testsuite/tests/th/T10697_decided_1.hs +++ b/testsuite/tests/th/T12403.hs @@ -1,11 +1,12 @@ {-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE UnboxedTuples #-} module Main where import Language.Haskell.TH -data T = T {-# UNPACK #-} !Int !Int Int +data T = T (# Int, Int #) $(return []) main :: IO () -main = putStrLn $(reifyConStrictness 'T >>= stringE . show) +main = putStrLn $(reify ''T >>= stringE . pprint) diff --git a/testsuite/tests/th/T12403.stdout b/testsuite/tests/th/T12403.stdout new file mode 100644 index 0000000..9b75e8b --- /dev/null +++ b/testsuite/tests/th/T12403.stdout @@ -0,0 +1 @@ +data Main.T = Main.T ((# , #) GHC.Types.Int GHC.Types.Int) diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T index f502252..5180edd 100644 --- a/testsuite/tests/th/all.T +++ b/testsuite/tests/th/all.T @@ -411,3 +411,5 @@ test('T11941', normal, compile_fail, ['-v0']) test('T11484', normal, compile, ['-v0']) test('T12130', extra_clean(['T12130a.hi','T12130a.o']), multimod_compile, ['T12130', '-v0 ' + config.ghc_th_way_flags]) +test('T12403', omit_ways(['ghci']), + compile_and_run, ['-v0 -ddump-splices -dsuppress-uniques']) From git at git.haskell.org Thu Aug 25 15:04:58 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 25 Aug 2016 15:04:58 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Improve documentation for type wildcards (6b58374) Message-ID: <20160825150458.4E13D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/6b583745e63b1489312bb37218028fa8ab2fbbf8/ghc >--------------------------------------------------------------- commit 6b583745e63b1489312bb37218028fa8ab2fbbf8 Author: Simon Peyton Jones Date: Wed May 18 17:13:29 2016 +0100 Improve documentation for type wildcards This docmentation improvement was triggered by Trac #12072 (cherry picked from commit f9e90bcb202b164189d71535eafbb39577682ff2) >--------------------------------------------------------------- 6b583745e63b1489312bb37218028fa8ab2fbbf8 docs/users_guide/glasgow_exts.rst | 60 ++++++++++++++++++++++++++++----------- 1 file changed, 43 insertions(+), 17 deletions(-) diff --git a/docs/users_guide/glasgow_exts.rst b/docs/users_guide/glasgow_exts.rst index 555bfb6..6f64e0c 100644 --- a/docs/users_guide/glasgow_exts.rst +++ b/docs/users_guide/glasgow_exts.rst @@ -6057,15 +6057,6 @@ instance for ``GMap`` is :: In this example, the declaration has only one variant. In general, it can be any number. -When the name of a type argument of a data or newtype instance -declaration doesn't matter, it can be replaced with an underscore -(``_``). This is the same as writing a type variable with a unique name. :: - - data family F a b :: * - data instance F Int _ = Int - -- Equivalent to - data instance F Int b = Int - When the flag :ghc-flag:`-Wunused-type-patterns` is enabled, type variables that are mentioned in the patterns on the left hand side, but not used on the right hand side are reported. Variables that occur multiple times @@ -6431,6 +6422,37 @@ If the option :ghc-flag:`-XUndecidableInstances` is passed to the compiler, the above restrictions are not enforced and it is on the programmer to ensure termination of the normalisation of type families during type inference. +.. _type-wildcards-lhs: + +Wildcards on the LHS of data and type family instances +------------------------------------------------------ + +When the name of a type argument of a data or type instance +declaration doesn't matter, it can be replaced with an underscore +(``_``). This is the same as writing a type variable with a unique name. :: + + data family F a b :: * + data instance F Int _ = Int + -- Equivalent to data instance F Int b = Int + + type family T a :: * + type instance T (a,_) = a + -- Equivalent to type instance T (a,b) = a + +This use of underscore for wildcard in a type pattern is exactly like +pattern matching in the term language, but is rather different to the +use of a underscore in a partial type signature (see :ref:`type-wildcards`). + +A type variable beginning with an underscore is not treated specially in a +type or data instance declaration. For example: :: + + data instance F Bool _a = _a -> Int + -- Equivalent to data instance F Bool a = a -> Int + +Contrast this with the special treatment of named wildcards in +type signatures (:ref:`named-wildcards`). + + .. _assoc-decl: Associated data and type families @@ -9674,11 +9696,9 @@ Where can they occur? --------------------- Partial type signatures are allowed for bindings, pattern and expression -signatures. In all other contexts, e.g. type class or type family -declarations, they are disallowed. In the following example a wildcard -is used in each of the three possible contexts. Extra-constraints +signatures, except that extra-constraints wildcards are not supported in pattern or expression signatures. - +In the following example a wildcard is used in each of the three possible contexts. :: {-# LANGUAGE ScopedTypeVariables #-} @@ -9686,10 +9706,16 @@ wildcards are not supported in pattern or expression signatures. foo (x :: _) = (x :: _) -- Inferred: forall w_. w_ -> w_ -Anonymous and named wildcards *can* occur in type or data instance -declarations. However, these declarations are not partial type signatures -and different rules apply. See :ref:`data-instance-declarations` for more -details. +Anonymous and named wildcards *can* occur on the left hand side of a +type or data instance declaration; +see :ref:`type-wildcards-lhs`. + +In all other contexts, type wildcards are disallowed, and a named wildcard is treated +as an ordinary type variable. For example: :: + + class C _ where ... -- Illegal + instance Eq (T _) -- Illegal (currently; would actually make sense) + instance Eq _a => Eq (T _a) -- Perfectly fine, same as Eq a => Eq (T a) Partial type signatures can also be used in :ref:`template-haskell` splices. From git at git.haskell.org Thu Aug 25 15:05:00 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 25 Aug 2016 15:05:00 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Update docs for partial type signatures (#12365) (e59121a) Message-ID: <20160825150500.F39453A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/e59121a5555a95911849605606f2076eba70c004/ghc >--------------------------------------------------------------- commit e59121a5555a95911849605606f2076eba70c004 Author: Thomas Winant Date: Wed Jul 20 09:57:04 2016 +0200 Update docs for partial type signatures (#12365) * Update the sample error messages. The messages have been reworded and reformatted since GHC 7.10. * Mention `TypeApplications` in "Where can they occur?" * The name of a named wild card is no longer used in the name of a resulting type variable. Before: `_foo` => `w_foo`, now: `_foo` => `t` or `a`. Test Plan: generate the users guide Reviewers: goldfire, austin, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2413 GHC Trac Issues: #12365 (cherry picked from commit 627c767b8e5587de52086d8891d7f7aabf6fa49f) >--------------------------------------------------------------- e59121a5555a95911849605606f2076eba70c004 docs/users_guide/glasgow_exts.rst | 79 ++++++++++++++++++++++++--------------- 1 file changed, 48 insertions(+), 31 deletions(-) diff --git a/docs/users_guide/glasgow_exts.rst b/docs/users_guide/glasgow_exts.rst index 6f64e0c..f8edf1e 100644 --- a/docs/users_guide/glasgow_exts.rst +++ b/docs/users_guide/glasgow_exts.rst @@ -9530,22 +9530,25 @@ types like ``(Int -> Bool)`` or ``Maybe``. For instance, the first wildcard in the type signature ``not'`` would produce the following error message: -:: +.. code-block:: none + + Test.hs:4:17: error: + • Found type wildcard ‘_’ standing for ‘Bool’ + To use the inferred type, enable PartialTypeSignatures + • In the type signature: + not' :: Bool -> _ + • Relevant bindings include + not' :: Bool -> Bool (bound at Test.hs:5:1) - Test.hs:4:17: - Found hole ‘_’ with type: Bool - To use the inferred type, enable PartialTypeSignatures - In the type signature for ‘not'’: Bool -> _ When a wildcard is not instantiated to a monotype, it will be -generalised over, i.e. replaced by a fresh type variable (of which the -name will often start with ``w_``), e.g. +generalised over, i.e. replaced by a fresh type variable, e.g. :: foo :: _ -> _ foo x = x - -- Inferred: forall w_. w_ -> w_ + -- Inferred: forall t. t -> t filter' :: _ filter' = filter -- has type forall a. (a -> Bool) -> [a] -> [a] @@ -9579,7 +9582,7 @@ of the type signature to make sure that it unifies with something: :: somethingShowable :: Show _x => _x -> _ somethingShowable x = show x - -- Inferred type: Show w_x => w_x -> String + -- Inferred type: Show a => a -> String somethingShowable' :: Show _x => _x -> _ somethingShowable' x = show (not x) @@ -9594,7 +9597,7 @@ though syntactically similar, named wildcards can unify with monotypes as well as be generalised over (and behave as type variables). In the first example above, ``_x`` is generalised over (and is -effectively replaced by a fresh type variable ``w_x``). In the second +effectively replaced by a fresh type variable ``a``). In the second example, ``_x`` is unified with the ``Bool`` type, and as ``Bool`` implements the ``Show`` type class, the constraint ``Show Bool`` can be simplified away. @@ -9613,23 +9616,29 @@ no matching the actual type ``Bool``. .. code-block:: none - Test.hs:5:9: - Couldn't match expected type ‘_a’ with actual type ‘Bool’ + Test.hs:5:9: error: + • Couldn't match expected type ‘_a’ with actual type ‘Bool’ ‘_a’ is a rigid type variable bound by - the type signature for foo :: _a -> _a at Test.hs:4:8 - Relevant bindings include foo :: _a -> _a (bound at Test.hs:4:1) - In the expression: False - In an equation for ‘foo’: foo _ = False + the type signature for: + foo :: forall _a. _a -> _a + at Test.hs:4:8 + • In the expression: False + In an equation for ‘foo’: foo _ = False + • Relevant bindings include foo :: _a -> _a (bound at Test.hs:5:1) -Compiling this program with :ghc-flag:`-XNamedWildCards` enabled produces the -following error message reporting the inferred type of the named -wildcard ``_a``. +Compiling this program with :ghc-flag:`-XNamedWildCards` (as well as +:ghc-flag:`-XPartialTypeSignatures`) enabled produces the following error +message reporting the inferred type of the named wildcard ``_a``. .. code-block:: none - Test.hs:4:8: Warning: - Found hole ‘_a’ with type: Bool - In the type signature for ‘foo’: _a -> _a + Test.hs:4:8: warning: [-Wpartial-type-signatures] + • Found type wildcard ‘_a’ standing for ‘Bool’ + • In the type signature: + foo :: _a -> _a + • Relevant bindings include + foo :: Bool -> Bool (bound at Test.hs:5:1) + .. _extra-constraints-wildcard: @@ -9649,10 +9658,11 @@ extra-constraints wildcard is used to infer three extra constraints. -- Inferred: -- forall a. (Enum a, Eq a, Show a) => a -> String -- Error: - Test.hs:5:12: - Found hole ‘_’ with inferred constraints: (Enum a, Eq a, Show a) + Test.hs:5:12: error: + Found constraint wildcard ‘_’ standing for ‘(Show a, Eq a, Enum a)’ To use the inferred type, enable PartialTypeSignatures - In the type signature for ‘arbitCs’: _ => a -> String + In the type signature: + arbitCs :: _ => a -> String An extra-constraints wildcard shouldn't prevent the programmer from already listing the constraints he knows or wants to annotate, e.g. @@ -9665,10 +9675,11 @@ already listing the constraints he knows or wants to annotate, e.g. -- Inferred: -- forall a. (Enum a, Show a, Eq a) => a -> String -- Error: - Test.hs:9:22: - Found hole ‘_’ with inferred constraints: (Eq a, Show a) + Test.hs:9:22: error: + Found constraint wildcard ‘_’ standing for ‘()’ To use the inferred type, enable PartialTypeSignatures - In the type signature for ‘arbitCs'’: (Enum a, _) => a -> String + In the type signature: + arbitCs' :: (Enum a, _) => a -> String An extra-constraints wildcard can also lead to zero extra constraints to be inferred, e.g. @@ -9679,10 +9690,11 @@ be inferred, e.g. noCs = "noCs" -- Inferred: String -- Error: - Test.hs:13:9: - Found hole ‘_’ with inferred constraints: () + Test.hs:13:9: error: + Found constraint wildcard ‘_’ standing for ‘()’ To use the inferred type, enable PartialTypeSignatures - In the type signature for ‘noCs’: _ => String + In the type signature: + noCs :: _ => String As a single extra-constraints wildcard is enough to infer any number of constraints, only one is allowed in a type signature and it should come @@ -9710,6 +9722,11 @@ Anonymous and named wildcards *can* occur on the left hand side of a type or data instance declaration; see :ref:`type-wildcards-lhs`. +Anonymous wildcards are also allowed in visible type applications +(:ref:`visible-type-application`). If you want to specify only the second type +argument to ``wurble``, then you can say ``wurble @_ @Int`` where the first +argument is a wildcard. + In all other contexts, type wildcards are disallowed, and a named wildcard is treated as an ordinary type variable. For example: :: From git at git.haskell.org Thu Aug 25 15:05:04 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 25 Aug 2016 15:05:04 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Fix bytecode generator panic (a0c9685) Message-ID: <20160825150504.342563A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/a0c9685e654f2b4bec90321e261d70b90022e546/ghc >--------------------------------------------------------------- commit a0c9685e654f2b4bec90321e261d70b90022e546 Author: Seraphime Kirkovski Date: Wed Jul 20 09:47:23 2016 +0200 Fix bytecode generator panic This fixes #12128. The bug was introduced in 1c9fd3f1c5522372fcaf250c805b959e8090a62c. Test Plan: ./validate Reviewers: simonmar, austin, hvr, simonpj, bgamari Reviewed By: bgamari Subscribers: simonpj, thomie Differential Revision: https://phabricator.haskell.org/D2374 GHC Trac Issues: #12128 (cherry picked from commit 8de6e13f9ef784750e502955fcb38d4a7e179727) >--------------------------------------------------------------- a0c9685e654f2b4bec90321e261d70b90022e546 compiler/ghci/ByteCodeGen.hs | 11 +++++++++++ testsuite/tests/ghci/should_run/T12128.hs | 14 ++++++++++++++ testsuite/tests/ghci/should_run/T12128.script | 1 + testsuite/tests/ghci/should_run/all.T | 1 + 4 files changed, 27 insertions(+) diff --git a/compiler/ghci/ByteCodeGen.hs b/compiler/ghci/ByteCodeGen.hs index 0b4d625..40cdf7e 100644 --- a/compiler/ghci/ByteCodeGen.hs +++ b/compiler/ghci/ByteCodeGen.hs @@ -1344,6 +1344,12 @@ pushAtom d p e pushAtom _ _ (AnnCoercion {}) -- Coercions are zero-width things, = return (nilOL, 0) -- treated just like a variable V +-- See Note [Empty case alternatives] in coreSyn/CoreSyn.hs +-- and Note [Bottoming expressions] in coreSyn/CoreUtils.hs: +-- The scrutinee of an empty case evaluates to bottom +pushAtom d p (AnnCase (_, a) _ _ []) -- trac #12128 + = pushAtom d p a + pushAtom d p (AnnVar v) | UnaryRep rep_ty <- repType (idType v) , V <- typeArgRep rep_ty @@ -1644,6 +1650,11 @@ atomPrimRep :: AnnExpr' Id ann -> PrimRep atomPrimRep e | Just e' <- bcView e = atomPrimRep e' atomPrimRep (AnnVar v) = bcIdPrimRep v atomPrimRep (AnnLit l) = typePrimRep (literalType l) + +-- Trac #12128: +-- A case expresssion can be an atom because empty cases evaluate to bottom. +-- See Note [Empty case alternatives] in coreSyn/CoreSyn.hs +atomPrimRep (AnnCase _ _ ty _) = ASSERT(typePrimRep ty == PtrRep) PtrRep atomPrimRep (AnnCoercion {}) = VoidRep atomPrimRep other = pprPanic "atomPrimRep" (ppr (deAnnotate (undefined,other))) diff --git a/testsuite/tests/ghci/should_run/T12128.hs b/testsuite/tests/ghci/should_run/T12128.hs new file mode 100644 index 0000000..0194910 --- /dev/null +++ b/testsuite/tests/ghci/should_run/T12128.hs @@ -0,0 +1,14 @@ +{- + This code produces an empty case statement, which + panics the bytecode generator after trac #11155. +-} + +module ShouldCompile where + +import GHC.TypeLits (Symbol) +import Unsafe.Coerce + +instance Read Symbol where + readsPrec = unsafeCoerce (readsPrec :: Int -> ReadS String) + +data Bar = TyCon !Symbol deriving (Read) diff --git a/testsuite/tests/ghci/should_run/T12128.script b/testsuite/tests/ghci/should_run/T12128.script new file mode 100644 index 0000000..8873ce2 --- /dev/null +++ b/testsuite/tests/ghci/should_run/T12128.script @@ -0,0 +1 @@ +:load T12128 diff --git a/testsuite/tests/ghci/should_run/all.T b/testsuite/tests/ghci/should_run/all.T index 08fe33d..f7e5018 100644 --- a/testsuite/tests/ghci/should_run/all.T +++ b/testsuite/tests/ghci/should_run/all.T @@ -24,3 +24,4 @@ test('T10145', just_ghci, ghci_script, ['T10145.script']) test('T7253', just_ghci, ghci_script, ['T7253.script']) test('T11328', just_ghci, ghci_script, ['T11328.script']) test('T11825', just_ghci, ghci_script, ['T11825.script']) +test('T12128', just_ghci, ghci_script, ['T12128.script']) From git at git.haskell.org Thu Aug 25 15:05:06 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 25 Aug 2016 15:05:06 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Fix productivity calculation (#12424) (7885a51) Message-ID: <20160825150506.D42803A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/7885a51b460f064e164b8a690b9c8da45b654049/ghc >--------------------------------------------------------------- commit 7885a51b460f064e164b8a690b9c8da45b654049 Author: Simon Marlow Date: Tue Jul 26 07:55:37 2016 -0700 Fix productivity calculation (#12424) (cherry picked from commit 1783011726a355ac7647246699d43bc7d8b6d9f1) >--------------------------------------------------------------- 7885a51b460f064e164b8a690b9c8da45b654049 rts/Stats.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/rts/Stats.c b/rts/Stats.c index 4c06b18..7ddd1d8 100644 --- a/rts/Stats.c +++ b/rts/Stats.c @@ -704,8 +704,8 @@ stat_exit (void) TimeToSecondsDbl(tot_cpu - gc_cpu - PROF_VAL(RP_tot_time + HC_tot_time) - init_cpu) * 100 / TimeToSecondsDbl(tot_cpu), - TimeToSecondsDbl(tot_cpu - gc_cpu - - PROF_VAL(RP_tot_time + HC_tot_time) - init_cpu) * 100 + TimeToSecondsDbl(tot_elapsed - gc_elapsed - + PROF_VAL(RPe_tot_time + HCe_tot_time) - init_elapsed) * 100 / TimeToSecondsDbl(tot_elapsed)); /* From git at git.haskell.org Thu Aug 25 15:05:09 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 25 Aug 2016 15:05:09 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: testsuite: Update performance numbers (d0c419c) Message-ID: <20160825150509.8714C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/d0c419c45e29d79889759606a89b1d9ed3e7f080/ghc >--------------------------------------------------------------- commit d0c419c45e29d79889759606a89b1d9ed3e7f080 Author: Ben Gamari Date: Thu Aug 25 11:02:58 2016 -0400 testsuite: Update performance numbers >--------------------------------------------------------------- d0c419c45e29d79889759606a89b1d9ed3e7f080 testsuite/tests/perf/compiler/all.T | 6 ++++-- testsuite/tests/perf/should_run/all.T | 3 ++- 2 files changed, 6 insertions(+), 3 deletions(-) diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T index 6dc8958..00f8e7a 100644 --- a/testsuite/tests/perf/compiler/all.T +++ b/testsuite/tests/perf/compiler/all.T @@ -28,7 +28,8 @@ setTestOpts(no_lint) # really changed, then you know there's an issue. test('T1969', - [compiler_stats_num_field('peak_megabytes_allocated', # Note [residency] + [ +compiler_stats_num_field('peak_megabytes_allocated', # Note [residency] [(wordsize(32), 30, 15), # 2010-05-17 14 (x86/Windows) # 15 (x86/OS X) @@ -91,7 +92,7 @@ test('T1969', # 2014-06-29 303300692 (x86/Linux) # 2015-07-11 288699104 (x86/Linux, 64-bit machine) use +RTS -G1 # 2016-04-06 344730660 (x86/Linux, 64-bit machine) - (wordsize(64), 695430728, 5)]), + (wordsize(64), 736973272, 5)]), # 17/11/2009 434845560 (amd64/Linux) # 08/12/2009 459776680 (amd64/Linux) # 17/05/2010 519377728 (amd64/Linux) @@ -111,6 +112,7 @@ test('T1969', # 10/09/2014 630299456 (x86_64/Linux) post-AMP-cleanup # 03/06/2015 581460896 (x86_64/Linux) use +RTS -G1 # 28/10/2015 695430728 (x86_64/Linux) emit Typeable at definition site + # 25/08/2016 736973272 (x86_64/Linux) unknown only_ways(['normal']), extra_hc_opts('-dcore-lint -static'), diff --git a/testsuite/tests/perf/should_run/all.T b/testsuite/tests/perf/should_run/all.T index 81a5535..e901f56 100644 --- a/testsuite/tests/perf/should_run/all.T +++ b/testsuite/tests/perf/should_run/all.T @@ -275,9 +275,10 @@ test('T7257', [(wordsize(32), 989850664, 10), # expected value: 1246287228 (i386/Linux) # 2016-04-06: 989850664 (i386/Linux) no idea what happened - (wordsize(64), 1654893248, 5)]), + (wordsize(64), 1414893352, 5)]), # 2012-09-21: 1774893760 (amd64/Linux) # 2015-11-03: 1654893248 (amd64/Linux) + # 2016-08-25: 1414893352 (amd64/Linux) stats_num_field('peak_megabytes_allocated', [(wordsize(32), 217, 5), # 2012-10-08: 217 (x86/Linux) From git at git.haskell.org Thu Aug 25 15:10:24 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 25 Aug 2016 15:10:24 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: testsuite: Remove spurious change from last commit (a1a7359) Message-ID: <20160825151024.0C9BA3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/a1a7359daed7d16634dc2ac7be43c112fab179f9/ghc >--------------------------------------------------------------- commit a1a7359daed7d16634dc2ac7be43c112fab179f9 Author: Ben Gamari Date: Thu Aug 25 11:08:12 2016 -0400 testsuite: Remove spurious change from last commit >--------------------------------------------------------------- a1a7359daed7d16634dc2ac7be43c112fab179f9 testsuite/tests/perf/compiler/all.T | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T index 00f8e7a..2425a83 100644 --- a/testsuite/tests/perf/compiler/all.T +++ b/testsuite/tests/perf/compiler/all.T @@ -28,8 +28,7 @@ setTestOpts(no_lint) # really changed, then you know there's an issue. test('T1969', - [ -compiler_stats_num_field('peak_megabytes_allocated', # Note [residency] + [compiler_stats_num_field('peak_megabytes_allocated', # Note [residency] [(wordsize(32), 30, 15), # 2010-05-17 14 (x86/Windows) # 15 (x86/OS X) From git at git.haskell.org Thu Aug 25 15:10:26 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 25 Aug 2016 15:10:26 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Revert "Fix Template Haskell reification of unboxed tuple types" (3219220) Message-ID: <20160825151026.B9CAF3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/3219220db283aa09396fc5fd7fe1668ecbe7a512/ghc >--------------------------------------------------------------- commit 3219220db283aa09396fc5fd7fe1668ecbe7a512 Author: Ben Gamari Date: Thu Aug 25 11:09:31 2016 -0400 Revert "Fix Template Haskell reification of unboxed tuple types" This reverts commit 3470f82fbd7039f9957761c5a12988fd558d6cb8 which we decided not to merge afterall. See #12403. >--------------------------------------------------------------- 3219220db283aa09396fc5fd7fe1668ecbe7a512 compiler/typecheck/TcSplice.hs | 4 +-- docs/users_guide/8.0.2-notes.rst | 59 ---------------------------------------- testsuite/tests/th/T12403.hs | 12 -------- testsuite/tests/th/T12403.stdout | 1 - testsuite/tests/th/all.T | 2 -- 5 files changed, 1 insertion(+), 77 deletions(-) diff --git a/compiler/typecheck/TcSplice.hs b/compiler/typecheck/TcSplice.hs index 06b4932..82853e1 100644 --- a/compiler/typecheck/TcSplice.hs +++ b/compiler/typecheck/TcSplice.hs @@ -1733,9 +1733,7 @@ reify_tc_app tc tys tc_binders = tyConBinders tc tc_res_kind = tyConResKind tc - r_tc | isUnboxedTupleTyCon tc = TH.UnboxedTupleT (arity `div` 2) - -- See Note [Unboxed tuple RuntimeRep vars] in TyCon - | isTupleTyCon tc = if isPromotedDataCon tc + r_tc | isTupleTyCon tc = if isPromotedDataCon tc then TH.PromotedTupleT arity else TH.TupleT arity | tc `hasKey` listTyConKey = TH.ListT diff --git a/docs/users_guide/8.0.2-notes.rst b/docs/users_guide/8.0.2-notes.rst deleted file mode 100644 index 39ad028..0000000 --- a/docs/users_guide/8.0.2-notes.rst +++ /dev/null @@ -1,59 +0,0 @@ -.. _release-8-0-2: - -Release notes for version 8.0.2 -=============================== - -TODO FIXME - -Highlights ----------- - -TODO FIXME. - -Full details ------------- - -Language -~~~~~~~~ - -- TODO FIXME. - -- :ghc-flag:`-XStaticPointers` now allows the body of the ``static`` form to - refer to closed local bindings. For instance, this is now permitted: - ``f = static x where x = 'a'``. - -Compiler -~~~~~~~~ - -- TODO FIXME. - -- The :ghc-flag:`-ddump-cmm` now dumps the result after C-- pipeline pass. Two - more flags were added: :ghc-flag:`-ddump-cmm-from-stg` to allow to get the - initial cmm from STG-to-C-- code generation and :ghc-flag:`-ddump-cmm-verbose` - to obtain the intermediates from all C-- pipeline stages. - -Template Haskell -~~~~~~~~~~~~~~~~ - -- Reifying types that contain unboxed tuples now works correctly. (Previously, - Template Haskell reified unboxed tuples as boxed tuples with twice their - appropriate arity.) - -TODO FIXME Heading title -~~~~~~~~~~~~~~~~~~~~~~~~ - -- GHCi now supports two new commands. :ghci-cmd:`:type` ``+d`` performs - defaulting on the type before reporting it to the user, and - :ghci-cmd:`:type` ``+v`` refrains from instantiating any variables before - reporting, which is useful in concert with :ghc-flag:`-XTypeApplications`. - - .. code-block:: none - - *X> :type +d length - length :: [a] -> Int - - *X> :set -fprint-explicit-foralls - *X> :type length - length :: forall {a} {t :: * -> *}. Foldable t => t a -> Int - *X> :type +v length - length :: forall (t :: * -> *). Foldable t => forall a. t a -> Int diff --git a/testsuite/tests/th/T12403.hs b/testsuite/tests/th/T12403.hs deleted file mode 100644 index d4aad62..0000000 --- a/testsuite/tests/th/T12403.hs +++ /dev/null @@ -1,12 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE UnboxedTuples #-} -module Main where - -import Language.Haskell.TH - -data T = T (# Int, Int #) - -$(return []) - -main :: IO () -main = putStrLn $(reify ''T >>= stringE . pprint) diff --git a/testsuite/tests/th/T12403.stdout b/testsuite/tests/th/T12403.stdout deleted file mode 100644 index 9b75e8b..0000000 --- a/testsuite/tests/th/T12403.stdout +++ /dev/null @@ -1 +0,0 @@ -data Main.T = Main.T ((# , #) GHC.Types.Int GHC.Types.Int) diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T index 5180edd..f502252 100644 --- a/testsuite/tests/th/all.T +++ b/testsuite/tests/th/all.T @@ -411,5 +411,3 @@ test('T11941', normal, compile_fail, ['-v0']) test('T11484', normal, compile, ['-v0']) test('T12130', extra_clean(['T12130a.hi','T12130a.o']), multimod_compile, ['T12130', '-v0 ' + config.ghc_th_way_flags]) -test('T12403', omit_ways(['ghci']), - compile_and_run, ['-v0 -ddump-splices -dsuppress-uniques']) From git at git.haskell.org Thu Aug 25 16:19:23 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 25 Aug 2016 16:19:23 +0000 (UTC) Subject: [commit: ghc] branch 'wip/12368' deleted Message-ID: <20160825161923.10A953A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Deleted branch: wip/12368 From git at git.haskell.org Thu Aug 25 16:25:12 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 25 Aug 2016 16:25:12 +0000 (UTC) Subject: [commit: ghc] master: Comments only: Refer to actually existing Notes (7a86f58) Message-ID: <20160825162512.EEB833A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7a86f58436434e7228efc7bd88a18230de104825/ghc >--------------------------------------------------------------- commit 7a86f58436434e7228efc7bd88a18230de104825 Author: Joachim Breitner Date: Sun Jul 31 20:59:54 2016 -0400 Comments only: Refer to actually existing Notes >--------------------------------------------------------------- 7a86f58436434e7228efc7bd88a18230de104825 compiler/stranal/DmdAnal.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/compiler/stranal/DmdAnal.hs b/compiler/stranal/DmdAnal.hs index c7f0767..44d2d20 100644 --- a/compiler/stranal/DmdAnal.hs +++ b/compiler/stranal/DmdAnal.hs @@ -67,8 +67,9 @@ dmdAnalTopBind sigs (NonRec id rhs) ( _, _, _, rhs1) = dmdAnalRhsLetDown TopLevel Nothing sigs id rhs (sig, _, id2, rhs2) = dmdAnalRhsLetDown TopLevel Nothing (nonVirgin sigs) id rhs1 -- Do two passes to improve CPR information - -- See comments with ignore_cpr_info in mk_sig_ty - -- and with extendSigsWithLam + -- See Note [CPR for thunks] + -- See Note [Optimistic CPR in the "virgin" case] + -- See Note [Initial CPR for strict binders] dmdAnalTopBind sigs (Rec pairs) = (sigs', Rec pairs') From git at git.haskell.org Thu Aug 25 16:25:15 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 25 Aug 2016 16:25:15 +0000 (UTC) Subject: [commit: ghc] master: DmdAnal: Add a final, safe iteration (8d92b88) Message-ID: <20160825162515.AB12B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8d92b88df7c1c04606c8a9e12c1d4bee65c990e4/ghc >--------------------------------------------------------------- commit 8d92b88df7c1c04606c8a9e12c1d4bee65c990e4 Author: Joachim Breitner Date: Thu Jul 7 11:23:48 2016 +0200 DmdAnal: Add a final, safe iteration this fixes #12368. It also refactors dmdFix a bit, removes some redundancies (such as passing around an strictness signature right next to an id, when that id is guaranteed to have been annotated with that strictness signature). Note that when fixed-point iteration does not terminate, we conservatively delete their strictness signatures (set them to nopSig). But this loses the information on how its strict free variables are used! Lazily used variables already escape via lazy_fvs. We ensure that in the case of an aborted fixed-point iteration, also the strict variables are put there (with a conservative demand of topDmd). Differential Revision: https://phabricator.haskell.org/D2392 >--------------------------------------------------------------- 8d92b88df7c1c04606c8a9e12c1d4bee65c990e4 compiler/basicTypes/Demand.hs | 7 +- compiler/basicTypes/VarEnv.hs | 5 +- compiler/stranal/DmdAnal.hs | 188 ++++++++++++++++++------------- compiler/utils/UniqFM.hs | 6 + testsuite/tests/stranal/should_run/all.T | 3 +- 5 files changed, 128 insertions(+), 81 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 8d92b88df7c1c04606c8a9e12c1d4bee65c990e4 From git at git.haskell.org Thu Aug 25 16:25:18 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 25 Aug 2016 16:25:18 +0000 (UTC) Subject: [commit: ghc] master: Degrade "case scrutinee not known to diverge for sure" Lint error to warning (ec7fcfd) Message-ID: <20160825162518.5A97D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ec7fcfdda7f4655f4cc4399d1b3f4bc2543809db/ghc >--------------------------------------------------------------- commit ec7fcfdda7f4655f4cc4399d1b3f4bc2543809db Author: Joachim Breitner Date: Tue Jul 26 11:44:53 2016 +0200 Degrade "case scrutinee not known to diverge for sure" Lint error to warning as proposed in #12435, as it easily gets in the way of development when it reports false positives. >--------------------------------------------------------------- ec7fcfdda7f4655f4cc4399d1b3f4bc2543809db compiler/coreSyn/CoreLint.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/coreSyn/CoreLint.hs b/compiler/coreSyn/CoreLint.hs index 9700522..74f8a61 100644 --- a/compiler/coreSyn/CoreLint.hs +++ b/compiler/coreSyn/CoreLint.hs @@ -715,7 +715,7 @@ lintCoreExpr e@(Case scrut var alt_ty alts) = ; when (null alts) $ do { checkL (not (exprIsHNF scrut)) (text "No alternatives for a case scrutinee in head-normal form:" <+> ppr scrut) - ; checkL scrut_diverges + ; checkWarnL scrut_diverges (text "No alternatives for a case scrutinee not known to diverge for sure:" <+> ppr scrut) } From git at git.haskell.org Thu Aug 25 16:25:21 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 25 Aug 2016 16:25:21 +0000 (UTC) Subject: [commit: ghc] master: WwLib: Add strictness signature to "let x = absentError …" (faaf313) Message-ID: <20160825162521.0DFE63A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/faaf31398110610a0f7068ca13d798d1ac21e02e/ghc >--------------------------------------------------------------- commit faaf31398110610a0f7068ca13d798d1ac21e02e Author: Joachim Breitner Date: Tue Jul 26 12:08:59 2016 +0200 WwLib: Add strictness signature to "let x = absentError …" indicating that it is bottom. This should help making the "empty cases" lint error give less false alarms. >--------------------------------------------------------------- faaf31398110610a0f7068ca13d798d1ac21e02e compiler/basicTypes/Demand.hs | 9 ++++++--- compiler/stranal/WwLib.hs | 14 +++++++++----- 2 files changed, 15 insertions(+), 8 deletions(-) diff --git a/compiler/basicTypes/Demand.hs b/compiler/basicTypes/Demand.hs index 2ada6b3..d79fa6e 100644 --- a/compiler/basicTypes/Demand.hs +++ b/compiler/basicTypes/Demand.hs @@ -35,7 +35,8 @@ module Demand ( vanillaCprProdRes, cprSumRes, appIsBottom, isBottomingSig, pprIfaceStrictSig, trimCPRInfo, returnsCPR_maybe, - StrictSig(..), mkStrictSig, mkClosedStrictSig, nopSig, botSig, cprProdSig, + StrictSig(..), mkStrictSig, mkClosedStrictSig, + nopSig, botSig, exnSig, cprProdSig, isTopSig, hasDemandEnvSig, splitStrictSig, strictSigDmdEnv, increaseStrictSigArity, @@ -1264,9 +1265,10 @@ emptyDmdEnv = emptyVarEnv -- (lazy, absent, no CPR information, no termination information). -- Note that it is ''not'' the top of the lattice (which would be "may use everything"), -- so it is (no longer) called topDmd -nopDmdType, botDmdType :: DmdType +nopDmdType, botDmdType, exnDmdType :: DmdType nopDmdType = DmdType emptyDmdEnv [] topRes botDmdType = DmdType emptyDmdEnv [] botRes +exnDmdType = DmdType emptyDmdEnv [] exnRes cprProdDmdType :: Arity -> DmdType cprProdDmdType arity @@ -1691,9 +1693,10 @@ isBottomingSig :: StrictSig -> Bool -- True if the signature diverges or throws an exception isBottomingSig (StrictSig (DmdType _ _ res)) = isBotRes res -nopSig, botSig :: StrictSig +nopSig, botSig, exnSig :: StrictSig nopSig = StrictSig nopDmdType botSig = StrictSig botDmdType +exnSig = StrictSig exnDmdType cprProdSig :: Arity -> StrictSig cprProdSig arity = StrictSig (cprProdDmdType arity) diff --git a/compiler/stranal/WwLib.hs b/compiler/stranal/WwLib.hs index 812252c..0057f6f 100644 --- a/compiler/stranal/WwLib.hs +++ b/compiler/stranal/WwLib.hs @@ -709,7 +709,7 @@ every primitive type, so the function is partial. mk_absent_let :: DynFlags -> Id -> Maybe (CoreExpr -> CoreExpr) mk_absent_let dflags arg | not (isUnliftedType arg_ty) - = Just (Let (NonRec arg abs_rhs)) + = Just (Let (NonRec lifted_arg abs_rhs)) | Just tc <- tyConAppTyCon_maybe arg_ty , Just lit <- absentLiteralOf tc = Just (Let (NonRec arg (Lit lit))) @@ -719,10 +719,14 @@ mk_absent_let dflags arg = WARN( True, text "No absent value for" <+> ppr arg_ty ) Nothing where - arg_ty = idType arg - abs_rhs = mkRuntimeErrorApp aBSENT_ERROR_ID arg_ty msg - msg = showSDoc (gopt_set dflags Opt_SuppressUniques) - (ppr arg <+> ppr (idType arg)) + arg_ty = idType arg + abs_rhs = mkRuntimeErrorApp aBSENT_ERROR_ID arg_ty msg + lifted_arg = arg `setIdStrictness` exnSig + -- Note in strictness signature that this is bottoming + -- (for the sake of the "empty case scrutinee not known to + -- diverge for sure lint" warning) + msg = showSDoc (gopt_set dflags Opt_SuppressUniques) + (ppr arg <+> ppr (idType arg)) -- We need to suppress uniques here because otherwise they'd -- end up in the generated code as strings. This is bad for -- determinism, because with different uniques the strings From git at git.haskell.org Thu Aug 25 16:25:24 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 25 Aug 2016 16:25:24 +0000 (UTC) Subject: [commit: ghc] master: DmdAnal: Testcase about splitFVs and dmdFix abortion (d6fd2e3) Message-ID: <20160825162524.69A2F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d6fd2e3787802265586aef7d51db35e66ef2507a/ghc >--------------------------------------------------------------- commit d6fd2e3787802265586aef7d51db35e66ef2507a Author: Joachim Breitner Date: Thu Jul 21 17:44:25 2016 +0200 DmdAnal: Testcase about splitFVs and dmdFix abortion Any variable with useful information (strict or used-once) will not be included in lazy_fv (according to splitFVs). If we now also remove them from the strictness signatures, their uses are not recorded anywhere – and then probably considered absent. >--------------------------------------------------------------- d6fd2e3787802265586aef7d51db35e66ef2507a testsuite/tests/stranal/should_run/T12368a.hs | 27 +++++++++++++++++++++++ testsuite/tests/stranal/should_run/T12368a.stderr | 3 +++ 2 files changed, 30 insertions(+) diff --git a/testsuite/tests/stranal/should_run/T12368a.hs b/testsuite/tests/stranal/should_run/T12368a.hs new file mode 100644 index 0000000..301d044 --- /dev/null +++ b/testsuite/tests/stranal/should_run/T12368a.hs @@ -0,0 +1,27 @@ +-- Needs to be a product type +data Stream = S Int Stream + +-- a is wrongly recorded abstent if the non-lazy-fv from foo are thrown away. +bar :: Int -> Int -> Stream -> Int +bar a n s = foo n s + where + -- Non terminating local rec, strict in a + foo :: Int -> Stream -> Int + foo 0 (S n s) = a + foo i (S n s) = a `seq` n + foo (i-1) s +{-# NOINLINE bar #-} + + +baz :: Int -> Int -> Int +baz 0 not_absent = 0 +baz 1 not_absent = baz 2 not_absent +baz x not_absent = bar not_absent 1000 arg + where + arg = S 1 arg + +bamf x = baz x (error "This is good!") +{-# NOINLINE bamf #-} + + +main :: IO () +main = bamf 10 `seq` return () diff --git a/testsuite/tests/stranal/should_run/T12368a.stderr b/testsuite/tests/stranal/should_run/T12368a.stderr new file mode 100644 index 0000000..98246d3 --- /dev/null +++ b/testsuite/tests/stranal/should_run/T12368a.stderr @@ -0,0 +1,3 @@ +T12368a: This is good! +CallStack (from HasCallStack): + error, called at T12368a.hs:22:17 in main:Main From git at git.haskell.org Thu Aug 25 16:37:04 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 25 Aug 2016 16:37:04 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Allow limiting the number of GC threads (+RTS -qn) (29f610d) Message-ID: <20160825163704.9E5763A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/29f610da83bc3e0c47747fae8d672269b8d7ea50/ghc >--------------------------------------------------------------- commit 29f610da83bc3e0c47747fae8d672269b8d7ea50 Author: Simon Marlow Date: Sat Apr 9 20:45:50 2016 +0100 Allow limiting the number of GC threads (+RTS -qn) This allows the GC to use fewer threads than the number of capabilities. At each GC, we choose some of the capabilities to be "idle", which means that the thread running on that capability (if any) will sleep for the duration of the GC, and the other threads will do its work. We choose capabilities that are already idle (if any) to be the idle capabilities. The idea is that this helps in the following situation: * We want to use a large -N value so as to make use of hyperthreaded cores * We use a large heap size, so GC is infrequent * But we don't want to use all -N threads in the GC, because that thrashes the memory too much. See docs for usage. (cherry picked from commit 76ee260778991367b8dbf07ecf7afd31f826c824) >--------------------------------------------------------------- 29f610da83bc3e0c47747fae8d672269b8d7ea50 docs/users_guide/runtime_control.rst | 24 +++ includes/rts/Flags.h | 4 + rts/Capability.c | 48 +++--- rts/Capability.h | 23 ++- rts/RtsFlags.c | 20 +++ rts/Schedule.c | 277 ++++++++++++++++++++++++----------- rts/Task.h | 20 ++- rts/sm/GC.c | 4 +- 8 files changed, 299 insertions(+), 121 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 29f610da83bc3e0c47747fae8d672269b8d7ea50 From git at git.haskell.org Thu Aug 25 16:37:07 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 25 Aug 2016 16:37:07 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: schedulePushWork: avoid unnecessary wakeups (ce60147) Message-ID: <20160825163707.51E863A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/ce60147b77e585d8c1b2ae1d783bb1caeedbb198/ghc >--------------------------------------------------------------- commit ce60147b77e585d8c1b2ae1d783bb1caeedbb198 Author: Simon Marlow Date: Sun Apr 24 21:31:55 2016 +0100 schedulePushWork: avoid unnecessary wakeups This function had some pathalogically bad behaviour: if we had 2 threads on the current capability and 23 other idle capabilities, we would * grab all 23 capabilities * migrate one Haskell thread to one of them * wake up a worker on *all* 23 other capabilities. This lead to a lot of unnecessary wakeups when using large -N values. Now, we * Count how many capabilities we need to wake up * Start from cap->no+1, so that we don't overload low-numbered capabilities * Only wake up capabilities that we migrated a thread to (unless we have sparks to steal) This results in a pretty dramatic improvement in our production system. (cherry picked from commit 1fa92ca9b1ed4cf44e2745830c9e9ccc2bee12d5) >--------------------------------------------------------------- ce60147b77e585d8c1b2ae1d783bb1caeedbb198 rts/Schedule.c | 32 +++++++++++++++++++++++++------- 1 file changed, 25 insertions(+), 7 deletions(-) diff --git a/rts/Schedule.c b/rts/Schedule.c index 6c90e52..772748f 100644 --- a/rts/Schedule.c +++ b/rts/Schedule.c @@ -695,7 +695,8 @@ schedulePushWork(Capability *cap USED_IF_THREADS, #if defined(THREADED_RTS) Capability *free_caps[n_capabilities], *cap0; - nat i, n_free_caps; + nat i, n_wanted_caps, n_free_caps; + StgTSO *t; // migration can be turned off with +RTS -qm if (!RtsFlags.ParFlags.migrate) return; @@ -709,8 +710,22 @@ schedulePushWork(Capability *cap USED_IF_THREADS, sparkPoolSizeCap(cap) < 1) return; } - // First grab as many free Capabilities as we can. - for (i=0, n_free_caps=0; i < n_capabilities; i++) { + // Figure out how many capabilities we want to wake up. We need at least + // sparkPoolSize(cap) plus the number of spare threads we have. + t = cap->run_queue_hd; + n_wanted_caps = sparkPoolSizeCap(cap); + if (t != END_TSO_QUEUE) { + do { + t = t->_link; + if (t == END_TSO_QUEUE) break; + n_wanted_caps++; + } while (n_wanted_caps < n_capabilities-1); + } + + // Grab free capabilities, starting from cap->no+1. + for (i = (cap->no + 1) % n_capabilities, n_free_caps=0; + n_free_caps < n_wanted_caps && i != cap->no; + i = (i + 1) % n_capabilities) { cap0 = capabilities[i]; if (cap != cap0 && !cap0->disabled && tryGrabCapability(cap0,task)) { if (!emptyRunQueue(cap0) @@ -820,10 +835,13 @@ schedulePushWork(Capability *cap USED_IF_THREADS, // release the capabilities for (i = 0; i < n_free_caps; i++) { task->cap = free_caps[i]; - // The idea behind waking up the capability unconditionally is that - // it might be able to steal sparks. Perhaps we should only do this - // if there were sparks to steal? - releaseAndWakeupCapability(free_caps[i]); + if (sparkPoolSizeCap(cap) > 0) { + // If we have sparks to steal, wake up a worker on the + // capability, even if it has no threads to run. + releaseAndWakeupCapability(free_caps[i]); + } else { + releaseCapability(free_caps[i]); + } } } task->cap = cap; // reset to point to our Capability. From git at git.haskell.org Thu Aug 25 16:37:10 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 25 Aug 2016 16:37:10 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Fix a crash in requestSync() (8a0485d) Message-ID: <20160825163710.03B283A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/8a0485d66161c65dd8eeefd11ce37378bfdba089/ghc >--------------------------------------------------------------- commit 8a0485d66161c65dd8eeefd11ce37378bfdba089 Author: Simon Marlow Date: Tue May 10 03:22:57 2016 -0700 Fix a crash in requestSync() It was possible for a thread to read invalid memory after a conflict when multiple threads were synchronising. I haven't been successful in constructing a test case that triggers this, but we have some internal code that ran into it. (cherry picked from commit ea3d1efb863ca83b28af9056576d47f1abf98fa9) >--------------------------------------------------------------- 8a0485d66161c65dd8eeefd11ce37378bfdba089 rts/Schedule.c | 23 ++++++++++++++--------- 1 file changed, 14 insertions(+), 9 deletions(-) diff --git a/rts/Schedule.c b/rts/Schedule.c index 772748f..632b9d3 100644 --- a/rts/Schedule.c +++ b/rts/Schedule.c @@ -1412,25 +1412,30 @@ static void stopAllCapabilities (Capability **pCap, Task *task) #if defined(THREADED_RTS) static rtsBool requestSync ( - Capability **pcap, Task *task, PendingSync *sync, + Capability **pcap, Task *task, PendingSync *new_sync, SyncType *prev_sync_type) { - PendingSync *prev_sync; + PendingSync *sync; - prev_sync = (PendingSync*)cas((StgVolatilePtr)&pending_sync, - (StgWord)NULL, - (StgWord)sync); + sync = (PendingSync*)cas((StgVolatilePtr)&pending_sync, + (StgWord)NULL, + (StgWord)new_sync); - if (prev_sync) + if (sync != NULL) { + // sync is valid until we have called yieldCapability(). + // After the sync is completed, we cannot read that struct any + // more because it has been freed. + *prev_sync_type = sync->type; do { debugTrace(DEBUG_sched, "someone else is trying to sync (%d)...", - prev_sync->type); + sync->type); ASSERT(*pcap); yieldCapability(pcap,task,rtsTrue); - } while (pending_sync); + sync = pending_sync; + } while (sync != NULL); + // NOTE: task->cap might have changed now - *prev_sync_type = prev_sync->type; return rtsTrue; } else From git at git.haskell.org Thu Aug 25 16:37:12 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 25 Aug 2016 16:37:12 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Fix ASSERT failure and re-enable setnumcapabilities001 (2f31960) Message-ID: <20160825163712.A42A13A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/2f319609ef0ebffc46aad7f4ad14d5c26750e3ba/ghc >--------------------------------------------------------------- commit 2f319609ef0ebffc46aad7f4ad14d5c26750e3ba Author: Simon Marlow Date: Wed May 11 15:38:25 2016 +0100 Fix ASSERT failure and re-enable setnumcapabilities001 The assertion failure was fairly benign, I think, but this fixes it. I've been running the test repeatedly for the last 30 mins and it hasn't triggered. There are other problems exposed by this test (see #12038), but I've worked around those in the test itself for now. I also copied the relevant bits of the parallel library here so that we don't need parallel for the test to run. (cherry picked from commit cfc5df43a7789832a2789e517d8270650cc31b7f) >--------------------------------------------------------------- 2f319609ef0ebffc46aad7f4ad14d5c26750e3ba rts/Schedule.c | 7 ++- testsuite/tests/concurrent/should_run/all.T | 13 ++--- .../concurrent/should_run/setnumcapabilities001.hs | 55 ++++++++++++++++++++-- 3 files changed, 62 insertions(+), 13 deletions(-) diff --git a/rts/Schedule.c b/rts/Schedule.c index 632b9d3..adb1aa1 100644 --- a/rts/Schedule.c +++ b/rts/Schedule.c @@ -1622,11 +1622,14 @@ scheduleDoGC (Capability **pcap, Task *task USED_IF_THREADS, if (was_syncing) { stgFree(idle_cap); } - if (was_syncing && (prev_sync == SYNC_GC_SEQ || - prev_sync == SYNC_GC_PAR)) { + if (was_syncing && + (prev_sync == SYNC_GC_SEQ || prev_sync == SYNC_GC_PAR) && + !(sched_state == SCHED_INTERRUPTING && force_major)) { // someone else had a pending sync request for a GC, so // let's assume GC has been done and we don't need to GC // again. + // Exception to this: if SCHED_INTERRUPTING, then we still + // need to do the final GC. return; } if (sched_state == SCHED_SHUTTING_DOWN) { diff --git a/testsuite/tests/concurrent/should_run/all.T b/testsuite/tests/concurrent/should_run/all.T index 1dd1e1a..3719101 100644 --- a/testsuite/tests/concurrent/should_run/all.T +++ b/testsuite/tests/concurrent/should_run/all.T @@ -244,14 +244,11 @@ test('conc067', ignore_output, compile_and_run, ['']) # than one CPU. test('conc068', [ omit_ways('threaded2'), exit_code(1) ], compile_and_run, ['']) -# Commented out, instead of marked expect_broken, because it fails only -# sometimes. See #10860. -#test('setnumcapabilities001', -# [ only_ways(['threaded1','threaded2']), -# extra_run_opts('4 12 2000'), -# reqlib('parallel'), -# req_smp ], -# compile_and_run, ['']) +test('setnumcapabilities001', + [ only_ways(['threaded1','threaded2']), + extra_run_opts('4 12 2000'), + req_smp ], + compile_and_run, ['']) # omit ghci, which can't handle unboxed tuples: test('compareAndSwap', [omit_ways(['ghci','hpc']), reqlib('primitive')], compile_and_run, ['']) diff --git a/testsuite/tests/concurrent/should_run/setnumcapabilities001.hs b/testsuite/tests/concurrent/should_run/setnumcapabilities001.hs index 1927cd8..27685f0 100644 --- a/testsuite/tests/concurrent/should_run/setnumcapabilities001.hs +++ b/testsuite/tests/concurrent/should_run/setnumcapabilities001.hs @@ -1,19 +1,25 @@ +{-# LANGUAGE MagicHash, UnboxedTuples #-} + import GHC.Conc -import Control.Parallel -import Control.Parallel.Strategies +import GHC.Prim import System.Environment import System.IO import Control.Monad import Text.Printf import Data.Time.Clock +import Control.DeepSeq main = do [n,q,t] <- fmap (fmap read) getArgs - forkIO $ do + t <- forkIO $ do forM_ (cycle ([n,n-1..1] ++ [2..n-1])) $ \m -> do setNumCapabilities m threadDelay t printf "%d" (nqueens q) + killThread t + -- If we don't kill the child thread, it might be about to + -- call setNumCapabilities() in C when the main thread exits, + -- and chaos can ensue. See #12038 nqueens :: Int -> Int nqueens nq = length (pargen 0 []) @@ -32,3 +38,46 @@ nqueens nq = length (pargen 0 []) where bs = map (pargen (n+1)) (gen [b]) `using` parList rdeepseq threshold = 3 + +using :: a -> Strategy a -> a +x `using` strat = runEval (strat x) + +type Strategy a = a -> Eval a + +newtype Eval a = Eval (State# RealWorld -> (# State# RealWorld, a #)) + +runEval :: Eval a -> a +runEval (Eval x) = case x realWorld# of (# _, a #) -> a + +instance Functor Eval where + fmap = liftM + +instance Applicative Eval where + pure x = Eval $ \s -> (# s, x #) + (<*>) = ap + +instance Monad Eval where + return = pure + Eval x >>= k = Eval $ \s -> case x s of + (# s', a #) -> case k a of + Eval f -> f s' + +parList :: Strategy a -> Strategy [a] +parList strat = traverse (rparWith strat) + +rpar :: Strategy a +rpar x = Eval $ \s -> spark# x s + +rseq :: Strategy a +rseq x = Eval $ \s -> seq# x s + +rparWith :: Strategy a -> Strategy a +rparWith s a = do l <- rpar r; return (case l of Lift x -> x) + where r = case s a of + Eval f -> case f realWorld# of + (# _, a' #) -> Lift a' + +data Lift a = Lift a + +rdeepseq :: NFData a => Strategy a +rdeepseq x = do rseq (rnf x); return x From git at git.haskell.org Thu Aug 25 16:37:15 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 25 Aug 2016 16:37:15 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Fix double-free in T5644 (#12208) (eb40deb) Message-ID: <20160825163715.4E5BF3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/eb40deb73215971b5e745cc7cc454124b7ac5250/ghc >--------------------------------------------------------------- commit eb40deb73215971b5e745cc7cc454124b7ac5250 Author: Simon Marlow Date: Mon Jun 20 13:33:13 2016 +0100 Fix double-free in T5644 (#12208) (cherry picked from commit e7e42c838e32ef1e05daf04b0b6afb62ffc4ec97) >--------------------------------------------------------------- eb40deb73215971b5e745cc7cc454124b7ac5250 rts/Schedule.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/rts/Schedule.c b/rts/Schedule.c index adb1aa1..d0ab715 100644 --- a/rts/Schedule.c +++ b/rts/Schedule.c @@ -1862,8 +1862,6 @@ delete_threads_and_gc: } task->cap = cap; } - - stgFree(idle_cap); #endif if (heap_overflow && sched_state < SCHED_INTERRUPTING) { @@ -1892,6 +1890,8 @@ delete_threads_and_gc: #endif #if defined(THREADED_RTS) + stgFree(idle_cap); + if (gc_type == SYNC_GC_SEQ) { // release our stash of capabilities. releaseAllCapabilities(n_capabilities, cap, task); From git at git.haskell.org Thu Aug 25 16:37:17 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 25 Aug 2016 16:37:17 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Move stat_startGCSync (efcd302) Message-ID: <20160825163717.F0F883A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/efcd302bbdbc6aa3e531c306c23a0ab25c6f6968/ghc >--------------------------------------------------------------- commit efcd302bbdbc6aa3e531c306c23a0ab25c6f6968 Author: Bartosz Nitka Date: Wed Jul 27 08:25:59 2016 -0700 Move stat_startGCSync @simonmar told me that it makes more sense this way. Test Plan: it still builds Reviewers: bgamari, austin, simonmar, erikd Reviewed By: simonmar, erikd Subscribers: thomie, simonmar Differential Revision: https://phabricator.haskell.org/D2428 (cherry picked from commit e98edbd1b8947dcb4a47d20fc854c0a9a6954bea) >--------------------------------------------------------------- efcd302bbdbc6aa3e531c306c23a0ab25c6f6968 rts/Schedule.c | 2 ++ rts/sm/GC.c | 2 -- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/rts/Schedule.c b/rts/Schedule.c index d0ab715..ff0a3d0 100644 --- a/rts/Schedule.c +++ b/rts/Schedule.c @@ -1641,6 +1641,8 @@ scheduleDoGC (Capability **pcap, Task *task USED_IF_THREADS, } while (was_syncing); } + stat_startGCSync(gc_threads[cap->no]); + #ifdef DEBUG unsigned int old_n_capabilities = n_capabilities; #endif diff --git a/rts/sm/GC.c b/rts/sm/GC.c index 1072d0e..0405c80 100644 --- a/rts/sm/GC.c +++ b/rts/sm/GC.c @@ -1068,8 +1068,6 @@ waitForGcThreads (Capability *cap USED_IF_THREADS) nat i, j; rtsBool retry = rtsTrue; - stat_startGCSync(gc_threads[cap->no]); - while(retry) { for (i=0; i < n_threads; i++) { if (i == me || gc_threads[i]->idle) continue; From git at git.haskell.org Thu Aug 25 16:37:20 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 25 Aug 2016 16:37:20 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Track the lengths of the thread queues (4d14d71) Message-ID: <20160825163720.AFF083A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/4d14d718c4c00be6dbcb3df4ab9c80b2da228697/ghc >--------------------------------------------------------------- commit 4d14d718c4c00be6dbcb3df4ab9c80b2da228697 Author: Simon Marlow Date: Tue Aug 2 09:55:31 2016 +0100 Track the lengths of the thread queues Summary: Knowing the length of the run queue in O(1) time is useful: for example we don't have to traverse the run queue to know how many threads we have to migrate in schedulePushWork(). Test Plan: validate Reviewers: ezyang, erikd, bgamari, austin Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2437 (cherry picked from commit 55f5aed756cd5d464942dddcb33e0bd19b05f2a4) >--------------------------------------------------------------- 4d14d718c4c00be6dbcb3df4ab9c80b2da228697 rts/Capability.c | 9 +++++++-- rts/Capability.h | 23 +++++++++++++++++++---- rts/Schedule.c | 39 +++++++++++++++------------------------ rts/Schedule.h | 15 +++++---------- rts/sm/Sanity.c | 6 ++++-- 5 files changed, 50 insertions(+), 42 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 4d14d718c4c00be6dbcb3df4ab9c80b2da228697 From git at git.haskell.org Thu Aug 25 16:37:23 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 25 Aug 2016 16:37:23 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Fix to thread migration (9f1b6de) Message-ID: <20160825163723.642903A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/9f1b6de8b3f788730fa5e2206fb709400299be7c/ghc >--------------------------------------------------------------- commit 9f1b6de8b3f788730fa5e2206fb709400299be7c Author: Simon Marlow Date: Wed Jul 27 16:00:08 2016 +0100 Fix to thread migration Summary: If we had 2 threads on the run queue, say [A,B], and B is bound to the current Task, then we would fail to migrate any threads. This fixes it so that we would migrate A in that case. This will help parallelism a bit in programs that have lots of bound threads. Test Plan: Test program in #12419, which is actually not a great program but it does behave a bit better after this change. Reviewers: ezyang, niteria, bgamari, austin, erikd Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2430 GHC Trac Issues: #12419 (cherry picked from commit 988ad8ba8e709eff3cea59728e481bb269fa6185) >--------------------------------------------------------------- 9f1b6de8b3f788730fa5e2206fb709400299be7c rts/Schedule.c | 87 ++++++++++++++++++++++++++++++++++++++++++---------------- 1 file changed, 63 insertions(+), 24 deletions(-) diff --git a/rts/Schedule.c b/rts/Schedule.c index 6e0f480..1f3fa36 100644 --- a/rts/Schedule.c +++ b/rts/Schedule.c @@ -698,13 +698,16 @@ schedulePushWork(Capability *cap USED_IF_THREADS, Capability *free_caps[n_capabilities], *cap0; uint32_t i, n_wanted_caps, n_free_caps; + uint32_t spare_threads = cap->n_run_queue > 0 ? cap->n_run_queue - 1 : 0; + // migration can be turned off with +RTS -qm - if (!RtsFlags.ParFlags.migrate) return; + if (!RtsFlags.ParFlags.migrate) { + spare_threads = 0; + } // Figure out how many capabilities we want to wake up. We need at least // sparkPoolSize(cap) plus the number of spare threads we have. - n_wanted_caps = sparkPoolSizeCap(cap) + cap->n_run_queue - 1; - + n_wanted_caps = sparkPoolSizeCap(cap) + spare_threads; if (n_wanted_caps == 0) return; // First grab as many free Capabilities as we can. @@ -725,10 +728,22 @@ schedulePushWork(Capability *cap USED_IF_THREADS, } } - // we now have n_free_caps free capabilities stashed in - // free_caps[]. Share our run queue equally with them. This is - // probably the simplest thing we could do; improvements we might - // want to do include: + // We now have n_free_caps free capabilities stashed in + // free_caps[]. Attempt to share our run queue equally with them. + // This is complicated slightly by the fact that we can't move + // some threads: + // + // - threads that have TSO_LOCKED cannot migrate + // - a thread that is bound to the current Task cannot be migrated + // + // So we walk through the run queue, migrating threads to + // free_caps[] round-robin, skipping over immovable threads. Each + // time through free_caps[] we keep one thread for ourselves, + // provided we haven't encountered one or more immovable threads + // in this pass. + // + // This is about the simplest thing we could do; improvements we + // might want to do include: // // - giving high priority to moving relatively new threads, on // the gournds that they haven't had time to build up a @@ -743,10 +758,8 @@ schedulePushWork(Capability *cap USED_IF_THREADS, #endif debugTrace(DEBUG_sched, - "cap %d: %s and %d free capabilities, sharing...", - cap->no, - (cap->n_run_queue > 1)? - "excess threads on run queue":"sparks to share (>=2)", + "cap %d: %d threads, %d sparks, and %d free capabilities, sharing...", + cap->no, cap->n_run_queue, sparkPoolSizeCap(cap), n_free_caps); i = 0; @@ -754,27 +767,56 @@ schedulePushWork(Capability *cap USED_IF_THREADS, pushed_to_all = rtsFalse; #endif - if (cap->run_queue_hd != END_TSO_QUEUE) { - prev = cap->run_queue_hd; - t = prev->_link; - prev->_link = END_TSO_QUEUE; + // We want to share threads equally amongst free_caps[] and the + // current capability, but sometimes we encounter immovable + // threads. This counter tracks the number of threads we have kept + // for the current capability minus the number of passes over + // free_caps[]. If it is great than zero (due to immovable + // threads), we should try to bring it back to zero again by not + // keeping any threads for the current capability. + uint32_t imbalance = 0; + + // n_free_caps may be larger than the number of spare threads we have, + // if there were sparks in the spark pool. To avoid giving away all our + // threads in this case, we limit the number of caps that we give + // threads to, to the number of spare threads (n_run_queue-1). + uint32_t thread_recipients = stg_min(spare_threads, n_free_caps); + + if (thread_recipients > 0) { + prev = END_TSO_QUEUE; + t = cap->run_queue_hd; for (; t != END_TSO_QUEUE; t = next) { next = t->_link; t->_link = END_TSO_QUEUE; if (t->bound == task->incall // don't move my bound thread || tsoLocked(t)) { // don't move a locked thread - setTSOLink(cap, prev, t); + if (prev == END_TSO_QUEUE) { + cap->run_queue_hd = t; + } else { + setTSOLink(cap, prev, t); + } setTSOPrev(cap, t, prev); prev = t; - } else if (i == n_free_caps) { + imbalance++; + } else if (i == thread_recipients) { #ifdef SPARK_PUSHING pushed_to_all = rtsTrue; #endif + // If we have not already kept any threads for this + // capability during the current pass over free_caps[], + // keep one now. + if (imbalance == 0) { + if (prev == END_TSO_QUEUE) { + cap->run_queue_hd = t; + } else { + setTSOLink(cap, prev, t); + } + setTSOPrev(cap, t, prev); + prev = t; + } else { + imbalance--; + } i = 0; - // keep one for us - setTSOLink(cap, prev, t); - setTSOPrev(cap, t, prev); - prev = t; } else { appendToRunQueue(free_caps[i],t); cap->n_run_queue--; @@ -2189,9 +2231,6 @@ setNumCapabilities (nat new_n_capabilities USED_IF_THREADS) n_capabilities = enabled_capabilities = new_n_capabilities; } - // Start worker tasks on the new Capabilities - startWorkerTasks(old_n_capabilities, new_n_capabilities); - // We're done: release the original Capabilities releaseAllCapabilities(old_n_capabilities, cap,task); From git at git.haskell.org Thu Aug 25 16:37:26 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 25 Aug 2016 16:37:26 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Another try to get thread migration right (13ff342) Message-ID: <20160825163726.114A63A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/13ff3423e058a409b035acce5c1448237885ac84/ghc >--------------------------------------------------------------- commit 13ff3423e058a409b035acce5c1448237885ac84 Author: Simon Marlow Date: Thu Aug 4 15:59:43 2016 +0100 Another try to get thread migration right Summary: This is surprisingly tricky. There were linked list bugs in the previous version (D2430) that showed up as a test failure in setnumcapabilities001 (that's a great stress test!). This new version uses a different strategy that doesn't suffer from the problem that @ezyang pointed out in D2430. We now pre-calculate how many threads to keep for this capability, and then migrate any surplus threads off the front of the queue, taking care to account for threads that can't be migrated. Test Plan: 1. setnumcapabilities001 stress test with sanity checking (+RTS -DS) turned on: ``` cd testsuite/tests/concurrent/should_run make TEST=setnumcapabilities001 WAY=threaded1 EXTRA_HC_OPTS=-with-rtsopts=-DS CLEANUP=0 while true; do ./setnumcapabilities001.run/setnumcapabilities001 4 9 2000 || break; done ``` 2. The test case from #12419 Reviewers: niteria, ezyang, rwbarton, austin, bgamari, erikd Subscribers: thomie, ezyang Differential Revision: https://phabricator.haskell.org/D2441 GHC Trac Issues: #12419 (cherry picked from commit 89fa4e968f47cfb42d0dc33fc3bfffdce31d850e) >--------------------------------------------------------------- 13ff3423e058a409b035acce5c1448237885ac84 rts/Schedule.c | 161 ++++++++++++++++++++++----------------------------------- 1 file changed, 62 insertions(+), 99 deletions(-) diff --git a/rts/Schedule.c b/rts/Schedule.c index 1f3fa36..74859af 100644 --- a/rts/Schedule.c +++ b/rts/Schedule.c @@ -736,12 +736,6 @@ schedulePushWork(Capability *cap USED_IF_THREADS, // - threads that have TSO_LOCKED cannot migrate // - a thread that is bound to the current Task cannot be migrated // - // So we walk through the run queue, migrating threads to - // free_caps[] round-robin, skipping over immovable threads. Each - // time through free_caps[] we keep one thread for ourselves, - // provided we haven't encountered one or more immovable threads - // in this pass. - // // This is about the simplest thing we could do; improvements we // might want to do include: // @@ -753,112 +747,81 @@ schedulePushWork(Capability *cap USED_IF_THREADS, if (n_free_caps > 0) { StgTSO *prev, *t, *next; -#ifdef SPARK_PUSHING - rtsBool pushed_to_all; -#endif debugTrace(DEBUG_sched, "cap %d: %d threads, %d sparks, and %d free capabilities, sharing...", cap->no, cap->n_run_queue, sparkPoolSizeCap(cap), n_free_caps); - i = 0; -#ifdef SPARK_PUSHING - pushed_to_all = rtsFalse; -#endif - - // We want to share threads equally amongst free_caps[] and the - // current capability, but sometimes we encounter immovable - // threads. This counter tracks the number of threads we have kept - // for the current capability minus the number of passes over - // free_caps[]. If it is great than zero (due to immovable - // threads), we should try to bring it back to zero again by not - // keeping any threads for the current capability. - uint32_t imbalance = 0; - - // n_free_caps may be larger than the number of spare threads we have, - // if there were sparks in the spark pool. To avoid giving away all our - // threads in this case, we limit the number of caps that we give - // threads to, to the number of spare threads (n_run_queue-1). - uint32_t thread_recipients = stg_min(spare_threads, n_free_caps); - - if (thread_recipients > 0) { - prev = END_TSO_QUEUE; - t = cap->run_queue_hd; - for (; t != END_TSO_QUEUE; t = next) { - next = t->_link; - t->_link = END_TSO_QUEUE; - if (t->bound == task->incall // don't move my bound thread - || tsoLocked(t)) { // don't move a locked thread - if (prev == END_TSO_QUEUE) { - cap->run_queue_hd = t; - } else { - setTSOLink(cap, prev, t); - } - setTSOPrev(cap, t, prev); - prev = t; - imbalance++; - } else if (i == thread_recipients) { -#ifdef SPARK_PUSHING - pushed_to_all = rtsTrue; -#endif - // If we have not already kept any threads for this - // capability during the current pass over free_caps[], - // keep one now. - if (imbalance == 0) { - if (prev == END_TSO_QUEUE) { - cap->run_queue_hd = t; - } else { - setTSOLink(cap, prev, t); - } - setTSOPrev(cap, t, prev); - prev = t; - } else { - imbalance--; - } - i = 0; + // There are n_free_caps+1 caps in total. We will share the threads + // evently between them, *except* that if the run queue does not divide + // evenly by n_free_caps+1 then we bias towards the current capability. + // e.g. with n_run_queue=4, n_free_caps=2, we will keep 2. + uint32_t keep_threads = + (cap->n_run_queue + n_free_caps) / (n_free_caps + 1); + + // This also ensures that we don't give away all our threads, since + // (x + y) / (y + 1) >= 1 when x >= 1. + + // The number of threads we have left. + uint32_t n = cap->n_run_queue; + + // prev = the previous thread on this cap's run queue + prev = END_TSO_QUEUE; + + // We're going to walk through the run queue, migrating threads to other + // capabilities until we have only keep_threads left. We might + // encounter a thread that cannot be migrated, in which case we add it + // to the current run queue and decrement keep_threads. + for (t = cap->run_queue_hd, i = 0; + t != END_TSO_QUEUE && n > keep_threads; + t = next) + { + next = t->_link; + t->_link = END_TSO_QUEUE; + + // Should we keep this thread? + if (t->bound == task->incall // don't move my bound thread + || tsoLocked(t) // don't move a locked thread + ) { + if (prev == END_TSO_QUEUE) { + cap->run_queue_hd = t; } else { - appendToRunQueue(free_caps[i],t); - cap->n_run_queue--; - - traceEventMigrateThread (cap, t, free_caps[i]->no); - - if (t->bound) { t->bound->task->cap = free_caps[i]; } - t->cap = free_caps[i]; - i++; + setTSOLink(cap, prev, t); } + setTSOPrev(cap, t, prev); + prev = t; + if (keep_threads > 0) keep_threads--; } - cap->run_queue_tl = prev; - IF_DEBUG(sanity, checkRunQueue(cap)); - } + // Or migrate it? + else { + appendToRunQueue(free_caps[i],t); + traceEventMigrateThread (cap, t, free_caps[i]->no); -#ifdef SPARK_PUSHING - /* JB I left this code in place, it would work but is not necessary */ - - // If there are some free capabilities that we didn't push any - // threads to, then try to push a spark to each one. - if (!pushed_to_all) { - StgClosure *spark; - // i is the next free capability to push to - for (; i < n_free_caps; i++) { - if (emptySparkPoolCap(free_caps[i])) { - spark = tryStealSpark(cap->sparks); - if (spark != NULL) { - /* TODO: if anyone wants to re-enable this code then - * they must consider the fizzledSpark(spark) case - * and update the per-cap spark statistics. - */ - debugTrace(DEBUG_sched, "pushing spark %p to capability %d", spark, free_caps[i]->no); - - traceEventStealSpark(free_caps[i], t, cap->no); - - newSpark(&(free_caps[i]->r), spark); - } - } + if (t->bound) { t->bound->task->cap = free_caps[i]; } + t->cap = free_caps[i]; + n--; // we have one fewer threads now + i++; // move on to the next free_cap + if (i == n_free_caps) i = 0; } } -#endif /* SPARK_PUSHING */ + + // Join up the beginning of the queue (prev) + // with the rest of the queue (t) + if (t == END_TSO_QUEUE) { + cap->run_queue_tl = prev; + } else { + setTSOPrev(cap, t, prev); + } + if (prev == END_TSO_QUEUE) { + cap->run_queue_hd = t; + } else { + setTSOLink(cap, prev, t); + } + cap->n_run_queue = n; + + IF_DEBUG(sanity, checkRunQueue(cap)); // release the capabilities for (i = 0; i < n_free_caps; i++) { From git at git.haskell.org Thu Aug 25 16:37:29 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 25 Aug 2016 16:37:29 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: check that the number of parallel build is greater than 0 (6f804c2) Message-ID: <20160825163729.62E173A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/6f804c249bf4ca9b8b3b63796fc36c0ec69a936b/ghc >--------------------------------------------------------------- commit 6f804c249bf4ca9b8b3b63796fc36c0ec69a936b Author: Ruey-Lin Hsu Date: Thu Aug 4 13:41:57 2016 +0200 check that the number of parallel build is greater than 0 Fixes #12062. Reviewers: bgamari, thomie, austin, simonmar Reviewed By: bgamari, thomie, simonmar Subscribers: simonmar, thomie Differential Revision: https://phabricator.haskell.org/D2415 GHC Trac Issues: #12062 (cherry picked from commit f09d65474ed042360999cb88221d65b07bfb4b5f) >--------------------------------------------------------------- 6f804c249bf4ca9b8b3b63796fc36c0ec69a936b compiler/main/DynFlags.hs | 13 +++++++++++-- docs/users_guide/using.rst | 10 ++++++---- .../{programs/hs-boot/A.hs-boot => driver/T12062/A.hs} | 2 -- testsuite/tests/{th/T2014 => driver/T12062}/A.hs-boot | 0 .../{th/TH_import_loop/ModuleC.hs => driver/T12062/C.hs} | 6 ++---- .../scripts/break022 => driver/T12062}/Makefile | 0 .../TH_import_loop/ModuleB.hs => driver/T12062/T12062.hs} | 7 ++----- testsuite/tests/driver/T12062/T12062.stderr | 2 ++ testsuite/tests/driver/T12062/all.T | 2 ++ 9 files changed, 25 insertions(+), 17 deletions(-) diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 0a944b7..7582e11 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -2328,8 +2328,17 @@ dynamic_flags_deps = [ "deprecated: They no longer have any effect")))) , make_ord_flag defFlag "v" (OptIntSuffix setVerbosity) - , make_ord_flag defGhcFlag "j" (OptIntSuffix (\n -> - upd (\d -> d {parMakeCount = n}))) + , make_ord_flag defGhcFlag "j" (OptIntSuffix + (\n -> case n of + Just n + | n > 0 -> upd (\d -> d { parMakeCount = Just n }) + | otherwise -> addErr "Syntax: -j[n] where n > 0" + Nothing -> upd (\d -> d { parMakeCount = Nothing }))) + -- When the number of parallel builds + -- is omitted, it is the same + -- as specifing that the number of + -- parallel builds is equal to the + -- result of getNumProcessors , make_ord_flag defFlag "sig-of" (sepArg setSigOf) -- RTS options ------------------------------------------------------------- diff --git a/docs/users_guide/using.rst b/docs/users_guide/using.rst index 3d3ef34..1d7f52c 100644 --- a/docs/users_guide/using.rst +++ b/docs/users_guide/using.rst @@ -418,7 +418,8 @@ The main advantages to using ``ghc --make`` over traditional dependencies never get out of sync with the source. - Using the :ghc-flag:`-j` flag, you can compile modules in parallel. Specify - ``-j⟨N⟩`` to compile ⟨N⟩ jobs in parallel. + ``-j⟨N⟩`` to compile ⟨N⟩ jobs in parallel. If N is omitted, + then it defaults to the number of processors. Any of the command-line options described in the rest of this chapter can be used with ``--make``, but note that any options you give on the @@ -444,11 +445,12 @@ The source files for the program don't all need to be in the same directory; the :ghc-flag:`-i` option can be used to add directories to the search path (see :ref:`search-path`). -.. ghc-flag:: -j +.. ghc-flag:: -j [N] Perform compilation in parallel when possible. GHC will use up to ⟨N⟩ - threads during compilation. Note that compilation of a module may not - begin until its dependencies have been built. + threads during compilation. If N is omitted, then it defaults to the + number of processors. Note that compilation of a module may not begin + until its dependencies have been built. .. _eval-mode: diff --git a/testsuite/tests/programs/hs-boot/A.hs-boot b/testsuite/tests/driver/T12062/A.hs similarity index 92% copy from testsuite/tests/programs/hs-boot/A.hs-boot copy to testsuite/tests/driver/T12062/A.hs index c80b00d..b1ea7a4 100644 --- a/testsuite/tests/programs/hs-boot/A.hs-boot +++ b/testsuite/tests/driver/T12062/A.hs @@ -1,4 +1,2 @@ - module A where - import C diff --git a/testsuite/tests/th/T2014/A.hs-boot b/testsuite/tests/driver/T12062/A.hs-boot similarity index 100% copy from testsuite/tests/th/T2014/A.hs-boot copy to testsuite/tests/driver/T12062/A.hs-boot diff --git a/testsuite/tests/th/TH_import_loop/ModuleC.hs b/testsuite/tests/driver/T12062/C.hs similarity index 53% copy from testsuite/tests/th/TH_import_loop/ModuleC.hs copy to testsuite/tests/driver/T12062/C.hs index 3047a8f..0f2a5b3 100644 --- a/testsuite/tests/th/TH_import_loop/ModuleC.hs +++ b/testsuite/tests/driver/T12062/C.hs @@ -1,9 +1,7 @@ - -module ModuleC where +module C where import Language.Haskell.TH -import {-# SOURCE #-} ModuleA +import {-# SOURCE #-} A nothing = return [] :: Q [Dec] - diff --git a/testsuite/tests/ghci.debugger/scripts/break022/Makefile b/testsuite/tests/driver/T12062/Makefile similarity index 100% copy from testsuite/tests/ghci.debugger/scripts/break022/Makefile copy to testsuite/tests/driver/T12062/Makefile diff --git a/testsuite/tests/th/TH_import_loop/ModuleB.hs b/testsuite/tests/driver/T12062/T12062.hs similarity index 54% copy from testsuite/tests/th/TH_import_loop/ModuleB.hs copy to testsuite/tests/driver/T12062/T12062.hs index 9aaffb6..ed581c0 100644 --- a/testsuite/tests/th/TH_import_loop/ModuleB.hs +++ b/testsuite/tests/driver/T12062/T12062.hs @@ -1,9 +1,6 @@ - {-# LANGUAGE TemplateHaskell #-} +module T12062 where -module ModuleB where - -import ModuleC +import C $(nothing) - diff --git a/testsuite/tests/driver/T12062/T12062.stderr b/testsuite/tests/driver/T12062/T12062.stderr new file mode 100644 index 0000000..8262940 --- /dev/null +++ b/testsuite/tests/driver/T12062/T12062.stderr @@ -0,0 +1,2 @@ +ghc-stage2: on the commandline: Syntax: -j[n] where n > 0 +Usage: For basic information, try the `--help' option. diff --git a/testsuite/tests/driver/T12062/all.T b/testsuite/tests/driver/T12062/all.T new file mode 100644 index 0000000..1372ae3 --- /dev/null +++ b/testsuite/tests/driver/T12062/all.T @@ -0,0 +1,2 @@ +test('T12062', extra_clean(['T12062.o','T12062.hi', 'A.hi', 'A.o', 'A.hi-boot', 'A.o-boot', 'C.hi', 'C.o']), + multimod_compile_fail, ['T12062', '-v0 -j0']) From git at git.haskell.org Thu Aug 25 16:37:32 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 25 Aug 2016 16:37:32 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Not-in-scope variables are always errors (6071ecf) Message-ID: <20160825163732.7C33B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/6071ecf4ff7501c70456c1448fa2f78e91bc8078/ghc >--------------------------------------------------------------- commit 6071ecf4ff7501c70456c1448fa2f78e91bc8078 Author: Simon Peyton Jones Date: Wed Aug 17 12:04:30 2016 +0100 Not-in-scope variables are always errors This fixes Trac #12406. A not-in-scope error shoudl be an error even if you have -fdefer-typed-holes. (cherry picked from commit efc0372a157eadeee58bbada77c64d53590e04af) >--------------------------------------------------------------- 6071ecf4ff7501c70456c1448fa2f78e91bc8078 compiler/typecheck/TcErrors.hs | 10 ++++++++-- .../tests/partial-sigs/should_compile/T12156.stderr | 3 +-- testsuite/tests/partial-sigs/should_compile/all.T | 2 +- testsuite/tests/typecheck/should_fail/T12406.hs | 20 ++++++++++++++++++++ testsuite/tests/typecheck/should_fail/T12406.stderr | 12 ++++++++++++ testsuite/tests/typecheck/should_fail/all.T | 1 + 6 files changed, 43 insertions(+), 5 deletions(-) diff --git a/compiler/typecheck/TcErrors.hs b/compiler/typecheck/TcErrors.hs index 406f13d..d638892 100644 --- a/compiler/typecheck/TcErrors.hs +++ b/compiler/typecheck/TcErrors.hs @@ -613,9 +613,15 @@ maybeReportHoleError ctxt ct err HoleWarn -> reportWarning (Reason Opt_WarnPartialTypeSignatures) err HoleDefer -> return () - -- Otherwise this is a typed hole in an expression + | isOutOfScopeCt ct + = -- Always report an error for out-of-scope variables + -- See Trac #12170, #12406 + reportError err + + -- Otherwise this is a typed hole in an expression, + -- but not for an out-of-scope variable | otherwise - = -- If deferring, report a warning only if -Wtyped-holds is on + = -- If deferring, report a warning only if -Wtyped-holes is on case cec_expr_holes ctxt of HoleError -> reportError err HoleWarn -> reportWarning (Reason Opt_WarnTypedHoles) err diff --git a/testsuite/tests/partial-sigs/should_compile/T12156.stderr b/testsuite/tests/partial-sigs/should_compile/T12156.stderr index 6508d8a..f1a5b9d 100644 --- a/testsuite/tests/partial-sigs/should_compile/T12156.stderr +++ b/testsuite/tests/partial-sigs/should_compile/T12156.stderr @@ -1,3 +1,2 @@ -T12156.hs:3:14: warning: [-Wtyped-holes (in -Wdefault)] - Variable not in scope: v +T12156.hs:3:14: error: Variable not in scope: v diff --git a/testsuite/tests/partial-sigs/should_compile/all.T b/testsuite/tests/partial-sigs/should_compile/all.T index bc3531a..63a6efc 100644 --- a/testsuite/tests/partial-sigs/should_compile/all.T +++ b/testsuite/tests/partial-sigs/should_compile/all.T @@ -62,4 +62,4 @@ test('T10463', normal, compile, ['']) test('ExprSigLocal', normal, compile, ['']) test('T11016', normal, compile, ['']) test('T11192', normal, compile, ['']) -test('T12156', normal, compile, ['-fdefer-typed-holes']) +test('T12156', normal, compile_fail, ['-fdefer-typed-holes']) diff --git a/testsuite/tests/typecheck/should_fail/T12406.hs b/testsuite/tests/typecheck/should_fail/T12406.hs new file mode 100644 index 0000000..20264cc --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T12406.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE TypeFamilies #-} +{-# OPTIONS_GHC -fdefer-typed-holes #-} + +module T12406 where + +-- import Control.Monad -- comment this out to cause error +import Data.IORef + +class MonadRef m where + type Ref m :: * -> * + newRef :: a -> m (Ref m a) + readRef :: Ref m a -> m a + +instance MonadRef IO where + type Ref IO = IORef + newRef = newIORef + readRef = readIORef + +foo :: IO () +foo = newRef (pure ()) >>= join . readRef diff --git a/testsuite/tests/typecheck/should_fail/T12406.stderr b/testsuite/tests/typecheck/should_fail/T12406.stderr new file mode 100644 index 0000000..85096e6 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T12406.stderr @@ -0,0 +1,12 @@ + +T12406.hs:20:7: error: + • Couldn't match type ‘Ref m0’ with ‘IORef’ + Expected type: IO (Ref m0 (f0 ())) + Actual type: IO (Ref IO (f0 ())) + The type variable ‘m0’ is ambiguous + • In the first argument of ‘(>>=)’, namely ‘newRef (pure ())’ + In the expression: newRef (pure ()) >>= join . readRef + In an equation for ‘foo’: foo = newRef (pure ()) >>= join . readRef + +T12406.hs:20:28: error: + Variable not in scope: join :: m0 (f0 ()) -> IO () diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T index e6aa020..3880287 100644 --- a/testsuite/tests/typecheck/should_fail/all.T +++ b/testsuite/tests/typecheck/should_fail/all.T @@ -419,3 +419,4 @@ test('T12151', normal, compile_fail, ['']) test('T7437', normal, compile_fail, ['']) test('T11947a', normal, compile_fail, ['']) test('T11974b', normal, compile_fail, ['']) +test('T12406', normal, compile_fail, ['']) From git at git.haskell.org Thu Aug 25 16:37:35 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 25 Aug 2016 16:37:35 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Keep the bindings local during defaultCallStacks (829b968) Message-ID: <20160825163735.93B283A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/829b9682969a5dabd3a75b82864c48c2e6a19ee8/ghc >--------------------------------------------------------------- commit 829b9682969a5dabd3a75b82864c48c2e6a19ee8 Author: Simon Peyton Jones Date: Wed Aug 17 14:35:19 2016 +0100 Keep the bindings local during defaultCallStacks defaultCallStacks generates evidence bindings for call stacks, but wasn't setting the binding site correctly. As a result they were simply discarded in the case of pattern synonyms, giving rise to Trac #12489. The fix is easy; and I added an ASSERT to catch the error earlier. (cherry picked from commit f352e5cd7bb629fe0ca3b913bfbe7bee43d62f3a) >--------------------------------------------------------------- 829b9682969a5dabd3a75b82864c48c2e6a19ee8 compiler/typecheck/TcPatSyn.hs | 4 +++- compiler/typecheck/TcSMonad.hs | 6 +++++- compiler/typecheck/TcSimplify.hs | 9 ++++++--- testsuite/tests/patsyn/should_compile/T12489.hs | 5 +++++ testsuite/tests/patsyn/should_compile/all.T | 1 + 5 files changed, 20 insertions(+), 5 deletions(-) diff --git a/compiler/typecheck/TcPatSyn.hs b/compiler/typecheck/TcPatSyn.hs index 5113856..73c46e8 100644 --- a/compiler/typecheck/TcPatSyn.hs +++ b/compiler/typecheck/TcPatSyn.hs @@ -293,8 +293,10 @@ tcCheckPatSynDecl psb at PSB{ psb_id = lname@(L _ name), psb_args = details -- Solve the constraints now, because we are about to make a PatSyn, -- which should not contain unification variables and the like (Trac #10997) + ; empty_binds <- simplifyTop (mkImplicWC implics) + -- Since all the inputs are implications the returned bindings will be empty - ; _ <- simplifyTop (mkImplicWC implics) + ; MASSERT2( isEmptyBag empty_binds, ppr empty_binds ) -- ToDo: in the bidirectional case, check that the ex_tvs' are all distinct -- Otherwise we may get a type error when typechecking the builder, diff --git a/compiler/typecheck/TcSMonad.hs b/compiler/typecheck/TcSMonad.hs index 3b4b842..e825dd4 100644 --- a/compiler/typecheck/TcSMonad.hs +++ b/compiler/typecheck/TcSMonad.hs @@ -16,7 +16,7 @@ module TcSMonad ( TcS, runTcS, runTcSDeriveds, runTcSWithEvBinds, failTcS, warnTcS, addErrTcS, runTcSEqualities, - nestTcS, nestImplicTcS, + nestTcS, nestImplicTcS, setEvBindsTcS, runTcPluginTcS, addUsedGREs, deferTcSForAllEq, @@ -2477,6 +2477,10 @@ checkForCyclicBinds ev_binds | bind@(EvBind { eb_lhs = bndr, eb_rhs = rhs}) <- bagToList ev_binds ] #endif +setEvBindsTcS :: Maybe EvBindsVar -> TcS a -> TcS a +setEvBindsTcS m_ref (TcS thing_inside) + = TcS $ \ env -> thing_inside (env { tcs_ev_binds = m_ref }) + nestImplicTcS :: Maybe EvBindsVar -> TyCoVarSet -- bound in this implication -> TcLevel -> TcS a -> TcS (a, TyCoVarSet) -- also returns any vars used when filling diff --git a/compiler/typecheck/TcSimplify.hs b/compiler/typecheck/TcSimplify.hs index c8702b4..f3c4b5b 100644 --- a/compiler/typecheck/TcSimplify.hs +++ b/compiler/typecheck/TcSimplify.hs @@ -177,9 +177,12 @@ defaultCallStacks wanteds handle_simples simples = catBagMaybes <$> mapBagM defaultCallStack simples - handle_implic implic = do - wanteds <- defaultCallStacks (ic_wanted implic) - return (implic { ic_wanted = wanteds }) + handle_implic implic + = do { wanteds <- setEvBindsTcS (ic_binds implic) $ + -- defaultCallStack sets a binding, so + -- we must set the correct binding group + defaultCallStacks (ic_wanted implic) + ; return (implic { ic_wanted = wanteds }) } defaultCallStack ct | Just _ <- isCallStackPred (ctPred ct) diff --git a/testsuite/tests/patsyn/should_compile/T12489.hs b/testsuite/tests/patsyn/should_compile/T12489.hs new file mode 100644 index 0000000..205799b --- /dev/null +++ b/testsuite/tests/patsyn/should_compile/T12489.hs @@ -0,0 +1,5 @@ +{-# LANGUAGE PatternSynonyms, ViewPatterns #-} + +module T12489 where +pattern P :: a -> b +pattern P a <- (undefined -> a) diff --git a/testsuite/tests/patsyn/should_compile/all.T b/testsuite/tests/patsyn/should_compile/all.T index 9a0c853..00d3b87 100644 --- a/testsuite/tests/patsyn/should_compile/all.T +++ b/testsuite/tests/patsyn/should_compile/all.T @@ -53,3 +53,4 @@ test('T11351', normal, compile, ['']) test('T11633', normal, compile, ['']) test('T12094', normal, compile, ['']) test('T12484', normal, compile, ['']) +test('T12489', normal, compile, ['']) From git at git.haskell.org Thu Aug 25 16:37:38 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 25 Aug 2016 16:37:38 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Improve missing-sig warning (ca58946) Message-ID: <20160825163738.E5D0C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/ca58946e7b3ac32785ef073e0e4daeece31dfd70/ghc >--------------------------------------------------------------- commit ca58946e7b3ac32785ef073e0e4daeece31dfd70 Author: Simon Peyton Jones Date: Fri Aug 12 15:52:07 2016 +0100 Improve missing-sig warning Fixes Trac #12484 (cherry picked from commit ac0e11252af149f085e2262200b7a1638b4a1553) >--------------------------------------------------------------- ca58946e7b3ac32785ef073e0e4daeece31dfd70 compiler/rename/RnNames.hs | 20 ++++---- .../tests/patsyn/should_compile/T11213.stderr | 53 ++++++++++++---------- testsuite/tests/patsyn/should_compile/T12484.hs | 7 +++ .../tests/patsyn/should_compile/T12484.stderr | 4 ++ testsuite/tests/patsyn/should_compile/all.T | 1 + testsuite/tests/patsyn/should_fail/T11053.stderr | 18 ++++---- 6 files changed, 61 insertions(+), 42 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc ca58946e7b3ac32785ef073e0e4daeece31dfd70 From git at git.haskell.org Thu Aug 25 17:54:54 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 25 Aug 2016 17:54:54 +0000 (UTC) Subject: [commit: ghc] branch 'wip/D2471' created Message-ID: <20160825175454.952BC3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/D2471 Referencing: c2844b81302aba41d558c0921ce461a6c9ef0f1e From git at git.haskell.org Thu Aug 25 17:54:58 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 25 Aug 2016 17:54:58 +0000 (UTC) Subject: [commit: ghc] wip/D2471: Fix binary-trees regression from unnecessary floating in CorePrep. (c2844b8) Message-ID: <20160825175458.1BA2E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/D2471 Link : http://ghc.haskell.org/trac/ghc/changeset/c2844b81302aba41d558c0921ce461a6c9ef0f1e/ghc >--------------------------------------------------------------- commit c2844b81302aba41d558c0921ce461a6c9ef0f1e Author: Edward Z. Yang Date: Tue Aug 23 15:53:49 2016 -0700 Fix binary-trees regression from unnecessary floating in CorePrep. Summary: In 0d3bf62092de83375025edca6f7242812338542d, I handled lazy @(Int -> Int) f x correctly, but failed to handle lazy @Int (f x) (we need to collect arguments in f x). Signed-off-by: Edward Z. Yang Test Plan: validate Reviewers: simonpj, nomeata, austin, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2471 >--------------------------------------------------------------- c2844b81302aba41d558c0921ce461a6c9ef0f1e compiler/coreSyn/CorePrep.hs | 16 ++++++++++- testsuite/tests/simplCore/should_compile/all.T | 1 + testsuite/tests/simplCore/should_compile/par01.hs | 10 +++++++ .../tests/simplCore/should_compile/par01.stderr | 33 ++++++++++++++++++++++ 4 files changed, 59 insertions(+), 1 deletion(-) diff --git a/compiler/coreSyn/CorePrep.hs b/compiler/coreSyn/CorePrep.hs index 0d82be5..c7603fc 100644 --- a/compiler/coreSyn/CorePrep.hs +++ b/compiler/coreSyn/CorePrep.hs @@ -706,7 +706,21 @@ cpeApp top_env expr cpe_app env (Var f) (CpeArg Type{} : CpeArg arg : args) depth | f `hasKey` lazyIdKey -- Replace (lazy a) with a, and || f `hasKey` noinlineIdKey -- Replace (noinline a) with a - = cpe_app env arg args (depth - 1) + -- Consider the code: + -- + -- lazy (f x) y + -- + -- We need to make sure that we need to recursively collect arguments on + -- "f x", otherwise we'll float "f x" out (it's not a variable) and + -- end up with this awful -ddump-prep: + -- + -- case f x of f_x { + -- __DEFAULT -> f_x y + -- } + -- + -- rather than the far superior "f x y". Test case is par01. + = let (terminal, args', depth') = collect_args arg + in cpe_app env terminal (args' ++ args) (depth + depth' - 1) cpe_app env (Var f) [CpeArg _runtimeRep at Type{}, CpeArg _type at Type{}, CpeArg arg] 1 | f `hasKey` runRWKey -- Replace (runRW# f) by (f realWorld#), beta reducing if possible (this diff --git a/testsuite/tests/simplCore/should_compile/all.T b/testsuite/tests/simplCore/should_compile/all.T index 92f9af4..e2e0bb6 100644 --- a/testsuite/tests/simplCore/should_compile/all.T +++ b/testsuite/tests/simplCore/should_compile/all.T @@ -243,3 +243,4 @@ test('T12076sat', normal, compile, ['-O']) test('T12212', normal, compile, ['-O']) test('noinline01', only_ways(['optasm']), compile, ['-ddump-stg -dsuppress-uniques -O']) +test('par01', only_ways(['optasm']), compile, ['-ddump-prep -dsuppress-uniques -O2']) diff --git a/testsuite/tests/simplCore/should_compile/par01.hs b/testsuite/tests/simplCore/should_compile/par01.hs new file mode 100644 index 0000000..e67fb13 --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/par01.hs @@ -0,0 +1,10 @@ +module Par01 where + +import GHC.Conc + +-- The smoking gun in -ddump-prep is: +-- case Par01.depth d of sat { __DEFAULT -> sat } +-- this should never happen! + +depth :: Int -> Int +depth d = d `par` depth d diff --git a/testsuite/tests/simplCore/should_compile/par01.stderr b/testsuite/tests/simplCore/should_compile/par01.stderr new file mode 100644 index 0000000..90d467f --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/par01.stderr @@ -0,0 +1,33 @@ + +==================== CorePrep ==================== +Result size of CorePrep = {terms: 18, types: 8, coercions: 0} + +Rec { +-- RHS size: {terms: 7, types: 3, coercions: 0} +Par01.depth [Occ=LoopBreaker] :: GHC.Types.Int -> GHC.Types.Int +[GblId, Arity=1, Caf=NoCafRefs, Str=, Unf=OtherCon []] +Par01.depth = + \ (d :: GHC.Types.Int) -> + case GHC.Prim.par# @ GHC.Types.Int d of { __DEFAULT -> + Par01.depth d + } +end Rec } + +-- RHS size: {terms: 2, types: 0, coercions: 0} +Par01.$trModule2 :: GHC.Types.TrName +[GblId, Caf=NoCafRefs, Str=m1, Unf=OtherCon []] +Par01.$trModule2 = GHC.Types.TrNameS "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0} +Par01.$trModule1 :: GHC.Types.TrName +[GblId, Caf=NoCafRefs, Str=m1, Unf=OtherCon []] +Par01.$trModule1 = GHC.Types.TrNameS "Par01"# + +-- RHS size: {terms: 3, types: 0, coercions: 0} +Par01.$trModule :: GHC.Types.Module +[GblId, Caf=NoCafRefs, Str=m, Unf=OtherCon []] +Par01.$trModule = + GHC.Types.Module Par01.$trModule2 Par01.$trModule1 + + + From git at git.haskell.org Fri Aug 26 14:01:59 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 26 Aug 2016 14:01:59 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Expand given superclasses more eagerly (0766668) Message-ID: <20160826140159.AB5963A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/0766668a10c700f463b192ce91ac44d3c48147f1/ghc >--------------------------------------------------------------- commit 0766668a10c700f463b192ce91ac44d3c48147f1 Author: Simon Peyton Jones Date: Wed Jun 22 14:17:58 2016 +0100 Expand given superclasses more eagerly This patch fixes Trac #12175, another delicate corner case of Note [Instance and Given overlap] in TcInteract. In #12175 we were not expanding given superclasses eagerly enough. It was easy to fix, and is actually rather neater than before. See Note [Eagerly expand given superclasses] in TcCanonical. The main change is to move the eager expansion of given superclasses to canClassNC. (cherry picked from commit ce97b7298d54bdfccd9dcf366a69c5617b4eb43f) >--------------------------------------------------------------- 0766668a10c700f463b192ce91ac44d3c48147f1 compiler/typecheck/TcCanonical.hs | 87 ++++++++++++++-------- compiler/typecheck/TcInteract.hs | 22 +++++- compiler/typecheck/TcRnTypes.hs | 10 ++- compiler/typecheck/TcSMonad.hs | 2 +- compiler/typecheck/TcSimplify.hs | 12 +-- .../tests/indexed-types/should_compile/T12175.hs | 36 +++++++++ testsuite/tests/indexed-types/should_compile/all.T | 2 +- 7 files changed, 125 insertions(+), 46 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 0766668a10c700f463b192ce91ac44d3c48147f1 From git at git.haskell.org Fri Aug 26 14:02:02 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 26 Aug 2016 14:02:02 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Do not init record accessors as exported (9d9eaec) Message-ID: <20160826140202.6C6DC3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/9d9eaeca03e138e0b35351c9401c832996398641/ghc >--------------------------------------------------------------- commit 9d9eaeca03e138e0b35351c9401c832996398641 Author: Ömer Sinan Ağacan Date: Fri May 27 11:02:47 2016 -0400 Do not init record accessors as exported This was causing redundant code generation when accessors are not actually exported, as they were being marked as "exported" at initialization. Test Plan: validate Reviewers: simonpj, austin, bgamari Reviewed By: simonpj Subscribers: mpickering, thomie Differential Revision: https://phabricator.haskell.org/D2270 (cherry picked from commit 3a00ff92a3ee66c096b85b180d247d1a471a6b6e) >--------------------------------------------------------------- 9d9eaeca03e138e0b35351c9401c832996398641 compiler/basicTypes/Id.hs | 7 +++++++ compiler/deSugar/Desugar.hs | 5 ++++- compiler/typecheck/TcTyDecls.hs | 7 ++++++- 3 files changed, 17 insertions(+), 2 deletions(-) diff --git a/compiler/basicTypes/Id.hs b/compiler/basicTypes/Id.hs index e55259b..990a192 100644 --- a/compiler/basicTypes/Id.hs +++ b/compiler/basicTypes/Id.hs @@ -33,6 +33,7 @@ module Id ( mkLocalId, mkLocalCoVar, mkLocalIdOrCoVar, mkLocalIdOrCoVarWithInfo, mkLocalIdWithInfo, mkExportedLocalId, mkExportedVanillaId, + mkNonExportedLocalId, mkSysLocal, mkSysLocalM, mkSysLocalOrCoVar, mkSysLocalOrCoVarM, mkUserLocal, mkUserLocalOrCoVar, mkTemplateLocals, mkTemplateLocalsNum, mkTemplateLocal, @@ -287,6 +288,12 @@ mkExportedLocalId :: IdDetails -> Name -> Type -> Id mkExportedLocalId details name ty = Var.mkExportedLocalVar details name ty vanillaIdInfo -- Note [Free type variables] +-- | Create a local 'Id' that is marked as not-exported. +-- These may be removed as dead code. +mkNonExportedLocalId :: IdDetails -> Name -> Type -> Id +mkNonExportedLocalId details name ty = + Var.mkLocalVar details name ty vanillaIdInfo + mkExportedVanillaId :: Name -> Type -> Id mkExportedVanillaId name ty = Var.mkExportedLocalVar VanillaId name ty vanillaIdInfo -- Note [Free type variables] diff --git a/compiler/deSugar/Desugar.hs b/compiler/deSugar/Desugar.hs index db4c867..365e7c9 100644 --- a/compiler/deSugar/Desugar.hs +++ b/compiler/deSugar/Desugar.hs @@ -295,7 +295,10 @@ deSugar hsc_env (text "Desugar"<+>brackets (ppr mod)) (const ()) $ do { -- Desugar the program - ; let export_set = availsToNameSet exports + ; let export_set = + -- Used to be 'availsToNameSet', but we now export selectors + -- only when necessary. See #12125. + availsToNameSetWithSelectors exports target = hscTarget dflags hpcInfo = emptyHpcInfo other_hpc_info diff --git a/compiler/typecheck/TcTyDecls.hs b/compiler/typecheck/TcTyDecls.hs index 233857c..4623744 100644 --- a/compiler/typecheck/TcTyDecls.hs +++ b/compiler/typecheck/TcTyDecls.hs @@ -949,7 +949,12 @@ mkOneRecordSelector all_cons idDetails fl lbl = flLabel fl sel_name = flSelector fl - sel_id = mkExportedLocalId rec_details sel_name sel_ty + sel_id = + -- Do not mark record selectors as exported to avoid keeping these Ids + -- alive unnecessarily. See #12125. Selectors are now marked as exported + -- when necessary by desugarer ('Desugar.addExportFlagsAndRules', also see + -- uses of 'availsToNameSetWithSelectors' in 'Desugar.hs'). + mkNonExportedLocalId rec_details sel_name sel_ty rec_details = RecSelId { sel_tycon = idDetails, sel_naughty = is_naughty } -- Find a representative constructor, con1 From git at git.haskell.org Fri Aug 26 14:02:05 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 26 Aug 2016 14:02:05 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: rts/LdvProfile.c: Fix NULL dereference on shutdown (57e7078) Message-ID: <20160826140205.4BC7D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/57e707821be933c673927426b001b1cdd83de3ac/ghc >--------------------------------------------------------------- commit 57e707821be933c673927426b001b1cdd83de3ac Author: Erik de Castro Lopo Date: Fri Apr 29 07:15:53 2016 +1000 rts/LdvProfile.c: Fix NULL dereference on shutdown Test Plan: validate Reviewers: carter, austin, simonmar, bgamari Reviewed By: simonmar, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2154 GHC Trac Issues: #11978 (cherry picked from commit bcfee2181e7b7edfea3473ec408a3a2a1815ecff) >--------------------------------------------------------------- 57e707821be933c673927426b001b1cdd83de3ac rts/LdvProfile.c | 3 +++ testsuite/tests/profiling/should_run/T11978a.hs | 2 ++ .../should_run/T5594.stdout => profiling/should_run/T11978a.stdout} | 0 3 files changed, 5 insertions(+) diff --git a/rts/LdvProfile.c b/rts/LdvProfile.c index 29fb24d..51cd3d7 100644 --- a/rts/LdvProfile.c +++ b/rts/LdvProfile.c @@ -179,6 +179,9 @@ processNurseryForDead( void ) StgPtr p; bdescr *bd; + if (MainCapability.r.rNursery == NULL) + return; + for (bd = MainCapability.r.rNursery->blocks; bd != NULL; bd = bd->link) { p = bd->start; while (p < bd->free) { diff --git a/testsuite/tests/profiling/should_run/T11978a.hs b/testsuite/tests/profiling/should_run/T11978a.hs new file mode 100644 index 0000000..bb859f3 --- /dev/null +++ b/testsuite/tests/profiling/should_run/T11978a.hs @@ -0,0 +1,2 @@ +main :: IO () +main = putStrLn "Hello!" diff --git a/testsuite/tests/ffi/should_run/T5594.stdout b/testsuite/tests/profiling/should_run/T11978a.stdout similarity index 100% copy from testsuite/tests/ffi/should_run/T5594.stdout copy to testsuite/tests/profiling/should_run/T11978a.stdout From git at git.haskell.org Fri Aug 26 14:02:08 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 26 Aug 2016 14:02:08 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Make okConIdOcc recognize unboxed tuples (422ed83) Message-ID: <20160826140208.701CA3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/422ed83c210e83acbd8f6b64ba725964d726f10a/ghc >--------------------------------------------------------------- commit 422ed83c210e83acbd8f6b64ba725964d726f10a Author: Ryan Scott Date: Mon Jul 18 13:51:53 2016 -0400 Make okConIdOcc recognize unboxed tuples Summary: `okConIdOcc`, which validates that a type or constructor name is valid for splicing using Template Haskell, has a special case for tuples, but neglects to look for unboxed tuples, causing some sensible Template Haskell code involving unboxed tuples to be rejected. Fixes #12407. Test Plan: make test TEST=T12407 Reviewers: austin, bgamari, hvr, goldfire Reviewed By: goldfire Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2410 GHC Trac Issues: #12407 (cherry picked from commit 1fc41d3274b5bf62f027aa6c7df57998db494938) >--------------------------------------------------------------- 422ed83c210e83acbd8f6b64ba725964d726f10a compiler/basicTypes/Lexeme.hs | 21 +++++++++++++-------- testsuite/tests/th/T12407.hs | 17 +++++++++++++++++ testsuite/tests/th/all.T | 1 + 3 files changed, 31 insertions(+), 8 deletions(-) diff --git a/compiler/basicTypes/Lexeme.hs b/compiler/basicTypes/Lexeme.hs index 4b1fe94..dec52cb 100644 --- a/compiler/basicTypes/Lexeme.hs +++ b/compiler/basicTypes/Lexeme.hs @@ -155,18 +155,23 @@ okVarSymOcc str = all okSymChar str && -- starts with an acceptable letter? okConIdOcc :: String -> Bool okConIdOcc str = okIdOcc str || - is_tuple_name1 str + is_tuple_name1 True str || + -- Is it a boxed tuple... + is_tuple_name1 False str + -- ...or an unboxed tuple (Trac #12407)? where -- check for tuple name, starting at the beginning - is_tuple_name1 ('(' : rest) = is_tuple_name2 rest - is_tuple_name1 _ = False + is_tuple_name1 True ('(' : rest) = is_tuple_name2 True rest + is_tuple_name1 False ('(' : '#' : rest) = is_tuple_name2 False rest + is_tuple_name1 _ _ = False -- check for tuple tail - is_tuple_name2 ")" = True - is_tuple_name2 (',' : rest) = is_tuple_name2 rest - is_tuple_name2 (ws : rest) - | isSpace ws = is_tuple_name2 rest - is_tuple_name2 _ = False + is_tuple_name2 True ")" = True + is_tuple_name2 False "#)" = True + is_tuple_name2 boxed (',' : rest) = is_tuple_name2 boxed rest + is_tuple_name2 boxed (ws : rest) + | isSpace ws = is_tuple_name2 boxed rest + is_tuple_name2 _ _ = False -- | Is this an acceptable symbolic constructor name, assuming it -- starts with an acceptable character? diff --git a/testsuite/tests/th/T12407.hs b/testsuite/tests/th/T12407.hs new file mode 100644 index 0000000..daa3e34 --- /dev/null +++ b/testsuite/tests/th/T12407.hs @@ -0,0 +1,17 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE UnboxedTuples #-} +module T12407 where + +import Language.Haskell.TH.Lib +import Language.Haskell.TH.Syntax + +$(do let ubxTup = conT (unboxedTupleTypeName 2) `appT` conT ''Int + `appT` conT ''Int + x <- newName "x" + y <- newName "y" + + [d| f :: $(ubxTup) -> $(ubxTup) + f $(conP (unboxedTupleDataName 2) [varP x, varP y]) + = $(conE (unboxedTupleDataName 2) `appE` varE x + `appE` varE y) + |]) diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T index f502252..b43971e 100644 --- a/testsuite/tests/th/all.T +++ b/testsuite/tests/th/all.T @@ -411,3 +411,4 @@ test('T11941', normal, compile_fail, ['-v0']) test('T11484', normal, compile, ['-v0']) test('T12130', extra_clean(['T12130a.hi','T12130a.o']), multimod_compile, ['T12130', '-v0 ' + config.ghc_th_way_flags]) +test('T12407', omit_ways(['ghci']), compile, ['-v0']) From git at git.haskell.org Fri Aug 26 14:02:12 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 26 Aug 2016 14:02:12 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Fix incorrect calculated relocations on Windows x86_64 (38497a2) Message-ID: <20160826140212.143633A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/38497a2317b015249c96d03c2c3df97fffdc6929/ghc >--------------------------------------------------------------- commit 38497a2317b015249c96d03c2c3df97fffdc6929 Author: Tamar Christina Date: Sat Jun 11 10:18:19 2016 +0200 Fix incorrect calculated relocations on Windows x86_64 Summary: See #12031 for analysis, but essentially what happens is: To sum up the issue, the reason this seems to go wrong is because of how we initialize the `.bss` section for Windows in the runtime linker. The first issue is where we calculate the zero space for the section: ``` zspace = stgCallocBytes(1, bss_sz, "ocGetNames_PEi386(anonymous bss)"); sectab_i->PointerToRawData = ((UChar*)zspace) - ((UChar*)(oc->image)); ``` Where ``` UInt32 PointerToRawData; ``` This means we're stuffing a `64-bit` value into a `32-bit` one. Also `zspace` can be larger than `oc->image`. In which case it'll overflow and then get truncated in the cast. The address of a value in the `.bss` section is then calculated as: ``` addr = ((UChar*)(oc->image)) + (sectabent->PointerToRawData + symtab_i->Value); ``` If it does truncate then this calculation won't be correct (which is what is happening). We then later use the value of `addr` as the `S` (Symbol) value for the relocations ``` S = (size_t) lookupSymbol_( (char*)symbol ); ``` Now the majority of the relocations are `R_X86_64_PC32` etc. e.g. They are guaranteed to fit in a `32-bit` value. The `R_X86_64_64` introduced for these pseudo-relocations so they can use the full `48-bit` addressing space isn't as lucky. As for why it sometimes work has to do on whether the value is truncated or not. `PointerToRawData` can't be changed because it's size is fixed by the PE specification. Instead just like with the other platforms, we now use `section` on Windows as well. This gives us a `start` parameter of type `void*` which solves the issue. This refactors the code to use `section.start` and to fix the issues. Test Plan: ./validate and new test added T12031 Reviewers: RyanGlScott, erikd, bgamari, austin, simonmar Reviewed By: simonmar Subscribers: thomie, #ghc_windows_task_force Differential Revision: https://phabricator.haskell.org/D2316 GHC Trac Issues: #12031, #11317 (cherry picked from commit b40e1b4c6746bdc34e6a53548a3925d309201c4d) >--------------------------------------------------------------- 38497a2317b015249c96d03c2c3df97fffdc6929 rts/Linker.c | 71 ++++++++++++++++++-------------- rts/LinkerInternals.h | 4 +- testsuite/tests/rts/T12031/ExternBug.hs | 9 ++++ testsuite/tests/rts/T12031/Makefile | 8 ++++ testsuite/tests/rts/T12031/T12031.stdout | 1 + testsuite/tests/rts/T12031/all.T | 2 + testsuite/tests/rts/T12031/bar.c | 11 +++++ testsuite/tests/rts/T12031/baz.c | 9 ++++ testsuite/tests/rts/T12031/foo.h | 11 +++++ 9 files changed, 94 insertions(+), 32 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 38497a2317b015249c96d03c2c3df97fffdc6929 From git at git.haskell.org Fri Aug 26 14:26:58 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 26 Aug 2016 14:26:58 +0000 (UTC) Subject: [commit: ghc] master: Fix doc build inconsistency (1083f45) Message-ID: <20160826142658.0D78D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1083f453dd296d4336899893518c65ae5113dc3e/ghc >--------------------------------------------------------------- commit 1083f453dd296d4336899893518c65ae5113dc3e Author: Harendra Kumar Date: Thu Aug 25 20:28:29 2016 -0400 Fix doc build inconsistency Remove the doc targets completely not partially when disabled. Otherwise even though we are able to build the targets but we will see some strange errors. Reviewers: austin, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2470 >--------------------------------------------------------------- 1083f453dd296d4336899893518c65ae5113dc3e ghc.mk | 1 + 1 file changed, 1 insertion(+) diff --git a/ghc.mk b/ghc.mk index be480c9..792bd21 100644 --- a/ghc.mk +++ b/ghc.mk @@ -712,6 +712,7 @@ BUILD_DIRS := $(filter-out utils/haddock,$(BUILD_DIRS)) BUILD_DIRS := $(filter-out utils/haddock/doc,$(BUILD_DIRS)) endif ifeq "$(BUILD_SPHINX_HTML) $(BUILD_SPHINX_PDF)" "NO NO" +BUILD_DIRS := $(filter-out docs/users_guide,$(BUILD_DIRS)) # Don't to build this little utility if we're not building the User's Guide. BUILD_DIRS := $(filter-out utils/mkUserGuidePart,$(BUILD_DIRS)) endif From git at git.haskell.org Fri Aug 26 14:38:38 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 26 Aug 2016 14:38:38 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Fix a performance issue with -fprint-expanded-synonyms (5c6e25f) Message-ID: <20160826143838.84F6C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/5c6e25f4cee5f53d4a6f4f20e6da63a65b4a1c17/ghc >--------------------------------------------------------------- commit 5c6e25f4cee5f53d4a6f4f20e6da63a65b4a1c17 Author: Ömer Sinan Ağacan Date: Sun May 15 07:04:39 2016 -0400 Fix a performance issue with -fprint-expanded-synonyms The type synonym expander was doing redundant work by looking at same types again and again. This patch fixes the loop code when both of the types can be expanded, to do `O(min(n, m))` comparisons and `O(n + m)` expansions, where `n` is expansions of the first type and `m` is expansions of the second type. Reported by sjcjoosten in T10547. Test Plan: Added a regression test that was taking several minutes to type check before this patch. Reviewers: bgamari, simonpj, austin, ezyang Reviewed By: bgamari, simonpj, austin, ezyang Subscribers: simonpj, thomie Differential Revision: https://phabricator.haskell.org/D2198 GHC Trac Issues: #10547 (cherry picked from commit e4834edf4418ace657361649365979e29ebd9daa) >--------------------------------------------------------------- 5c6e25f4cee5f53d4a6f4f20e6da63a65b4a1c17 compiler/typecheck/TcErrors.hs | 196 +++++++++++++++++----------- testsuite/tests/perf/compiler/T10547.hs | 90 +++++++++++++ testsuite/tests/perf/compiler/T10547.stderr | 11 ++ testsuite/tests/perf/compiler/all.T | 9 ++ 4 files changed, 227 insertions(+), 79 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 5c6e25f4cee5f53d4a6f4f20e6da63a65b4a1c17 From git at git.haskell.org Fri Aug 26 16:36:02 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 26 Aug 2016 16:36:02 +0000 (UTC) Subject: [commit: ghc] master: Allow typed holes to be levity-polymorphic (ae66f35) Message-ID: <20160826163602.A53B93A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ae66f356fb0dbf79dab1074d71275904c448b329/ghc >--------------------------------------------------------------- commit ae66f356fb0dbf79dab1074d71275904c448b329 Author: Simon Peyton Jones Date: Fri Aug 26 17:24:10 2016 +0100 Allow typed holes to be levity-polymorphic This one-line change fixes Trac #12531. Hooray. Simple, non-invasive; can merge to 8.0.2 >--------------------------------------------------------------- ae66f356fb0dbf79dab1074d71275904c448b329 compiler/typecheck/TcExpr.hs | 8 ++++---- .../T5472.stdout => partial-sigs/should_compile/12531.stderr} | 0 testsuite/tests/partial-sigs/should_compile/T12531.hs | 6 ++++++ testsuite/tests/partial-sigs/should_compile/all.T | 1 + 4 files changed, 11 insertions(+), 4 deletions(-) diff --git a/compiler/typecheck/TcExpr.hs b/compiler/typecheck/TcExpr.hs index dc1a90f..8ae454c 100644 --- a/compiler/typecheck/TcExpr.hs +++ b/compiler/typecheck/TcExpr.hs @@ -1658,16 +1658,16 @@ tc_infer_id lbl id_name tcUnboundId :: UnboundVar -> ExpRhoType -> TcM (HsExpr TcId) --- Typechedk an occurrence of an unbound Id +-- Typecheck an occurrence of an unbound Id -- --- Some of these started life as a true hole "_". Others might simply --- be variables that accidentally have no binding site +-- Some of these started life as a true expression hole "_". +-- Others might simply be variables that accidentally have no binding site -- -- We turn all of them into HsVar, since HsUnboundVar can't contain an -- Id; and indeed the evidence for the CHoleCan does bind it, so it's -- not unbound any more! tcUnboundId unbound res_ty - = do { ty <- newFlexiTyVarTy liftedTypeKind + = do { ty <- newOpenFlexiTyVarTy -- Allow Int# etc (Trac #12531) ; let occ = unboundVarOcc unbound ; name <- newSysName occ ; let ev = mkLocalId name ty diff --git a/testsuite/tests/deSugar/should_run/T5472.stdout b/testsuite/tests/partial-sigs/should_compile/12531.stderr similarity index 100% copy from testsuite/tests/deSugar/should_run/T5472.stdout copy to testsuite/tests/partial-sigs/should_compile/12531.stderr diff --git a/testsuite/tests/partial-sigs/should_compile/T12531.hs b/testsuite/tests/partial-sigs/should_compile/T12531.hs new file mode 100644 index 0000000..2488db2 --- /dev/null +++ b/testsuite/tests/partial-sigs/should_compile/T12531.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE MagicHash #-} + +module T12531 where +import GHC.Exts + +f x = I# (_ +# x) diff --git a/testsuite/tests/partial-sigs/should_compile/all.T b/testsuite/tests/partial-sigs/should_compile/all.T index 104c2ad..17c769e 100644 --- a/testsuite/tests/partial-sigs/should_compile/all.T +++ b/testsuite/tests/partial-sigs/should_compile/all.T @@ -65,3 +65,4 @@ test('T12033', normal, compile, ['']) test('T11339a', normal, compile, ['']) test('T11670', normal, compile, ['']) test('T12156', normal, compile_fail, ['-fdefer-typed-holes']) +test('T12531', normal, compile, ['-fdefer-typed-holes']) From git at git.haskell.org Fri Aug 26 16:36:05 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 26 Aug 2016 16:36:05 +0000 (UTC) Subject: [commit: ghc] master: Move import to avoid warning (a60ea70) Message-ID: <20160826163605.7FE1D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a60ea709c2b58b77a920823f2d095b1e3c02e2b5/ghc >--------------------------------------------------------------- commit a60ea709c2b58b77a920823f2d095b1e3c02e2b5 Author: Simon Peyton Jones Date: Fri Aug 26 17:25:52 2016 +0100 Move import to avoid warning The import of UniqFM in HscTypes was only needed in stage2 >--------------------------------------------------------------- a60ea709c2b58b77a920823f2d095b1e3c02e2b5 compiler/main/HscTypes.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/main/HscTypes.hs b/compiler/main/HscTypes.hs index cade33e..ddeee33 100644 --- a/compiler/main/HscTypes.hs +++ b/compiler/main/HscTypes.hs @@ -139,9 +139,9 @@ import ByteCodeTypes import InteractiveEvalTypes ( Resume ) import GHCi.Message ( Pipe ) import GHCi.RemoteTypes +import UniqFM #endif -import UniqFM import HsSyn import RdrName import Avail From git at git.haskell.org Fri Aug 26 16:36:09 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 26 Aug 2016 16:36:09 +0000 (UTC) Subject: [commit: ghc] master: Fix scoping of type variables in instances (0050aff) Message-ID: <20160826163609.288ED3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/0050aff22ba04baca732bf5124002417ab667f8a/ghc >--------------------------------------------------------------- commit 0050aff22ba04baca732bf5124002417ab667f8a Author: Simon Peyton Jones Date: Fri Aug 26 17:32:42 2016 +0100 Fix scoping of type variables in instances This fixes Trac #12531: class Foo x where foo :: forall a . x a -> x a default foo :: forall b . x b -> x b foo x = go where go :: x b go = undefined We want 'b' to scope over the code for 'foo', but we were using 'a' instead. >--------------------------------------------------------------- 0050aff22ba04baca732bf5124002417ab667f8a compiler/hsSyn/HsUtils.hs | 29 +++++++++++++++++++- compiler/rename/RnBinds.hs | 31 ++++++++++----------- compiler/typecheck/TcClassDcl.hs | 36 +++++++++++++++---------- compiler/typecheck/TcInstDcls.hs | 6 ++--- testsuite/tests/rename/should_compile/T12533.hs | 10 +++++++ testsuite/tests/rename/should_compile/all.T | 1 + 6 files changed, 78 insertions(+), 35 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 0050aff22ba04baca732bf5124002417ab667f8a From git at git.haskell.org Sun Aug 28 07:18:33 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 28 Aug 2016 07:18:33 +0000 (UTC) Subject: [commit: ghc] master: Typofix in docs. (ca8c0e2) Message-ID: <20160828071833.430223A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ca8c0e279a87d93c1fb10460c24ef35a9080238f/ghc >--------------------------------------------------------------- commit ca8c0e279a87d93c1fb10460c24ef35a9080238f Author: Edward Z. Yang Date: Sun Aug 28 00:18:21 2016 -0700 Typofix in docs. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- ca8c0e279a87d93c1fb10460c24ef35a9080238f compiler/basicTypes/Module.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/basicTypes/Module.hs b/compiler/basicTypes/Module.hs index 0bade7d..c0e9080 100644 --- a/compiler/basicTypes/Module.hs +++ b/compiler/basicTypes/Module.hs @@ -308,7 +308,7 @@ moduleNameSlashes :: ModuleName -> String moduleNameSlashes = dots_to_slashes . moduleNameString where dots_to_slashes = map (\c -> if c == '.' then pathSeparator else c) --- |Returns the string version of the module name, with dots replaced by underscores. +-- |Returns the string version of the module name, with dots replaced by colons. -- moduleNameColons :: ModuleName -> String moduleNameColons = dots_to_colons . moduleNameString From git at git.haskell.org Mon Aug 29 13:49:35 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 29 Aug 2016 13:49:35 +0000 (UTC) Subject: [commit: ghc] master: Template Haskell support for TypeApplications (983f660) Message-ID: <20160829134935.414263A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/983f6609b68bf4cef0a5c94cd5568673cab3a6cf/ghc >--------------------------------------------------------------- commit 983f6609b68bf4cef0a5c94cd5568673cab3a6cf Author: Ryan Scott Date: Mon Aug 29 09:47:56 2016 -0400 Template Haskell support for TypeApplications Summary: Fixes #12530. Test Plan: make test TEST=12530 Reviewers: austin, bgamari, hvr, goldfire Reviewed By: goldfire Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2472 GHC Trac Issues: #12530 >--------------------------------------------------------------- 983f6609b68bf4cef0a5c94cd5568673cab3a6cf compiler/deSugar/DsMeta.hs | 6 +++ compiler/hsSyn/Convert.hs | 3 ++ compiler/prelude/THNames.hs | 62 +++++++++++----------- docs/users_guide/8.2.1-notes.rst | 2 + libraries/template-haskell/Language/Haskell/TH.hs | 2 +- .../template-haskell/Language/Haskell/TH/Lib.hs | 3 ++ .../template-haskell/Language/Haskell/TH/Ppr.hs | 2 + .../template-haskell/Language/Haskell/TH/Syntax.hs | 1 + libraries/template-haskell/changelog.md | 2 + testsuite/tests/th/T12530.hs | 15 ++++++ testsuite/tests/th/T12530.stderr | 10 ++++ testsuite/tests/th/all.T | 1 + 12 files changed, 78 insertions(+), 31 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 983f6609b68bf4cef0a5c94cd5568673cab3a6cf From git at git.haskell.org Mon Aug 29 14:36:48 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 29 Aug 2016 14:36:48 +0000 (UTC) Subject: [commit: ghc] master: Fix broken Haddock comment (822af41) Message-ID: <20160829143648.89A973A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/822af416882a865ce57daf6938b969f072cb7e0b/ghc >--------------------------------------------------------------- commit 822af416882a865ce57daf6938b969f072cb7e0b Author: Ryan Scott Date: Mon Aug 29 10:35:37 2016 -0400 Fix broken Haddock comment >--------------------------------------------------------------- 822af416882a865ce57daf6938b969f072cb7e0b libraries/template-haskell/Language/Haskell/TH/Syntax.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs index 73955be..690ab98 100644 --- a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs +++ b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs @@ -1445,7 +1445,7 @@ data Exp | ConE Name -- ^ @data T1 = C1 t1 t2; p = {C1} e1 e2 @ | LitE Lit -- ^ @{ 5 or \'c\'}@ | AppE Exp Exp -- ^ @{ f x }@ - | AppTypeE Exp Type -- $ @{ f \@Int } + | AppTypeE Exp Type -- ^ @{ f \@Int } | InfixE (Maybe Exp) Exp (Maybe Exp) -- ^ @{x + y} or {(x+)} or {(+ x)} or {(+)}@ From git at git.haskell.org Mon Aug 29 19:28:42 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 29 Aug 2016 19:28:42 +0000 (UTC) Subject: [commit: ghc] master: Remove unused DerivInst constructor for DerivStuff (f4384ef) Message-ID: <20160829192842.E791C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f4384ef5b42bb64b55d6c930ed9850a021796f36/ghc >--------------------------------------------------------------- commit f4384ef5b42bb64b55d6c930ed9850a021796f36 Author: Ryan Scott Date: Mon Aug 29 15:26:53 2016 -0400 Remove unused DerivInst constructor for DerivStuff Summary: Back when derived `Generic` instances used to generate auxiliary datatypes, they would also generate instances for those datatypes. Nowadays, GHC generics uses a `DataKinds`-based encoding that requires neither auxiliary datatypes (corresponding to the `DerivTyCon` constructor of `DerivStuff`) nor instances for them (the `DerivInst` constructor of `DerivStuff`). It appears that `DerivTyCon` constructor was removed at some point, but `DerivInst` never was. No `DerivInst` values are ever constructed, so we can safely remove it. Test Plan: It builds Reviewers: austin, hvr, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2481 >--------------------------------------------------------------- f4384ef5b42bb64b55d6c930ed9850a021796f36 compiler/typecheck/TcDeriv.hs | 5 ++--- compiler/typecheck/TcGenDeriv.hs | 22 +++++++++------------- 2 files changed, 11 insertions(+), 16 deletions(-) diff --git a/compiler/typecheck/TcDeriv.hs b/compiler/typecheck/TcDeriv.hs index 70eaf5c..e38cfdc 100644 --- a/compiler/typecheck/TcDeriv.hs +++ b/compiler/typecheck/TcDeriv.hs @@ -387,13 +387,12 @@ tcDeriving deriv_infos deriv_decls ; let (inst_infos, deriv_stuff, maybe_fvs) = unzip3 (insts1 ++ insts2) ; loc <- getSrcSpanM - ; let (binds, famInsts, extraInstances) = - genAuxBinds loc (unionManyBags deriv_stuff) + ; let (binds, famInsts) = genAuxBinds loc (unionManyBags deriv_stuff) ; dflags <- getDynFlags ; (inst_info, rn_binds, rn_dus) <- - renameDeriv is_boot (inst_infos ++ (bagToList extraInstances)) binds + renameDeriv is_boot inst_infos binds ; unless (isEmptyBag inst_info) $ liftIO (dumpIfSet_dyn dflags Opt_D_dump_deriv "Derived instances" diff --git a/compiler/typecheck/TcGenDeriv.hs b/compiler/typecheck/TcGenDeriv.hs index 2eb8c07..dce0b16 100644 --- a/compiler/typecheck/TcGenDeriv.hs +++ b/compiler/typecheck/TcGenDeriv.hs @@ -70,7 +70,6 @@ import Lexeme import FastString import Pair import Bag -import TcEnv (InstInfo) import StaticFlags( opt_PprStyle_Debug ) import ListSetOps ( assocMaybe ) @@ -90,12 +89,11 @@ data AuxBindSpec data DerivStuff -- Please add this auxiliary stuff = DerivAuxBind AuxBindSpec - -- Generics + -- Generics and DeriveAnyClass | DerivFamInst FamInst -- New type family instances -- New top-level auxiliary bindings | DerivHsBind (LHsBind RdrName, LSig RdrName) -- Also used for SYB - | DerivInst (InstInfo RdrName) -- New, auxiliary instances {- ************************************************************************ @@ -2346,11 +2344,11 @@ genAuxBindSpec loc (DerivMaxTag tycon) max_tag = case (tyConDataCons tycon) of data_cons -> toInteger ((length data_cons) - fIRST_TAG) -type SeparateBagsDerivStuff = -- AuxBinds and SYB bindings - ( Bag (LHsBind RdrName, LSig RdrName) - -- Extra bindings (used by Generic only) - , Bag (FamInst) -- Extra family instances - , Bag (InstInfo RdrName)) -- Extra instances +type SeparateBagsDerivStuff = + -- AuxBinds and SYB bindings + ( Bag (LHsBind RdrName, LSig RdrName) + -- Extra family instances (used by Generic and DeriveAnyClass) + , Bag (FamInst) ) genAuxBinds :: SrcSpan -> BagDerivStuff -> SeparateBagsDerivStuff genAuxBinds loc b = genAuxBinds' b2 where @@ -2363,16 +2361,14 @@ genAuxBinds loc b = genAuxBinds' b2 where genAuxBinds' :: BagDerivStuff -> SeparateBagsDerivStuff genAuxBinds' = foldrBag f ( mapBag (genAuxBindSpec loc) (rm_dups b1) - , emptyBag, emptyBag) + , emptyBag ) f :: DerivStuff -> SeparateBagsDerivStuff -> SeparateBagsDerivStuff f (DerivAuxBind _) = panic "genAuxBinds'" -- We have removed these before f (DerivHsBind b) = add1 b f (DerivFamInst t) = add2 t - f (DerivInst i) = add3 i - add1 x (a,b,c) = (x `consBag` a,b,c) - add2 x (a,b,c) = (a,x `consBag` b,c) - add3 x (a,b,c) = (a,b,x `consBag` c) + add1 x (a,b) = (x `consBag` a,b) + add2 x (a,b) = (a,x `consBag` b) mkParentType :: TyCon -> Type -- Turn the representation tycon of a family into From git at git.haskell.org Tue Aug 30 08:05:47 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 30 Aug 2016 08:05:47 +0000 (UTC) Subject: [commit: ghc] wip/D2471: Fix binary-trees regression from unnecessary floating in CorePrep. (395d6fd) Message-ID: <20160830080547.797A23A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/D2471 Link : http://ghc.haskell.org/trac/ghc/changeset/395d6fd3a37f9c5ed4b69d25515967bb5aaee547/ghc >--------------------------------------------------------------- commit 395d6fd3a37f9c5ed4b69d25515967bb5aaee547 Author: Edward Z. Yang Date: Tue Aug 23 15:53:49 2016 -0700 Fix binary-trees regression from unnecessary floating in CorePrep. Summary: In 0d3bf62092de83375025edca6f7242812338542d, I handled lazy @(Int -> Int) f x correctly, but failed to handle lazy @Int (f x) (we need to collect arguments in f x). Additionally, if we have lazy @Int (case ...) (or anything that's not an application, we have to bounce back to cpeRhsE. Signed-off-by: Edward Z. Yang Test Plan: validate Reviewers: simonpj, nomeata, austin, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2471 >--------------------------------------------------------------- 395d6fd3a37f9c5ed4b69d25515967bb5aaee547 compiler/coreSyn/CorePrep.hs | 44 ++++++++++++++++------ testsuite/tests/simplCore/should_compile/all.T | 1 + testsuite/tests/simplCore/should_compile/par01.hs | 10 +++++ .../tests/simplCore/should_compile/par01.stderr | 33 ++++++++++++++++ 4 files changed, 76 insertions(+), 12 deletions(-) diff --git a/compiler/coreSyn/CorePrep.hs b/compiler/coreSyn/CorePrep.hs index 0d82be5..b3d7817 100644 --- a/compiler/coreSyn/CorePrep.hs +++ b/compiler/coreSyn/CorePrep.hs @@ -668,13 +668,8 @@ cpeApp :: CorePrepEnv -> CoreExpr -> UniqSM (Floats, CpeRhs) -- May return a CpeRhs because of saturating primops cpeApp top_env expr = do { let (terminal, args, depth) = collect_args expr - ; (head, app, floats) <- cpe_app top_env terminal args depth - - -- Now deal with the function - ; case head of - Just fn_id -> do { sat_app <- maybeSaturate fn_id app depth - ; return (floats, sat_app) } - _other -> return (floats, app) } + ; cpe_app top_env terminal args depth + } where -- We have a nested data structure of the form @@ -702,11 +697,25 @@ cpeApp top_env expr -> CoreExpr -> [CpeArg] -> Int - -> UniqSM (Maybe Id, CpeApp, Floats) + -> UniqSM (Floats, CpeRhs) cpe_app env (Var f) (CpeArg Type{} : CpeArg arg : args) depth | f `hasKey` lazyIdKey -- Replace (lazy a) with a, and || f `hasKey` noinlineIdKey -- Replace (noinline a) with a - = cpe_app env arg args (depth - 1) + -- Consider the code: + -- + -- lazy (f x) y + -- + -- We need to make sure that we need to recursively collect arguments on + -- "f x", otherwise we'll float "f x" out (it's not a variable) and + -- end up with this awful -ddump-prep: + -- + -- case f x of f_x { + -- __DEFAULT -> f_x y + -- } + -- + -- rather than the far superior "f x y". Test case is par01. + = let (terminal, args', depth') = collect_args arg + in cpe_app env terminal (args' ++ args) (depth + depth' - 1) cpe_app env (Var f) [CpeArg _runtimeRep at Type{}, CpeArg _type at Type{}, CpeArg arg] 1 | f `hasKey` runRWKey -- Replace (runRW# f) by (f realWorld#), beta reducing if possible (this @@ -724,7 +733,7 @@ cpeApp top_env expr -- cpe_ExprIsTrivial). But note that we need the type of the -- expression, not the id. ; (app, floats) <- rebuild_app args e2 (exprType e2) emptyFloats stricts - ; return (hd, app, floats) } + ; mb_saturate hd app floats depth } where stricts = case idStrictness v of StrictSig (DmdType _ demands _) @@ -737,16 +746,27 @@ cpeApp top_env expr -- Here, we can't evaluate the arg strictly, because this -- partial application might be seq'd + -- We inlined into something that's not a var and has no args. + -- Bounce it back up to cpeRhsE. + cpe_app env fun [] _ = cpeRhsE env fun + -- N-variable fun, better let-bind it - cpe_app env fun args _ + cpe_app env fun args depth = do { (fun_floats, fun') <- cpeArg env evalDmd fun ty -- The evalDmd says that it's sure to be evaluated, -- so we'll end up case-binding it ; (app, floats) <- rebuild_app args fun' ty fun_floats [] - ; return (Nothing, app, floats) } + ; mb_saturate Nothing app floats depth } where ty = exprType fun + -- Saturate if necessary + mb_saturate head app floats depth = + case head of + Just fn_id -> do { sat_app <- maybeSaturate fn_id app depth + ; return (floats, sat_app) } + _other -> return (floats, app) + -- Deconstruct and rebuild the application, floating any non-atomic -- arguments to the outside. We collect the type of the expression, -- the head of the application, and the number of actual value arguments, diff --git a/testsuite/tests/simplCore/should_compile/all.T b/testsuite/tests/simplCore/should_compile/all.T index 92f9af4..e2e0bb6 100644 --- a/testsuite/tests/simplCore/should_compile/all.T +++ b/testsuite/tests/simplCore/should_compile/all.T @@ -243,3 +243,4 @@ test('T12076sat', normal, compile, ['-O']) test('T12212', normal, compile, ['-O']) test('noinline01', only_ways(['optasm']), compile, ['-ddump-stg -dsuppress-uniques -O']) +test('par01', only_ways(['optasm']), compile, ['-ddump-prep -dsuppress-uniques -O2']) diff --git a/testsuite/tests/simplCore/should_compile/par01.hs b/testsuite/tests/simplCore/should_compile/par01.hs new file mode 100644 index 0000000..e67fb13 --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/par01.hs @@ -0,0 +1,10 @@ +module Par01 where + +import GHC.Conc + +-- The smoking gun in -ddump-prep is: +-- case Par01.depth d of sat { __DEFAULT -> sat } +-- this should never happen! + +depth :: Int -> Int +depth d = d `par` depth d diff --git a/testsuite/tests/simplCore/should_compile/par01.stderr b/testsuite/tests/simplCore/should_compile/par01.stderr new file mode 100644 index 0000000..90d467f --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/par01.stderr @@ -0,0 +1,33 @@ + +==================== CorePrep ==================== +Result size of CorePrep = {terms: 18, types: 8, coercions: 0} + +Rec { +-- RHS size: {terms: 7, types: 3, coercions: 0} +Par01.depth [Occ=LoopBreaker] :: GHC.Types.Int -> GHC.Types.Int +[GblId, Arity=1, Caf=NoCafRefs, Str=, Unf=OtherCon []] +Par01.depth = + \ (d :: GHC.Types.Int) -> + case GHC.Prim.par# @ GHC.Types.Int d of { __DEFAULT -> + Par01.depth d + } +end Rec } + +-- RHS size: {terms: 2, types: 0, coercions: 0} +Par01.$trModule2 :: GHC.Types.TrName +[GblId, Caf=NoCafRefs, Str=m1, Unf=OtherCon []] +Par01.$trModule2 = GHC.Types.TrNameS "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0} +Par01.$trModule1 :: GHC.Types.TrName +[GblId, Caf=NoCafRefs, Str=m1, Unf=OtherCon []] +Par01.$trModule1 = GHC.Types.TrNameS "Par01"# + +-- RHS size: {terms: 3, types: 0, coercions: 0} +Par01.$trModule :: GHC.Types.Module +[GblId, Caf=NoCafRefs, Str=m, Unf=OtherCon []] +Par01.$trModule = + GHC.Types.Module Par01.$trModule2 Par01.$trModule1 + + + From git at git.haskell.org Tue Aug 30 08:05:49 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 30 Aug 2016 08:05:49 +0000 (UTC) Subject: [commit: ghc] wip/D2471's head updated: Fix binary-trees regression from unnecessary floating in CorePrep. (395d6fd) Message-ID: <20160830080549.A53C53A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/D2471' now includes: 1083f45 Fix doc build inconsistency ae66f35 Allow typed holes to be levity-polymorphic a60ea70 Move import to avoid warning 0050aff Fix scoping of type variables in instances ca8c0e2 Typofix in docs. 983f660 Template Haskell support for TypeApplications 822af41 Fix broken Haddock comment f4384ef Remove unused DerivInst constructor for DerivStuff 395d6fd Fix binary-trees regression from unnecessary floating in CorePrep. From git at git.haskell.org Tue Aug 30 09:44:02 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 30 Aug 2016 09:44:02 +0000 (UTC) Subject: [commit: ghc] master: Missing stderr for T12531. (21c2ebf) Message-ID: <20160830094402.9E2CB3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/21c2ebf2504125611eec0d24ab3ed60cd9e475be/ghc >--------------------------------------------------------------- commit 21c2ebf2504125611eec0d24ab3ed60cd9e475be Author: Edward Z. Yang Date: Tue Aug 30 02:43:38 2016 -0700 Missing stderr for T12531. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- 21c2ebf2504125611eec0d24ab3ed60cd9e475be testsuite/tests/partial-sigs/should_compile/T12531.stderr | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/testsuite/tests/partial-sigs/should_compile/T12531.stderr b/testsuite/tests/partial-sigs/should_compile/T12531.stderr new file mode 100644 index 0000000..ddd6824 --- /dev/null +++ b/testsuite/tests/partial-sigs/should_compile/T12531.stderr @@ -0,0 +1,9 @@ + +T12531.hs:6:11: warning: [-Wtyped-holes (in -Wdefault)] + • Found hole: _ :: Int# + • In the first argument of ‘(+#)’, namely ‘_’ + In the first argument of ‘I#’, namely ‘(_ +# x)’ + In the expression: I# (_ +# x) + • Relevant bindings include + x :: Int# (bound at T12531.hs:6:3) + f :: Int# -> Int (bound at T12531.hs:6:1) From git at git.haskell.org Tue Aug 30 12:28:16 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 30 Aug 2016 12:28:16 +0000 (UTC) Subject: [commit: ghc] master: GhcMake: limit Capability count to CPU count in parallel mode (9d17560) Message-ID: <20160830122816.697DA3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9d175605e52fd0d85f2548896358d96ee441c7e4/ghc >--------------------------------------------------------------- commit 9d175605e52fd0d85f2548896358d96ee441c7e4 Author: Sergei Trofimovich Date: Tue Aug 30 12:10:47 2016 +0100 GhcMake: limit Capability count to CPU count in parallel mode In Trac #9221 one of problems using high --jobs= is amount of mutator (or GC) threads we crate. We use userspace spinning-and-yielding (see ACQUIRE_SPIN_LOCK) to acess work stealing queues. In case of N-worker-threads > N-CPUs fraction of time when thread holding spin lock gets descheduled by kernel increases. That causes other threads to waste CPU time before giving up CPU. Signed-off-by: Sergei Trofimovich Test Plan: ghc --make -j8 and -j80 have comparable sys time on a 8-core system. Reviewers: austin, gintas, bgamari, simonmar Reviewed By: bgamari, simonmar Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2482 GHC Trac Issues: #9221 >--------------------------------------------------------------- 9d175605e52fd0d85f2548896358d96ee441c7e4 compiler/main/GhcMake.hs | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/compiler/main/GhcMake.hs b/compiler/main/GhcMake.hs index bb1c8e3..9197b2c 100644 --- a/compiler/main/GhcMake.hs +++ b/compiler/main/GhcMake.hs @@ -762,7 +762,12 @@ parUpsweep n_jobs old_hpt stable_mods cleanup sccs = do let updNumCapabilities = liftIO $ do n_capabilities <- getNumCapabilities - unless (n_capabilities /= 1) $ setNumCapabilities n_jobs + n_cpus <- getNumProcessors + -- Setting number of capabilities more than + -- CPU count usually leads to high userspace + -- lock contention. Trac #9221 + let n_caps = min n_jobs n_cpus + unless (n_capabilities /= 1) $ setNumCapabilities n_caps return n_capabilities -- Reset the number of capabilities once the upsweep ends. let resetNumCapabilities orig_n = liftIO $ setNumCapabilities orig_n From git at git.haskell.org Tue Aug 30 12:28:19 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 30 Aug 2016 12:28:19 +0000 (UTC) Subject: [commit: ghc] master: rts: enable parallel GC scan of large (32M+) allocation area (a5d26f2) Message-ID: <20160830122819.34FB43A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a5d26f26d33bc04f31eaff50b7d633444192b4cb/ghc >--------------------------------------------------------------- commit a5d26f26d33bc04f31eaff50b7d633444192b4cb Author: Sergei Trofimovich Date: Tue Aug 30 12:10:54 2016 +0100 rts: enable parallel GC scan of large (32M+) allocation area Parallel GC does not scan large allocation area (-A) effectively as it does not do work stealing from nursery by default. That leads to large imbalance when only one of threads overflows allocation area: most of GC threads finish quickly (as there is not much to collect) and sit idle waiting while single GC thread finishes scan of single allocation area for that thread. The patch enables work stealing for (equivalent of -qb0) allocation area of -A32M or higher. Tested on a highlighting-kate package from Trac #9221 On 8-core machine the difference is around 5% faster of wall-clock time. On 24-core VM the speedup is 20%. Signed-off-by: Sergei Trofimovich Test Plan: measured wall time and GC parallelism on highlighting-kate build Reviewers: austin, bgamari, erikd, simonmar Reviewed By: bgamari, simonmar Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2483 GHC Trac Issues: #9221 >--------------------------------------------------------------- a5d26f26d33bc04f31eaff50b7d633444192b4cb docs/users_guide/runtime_control.rst | 2 +- rts/RtsFlags.c | 21 +++++++++++++++++++-- 2 files changed, 20 insertions(+), 3 deletions(-) diff --git a/docs/users_guide/runtime_control.rst b/docs/users_guide/runtime_control.rst index 1ae51dd..3968065 100644 --- a/docs/users_guide/runtime_control.rst +++ b/docs/users_guide/runtime_control.rst @@ -449,7 +449,7 @@ performance. .. rts-flag:: -qb - :default: 1 + :default: 1 for ``-A`` < 32M, 0 otherwise :since: 6.12.1 Use load-balancing in the parallel GC in generation ⟨gen⟩ and higher. diff --git a/rts/RtsFlags.c b/rts/RtsFlags.c index e23f760..7e06d84 100644 --- a/rts/RtsFlags.c +++ b/rts/RtsFlags.c @@ -227,7 +227,7 @@ void initRtsFlagsDefaults(void) RtsFlags.ParFlags.parGcEnabled = 1; RtsFlags.ParFlags.parGcGen = 0; RtsFlags.ParFlags.parGcLoadBalancingEnabled = rtsTrue; - RtsFlags.ParFlags.parGcLoadBalancingGen = 1; + RtsFlags.ParFlags.parGcLoadBalancingGen = ~0u; /* auto, based on -A */ RtsFlags.ParFlags.parGcNoSyncWithIdle = 0; RtsFlags.ParFlags.parGcThreads = 0; /* defaults to -N */ RtsFlags.ParFlags.setAffinity = 0; @@ -393,7 +393,8 @@ usage_text[] = { " -qg[] Use parallel GC only for generations >= ", " (default: 0, -qg alone turns off parallel GC)", " -qb[] Use load-balancing in the parallel GC only for generations >= ", -" (default: 1, -qb alone turns off load-balancing)", +" (default: 1 for -A < 32M, 0 otherwise;" +" -qb alone turns off load-balancing)", " -qn Use threads for parallel GC (defaults to value of -N)", " -qa Use the OS to set thread affinity (experimental)", " -qm Don't automatically migrate threads between CPUs", @@ -1450,6 +1451,22 @@ static void normaliseRtsOpts (void) errorUsage(); } + if (RtsFlags.ParFlags.parGcLoadBalancingGen == ~0u) { + StgWord alloc_area_bytes + = RtsFlags.GcFlags.minAllocAreaSize * BLOCK_SIZE; + + // If allocation area is larger that CPU cache + // we can finish scanning quicker doing work-stealing + // scan. Trac #9221 + // 32M looks big enough not to fit into L2 cache + // of popular modern CPUs. + if (alloc_area_bytes >= 32 * 1024 * 1024) { + RtsFlags.ParFlags.parGcLoadBalancingGen = 0; + } else { + RtsFlags.ParFlags.parGcLoadBalancingGen = 1; + } + } + #ifdef THREADED_RTS if (RtsFlags.ParFlags.parGcThreads > RtsFlags.ParFlags.nCapabilities) { errorBelch("GC threads (-qn) must be between 1 and the value of -N"); From git at git.haskell.org Tue Aug 30 15:07:44 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 30 Aug 2016 15:07:44 +0000 (UTC) Subject: [commit: ghc] master: OccName: Remove unused DrIFT directive (044e81b) Message-ID: <20160830150744.88A563A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/044e81b488bfa454ab0d6927f662bfd0ffe78538/ghc >--------------------------------------------------------------- commit 044e81b488bfa454ab0d6927f662bfd0ffe78538 Author: Ryan Scott Date: Tue Aug 30 11:02:01 2016 -0400 OccName: Remove unused DrIFT directive >--------------------------------------------------------------- 044e81b488bfa454ab0d6927f662bfd0ffe78538 compiler/basicTypes/OccName.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/compiler/basicTypes/OccName.hs b/compiler/basicTypes/OccName.hs index 0727328..182166e 100644 --- a/compiler/basicTypes/OccName.hs +++ b/compiler/basicTypes/OccName.hs @@ -135,7 +135,6 @@ data NameSpace = VarName -- Variables, including "real" data constructors | TcClsName -- Type constructors and classes; Haskell has them -- in the same name space for now. deriving( Eq, Ord ) - {-! derive: Binary !-} -- Note [Data Constructors] -- see also: Note [Data Constructor Naming] in DataCon.hs From git at git.haskell.org Tue Aug 30 15:07:47 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 30 Aug 2016 15:07:47 +0000 (UTC) Subject: [commit: ghc] master: TcGenDeriv: Typofix (ff1931e) Message-ID: <20160830150747.7D5EC3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ff1931e2e56526eae661f9ce384da534ce5a902c/ghc >--------------------------------------------------------------- commit ff1931e2e56526eae661f9ce384da534ce5a902c Author: Ryan Scott Date: Tue Aug 30 11:05:14 2016 -0400 TcGenDeriv: Typofix I think someone accidentally a word in a Note in TcGenDeriv. >--------------------------------------------------------------- ff1931e2e56526eae661f9ce384da534ce5a902c compiler/typecheck/TcGenDeriv.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/typecheck/TcGenDeriv.hs b/compiler/typecheck/TcGenDeriv.hs index dce0b16..f282733 100644 --- a/compiler/typecheck/TcGenDeriv.hs +++ b/compiler/typecheck/TcGenDeriv.hs @@ -2197,7 +2197,7 @@ coercing from. So from, say, ) :: a -> [T x] -> Int Notice that we give the 'coerce' call two type signatures: one to -fix the of the inner call, and one for the expected type. The outer +fix the type of the inner call, and one for the expected type. The outer type signature ought to be redundant, but may improve error messages. The inner one is essential to fix the type at which 'op' is called. From git at git.haskell.org Tue Aug 30 21:43:42 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 30 Aug 2016 21:43:42 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: RtClosureInspect: Fix off-by-one error in cvReconstructType (54413fd) Message-ID: <20160830214342.369233A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/54413fd1b004def92d629e85499caef53832d8ee/ghc >--------------------------------------------------------------- commit 54413fd1b004def92d629e85499caef53832d8ee Author: mniip Date: Tue Aug 23 13:19:02 2016 -0400 RtClosureInspect: Fix off-by-one error in cvReconstructType Replaced error-prone index manipulation on a pointer array with a simple fold on the array elements. Test Plan: Added a test case that triggers the bug Reviewers: hvr, austin, bgamari Reviewed By: bgamari Subscribers: simonpj, thomie Differential Revision: https://phabricator.haskell.org/D2439 GHC Trac Issues: #12458 (cherry picked from commit 1766bb3cfd1460796c78bd5651f89d53603586f9) >--------------------------------------------------------------- 54413fd1b004def92d629e85499caef53832d8ee compiler/ghci/RtClosureInspect.hs | 7 +++---- testsuite/tests/ghci.debugger/scripts/T12458.script | 4 ++++ testsuite/tests/ghci.debugger/scripts/T12458.stdout | 2 ++ testsuite/tests/ghci.debugger/scripts/all.T | 1 + 4 files changed, 10 insertions(+), 4 deletions(-) diff --git a/compiler/ghci/RtClosureInspect.hs b/compiler/ghci/RtClosureInspect.hs index 86e9a00..9ed6cfb 100644 --- a/compiler/ghci/RtClosureInspect.hs +++ b/compiler/ghci/RtClosureInspect.hs @@ -905,10 +905,9 @@ cvReconstructType hsc_env max_depth old_ty hval = runTR_maybe hsc_env $ do (_,mb_dc) <- tryTcErrs (tcLookupDataCon dcname) case mb_dc of Nothing-> do - -- TODO: Check this case - forM [0..length (elems $ ptrs clos)] $ \i -> do - tv <- newVar liftedTypeKind - return$ appArr (\e->(tv,e)) (ptrs clos) i + forM (elems $ ptrs clos) $ \a -> do + tv <- newVar liftedTypeKind + return (tv, a) Just dc -> do arg_tys <- getDataConArgTys dc my_ty diff --git a/testsuite/tests/ghci.debugger/scripts/T12458.script b/testsuite/tests/ghci.debugger/scripts/T12458.script new file mode 100644 index 0000000..5d4120d --- /dev/null +++ b/testsuite/tests/ghci.debugger/scripts/T12458.script @@ -0,0 +1,4 @@ +data D a = D +d = D +:print d +d `seq` () diff --git a/testsuite/tests/ghci.debugger/scripts/T12458.stdout b/testsuite/tests/ghci.debugger/scripts/T12458.stdout new file mode 100644 index 0000000..2a616b0 --- /dev/null +++ b/testsuite/tests/ghci.debugger/scripts/T12458.stdout @@ -0,0 +1,2 @@ +d = (_t1::D a) +() diff --git a/testsuite/tests/ghci.debugger/scripts/all.T b/testsuite/tests/ghci.debugger/scripts/all.T index 28089a2..b74a6ea 100644 --- a/testsuite/tests/ghci.debugger/scripts/all.T +++ b/testsuite/tests/ghci.debugger/scripts/all.T @@ -87,3 +87,4 @@ test('T2740', normal, ghci_script, ['T2740.script']) test('getargs', normal, 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']) From git at git.haskell.org Tue Aug 30 21:43:45 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 30 Aug 2016 21:43:45 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Relevant Bindings no longer reports shadowed bindings (fixes #12176) (88b7812) Message-ID: <20160830214345.786FC3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/88b781283b728f72f2fcbae82037dd3d7f407e7a/ghc >--------------------------------------------------------------- commit 88b781283b728f72f2fcbae82037dd3d7f407e7a Author: Annie Cherkaev Date: Sun Jul 31 23:30:42 2016 -0700 Relevant Bindings no longer reports shadowed bindings (fixes #12176) Summary: Modified the RelevantBindings method in TcErrors.hs to only search over non-shadowed bindings. Test Plan: Wrote 2 simple test cases, verified that it worked with multiple shadowed bindings, and also non-shadowed bindings. Reviewers: austin, bgamari, ezyang Reviewed By: ezyang Subscribers: ezyang, thomie Differential Revision: https://phabricator.haskell.org/D2434 GHC Trac Issues: #12177 (cherry picked from commit 89ae1e858f6eed42cebd9af01b30e239d4543faf) >--------------------------------------------------------------- 88b781283b728f72f2fcbae82037dd3d7f407e7a compiler/typecheck/TcErrors.hs | 12 +++++++++- compiler/typecheck/TcRnTypes.hs | 4 ++++ testsuite/tests/typecheck/should_fail/T12177.hs | 5 ++++ .../tests/typecheck/should_fail/T12177.stderr | 28 ++++++++++++++++++++++ testsuite/tests/typecheck/should_fail/all.T | 1 + 5 files changed, 49 insertions(+), 1 deletion(-) diff --git a/compiler/typecheck/TcErrors.hs b/compiler/typecheck/TcErrors.hs index 43c2571..60144c6 100644 --- a/compiler/typecheck/TcErrors.hs +++ b/compiler/typecheck/TcErrors.hs @@ -2517,7 +2517,7 @@ relevantBindings want_filtering ctxt ct ; (tidy_env', docs, discards) <- go env1 ct_tvs (maxRelevantBinds dflags) emptyVarSet [] False - (tcl_bndrs lcl_env) + (remove_shadowing $ tcl_bndrs lcl_env) -- tcl_bndrs has the innermost bindings first, -- which are probably the most relevant ones @@ -2543,6 +2543,16 @@ relevantBindings want_filtering ctxt ct dec_max :: Maybe Int -> Maybe Int dec_max = fmap (\n -> n - 1) + ---- fixes #12177 + ---- builds up a list of bindings whose OccName has not been seen before + remove_shadowing :: [TcIdBinder] -> [TcIdBinder] + remove_shadowing bindings = reverse $ fst $ foldl + (\(bindingAcc, seenNames) binding -> + if (occName binding) `elemOccSet` seenNames -- if we've seen it + then (bindingAcc, seenNames) -- skip it + else (binding:bindingAcc, extendOccSet seenNames (occName binding))) + ([], emptyOccSet) bindings + go :: TidyEnv -> TcTyVarSet -> Maybe Int -> TcTyVarSet -> [SDoc] -> Bool -- True <=> some filtered out due to lack of fuel -> [TcIdBinder] diff --git a/compiler/typecheck/TcRnTypes.hs b/compiler/typecheck/TcRnTypes.hs index d48d6a7..72a8222 100644 --- a/compiler/typecheck/TcRnTypes.hs +++ b/compiler/typecheck/TcRnTypes.hs @@ -777,6 +777,10 @@ instance Outputable TcIdBinder where ppr (TcIdBndr id top_lvl) = ppr id <> brackets (ppr top_lvl) ppr (TcIdBndr_ExpType id _ top_lvl) = ppr id <> brackets (ppr top_lvl) +instance HasOccName TcIdBinder where + occName (TcIdBndr id _) = (occName (idName id)) + occName (TcIdBndr_ExpType name _ _) = (occName name) + --------------------------- -- Template Haskell stages and levels --------------------------- diff --git a/testsuite/tests/typecheck/should_fail/T12177.hs b/testsuite/tests/typecheck/should_fail/T12177.hs new file mode 100644 index 0000000..4845e7f --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T12177.hs @@ -0,0 +1,5 @@ +module Foo where + +bar = \x -> \x -> _ + +baz = \x -> \y -> \z -> \x -> \z -> _ diff --git a/testsuite/tests/typecheck/should_fail/T12177.stderr b/testsuite/tests/typecheck/should_fail/T12177.stderr new file mode 100644 index 0000000..48bf94d --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T12177.stderr @@ -0,0 +1,28 @@ + +T12177.hs:3:19: error: + • Found hole: _ :: t + Where: ‘t’ is a rigid type variable bound by + the inferred type of bar :: t2 -> t1 -> t + at T12177.hs:3:1-19 + • In the expression: _ + In the expression: \ x -> _ + In the expression: \ x -> \ x -> _ + • Relevant bindings include + x :: t1 (bound at T12177.hs:3:14) + bar :: t2 -> t1 -> t (bound at T12177.hs:3:1) + +T12177.hs:5:37: error: + • Found hole: _ :: t + Where: ‘t’ is a rigid type variable bound by + the inferred type of baz :: t5 -> t4 -> t3 -> t2 -> t1 -> t + at T12177.hs:5:1-37 + • In the expression: _ + In the expression: \ z -> _ + In the expression: \ x -> \ z -> _ + • Relevant bindings include + z :: t1 (bound at T12177.hs:5:32) + x :: t2 (bound at T12177.hs:5:26) + y :: t4 (bound at T12177.hs:5:14) + baz :: t5 -> t4 -> t3 -> t2 -> t1 -> t + (bound at T12177.hs:5:1) + \ No newline at end of file diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T index 3880287..534626a 100644 --- a/testsuite/tests/typecheck/should_fail/all.T +++ b/testsuite/tests/typecheck/should_fail/all.T @@ -420,3 +420,4 @@ test('T7437', normal, compile_fail, ['']) test('T11947a', normal, compile_fail, ['']) test('T11974b', normal, compile_fail, ['']) test('T12406', normal, compile_fail, ['']) +test('T12177', normal, compile_fail, ['']) From git at git.haskell.org Tue Aug 30 21:43:48 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 30 Aug 2016 21:43:48 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Allow typed holes to be levity-polymorphic (f4ac734) Message-ID: <20160830214348.753663A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/f4ac734d754e2d4399525038e8a4dd4a841ce8af/ghc >--------------------------------------------------------------- commit f4ac734d754e2d4399525038e8a4dd4a841ce8af Author: Simon Peyton Jones Date: Fri Aug 26 17:24:10 2016 +0100 Allow typed holes to be levity-polymorphic This one-line change fixes Trac #12531. Hooray. Simple, non-invasive; can merge to 8.0.2 (cherry picked from commit ae66f356fb0dbf79dab1074d71275904c448b329) >--------------------------------------------------------------- f4ac734d754e2d4399525038e8a4dd4a841ce8af compiler/typecheck/TcExpr.hs | 8 ++++---- .../T5472.stdout => partial-sigs/should_compile/12531.stderr} | 0 testsuite/tests/partial-sigs/should_compile/T12531.hs | 6 ++++++ testsuite/tests/partial-sigs/should_compile/all.T | 1 + 4 files changed, 11 insertions(+), 4 deletions(-) diff --git a/compiler/typecheck/TcExpr.hs b/compiler/typecheck/TcExpr.hs index d083f3f..0933623 100644 --- a/compiler/typecheck/TcExpr.hs +++ b/compiler/typecheck/TcExpr.hs @@ -1593,16 +1593,16 @@ tc_infer_id lbl id_name tcUnboundId :: UnboundVar -> ExpRhoType -> TcM (HsExpr TcId) --- Typechedk an occurrence of an unbound Id +-- Typecheck an occurrence of an unbound Id -- --- Some of these started life as a true hole "_". Others might simply --- be variables that accidentally have no binding site +-- Some of these started life as a true expression hole "_". +-- Others might simply be variables that accidentally have no binding site -- -- We turn all of them into HsVar, since HsUnboundVar can't contain an -- Id; and indeed the evidence for the CHoleCan does bind it, so it's -- not unbound any more! tcUnboundId unbound res_ty - = do { ty <- newFlexiTyVarTy liftedTypeKind + = do { ty <- newOpenFlexiTyVarTy -- Allow Int# etc (Trac #12531) ; let occ = unboundVarOcc unbound ; name <- newSysName occ ; let ev = mkLocalId name ty diff --git a/testsuite/tests/deSugar/should_run/T5472.stdout b/testsuite/tests/partial-sigs/should_compile/12531.stderr similarity index 100% copy from testsuite/tests/deSugar/should_run/T5472.stdout copy to testsuite/tests/partial-sigs/should_compile/12531.stderr diff --git a/testsuite/tests/partial-sigs/should_compile/T12531.hs b/testsuite/tests/partial-sigs/should_compile/T12531.hs new file mode 100644 index 0000000..2488db2 --- /dev/null +++ b/testsuite/tests/partial-sigs/should_compile/T12531.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE MagicHash #-} + +module T12531 where +import GHC.Exts + +f x = I# (_ +# x) diff --git a/testsuite/tests/partial-sigs/should_compile/all.T b/testsuite/tests/partial-sigs/should_compile/all.T index 63a6efc..38c937c 100644 --- a/testsuite/tests/partial-sigs/should_compile/all.T +++ b/testsuite/tests/partial-sigs/should_compile/all.T @@ -63,3 +63,4 @@ test('ExprSigLocal', normal, compile, ['']) test('T11016', normal, compile, ['']) test('T11192', normal, compile, ['']) test('T12156', normal, compile_fail, ['-fdefer-typed-holes']) +test('T12531', normal, compile, ['-fdefer-typed-holes']) From git at git.haskell.org Tue Aug 30 21:43:51 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 30 Aug 2016 21:43:51 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Testsuite: for tests that use TH, omit *all* prof_ways (a8d0d3e) Message-ID: <20160830214351.2FFF43A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/a8d0d3eb1e978276b19e4918ec4315f3fd62e0bb/ghc >--------------------------------------------------------------- commit a8d0d3eb1e978276b19e4918ec4315f3fd62e0bb Author: Thomas Miedema Date: Mon Feb 22 18:55:30 2016 +0100 Testsuite: for tests that use TH, omit *all* prof_ways Instead of just profasm and profthreaded. And at least until -fexternal-interpreter is the default. Also: * WAY=profc doesn't exist anymore. * Omit all threaded_ways for conc039, not just a few. (cherry picked from commit e02b8c8dadcc77c0c40d5346246f6a3b548258c2) >--------------------------------------------------------------- a8d0d3eb1e978276b19e4918ec4315f3fd62e0bb testsuite/config/ghc | 2 +- testsuite/tests/annotations/should_compile/all.T | 5 +---- testsuite/tests/annotations/should_compile/th/all.T | 4 ++-- testsuite/tests/annotations/should_run/all.T | 2 +- testsuite/tests/concurrent/should_run/all.T | 2 +- testsuite/tests/haddock/haddock_examples/test.T | 2 +- testsuite/tests/overloadedrecflds/should_run/all.T | 8 +++++--- testsuite/tests/parser/should_compile/all.T | 4 ++-- testsuite/tests/partial-sigs/should_compile/all.T | 4 ++-- testsuite/tests/quasiquotation/qq005/test.T | 2 +- testsuite/tests/quasiquotation/qq007/test.T | 1 + testsuite/tests/quasiquotation/qq008/test.T | 1 + testsuite/tests/quasiquotation/qq009/test.T | 1 + testsuite/tests/quotes/TH_spliceViewPat/test.T | 5 ++--- testsuite/tests/rts/all.T | 8 ++++---- testsuite/tests/simplCore/should_compile/all.T | 2 +- 16 files changed, 27 insertions(+), 26 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc a8d0d3eb1e978276b19e4918ec4315f3fd62e0bb From git at git.haskell.org Tue Aug 30 21:43:53 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 30 Aug 2016 21:43:53 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: pass -z wxneeded or -Wl, -zwxneeded for linking on OpenBSD (5370f3c) Message-ID: <20160830214353.D3E2D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/5370f3cb40aaf758f39b4b0db8b38dce68fd57aa/ghc >--------------------------------------------------------------- commit 5370f3cb40aaf758f39b4b0db8b38dce68fd57aa Author: Karel Gardas Date: Sat Aug 13 18:49:53 2016 +0200 pass -z wxneeded or -Wl,-zwxneeded for linking on OpenBSD Summary: This patch fixes issue with abort in GHCi on OpenBSD current as of Aug 12 2016. The OpenBSD is more and more strict about usage of writable and executable memory. Programs/applications which requires such functionality need to be linked with -z wxneeded linker flag and need to be run from the file-system mounted with wxallowed mount option. If either of those options in not met, then problematic program/application usually fail on some mmap/mprotect call which fail. Reviewers: bgamari, austin, hvr Subscribers: thomie, erikd Differential Revision: https://phabricator.haskell.org/D2454 (cherry picked from commit f9aa996f0af59f32dc7b1528ff78be41413a9c27) >--------------------------------------------------------------- 5370f3cb40aaf758f39b4b0db8b38dce68fd57aa aclocal.m4 | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/aclocal.m4 b/aclocal.m4 index 18b9529..0c842d5 100644 --- a/aclocal.m4 +++ b/aclocal.m4 @@ -601,6 +601,13 @@ AC_DEFUN([FPTOOLS_SET_C_LD_FLAGS], $5="$$5 -D_THREAD_SAFE" ;; + x86_64-*-openbsd*) + # We need -z wxneeded at least to link ghc-stage2 to workaround + # W^X issue in GHCi on OpenBSD current (as of Aug 2016) + $3="$$3 -Wl,-zwxneeded" + $4="$$4 -z wxneeded" + ;; + esac # If gcc knows about the stack protector, turn it off. From git at git.haskell.org Tue Aug 30 21:43:56 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 30 Aug 2016 21:43:56 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Fix T12177 (c7c4e71) Message-ID: <20160830214356.89B903A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/c7c4e71fe681e5befb42cf704f3776b14b2554d7/ghc >--------------------------------------------------------------- commit c7c4e71fe681e5befb42cf704f3776b14b2554d7 Author: Ben Gamari Date: Tue Aug 30 14:48:49 2016 -0400 Fix T12177 >--------------------------------------------------------------- c7c4e71fe681e5befb42cf704f3776b14b2554d7 testsuite/tests/typecheck/should_fail/T12177.stderr | 9 +++------ 1 file changed, 3 insertions(+), 6 deletions(-) diff --git a/testsuite/tests/typecheck/should_fail/T12177.stderr b/testsuite/tests/typecheck/should_fail/T12177.stderr index 48bf94d..8b17b9b 100644 --- a/testsuite/tests/typecheck/should_fail/T12177.stderr +++ b/testsuite/tests/typecheck/should_fail/T12177.stderr @@ -2,8 +2,7 @@ T12177.hs:3:19: error: • Found hole: _ :: t Where: ‘t’ is a rigid type variable bound by - the inferred type of bar :: t2 -> t1 -> t - at T12177.hs:3:1-19 + the inferred type of bar :: t2 -> t1 -> t at T12177.hs:3:1 • In the expression: _ In the expression: \ x -> _ In the expression: \ x -> \ x -> _ @@ -15,7 +14,7 @@ T12177.hs:5:37: error: • Found hole: _ :: t Where: ‘t’ is a rigid type variable bound by the inferred type of baz :: t5 -> t4 -> t3 -> t2 -> t1 -> t - at T12177.hs:5:1-37 + at T12177.hs:5:1 • In the expression: _ In the expression: \ z -> _ In the expression: \ x -> \ z -> _ @@ -23,6 +22,4 @@ T12177.hs:5:37: error: z :: t1 (bound at T12177.hs:5:32) x :: t2 (bound at T12177.hs:5:26) y :: t4 (bound at T12177.hs:5:14) - baz :: t5 -> t4 -> t3 -> t2 -> t1 -> t - (bound at T12177.hs:5:1) - \ No newline at end of file + baz :: t5 -> t4 -> t3 -> t2 -> t1 -> t (bound at T12177.hs:5:1) From git at git.haskell.org Tue Aug 30 21:43:59 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 30 Aug 2016 21:43:59 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Missing stderr for T12531. (72bec52) Message-ID: <20160830214359.BDD053A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/72bec52d1237dfc21500159725aaba55f2f8ed8f/ghc >--------------------------------------------------------------- commit 72bec52d1237dfc21500159725aaba55f2f8ed8f Author: Edward Z. Yang Date: Tue Aug 30 02:43:38 2016 -0700 Missing stderr for T12531. Signed-off-by: Edward Z. Yang (cherry picked from commit 21c2ebf2504125611eec0d24ab3ed60cd9e475be) >--------------------------------------------------------------- 72bec52d1237dfc21500159725aaba55f2f8ed8f testsuite/tests/partial-sigs/should_compile/T12531.stderr | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/testsuite/tests/partial-sigs/should_compile/T12531.stderr b/testsuite/tests/partial-sigs/should_compile/T12531.stderr new file mode 100644 index 0000000..ddd6824 --- /dev/null +++ b/testsuite/tests/partial-sigs/should_compile/T12531.stderr @@ -0,0 +1,9 @@ + +T12531.hs:6:11: warning: [-Wtyped-holes (in -Wdefault)] + • Found hole: _ :: Int# + • In the first argument of ‘(+#)’, namely ‘_’ + In the first argument of ‘I#’, namely ‘(_ +# x)’ + In the expression: I# (_ +# x) + • Relevant bindings include + x :: Int# (bound at T12531.hs:6:3) + f :: Int# -> Int (bound at T12531.hs:6:1) From git at git.haskell.org Tue Aug 30 21:44:03 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 30 Aug 2016 21:44:03 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Have addModFinalizer expose the local type environment. (8d63419) Message-ID: <20160830214403.762B53A301@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/8d63419478074728eb03082787ea51d498b3e62e/ghc >--------------------------------------------------------------- commit 8d63419478074728eb03082787ea51d498b3e62e Author: Facundo Domínguez Date: Wed Jul 6 06:48:27 2016 -0300 Have addModFinalizer expose the local type environment. Summary: This annotates the splice point with 'HsSpliced ref e' where 'e' is the result of the splice. 'ref' is a reference that the typechecker will fill with the local type environment. The finalizer then reads the ref and uses the local type environment, which causes 'reify' to find local variables when run in the finalizer. Test Plan: ./validate Reviewers: simonpj, simonmar, bgamari, austin, goldfire Reviewed By: goldfire Subscribers: simonmar, thomie, mboes Differential Revision: https://phabricator.haskell.org/D2286 GHC Trac Issues: #11832 (cherry picked from commit 567dbd9bcb602accf3184b83050f2982cbb7758b) >--------------------------------------------------------------- 8d63419478074728eb03082787ea51d498b3e62e compiler/deSugar/DsMeta.hs | 1 + compiler/hsSyn/HsExpr.hs | 58 ++++++++- compiler/rename/RnPat.hs | 4 + compiler/rename/RnSplice.hs | 137 +++++++++++++++++++-- compiler/rename/RnTypes.hs | 1 + compiler/typecheck/TcExpr.hs | 8 ++ compiler/typecheck/TcHsType.hs | 12 ++ compiler/typecheck/TcPat.hs | 9 ++ compiler/typecheck/TcRnMonad.hs | 17 +++ compiler/typecheck/TcRnTypes.hs | 55 +++++++-- compiler/typecheck/TcSplice.hs | 99 +++++++++++---- compiler/typecheck/TcSplice.hs-boot | 3 +- iserv/src/Main.hs | 2 +- libraries/ghci/GHCi/Message.hs | 20 +-- libraries/ghci/GHCi/TH.hs | 35 +++--- .../template-haskell/Language/Haskell/TH/Syntax.hs | 4 + testsuite/tests/th/TH_reifyLocalDefs.hs | 36 ++++++ testsuite/tests/th/TH_reifyLocalDefs.stderr | 5 + testsuite/tests/th/all.T | 1 + 19 files changed, 433 insertions(+), 74 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 8d63419478074728eb03082787ea51d498b3e62e From git at git.haskell.org Wed Aug 31 16:44:10 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 31 Aug 2016 16:44:10 +0000 (UTC) Subject: [commit: ghc] branch 'wip/spj-tc-branch' created Message-ID: <20160831164410.E181D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/spj-tc-branch Referencing: 4f1edfd6b960b14579309f22639ead3d14175852 From git at git.haskell.org Wed Aug 31 16:44:13 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 31 Aug 2016 16:44:13 +0000 (UTC) Subject: [commit: ghc] wip/spj-tc-branch: Comments and white space only (7cf5c43) Message-ID: <20160831164413.C5EDD3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/spj-tc-branch Link : http://ghc.haskell.org/trac/ghc/changeset/7cf5c43b85ab90c4e8b3046cf59c704acab3473f/ghc >--------------------------------------------------------------- commit 7cf5c43b85ab90c4e8b3046cf59c704acab3473f Author: Simon Peyton Jones Date: Mon Aug 29 09:04:24 2016 +0100 Comments and white space only >--------------------------------------------------------------- 7cf5c43b85ab90c4e8b3046cf59c704acab3473f compiler/hsSyn/HsBinds.hs | 2 +- compiler/typecheck/TcRnTypes.hs | 6 +++--- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/compiler/hsSyn/HsBinds.hs b/compiler/hsSyn/HsBinds.hs index 2120e05..236892e 100644 --- a/compiler/hsSyn/HsBinds.hs +++ b/compiler/hsSyn/HsBinds.hs @@ -745,7 +745,7 @@ data Sig name -- | A signature for a class method -- False: ordinary class-method signature - -- True: default class method signature + -- True: generic-default class method signature -- e.g. class C a where -- op :: a -> a -- Ordinary -- default op :: Eq a => a -> a -- Generic default diff --git a/compiler/typecheck/TcRnTypes.hs b/compiler/typecheck/TcRnTypes.hs index 02e53af..78b0091 100644 --- a/compiler/typecheck/TcRnTypes.hs +++ b/compiler/typecheck/TcRnTypes.hs @@ -2091,10 +2091,10 @@ ppr_bag doc bag data Implication = Implic { - ic_tclvl :: TcLevel, -- TcLevel: unification variables - -- free in the environment + ic_tclvl :: TcLevel, -- TcLevel of unification variables + -- allocated /inside/ this implication - ic_skols :: [TcTyVar], -- Introduced skolems + ic_skols :: [TcTyVar], -- Introduced skolems ic_info :: SkolemInfo, -- See Note [Skolems in an implication] -- See Note [Shadowing in a constraint] From git at git.haskell.org Wed Aug 31 16:44:16 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 31 Aug 2016 16:44:16 +0000 (UTC) Subject: [commit: ghc] wip/spj-tc-branch: Type inference improvements for higher rank (c0346ae) Message-ID: <20160831164416.CB3B53A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/spj-tc-branch Link : http://ghc.haskell.org/trac/ghc/changeset/c0346aeac2770cfef929ed9c8e5f99f2ec0e9cff/ghc >--------------------------------------------------------------- commit c0346aeac2770cfef929ed9c8e5f99f2ec0e9cff Author: Simon Peyton Jones Date: Tue Aug 30 11:00:47 2016 +0100 Type inference improvements for higher rank This is a draft patch 1. Modify TcType.ExpType to make a distinct data type, InferResult for the Infer case. 2. Define a new function TcUnify.fillInferResult, to fill in an InferResult. Crucially, it calls new function TcMType.promoteTcType to the magic of exposing higher rank stuff See Note [Promoting a type] in TcMType 3. Add a TcLevel to SkolemTvs. This will be useful generally - it's a fast way to see if the type variable escapes when floating - it provides a good consistency check when updating a unification variable But my reason for doing it now is that it allows me to be more selective about cloning in promoteTcType. It's not essential, but I've been meaning to do this for some time. 4. Reduce and simplify the plethora of tcSubType functions in TcUnify. But the main change is that tcSubTypeDS_NC_O, in the Infer case, does deep instantiation before calling fillInferResult. Reason: f :: (?x :: Int) => a -> a g y = let ?x = 3::Int in f Open problem: the cloning in promoteTc should not happen under GADT-style type equalities. Boo.. >--------------------------------------------------------------- c0346aeac2770cfef929ed9c8e5f99f2ec0e9cff compiler/typecheck/TcBinds.hs | 2 +- compiler/typecheck/TcExpr.hs | 9 +- compiler/typecheck/TcHsType.hs | 13 +- compiler/typecheck/TcInstDcls.hs | 3 +- compiler/typecheck/TcMType.hs | 261 +++++++++++++++------ compiler/typecheck/TcPatSyn.hs | 8 +- compiler/typecheck/TcType.hs | 70 ++++-- compiler/typecheck/TcUnify.hs | 232 +++++++++--------- compiler/typecheck/TcValidity.hs | 2 +- compiler/vectorise/Vectorise/Generic/PData.hs | 2 +- .../typecheck/should_compile/ExPatFail.stderr | 6 +- .../tests/typecheck/should_compile/tc141.stderr | 2 +- testsuite/tests/typecheck/should_fail/T3102.hs | 2 +- .../tests/typecheck/should_fail/tcfail004.stderr | 6 +- .../tests/typecheck/should_fail/tcfail005.stderr | 6 +- .../tests/typecheck/should_fail/tcfail018.stderr | 2 +- 16 files changed, 382 insertions(+), 244 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc c0346aeac2770cfef929ed9c8e5f99f2ec0e9cff From git at git.haskell.org Wed Aug 31 16:44:20 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 31 Aug 2016 16:44:20 +0000 (UTC) Subject: [commit: ghc] wip/spj-tc-branch: Refactor typechecking of pattern bindings (42c1792) Message-ID: <20160831164420.5BBD03A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/spj-tc-branch Link : http://ghc.haskell.org/trac/ghc/changeset/42c1792403cb8241e2ac8c0d357a1a0aa7570a87/ghc >--------------------------------------------------------------- commit 42c1792403cb8241e2ac8c0d357a1a0aa7570a87 Author: Simon Peyton Jones Date: Wed Aug 31 09:28:39 2016 +0100 Refactor typechecking of pattern bindings This patch fixes a regression introduced, post 8.0.1, by this major commit: commit 15b9bf4ba4ab47e6809bf2b3b36ec16e502aea72 Author: Simon Peyton Jones Date: Sat Jun 11 23:49:27 2016 +0100 Improve typechecking of let-bindings This major commit was initially triggered by #11339, but it spiraled into a major review of the way in which type signatures for bindings are handled, especially partial type signatures. I didn't get the typechecking of pattern bindings right, leading to Trac #12427. In fixing this I found that this program doesn't work: data T where T :: a -> ((forall b. [b]->[b]) -> Int) -> T h1 y = case y of T _ v -> v Works in 7.10, but not in 8.0.1. There's a happy ending. I found a way to fix this, and improve pattern bindings too. Not only does this fix #12427, but it also allows In particular,we now can accept data T where MkT :: a -> Int -> T ... let { MkT _ q = t } in ... Previously this elicited "my head exploded" but it's really fine since q::Int. The approach is described in detail in TcBinds Note [Typechecking pattern bindings] Super cool. And not even a big patch! >--------------------------------------------------------------- 42c1792403cb8241e2ac8c0d357a1a0aa7570a87 compiler/typecheck/TcBinds.hs | 182 ++++++++++++++------- compiler/typecheck/TcPat.hs | 59 +++++-- .../tests/typecheck/should_compile/T12427a.hs | 28 ++++ .../tests/typecheck/should_compile/T12427b.hs | 20 +++ testsuite/tests/typecheck/should_compile/all.T | 3 + 5 files changed, 214 insertions(+), 78 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 42c1792403cb8241e2ac8c0d357a1a0aa7570a87 From git at git.haskell.org Wed Aug 31 16:44:23 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 31 Aug 2016 16:44:23 +0000 (UTC) Subject: [commit: ghc] wip/spj-tc-branch: Comments only (4f1edfd) Message-ID: <20160831164423.37F683A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/spj-tc-branch Link : http://ghc.haskell.org/trac/ghc/changeset/4f1edfd6b960b14579309f22639ead3d14175852/ghc >--------------------------------------------------------------- commit 4f1edfd6b960b14579309f22639ead3d14175852 Author: Simon Peyton Jones Date: Wed Aug 31 17:42:56 2016 +0100 Comments only >--------------------------------------------------------------- 4f1edfd6b960b14579309f22639ead3d14175852 compiler/types/TyCoRep.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/types/TyCoRep.hs b/compiler/types/TyCoRep.hs index cd221a2..88352e9 100644 --- a/compiler/types/TyCoRep.hs +++ b/compiler/types/TyCoRep.hs @@ -1686,7 +1686,7 @@ the range of the TvSubstEnv should *never* include a type headed with CoercionTy. Note [The substitution invariant] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ When calling (substTy subst ty) it should be the case that the in-scope set in the substitution is a superset of both: From git at git.haskell.org Wed Aug 31 17:18:47 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 31 Aug 2016 17:18:47 +0000 (UTC) Subject: [commit: hsc2hs] master: Fixes #12504: Double-escape paths used to build call to hsc_line (f5ae016) Message-ID: <20160831171847.330E13A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/hsc2hs On branch : master Link : http://git.haskell.org/hsc2hs.git/commitdiff/f5ae016e5a69ebf42d612805e51afd9227df9389 >--------------------------------------------------------------- commit f5ae016e5a69ebf42d612805e51afd9227df9389 Author: Richard Cook Date: Mon Aug 22 12:14:17 2016 -0700 Fixes #12504: Double-escape paths used to build call to hsc_line In outHsLine, paths passed to construct invocations of hsc_line must be escaped twice in order to generate a properly escaped string literal that will end up in the eventual LINE pragma emitted by this code. This is especially important on Windows paths, where backslashes would otherwise be treated as C escape sequences and result in the incorrect Windows paths. See https://ghc.haskell.org/trac/ghc/ticket/12504 >--------------------------------------------------------------- f5ae016e5a69ebf42d612805e51afd9227df9389 C.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/C.hs b/C.hs index dd02f43..f742be7 100644 --- a/C.hs +++ b/C.hs @@ -185,7 +185,7 @@ outCLine (SourcePos name line) = outHsLine :: SourcePos -> String outHsLine (SourcePos name line) = " hsc_line ("++show (line + 1)++", \""++ - showCString name++"\");\n" + (showCString . showCString) name ++ "\");\n" showCString :: String -> String showCString = concatMap showCChar From git at git.haskell.org Wed Aug 31 17:19:02 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 31 Aug 2016 17:19:02 +0000 (UTC) Subject: [commit: ghc] master: Fix and complete runghc documentation (d168c41) Message-ID: <20160831171902.DDB353A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d168c41a231cd92ca993e0bdd621cf554694df1c/ghc >--------------------------------------------------------------- commit d168c41a231cd92ca993e0bdd621cf554694df1c Author: Harendra Kumar Date: Tue Aug 30 16:54:30 2016 -0400 Fix and complete runghc documentation Reviewers: austin, thomie, bgamari Reviewed By: bgamari Differential Revision: https://phabricator.haskell.org/D2463 GHC Trac Issues: #12517 >--------------------------------------------------------------- d168c41a231cd92ca993e0bdd621cf554694df1c docs/users_guide/runghc.rst | 58 +++++++++++++++++++++++++++++++++------------ utils/runghc/Main.hs | 1 + 2 files changed, 44 insertions(+), 15 deletions(-) diff --git a/docs/users_guide/runghc.rst b/docs/users_guide/runghc.rst index d823e35..fcc8cf8 100644 --- a/docs/users_guide/runghc.rst +++ b/docs/users_guide/runghc.rst @@ -11,7 +11,7 @@ compile them. .. _runghc-introduction: -Flags +Usage ----- The ``runghc`` command-line looks like: @@ -20,17 +20,45 @@ The ``runghc`` command-line looks like: runghc [runghc flags] [GHC flags] module [program args] -The runghc flags are ``-f /path/to/ghc``, which tells runghc which GHC -to use to run the program, and ``--help``, which prints usage -information. If it is not given then runghc will search for GHC in the -directories in the system search path. - -runghc will try to work out where the boundaries between -``[runghc flags]`` and ``[GHC flags]``, and ``[program args]`` and -``module`` are, but you can use a ``--`` flag if it doesn't get it -right. For example, ``runghc -- -Wunused-bindings Foo`` means -runghc won't try to use ``warn-unused-bindings`` as the path to GHC, but -instead will pass the flag to GHC. If a GHC flag doesn't start with a -dash then you need to prefix it with ``--ghc-arg=`` or runghc will think -that it is the program to run, e.g. -``runghc -package-db --ghc-arg=foo.conf Main.hs``. +Any flags not recognized by runghc are automatically passed to GHC. +If a flag is recognized by both runghc and GHC but you want to +pass it to GHC then you can place it after a ``--`` separator. Flags after the +separator are treated as GHC only flags. Alternatively you can use the runghc +option ``--ghc-arg=`` to pass any flag or argument directly to GHC. + +``module`` could be a Haskell source filename with or without the extension. +If for some reason the filename starts with a ``-`` you can use a second +``--`` to indicate the end of flags. Anything following a second +``--`` will be considered a program file or module name followed by its +arguments. For example: + +- ``runghc -- -- -hello.hs`` + +runghc flags +------------ + +runghc accepts the following flags: + +- ``-f /path/to/ghc``: tell runghc the path of GHC executable to use to run the program. By default runghc will search for GHC in the directories in the system search path. +- ``--ghc-arg=``: Pass an option or argument to GHC +- ``--help``: print usage information. +- ``--version``: print version information. + +GHC Flags +--------- + +As discussed earlier, use ``--`` or ``--ghc-arg=`` to disambiguate GHC +flags when needed. For example, ``-f`` is recognized by runghc, therefore to +pass ``-fliberate-case`` to GHC use any of the following: + +- ``runghc -- -fliberate-case`` +- ``runghc --ghc-arg=-fliberate-case`` + +Note that any non-flag arguments are never passed to GHC. An unused non-flag +argument will be considered as the name of the program to run. If a GHC flag +takes an argument use ``--ghc-arg=`` to pass the argument to GHC. +For example, if you want to pass ``-package foo`` to GHC use any of the +following: + +- ``runghc -package --ghc-arg=foo Main.hs`` +- ``runghc --ghc-arg=-package --ghc-arg=foo Main.hs`` diff --git a/utils/runghc/Main.hs b/utils/runghc/Main.hs index d048125..001d902 100644 --- a/utils/runghc/Main.hs +++ b/utils/runghc/Main.hs @@ -107,6 +107,7 @@ printUsage = do putStrLn "" putStrLn "The runghc flags are" putStrLn " -f /path/to/ghc Tell runghc where GHC is" + putStrLn " --ghc-arg= Pass an option or argument to GHC" putStrLn " --help Print this usage information" putStrLn " --version Print version number" From git at git.haskell.org Wed Aug 31 17:19:05 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 31 Aug 2016 17:19:05 +0000 (UTC) Subject: [commit: ghc] master: Clarify pkg selection when multiple versions are available (6781f37) Message-ID: <20160831171905.972963A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6781f37d1915ab08cdb3846839a1d485a874049b/ghc >--------------------------------------------------------------- commit 6781f37d1915ab08cdb3846839a1d485a874049b Author: Harendra Kumar Date: Tue Aug 30 16:55:08 2016 -0400 Clarify pkg selection when multiple versions are available Reviewers: austin, bgamari, ezyang Reviewed By: ezyang Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2464 >--------------------------------------------------------------- 6781f37d1915ab08cdb3846839a1d485a874049b docs/users_guide/conf.py | 6 +- docs/users_guide/packages.rst | 275 ++++++++++++++++++++++++------------------ 2 files changed, 159 insertions(+), 122 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 6781f37d1915ab08cdb3846839a1d485a874049b From git at git.haskell.org Wed Aug 31 17:19:09 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 31 Aug 2016 17:19:09 +0000 (UTC) Subject: [commit: ghc] master: Fix binary-trees regression from unnecessary floating in CorePrep. (83b326c) Message-ID: <20160831171909.220AF3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/83b326cda759cfd4c538595cf38ee23eb81a4c76/ghc >--------------------------------------------------------------- commit 83b326cda759cfd4c538595cf38ee23eb81a4c76 Author: Edward Z. Yang Date: Tue Aug 30 16:55:58 2016 -0400 Fix binary-trees regression from unnecessary floating in CorePrep. In the previous patch, I handled lazy @(Int -> Int) f x correctly, but failed to handle lazy @Int (f x) (we need to collect arguments in f x). Signed-off-by: Edward Z. Yang Test Plan: validate Reviewers: simonpj, austin, bgamari, nomeata Reviewed By: nomeata Subscribers: simonmar, thomie Differential Revision: https://phabricator.haskell.org/D2471 >--------------------------------------------------------------- 83b326cda759cfd4c538595cf38ee23eb81a4c76 compiler/coreSyn/CorePrep.hs | 44 ++++++++++++++++------ testsuite/tests/simplCore/should_compile/all.T | 1 + testsuite/tests/simplCore/should_compile/par01.hs | 10 +++++ .../tests/simplCore/should_compile/par01.stderr | 33 ++++++++++++++++ 4 files changed, 76 insertions(+), 12 deletions(-) diff --git a/compiler/coreSyn/CorePrep.hs b/compiler/coreSyn/CorePrep.hs index 0d82be5..b3d7817 100644 --- a/compiler/coreSyn/CorePrep.hs +++ b/compiler/coreSyn/CorePrep.hs @@ -668,13 +668,8 @@ cpeApp :: CorePrepEnv -> CoreExpr -> UniqSM (Floats, CpeRhs) -- May return a CpeRhs because of saturating primops cpeApp top_env expr = do { let (terminal, args, depth) = collect_args expr - ; (head, app, floats) <- cpe_app top_env terminal args depth - - -- Now deal with the function - ; case head of - Just fn_id -> do { sat_app <- maybeSaturate fn_id app depth - ; return (floats, sat_app) } - _other -> return (floats, app) } + ; cpe_app top_env terminal args depth + } where -- We have a nested data structure of the form @@ -702,11 +697,25 @@ cpeApp top_env expr -> CoreExpr -> [CpeArg] -> Int - -> UniqSM (Maybe Id, CpeApp, Floats) + -> UniqSM (Floats, CpeRhs) cpe_app env (Var f) (CpeArg Type{} : CpeArg arg : args) depth | f `hasKey` lazyIdKey -- Replace (lazy a) with a, and || f `hasKey` noinlineIdKey -- Replace (noinline a) with a - = cpe_app env arg args (depth - 1) + -- Consider the code: + -- + -- lazy (f x) y + -- + -- We need to make sure that we need to recursively collect arguments on + -- "f x", otherwise we'll float "f x" out (it's not a variable) and + -- end up with this awful -ddump-prep: + -- + -- case f x of f_x { + -- __DEFAULT -> f_x y + -- } + -- + -- rather than the far superior "f x y". Test case is par01. + = let (terminal, args', depth') = collect_args arg + in cpe_app env terminal (args' ++ args) (depth + depth' - 1) cpe_app env (Var f) [CpeArg _runtimeRep at Type{}, CpeArg _type at Type{}, CpeArg arg] 1 | f `hasKey` runRWKey -- Replace (runRW# f) by (f realWorld#), beta reducing if possible (this @@ -724,7 +733,7 @@ cpeApp top_env expr -- cpe_ExprIsTrivial). But note that we need the type of the -- expression, not the id. ; (app, floats) <- rebuild_app args e2 (exprType e2) emptyFloats stricts - ; return (hd, app, floats) } + ; mb_saturate hd app floats depth } where stricts = case idStrictness v of StrictSig (DmdType _ demands _) @@ -737,16 +746,27 @@ cpeApp top_env expr -- Here, we can't evaluate the arg strictly, because this -- partial application might be seq'd + -- We inlined into something that's not a var and has no args. + -- Bounce it back up to cpeRhsE. + cpe_app env fun [] _ = cpeRhsE env fun + -- N-variable fun, better let-bind it - cpe_app env fun args _ + cpe_app env fun args depth = do { (fun_floats, fun') <- cpeArg env evalDmd fun ty -- The evalDmd says that it's sure to be evaluated, -- so we'll end up case-binding it ; (app, floats) <- rebuild_app args fun' ty fun_floats [] - ; return (Nothing, app, floats) } + ; mb_saturate Nothing app floats depth } where ty = exprType fun + -- Saturate if necessary + mb_saturate head app floats depth = + case head of + Just fn_id -> do { sat_app <- maybeSaturate fn_id app depth + ; return (floats, sat_app) } + _other -> return (floats, app) + -- Deconstruct and rebuild the application, floating any non-atomic -- arguments to the outside. We collect the type of the expression, -- the head of the application, and the number of actual value arguments, diff --git a/testsuite/tests/simplCore/should_compile/all.T b/testsuite/tests/simplCore/should_compile/all.T index 92f9af4..e2e0bb6 100644 --- a/testsuite/tests/simplCore/should_compile/all.T +++ b/testsuite/tests/simplCore/should_compile/all.T @@ -243,3 +243,4 @@ test('T12076sat', normal, compile, ['-O']) test('T12212', normal, compile, ['-O']) test('noinline01', only_ways(['optasm']), compile, ['-ddump-stg -dsuppress-uniques -O']) +test('par01', only_ways(['optasm']), compile, ['-ddump-prep -dsuppress-uniques -O2']) diff --git a/testsuite/tests/simplCore/should_compile/par01.hs b/testsuite/tests/simplCore/should_compile/par01.hs new file mode 100644 index 0000000..e67fb13 --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/par01.hs @@ -0,0 +1,10 @@ +module Par01 where + +import GHC.Conc + +-- The smoking gun in -ddump-prep is: +-- case Par01.depth d of sat { __DEFAULT -> sat } +-- this should never happen! + +depth :: Int -> Int +depth d = d `par` depth d diff --git a/testsuite/tests/simplCore/should_compile/par01.stderr b/testsuite/tests/simplCore/should_compile/par01.stderr new file mode 100644 index 0000000..90d467f --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/par01.stderr @@ -0,0 +1,33 @@ + +==================== CorePrep ==================== +Result size of CorePrep = {terms: 18, types: 8, coercions: 0} + +Rec { +-- RHS size: {terms: 7, types: 3, coercions: 0} +Par01.depth [Occ=LoopBreaker] :: GHC.Types.Int -> GHC.Types.Int +[GblId, Arity=1, Caf=NoCafRefs, Str=, Unf=OtherCon []] +Par01.depth = + \ (d :: GHC.Types.Int) -> + case GHC.Prim.par# @ GHC.Types.Int d of { __DEFAULT -> + Par01.depth d + } +end Rec } + +-- RHS size: {terms: 2, types: 0, coercions: 0} +Par01.$trModule2 :: GHC.Types.TrName +[GblId, Caf=NoCafRefs, Str=m1, Unf=OtherCon []] +Par01.$trModule2 = GHC.Types.TrNameS "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0} +Par01.$trModule1 :: GHC.Types.TrName +[GblId, Caf=NoCafRefs, Str=m1, Unf=OtherCon []] +Par01.$trModule1 = GHC.Types.TrNameS "Par01"# + +-- RHS size: {terms: 3, types: 0, coercions: 0} +Par01.$trModule :: GHC.Types.Module +[GblId, Caf=NoCafRefs, Str=m, Unf=OtherCon []] +Par01.$trModule = + GHC.Types.Module Par01.$trModule2 Par01.$trModule1 + + + From git at git.haskell.org Wed Aug 31 17:19:12 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 31 Aug 2016 17:19:12 +0000 (UTC) Subject: [commit: ghc] master: Tag pointers in interpreted constructors (a25bf26) Message-ID: <20160831171912.C0ECC3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a25bf2673d0f6db5f454619ddf91f974cace4e8b/ghc >--------------------------------------------------------------- commit a25bf2673d0f6db5f454619ddf91f974cace4e8b Author: mniip Date: Tue Aug 30 16:57:47 2016 -0400 Tag pointers in interpreted constructors Instead of stg_interp_constr_entry there are now 7 functions (one for each value of the tag bits) that tag the constructor pointer before returning. This is consistent with compiled constructors' entry code, and expectations that compiled code places on compiled constructors. The iserv protocol is extended with an extra field that explains what pointer tag the constructor should use. Test Plan: Added tests for #12523 Reviewers: erikd, bgamari, hvr, austin, simonmar Reviewed By: simonmar Subscribers: osa1, thomie, rwbarton Differential Revision: https://phabricator.haskell.org/D2473 GHC Trac Issues: #12523 >--------------------------------------------------------------- a25bf2673d0f6db5f454619ddf91f974cace4e8b compiler/ghci/ByteCodeItbls.hs | 4 +++- includes/stg/MiscClosures.h | 8 +++++++- libraries/ghci/GHCi/InfoTable.hsc | 24 ++++++++++++++++++++---- libraries/ghci/GHCi/Message.hs | 5 +++-- libraries/ghci/GHCi/Run.hs | 4 ++-- rts/RtsSymbols.c | 8 +++++++- rts/StgMiscClosures.cmm | 13 ++++++++----- testsuite/tests/ghci/scripts/T12523.hs | 28 ++++++++++++++++++++++++++++ testsuite/tests/ghci/scripts/T12523.script | 18 ++++++++++++++++++ testsuite/tests/ghci/scripts/T12523.stdout | 8 ++++++++ testsuite/tests/ghci/scripts/all.T | 1 + 11 files changed, 105 insertions(+), 16 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 a25bf2673d0f6db5f454619ddf91f974cace4e8b From git at git.haskell.org Wed Aug 31 17:19:15 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 31 Aug 2016 17:19:15 +0000 (UTC) Subject: [commit: ghc] master: Fix handling of package-db entries in .ghc.environment files, etc. (ef784c5) Message-ID: <20160831171915.792E63A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ef784c551ef9b64c3c0b32c73f54bbdb747a8188/ghc >--------------------------------------------------------------- commit ef784c551ef9b64c3c0b32c73f54bbdb747a8188 Author: Duncan Coutts Date: Tue Aug 30 16:59:17 2016 -0400 Fix handling of package-db entries in .ghc.environment files, etc. Previously interpreting the content of the .ghc.env files was done after the step that loaded the available package dbs. This meant that setting the package db flags was ineffective. This patch moves interpreting the env files before loading of the package dbs. Also, the package-db entries refer to files. Allow spaces in these file names. Also treat as comments lines beginning with "--". These are pretty minor fixes in a feature that up 'til now has been essentially unused (witness no bug report about it), so there's very low risk here. If we can get this into 8.0.2 then cabal can start generating the .ghc.environment files, otherwise it cannot as it needs the working package-db entries, to be able to refer to local package dbs in the build tree (or cabal nix store). Test Plan: Manually create example .ghc.env files run ghci; :show packages Done this. It works. Reviewers: austin, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2476 >--------------------------------------------------------------- ef784c551ef9b64c3c0b32c73f54bbdb747a8188 compiler/main/DynFlags.hs | 4 +++- compiler/main/Packages.hs | 7 +++---- 2 files changed, 6 insertions(+), 5 deletions(-) diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index c1ccfcd..4081ac4 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -4410,13 +4410,15 @@ interpretPackageEnv dflags = do parseEnvFile envfile = mapM_ parseEntry . lines where parseEntry str = case words str of - ["package-db", db] -> addPkgConfRef (PkgConfFile (envdir db)) + ("package-db": _) -> addPkgConfRef (PkgConfFile (envdir db)) -- relative package dbs are interpreted relative to the env file where envdir = takeDirectory envfile + db = drop 11 str ["clear-package-db"] -> clearPkgConf ["global-package-db"] -> addPkgConfRef GlobalPkgConf ["user-package-db"] -> addPkgConfRef UserPkgConf ["package-id", pkgid] -> exposePackageId pkgid + (('-':'-':_):_) -> return () -- comments -- and the original syntax introduced in 7.10: [pkgid] -> exposePackageId pkgid [] -> return () diff --git a/compiler/main/Packages.hs b/compiler/main/Packages.hs index ecec982..0c91af2 100644 --- a/compiler/main/Packages.hs +++ b/compiler/main/Packages.hs @@ -339,7 +339,8 @@ listPackageConfigMap dflags = eltsUDFM (pkgIdMap (pkgState dflags)) -- 'pkgState' in 'DynFlags' and return a list of packages to -- link in. initPackages :: DynFlags -> IO (DynFlags, [UnitId]) -initPackages dflags = do +initPackages dflags0 = do + dflags <- interpretPackageEnv dflags0 pkg_db <- case pkgDatabase dflags of Nothing -> readPackageConfigs dflags @@ -879,9 +880,7 @@ mkPackageState UnitId) -- this package, might be modified if the current -- package is a wired-in package. -mkPackageState dflags0 dbs preload0 = do - dflags <- interpretPackageEnv dflags0 - +mkPackageState dflags dbs preload0 = do -- Compute the unit id let this_package = thisPackage dflags From git at git.haskell.org Wed Aug 31 17:19:18 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 31 Aug 2016 17:19:18 +0000 (UTC) Subject: [commit: ghc] master: Fixes #12504: Double-escape paths used to build call to hsc_line (2ee1db6) Message-ID: <20160831171918.A0EBB3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2ee1db60ab29258fa9f8ab820f778bd0bb7f87a4/ghc >--------------------------------------------------------------- commit 2ee1db60ab29258fa9f8ab820f778bd0bb7f87a4 Author: Richard Cook Date: Tue Aug 30 17:00:36 2016 -0400 Fixes #12504: Double-escape paths used to build call to hsc_line In outHsLine, paths passed to construct invocations of hsc_line must be escaped twice in order to generate a properly escaped string literal that will end up in the eventual LINE pragma emitted by this code. This is especially important on Windows paths, where backslashes would otherwise be treated as C escape sequences and result in the incorrect Windows paths. Adds test case to verify that hsc2hs properly escapes file paths in LINE pragmas Updates the hsc2hs submodule. See https://ghc.haskell.org/trac/ghc/ticket/12504 Reviewers: erikd, hvr, austin, bgamari, Phyx Reviewed By: erikd, Phyx Subscribers: thomie, Phyx, mpickering Differential Revision: https://phabricator.haskell.org/D2478 GHC Trac Issues: #12504 >--------------------------------------------------------------- 2ee1db60ab29258fa9f8ab820f778bd0bb7f87a4 testsuite/.gitignore | 1 + testsuite/tests/hsc2hs/Makefile | 11 +++++++++++ testsuite/tests/hsc2hs/T12504.stdout | 2 ++ .../{driver/T11429a.hs => hsc2hs/T12504/path/to/T12504.hsc} | 3 +++ testsuite/tests/hsc2hs/all.T | 6 ++++++ utils/hsc2hs | 2 +- 6 files changed, 24 insertions(+), 1 deletion(-) diff --git a/testsuite/.gitignore b/testsuite/.gitignore index 87e3558..5e3f1c2 100644 --- a/testsuite/.gitignore +++ b/testsuite/.gitignore @@ -790,6 +790,7 @@ mk/ghcconfig*_test___spaces_ghc*.exe.mk /tests/ghci/scripts/ghci027.hs /tests/ghci/should_run/3171.err /tests/hsc2hs/3837.hs +/tests/hsc2hs/T12504/path/to/T12504.hs /tests/hsc2hs/T3837.hs /tests/hsc2hs/hsc2hs001.hs /tests/hsc2hs/hsc2hs002.hs diff --git a/testsuite/tests/hsc2hs/Makefile b/testsuite/tests/hsc2hs/Makefile index 54fa5ad..9b3ee98 100644 --- a/testsuite/tests/hsc2hs/Makefile +++ b/testsuite/tests/hsc2hs/Makefile @@ -40,3 +40,14 @@ T10272: '$(HSC2HS)' --cross-compile $@.hsc '$(TEST_HC)' $(TEST_HC_OPTS) -v0 --make $@ ./$@ + +.PHONY: T12504 +T12504: + '$(HSC2HS)' T12504/path/to/$@.hsc +ifeq "$(WINDOWS)" "YES" + grep '{-# LINE 1 \"T12504\\\\path\\\\to\\\\$@\.hsc\" #-}' T12504/path/to/$@.hs + grep '{-# LINE 2 \"T12504\\\\path\\\\to\\\\$@\.hsc\" #-}' T12504/path/to/$@.hs +else + grep '{-# LINE 1 \"T12504/path/to/$@\.hsc\" #-}' T12504/path/to/$@.hs + grep '{-# LINE 2 \"T12504/path/to/$@\.hsc\" #-}' T12504/path/to/$@.hs +endif diff --git a/testsuite/tests/hsc2hs/T12504.stdout b/testsuite/tests/hsc2hs/T12504.stdout new file mode 100644 index 0000000..c1c05d0 --- /dev/null +++ b/testsuite/tests/hsc2hs/T12504.stdout @@ -0,0 +1,2 @@ +{-# LINE 1 "T12504/path/to/T12504.hsc" #-} +{-# LINE 2 "T12504/path/to/T12504.hsc" #-} diff --git a/testsuite/tests/driver/T11429a.hs b/testsuite/tests/hsc2hs/T12504/path/to/T12504.hsc similarity index 61% copy from testsuite/tests/driver/T11429a.hs copy to testsuite/tests/hsc2hs/T12504/path/to/T12504.hsc index c81fb82..3d05ce0 100644 --- a/testsuite/tests/driver/T11429a.hs +++ b/testsuite/tests/hsc2hs/T12504/path/to/T12504.hsc @@ -1,2 +1,5 @@ +module Main (main) where + main :: IO () main = putStrLn "hello world" + diff --git a/testsuite/tests/hsc2hs/all.T b/testsuite/tests/hsc2hs/all.T index d4fc69d..3f910db 100644 --- a/testsuite/tests/hsc2hs/all.T +++ b/testsuite/tests/hsc2hs/all.T @@ -35,3 +35,9 @@ test('T10272', [extra_clean(['T10272.hs', 'T10272_hsc_make.c'])], run_command, ['$MAKE -s --no-print-directory T10272']) + +test('T12504', + [extra_clean(['T12504/path/to/T12504.hs']), + extra_files(['T12504'])], + run_command, + ['$MAKE -s --no-print-directory T12504']) diff --git a/utils/hsc2hs b/utils/hsc2hs index 5119aeb..f5ae016 160000 --- a/utils/hsc2hs +++ b/utils/hsc2hs @@ -1 +1 @@ -Subproject commit 5119aebacaca75d983b4d7db32a6305b7f8651dd +Subproject commit f5ae016e5a69ebf42d612805e51afd9227df9389 From git at git.haskell.org Wed Aug 31 17:19:21 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 31 Aug 2016 17:19:21 +0000 (UTC) Subject: [commit: ghc] master: users_guide: More capabilities than processors considered harmful (28b71c5) Message-ID: <20160831171921.549D63A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/28b71c55d057b780d92b351498ec611287dedbd4/ghc >--------------------------------------------------------------- commit 28b71c55d057b780d92b351498ec611287dedbd4 Author: Ben Gamari Date: Tue Aug 30 17:05:25 2016 -0400 users_guide: More capabilities than processors considered harmful Test Plan: None. Reviewers: austin, simonmar Reviewed By: simonmar Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2487 >--------------------------------------------------------------- 28b71c55d057b780d92b351498ec611287dedbd4 docs/users_guide/using-concurrent.rst | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/docs/users_guide/using-concurrent.rst b/docs/users_guide/using-concurrent.rst index 8c0587c..d62b811 100644 --- a/docs/users_guide/using-concurrent.rst +++ b/docs/users_guide/using-concurrent.rst @@ -136,7 +136,8 @@ RTS ``-N`` options. Be careful when using all the processors in your machine: if some of your processors are in use by other programs, this can actually harm - performance rather than improve it. + performance rather than improve it. Asking GHC to create more capabilities + than you have physical threads is almost always a bad idea. Setting ``-N`` also has the effect of enabling the parallel garbage collector (see :ref:`rts-options-gc`). From git at git.haskell.org Wed Aug 31 17:19:24 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 31 Aug 2016 17:19:24 +0000 (UTC) Subject: [commit: ghc] master: Bump the default allocation area size to 1MB (d790cb9) Message-ID: <20160831171924.045573A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d790cb9db71693baed70e3de8e9100d5b7d7404b/ghc >--------------------------------------------------------------- commit d790cb9db71693baed70e3de8e9100d5b7d7404b Author: Simon Marlow Date: Tue Aug 30 17:07:36 2016 -0400 Bump the default allocation area size to 1MB This is long overdue. Perhaps 1MB is a little on the skinny size, but this is based on * A lot of commodity dual-core desktop processors have 3MB L3 cache * We're traditionally quite frugal with memory by default Test Plan: validate Reviewers: erikd, bgamari, hvr, austin, rwbarton, ezyang Reviewed By: ezyang Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2496 >--------------------------------------------------------------- d790cb9db71693baed70e3de8e9100d5b7d7404b docs/users_guide/profiling.rst | 2 +- docs/users_guide/runtime_control.rst | 2 +- rts/RtsFlags.c | 2 +- testsuite/tests/perf/should_run/all.T | 10 ++++++---- testsuite/tests/perf/space_leaks/all.T | 3 ++- 5 files changed, 11 insertions(+), 8 deletions(-) diff --git a/docs/users_guide/profiling.rst b/docs/users_guide/profiling.rst index 20f2a83..d3fdd62 100644 --- a/docs/users_guide/profiling.rst +++ b/docs/users_guide/profiling.rst @@ -754,7 +754,7 @@ reasons for this: data into. When using compacting collection (see the :rts-flag:`-c` option), this is reduced to 2L, and can further be reduced by tweaking the :rts-flag:`-F` option. Also add the size of the allocation area - (currently a fixed 512Kb). + (see :rts-flag:`-A`). - The stack isn't counted in the heap profile by default. See the RTS :rts-flag:`-xt` option. diff --git a/docs/users_guide/runtime_control.rst b/docs/users_guide/runtime_control.rst index 3968065..5226d6d 100644 --- a/docs/users_guide/runtime_control.rst +++ b/docs/users_guide/runtime_control.rst @@ -267,7 +267,7 @@ performance. .. rts-flag:: -A ⟨size⟩ - :default: 512k + :default: 1MB .. index:: single: allocation area, size diff --git a/rts/RtsFlags.c b/rts/RtsFlags.c index 7e06d84..92b7e87 100644 --- a/rts/RtsFlags.c +++ b/rts/RtsFlags.c @@ -136,7 +136,7 @@ void initRtsFlagsDefaults(void) RtsFlags.GcFlags.stkChunkSize = (32 * 1024) / sizeof(W_); RtsFlags.GcFlags.stkChunkBufferSize = (1 * 1024) / sizeof(W_); - RtsFlags.GcFlags.minAllocAreaSize = (512 * 1024) / BLOCK_SIZE; + RtsFlags.GcFlags.minAllocAreaSize = (1024 * 1024) / BLOCK_SIZE; RtsFlags.GcFlags.largeAllocLim = 0; /* defaults to minAllocAreasize */ RtsFlags.GcFlags.nurseryChunkSize = 0; RtsFlags.GcFlags.minOldGenSize = (1024 * 1024) / BLOCK_SIZE; diff --git a/testsuite/tests/perf/should_run/all.T b/testsuite/tests/perf/should_run/all.T index 282bb1a..c20807e 100644 --- a/testsuite/tests/perf/should_run/all.T +++ b/testsuite/tests/perf/should_run/all.T @@ -116,8 +116,9 @@ test('T3736', ['$MAKE -s --no-print-directory T3736']) test('T3738', [extra_clean(['T3738a.hi', 'T3738a.o']), - stats_num_field('peak_megabytes_allocated', (1, 0)), - # expected value: 1 (amd64/Linux) + stats_num_field('peak_megabytes_allocated', (2, 0)), + # expected value: 1 (amd64/Linux) + # 2016-08-31: 2 (allocation area size bumped to 1MB) stats_num_field('bytes allocated', [(wordsize(32), 45648, 5), # expected value: 50520 (x86/Linux) @@ -132,8 +133,9 @@ test('T3738', ['-O']) test('MethSharing', - [stats_num_field('peak_megabytes_allocated', (1, 0)), - # expected value: 1 (amd64/Linux) + [stats_num_field('peak_megabytes_allocated', (2, 0)), + # expected value: 1 (amd64/Linux) + # 2016-08-31: 2 (allocation area size bumped to 1MB) stats_num_field('bytes allocated', [(wordsize(32), 360940756, 5), # expected value: 2685858140 (x86/OS X) diff --git a/testsuite/tests/perf/space_leaks/all.T b/testsuite/tests/perf/space_leaks/all.T index 9d0661f..c6b1d92 100644 --- a/testsuite/tests/perf/space_leaks/all.T +++ b/testsuite/tests/perf/space_leaks/all.T @@ -46,7 +46,8 @@ test('T4334', test('T2762', [# peak_megabytes_allocated is 2 with 7.0.2. # Was 57 with 6.12.3. - stats_num_field('peak_megabytes_allocated', (2, 0)), + # 2016-08-31: 3 (allocation area size bumped to 1MB) + stats_num_field('peak_megabytes_allocated', (3, 0)), only_ways(['normal']), extra_clean(['T2762A.hi', 'T2762A.o'])], compile_and_run, ['-O']) From git at git.haskell.org Wed Aug 31 17:19:26 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 31 Aug 2016 17:19:26 +0000 (UTC) Subject: [commit: ghc] master: StgCmmPrim: Add missing MO_WriteBarrier (d40d6df) Message-ID: <20160831171926.AE8283A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d40d6df74a9fca382a84709ac9bc862897fbec18/ghc >--------------------------------------------------------------- commit d40d6df74a9fca382a84709ac9bc862897fbec18 Author: Ben Gamari Date: Tue Aug 30 17:08:05 2016 -0400 StgCmmPrim: Add missing MO_WriteBarrier Test Plan: Good question Reviewers: austin, trommler, simonmar, rrnewton Reviewed By: simonmar Subscribers: RyanGlScott, thomie Differential Revision: https://phabricator.haskell.org/D2495 GHC Trac Issues: #12469 >--------------------------------------------------------------- d40d6df74a9fca382a84709ac9bc862897fbec18 compiler/codeGen/StgCmmPrim.hs | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/compiler/codeGen/StgCmmPrim.hs b/compiler/codeGen/StgCmmPrim.hs index d3c09c5..2169465 100644 --- a/compiler/codeGen/StgCmmPrim.hs +++ b/compiler/codeGen/StgCmmPrim.hs @@ -308,8 +308,11 @@ emitPrimOp _ [res] GetCurrentCCSOp [_dummy_arg] emitPrimOp dflags [res] ReadMutVarOp [mutv] = emitAssign (CmmLocal res) (cmmLoadIndexW dflags mutv (fixedHdrSizeW dflags) (gcWord dflags)) -emitPrimOp dflags [] WriteMutVarOp [mutv,var] - = do emitStore (cmmOffsetW dflags mutv (fixedHdrSizeW dflags)) var +emitPrimOp dflags res@[] WriteMutVarOp [mutv,var] + = do -- Without this write barrier, other CPUs may see this pointer before + -- the writes for the closure it points to have occurred. + emitPrimCall res MO_WriteBarrier [] + emitStore (cmmOffsetW dflags mutv (fixedHdrSizeW dflags)) var emitCCall [{-no results-}] (CmmLit (CmmLabel mkDirty_MUT_VAR_Label)) From git at git.haskell.org Wed Aug 31 17:19:29 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 31 Aug 2016 17:19:29 +0000 (UTC) Subject: [commit: ghc] master: GHC: Expose installSignalHandlers, withCleanupSession (0e74925) Message-ID: <20160831171929.6A5453A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/0e7492508cefbcabb4cf1398cfb3669edb72db77/ghc >--------------------------------------------------------------- commit 0e7492508cefbcabb4cf1398cfb3669edb72db77 Author: Ben Gamari Date: Tue Aug 30 17:05:43 2016 -0400 GHC: Expose installSignalHandlers, withCleanupSession Test Plan: Validate Reviewers: austin, simonmar Reviewed By: simonmar Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2492 GHC Trac Issues: #12398 >--------------------------------------------------------------- 0e7492508cefbcabb4cf1398cfb3669edb72db77 compiler/main/GHC.hs | 7 +++++-- docs/users_guide/8.2.1-notes.rst | 5 ++++- 2 files changed, 9 insertions(+), 3 deletions(-) diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs index 9dc6853..6a3887a 100644 --- a/compiler/main/GHC.hs +++ b/compiler/main/GHC.hs @@ -13,6 +13,8 @@ module GHC ( defaultErrorHandler, defaultCleanupHandler, prettyPrintGhcErrors, + installSignalHandlers, + withCleanupSession, -- * GHC Monad Ghc, GhcT, GhcMonad(..), HscEnv, @@ -437,6 +439,7 @@ runGhc mb_top_dir ghc = do ref <- newIORef (panic "empty session") let session = Session ref flip unGhc session $ do + liftIO installSignalHandlers -- catch ^C initGhcMonad mb_top_dir withCleanupSession ghc @@ -456,6 +459,7 @@ runGhcT mb_top_dir ghct = do ref <- liftIO $ newIORef (panic "empty session") let session = Session ref flip unGhcT session $ do + liftIO installSignalHandlers -- catch ^C initGhcMonad mb_top_dir withCleanupSession ghct @@ -490,8 +494,7 @@ withCleanupSession ghc = ghc `gfinally` cleanup initGhcMonad :: GhcMonad m => Maybe FilePath -> m () initGhcMonad mb_top_dir = do { env <- liftIO $ - do { installSignalHandlers -- catch ^C - ; initStaticOpts + do { initStaticOpts ; mySettings <- initSysTools mb_top_dir ; dflags <- initDynFlags (defaultDynFlags mySettings) ; checkBrokenTablesNextToCode dflags diff --git a/docs/users_guide/8.2.1-notes.rst b/docs/users_guide/8.2.1-notes.rst index c50990f..bb31d95 100644 --- a/docs/users_guide/8.2.1-notes.rst +++ b/docs/users_guide/8.2.1-notes.rst @@ -149,7 +149,10 @@ filepath ghc ~~~ -- TODO FIXME. +- The ``GHC.initGhcMonad`` function no longer installs signal handlers by + default. This means that the RTS won't attempt to handle Ctrl-C gracefully. + If you would like to use GHC's signal handlers, call + ``GHC.installSignalHandlers`` during initialization. ghc-boot ~~~~~~~~ From git at git.haskell.org Wed Aug 31 17:19:32 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 31 Aug 2016 17:19:32 +0000 (UTC) Subject: [commit: ghc] master: Clarify scope of `getQ`/`putQ` state. (d1f2239) Message-ID: <20160831171932.3C8C93A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d1f22396eec4be0a2101de6b7f7b780792acc0a9/ghc >--------------------------------------------------------------- commit d1f22396eec4be0a2101de6b7f7b780792acc0a9 Author: Francesco Mazzoli Date: Tue Aug 30 17:09:16 2016 -0400 Clarify scope of `getQ`/`putQ` state. The current haddocks do not specify the scope of the state manipulated by `getQ`/`putQ`. Reviewers: austin, goldfire, bgamari, ezyang Reviewed By: ezyang Subscribers: ezyang, thomie Differential Revision: https://phabricator.haskell.org/D2497 >--------------------------------------------------------------- d1f22396eec4be0a2101de6b7f7b780792acc0a9 libraries/template-haskell/Language/Haskell/TH/Syntax.hs | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs index 690ab98..1129239 100644 --- a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs +++ b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs @@ -465,11 +465,13 @@ addTopDecls ds = Q (qAddTopDecls ds) addModFinalizer :: Q () -> Q () addModFinalizer act = Q (qAddModFinalizer (unQ act)) --- | Get state from the 'Q' monad. +-- | Get state from the 'Q' monad. Note that the state is local to the +-- Haskell module in which the Template Haskell expression is executed. getQ :: Typeable a => Q (Maybe a) getQ = Q qGetQ --- | Replace the state in the 'Q' monad. +-- | Replace the state in the 'Q' monad. Note that the state is local to the +-- Haskell module in which the Template Haskell expression is executed. putQ :: Typeable a => a -> Q () putQ x = Q (qPutQ x) From git at git.haskell.org Wed Aug 31 17:19:35 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 31 Aug 2016 17:19:35 +0000 (UTC) Subject: [commit: ghc] master: iserv: Show usage message on argument parse failure (3005fa5) Message-ID: <20160831171935.0BBC63A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3005fa5313b6d5fd9d4f47192c84e96e94ee7f17/ghc >--------------------------------------------------------------- commit 3005fa5313b6d5fd9d4f47192c84e96e94ee7f17 Author: Ben Gamari Date: Tue Aug 30 17:06:08 2016 -0400 iserv: Show usage message on argument parse failure Test Plan: validate Reviewers: simonmar, erikd, austin Reviewed By: simonmar, erikd Subscribers: thomie, erikd Differential Revision: https://phabricator.haskell.org/D2494 GHC Trac Issues: #12491 >--------------------------------------------------------------- 3005fa5313b6d5fd9d4f47192c84e96e94ee7f17 iserv/iserv-bin.cabal | 4 +++- iserv/src/Main.hs | 26 ++++++++++++++++++++++---- 2 files changed, 25 insertions(+), 5 deletions(-) diff --git a/iserv/iserv-bin.cabal b/iserv/iserv-bin.cabal index 3fd5d2b..eb33277 100644 --- a/iserv/iserv-bin.cabal +++ b/iserv/iserv-bin.cabal @@ -26,5 +26,7 @@ Executable iserv deepseq >= 1.4 && < 1.5, ghci == 8.1 - if !os(windows) + if os(windows) + Cpp-Options: -DWINDOWS + else Build-Depends: unix >= 2.7 && < 2.8 diff --git a/iserv/src/Main.hs b/iserv/src/Main.hs index 66e15c9..8c76e1f 100644 --- a/iserv/src/Main.hs +++ b/iserv/src/Main.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE RecordWildCards, GADTs, ScopedTypeVariables, RankNTypes #-} +{-# LANGUAGE CPP, RecordWildCards, GADTs, ScopedTypeVariables, RankNTypes #-} -- | -- The Remote GHCi server. @@ -23,14 +23,32 @@ import System.Environment import System.Exit import Text.Printf +dieWithUsage :: IO a +dieWithUsage = do + prog <- getProgName + die $ prog ++ ": " ++ msg + where +#ifdef WINDOWS + msg = "usage: iserv [-v]" +#else + msg = "usage: iserv [-v]" +#endif + main :: IO () main = do - (arg0:arg1:rest) <- getArgs - let wfd1 = read arg0; rfd2 = read arg1 + args <- getArgs + (wfd1, rfd2, rest) <- + case args of + arg0:arg1:rest -> do + let wfd1 = read arg0 + rfd2 = read arg1 + return (wfd1, rfd2, rest) + _ -> dieWithUsage + verbose <- case rest of ["-v"] -> return True [] -> return False - _ -> die "iserv: syntax: iserv [-v]" + _ -> dieWithUsage when verbose $ do printf "GHC iserv starting (in: %d; out: %d)\n" (fromIntegral rfd2 :: Int) (fromIntegral wfd1 :: Int) From git at git.haskell.org Wed Aug 31 18:29:22 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 31 Aug 2016 18:29:22 +0000 (UTC) Subject: [commit: ghc] master: testsuite: Failing testcase for #12091 (22259c1) Message-ID: <20160831182922.B33443A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/22259c17c5e3043e5fa5b354f339f9b0d66167db/ghc >--------------------------------------------------------------- commit 22259c17c5e3043e5fa5b354f339f9b0d66167db Author: Ben Gamari Date: Wed Aug 31 13:49:24 2016 -0400 testsuite: Failing testcase for #12091 Just as it says on the can Test Plan: validate Reviewers: austin Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2489 GHC Trac Issues: #12091 >--------------------------------------------------------------- 22259c17c5e3043e5fa5b354f339f9b0d66167db testsuite/tests/ghci/scripts/T12091.script | 2 ++ testsuite/tests/ghci/scripts/T12091.stdout | 1 + testsuite/tests/ghci/scripts/all.T | 3 +++ 3 files changed, 6 insertions(+) diff --git a/testsuite/tests/ghci/scripts/T12091.script b/testsuite/tests/ghci/scripts/T12091.script new file mode 100644 index 0000000..247a1ed --- /dev/null +++ b/testsuite/tests/ghci/scripts/T12091.script @@ -0,0 +1,2 @@ +x = 5 +x \ No newline at end of file diff --git a/testsuite/tests/ghci/scripts/T12091.stdout b/testsuite/tests/ghci/scripts/T12091.stdout new file mode 100644 index 0000000..7813681 --- /dev/null +++ b/testsuite/tests/ghci/scripts/T12091.stdout @@ -0,0 +1 @@ +5 \ No newline at end of file diff --git a/testsuite/tests/ghci/scripts/all.T b/testsuite/tests/ghci/scripts/all.T index 9c791e3..9e36567 100755 --- a/testsuite/tests/ghci/scripts/all.T +++ b/testsuite/tests/ghci/scripts/all.T @@ -259,4 +259,7 @@ test('T12007', normal, ghci_script, ['T12007.script']) test('T11975', normal, ghci_script, ['T11975.script']) test('T10963', normal, ghci_script, ['T10963.script']) test('T12520', normal, ghci_script, ['T12520.script']) +test('T12091', + [expect_broken(12091), extra_run_opts('-fobject-code')], + ghci_script, ['T12091.script']) test('T12523', normal, ghci_script, ['T12523.script']) From git at git.haskell.org Wed Aug 31 18:29:25 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 31 Aug 2016 18:29:25 +0000 (UTC) Subject: [commit: ghc] master: ErrUtils: Expose accessors of ErrDoc and ErrMsg (2d22026) Message-ID: <20160831182925.6FF103A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2d220263f6e5f49139f5571b7a5bc1649cb9ac8c/ghc >--------------------------------------------------------------- commit 2d220263f6e5f49139f5571b7a5bc1649cb9ac8c Author: Ben Gamari Date: Wed Aug 31 13:50:30 2016 -0400 ErrUtils: Expose accessors of ErrDoc and ErrMsg Test Plan: Validate Reviewers: austin Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2491 GHC Trac Issues: #12206 >--------------------------------------------------------------- 2d220263f6e5f49139f5571b7a5bc1649cb9ac8c compiler/main/ErrUtils.hs | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/compiler/main/ErrUtils.hs b/compiler/main/ErrUtils.hs index 21fd7e8..9a4c7fc 100644 --- a/compiler/main/ErrUtils.hs +++ b/compiler/main/ErrUtils.hs @@ -13,7 +13,9 @@ module ErrUtils ( Severity(..), -- * Messages - MsgDoc, ErrMsg, ErrDoc, errDoc, WarnMsg, + ErrMsg, errMsgDoc, + ErrDoc, errDoc, errDocImportant, errDocContext, errDocSupplementary, + WarnMsg, MsgDoc, Messages, ErrorMessages, WarningMessages, unionMessages, errMsgSpan, errMsgContext, @@ -22,6 +24,7 @@ module ErrUtils ( -- ** Formatting pprMessageBag, pprErrMsgBagWithLoc, pprLocErrMsg, printBagOfErrors, + formatErrDoc, -- ** Construction emptyMessages, mkLocMessage, mkLocMessageAnn, makeIntoWarning, @@ -123,11 +126,11 @@ data ErrMsg = ErrMsg { -- from. data ErrDoc = ErrDoc { -- | Primary error msg. - errDocImportant :: [MsgDoc], + errDocImportant :: [MsgDoc], -- | Context e.g. \"In the second argument of ...\". - _errDocContext :: [MsgDoc], + errDocContext :: [MsgDoc], -- | Supplementary information, e.g. \"Relevant bindings include ...\". - _errDocSupplementary :: [MsgDoc] + errDocSupplementary :: [MsgDoc] } errDoc :: [MsgDoc] -> [MsgDoc] -> [MsgDoc] -> ErrDoc From git at git.haskell.org Wed Aug 31 18:29:29 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 31 Aug 2016 18:29:29 +0000 (UTC) Subject: [commit: ghc] master: A failing testcase for T12485 (a07a3ff) Message-ID: <20160831182929.50FAD3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a07a3ffa3efda6f7ebe68841e15ef89ac0d313b1/ghc >--------------------------------------------------------------- commit a07a3ffa3efda6f7ebe68841e15ef89ac0d313b1 Author: Bartosz Nitka Date: Wed Aug 31 13:52:35 2016 -0400 A failing testcase for T12485 Test Plan: it's just a testcase Reviewers: ezyang, simonmar, bgamari, austin Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2450 GHC Trac Issues: #12485 >--------------------------------------------------------------- a07a3ffa3efda6f7ebe68841e15ef89ac0d313b1 testsuite/driver/extra_files.py | 1 + testsuite/tests/{module/T7765.hs => cabal/T12485/Main.hs} | 1 + testsuite/tests/cabal/T12485/Makefile | 14 ++++++++++++++ .../cabal/{cabal08/cabal08.stdout => T12485/T12485.stdout} | 4 ++-- testsuite/tests/cabal/T12485/a.pkg | 6 ++++++ testsuite/tests/cabal/T12485/all.T | 5 +++++ testsuite/tests/cabal/T12485/b.pkg | 5 +++++ 7 files changed, 34 insertions(+), 2 deletions(-) diff --git a/testsuite/driver/extra_files.py b/testsuite/driver/extra_files.py index acf4802..f1dbcb5 100644 --- a/testsuite/driver/extra_files.py +++ b/testsuite/driver/extra_files.py @@ -84,6 +84,7 @@ extra_src_files = { 'T11827': ['A.hs', 'A.hs-boot', 'B.hs'], 'T12062': ['A.hs', 'A.hs-boot', 'C.hs'], 'T12035j': ['T12035.hs', 'T12035a.hs', 'T12035.hs-boot'], + 'T12485': ['a.pkg', 'b.pkg', 'Main.hs'], 'T1372': ['p1/', 'p2/'], 'T1407': ['A.c'], 'T1959': ['B.hs', 'C.hs', 'D.hs', 'E1.hs', 'E2.hs'], diff --git a/testsuite/tests/module/T7765.hs b/testsuite/tests/cabal/T12485/Main.hs similarity index 60% copy from testsuite/tests/module/T7765.hs copy to testsuite/tests/cabal/T12485/Main.hs index 6ca9a1f..3894aba 100644 --- a/testsuite/tests/module/T7765.hs +++ b/testsuite/tests/cabal/T12485/Main.hs @@ -1 +1,2 @@ module Main where +main = main diff --git a/testsuite/tests/cabal/T12485/Makefile b/testsuite/tests/cabal/T12485/Makefile new file mode 100644 index 0000000..fc8e992 --- /dev/null +++ b/testsuite/tests/cabal/T12485/Makefile @@ -0,0 +1,14 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +T12485 : + @rm -rf a.db b.db + '$(GHC_PKG)' init a.db + '$(GHC_PKG)' -f a.db register a.pkg + '$(GHC_PKG)' init b.db + '$(GHC_PKG)' -f a.db/ -f b.db/ register b.pkg # register b.pkg in b.db + # -package-db in dependency order + '$(TEST_HC)' -XNoImplicitPrelude -fforce-recomp -hide-all-packages -no-user-package-db -package-db a.db -package-db b.db -package-id a-1-XXX -package-id b-1-XXX Main.hs + # -package-db in reverse dependency order + '$(TEST_HC)' -XNoImplicitPrelude -fforce-recomp -hide-all-packages -no-user-package-db -package-db b.db -package-db a.db -package-id a-1-XXX -package-id b-1-XXX Main.hs diff --git a/testsuite/tests/cabal/cabal08/cabal08.stdout b/testsuite/tests/cabal/T12485/T12485.stdout similarity index 62% copy from testsuite/tests/cabal/cabal08/cabal08.stdout copy to testsuite/tests/cabal/T12485/T12485.stdout index 8f97cd4..aefbf38 100644 --- a/testsuite/tests/cabal/cabal08/cabal08.stdout +++ b/testsuite/tests/cabal/T12485/T12485.stdout @@ -1,6 +1,6 @@ +Reading package info from "a.pkg" ... done. +Reading package info from "b.pkg" ... done. [1 of 1] Compiling Main ( Main.hs, Main.o ) Linking Main ... -p2 [1 of 1] Compiling Main ( Main.hs, Main.o ) Linking Main ... -p2 diff --git a/testsuite/tests/cabal/T12485/a.pkg b/testsuite/tests/cabal/T12485/a.pkg new file mode 100644 index 0000000..fdf9bf6 --- /dev/null +++ b/testsuite/tests/cabal/T12485/a.pkg @@ -0,0 +1,6 @@ +name: a +version: 1 +id: a-1-XXX +key: a-1-XXX +abi: aaa +depends: diff --git a/testsuite/tests/cabal/T12485/all.T b/testsuite/tests/cabal/T12485/all.T new file mode 100644 index 0000000..63f6d6a --- /dev/null +++ b/testsuite/tests/cabal/T12485/all.T @@ -0,0 +1,5 @@ +test('T12485', + [extra_clean(['a.db', 'b.db', 'Main.o', 'Main', 'Main.hi']), + expect_broken(12485)], + run_command, + ['$MAKE -s --no-print-directory T12485']) diff --git a/testsuite/tests/cabal/T12485/b.pkg b/testsuite/tests/cabal/T12485/b.pkg new file mode 100644 index 0000000..f9ad852 --- /dev/null +++ b/testsuite/tests/cabal/T12485/b.pkg @@ -0,0 +1,5 @@ +name: b +version: 1 +id: b-1-XXX +key: b-1-XXX +depends: a-1-XXX From git at git.haskell.org Wed Aug 31 18:29:32 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 31 Aug 2016 18:29:32 +0000 (UTC) Subject: [commit: ghc] master: TysWiredIn: Use dataConWorkerUnique instead of incrUnique (9306db0) Message-ID: <20160831182932.1C8643A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9306db051ff5835b453d55f32783d081ac79ec28/ghc >--------------------------------------------------------------- commit 9306db051ff5835b453d55f32783d081ac79ec28 Author: Ben Gamari Date: Wed Aug 31 13:53:04 2016 -0400 TysWiredIn: Use dataConWorkerUnique instead of incrUnique Test Plan: Validate Reviewers: austin Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2465 >--------------------------------------------------------------- 9306db051ff5835b453d55f32783d081ac79ec28 compiler/basicTypes/Unique.hs | 1 - compiler/prelude/TysWiredIn.hs | 4 ++-- 2 files changed, 2 insertions(+), 3 deletions(-) diff --git a/compiler/basicTypes/Unique.hs b/compiler/basicTypes/Unique.hs index 0bbf861..c933d61 100644 --- a/compiler/basicTypes/Unique.hs +++ b/compiler/basicTypes/Unique.hs @@ -31,7 +31,6 @@ module Unique ( getKey, -- Used in Var, UniqFM, Name only! mkUnique, unpkUnique, -- Used in BinIface only - incrUnique, -- Used for renumbering deriveUnique, -- Ditto newTagUnique, -- Used in CgCase initTyVarUnique, diff --git a/compiler/prelude/TysWiredIn.hs b/compiler/prelude/TysWiredIn.hs index 1028478..b334967 100644 --- a/compiler/prelude/TysWiredIn.hs +++ b/compiler/prelude/TysWiredIn.hs @@ -489,7 +489,7 @@ pcDataConWithFixity :: Bool -- ^ declared infix? -> [Type] -- ^ args -> TyCon -> DataCon -pcDataConWithFixity infx n = pcDataConWithFixity' infx n (incrUnique (nameUnique n)) +pcDataConWithFixity infx n = pcDataConWithFixity' infx n (dataConWorkerUnique (nameUnique n)) NoRRI -- The Name's unique is the first of two free uniques; -- the first is used for the datacon itself, @@ -535,7 +535,7 @@ pcDataConWithFixity' declared_infix dc_name wrk_key rri tyvars ex_tyvars arg_tys -- used for RuntimeRep and friends pcSpecialDataCon :: Name -> [Type] -> TyCon -> RuntimeRepInfo -> DataCon pcSpecialDataCon dc_name arg_tys tycon rri - = pcDataConWithFixity' False dc_name (incrUnique (nameUnique dc_name)) rri + = pcDataConWithFixity' False dc_name (dataConWorkerUnique (nameUnique dc_name)) rri [] [] arg_tys tycon {- From git at git.haskell.org Wed Aug 31 19:01:20 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 31 Aug 2016 19:01:20 +0000 (UTC) Subject: [commit: ghc] master: Add Read1/Read2 methods defined in terms of ReadPrec (9cfef16) Message-ID: <20160831190120.0386B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9cfef167dc0b2bfa881c5d9eca38227fbdfd507c/ghc >--------------------------------------------------------------- commit 9cfef167dc0b2bfa881c5d9eca38227fbdfd507c Author: Ryan Scott Date: Wed Aug 31 14:30:57 2016 -0400 Add Read1/Read2 methods defined in terms of ReadPrec This adds new methods `liftReadList(2)` and `liftReadListPrec(2)` to the `Read1`/`Read2` classes which are defined in terms of `ReadPrec` instead of `ReadS`. This also adds related combinators and changes existing `Read1` and `Read2` instances to be defined in terms of the new methods. Reviewers: hvr, austin, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2379 GHC Trac Issues: #12358 >--------------------------------------------------------------- 9cfef167dc0b2bfa881c5d9eca38227fbdfd507c docs/users_guide/8.2.1-notes.rst | 6 + docs/users_guide/bugs.rst | 10 + libraries/base/Data/Functor/Classes.hs | 364 ++++++++++++++++++++++++++++----- libraries/base/Data/Functor/Compose.hs | 17 +- libraries/base/Data/Functor/Product.hs | 13 +- libraries/base/Data/Functor/Sum.hs | 17 +- libraries/base/GHC/Read.hs | 25 +++ libraries/base/changelog.md | 5 + 8 files changed, 396 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 9cfef167dc0b2bfa881c5d9eca38227fbdfd507c From git at git.haskell.org Wed Aug 31 19:01:22 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 31 Aug 2016 19:01:22 +0000 (UTC) Subject: [commit: ghc] master: Add -flocal-ghci-history flag (#9089). (1ad770f) Message-ID: <20160831190122.BAAE23A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1ad770f599a00e8f8919f7fcf4cf00800fd4d9ed/ghc >--------------------------------------------------------------- commit 1ad770f599a00e8f8919f7fcf4cf00800fd4d9ed Author: Eugene Akentyev Date: Wed Aug 31 14:31:39 2016 -0400 Add -flocal-ghci-history flag (#9089). Reviewers: thomie, bgamari, austin Reviewed By: thomie, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2461 GHC Trac Issues: #9089 >--------------------------------------------------------------- 1ad770f599a00e8f8919f7fcf4cf00800fd4d9ed compiler/main/DynFlags.hs | 3 +++ docs/users_guide/8.2.1-notes.rst | 2 ++ docs/users_guide/ghci.rst | 11 +++++++++++ ghc/GHCi/UI.hs | 14 ++++++++++---- utils/mkUserGuidePart/Options/Misc.hs | 7 +++++++ 5 files changed, 33 insertions(+), 4 deletions(-) diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 4081ac4..17386ab 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -476,6 +476,7 @@ data GeneralFlag | Opt_IgnoreDotGhci | Opt_GhciSandbox | Opt_GhciHistory + | Opt_LocalGhciHistory | Opt_HelpfulErrors | Opt_DeferTypeErrors | Opt_DeferTypedHoles @@ -3381,6 +3382,7 @@ fFlagsDeps = [ flagSpec "fun-to-thunk" Opt_FunToThunk, flagSpec "gen-manifest" Opt_GenManifest, flagSpec "ghci-history" Opt_GhciHistory, + flagGhciSpec "local-ghci-history" Opt_LocalGhciHistory, flagSpec "ghci-sandbox" Opt_GhciSandbox, flagSpec "helpful-errors" Opt_HelpfulErrors, flagSpec "hpc" Opt_Hpc, @@ -3668,6 +3670,7 @@ defaultFlags settings Opt_FlatCache, Opt_GenManifest, Opt_GhciHistory, + Opt_LocalGhciHistory, Opt_GhciSandbox, Opt_HelpfulErrors, Opt_KeepHiFiles, diff --git a/docs/users_guide/8.2.1-notes.rst b/docs/users_guide/8.2.1-notes.rst index fdd8f5c..1b4b34e 100644 --- a/docs/users_guide/8.2.1-notes.rst +++ b/docs/users_guide/8.2.1-notes.rst @@ -43,6 +43,8 @@ GHCi - TODO FIXME. +- Added :ghc-flag:`-flocal-ghci-history` which uses current directory for `.ghci-history`. + Template Haskell ~~~~~~~~~~~~~~~~ diff --git a/docs/users_guide/ghci.rst b/docs/users_guide/ghci.rst index 783059f..468f39e 100644 --- a/docs/users_guide/ghci.rst +++ b/docs/users_guide/ghci.rst @@ -1901,6 +1901,17 @@ Most of the command-line options accepted by GHC (see :ref:`using-ghc`) also make sense in interactive mode. The ones that don't make sense are mostly obvious. +.. ghc-flag:: -flocal-ghci-history + + By default, GHCi keeps global history in ``~/.ghc/ghci_history`` or + ``%APPDATA%//ghci_history``, but you can use current directory, e.g.: + + .. code-block:: none + + $ ghci -flocal-ghci-history + + It will create ``.ghci-history`` in current folder where GHCi is launched. + Packages ~~~~~~~~ diff --git a/ghc/GHCi/UI.hs b/ghc/GHCi/UI.hs index 1e27c7a..e3a56d6 100644 --- a/ghc/GHCi/UI.hs +++ b/ghc/GHCi/UI.hs @@ -613,10 +613,16 @@ runGHCi paths maybe_exprs = do runGHCiInput :: InputT GHCi a -> GHCi a runGHCiInput f = do dflags <- getDynFlags - histFile <- if gopt Opt_GhciHistory dflags - then liftIO $ withGhcAppData (\dir -> return (Just (dir "ghci_history"))) - (return Nothing) - else return Nothing + let ghciHistory = gopt Opt_GhciHistory dflags + let localGhciHistory = gopt Opt_LocalGhciHistory dflags + currentDirectory <- liftIO $ getCurrentDirectory + + histFile <- case (ghciHistory, localGhciHistory) of + (True, True) -> return (Just (currentDirectory ".ghci_history")) + (True, _) -> liftIO $ withGhcAppData + (\dir -> return (Just (dir "ghci_history"))) (return Nothing) + _ -> return Nothing + runInputT (setComplete ghciCompleteWord $ defaultSettings {historyFile = histFile}) f diff --git a/utils/mkUserGuidePart/Options/Misc.hs b/utils/mkUserGuidePart/Options/Misc.hs index 0bb504a..57e8808 100644 --- a/utils/mkUserGuidePart/Options/Misc.hs +++ b/utils/mkUserGuidePart/Options/Misc.hs @@ -36,4 +36,11 @@ miscOptions = , flagType = DynamicFlag , flagReverse = "-fno-reverse-errors" } + , flag { flagName = "-flocal-ghci-history" + , flagDescription = + "Use current directory for the GHCi command history "++ + "file ``.ghci-history``." + , flagType = DynamicFlag + , flagReverse = "-fno-local-ghci-history" + } ] From git at git.haskell.org Wed Aug 31 19:56:23 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 31 Aug 2016 19:56:23 +0000 (UTC) Subject: [commit: ghc] master: PPC NCG: Implement minimal stack frame header. (010b07a) Message-ID: <20160831195623.938893A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/010b07aae082cb6b1f2a5db3deecc5997f6d9a6d/ghc >--------------------------------------------------------------- commit 010b07aae082cb6b1f2a5db3deecc5997f6d9a6d Author: Peter Trommler Date: Wed Aug 31 15:18:06 2016 -0400 PPC NCG: Implement minimal stack frame header. According to the ABI specifications a minimal stack frame consists of a header and a minimum size parameter save area. We reserve the minimal size for each ABI. On PowerPC 64-bil Linux and AIX the parameter save area can accomodate up to eight parameters. So calls with eight parameters and fewer can be done without allocating a new stack frame and deallocating that stack frame after the call. On AIX one additional spill slot is available on the stack. Code size for all nofib benchmarks is 0.3 % smaller on powerpc64. Test Plan: validate on AIX Reviewers: hvr!, erikd, austin, simonmar, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2445 >--------------------------------------------------------------- 010b07aae082cb6b1f2a5db3deecc5997f6d9a6d compiler/nativeGen/PPC/CodeGen.hs | 5 +++-- compiler/nativeGen/PPC/Instr.hs | 30 ++++++++++++++++++++++++------ 2 files changed, 27 insertions(+), 8 deletions(-) diff --git a/compiler/nativeGen/PPC/CodeGen.hs b/compiler/nativeGen/PPC/CodeGen.hs index 1b719fc..d03a6e5 100644 --- a/compiler/nativeGen/PPC/CodeGen.hs +++ b/compiler/nativeGen/PPC/CodeGen.hs @@ -1286,14 +1286,15 @@ genCCall' dflags gcp target dest_regs args spFormat = if target32Bit platform then II32 else II64 + -- TODO: Do not create a new stack frame if delta is too large. move_sp_down finalStack - | delta > 64 = + | delta > stackFrameHeaderSize dflags = toOL [STU spFormat sp (AddrRegImm sp (ImmInt (-delta))), DELTA (-delta)] | otherwise = nilOL where delta = stackDelta finalStack move_sp_up finalStack - | delta > 64 = -- TODO: fix-up stack back-chain + | delta > stackFrameHeaderSize dflags = toOL [ADD sp sp (RIImm (ImmInt delta)), DELTA 0] | otherwise = nilOL diff --git a/compiler/nativeGen/PPC/Instr.hs b/compiler/nativeGen/PPC/Instr.hs index 23d8b6b..5dc0325 100644 --- a/compiler/nativeGen/PPC/Instr.hs +++ b/compiler/nativeGen/PPC/Instr.hs @@ -15,6 +15,7 @@ module PPC.Instr ( archWordFormat, RI(..), Instr(..), + stackFrameHeaderSize, maxSpillSlots, allocMoreStack, makeFarBranches @@ -508,7 +509,7 @@ ppc_mkSpillInstr ppc_mkSpillInstr dflags reg delta slot = let platform = targetPlatform dflags - off = spillSlotToOffset slot + off = spillSlotToOffset dflags slot arch = platformArch platform in let fmt = case targetClassOfReg platform reg of @@ -533,7 +534,7 @@ ppc_mkLoadInstr ppc_mkLoadInstr dflags reg delta slot = let platform = targetPlatform dflags - off = spillSlotToOffset slot + off = spillSlotToOffset dflags slot arch = platformArch platform in let fmt = case targetClassOfReg platform reg of @@ -549,6 +550,22 @@ ppc_mkLoadInstr dflags reg delta slot in instr fmt reg (AddrRegImm sp (ImmInt (off-delta))) +-- | The size of a minimal stackframe header including minimal +-- parameter save area. +stackFrameHeaderSize :: DynFlags -> Int +stackFrameHeaderSize dflags + = case platformOS platform of + OSLinux -> case platformArch platform of + -- header + parameter save area + ArchPPC -> 64 -- TODO: check ABI spec + ArchPPC_64 ELF_V1 -> 48 + 8 * 8 + ArchPPC_64 ELF_V2 -> 32 + 8 * 8 + _ -> panic "PPC.stackFrameHeaderSize: Unknown Linux" + OSAIX -> 24 + 8 * 4 + OSDarwin -> 64 -- TODO: check ABI spec + _ -> panic "PPC.stackFrameHeaderSize: not defined for this OS" + where platform = targetPlatform dflags + -- | The maximum number of bytes required to spill a register. PPC32 -- has 32-bit GPRs and 64-bit FPRs, while PPC64 has 64-bit GPRs and -- 64-bit FPRs. So the maximum is 8 regardless of platforms unlike @@ -560,7 +577,8 @@ spillSlotSize = 8 -- | The number of spill slots available without allocating more. maxSpillSlots :: DynFlags -> Int maxSpillSlots dflags - = ((rESERVED_C_STACK_BYTES dflags - 64) `div` spillSlotSize) - 1 + = ((rESERVED_C_STACK_BYTES dflags - stackFrameHeaderSize dflags) + `div` spillSlotSize) - 1 -- = 0 -- useful for testing allocMoreStack -- | The number of bytes that the stack pointer should be aligned @@ -570,9 +588,9 @@ stackAlign :: Int stackAlign = 16 -- | Convert a spill slot number to a *byte* offset, with no sign. -spillSlotToOffset :: Int -> Int -spillSlotToOffset slot - = 64 + spillSlotSize * slot +spillSlotToOffset :: DynFlags -> Int -> Int +spillSlotToOffset dflags slot + = stackFrameHeaderSize dflags + spillSlotSize * slot -------------------------------------------------------------------------------- From git at git.haskell.org Wed Aug 31 20:35:13 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 31 Aug 2016 20:35:13 +0000 (UTC) Subject: [commit: ghc] master: testsuite: Update bytes allocated of parsing001 (ca6d0eb) Message-ID: <20160831203513.988363A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ca6d0eb0f7d28b0245abc2b0783141101e51945f/ghc >--------------------------------------------------------------- commit ca6d0eb0f7d28b0245abc2b0783141101e51945f Author: Ben Gamari Date: Wed Aug 31 16:16:25 2016 -0400 testsuite: Update bytes allocated of parsing001 Sadly I don't know precisely which commit regressed this, but it was quite recent. I'm not sure how this wasn't caught by my test builds. >--------------------------------------------------------------- ca6d0eb0f7d28b0245abc2b0783141101e51945f testsuite/tests/perf/compiler/all.T | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T index 3c8cbda..0ecc7c2 100644 --- a/testsuite/tests/perf/compiler/all.T +++ b/testsuite/tests/perf/compiler/all.T @@ -428,8 +428,9 @@ test('T5631', test('parsing001', [compiler_stats_num_field('bytes allocated', [(wordsize(32), 274000576, 10), - (wordsize(64), 587079016, 5)]), + (wordsize(64), 682266448, 5)]), # expected value: 587079016 (amd64/Linux) + # 2016-08-31: 682266448 (amd64/Linux) only_ways(['normal']), ], compile_fail, ['']) From git at git.haskell.org Wed Aug 31 20:35:17 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 31 Aug 2016 20:35:17 +0000 (UTC) Subject: [commit: ghc] master: Add -fdefer-out-of-scope-variables flag (#12170). (75321ff) Message-ID: <20160831203517.805753A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/75321ffa25ad377fa200485a7d58ad32a87e7d65/ghc >--------------------------------------------------------------- commit 75321ffa25ad377fa200485a7d58ad32a87e7d65 Author: Eugene Akentyev Date: Wed Aug 31 16:02:10 2016 -0400 Add -fdefer-out-of-scope-variables flag (#12170). Reviewers: simonpj, thomie, austin, bgamari Reviewed By: simonpj, thomie, bgamari Subscribers: simonpj, thomie Differential Revision: https://phabricator.haskell.org/D2458 GHC Trac Issues: #12170 >--------------------------------------------------------------- 75321ffa25ad377fa200485a7d58ad32a87e7d65 compiler/main/DynFlags.hs | 7 ++++ compiler/typecheck/TcErrors.hs | 40 +++++++++++++++++----- docs/users_guide/8.2.1-notes.rst | 3 ++ docs/users_guide/glasgow_exts.rst | 25 +++++++++----- docs/users_guide/using-warnings.rst | 13 ++++++- .../tests/typecheck/should_compile/T12170b.hs | 5 +++ .../tests/typecheck/should_compile/T12170b.stderr | 3 ++ testsuite/tests/typecheck/should_compile/all.T | 1 + .../should_fail/{T12406.hs => T12170a.hs} | 4 +-- .../should_fail/{T12406.stderr => T12170a.stderr} | 5 +-- testsuite/tests/typecheck/should_fail/all.T | 1 + utils/mkUserGuidePart/Options/Warnings.hs | 20 ++++++++++- 12 files changed, 102 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 75321ffa25ad377fa200485a7d58ad32a87e7d65 From git at git.haskell.org Wed Aug 31 20:35:20 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 31 Aug 2016 20:35:20 +0000 (UTC) Subject: [commit: ghc] master: Remove redundant-constraints from -Wall (#10635) (e9b0bf4) Message-ID: <20160831203520.AA0413A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e9b0bf4ed52114852dbaf6af556514610a895f88/ghc >--------------------------------------------------------------- commit e9b0bf4ed52114852dbaf6af556514610a895f88 Author: Adam C. Foltzer Date: Wed Aug 31 16:02:53 2016 -0400 Remove redundant-constraints from -Wall (#10635) Removes -Wredundant-constraints from -Wall, as per the discussion in #10635. Reviewers: austin, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2498 GHC Trac Issues: #10635 >--------------------------------------------------------------- e9b0bf4ed52114852dbaf6af556514610a895f88 compiler/main/DynFlags.hs | 3 +-- testsuite/tests/typecheck/should_compile/T10632.hs | 1 + testsuite/tests/typecheck/should_compile/T10632.stderr | 2 +- testsuite/tests/typecheck/should_compile/{T9939.hs => T10635.hs} | 1 - testsuite/tests/typecheck/should_compile/T9939.hs | 1 + testsuite/tests/typecheck/should_compile/T9939.stderr | 8 ++++---- testsuite/tests/typecheck/should_compile/all.T | 1 + testsuite/tests/warnings/should_compile/PluralS.stderr | 4 ++-- 8 files changed, 11 insertions(+), 10 deletions(-) diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 065a732..fa471d3 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -3958,8 +3958,7 @@ minusWallOpts Opt_WarnUnusedDoBind, Opt_WarnTrustworthySafe, Opt_WarnUntickedPromotedConstructors, - Opt_WarnMissingPatternSynonymSignatures, - Opt_WarnRedundantConstraints + Opt_WarnMissingPatternSynonymSignatures ] -- | Things you get with -Weverything, i.e. *all* known warnings flags diff --git a/testsuite/tests/typecheck/should_compile/T10632.hs b/testsuite/tests/typecheck/should_compile/T10632.hs index 5c1a177..03478fc 100644 --- a/testsuite/tests/typecheck/should_compile/T10632.hs +++ b/testsuite/tests/typecheck/should_compile/T10632.hs @@ -1,4 +1,5 @@ {-# LANGUAGE ImplicitParams #-} +{-# OPTIONS_GHC -Wredundant-constraints #-} f :: (?file1 :: String) => IO () f = putStrLn $ "f2: " diff --git a/testsuite/tests/typecheck/should_compile/T10632.stderr b/testsuite/tests/typecheck/should_compile/T10632.stderr index c3d112f..1733f0a 100644 --- a/testsuite/tests/typecheck/should_compile/T10632.stderr +++ b/testsuite/tests/typecheck/should_compile/T10632.stderr @@ -1,5 +1,5 @@ -T10632.hs:3:1: warning: [-Wredundant-constraints (in -Wall)] +T10632.hs:4:1: warning: [-Wredundant-constraints] • Redundant constraint: ?file1::String • In the type signature for: f :: (?file1::String) => IO () diff --git a/testsuite/tests/typecheck/should_compile/T9939.hs b/testsuite/tests/typecheck/should_compile/T10635.hs similarity index 99% copy from testsuite/tests/typecheck/should_compile/T9939.hs copy to testsuite/tests/typecheck/should_compile/T10635.hs index 4ae370b..1382466 100644 --- a/testsuite/tests/typecheck/should_compile/T9939.hs +++ b/testsuite/tests/typecheck/should_compile/T10635.hs @@ -20,4 +20,3 @@ data Equal a b where f4 :: (Eq a, Eq b) => a -> b -> Equal a b -> Bool -- Eq b redundant f4 x y EQUAL = y==y - diff --git a/testsuite/tests/typecheck/should_compile/T9939.hs b/testsuite/tests/typecheck/should_compile/T9939.hs index 4ae370b..3ceab51 100644 --- a/testsuite/tests/typecheck/should_compile/T9939.hs +++ b/testsuite/tests/typecheck/should_compile/T9939.hs @@ -1,4 +1,5 @@ {-# LANGUAGE GADTs #-} +{-# OPTIONS_GHC -Wredundant-constraints #-} module T9939 where diff --git a/testsuite/tests/typecheck/should_compile/T9939.stderr b/testsuite/tests/typecheck/should_compile/T9939.stderr index d10c510..c486679 100644 --- a/testsuite/tests/typecheck/should_compile/T9939.stderr +++ b/testsuite/tests/typecheck/should_compile/T9939.stderr @@ -1,20 +1,20 @@ -T9939.hs:5:1: warning: [-Wredundant-constraints (in -Wall)] +T9939.hs:6:1: warning: [-Wredundant-constraints] • Redundant constraint: Eq a • In the type signature for: f1 :: (Eq a, Ord a) => a -> a -> Bool -T9939.hs:9:1: warning: [-Wredundant-constraints (in -Wall)] +T9939.hs:10:1: warning: [-Wredundant-constraints] • Redundant constraint: Eq a • In the type signature for: f2 :: (Eq a, Ord a) => a -> a -> Bool -T9939.hs:13:1: warning: [-Wredundant-constraints (in -Wall)] +T9939.hs:14:1: warning: [-Wredundant-constraints] • Redundant constraint: Eq b • In the type signature for: f3 :: (Eq a, a ~ b, Eq b) => a -> b -> Bool -T9939.hs:20:1: warning: [-Wredundant-constraints (in -Wall)] +T9939.hs:21:1: warning: [-Wredundant-constraints] • Redundant constraint: Eq a • In the type signature for: f4 :: (Eq a, Eq b) => a -> b -> Equal a b -> Bool diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index 4bebf97..b9f452d 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -537,4 +537,5 @@ test('T12185', normal, compile, ['']) test('T12133', normal, compile, ['']) test('T12381', normal, compile, ['']) test('T12082', normal, compile, ['']) +test('T10635', normal, compile, ['']) test('T12170b', normal, compile, ['']) diff --git a/testsuite/tests/warnings/should_compile/PluralS.stderr b/testsuite/tests/warnings/should_compile/PluralS.stderr index b1ceab6..416ebb8 100644 --- a/testsuite/tests/warnings/should_compile/PluralS.stderr +++ b/testsuite/tests/warnings/should_compile/PluralS.stderr @@ -14,12 +14,12 @@ PluralS.hs:17:24: warning: [-Wtype-defaults (in -Wall)] In an equation for ‘defaultingNumAndShow’: defaultingNumAndShow = show 123 -PluralS.hs:23:1: warning: [-Wredundant-constraints (in -Wall)] +PluralS.hs:23:1: warning: [-Wredundant-constraints] • Redundant constraint: Num a • In the type signature for: redundantNum :: (Num a, Num a) => a -PluralS.hs:26:1: warning: [-Wredundant-constraints (in -Wall)] +PluralS.hs:26:1: warning: [-Wredundant-constraints] • Redundant constraints: (Show a, Num a, Eq a, Eq a) • In the type signature for: redundantMultiple :: (Num a, Show a, Num a, Eq a, Eq a) => a From git at git.haskell.org Wed Aug 31 20:35:23 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 31 Aug 2016 20:35:23 +0000 (UTC) Subject: [commit: ghc] master: RnExpr: Fix ApplicativeDo desugaring with RebindableSyntax (043604c) Message-ID: <20160831203523.EA6AA3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/043604c7232adb698d5008a46d3f29d532acd12d/ghc >--------------------------------------------------------------- commit 043604c7232adb698d5008a46d3f29d532acd12d Author: Ben Gamari Date: Wed Aug 31 16:03:33 2016 -0400 RnExpr: Fix ApplicativeDo desugaring with RebindableSyntax We need to compare against the local return and pure, not returnMName and pureAName. Fixes #12490. Test Plan: Validate, add testcase Reviewers: austin, simonmar Reviewed By: simonmar Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2499 GHC Trac Issues: #12490 >--------------------------------------------------------------- 043604c7232adb698d5008a46d3f29d532acd12d compiler/rename/RnEnv.hs | 13 +++++++++- compiler/rename/RnExpr.hs | 55 +++++++++++++++++++++++++++---------------- testsuite/tests/ado/T12490.hs | 30 +++++++++++++++++++++++ testsuite/tests/ado/all.T | 1 + 4 files changed, 78 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 043604c7232adb698d5008a46d3f29d532acd12d From git at git.haskell.org Wed Aug 31 20:35:26 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 31 Aug 2016 20:35:26 +0000 (UTC) Subject: [commit: ghc] master: LoadIFace: Show known names on inconsistent interface file (dad6a88) Message-ID: <20160831203526.9C82F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/dad6a886802ec4e69104972428fabc75c79a634a/ghc >--------------------------------------------------------------- commit dad6a886802ec4e69104972428fabc75c79a634a Author: Ben Gamari Date: Wed Aug 31 16:04:11 2016 -0400 LoadIFace: Show known names on inconsistent interface file Reviewers: austin Subscribers: simonpj, ezyang, thomie Differential Revision: https://phabricator.haskell.org/D2466 >--------------------------------------------------------------- dad6a886802ec4e69104972428fabc75c79a634a compiler/iface/LoadIface.hs | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/compiler/iface/LoadIface.hs b/compiler/iface/LoadIface.hs index ad5f7d3..c5c3538 100644 --- a/compiler/iface/LoadIface.hs +++ b/compiler/iface/LoadIface.hs @@ -138,7 +138,7 @@ importDecl name { eps <- getEps ; case lookupTypeEnv (eps_PTE eps) name of Just thing -> return (Succeeded thing) - Nothing -> return (Failed not_found_msg) + Nothing -> return $ Failed (ifPprDebug (found_things_msg eps) $$ not_found_msg) }}} where nd_doc = text "Need decl for" <+> ppr name @@ -146,6 +146,11 @@ importDecl name pprNameSpace (occNameSpace (nameOccName name)) <+> ppr name) 2 (vcat [text "Probable cause: bug in .hi-boot file, or inconsistent .hi file", text "Use -ddump-if-trace to get an idea of which file caused the error"]) + found_things_msg eps = + hang (text "Found the following declarations in" <+> ppr (nameModule name) <> colon) + 2 (vcat (map ppr $ filter is_interesting $ nameEnvElts $ eps_PTE eps)) + where + is_interesting thing = nameModule name == nameModule (getName thing) {- From git at git.haskell.org Wed Aug 31 23:23:30 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 31 Aug 2016 23:23:30 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: users_guide: Add 8.0.2 release notes (5af7f19) Message-ID: <20160831232330.239233A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/5af7f197751f039a7cdaf0b0d4123fc9710e1d8b/ghc >--------------------------------------------------------------- commit 5af7f197751f039a7cdaf0b0d4123fc9710e1d8b Author: Ben Gamari Date: Wed Aug 31 16:42:53 2016 -0400 users_guide: Add 8.0.2 release notes >--------------------------------------------------------------- 5af7f197751f039a7cdaf0b0d4123fc9710e1d8b docs/users_guide/8.0.2-notes.rst | 29 +++++++++++++++++++++++++++++ docs/users_guide/index.rst | 1 + 2 files changed, 30 insertions(+) diff --git a/docs/users_guide/8.0.2-notes.rst b/docs/users_guide/8.0.2-notes.rst new file mode 100644 index 0000000..a86050c --- /dev/null +++ b/docs/users_guide/8.0.2-notes.rst @@ -0,0 +1,29 @@ +.. _release-8-0-2: + +Release notes for version 8.0.2 +=============================== + +TODO FIXME + +Highlights +---------- + +TODO FIXME. + +Full details +------------ + +Language +~~~~~~~~ + +- TODO FIXME. + +Compiler +~~~~~~~~ + +- TODO FIXME. + +Template Haskell +~~~~~~~~~~~~~~~~ + +- TODO FIXME. diff --git a/docs/users_guide/index.rst b/docs/users_guide/index.rst index 60f8c9a..b50913d 100644 --- a/docs/users_guide/index.rst +++ b/docs/users_guide/index.rst @@ -13,6 +13,7 @@ Contents: license intro 8.0.1-notes + 8.0.2-notes ghci runghc usage From git at git.haskell.org Wed Aug 31 23:23:32 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 31 Aug 2016 23:23:32 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: StgCmmPrim: Add missing MO_WriteBarrier (7053019) Message-ID: <20160831232332.C521E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/7053019e7b04842dd7364039381d8c4c069489a2/ghc >--------------------------------------------------------------- commit 7053019e7b04842dd7364039381d8c4c069489a2 Author: Ben Gamari Date: Tue Aug 30 17:08:05 2016 -0400 StgCmmPrim: Add missing MO_WriteBarrier Test Plan: Good question Reviewers: austin, trommler, simonmar, rrnewton Reviewed By: simonmar Subscribers: RyanGlScott, thomie Differential Revision: https://phabricator.haskell.org/D2495 GHC Trac Issues: #12469 (cherry picked from commit d40d6df74a9fca382a84709ac9bc862897fbec18) >--------------------------------------------------------------- 7053019e7b04842dd7364039381d8c4c069489a2 compiler/codeGen/StgCmmPrim.hs | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/compiler/codeGen/StgCmmPrim.hs b/compiler/codeGen/StgCmmPrim.hs index 5d3b94f..3cb9f83 100644 --- a/compiler/codeGen/StgCmmPrim.hs +++ b/compiler/codeGen/StgCmmPrim.hs @@ -310,8 +310,11 @@ emitPrimOp _ [res] GetCurrentCCSOp [_dummy_arg] emitPrimOp dflags [res] ReadMutVarOp [mutv] = emitAssign (CmmLocal res) (cmmLoadIndexW dflags mutv (fixedHdrSizeW dflags) (gcWord dflags)) -emitPrimOp dflags [] WriteMutVarOp [mutv,var] - = do emitStore (cmmOffsetW dflags mutv (fixedHdrSizeW dflags)) var +emitPrimOp dflags res@[] WriteMutVarOp [mutv,var] + = do -- Without this write barrier, other CPUs may see this pointer before + -- the writes for the closure it points to have occurred. + emitPrimCall res MO_WriteBarrier [] + emitStore (cmmOffsetW dflags mutv (fixedHdrSizeW dflags)) var emitCCall [{-no results-}] (CmmLit (CmmLabel mkDirty_MUT_VAR_Label)) From git at git.haskell.org Wed Aug 31 23:23:35 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 31 Aug 2016 23:23:35 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Clarify scope of `getQ`/`putQ` state. (730809f) Message-ID: <20160831232335.886173A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/730809f018bb6fb8f6c14a6da3f4d78b395f9ccb/ghc >--------------------------------------------------------------- commit 730809f018bb6fb8f6c14a6da3f4d78b395f9ccb Author: Francesco Mazzoli Date: Tue Aug 30 17:09:16 2016 -0400 Clarify scope of `getQ`/`putQ` state. The current haddocks do not specify the scope of the state manipulated by `getQ`/`putQ`. Reviewers: austin, goldfire, bgamari, ezyang Reviewed By: ezyang Subscribers: ezyang, thomie Differential Revision: https://phabricator.haskell.org/D2497 (cherry picked from commit d1f22396eec4be0a2101de6b7f7b780792acc0a9) >--------------------------------------------------------------- 730809f018bb6fb8f6c14a6da3f4d78b395f9ccb libraries/template-haskell/Language/Haskell/TH/Syntax.hs | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs index 5b35127..ec6e1ca 100644 --- a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs +++ b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs @@ -478,11 +478,13 @@ addTopDecls ds = Q (qAddTopDecls ds) addModFinalizer :: Q () -> Q () addModFinalizer act = Q (qAddModFinalizer (unQ act)) --- | Get state from the 'Q' monad. +-- | Get state from the 'Q' monad. Note that the state is local to the +-- Haskell module in which the Template Haskell expression is executed. getQ :: Typeable a => Q (Maybe a) getQ = Q qGetQ --- | Replace the state in the 'Q' monad. +-- | Replace the state in the 'Q' monad. Note that the state is local to the +-- Haskell module in which the Template Haskell expression is executed. putQ :: Typeable a => a -> Q () putQ x = Q (qPutQ x) From git at git.haskell.org Wed Aug 31 23:23:38 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 31 Aug 2016 23:23:38 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: users_guide: More capabilities than processors considered harmful (10ba4f0) Message-ID: <20160831232338.326343A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/10ba4f0a40dbf5f6bc47abd9ff294901ad222538/ghc >--------------------------------------------------------------- commit 10ba4f0a40dbf5f6bc47abd9ff294901ad222538 Author: Ben Gamari Date: Tue Aug 30 17:05:25 2016 -0400 users_guide: More capabilities than processors considered harmful Test Plan: None. Reviewers: austin, simonmar Reviewed By: simonmar Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2487 (cherry picked from commit 28b71c55d057b780d92b351498ec611287dedbd4) >--------------------------------------------------------------- 10ba4f0a40dbf5f6bc47abd9ff294901ad222538 docs/users_guide/using-concurrent.rst | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/docs/users_guide/using-concurrent.rst b/docs/users_guide/using-concurrent.rst index c5179c7..676d094 100644 --- a/docs/users_guide/using-concurrent.rst +++ b/docs/users_guide/using-concurrent.rst @@ -136,7 +136,8 @@ RTS ``-N`` options. Be careful when using all the processors in your machine: if some of your processors are in use by other programs, this can actually harm - performance rather than improve it. + performance rather than improve it. Asking GHC to create more capabilities + than you have physical threads is almost always a bad idea. Setting ``-N`` also has the effect of enabling the parallel garbage collector (see :ref:`rts-options-gc`). From git at git.haskell.org Wed Aug 31 23:23:40 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 31 Aug 2016 23:23:40 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Fix handling of package-db entries in .ghc.environment files, etc. (b688f00) Message-ID: <20160831232340.DB97C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/b688f0056a1694bb0db3ca2b84ab5505ba9947d7/ghc >--------------------------------------------------------------- commit b688f0056a1694bb0db3ca2b84ab5505ba9947d7 Author: Duncan Coutts Date: Tue Aug 30 16:59:17 2016 -0400 Fix handling of package-db entries in .ghc.environment files, etc. Previously interpreting the content of the .ghc.env files was done after the step that loaded the available package dbs. This meant that setting the package db flags was ineffective. This patch moves interpreting the env files before loading of the package dbs. Also, the package-db entries refer to files. Allow spaces in these file names. Also treat as comments lines beginning with "--". These are pretty minor fixes in a feature that up 'til now has been essentially unused (witness no bug report about it), so there's very low risk here. If we can get this into 8.0.2 then cabal can start generating the .ghc.environment files, otherwise it cannot as it needs the working package-db entries, to be able to refer to local package dbs in the build tree (or cabal nix store). Test Plan: Manually create example .ghc.env files run ghci; :show packages Done this. It works. Reviewers: austin, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2476 (cherry picked from commit ef784c551ef9b64c3c0b32c73f54bbdb747a8188) >--------------------------------------------------------------- b688f0056a1694bb0db3ca2b84ab5505ba9947d7 compiler/main/DynFlags.hs | 4 +++- compiler/main/Packages.hs | 7 +++---- 2 files changed, 6 insertions(+), 5 deletions(-) diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 7582e11..09522ab 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -4359,13 +4359,15 @@ interpretPackageEnv dflags = do parseEnvFile envfile = mapM_ parseEntry . lines where parseEntry str = case words str of - ["package-db", db] -> addPkgConfRef (PkgConfFile (envdir db)) + ("package-db": _) -> addPkgConfRef (PkgConfFile (envdir db)) -- relative package dbs are interpreted relative to the env file where envdir = takeDirectory envfile + db = drop 11 str ["clear-package-db"] -> clearPkgConf ["global-package-db"] -> addPkgConfRef GlobalPkgConf ["user-package-db"] -> addPkgConfRef UserPkgConf ["package-id", pkgid] -> exposePackageId pkgid + (('-':'-':_):_) -> return () -- comments -- and the original syntax introduced in 7.10: [pkgid] -> exposePackageId pkgid [] -> return () diff --git a/compiler/main/Packages.hs b/compiler/main/Packages.hs index 4a09ce6..eca0890 100644 --- a/compiler/main/Packages.hs +++ b/compiler/main/Packages.hs @@ -342,7 +342,8 @@ listPackageConfigMap dflags = eltsUDFM (pkgIdMap (pkgState dflags)) -- 'pkgState' in 'DynFlags' and return a list of packages to -- link in. initPackages :: DynFlags -> IO (DynFlags, [UnitId]) -initPackages dflags = do +initPackages dflags0 = do + dflags <- interpretPackageEnv dflags0 pkg_db <- case pkgDatabase dflags of Nothing -> readPackageConfigs dflags @@ -884,9 +885,7 @@ mkPackageState UnitId) -- this package, might be modified if the current -- package is a wired-in package. -mkPackageState dflags0 dbs preload0 = do - dflags <- interpretPackageEnv dflags0 - +mkPackageState dflags dbs preload0 = do -- Compute the unit id let this_package = thisPackage dflags From git at git.haskell.org Wed Aug 31 23:23:43 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 31 Aug 2016 23:23:43 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: iserv: Show usage message on argument parse failure (aa6da11) Message-ID: <20160831232343.D26C23A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/aa6da1174b6f6f52aff9cae5a8492aa3cd0ecdb4/ghc >--------------------------------------------------------------- commit aa6da1174b6f6f52aff9cae5a8492aa3cd0ecdb4 Author: Ben Gamari Date: Tue Aug 30 17:06:08 2016 -0400 iserv: Show usage message on argument parse failure Test Plan: validate Reviewers: simonmar, erikd, austin Reviewed By: simonmar, erikd Subscribers: thomie, erikd Differential Revision: https://phabricator.haskell.org/D2494 GHC Trac Issues: #12491 (cherry picked from commit 3005fa5313b6d5fd9d4f47192c84e96e94ee7f17) >--------------------------------------------------------------- aa6da1174b6f6f52aff9cae5a8492aa3cd0ecdb4 iserv/iserv-bin.cabal | 4 +++- iserv/src/Main.hs | 26 ++++++++++++++++++++++---- 2 files changed, 25 insertions(+), 5 deletions(-) diff --git a/iserv/iserv-bin.cabal b/iserv/iserv-bin.cabal index e0bc843..61f6e04 100644 --- a/iserv/iserv-bin.cabal +++ b/iserv/iserv-bin.cabal @@ -26,5 +26,7 @@ Executable iserv deepseq >= 1.4 && < 1.5, ghci >= 7.11 && < 8.1 - if !os(windows) + if os(windows) + Cpp-Options: -DWINDOWS + else Build-Depends: unix >= 2.7 && < 2.8 diff --git a/iserv/src/Main.hs b/iserv/src/Main.hs index 3595999..5b13e7e 100644 --- a/iserv/src/Main.hs +++ b/iserv/src/Main.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE RecordWildCards, GADTs, ScopedTypeVariables, RankNTypes #-} +{-# LANGUAGE CPP, RecordWildCards, GADTs, ScopedTypeVariables, RankNTypes #-} module Main (main) where import GHCi.Run @@ -16,14 +16,32 @@ import System.Environment import System.Exit import Text.Printf +dieWithUsage :: IO a +dieWithUsage = do + prog <- getProgName + die $ prog ++ ": " ++ msg + where +#ifdef WINDOWS + msg = "usage: iserv [-v]" +#else + msg = "usage: iserv [-v]" +#endif + main :: IO () main = do - (arg0:arg1:rest) <- getArgs - let wfd1 = read arg0; rfd2 = read arg1 + args <- getArgs + (wfd1, rfd2, rest) <- + case args of + arg0:arg1:rest -> do + let wfd1 = read arg0 + rfd2 = read arg1 + return (wfd1, rfd2, rest) + _ -> dieWithUsage + verbose <- case rest of ["-v"] -> return True [] -> return False - _ -> die "iserv: syntax: iserv [-v]" + _ -> dieWithUsage when verbose $ do printf "GHC iserv starting (in: %d; out: %d)\n" (fromIntegral rfd2 :: Int) (fromIntegral wfd1 :: Int) From git at git.haskell.org Wed Aug 31 23:23:46 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 31 Aug 2016 23:23:46 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Fix aggressive cleanup of T1407 (5a6f4ac) Message-ID: <20160831232346.944793A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/5a6f4ac9874cffbf396e444cc29d60ed1d214b14/ghc >--------------------------------------------------------------- commit 5a6f4ac9874cffbf396e444cc29d60ed1d214b14 Author: Tamar Christina Date: Sun May 1 17:25:48 2016 +0200 Fix aggressive cleanup of T1407 Summary: The aggressive cleanup routine of T1407 is removing files that don't belong to it. Constrain the test to only removing files it should by putting all it's generated binaries in it's own output folder. Test Plan: make test -C testsuite/tests/ghci/linking/dyn Reviewers: austin, bgamari Reviewed By: bgamari Subscribers: thomie, #ghc_windows_task_force Differential Revision: https://phabricator.haskell.org/D2165 GHC Trac Issues: #1407 (cherry picked from commit e6627d1f8964807f19f8773f09cfaacae7ca8ab8) >--------------------------------------------------------------- 5a6f4ac9874cffbf396e444cc29d60ed1d214b14 testsuite/tests/ghci/linking/dyn/Makefile | 22 +++++++++++++++++----- testsuite/tests/ghci/linking/dyn/all.T | 6 +++--- 2 files changed, 20 insertions(+), 8 deletions(-) diff --git a/testsuite/tests/ghci/linking/dyn/Makefile b/testsuite/tests/ghci/linking/dyn/Makefile index b37fdea..38721dd 100644 --- a/testsuite/tests/ghci/linking/dyn/Makefile +++ b/testsuite/tests/ghci/linking/dyn/Makefile @@ -26,6 +26,16 @@ endif MY_TEST_HC_OPTS = $(filter-out -rtsopts,$(TEST_HC_OPTS)) $(CFLAGS) +# -------------------------------------------------------------- +# Note: libAS.def is not used directly in these tests but is +# included for completeness. libAS.def is the input to +# the Microsoft tool "lib.exe" that can be used to +# create the import libraries using the short format +# that the `compile_libAS_impl_msvc' target uses. +# +# See #11072 +# -------------------------------------------------------------- + .PHONY: load_short_name load_short_name: rm -rf bin_short @@ -34,10 +44,12 @@ load_short_name: rm -f bin_short/*.a echo ":q" | "$(TEST_HC)" --interactive -ignore-dot-ghci -L"./bin_short" -lA -v0 -.PHONY: compile_libAS -compile_libAS: - '$(TEST_HC)' $(MY_TEST_HC_OPTS) -shared A.c -o $(call DLL,AS) - rm -f libAS*.a +.PHONY: compile_libT1407 +compile_libT1407: + rm -rf T1407dir + mkdir T1407dir + '$(TEST_HC)' $(MY_TEST_HC_OPTS) -odir "T1407dir" -shared A.c -o "T1407dir/$(call DLL,AS)" + rm -f T1407dir/libAS*.a .PHONY: compile_libT10458 compile_libT10458: @@ -82,7 +94,7 @@ compile_libAS_impl_msvc: .PHONY: T1407 T1407: - cat T1407.script | LD_LIBRARY_PATH=. "$(TEST_HC)" $(TEST_HC_OPTS) -ignore-dot-ghci -v0 --interactive -L. + cat T1407.script | LD_LIBRARY_PATH=. "$(TEST_HC)" $(TEST_HC_OPTS) -ignore-dot-ghci -v0 --interactive -L"T1407dir" .PHONY: T3242 echo ":q" | '$(TEST_HC)' $(TEST_HC_OPTS) --interactive -ignore-dot-ghci -v0 -lm diff --git a/testsuite/tests/ghci/linking/dyn/all.T b/testsuite/tests/ghci/linking/dyn/all.T index d54c84e..b8ef670 100644 --- a/testsuite/tests/ghci/linking/dyn/all.T +++ b/testsuite/tests/ghci/linking/dyn/all.T @@ -6,9 +6,9 @@ test('load_short_name', test('T1407', [unless(doing_ghci, skip), - extra_clean(['libAS.*']), - pre_cmd('$MAKE -s --no-print-directory compile_libAS'), - extra_hc_opts('-L.')], + extra_clean(['T1407dir/libAS.*']), + pre_cmd('$MAKE -s --no-print-directory compile_libT1407'), + extra_hc_opts('-L$PWD/T1407dir')], run_command, ['$MAKE --no-print-directory -s T1407']) test('T3242', From git at git.haskell.org Wed Aug 31 23:23:49 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 31 Aug 2016 23:23:49 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Fix Windows build after Ticky changes (644f68c) Message-ID: <20160831232349.40F8B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/644f68c5774df5e0070a777aa8b31a0aea1f8e56/ghc >--------------------------------------------------------------- commit 644f68c5774df5e0070a777aa8b31a0aea1f8e56 Author: Tamar Christina Date: Sat May 21 11:31:58 2016 +0200 Fix Windows build after Ticky changes Summary: Replace hardcoded ld with FMT_Int for StgInt types. Test Plan: ./validate Reviewers: austin, bgamari, simonmar, erikd Reviewed By: erikd Subscribers: thomie, #ghc_windows_task_force Differential Revision: https://phabricator.haskell.org/D2249 (cherry picked from commit ae7e9cb574801954c7769c210829b06193fa72ea) >--------------------------------------------------------------- 644f68c5774df5e0070a777aa8b31a0aea1f8e56 rts/Ticky.c | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/rts/Ticky.c b/rts/Ticky.c index cb3651d..b854e9e 100644 --- a/rts/Ticky.c +++ b/rts/Ticky.c @@ -135,19 +135,19 @@ PrintTickyInfo(void) PC(INTAVG(tot_returns_of_new,tot_returns))); - fprintf(tf, "\nRET_NEW: %11ld: ", RET_NEW_ctr); + fprintf(tf, "\nRET_NEW: %11" FMT_Int ": ", RET_NEW_ctr); for (i = 0; i < TICKY_BIN_COUNT; i++) { fprintf(tf, "%5.1f%%", PC(INTAVG(RET_NEW_hst[i], RET_NEW_ctr))); } fprintf(tf, "\n"); - fprintf(tf, "RET_OLD: %11ld: ", RET_OLD_ctr); + fprintf(tf, "RET_OLD: %11" FMT_Int ": ", RET_OLD_ctr); for (i = 0; i < TICKY_BIN_COUNT; i++) { fprintf(tf, "%5.1f%%", PC(INTAVG(RET_OLD_hst[i], RET_OLD_ctr))); } fprintf(tf, "\n"); - fprintf(tf, "RET_UNBOXED_TUP: %11ld: ", RET_UNBOXED_TUP_ctr); + fprintf(tf, "RET_UNBOXED_TUP: %11" FMT_Int ": ", RET_UNBOXED_TUP_ctr); for (i = 0; i < TICKY_BIN_COUNT; i++) { fprintf(tf, "%5.1f%%", PC(INTAVG(RET_UNBOXED_TUP_hst[i], RET_UNBOXED_TUP_ctr))); @@ -311,7 +311,7 @@ PrintTickyInfo(void) PR_CTR(RET_UNBOXED_TUP_ctr); #define PR_HST_BINS(hst) for (i = 0; i < TICKY_BIN_COUNT; i++) \ - { fprintf(tf,"%11ld " #hst "_%lu\n", hst[i], i); } + { fprintf(tf,"%11" FMT_Int " " #hst "_%lu\n", hst[i], i); } PR_HST_BINS(RET_NEW_hst); PR_HST_BINS(RET_OLD_hst); From git at git.haskell.org Wed Aug 31 23:23:51 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 31 Aug 2016 23:23:51 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Fix failures of T12031 (3308b30) Message-ID: <20160831232351.E3C623A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/3308b30be6a5eef71039923e94f11d9809671ca2/ghc >--------------------------------------------------------------- commit 3308b30be6a5eef71039923e94f11d9809671ca2 Author: Ben Gamari Date: Wed Aug 31 14:12:06 2016 -0400 Fix failures of T12031 TEST_HC_OPTS_INTERACTIVE was not defined due to an inconsistent cherry-pick. In master this was done in bdc555885b8898684549eca70053c9ce0ec7fa39 but I opted to simply extract the relevant definition from this commit in the interest of simplicity. >--------------------------------------------------------------- 3308b30be6a5eef71039923e94f11d9809671ca2 testsuite/mk/test.mk | 2 ++ 1 file changed, 2 insertions(+) diff --git a/testsuite/mk/test.mk b/testsuite/mk/test.mk index 6379a16..127d081 100644 --- a/testsuite/mk/test.mk +++ b/testsuite/mk/test.mk @@ -50,6 +50,8 @@ ifeq "$(MinGhcVersion711)" "YES" TEST_HC_OPTS += -fno-warn-missed-specialisations endif +TEST_HC_OPTS_INTERACTIVE = $(TEST_HC_OPTS) --interactive -v0 -ignore-dot-ghci + RUNTEST_OPTS = ifeq "$(filter $(TargetOS_CPP), cygwin32 mingw32)" "" From git at git.haskell.org Wed Aug 31 23:23:54 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 31 Aug 2016 23:23:54 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Disable T12031 on linux (af14774) Message-ID: <20160831232354.944823A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/af147747588ec3e40de684757311c32f5152a8df/ghc >--------------------------------------------------------------- commit af147747588ec3e40de684757311c32f5152a8df Author: Tamar Christina Date: Sun Jun 12 14:41:18 2016 +0200 Disable T12031 on linux (cherry picked from commit 29e1464319f40fe30fd63d8648f0d0a05541abe0) >--------------------------------------------------------------- af147747588ec3e40de684757311c32f5152a8df testsuite/tests/rts/T12031/all.T | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/testsuite/tests/rts/T12031/all.T b/testsuite/tests/rts/T12031/all.T index cb2b18e..53d842f 100644 --- a/testsuite/tests/rts/T12031/all.T +++ b/testsuite/tests/rts/T12031/all.T @@ -1,2 +1,3 @@ -test('T12031', [ extra_clean(['bar.o', 'baz.o', 'ExternBug.o']) ], +test('T12031', [ extra_clean(['bar.o', 'baz.o', 'ExternBug.o']) + , unless(opsys('mingw32'), skip) ], run_command, ['$MAKE -s --no-print-directory T12031']) From git at git.haskell.org Wed Aug 31 23:23:57 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 31 Aug 2016 23:23:57 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: ErrUtils: Expose accessors of ErrDoc and ErrMsg (99bb8ff) Message-ID: <20160831232357.47B993A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/99bb8ffe85ab135b3928b790818c0d5bbbb747a4/ghc >--------------------------------------------------------------- commit 99bb8ffe85ab135b3928b790818c0d5bbbb747a4 Author: Ben Gamari Date: Wed Aug 31 13:50:30 2016 -0400 ErrUtils: Expose accessors of ErrDoc and ErrMsg Test Plan: Validate Reviewers: austin Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2491 GHC Trac Issues: #12206 (cherry picked from commit 2d220263f6e5f49139f5571b7a5bc1649cb9ac8c) >--------------------------------------------------------------- 99bb8ffe85ab135b3928b790818c0d5bbbb747a4 compiler/main/ErrUtils.hs | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/compiler/main/ErrUtils.hs b/compiler/main/ErrUtils.hs index 3675b85..0cb40d2 100644 --- a/compiler/main/ErrUtils.hs +++ b/compiler/main/ErrUtils.hs @@ -13,7 +13,9 @@ module ErrUtils ( Severity(..), -- * Messages - MsgDoc, ErrMsg, ErrDoc, errDoc, WarnMsg, + ErrMsg, errMsgDoc, + ErrDoc, errDoc, errDocImportant, errDocContext, errDocSupplementary, + WarnMsg, MsgDoc, Messages, ErrorMessages, WarningMessages, unionMessages, errMsgSpan, errMsgContext, @@ -22,6 +24,7 @@ module ErrUtils ( -- ** Formatting pprMessageBag, pprErrMsgBagWithLoc, pprLocErrMsg, printBagOfErrors, + formatErrDoc, -- ** Construction emptyMessages, mkLocMessage, mkLocMessageAnn, makeIntoWarning, @@ -127,11 +130,11 @@ data ErrMsg = ErrMsg { -- from. data ErrDoc = ErrDoc { -- | Primary error msg. - errDocImportant :: [MsgDoc], + errDocImportant :: [MsgDoc], -- | Context e.g. \"In the second argument of ...\". - _errDocContext :: [MsgDoc], + errDocContext :: [MsgDoc], -- | Supplementary information, e.g. \"Relevant bindings include ...\". - _errDocSupplementary :: [MsgDoc] + errDocSupplementary :: [MsgDoc] } errDoc :: [MsgDoc] -> [MsgDoc] -> [MsgDoc] -> ErrDoc From git at git.haskell.org Wed Aug 31 23:24:00 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 31 Aug 2016 23:24:00 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: HsExpr: Ensure Type is derived on ThModFinalizers (d2e14e6) Message-ID: <20160831232400.158CF3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/d2e14e656e8010a9667ee85743b5aba88f28dce3/ghc >--------------------------------------------------------------- commit d2e14e656e8010a9667ee85743b5aba88f28dce3 Author: Ben Gamari Date: Wed Aug 31 15:26:16 2016 -0400 HsExpr: Ensure Type is derived on ThModFinalizers This is necessary to bootstrap with GHC 7.8. >--------------------------------------------------------------- d2e14e656e8010a9667ee85743b5aba88f28dce3 compiler/hsSyn/HsExpr.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/compiler/hsSyn/HsExpr.hs b/compiler/hsSyn/HsExpr.hs index b9f7142..103f59a 100644 --- a/compiler/hsSyn/HsExpr.hs +++ b/compiler/hsSyn/HsExpr.hs @@ -1956,8 +1956,10 @@ isTypedSplice _ = False -- Quasi-quotes are untyped splices -- #ifdef GHCI newtype ThModFinalizers = ThModFinalizers [ForeignRef (TH.Q ())] + deriving (Typeable) #else data ThModFinalizers = ThModFinalizers + deriving (Typeable) #endif -- A Data instance which ignores the argument of 'ThModFinalizers'. From git at git.haskell.org Wed Aug 31 23:24:03 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 31 Aug 2016 23:24:03 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Fixes #12504: Double-escape paths used to build call to hsc_line (76286af) Message-ID: <20160831232403.345AE3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/76286af5c621f032c4afab1f26b992e8ffa7f84d/ghc >--------------------------------------------------------------- commit 76286af5c621f032c4afab1f26b992e8ffa7f84d Author: Richard Cook Date: Tue Aug 30 17:00:36 2016 -0400 Fixes #12504: Double-escape paths used to build call to hsc_line In outHsLine, paths passed to construct invocations of hsc_line must be escaped twice in order to generate a properly escaped string literal that will end up in the eventual LINE pragma emitted by this code. This is especially important on Windows paths, where backslashes would otherwise be treated as C escape sequences and result in the incorrect Windows paths. Adds test case to verify that hsc2hs properly escapes file paths in LINE pragmas Updates the hsc2hs submodule. See https://ghc.haskell.org/trac/ghc/ticket/12504 Reviewers: erikd, hvr, austin, bgamari, Phyx Reviewed By: erikd, Phyx Subscribers: thomie, Phyx, mpickering Differential Revision: https://phabricator.haskell.org/D2478 GHC Trac Issues: #12504 (cherry picked from commit 2ee1db60ab29258fa9f8ab820f778bd0bb7f87a4) >--------------------------------------------------------------- 76286af5c621f032c4afab1f26b992e8ffa7f84d testsuite/.gitignore | 1 + testsuite/tests/hsc2hs/Makefile | 11 +++++++++++ testsuite/tests/hsc2hs/T12504.stdout | 2 ++ .../{driver/T11429b.hs => hsc2hs/T12504/path/to/T12504.hsc} | 3 +++ testsuite/tests/hsc2hs/all.T | 6 ++++++ utils/hsc2hs | 2 +- 6 files changed, 24 insertions(+), 1 deletion(-) diff --git a/testsuite/.gitignore b/testsuite/.gitignore index e37a101..2114e6f 100644 --- a/testsuite/.gitignore +++ b/testsuite/.gitignore @@ -785,6 +785,7 @@ mk/ghcconfig*_test___spaces_ghc*.exe.mk /tests/ghci/scripts/ghci027.hs /tests/ghci/should_run/3171.err /tests/hsc2hs/3837.hs +/tests/hsc2hs/T12504/path/to/T12504.hs /tests/hsc2hs/T3837.hs /tests/hsc2hs/hsc2hs001.hs /tests/hsc2hs/hsc2hs002.hs diff --git a/testsuite/tests/hsc2hs/Makefile b/testsuite/tests/hsc2hs/Makefile index 54fa5ad..9b3ee98 100644 --- a/testsuite/tests/hsc2hs/Makefile +++ b/testsuite/tests/hsc2hs/Makefile @@ -40,3 +40,14 @@ T10272: '$(HSC2HS)' --cross-compile $@.hsc '$(TEST_HC)' $(TEST_HC_OPTS) -v0 --make $@ ./$@ + +.PHONY: T12504 +T12504: + '$(HSC2HS)' T12504/path/to/$@.hsc +ifeq "$(WINDOWS)" "YES" + grep '{-# LINE 1 \"T12504\\\\path\\\\to\\\\$@\.hsc\" #-}' T12504/path/to/$@.hs + grep '{-# LINE 2 \"T12504\\\\path\\\\to\\\\$@\.hsc\" #-}' T12504/path/to/$@.hs +else + grep '{-# LINE 1 \"T12504/path/to/$@\.hsc\" #-}' T12504/path/to/$@.hs + grep '{-# LINE 2 \"T12504/path/to/$@\.hsc\" #-}' T12504/path/to/$@.hs +endif diff --git a/testsuite/tests/hsc2hs/T12504.stdout b/testsuite/tests/hsc2hs/T12504.stdout new file mode 100644 index 0000000..c1c05d0 --- /dev/null +++ b/testsuite/tests/hsc2hs/T12504.stdout @@ -0,0 +1,2 @@ +{-# LINE 1 "T12504/path/to/T12504.hsc" #-} +{-# LINE 2 "T12504/path/to/T12504.hsc" #-} diff --git a/testsuite/tests/driver/T11429b.hs b/testsuite/tests/hsc2hs/T12504/path/to/T12504.hsc similarity index 61% copy from testsuite/tests/driver/T11429b.hs copy to testsuite/tests/hsc2hs/T12504/path/to/T12504.hsc index c81fb82..3d05ce0 100644 --- a/testsuite/tests/driver/T11429b.hs +++ b/testsuite/tests/hsc2hs/T12504/path/to/T12504.hsc @@ -1,2 +1,5 @@ +module Main (main) where + main :: IO () main = putStrLn "hello world" + diff --git a/testsuite/tests/hsc2hs/all.T b/testsuite/tests/hsc2hs/all.T index d4fc69d..3f910db 100644 --- a/testsuite/tests/hsc2hs/all.T +++ b/testsuite/tests/hsc2hs/all.T @@ -35,3 +35,9 @@ test('T10272', [extra_clean(['T10272.hs', 'T10272_hsc_make.c'])], run_command, ['$MAKE -s --no-print-directory T10272']) + +test('T12504', + [extra_clean(['T12504/path/to/T12504.hs']), + extra_files(['T12504'])], + run_command, + ['$MAKE -s --no-print-directory T12504']) diff --git a/utils/hsc2hs b/utils/hsc2hs index 5119aeb..f5ae016 160000 --- a/utils/hsc2hs +++ b/utils/hsc2hs @@ -1 +1 @@ -Subproject commit 5119aebacaca75d983b4d7db32a6305b7f8651dd +Subproject commit f5ae016e5a69ebf42d612805e51afd9227df9389 From git at git.haskell.org Wed Aug 31 23:24:05 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 31 Aug 2016 23:24:05 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: PPC NCG: Implement minimal stack frame header. (7364a1d) Message-ID: <20160831232405.DD6AC3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/7364a1d79ffe764a57500551370194a73259dfb6/ghc >--------------------------------------------------------------- commit 7364a1d79ffe764a57500551370194a73259dfb6 Author: Peter Trommler Date: Wed Aug 31 15:18:06 2016 -0400 PPC NCG: Implement minimal stack frame header. According to the ABI specifications a minimal stack frame consists of a header and a minimum size parameter save area. We reserve the minimal size for each ABI. On PowerPC 64-bil Linux and AIX the parameter save area can accomodate up to eight parameters. So calls with eight parameters and fewer can be done without allocating a new stack frame and deallocating that stack frame after the call. On AIX one additional spill slot is available on the stack. Code size for all nofib benchmarks is 0.3 % smaller on powerpc64. Test Plan: validate on AIX Reviewers: hvr!, erikd, austin, simonmar, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2445 (cherry picked from commit 010b07aae082cb6b1f2a5db3deecc5997f6d9a6d) >--------------------------------------------------------------- 7364a1d79ffe764a57500551370194a73259dfb6 compiler/nativeGen/PPC/CodeGen.hs | 5 +++-- compiler/nativeGen/PPC/Instr.hs | 30 ++++++++++++++++++++++++------ 2 files changed, 27 insertions(+), 8 deletions(-) diff --git a/compiler/nativeGen/PPC/CodeGen.hs b/compiler/nativeGen/PPC/CodeGen.hs index 9bcbd18..4b9a180 100644 --- a/compiler/nativeGen/PPC/CodeGen.hs +++ b/compiler/nativeGen/PPC/CodeGen.hs @@ -1276,14 +1276,15 @@ genCCall' dflags gcp target dest_regs args spFormat = if target32Bit platform then II32 else II64 + -- TODO: Do not create a new stack frame if delta is too large. move_sp_down finalStack - | delta > 64 = + | delta > stackFrameHeaderSize dflags = toOL [STU spFormat sp (AddrRegImm sp (ImmInt (-delta))), DELTA (-delta)] | otherwise = nilOL where delta = stackDelta finalStack move_sp_up finalStack - | delta > 64 = -- TODO: fix-up stack back-chain + | delta > stackFrameHeaderSize dflags = toOL [ADD sp sp (RIImm (ImmInt delta)), DELTA 0] | otherwise = nilOL diff --git a/compiler/nativeGen/PPC/Instr.hs b/compiler/nativeGen/PPC/Instr.hs index b5c26ed..6baeb6c 100644 --- a/compiler/nativeGen/PPC/Instr.hs +++ b/compiler/nativeGen/PPC/Instr.hs @@ -15,6 +15,7 @@ module PPC.Instr ( archWordFormat, RI(..), Instr(..), + stackFrameHeaderSize, maxSpillSlots, allocMoreStack, makeFarBranches @@ -505,7 +506,7 @@ ppc_mkSpillInstr ppc_mkSpillInstr dflags reg delta slot = let platform = targetPlatform dflags - off = spillSlotToOffset slot + off = spillSlotToOffset dflags slot arch = platformArch platform in let fmt = case targetClassOfReg platform reg of @@ -530,7 +531,7 @@ ppc_mkLoadInstr ppc_mkLoadInstr dflags reg delta slot = let platform = targetPlatform dflags - off = spillSlotToOffset slot + off = spillSlotToOffset dflags slot arch = platformArch platform in let fmt = case targetClassOfReg platform reg of @@ -546,6 +547,22 @@ ppc_mkLoadInstr dflags reg delta slot in instr fmt reg (AddrRegImm sp (ImmInt (off-delta))) +-- | The size of a minimal stackframe header including minimal +-- parameter save area. +stackFrameHeaderSize :: DynFlags -> Int +stackFrameHeaderSize dflags + = case platformOS platform of + OSLinux -> case platformArch platform of + -- header + parameter save area + ArchPPC -> 64 -- TODO: check ABI spec + ArchPPC_64 ELF_V1 -> 48 + 8 * 8 + ArchPPC_64 ELF_V2 -> 32 + 8 * 8 + _ -> panic "PPC.stackFrameHeaderSize: Unknown Linux" + OSAIX -> 24 + 8 * 4 + OSDarwin -> 64 -- TODO: check ABI spec + _ -> panic "PPC.stackFrameHeaderSize: not defined for this OS" + where platform = targetPlatform dflags + -- | The maximum number of bytes required to spill a register. PPC32 -- has 32-bit GPRs and 64-bit FPRs, while PPC64 has 64-bit GPRs and -- 64-bit FPRs. So the maximum is 8 regardless of platforms unlike @@ -557,7 +574,8 @@ spillSlotSize = 8 -- | The number of spill slots available without allocating more. maxSpillSlots :: DynFlags -> Int maxSpillSlots dflags - = ((rESERVED_C_STACK_BYTES dflags - 64) `div` spillSlotSize) - 1 + = ((rESERVED_C_STACK_BYTES dflags - stackFrameHeaderSize dflags) + `div` spillSlotSize) - 1 -- = 0 -- useful for testing allocMoreStack -- | The number of bytes that the stack pointer should be aligned @@ -567,9 +585,9 @@ stackAlign :: Int stackAlign = 16 -- | Convert a spill slot number to a *byte* offset, with no sign. -spillSlotToOffset :: Int -> Int -spillSlotToOffset slot - = 64 + spillSlotSize * slot +spillSlotToOffset :: DynFlags -> Int -> Int +spillSlotToOffset dflags slot + = stackFrameHeaderSize dflags + spillSlotSize * slot -------------------------------------------------------------------------------- From git at git.haskell.org Wed Aug 31 23:24:09 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 31 Aug 2016 23:24:09 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Add -fdefer-out-of-scope-variables flag (#12170). (661d140) Message-ID: <20160831232409.B95DF3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/661d140a198d941e3a1eaec13fbf7bd4406fa3e5/ghc >--------------------------------------------------------------- commit 661d140a198d941e3a1eaec13fbf7bd4406fa3e5 Author: Eugene Akentyev Date: Wed Aug 31 16:02:10 2016 -0400 Add -fdefer-out-of-scope-variables flag (#12170). Reviewers: simonpj, thomie, austin, bgamari Reviewed By: simonpj, thomie, bgamari Subscribers: simonpj, thomie Differential Revision: https://phabricator.haskell.org/D2458 GHC Trac Issues: #12170 (cherry picked from commit 75321ffa25ad377fa200485a7d58ad32a87e7d65) >--------------------------------------------------------------- 661d140a198d941e3a1eaec13fbf7bd4406fa3e5 compiler/main/DynFlags.hs | 7 ++++ compiler/typecheck/TcErrors.hs | 40 +++++++++++++++++----- docs/users_guide/glasgow_exts.rst | 25 +++++++++----- docs/users_guide/using-warnings.rst | 13 ++++++- .../tests/typecheck/should_compile/T12170b.hs | 5 +++ .../tests/typecheck/should_compile/T12170b.stderr | 3 ++ testsuite/tests/typecheck/should_compile/all.T | 1 + .../should_fail/{T12406.hs => T12170a.hs} | 4 +-- .../should_fail/{T12406.stderr => T12170a.stderr} | 5 +-- testsuite/tests/typecheck/should_fail/all.T | 1 + utils/mkUserGuidePart/Options/Warnings.hs | 20 ++++++++++- 11 files changed, 99 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 661d140a198d941e3a1eaec13fbf7bd4406fa3e5 From git at git.haskell.org Wed Aug 31 23:24:12 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 31 Aug 2016 23:24:12 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: user_guide: Move addModFinalizer mention to 8.0.2 release notes (0e68d98) Message-ID: <20160831232412.71B803A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/0e68d98dbd6ad28cc8171d9a8590e00c7a863fdc/ghc >--------------------------------------------------------------- commit 0e68d98dbd6ad28cc8171d9a8590e00c7a863fdc Author: Ben Gamari Date: Wed Aug 31 17:03:46 2016 -0400 user_guide: Move addModFinalizer mention to 8.0.2 release notes (cherry picked from commit 4e1e7f2b2b3e352bd772339480b67f7c02ba9061) >--------------------------------------------------------------- 0e68d98dbd6ad28cc8171d9a8590e00c7a863fdc docs/users_guide/8.0.2-notes.rst | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/docs/users_guide/8.0.2-notes.rst b/docs/users_guide/8.0.2-notes.rst index a86050c..3885951 100644 --- a/docs/users_guide/8.0.2-notes.rst +++ b/docs/users_guide/8.0.2-notes.rst @@ -27,3 +27,12 @@ Template Haskell ~~~~~~~~~~~~~~~~ - TODO FIXME. + +- ``addModFinalizer`` now exposes the local typing environment at the splice + point. This allows ``reify`` to see local and top-level definitions in the + current declaration group when used as in + + .. code-block:: none + + f x = $(addModFinalizer (reify 'x >>= runIO . print) >> [| x |]) + From git at git.haskell.org Wed Aug 31 23:24:15 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 31 Aug 2016 23:24:15 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Docs: fix links to ghc-flags (688354f) Message-ID: <20160831232415.3652B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/688354f5f7b100eb61a5619529e2371d6a31ec70/ghc >--------------------------------------------------------------- commit 688354f5f7b100eb61a5619529e2371d6a31ec70 Author: Thomas Miedema Date: Thu Jun 9 13:26:35 2016 +0200 Docs: fix links to ghc-flags (cherry picked from commit e703a232174fd6e6cc42f2b27a2d9a2a17957aa7) >--------------------------------------------------------------- 688354f5f7b100eb61a5619529e2371d6a31ec70 docs/users_guide/glasgow_exts.rst | 2 +- utils/mkUserGuidePart/Options/Language.hs | 70 +++++++++++----------- utils/mkUserGuidePart/Options/Linking.hs | 4 +- utils/mkUserGuidePart/Options/Misc.hs | 2 +- utils/mkUserGuidePart/Options/Optimizations.hs | 50 ++++++++-------- utils/mkUserGuidePart/Options/Phases.hs | 2 +- .../Options/RecompilationChecking.hs | 2 +- utils/mkUserGuidePart/Options/Verbosity.hs | 6 +- utils/mkUserGuidePart/Options/Warnings.hs | 28 ++++----- 9 files changed, 83 insertions(+), 83 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 688354f5f7b100eb61a5619529e2371d6a31ec70 From git at git.haskell.org Wed Aug 31 23:24:17 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 31 Aug 2016 23:24:17 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: users_guide: Document removal of -Wredundant-constraints from -Wall (f476386) Message-ID: <20160831232417.D627F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/f4763869a1350a41a76bdcdd0b6830f3082ab3ef/ghc >--------------------------------------------------------------- commit f4763869a1350a41a76bdcdd0b6830f3082ab3ef Author: Ben Gamari Date: Wed Aug 31 16:42:53 2016 -0400 users_guide: Document removal of -Wredundant-constraints from -Wall (cherry picked from commit 9661f59be99dcb0767739d6734e66babdc2bfe16) >--------------------------------------------------------------- f4763869a1350a41a76bdcdd0b6830f3082ab3ef docs/users_guide/8.0.2-notes.rst | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/docs/users_guide/8.0.2-notes.rst b/docs/users_guide/8.0.2-notes.rst index 3885951..0832566 100644 --- a/docs/users_guide/8.0.2-notes.rst +++ b/docs/users_guide/8.0.2-notes.rst @@ -21,7 +21,8 @@ Language Compiler ~~~~~~~~ -- TODO FIXME. +- The :ghc-flag:`-Wredundant-constraints` flag has been removed from the + :ghc-flag:`-Wall` flag set (see :ghc-ticket:`10635`). Template Haskell ~~~~~~~~~~~~~~~~ From git at git.haskell.org Wed Aug 31 23:24:21 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 31 Aug 2016 23:24:21 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: Remove redundant-constraints from -Wall (#10635) (4967265) Message-ID: <20160831232421.03AE63A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/49672659113371c3bee691e6d913df8e6f60a1d8/ghc >--------------------------------------------------------------- commit 49672659113371c3bee691e6d913df8e6f60a1d8 Author: Adam C. Foltzer Date: Wed Aug 31 16:02:53 2016 -0400 Remove redundant-constraints from -Wall (#10635) Removes -Wredundant-constraints from -Wall, as per the discussion in #10635. Reviewers: austin, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2498 GHC Trac Issues: #10635 (cherry picked from commit e9b0bf4ed52114852dbaf6af556514610a895f88) >--------------------------------------------------------------- 49672659113371c3bee691e6d913df8e6f60a1d8 compiler/main/DynFlags.hs | 3 +-- testsuite/tests/typecheck/should_compile/T10632.hs | 1 + testsuite/tests/typecheck/should_compile/T10632.stderr | 2 +- testsuite/tests/typecheck/should_compile/{T9939.hs => T10635.hs} | 1 - testsuite/tests/typecheck/should_compile/T9939.hs | 1 + testsuite/tests/typecheck/should_compile/T9939.stderr | 8 ++++---- testsuite/tests/typecheck/should_compile/all.T | 1 + testsuite/tests/warnings/should_compile/PluralS.stderr | 4 ++-- 8 files changed, 11 insertions(+), 10 deletions(-) diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 655d72a..93c0ee8 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -3904,8 +3904,7 @@ minusWallOpts Opt_WarnUnusedDoBind, Opt_WarnTrustworthySafe, Opt_WarnUntickedPromotedConstructors, - Opt_WarnMissingPatternSynonymSignatures, - Opt_WarnRedundantConstraints + Opt_WarnMissingPatternSynonymSignatures ] -- | Things you get with -Weverything, i.e. *all* known warnings flags diff --git a/testsuite/tests/typecheck/should_compile/T10632.hs b/testsuite/tests/typecheck/should_compile/T10632.hs index 5c1a177..03478fc 100644 --- a/testsuite/tests/typecheck/should_compile/T10632.hs +++ b/testsuite/tests/typecheck/should_compile/T10632.hs @@ -1,4 +1,5 @@ {-# LANGUAGE ImplicitParams #-} +{-# OPTIONS_GHC -Wredundant-constraints #-} f :: (?file1 :: String) => IO () f = putStrLn $ "f2: " diff --git a/testsuite/tests/typecheck/should_compile/T10632.stderr b/testsuite/tests/typecheck/should_compile/T10632.stderr index c3d112f..1733f0a 100644 --- a/testsuite/tests/typecheck/should_compile/T10632.stderr +++ b/testsuite/tests/typecheck/should_compile/T10632.stderr @@ -1,5 +1,5 @@ -T10632.hs:3:1: warning: [-Wredundant-constraints (in -Wall)] +T10632.hs:4:1: warning: [-Wredundant-constraints] • Redundant constraint: ?file1::String • In the type signature for: f :: (?file1::String) => IO () diff --git a/testsuite/tests/typecheck/should_compile/T9939.hs b/testsuite/tests/typecheck/should_compile/T10635.hs similarity index 99% copy from testsuite/tests/typecheck/should_compile/T9939.hs copy to testsuite/tests/typecheck/should_compile/T10635.hs index 4ae370b..1382466 100644 --- a/testsuite/tests/typecheck/should_compile/T9939.hs +++ b/testsuite/tests/typecheck/should_compile/T10635.hs @@ -20,4 +20,3 @@ data Equal a b where f4 :: (Eq a, Eq b) => a -> b -> Equal a b -> Bool -- Eq b redundant f4 x y EQUAL = y==y - diff --git a/testsuite/tests/typecheck/should_compile/T9939.hs b/testsuite/tests/typecheck/should_compile/T9939.hs index 4ae370b..3ceab51 100644 --- a/testsuite/tests/typecheck/should_compile/T9939.hs +++ b/testsuite/tests/typecheck/should_compile/T9939.hs @@ -1,4 +1,5 @@ {-# LANGUAGE GADTs #-} +{-# OPTIONS_GHC -Wredundant-constraints #-} module T9939 where diff --git a/testsuite/tests/typecheck/should_compile/T9939.stderr b/testsuite/tests/typecheck/should_compile/T9939.stderr index d10c510..c486679 100644 --- a/testsuite/tests/typecheck/should_compile/T9939.stderr +++ b/testsuite/tests/typecheck/should_compile/T9939.stderr @@ -1,20 +1,20 @@ -T9939.hs:5:1: warning: [-Wredundant-constraints (in -Wall)] +T9939.hs:6:1: warning: [-Wredundant-constraints] • Redundant constraint: Eq a • In the type signature for: f1 :: (Eq a, Ord a) => a -> a -> Bool -T9939.hs:9:1: warning: [-Wredundant-constraints (in -Wall)] +T9939.hs:10:1: warning: [-Wredundant-constraints] • Redundant constraint: Eq a • In the type signature for: f2 :: (Eq a, Ord a) => a -> a -> Bool -T9939.hs:13:1: warning: [-Wredundant-constraints (in -Wall)] +T9939.hs:14:1: warning: [-Wredundant-constraints] • Redundant constraint: Eq b • In the type signature for: f3 :: (Eq a, a ~ b, Eq b) => a -> b -> Bool -T9939.hs:20:1: warning: [-Wredundant-constraints (in -Wall)] +T9939.hs:21:1: warning: [-Wredundant-constraints] • Redundant constraint: Eq a • In the type signature for: f4 :: (Eq a, Eq b) => a -> b -> Equal a b -> Bool diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index f9f5610..b713206 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -517,4 +517,5 @@ test('T12064', extra_clean(['T12064.hi-boot', 'T12064.o-boot', 'T11062a.hi', 'T1 test('T11974', normal, compile, ['']) test('T12067', extra_clean(['T12067a.hi', 'T12067a.o']), multimod_compile, ['T12067', '-v0']) +test('T10635', normal, compile, ['']) test('T12170b', normal, compile, ['']) diff --git a/testsuite/tests/warnings/should_compile/PluralS.stderr b/testsuite/tests/warnings/should_compile/PluralS.stderr index b1ceab6..416ebb8 100644 --- a/testsuite/tests/warnings/should_compile/PluralS.stderr +++ b/testsuite/tests/warnings/should_compile/PluralS.stderr @@ -14,12 +14,12 @@ PluralS.hs:17:24: warning: [-Wtype-defaults (in -Wall)] In an equation for ‘defaultingNumAndShow’: defaultingNumAndShow = show 123 -PluralS.hs:23:1: warning: [-Wredundant-constraints (in -Wall)] +PluralS.hs:23:1: warning: [-Wredundant-constraints] • Redundant constraint: Num a • In the type signature for: redundantNum :: (Num a, Num a) => a -PluralS.hs:26:1: warning: [-Wredundant-constraints (in -Wall)] +PluralS.hs:26:1: warning: [-Wredundant-constraints] • Redundant constraints: (Show a, Num a, Eq a, Eq a) • In the type signature for: redundantMultiple :: (Num a, Show a, Num a, Eq a, Eq a) => a From git at git.haskell.org Wed Aug 31 23:24:23 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 31 Aug 2016 23:24:23 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: users_guide: A few miscellaneous notes in relnotes (4cda36d) Message-ID: <20160831232423.ABD7E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/4cda36de5cefb144c797b26552e438c90a3e22fd/ghc >--------------------------------------------------------------- commit 4cda36de5cefb144c797b26552e438c90a3e22fd Author: Ben Gamari Date: Wed Aug 31 17:15:37 2016 -0400 users_guide: A few miscellaneous notes in relnotes >--------------------------------------------------------------- 4cda36de5cefb144c797b26552e438c90a3e22fd docs/users_guide/8.0.2-notes.rst | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/docs/users_guide/8.0.2-notes.rst b/docs/users_guide/8.0.2-notes.rst index 0832566..cbabe40 100644 --- a/docs/users_guide/8.0.2-notes.rst +++ b/docs/users_guide/8.0.2-notes.rst @@ -8,7 +8,7 @@ TODO FIXME Highlights ---------- -TODO FIXME. +- Many, many bug fixes. Full details ------------ @@ -37,3 +37,8 @@ Template Haskell f x = $(addModFinalizer (reify 'x >>= runIO . print) >> [| x |]) +``ghc`` library +~~~~~~~~~~~~~~~ + +- Accessors are now exposed for ``ErrUtils.ErrMsg`` and ``ErrUtils.ErrDoc``. + From git at git.haskell.org Wed Aug 31 23:24:26 2016 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 31 Aug 2016 23:24:26 +0000 (UTC) Subject: [commit: ghc] ghc-8.0: users_guide: Move -fdefer-out-of-scope-variables note to 8.0.2 relnotes (0412525) Message-ID: <20160831232426.5A0CC3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.0 Link : http://ghc.haskell.org/trac/ghc/changeset/04125256085806648ba8b442d027ba38958c341b/ghc >--------------------------------------------------------------- commit 04125256085806648ba8b442d027ba38958c341b Author: Ben Gamari Date: Wed Aug 31 17:14:42 2016 -0400 users_guide: Move -fdefer-out-of-scope-variables note to 8.0.2 relnotes It will be included in 8.0.2 (cherry picked from commit 3cbb60b59e2bb0e2f8985a672b96bac74ca47c5d) >--------------------------------------------------------------- 04125256085806648ba8b442d027ba38958c341b docs/users_guide/8.0.2-notes.rst | 3 +++ 1 file changed, 3 insertions(+) diff --git a/docs/users_guide/8.0.2-notes.rst b/docs/users_guide/8.0.2-notes.rst index cbabe40..ac16a4f 100644 --- a/docs/users_guide/8.0.2-notes.rst +++ b/docs/users_guide/8.0.2-notes.rst @@ -24,6 +24,9 @@ Compiler - The :ghc-flag:`-Wredundant-constraints` flag has been removed from the :ghc-flag:`-Wall` flag set (see :ghc-ticket:`10635`). +- Added :ghc-flag:`-fdefer-out-of-scope-variables`, which converts variable + out of scope variables errors into warnings. + Template Haskell ~~~~~~~~~~~~~~~~