From git at git.haskell.org Tue Aug 1 12:14:59 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 1 Aug 2017 12:14:59 +0000 (UTC) Subject: [commit: ghc] master: Typofixes [ci skip] (7a74f50) Message-ID: <20170801121459.A9BB03A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7a74f5053fa0972b8ce191f7492e1692f09c2e1d/ghc >--------------------------------------------------------------- commit 7a74f5053fa0972b8ce191f7492e1692f09c2e1d Author: Gabor Greif Date: Tue Aug 1 14:14:31 2017 +0200 Typofixes [ci skip] >--------------------------------------------------------------- 7a74f5053fa0972b8ce191f7492e1692f09c2e1d compiler/basicTypes/DataCon.hs | 2 +- compiler/basicTypes/Id.hs | 2 +- compiler/coreSyn/PprCore.hs | 2 +- compiler/deSugar/DsBinds.hs | 2 +- compiler/simplCore/Simplify.hs | 2 +- 5 files changed, 5 insertions(+), 5 deletions(-) diff --git a/compiler/basicTypes/DataCon.hs b/compiler/basicTypes/DataCon.hs index b8a1b04..fa8e0a8 100644 --- a/compiler/basicTypes/DataCon.hs +++ b/compiler/basicTypes/DataCon.hs @@ -778,7 +778,7 @@ mkDataCon name declared_infix prom_info -- data T a where { MkT :: S } -- then it's possible that the univ_tvs may hit an assertion failure -- if you pull on univ_tvs. This case is checked by checkValidDataCon, --- so the error is detected properly... it's just that asaertions here +-- so the error is detected properly... it's just that assertions here -- are a little dodgy. = con diff --git a/compiler/basicTypes/Id.hs b/compiler/basicTypes/Id.hs index 290e262..aab5569 100644 --- a/compiler/basicTypes/Id.hs +++ b/compiler/basicTypes/Id.hs @@ -715,7 +715,7 @@ setIdCafInfo :: Id -> CafInfo -> Id setIdCafInfo id caf_info = modifyIdInfo (`setCafInfo` caf_info) id --------------------------------- - -- Occcurrence INFO + -- Occurrence INFO idOccInfo :: Id -> OccInfo idOccInfo id = occInfo (idInfo id) diff --git a/compiler/coreSyn/PprCore.hs b/compiler/coreSyn/PprCore.hs index 28d3552..1ac3084 100644 --- a/compiler/coreSyn/PprCore.hs +++ b/compiler/coreSyn/PprCore.hs @@ -374,7 +374,7 @@ pprTypedLamBinder bind_site debug_on var = sdocWithDynFlags $ \dflags -> case () of _ - | not debug_on -- Show case-bound wild bilders only if debug is on + | not debug_on -- Show case-bound wild binders only if debug is on , CaseBind <- bind_site , isDeadBinder var -> empty diff --git a/compiler/deSugar/DsBinds.hs b/compiler/deSugar/DsBinds.hs index 41aeb93..a3e5c15 100644 --- a/compiler/deSugar/DsBinds.hs +++ b/compiler/deSugar/DsBinds.hs @@ -195,7 +195,7 @@ dsHsBind _ (PatSynBind{}) = panic "dsHsBind: PatSynBind" ----------------------- dsAbsBinds :: DynFlags -> [TyVar] -> [EvVar] -> [ABExport GhcTc] - -> [CoreBind] -- Desugared evidence bidings + -> [CoreBind] -- Desugared evidence bindings -> ([Id], [(Id,CoreExpr)]) -- Desugared value bindings -> Bool -- Single binding with signature -> DsM ([Id], [(Id,CoreExpr)]) diff --git a/compiler/simplCore/Simplify.hs b/compiler/simplCore/Simplify.hs index dd0d45b..1fc9112 100644 --- a/compiler/simplCore/Simplify.hs +++ b/compiler/simplCore/Simplify.hs @@ -2699,7 +2699,7 @@ Note [Add unfolding for scrutinee] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ In general it's unlikely that a variable scrutinee will appear in the case alternatives case x of { ...x unlikely to appear... } -because the binder-swap in OccAnal has got rid of all such occcurrences +because the binder-swap in OccAnal has got rid of all such occurrences See Note [Binder swap] in OccAnal. BUT it is still VERY IMPORTANT to add a suitable unfolding for a From git at git.haskell.org Tue Aug 1 12:58:18 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 1 Aug 2017 12:58:18 +0000 (UTC) Subject: [commit: ghc] master: rts: Fix "variable set but not used" warning (74c7016) Message-ID: <20170801125818.9FA2B3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/74c70166dc70486f3535d3c9d12071ea8a447389/ghc >--------------------------------------------------------------- commit 74c70166dc70486f3535d3c9d12071ea8a447389 Author: Ben Gamari Date: Mon Jul 31 22:33:51 2017 -0400 rts: Fix "variable set but not used" warning gcc complains about this while building with Hadrian, ``` rts/RetainerProfile.c: In function ‘computeRetainerSet’: rts/RetainerProfile.c:1758:18: error: error: variable ‘rtl’ set but not used [-Werror=unused-but-set-variable] RetainerSet *rtl; ^~~ | 1758 | RetainerSet *rtl; | ^ ``` Reviewers: austin, erikd, simonmar, Phyx Reviewed By: Phyx Subscribers: Phyx, rwbarton, thomie Differential Revision: https://phabricator.haskell.org/D3801 >--------------------------------------------------------------- 74c70166dc70486f3535d3c9d12071ea8a447389 rts/RetainerProfile.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/rts/RetainerProfile.c b/rts/RetainerProfile.c index 6ca09fc..1d5e923 100644 --- a/rts/RetainerProfile.c +++ b/rts/RetainerProfile.c @@ -1755,11 +1755,11 @@ static void computeRetainerSet( void ) { StgWeak *weak; - RetainerSet *rtl; uint32_t g, n; StgPtr ml; bdescr *bd; #if defined(DEBUG_RETAINER) + RetainerSet *rtl; RetainerSet tmpRetainerSet; #endif @@ -1801,9 +1801,9 @@ computeRetainerSet( void ) for (ml = bd->start; ml < bd->free; ml++) { maybeInitRetainerSet((StgClosure *)*ml); - rtl = retainerSetOf((StgClosure *)*ml); #if defined(DEBUG_RETAINER) + rtl = retainerSetOf((StgClosure *)*ml); if (rtl == NULL) { // first visit to *ml // This is a violation of the interface rule! From git at git.haskell.org Tue Aug 1 12:58:12 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 1 Aug 2017 12:58:12 +0000 (UTC) Subject: [commit: ghc] master: Allow bundling pattern synonyms with exported data families (29f07b1) Message-ID: <20170801125812.8A1AF3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/29f07b1de78198fa29dabafd7bf1f1f4ecdc7f54/ghc >--------------------------------------------------------------- commit 29f07b1de78198fa29dabafd7bf1f1f4ecdc7f54 Author: Ryan Scott Date: Mon Jul 31 22:33:40 2017 -0400 Allow bundling pattern synonyms with exported data families Test Plan: make test TEST=T14058 Reviewers: mpickering, austin, bgamari, simonpj Reviewed By: simonpj Subscribers: simonpj, rwbarton, thomie GHC Trac Issues: #14058 Differential Revision: https://phabricator.haskell.org/D3808 >--------------------------------------------------------------- 29f07b1de78198fa29dabafd7bf1f1f4ecdc7f54 compiler/types/TyCon.hs | 6 ++++++ testsuite/tests/patsyn/should_compile/T14058.hs | 7 +++++++ testsuite/tests/patsyn/should_compile/T14058a.hs | 19 +++++++++++++++++++ testsuite/tests/patsyn/should_compile/all.T | 2 ++ 4 files changed, 34 insertions(+) diff --git a/compiler/types/TyCon.hs b/compiler/types/TyCon.hs index cf144eb..95207c4 100644 --- a/compiler/types/TyCon.hs +++ b/compiler/types/TyCon.hs @@ -2108,6 +2108,10 @@ expandSynTyCon_maybe tc tys -- | Check if the tycon actually refers to a proper `data` or `newtype` -- with user defined constructors rather than one from a class or other -- construction. + +-- NB: This is only used in TcRnExports.checkPatSynParent to determine if an +-- exported tycon can have a pattern synonym bundled with it, e.g., +-- module Foo (TyCon(.., PatSyn)) where isTyConWithSrcDataCons :: TyCon -> Bool isTyConWithSrcDataCons (AlgTyCon { algTcRhs = rhs, algTcParent = parent }) = case rhs of @@ -2117,6 +2121,8 @@ isTyConWithSrcDataCons (AlgTyCon { algTcRhs = rhs, algTcParent = parent }) = _ -> False where isSrcParent = isNoParent parent +isTyConWithSrcDataCons (FamilyTyCon { famTcFlav = DataFamilyTyCon {} }) + = True -- #14058 isTyConWithSrcDataCons _ = False diff --git a/testsuite/tests/patsyn/should_compile/T14058.hs b/testsuite/tests/patsyn/should_compile/T14058.hs new file mode 100644 index 0000000..7c263b8 --- /dev/null +++ b/testsuite/tests/patsyn/should_compile/T14058.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE TypeInType #-} +module T14058 where + +import T14058a (Sing(..)) + +foo :: Sing ('[ '[] ] :: [[a]]) +foo = SCons SNil SNil diff --git a/testsuite/tests/patsyn/should_compile/T14058a.hs b/testsuite/tests/patsyn/should_compile/T14058a.hs new file mode 100644 index 0000000..a7e5d97 --- /dev/null +++ b/testsuite/tests/patsyn/should_compile/T14058a.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeInType #-} +{-# LANGUAGE TypeOperators #-} +module T14058a (Sing(.., SCons)) where + +data family Sing (a :: k) + +data instance Sing (z :: [a]) where + SNil :: Sing '[] + (:%) :: Sing x -> Sing xs -> Sing (x:xs) + +pattern SCons :: forall a (z :: [a]). () + => forall (x :: a) (xs :: [a]). z ~ (x:xs) + => Sing x -> Sing xs -> Sing z +pattern SCons x xs = (:%) x xs +{-# COMPLETE SNil, SCons #-} diff --git a/testsuite/tests/patsyn/should_compile/all.T b/testsuite/tests/patsyn/should_compile/all.T index 286f735..b8c9806 100644 --- a/testsuite/tests/patsyn/should_compile/all.T +++ b/testsuite/tests/patsyn/should_compile/all.T @@ -71,3 +71,5 @@ test('T13454', normal, compile, ['']) test('T13752', normal, compile, ['']) test('T13752a', normal, compile, ['']) test('T13768', normal, compile, ['']) +test('T14058', [extra_files(['T14058.hs', 'T14058a.hs'])], + multimod_compile, ['T14058', '-v0']) From git at git.haskell.org Tue Aug 1 12:58:15 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 1 Aug 2017 12:58:15 +0000 (UTC) Subject: [commit: ghc] master: KnownUniques: Handle DataCon wrapper names (5a7af95) Message-ID: <20170801125815.DD90B3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5a7af95ad2ce38e4b80893d869948c630454683b/ghc >--------------------------------------------------------------- commit 5a7af95ad2ce38e4b80893d869948c630454683b Author: Ben Gamari Date: Mon Jul 31 22:33:24 2017 -0400 KnownUniques: Handle DataCon wrapper names For some reason these weren't handled. I seem to remember thinking I had a reason for omitting them when writing the original patch, but I don't recall what that reason was at this point and clearly workers do show up in interface files. Test Plan: Validate against T14051 Reviewers: austin Subscribers: rwbarton, thomie, RyanGlScott GHC Trac Issues: #14051 Differential Revision: https://phabricator.haskell.org/D3805 >--------------------------------------------------------------- 5a7af95ad2ce38e4b80893d869948c630454683b compiler/prelude/KnownUniques.hs | 9 ++++++--- testsuite/tests/unboxedsums/T14051.hs | 10 ++++++++++ testsuite/tests/unboxedsums/T14051a.hs | 6 ++++++ testsuite/tests/unboxedsums/all.T | 1 + 4 files changed, 23 insertions(+), 3 deletions(-) diff --git a/compiler/prelude/KnownUniques.hs b/compiler/prelude/KnownUniques.hs index 8f1b0b6..60fa0e2 100644 --- a/compiler/prelude/KnownUniques.hs +++ b/compiler/prelude/KnownUniques.hs @@ -79,7 +79,8 @@ knownUniqueName u = mkSumTyConUnique :: Arity -> Unique mkSumTyConUnique arity = - ASSERT(arity < 0xff) + ASSERT(arity < 0x3f) -- 0x3f since we only have 6 bits to encode the + -- alternative mkUnique 'z' (arity `shiftL` 8 .|. 0xfc) mkSumDataConUnique :: ConTagZ -> Arity -> Unique @@ -98,16 +99,18 @@ getUnboxedSumName n _ -> pprPanic "getUnboxedSumName: invalid tag" (ppr tag) | tag == 0x0 = dataConName $ sumDataCon (alt + 1) arity + | tag == 0x1 + = getName $ dataConWrapId $ sumDataCon (alt + 1) arity | tag == 0x2 = getRep $ promoteDataCon $ sumDataCon (alt + 1) arity | otherwise = pprPanic "getUnboxedSumName" (ppr n) where arity = n `shiftR` 8 - alt = (n .&. 0xff) `shiftR` 2 + alt = (n .&. 0xfc) `shiftR` 2 tag = 0x3 .&. n getRep tycon = - fromMaybe (pprPanic "getUnboxedSumName" (ppr tycon)) + fromMaybe (pprPanic "getUnboxedSumName(getRep)" (ppr tycon)) $ tyConRepName_maybe tycon -- Note [Uniques for tuple type and data constructors] diff --git a/testsuite/tests/unboxedsums/T14051.hs b/testsuite/tests/unboxedsums/T14051.hs new file mode 100644 index 0000000..96662a9 --- /dev/null +++ b/testsuite/tests/unboxedsums/T14051.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE UnboxedSums #-} + +module Main where + +import T14051a + +main :: IO () +main = print $ case func () of + (# True | #) -> 123 + _ -> 321 diff --git a/testsuite/tests/unboxedsums/T14051a.hs b/testsuite/tests/unboxedsums/T14051a.hs new file mode 100644 index 0000000..b88f70e --- /dev/null +++ b/testsuite/tests/unboxedsums/T14051a.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE UnboxedSums #-} + +module T14051a where + +func :: s -> (# Bool | Bool #) +func _ = (# True | #) diff --git a/testsuite/tests/unboxedsums/all.T b/testsuite/tests/unboxedsums/all.T index eea818b..45723cb 100644 --- a/testsuite/tests/unboxedsums/all.T +++ b/testsuite/tests/unboxedsums/all.T @@ -32,3 +32,4 @@ test('T12711', only_ways(['ghci']), ghci_script, ['T12711.script']) # ['$MAKE -s --no-print-directory sum_api_annots']) test('UbxSumLevPoly', normal, compile, ['']) +test('T14051', normal, multi_compile, ['T14051.hs', [('T14051a.hs', '')], '-O2 -v0']) From git at git.haskell.org Tue Aug 1 13:09:58 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 1 Aug 2017 13:09:58 +0000 (UTC) Subject: [commit: ghc] master: Simplify OccurAnal.tagRecBinders (b311096) Message-ID: <20170801130958.BEB773A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b311096c5cf4b669dcfceb99561ac6e1c4cca0cd/ghc >--------------------------------------------------------------- commit b311096c5cf4b669dcfceb99561ac6e1c4cca0cd Author: Joachim Breitner Date: Mon Jul 31 22:56:51 2017 -0400 Simplify OccurAnal.tagRecBinders No need to mark the binders with markNonTailCalled, as they already have been marked as such in rhs_udss' via adjust. Differential Revision: https://phabricator.haskell.org/D3810 >--------------------------------------------------------------- b311096c5cf4b669dcfceb99561ac6e1c4cca0cd compiler/simplCore/OccurAnal.hs | 9 +++------ 1 file changed, 3 insertions(+), 6 deletions(-) diff --git a/compiler/simplCore/OccurAnal.hs b/compiler/simplCore/OccurAnal.hs index 5dd30aa..dbe1c48 100644 --- a/compiler/simplCore/OccurAnal.hs +++ b/compiler/simplCore/OccurAnal.hs @@ -2657,12 +2657,9 @@ tagRecBinders lvl body_uds triples -- 3. Compute final usage details from adjusted RHS details adj_uds = body_uds +++ combineUsageDetailsList rhs_udss' - -- 4. Tag each binder with its adjusted details modulo the - -- join-point-hood decision - occs = map (lookupDetails adj_uds) bndrs - occs' | will_be_joins = occs - | otherwise = map markNonTailCalled occs - bndrs' = zipWith setBinderOcc occs' bndrs + -- 4. Tag each binder with its adjusted details + bndrs' = [ setBinderOcc (lookupDetails adj_uds bndr) bndr + | bndr <- bndrs ] -- 5. Drop the binders from the adjusted details and return usage' = adj_uds `delDetailsList` bndrs From git at git.haskell.org Tue Aug 1 13:49:07 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 1 Aug 2017 13:49:07 +0000 (UTC) Subject: [commit: ghc] branch 'wip/T14068' created Message-ID: <20170801134907.C52B43A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/T14068 Referencing: 456cbbde2bead57319c9fa0d27bc88f1d5523625 From git at git.haskell.org Tue Aug 1 13:49:10 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 1 Aug 2017 13:49:10 +0000 (UTC) Subject: [commit: ghc] wip/T14068: Detect functions where all recursive calls are tail-recursive (456cbbd) Message-ID: <20170801134910.93C4F3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14068 Link : http://ghc.haskell.org/trac/ghc/changeset/456cbbde2bead57319c9fa0d27bc88f1d5523625/ghc >--------------------------------------------------------------- commit 456cbbde2bead57319c9fa0d27bc88f1d5523625 Author: Joachim Breitner Date: Tue Aug 1 09:47:49 2017 -0400 Detect functions where all recursive calls are tail-recursive This is the first half of #14068. >--------------------------------------------------------------- 456cbbde2bead57319c9fa0d27bc88f1d5523625 compiler/basicTypes/BasicTypes.hs | 20 ++++++++++++++------ compiler/simplCore/OccurAnal.hs | 25 +++++++++++++++++++++---- 2 files changed, 35 insertions(+), 10 deletions(-) diff --git a/compiler/basicTypes/BasicTypes.hs b/compiler/basicTypes/BasicTypes.hs index 90a043d..284ddfe 100644 --- a/compiler/basicTypes/BasicTypes.hs +++ b/compiler/basicTypes/BasicTypes.hs @@ -935,6 +935,7 @@ notOneBranch = False ----------------- data TailCallInfo = AlwaysTailCalled JoinArity -- See Note [TailCallInfo] + | RecursiveTailCalled JoinArity | NoTailCallInfo deriving (Eq) @@ -948,12 +949,14 @@ zapOccTailCallInfo occ = occ { occ_tail = NoTailCallInfo } isAlwaysTailCalled :: OccInfo -> Bool isAlwaysTailCalled occ - = case tailCallInfo occ of AlwaysTailCalled{} -> True - NoTailCallInfo -> False + = case tailCallInfo occ of AlwaysTailCalled{} -> True + RecursiveTailCalled {} -> False + NoTailCallInfo -> False instance Outputable TailCallInfo where - ppr (AlwaysTailCalled ar) = sep [ text "Tail", int ar ] - ppr _ = empty + ppr (AlwaysTailCalled ar) = sep [ text "Tail", int ar ] + ppr (RecursiveTailCalled ar) = sep [ text "Tail(rec)", int ar ] + ppr _ = empty ----------------- strongLoopBreaker, weakLoopBreaker :: OccInfo @@ -1003,8 +1006,9 @@ instance Outputable OccInfo where pp_tail = pprShortTailCallInfo tail_info pprShortTailCallInfo :: TailCallInfo -> SDoc -pprShortTailCallInfo (AlwaysTailCalled ar) = char 'T' <> brackets (int ar) -pprShortTailCallInfo NoTailCallInfo = empty +pprShortTailCallInfo (AlwaysTailCalled ar) = char 'T' <> brackets (int ar) +pprShortTailCallInfo (RecursiveTailCalled ar) = text "TR" <> brackets (int ar) +pprShortTailCallInfo NoTailCallInfo = empty {- Note [TailCallInfo] @@ -1037,6 +1041,10 @@ point can also be invoked from other join points, not just from case branches: Here both 'j1' and 'j2' will get marked AlwaysTailCalled, but j1 will get ManyOccs and j2 will get `OneOcc { occ_one_br = True }`. +The RecursiveTailCalled marker, which is only valid for a recursive binder, +says: All recursive calls are tail calls in the sense of AlwaysTailCalled, +even if some calls in the body might not be. + ************************************************************************ * * Default method specification diff --git a/compiler/simplCore/OccurAnal.hs b/compiler/simplCore/OccurAnal.hs index dbe1c48..a652e1c 100644 --- a/compiler/simplCore/OccurAnal.hs +++ b/compiler/simplCore/OccurAnal.hs @@ -2633,8 +2633,9 @@ tagRecBinders lvl body_uds triples -- 1. Determine join-point-hood of whole group, as determined by -- the *unadjusted* usage details - unadj_uds = body_uds +++ combineUsageDetailsList rhs_udss - will_be_joins = decideJoinPointHood lvl unadj_uds bndrs + unadj_uds_rhss = combineUsageDetailsList rhs_udss + unadj_uds = body_uds +++ unadj_uds_rhss + will_be_joins = decideJoinPointHood lvl unadj_uds bndrs -- 2. Adjust usage details of each RHS, taking into account the -- join-point-hood decision @@ -2658,8 +2659,20 @@ tagRecBinders lvl body_uds triples adj_uds = body_uds +++ combineUsageDetailsList rhs_udss' -- 4. Tag each binder with its adjusted details - bndrs' = [ setBinderOcc (lookupDetails adj_uds bndr) bndr - | bndr <- bndrs ] + bndrs' + -- 4a. If this is only one function, and the recursive calls are + -- tail calls, then the simplifier turn it into a non-recursive function + -- with a local joinrec. + | [bndr] <- bndrs + , let occ_rhs = lookupDetails unadj_uds_rhss bndr + , AlwaysTailCalled arity <- tailCallInfo occ_rhs + = let occ = lookupDetails adj_uds bndr + occ' = markRecursiveTailCalled arity occ + in [ setBinderOcc occ' bndr ] + -- 4b. Otherwise, just use the adjusted details + | otherwise + = [ setBinderOcc (lookupDetails adj_uds bndr) bndr + | bndr <- bndrs ] -- 5. Drop the binders from the adjusted details and return usage' = adj_uds `delDetailsList` bndrs @@ -2744,6 +2757,10 @@ markInsideLam occ = occ markNonTailCalled IAmDead = IAmDead markNonTailCalled occ = occ { occ_tail = NoTailCallInfo } +markRecursiveTailCalled :: Arity -> OccInfo -> OccInfo +markRecursiveTailCalled _ IAmDead = IAmDead +markRecursiveTailCalled arity occ = occ { occ_tail = RecursiveTailCalled arity } + addOccInfo, orOccInfo :: OccInfo -> OccInfo -> OccInfo addOccInfo a1 a2 = ASSERT( not (isDeadOcc a1 || isDeadOcc a2) ) From git at git.haskell.org Tue Aug 1 14:37:58 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 1 Aug 2017 14:37:58 +0000 (UTC) Subject: [commit: ghc] master: Drop GHC 7.10 compatibility (c13720c) Message-ID: <20170801143758.DD3863A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c13720c8c6047844f659ad4ce684946b80c99bee/ghc >--------------------------------------------------------------- commit c13720c8c6047844f659ad4ce684946b80c99bee Author: Ryan Scott Date: Tue Aug 1 09:48:52 2017 -0400 Drop GHC 7.10 compatibility GHC 8.2.1 is out, so now GHC's support window only extends back to GHC 8.0. This means we can delete gobs of code that was only used for GHC 7.10 support. Hooray! Test Plan: ./validate Reviewers: hvr, bgamari, austin, goldfire, simonmar Reviewed By: bgamari Subscribers: Phyx, rwbarton, thomie Differential Revision: https://phabricator.haskell.org/D3781 >--------------------------------------------------------------- c13720c8c6047844f659ad4ce684946b80c99bee compiler/cmm/CmmMonad.hs | 5 ---- compiler/cmm/CmmOpt.hs | 2 -- compiler/coreSyn/CoreLint.hs | 4 --- compiler/deSugar/Coverage.hs | 6 +--- compiler/ghc.cabal.in | 7 ----- compiler/ghci/ByteCodeGen.hs | 4 --- compiler/ghci/ByteCodeInstr.hs | 4 --- compiler/ghci/ByteCodeTypes.hs | 6 +--- compiler/ghci/{GHCi.hsc => GHCi.hs} | 26 ----------------- compiler/ghci/Linker.hs | 9 ------ compiler/llvmGen/LlvmCodeGen/CodeGen.hs | 4 --- compiler/main/InteractiveEvalTypes.hs | 6 ---- compiler/main/Packages.hs | 4 --- compiler/nativeGen/X86/CodeGen.hs | 2 -- compiler/parser/Lexer.x | 4 --- compiler/prelude/TysWiredIn.hs | 23 ++++----------- compiler/specialise/Specialise.hs | 4 --- compiler/typecheck/TcErrors.hs | 4 --- compiler/typecheck/TcRnTypes.hs | 4 --- compiler/typecheck/TcSMonad.hs | 4 --- compiler/types/OptCoercion.hs | 2 -- compiler/types/Unify.hs | 4 --- compiler/utils/IOEnv.hs | 7 ----- compiler/utils/MonadUtils.hs | 5 ---- compiler/utils/OrdList.hs | 5 ---- compiler/utils/Outputable.hs | 4 ++- compiler/utils/UniqFM.hs | 4 --- compiler/utils/UniqSet.hs | 5 ---- compiler/utils/Util.hs | 33 +--------------------- ghc/hschooks.c | 2 -- libraries/base/Data/Bits.hs | 8 ++---- libraries/base/GHC/Natural.hs | 18 ++++-------- libraries/base/GHC/Real.hs | 2 -- libraries/ghci/GHCi/Message.hs | 16 +---------- .../template-haskell/Language/Haskell/TH/Syntax.hs | 16 +---------- 35 files changed, 21 insertions(+), 242 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 c13720c8c6047844f659ad4ce684946b80c99bee From git at git.haskell.org Tue Aug 1 15:14:18 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 1 Aug 2017 15:14:18 +0000 (UTC) Subject: [commit: ghc] wip/T14068: Implement loopification for local bindings (#14068) (29a03ad) Message-ID: <20170801151418.994BF3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14068 Link : http://ghc.haskell.org/trac/ghc/changeset/29a03ad7cc5734033bb1ccca1ca8c56a48ffeef3/ghc >--------------------------------------------------------------- commit 29a03ad7cc5734033bb1ccca1ca8c56a48ffeef3 Author: Joachim Breitner Date: Tue Aug 1 10:36:32 2017 -0400 Implement loopification for local bindings (#14068) This is a relatively prelimary version. I am sure there is a huge number of invariants that this breaks, and conditions that I am not checking etc. I do not even know if the simplifier is the right place to implement this. But it works in this simple case: module T14068 where foo p f k = let bar a = if p a then bar (f a) else a in k bar so we can iterate from here. >--------------------------------------------------------------- 29a03ad7cc5734033bb1ccca1ca8c56a48ffeef3 compiler/coreSyn/CoreOpt.hs | 34 +++++++++++++++++++++++++++------- compiler/simplCore/Simplify.hs | 17 ++++++++++++++++- 2 files changed, 43 insertions(+), 8 deletions(-) diff --git a/compiler/coreSyn/CoreOpt.hs b/compiler/coreSyn/CoreOpt.hs index 4a19605..0dae086 100644 --- a/compiler/coreSyn/CoreOpt.hs +++ b/compiler/coreSyn/CoreOpt.hs @@ -10,6 +10,7 @@ module CoreOpt ( -- ** Join points joinPointBinding_maybe, joinPointBindings_maybe, + loopificationJoinPointBinding_maybe , -- ** Predicates on expressions exprIsConApp_maybe, exprIsLiteral_maybe, exprIsLambda_maybe, @@ -642,22 +643,41 @@ joinPointBinding_maybe bndr rhs = Just (bndr, rhs) | AlwaysTailCalled join_arity <- tailCallInfo (idOccInfo bndr) - , not (bad_unfolding join_arity (idUnfolding bndr)) + , not (badUnfoldingForJoin join_arity bndr) , (bndrs, body) <- etaExpandToJoinPoint join_arity rhs = Just (bndr `asJoinId` join_arity, mkLams bndrs body) | otherwise = Nothing +-- | like joinPointBinding_maybe, but looks for RecursiveTailCalled +loopificationJoinPointBinding_maybe :: InBndr -> InExpr -> Maybe (InBndr, InExpr) +loopificationJoinPointBinding_maybe bndr rhs + | not (isId bndr) + = Nothing + + | isJoinId bndr + = Nothing -- do not loopificate again + + | RecursiveTailCalled join_arity <- tailCallInfo (idOccInfo bndr) + , not (badUnfoldingForJoin join_arity bndr) + , (bndrs, body) <- etaExpandToJoinPoint join_arity rhs + = Just (bndr `asJoinId` join_arity, mkLams bndrs body) + + | otherwise + = Nothing + +-- | badUnfoldingForJoin returns True if we should /not/ convert a non-join-id +-- into a join-id, even though it is AlwaysTailCalled +-- See Note [Join points and INLINE pragmas] +badUnfoldingForJoin :: JoinArity -> Id -> Bool +badUnfoldingForJoin join_arity bndr = bad_unfolding (idUnfolding bndr) where - -- bad_unfolding returns True if we should /not/ convert a non-join-id - -- into a join-id, even though it is AlwaysTailCalled - -- See Note [Join points and INLINE pragmas] - bad_unfolding join_arity (CoreUnfolding { uf_src = src, uf_tmpl = rhs }) + bad_unfolding (CoreUnfolding { uf_src = src, uf_tmpl = rhs }) = isStableSource src && join_arity > joinRhsArity rhs - bad_unfolding _ (DFunUnfolding {}) + bad_unfolding (DFunUnfolding {}) = True - bad_unfolding _ _ + bad_unfolding _ = False joinPointBindings_maybe :: [(InBndr, InExpr)] -> Maybe [(InBndr, InExpr)] diff --git a/compiler/simplCore/Simplify.hs b/compiler/simplCore/Simplify.hs index 1fc9112..51b93ff 100644 --- a/compiler/simplCore/Simplify.hs +++ b/compiler/simplCore/Simplify.hs @@ -36,7 +36,8 @@ import CoreUnfold import CoreUtils import CoreArity import CoreOpt ( pushCoTyArg, pushCoValArg - , joinPointBinding_maybe, joinPointBindings_maybe ) + , joinPointBinding_maybe, joinPointBindings_maybe + , loopificationJoinPointBinding_maybe ) --import PrimOp ( tagToEnumKey ) -- temporalily commented out. See #8326 import Rules ( mkRuleInfo, lookupRule, getRules ) --import TysPrim ( intPrimTy ) -- temporalily commented out. See #8326 @@ -1637,6 +1638,7 @@ simplRecE :: SimplEnv -- simplRecE is used for -- * non-top-level recursive lets in expressions simplRecE env pairs body cont + | Just pairs' <- joinPointBindings_maybe pairs = do { (env1, cont') <- prepareJoinCont env cont ; let bndrs' = map fst pairs' @@ -1647,6 +1649,19 @@ simplRecE env pairs body cont ; env3 <- simplRecBind env2 NotTopLevel (Just cont') pairs' ; simplExprF env3 body cont' } + -- Is this a tail-recursive function that we want to loopify? Then + -- lets loopify it and re-analyse. + | [(bndr,rhs)] <- pairs + , Just (join_bndr, join_rhs) <- loopificationJoinPointBinding_maybe bndr rhs + , let Just arity = isJoinId_maybe join_bndr + = do { let (join_params, _join_body) = collectNBinders arity join_rhs + ; let bndr' = zapFragileIdInfo bndr -- TODO: What do we have to zap here? + ; let rhs' = mkLams join_params $ + mkLetRec [(join_bndr,join_rhs)] $ + mkVarApps (Var join_bndr) join_params + ; simplNonRecE env bndr' (rhs', env) ([], body) cont + } + | otherwise = do { let bndrs = map fst pairs ; MASSERT(all (not . isJoinId) bndrs) From git at git.haskell.org Tue Aug 1 15:14:21 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 1 Aug 2017 15:14:21 +0000 (UTC) Subject: [commit: ghc] wip/T14068: Also loopify global bindings (#14068) (4fa85c9) Message-ID: <20170801151421.5AB213A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14068 Link : http://ghc.haskell.org/trac/ghc/changeset/4fa85c9636e9481de4d3c1cae125aa1e5f95d459/ghc >--------------------------------------------------------------- commit 4fa85c9636e9481de4d3c1cae125aa1e5f95d459 Author: Joachim Breitner Date: Tue Aug 1 11:13:21 2017 -0400 Also loopify global bindings (#14068) >--------------------------------------------------------------- 4fa85c9636e9481de4d3c1cae125aa1e5f95d459 compiler/coreSyn/CoreOpt.hs | 7 +++++-- compiler/simplCore/OccurAnal.hs | 17 ++++++++++------- compiler/simplCore/Simplify.hs | 36 ++++++++++++++++++++++-------------- 3 files changed, 37 insertions(+), 23 deletions(-) diff --git a/compiler/coreSyn/CoreOpt.hs b/compiler/coreSyn/CoreOpt.hs index 0dae086..88f7b41 100644 --- a/compiler/coreSyn/CoreOpt.hs +++ b/compiler/coreSyn/CoreOpt.hs @@ -659,10 +659,13 @@ loopificationJoinPointBinding_maybe bndr rhs | isJoinId bndr = Nothing -- do not loopificate again - | RecursiveTailCalled join_arity <- tailCallInfo (idOccInfo bndr) + | let occ = idOccInfo bndr + , RecursiveTailCalled join_arity <- tailCallInfo occ , not (badUnfoldingForJoin join_arity bndr) , (bndrs, body) <- etaExpandToJoinPoint join_arity rhs - = Just (bndr `asJoinId` join_arity, mkLams bndrs body) + = let occ' = occ { occ_tail = AlwaysTailCalled join_arity } + bndr' = setIdOccInfo bndr occ' + in Just (bndr' `asJoinId` join_arity, mkLams bndrs body) | otherwise = Nothing diff --git a/compiler/simplCore/OccurAnal.hs b/compiler/simplCore/OccurAnal.hs index a652e1c..a16b761 100644 --- a/compiler/simplCore/OccurAnal.hs +++ b/compiler/simplCore/OccurAnal.hs @@ -2660,15 +2660,17 @@ tagRecBinders lvl body_uds triples -- 4. Tag each binder with its adjusted details bndrs' - -- 4a. If this is only one function, and the recursive calls are - -- tail calls, then the simplifier turn it into a non-recursive function - -- with a local joinrec. - | [bndr] <- bndrs + -- 4a. If this is the only one function, not a join-point already + -- and the _recursive calls_ are all tail calls, then the simplifier + -- can loopify it with a local joinrec. Mark it as such. + | not will_be_joins + , [bndr] <- bndrs , let occ_rhs = lookupDetails unadj_uds_rhss bndr , AlwaysTailCalled arity <- tailCallInfo occ_rhs - = let occ = lookupDetails adj_uds bndr - occ' = markRecursiveTailCalled arity occ - in [ setBinderOcc occ' bndr ] + = let occ = lookupDetails adj_uds bndr + occ' = markRecursiveTailCalled arity occ + bndr' = setIdOccInfo bndr occ' + in [bndr'] -- 4b. Otherwise, just use the adjusted details | otherwise = [ setBinderOcc (lookupDetails adj_uds bndr) bndr @@ -2677,6 +2679,7 @@ tagRecBinders lvl body_uds triples -- 5. Drop the binders from the adjusted details and return usage' = adj_uds `delDetailsList` bndrs in + pprTrace "tagRecBinders" (ppr bndrs <+> ppr (map idOccInfo bndrs') <+> ppr unadj_uds_rhss) $ (usage', bndrs') setBinderOcc :: OccInfo -> CoreBndr -> CoreBndr diff --git a/compiler/simplCore/Simplify.hs b/compiler/simplCore/Simplify.hs index 51b93ff..362989e 100644 --- a/compiler/simplCore/Simplify.hs +++ b/compiler/simplCore/Simplify.hs @@ -266,6 +266,8 @@ simplTopBinds env0 binds0 simpl_binds env (bind:binds) = do { env' <- simpl_bind env bind ; simpl_binds env' binds } + simpl_bind env bind | Just bind' <- maybeLoopify bind + = simpl_bind env bind' simpl_bind env (Rec pairs) = simplRecBind env TopLevel Nothing pairs simpl_bind env (NonRec b r) = do { (env', b') <- addBndrRules env b (lookupRecBndr env b) ; simplRecOrTopPair env' TopLevel @@ -1127,6 +1129,10 @@ simplExprF1 env (Case scrut bndr _ alts) cont env'' = env `addLetFloats` env' ; rebuildCase env'' scrut'' bndr alts cont } +simplExprF1 env (Let bind body) cont + | Just bind' <- maybeLoopify bind + = simplExprF1 env (Let bind' body) cont + simplExprF1 env (Let (Rec pairs) body) cont = simplRecE env pairs body cont @@ -1638,7 +1644,6 @@ simplRecE :: SimplEnv -- simplRecE is used for -- * non-top-level recursive lets in expressions simplRecE env pairs body cont - | Just pairs' <- joinPointBindings_maybe pairs = do { (env1, cont') <- prepareJoinCont env cont ; let bndrs' = map fst pairs' @@ -1649,19 +1654,6 @@ simplRecE env pairs body cont ; env3 <- simplRecBind env2 NotTopLevel (Just cont') pairs' ; simplExprF env3 body cont' } - -- Is this a tail-recursive function that we want to loopify? Then - -- lets loopify it and re-analyse. - | [(bndr,rhs)] <- pairs - , Just (join_bndr, join_rhs) <- loopificationJoinPointBinding_maybe bndr rhs - , let Just arity = isJoinId_maybe join_bndr - = do { let (join_params, _join_body) = collectNBinders arity join_rhs - ; let bndr' = zapFragileIdInfo bndr -- TODO: What do we have to zap here? - ; let rhs' = mkLams join_params $ - mkLetRec [(join_bndr,join_rhs)] $ - mkVarApps (Var join_bndr) join_params - ; simplNonRecE env bndr' (rhs', env) ([], body) cont - } - | otherwise = do { let bndrs = map fst pairs ; MASSERT(all (not . isJoinId) bndrs) @@ -1671,6 +1663,22 @@ simplRecE env pairs body cont ; env2 <- simplRecBind env1 NotTopLevel Nothing pairs ; simplExprF env2 body cont } + +-- Is this a tail-recursive function that we want to loopify? Then +-- lets loopify it and simplify that +maybeLoopify :: InBind -> Maybe InBind +maybeLoopify (Rec [(bndr, rhs)]) + | Just (join_bndr, join_rhs) <- loopificationJoinPointBinding_maybe bndr rhs + = do { let Just arity = isJoinId_maybe join_bndr + ; let (join_params, _join_body) = collectNBinders arity join_rhs + ; let bndr' = zapFragileIdInfo bndr -- TODO: What do we have to zap here? + ; let rhs' = mkLams join_params $ + mkLetRec [(join_bndr,join_rhs)] $ + mkVarApps (Var join_bndr) join_params + ; Just (NonRec bndr' rhs') + } +maybeLoopify _ = Nothing + {- ************************************************************************ * * From git at git.haskell.org Tue Aug 1 20:13:46 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 1 Aug 2017 20:13:46 +0000 (UTC) Subject: [commit: ghc] master: Enable building Cabal with parsec (36fe21a) Message-ID: <20170801201346.229CA3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/36fe21aa3fe5abe1cef0104b20c296ac9385658d/ghc >--------------------------------------------------------------- commit 36fe21aa3fe5abe1cef0104b20c296ac9385658d Author: Herbert Valerio Riedel Date: Tue Aug 1 11:05:18 2017 -0400 Enable building Cabal with parsec Cabal's parser has been rewritten in terms of Parsec (which is not enabled yet in Cabal-2.0 by default, but can be enabled by a cabal flag). The plan for Cabal is to drop support for the non-parsec parser, so we need to prepare GHC to cope with new situation. However, this means that lib:Cabal requires three new library dependency submodules, - parsec - text - mtl What complicates matters is that we need to build `ghc-cabal` early on during the bootstrap phase which currently needs to invoke `ghc --make` directly. So these additional dependencies need to be integrated into the monolithic `ghc --make` invocation which produces the `ghc-cabal` executable. Test Plan: `./validate --fast` passed Reviewers: austin, bgamari Subscribers: erikd, phadej, rwbarton, thomie Differential Revision: https://phabricator.haskell.org/D3757 >--------------------------------------------------------------- 36fe21aa3fe5abe1cef0104b20c296ac9385658d configure.ac | 4 ++-- ghc.mk | 11 +++++++++-- libraries/mtl | 1 + libraries/parsec | 1 + libraries/text | 1 + mk/warnings.mk | 5 +++++ packages | 3 +++ rules/sdist-ghc-file.mk | 31 +++++++++++++++++++++++++++++++ utils/ghc-cabal/ghc.mk | 25 ++++++++++++++++++++++--- 9 files changed, 75 insertions(+), 7 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 36fe21aa3fe5abe1cef0104b20c296ac9385658d From git at git.haskell.org Tue Aug 1 20:13:48 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 1 Aug 2017 20:13:48 +0000 (UTC) Subject: [commit: ghc] master: Bump unix submodule (9df71bf) Message-ID: <20170801201348.D28C33A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9df71bfb73a2d550789115b66e49462bda51c357/ghc >--------------------------------------------------------------- commit 9df71bfb73a2d550789115b66e49462bda51c357 Author: Ben Gamari Date: Tue Aug 1 11:10:46 2017 -0400 Bump unix submodule >--------------------------------------------------------------- 9df71bfb73a2d550789115b66e49462bda51c357 libraries/unix | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/unix b/libraries/unix index fcaa530..063aea3 160000 --- a/libraries/unix +++ b/libraries/unix @@ -1 +1 @@ -Subproject commit fcaa530a8fdd3897353bdf246752a91d675aad46 +Subproject commit 063aea3fbc5a8caa03d0deb9a887763006ab86df From git at git.haskell.org Tue Aug 1 20:52:38 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 1 Aug 2017 20:52:38 +0000 (UTC) Subject: [commit: ghc] master: Add .gitmodules entries for text, parsec, mtl submodules (8ef8520) Message-ID: <20170801205238.04D793A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8ef852098286749af1165e1215204a5de63babaf/ghc >--------------------------------------------------------------- commit 8ef852098286749af1165e1215204a5de63babaf Author: Ben Gamari Date: Tue Aug 1 16:51:41 2017 -0400 Add .gitmodules entries for text, parsec, mtl submodules >--------------------------------------------------------------- 8ef852098286749af1165e1215204a5de63babaf .gitmodules | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/.gitmodules b/.gitmodules index 07ed3b7..9e0e805 100644 --- a/.gitmodules +++ b/.gitmodules @@ -74,6 +74,18 @@ path = libraries/hpc url = ../packages/hpc.git ignore = none +[submodule "libraries/parsec"] + path = libraries/parsec + url = ../packages/parsec.git + ignore = none +[submodule "libraries/text"] + path = libraries/text + url = ../packages/text.git + ignore = none +[submodule "libraries/mtl"] + path = libraries/mtl + url = ../packages/mtl.git + ignore = none [submodule "libraries/process"] path = libraries/process url = ../packages/process.git From git at git.haskell.org Wed Aug 2 03:07:02 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 2 Aug 2017 03:07:02 +0000 (UTC) Subject: [commit: ghc] wip/T14068: Loopification: Keep IdInfo on the outer binder (deab10c) Message-ID: <20170802030702.7FE8E3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14068 Link : http://ghc.haskell.org/trac/ghc/changeset/deab10c80b98655cdf9ed22addaba8b0966797e0/ghc >--------------------------------------------------------------- commit deab10c80b98655cdf9ed22addaba8b0966797e0 Author: Joachim Breitner Date: Tue Aug 1 11:43:15 2017 -0400 Loopification: Keep IdInfo on the outer binder e.g. RULES should be unaffected. Also localise the inner binder. >--------------------------------------------------------------- deab10c80b98655cdf9ed22addaba8b0966797e0 compiler/coreSyn/CoreOpt.hs | 14 +++++++++++--- compiler/simplCore/Simplify.hs | 3 +-- 2 files changed, 12 insertions(+), 5 deletions(-) diff --git a/compiler/coreSyn/CoreOpt.hs b/compiler/coreSyn/CoreOpt.hs index 88f7b41..5949cf6 100644 --- a/compiler/coreSyn/CoreOpt.hs +++ b/compiler/coreSyn/CoreOpt.hs @@ -651,7 +651,8 @@ joinPointBinding_maybe bndr rhs = Nothing -- | like joinPointBinding_maybe, but looks for RecursiveTailCalled -loopificationJoinPointBinding_maybe :: InBndr -> InExpr -> Maybe (InBndr, InExpr) +-- Returns both the new outer and the new inner binder +loopificationJoinPointBinding_maybe :: InBndr -> InExpr -> Maybe (InBndr, InBndr, InExpr) loopificationJoinPointBinding_maybe bndr rhs | not (isId bndr) = Nothing @@ -664,8 +665,15 @@ loopificationJoinPointBinding_maybe bndr rhs , not (badUnfoldingForJoin join_arity bndr) , (bndrs, body) <- etaExpandToJoinPoint join_arity rhs = let occ' = occ { occ_tail = AlwaysTailCalled join_arity } - bndr' = setIdOccInfo bndr occ' - in Just (bndr' `asJoinId` join_arity, mkLams bndrs body) + -- What all do we have to zap? + join_bndr = (`asJoinId` join_arity) $ + (`setIdOccInfo` occ') $ + zapFragileIdInfo $ + localiseId $ + bndr + -- RULES etc stay with bindr' + bndr' = zapIdTailCallInfo bndr + in Just (bndr', join_bndr, mkLams bndrs body) | otherwise = Nothing diff --git a/compiler/simplCore/Simplify.hs b/compiler/simplCore/Simplify.hs index 362989e..c612b2f 100644 --- a/compiler/simplCore/Simplify.hs +++ b/compiler/simplCore/Simplify.hs @@ -1668,10 +1668,9 @@ simplRecE env pairs body cont -- lets loopify it and simplify that maybeLoopify :: InBind -> Maybe InBind maybeLoopify (Rec [(bndr, rhs)]) - | Just (join_bndr, join_rhs) <- loopificationJoinPointBinding_maybe bndr rhs + | Just (bndr', join_bndr, join_rhs) <- loopificationJoinPointBinding_maybe bndr rhs = do { let Just arity = isJoinId_maybe join_bndr ; let (join_params, _join_body) = collectNBinders arity join_rhs - ; let bndr' = zapFragileIdInfo bndr -- TODO: What do we have to zap here? ; let rhs' = mkLams join_params $ mkLetRec [(join_bndr,join_rhs)] $ mkVarApps (Var join_bndr) join_params From git at git.haskell.org Wed Aug 2 03:07:05 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 2 Aug 2017 03:07:05 +0000 (UTC) Subject: [commit: ghc] wip/T14068: Loopification: Preserver Invariant 4, polymorphism rule (34a0e05) Message-ID: <20170802030705.40EB33A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14068 Link : http://ghc.haskell.org/trac/ghc/changeset/34a0e054c60a442bb8b520450f1792a138145af6/ghc >--------------------------------------------------------------- commit 34a0e054c60a442bb8b520450f1792a138145af6 Author: Joachim Breitner Date: Tue Aug 1 12:23:38 2017 -0400 Loopification: Preserver Invariant 4, polymorphism rule >--------------------------------------------------------------- 34a0e054c60a442bb8b520450f1792a138145af6 compiler/simplCore/OccurAnal.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/compiler/simplCore/OccurAnal.hs b/compiler/simplCore/OccurAnal.hs index a16b761..4742b41 100644 --- a/compiler/simplCore/OccurAnal.hs +++ b/compiler/simplCore/OccurAnal.hs @@ -2667,6 +2667,8 @@ tagRecBinders lvl body_uds triples , [bndr] <- bndrs , let occ_rhs = lookupDetails unadj_uds_rhss bndr , AlwaysTailCalled arity <- tailCallInfo occ_rhs + -- Could do better, see note [Excess polymorphism and join points] + , isValidJoinPointType arity (idType bndr) = let occ = lookupDetails adj_uds bndr occ' = markRecursiveTailCalled arity occ bndr' = setIdOccInfo bndr occ' From git at git.haskell.org Wed Aug 2 03:07:10 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 2 Aug 2017 03:07:10 +0000 (UTC) Subject: [commit: ghc] wip/T14068: Remove modifyJoinResTy (2e513a6) Message-ID: <20170802030710.AEA1C3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14068 Link : http://ghc.haskell.org/trac/ghc/changeset/2e513a6dbde8308768d793ccf285377e3ed231b8/ghc >--------------------------------------------------------------- commit 2e513a6dbde8308768d793ccf285377e3ed231b8 Author: Joachim Breitner Date: Tue Aug 1 22:27:34 2017 -0400 Remove modifyJoinResTy only used in setJoinResTy, so lets just have that one. >--------------------------------------------------------------- 2e513a6dbde8308768d793ccf285377e3ed231b8 compiler/types/Type.hs | 24 ++++++++---------------- 1 file changed, 8 insertions(+), 16 deletions(-) diff --git a/compiler/types/Type.hs b/compiler/types/Type.hs index b81192f..50a35b0 100644 --- a/compiler/types/Type.hs +++ b/compiler/types/Type.hs @@ -61,7 +61,7 @@ module Type ( filterOutInvisibleTyVars, partitionInvisibles, synTyConResKind, - modifyJoinResTy, setJoinResTy, + setJoinResTy, -- Analyzing types TyCoMapper(..), mapType, mapCoercion, @@ -2439,25 +2439,17 @@ splitVisVarsOfType orig_ty = Pair invis_vars vis_vars splitVisVarsOfTypes :: [Type] -> Pair TyCoVarSet splitVisVarsOfTypes = foldMap splitVisVarsOfType -modifyJoinResTy :: Int -- Number of binders to skip - -> (Type -> Type) -- Function to apply to result type - -> Type -- Type of join point - -> Type -- New type +setJoinResTy :: Int -- Number of binders to skip + -> Type -- New result type + -> Type -- Type of join point + -> Type -- New type -- INVARIANT: If any of the first n binders are foralls, those tyvars cannot -- appear in the original result type. See isValidJoinPointType. -modifyJoinResTy orig_ar f orig_ty +setJoinResTy orig_ar new_res_ty orig_ty = go orig_ar orig_ty where - go 0 ty = f ty + go 0 _ = new_res_ty go n ty | Just (arg_bndr, res_ty) <- splitPiTy_maybe ty = mkPiTy arg_bndr (go (n-1) res_ty) | otherwise - = pprPanic "modifyJoinResTy" (ppr orig_ar <+> ppr orig_ty) - -setJoinResTy :: Int -- Number of binders to skip - -> Type -- New result type - -> Type -- Type of join point - -> Type -- New type --- INVARIANT: Same as for modifyJoinResTy -setJoinResTy ar new_res_ty ty - = modifyJoinResTy ar (const new_res_ty) ty + = pprPanic "setJoinResTy" (ppr orig_ar <+> ppr orig_ty) From git at git.haskell.org Wed Aug 2 03:07:07 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 2 Aug 2017 03:07:07 +0000 (UTC) Subject: [commit: ghc] wip/T14068: zap RecursiveTailCalled in zapTailCallInfo as well (03ea626) Message-ID: <20170802030707.F15B33A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14068 Link : http://ghc.haskell.org/trac/ghc/changeset/03ea62602e550973301243025f3625681c21b157/ghc >--------------------------------------------------------------- commit 03ea62602e550973301243025f3625681c21b157 Author: Joachim Breitner Date: Tue Aug 1 18:26:36 2017 -0400 zap RecursiveTailCalled in zapTailCallInfo as well >--------------------------------------------------------------- 03ea62602e550973301243025f3625681c21b157 compiler/basicTypes/BasicTypes.hs | 8 +++++++- compiler/basicTypes/IdInfo.hs | 4 ++-- compiler/simplCore/OccurAnal.hs | 3 +-- 3 files changed, 10 insertions(+), 5 deletions(-) diff --git a/compiler/basicTypes/BasicTypes.hs b/compiler/basicTypes/BasicTypes.hs index 284ddfe..a88ae59 100644 --- a/compiler/basicTypes/BasicTypes.hs +++ b/compiler/basicTypes/BasicTypes.hs @@ -72,7 +72,7 @@ module BasicTypes( OneBranch, oneBranch, notOneBranch, InterestingCxt, TailCallInfo(..), tailCallInfo, zapOccTailCallInfo, - isAlwaysTailCalled, + isAlwaysTailCalled, isSometimesTailCalled, EP(..), @@ -953,6 +953,12 @@ isAlwaysTailCalled occ RecursiveTailCalled {} -> False NoTailCallInfo -> False +isSometimesTailCalled :: OccInfo -> Bool +isSometimesTailCalled occ + = case tailCallInfo occ of AlwaysTailCalled{} -> True + RecursiveTailCalled {} -> True + NoTailCallInfo -> False + instance Outputable TailCallInfo where ppr (AlwaysTailCalled ar) = sep [ text "Tail", int ar ] ppr (RecursiveTailCalled ar) = sep [ text "Tail(rec)", int ar ] diff --git a/compiler/basicTypes/IdInfo.hs b/compiler/basicTypes/IdInfo.hs index bd6ec8f..380f2f9 100644 --- a/compiler/basicTypes/IdInfo.hs +++ b/compiler/basicTypes/IdInfo.hs @@ -548,8 +548,8 @@ zapFragileUnfolding unf zapTailCallInfo :: IdInfo -> Maybe IdInfo zapTailCallInfo info = case occInfo info of - occ | isAlwaysTailCalled occ -> Just (info `setOccInfo` safe_occ) - | otherwise -> Nothing + occ | isSometimesTailCalled occ -> Just (info `setOccInfo` safe_occ) + | otherwise -> Nothing where safe_occ = occ { occ_tail = NoTailCallInfo } diff --git a/compiler/simplCore/OccurAnal.hs b/compiler/simplCore/OccurAnal.hs index 4742b41..024782d 100644 --- a/compiler/simplCore/OccurAnal.hs +++ b/compiler/simplCore/OccurAnal.hs @@ -2660,7 +2660,7 @@ tagRecBinders lvl body_uds triples -- 4. Tag each binder with its adjusted details bndrs' - -- 4a. If this is the only one function, not a join-point already + -- 4a. If this is the only function, not a join-point already -- and the _recursive calls_ are all tail calls, then the simplifier -- can loopify it with a local joinrec. Mark it as such. | not will_be_joins @@ -2681,7 +2681,6 @@ tagRecBinders lvl body_uds triples -- 5. Drop the binders from the adjusted details and return usage' = adj_uds `delDetailsList` bndrs in - pprTrace "tagRecBinders" (ppr bndrs <+> ppr (map idOccInfo bndrs') <+> ppr unadj_uds_rhss) $ (usage', bndrs') setBinderOcc :: OccInfo -> CoreBndr -> CoreBndr From git at git.haskell.org Wed Aug 2 03:07:13 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 2 Aug 2017 03:07:13 +0000 (UTC) Subject: [commit: ghc] wip/T14068: Avoid name capture in setJoinResTy (6a50466) Message-ID: <20170802030713.6A4773A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14068 Link : http://ghc.haskell.org/trac/ghc/changeset/6a5046684f93f1870663119b447fff6baeb7a7c4/ghc >--------------------------------------------------------------- commit 6a5046684f93f1870663119b447fff6baeb7a7c4 Author: Joachim Breitner Date: Tue Aug 1 22:48:26 2017 -0400 Avoid name capture in setJoinResTy >--------------------------------------------------------------- 6a5046684f93f1870663119b447fff6baeb7a7c4 compiler/types/Type.hs | 22 ++++++++++++++++------ 1 file changed, 16 insertions(+), 6 deletions(-) diff --git a/compiler/types/Type.hs b/compiler/types/Type.hs index 50a35b0..c69d4ff 100644 --- a/compiler/types/Type.hs +++ b/compiler/types/Type.hs @@ -2445,11 +2445,21 @@ setJoinResTy :: Int -- Number of binders to skip -> Type -- New type -- INVARIANT: If any of the first n binders are foralls, those tyvars cannot -- appear in the original result type. See isValidJoinPointType. +-- +-- When we set the return type under a forall, avoid capture! setJoinResTy orig_ar new_res_ty orig_ty - = go orig_ar orig_ty + = go init_subst orig_ar orig_ty where - go 0 _ = new_res_ty - go n ty | Just (arg_bndr, res_ty) <- splitPiTy_maybe ty - = mkPiTy arg_bndr (go (n-1) res_ty) - | otherwise - = pprPanic "setJoinResTy" (ppr orig_ar <+> ppr orig_ty) + init_subst :: TCvSubst + init_subst = mkEmptyTCvSubst (mkInScopeSet (tyCoVarsOfType new_res_ty)) + + go _ 0 _ = new_res_ty + go subst n ty + | Just (t, ty') <- splitForAllTy_maybe ty + , let (subst', t') = substTyVarBndr subst t + = mkForAllTy t' Inferred (go subst' (n-1) ty') + | Just (arg_ty, ty') <- splitFunTy_maybe ty + , let arg_ty' = substTy subst arg_ty + = mkFunTy arg_ty' (go subst (n-1) ty') + | otherwise + = pprPanic "setJoinResTy" (ppr orig_ar <+> ppr orig_ty) From git at git.haskell.org Wed Aug 2 15:40:44 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 2 Aug 2017 15:40:44 +0000 (UTC) Subject: [commit: ghc] wip/T14068: During loopification, zap occurrence info on the lambda binders (156f879) Message-ID: <20170802154044.F41FF3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14068 Link : http://ghc.haskell.org/trac/ghc/changeset/156f8790d07e276eaf105eaab191149569e66eb0/ghc >--------------------------------------------------------------- commit 156f8790d07e276eaf105eaab191149569e66eb0 Author: Joachim Breitner Date: Wed Aug 2 10:04:48 2017 -0400 During loopification, zap occurrence info on the lambda binders If we have letrec f x[dead] = … f () … in g f loopification turns that into let f x = joinrec f x[dead] = … f () … in jump j x in g f Note that the parameter x of f is no longer dead! >--------------------------------------------------------------- 156f8790d07e276eaf105eaab191149569e66eb0 compiler/simplCore/Simplify.hs | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/compiler/simplCore/Simplify.hs b/compiler/simplCore/Simplify.hs index c612b2f..6ccd1f2 100644 --- a/compiler/simplCore/Simplify.hs +++ b/compiler/simplCore/Simplify.hs @@ -1671,9 +1671,13 @@ maybeLoopify (Rec [(bndr, rhs)]) | Just (bndr', join_bndr, join_rhs) <- loopificationJoinPointBinding_maybe bndr rhs = do { let Just arity = isJoinId_maybe join_bndr ; let (join_params, _join_body) = collectNBinders arity join_rhs - ; let rhs' = mkLams join_params $ + ; let join_params' = + [ if isId var then zapIdOccInfo var else var + | var <- join_params ] + -- Some might be marked as dead (in the RHS), but there are not dead here + ; let rhs' = mkLams join_params' $ mkLetRec [(join_bndr,join_rhs)] $ - mkVarApps (Var join_bndr) join_params + mkVarApps (Var join_bndr) join_params' ; Just (NonRec bndr' rhs') } maybeLoopify _ = Nothing From git at git.haskell.org Wed Aug 2 15:40:47 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 2 Aug 2017 15:40:47 +0000 (UTC) Subject: [commit: ghc] wip/T14068: Update test cases that check Core output (a92dffe) Message-ID: <20170802154047.B89693A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14068 Link : http://ghc.haskell.org/trac/ghc/changeset/a92dffe9090e41964fd45f9d6ba5a6bc188e25f9/ghc >--------------------------------------------------------------- commit a92dffe9090e41964fd45f9d6ba5a6bc188e25f9 Author: Joachim Breitner Date: Wed Aug 2 10:40:23 2017 -0400 Update test cases that check Core output We see many recursive functions being inlined as jointrecs! (Also, test cases that simply check the `-ddump-simpl` are not really useful, and time-consuming. At least `grep` on relevant bits…) >--------------------------------------------------------------- a92dffe9090e41964fd45f9d6ba5a6bc188e25f9 .../tests/simplCore/should_compile/T12603.stdout | 2 +- .../tests/simplCore/should_compile/T13143.stderr | 75 ++- .../tests/simplCore/should_compile/T3717.stderr | 64 ++- .../tests/simplCore/should_compile/T3772.stdout | 27 +- .../tests/simplCore/should_compile/T4908.stderr | 80 ++- .../tests/simplCore/should_compile/T7360.stderr | 43 +- .../simplCore/should_compile/spec-inline.stderr | 166 +++--- .../tests/stranal/should_compile/T10482.stderr | 279 +++++++++- .../tests/stranal/should_compile/T10482a.stderr | 590 ++++++++++++++++++++- 9 files changed, 1103 insertions(+), 223 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 a92dffe9090e41964fd45f9d6ba5a6bc188e25f9 From git at git.haskell.org Wed Aug 2 15:40:50 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 2 Aug 2017 15:40:50 +0000 (UTC) Subject: [commit: ghc] wip/T14068: Disable test case for #4030 and #5644 (9e902ca) Message-ID: <20170802154050.7AD073A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14068 Link : http://ghc.haskell.org/trac/ghc/changeset/9e902ca6cb43ba8a2154bfeb2126aa4299c040cc/ghc >--------------------------------------------------------------- commit 9e902ca6cb43ba8a2154bfeb2126aa4299c040cc Author: Joachim Breitner Date: Wed Aug 2 10:43:04 2017 -0400 Disable test case for #4030 and #5644 With loopification, T4030 always goes into an infinite loop. Not nice when running the test suite. Also, with loopification, T5644 no longer runs out of heap, so it does not trigger the out-of-heap exception that the test case was testing. >--------------------------------------------------------------- 9e902ca6cb43ba8a2154bfeb2126aa4299c040cc testsuite/tests/concurrent/should_run/all.T | 4 +++- testsuite/tests/rts/T5644/ManyQueue.hs | 0 testsuite/tests/rts/T5644/all.T | 4 +++- 3 files changed, 6 insertions(+), 2 deletions(-) diff --git a/testsuite/tests/concurrent/should_run/all.T b/testsuite/tests/concurrent/should_run/all.T index 69b8ad7..797804c 100644 --- a/testsuite/tests/concurrent/should_run/all.T +++ b/testsuite/tests/concurrent/should_run/all.T @@ -41,7 +41,9 @@ test('T3429', [ extra_run_opts('+RTS -C0.001 -RTS'), # without -O, goes into an infinite loop # GHCi does not detect the infinite loop. We should really fix this. -test('T4030', omit_ways('ghci'), compile_and_run, ['-O']) +# With loopification (#14068), always goes into an infinite loop. Disabling for +# now. +# test('T4030', omit_ways('ghci'), compile_and_run, ['-O']) # each of these runs for about a second test('throwto001', [reqlib('random'), extra_run_opts('1000 2000')], diff --git a/testsuite/tests/rts/T5644/all.T b/testsuite/tests/rts/T5644/all.T index 7dd120d..1711992 100644 --- a/testsuite/tests/rts/T5644/all.T +++ b/testsuite/tests/rts/T5644/all.T @@ -2,7 +2,9 @@ test('T5644', [extra_files(['Conf.hs', 'ManyQueue.hs', 'Util.hs', 'heap-overflow only_ways(['optasm','threaded1','threaded2']), extra_run_opts('+RTS -M20m -RTS'), - exit_code(251) # RTS exit code for "out of memory" + exit_code(251), # RTS exit code for "out of memory" + # With loopification, the code does no longer run out of heap space: + expect_broken(14068) ], multimod_compile_and_run, ['heap-overflow.hs','-O']) From git at git.haskell.org Wed Aug 2 15:40:53 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 2 Aug 2017 15:40:53 +0000 (UTC) Subject: [commit: ghc] wip/T14068: Mark `eqString` as `NOINLINE` (a809ef6) Message-ID: <20170802154053.3D5AA3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14068 Link : http://ghc.haskell.org/trac/ghc/changeset/a809ef6666a193979a997828dcf75f1b9ac3356b/ghc >--------------------------------------------------------------- commit a809ef6666a193979a997828dcf75f1b9ac3356b Author: Joachim Breitner Date: Wed Aug 2 10:53:37 2017 -0400 Mark `eqString` as `NOINLINE` so that the built-in rule can still match. This will be a problem in general: With loopification, recursive functions can now inline (yay!) but many people out there probably rely on the fact that recursive functions cannot inline (ouch). Hopefully the recent warnings in GHC made them fix this before loopification reaches them. >--------------------------------------------------------------- a809ef6666a193979a997828dcf75f1b9ac3356b libraries/base/GHC/Base.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/libraries/base/GHC/Base.hs b/libraries/base/GHC/Base.hs index ffcd7ff..f25a861 100644 --- a/libraries/base/GHC/Base.hs +++ b/libraries/base/GHC/Base.hs @@ -1053,6 +1053,7 @@ eqString :: String -> String -> Bool eqString [] [] = True eqString (c1:cs1) (c2:cs2) = c1 == c2 && cs1 `eqString` cs2 eqString _ _ = False +{-# NOINLINE eqString #-} {-# RULES "eqString" (==) = eqString #-} -- eqString also has a BuiltInRule in PrelRules.hs: From git at git.haskell.org Wed Aug 2 15:40:55 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 2 Aug 2017 15:40:55 +0000 (UTC) Subject: [commit: ghc] wip/T14068: Do not inline showWord (9cbb784) Message-ID: <20170802154055.ED1FD3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14068 Link : http://ghc.haskell.org/trac/ghc/changeset/9cbb7848ac00c4777901f32d2a7f3d24704e2aac/ghc >--------------------------------------------------------------- commit 9cbb7848ac00c4777901f32d2a7f3d24704e2aac Author: Joachim Breitner Date: Wed Aug 2 11:26:22 2017 -0400 Do not inline showWord mostly because otherwise the test setup of #7014 fails. (The test checks for the absence of certain primops in the code, but inlining showWords adds many of these.) >--------------------------------------------------------------- 9cbb7848ac00c4777901f32d2a7f3d24704e2aac libraries/base/GHC/Show.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/libraries/base/GHC/Show.hs b/libraries/base/GHC/Show.hs index 6965335..ecd7db8 100644 --- a/libraries/base/GHC/Show.hs +++ b/libraries/base/GHC/Show.hs @@ -196,6 +196,7 @@ showWord w# cs | otherwise = case chr# (ord# '0'# +# word2Int# (w# `remWord#` 10##)) of c# -> showWord (w# `quotWord#` 10##) (C# c# : cs) +{-# NOINLINE showWord #-} deriving instance Show a => Show (Maybe a) From git at git.haskell.org Wed Aug 2 17:03:00 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 2 Aug 2017 17:03:00 +0000 (UTC) Subject: [commit: ghc] master: Get the roles right for newtype instances (d74983e) Message-ID: <20170802170300.C311B3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d74983ef0c4a5b47a53d2821f8be9ebbf86e9257/ghc >--------------------------------------------------------------- commit d74983ef0c4a5b47a53d2821f8be9ebbf86e9257 Author: Simon Peyton Jones Date: Wed Aug 2 12:59:56 2017 -0400 Get the roles right for newtype instances This was a simple slip, that gave rise to the bug reported in comment:13 of Trac #14045. We were supplying roles to mkAlgTyCon that didn't match the tyvars. >--------------------------------------------------------------- d74983ef0c4a5b47a53d2821f8be9ebbf86e9257 compiler/typecheck/TcInstDcls.hs | 2 +- compiler/types/Type.hs | 8 ++++++-- testsuite/tests/deriving/should_compile/T14045b.hs | 13 +++++++++++++ testsuite/tests/deriving/should_compile/all.T | 1 + 4 files changed, 21 insertions(+), 3 deletions(-) diff --git a/compiler/typecheck/TcInstDcls.hs b/compiler/typecheck/TcInstDcls.hs index fe513f4..58d4506 100644 --- a/compiler/typecheck/TcInstDcls.hs +++ b/compiler/typecheck/TcInstDcls.hs @@ -695,7 +695,7 @@ tcDataFamInstDecl mb_clsinfo -- the end of Note [Data type families] in TyCon rep_tc = mkAlgTyCon rep_tc_name ty_binders liftedTypeKind - (map (const Nominal) full_tvs) + (map (const Nominal) ty_binders) (fmap unLoc cType) stupid_theta tc_rhs parent gadt_syntax diff --git a/compiler/types/Type.hs b/compiler/types/Type.hs index b81192f..dcc134c 100644 --- a/compiler/types/Type.hs +++ b/compiler/types/Type.hs @@ -1315,8 +1315,12 @@ mkLamType v ty mkLamTypes vs ty = foldr mkLamType ty vs --- | Given a list of type-level vars and a result type, makes TyBinders, preferring --- anonymous binders if the variable is, in fact, not dependent. +-- | Given a list of type-level vars and a result kind, +-- makes TyBinders, preferring anonymous binders +-- if the variable is, in fact, not dependent. +-- e.g. mkTyConBindersPreferAnon [(k:*),(b:k),(c:k)] (k->k) +-- We want (k:*) Named, (a;k) Anon, (c:k) Anon +-- -- All binders are /visible/. mkTyConBindersPreferAnon :: [TyVar] -> Type -> [TyConBinder] mkTyConBindersPreferAnon vars inner_ty = fst (go vars) diff --git a/testsuite/tests/deriving/should_compile/T14045b.hs b/testsuite/tests/deriving/should_compile/T14045b.hs new file mode 100644 index 0000000..cb18e36 --- /dev/null +++ b/testsuite/tests/deriving/should_compile/T14045b.hs @@ -0,0 +1,13 @@ +{-# LANGUAGE TypeFamilies, KindSignatures, GADTs, GeneralizedNewtypeDeriving #-} + +module T14045b where + +import Data.Kind ( Type ) + +data family T a b :: Type + +-- newtype instance T Int d = MkT (IO d) + +newtype instance T Int :: Type -> Type where + MkT :: IO d -> T Int d + deriving( Monad, Applicative, Functor ) diff --git a/testsuite/tests/deriving/should_compile/all.T b/testsuite/tests/deriving/should_compile/all.T index 0025d25..5b69565 100644 --- a/testsuite/tests/deriving/should_compile/all.T +++ b/testsuite/tests/deriving/should_compile/all.T @@ -94,3 +94,4 @@ test('drv-phantom', [normalise_errmsg_fun(just_the_deriving)],compile, ['-ddump- test('T13813', normal, compile, ['']) test('T13919', normal, compile, ['']) test('T13998', normal, compile, ['']) +test('T14045b', normal, compile, ['']) From git at git.haskell.org Wed Aug 2 17:05:21 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 2 Aug 2017 17:05:21 +0000 (UTC) Subject: [commit: ghc] wip/T14068: Mark `eqString` as `NOINLINE` (b3e2aaf) Message-ID: <20170802170521.CF4893A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14068 Link : http://ghc.haskell.org/trac/ghc/changeset/b3e2aafa21283fd42b2606228a54331e07d1fe88/ghc >--------------------------------------------------------------- commit b3e2aafa21283fd42b2606228a54331e07d1fe88 Author: Joachim Breitner Date: Wed Aug 2 10:53:37 2017 -0400 Mark `eqString` as `NOINLINE` so that the built-in rule can still match. This will be a problem in general: With loopification, recursive functions can now inline (yay!) but many people out there probably rely on the fact that recursive functions cannot inline (ouch). Hopefully the recent warnings in GHC made them fix this before loopification reaches them. >--------------------------------------------------------------- b3e2aafa21283fd42b2606228a54331e07d1fe88 libraries/base/GHC/Base.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/libraries/base/GHC/Base.hs b/libraries/base/GHC/Base.hs index ffcd7ff..f25a861 100644 --- a/libraries/base/GHC/Base.hs +++ b/libraries/base/GHC/Base.hs @@ -1053,6 +1053,7 @@ eqString :: String -> String -> Bool eqString [] [] = True eqString (c1:cs1) (c2:cs2) = c1 == c2 && cs1 `eqString` cs2 eqString _ _ = False +{-# NOINLINE eqString #-} {-# RULES "eqString" (==) = eqString #-} -- eqString also has a BuiltInRule in PrelRules.hs: From git at git.haskell.org Wed Aug 2 17:05:24 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 2 Aug 2017 17:05:24 +0000 (UTC) Subject: [commit: ghc] wip/T14068: Do not inline showWord (532e480) Message-ID: <20170802170524.8B27A3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14068 Link : http://ghc.haskell.org/trac/ghc/changeset/532e4801698f9eda5d6da5e9492da1c31eba963b/ghc >--------------------------------------------------------------- commit 532e4801698f9eda5d6da5e9492da1c31eba963b Author: Joachim Breitner Date: Wed Aug 2 11:26:22 2017 -0400 Do not inline showWord mostly because otherwise the test setup of #7014 fails. (The test checks for the absence of certain primops in the code, but inlining showWords adds many of these.) >--------------------------------------------------------------- 532e4801698f9eda5d6da5e9492da1c31eba963b libraries/base/GHC/Show.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/libraries/base/GHC/Show.hs b/libraries/base/GHC/Show.hs index 6965335..ecd7db8 100644 --- a/libraries/base/GHC/Show.hs +++ b/libraries/base/GHC/Show.hs @@ -196,6 +196,7 @@ showWord w# cs | otherwise = case chr# (ord# '0'# +# word2Int# (w# `remWord#` 10##)) of c# -> showWord (w# `quotWord#` 10##) (C# c# : cs) +{-# NOINLINE showWord #-} deriving instance Show a => Show (Maybe a) From git at git.haskell.org Wed Aug 2 17:05:27 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 2 Aug 2017 17:05:27 +0000 (UTC) Subject: [commit: ghc] wip/T14068: Make the test case for #T5949 a little less bogus (4e9f2fb) Message-ID: <20170802170527.4A5AC3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14068 Link : http://ghc.haskell.org/trac/ghc/changeset/4e9f2fb5cd803ba7d1730ab1a05e2e4071a44ee0/ghc >--------------------------------------------------------------- commit 4e9f2fb5cd803ba7d1730ab1a05e2e4071a44ee0 Author: Joachim Breitner Date: Wed Aug 2 11:53:26 2017 -0400 Make the test case for #T5949 a little less bogus by actually using the result of `e`. I *believe* it still tests what we want to test, and now we get proper results with loopification. I am not so worried about the regression in the case of an unused result of `e`. >--------------------------------------------------------------- 4e9f2fb5cd803ba7d1730ab1a05e2e4071a44ee0 testsuite/tests/perf/should_run/T5949.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/testsuite/tests/perf/should_run/T5949.hs b/testsuite/tests/perf/should_run/T5949.hs index a633aa0..689b629 100644 --- a/testsuite/tests/perf/should_run/T5949.hs +++ b/testsuite/tests/perf/should_run/T5949.hs @@ -53,4 +53,4 @@ e x y = x `seq` if y > 10 else e x (y + 1) -main = foldr (seq) 0 [e (n,0) 0| n <- [0..10000]] `seq` return () +main = sum [uncurry (+) (e (n,n) 0)| n <- [0..10000]] `seq` return () From git at git.haskell.org Wed Aug 2 17:05:32 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 2 Aug 2017 17:05:32 +0000 (UTC) Subject: [commit: ghc] wip/T14068: Update test cases that check Core output (cba0b2a) Message-ID: <20170802170532.C08173A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14068 Link : http://ghc.haskell.org/trac/ghc/changeset/cba0b2a6a477b2e2de4b01c1a477ad3d51e0117f/ghc >--------------------------------------------------------------- commit cba0b2a6a477b2e2de4b01c1a477ad3d51e0117f Author: Joachim Breitner Date: Wed Aug 2 10:40:23 2017 -0400 Update test cases that check Core output We see many recursive functions being inlined as jointrecs! (Also, test cases that simply check the `-ddump-simpl` are not really useful, and time-consuming. At least `grep` on relevant bits…) >--------------------------------------------------------------- cba0b2a6a477b2e2de4b01c1a477ad3d51e0117f .../tests/simplCore/should_compile/T12603.stdout | 2 +- .../tests/simplCore/should_compile/T13143.stderr | 75 ++- .../tests/simplCore/should_compile/T3717.stderr | 64 ++- .../tests/simplCore/should_compile/T3772.stdout | 27 +- .../tests/simplCore/should_compile/T4908.stderr | 80 ++- .../tests/simplCore/should_compile/T7360.stderr | 43 +- .../simplCore/should_compile/spec-inline.stderr | 166 +++--- .../tests/stranal/should_compile/T10482.stderr | 278 +++++++++- .../tests/stranal/should_compile/T10482a.stderr | 585 ++++++++++++++++++++- testsuite/tests/stranal/should_compile/all.T | 4 +- 10 files changed, 1099 insertions(+), 225 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 cba0b2a6a477b2e2de4b01c1a477ad3d51e0117f From git at git.haskell.org Wed Aug 2 17:05:30 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 2 Aug 2017 17:05:30 +0000 (UTC) Subject: [commit: ghc] wip/T14068: Disable test case for #4030 and #5644 (edce46f) Message-ID: <20170802170530.0AF643A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14068 Link : http://ghc.haskell.org/trac/ghc/changeset/edce46f35f468bdfda320279ec52e93b1166ae4a/ghc >--------------------------------------------------------------- commit edce46f35f468bdfda320279ec52e93b1166ae4a Author: Joachim Breitner Date: Wed Aug 2 10:43:04 2017 -0400 Disable test case for #4030 and #5644 With loopification, T4030 always goes into an infinite loop. Not nice when running the test suite. Also, with loopification, T5644 no longer runs out of heap, so it does not trigger the out-of-heap exception that the test case was testing. >--------------------------------------------------------------- edce46f35f468bdfda320279ec52e93b1166ae4a testsuite/tests/concurrent/should_run/all.T | 4 +++- testsuite/tests/rts/T5644/ManyQueue.hs | 0 testsuite/tests/rts/T5644/all.T | 4 +++- 3 files changed, 6 insertions(+), 2 deletions(-) diff --git a/testsuite/tests/concurrent/should_run/all.T b/testsuite/tests/concurrent/should_run/all.T index 69b8ad7..797804c 100644 --- a/testsuite/tests/concurrent/should_run/all.T +++ b/testsuite/tests/concurrent/should_run/all.T @@ -41,7 +41,9 @@ test('T3429', [ extra_run_opts('+RTS -C0.001 -RTS'), # without -O, goes into an infinite loop # GHCi does not detect the infinite loop. We should really fix this. -test('T4030', omit_ways('ghci'), compile_and_run, ['-O']) +# With loopification (#14068), always goes into an infinite loop. Disabling for +# now. +# test('T4030', omit_ways('ghci'), compile_and_run, ['-O']) # each of these runs for about a second test('throwto001', [reqlib('random'), extra_run_opts('1000 2000')], diff --git a/testsuite/tests/rts/T5644/all.T b/testsuite/tests/rts/T5644/all.T index 7dd120d..1711992 100644 --- a/testsuite/tests/rts/T5644/all.T +++ b/testsuite/tests/rts/T5644/all.T @@ -2,7 +2,9 @@ test('T5644', [extra_files(['Conf.hs', 'ManyQueue.hs', 'Util.hs', 'heap-overflow only_ways(['optasm','threaded1','threaded2']), extra_run_opts('+RTS -M20m -RTS'), - exit_code(251) # RTS exit code for "out of memory" + exit_code(251), # RTS exit code for "out of memory" + # With loopification, the code does no longer run out of heap space: + expect_broken(14068) ], multimod_compile_and_run, ['heap-overflow.hs','-O']) From git at git.haskell.org Wed Aug 2 20:16:00 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 2 Aug 2017 20:16:00 +0000 (UTC) Subject: [commit: ghc] master: Remove unneeded uses of ImplicitParams (f68a00c) Message-ID: <20170802201600.B85E53A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f68a00c97c149428c4b711e0abb8b69cdc3c6bcb/ghc >--------------------------------------------------------------- commit f68a00c97c149428c4b711e0abb8b69cdc3c6bcb Author: Ryan Scott Date: Wed Aug 2 16:10:34 2017 -0400 Remove unneeded uses of ImplicitParams Summary: Finish the work started in 7d1909ad110f05c8cb2fb0689ee75857ceb945f6. Test Plan: If it builds, ship it Reviewers: austin, bgamari Subscribers: rwbarton, thomie Differential Revision: https://phabricator.haskell.org/D3812 >--------------------------------------------------------------- f68a00c97c149428c4b711e0abb8b69cdc3c6bcb compiler/basicTypes/Id.hs | 2 +- compiler/typecheck/TcDerivUtils.hs | 1 - compiler/types/TyCoRep.hs | 1 - compiler/utils/Outputable.hs | 1 - 4 files changed, 1 insertion(+), 4 deletions(-) diff --git a/compiler/basicTypes/Id.hs b/compiler/basicTypes/Id.hs index aab5569..0529077 100644 --- a/compiler/basicTypes/Id.hs +++ b/compiler/basicTypes/Id.hs @@ -5,7 +5,7 @@ \section[Id]{@Ids@: Value and constructor identifiers} -} -{-# LANGUAGE ImplicitParams, CPP #-} +{-# LANGUAGE CPP #-} -- | -- #name_types# diff --git a/compiler/typecheck/TcDerivUtils.hs b/compiler/typecheck/TcDerivUtils.hs index 09876af..05d323c 100644 --- a/compiler/typecheck/TcDerivUtils.hs +++ b/compiler/typecheck/TcDerivUtils.hs @@ -6,7 +6,6 @@ Error-checking and other utilities for @deriving@ clauses or declarations. -} -{-# LANGUAGE ImplicitParams #-} {-# LANGUAGE TypeFamilies #-} module TcDerivUtils ( diff --git a/compiler/types/TyCoRep.hs b/compiler/types/TyCoRep.hs index c8ea18a..8b8a960 100644 --- a/compiler/types/TyCoRep.hs +++ b/compiler/types/TyCoRep.hs @@ -18,7 +18,6 @@ Note [The Type-related module hierarchy] -- We expose the relevant stuff from this module via the Type module {-# OPTIONS_HADDOCK hide #-} {-# LANGUAGE CPP, DeriveDataTypeable, MultiWayIf #-} -{-# LANGUAGE ImplicitParams #-} module TyCoRep ( TyThing(..), tyThingCategory, pprTyThingCategory, pprShortTyThing, diff --git a/compiler/utils/Outputable.hs b/compiler/utils/Outputable.hs index de27546..bc46f2f 100644 --- a/compiler/utils/Outputable.hs +++ b/compiler/utils/Outputable.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP, ImplicitParams #-} {- (c) The University of Glasgow 2006-2012 (c) The GRASP Project, Glasgow University, 1992-1998 From git at git.haskell.org Wed Aug 2 20:16:03 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 2 Aug 2017 20:16:03 +0000 (UTC) Subject: [commit: ghc] master: Add the bootstrapping/ dir to .gitignore (884bd21) Message-ID: <20170802201603.729193A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/884bd21a917f607b5a44e038e06f78d0b765ea63/ghc >--------------------------------------------------------------- commit 884bd21a917f607b5a44e038e06f78d0b765ea63 Author: Ryan Scott Date: Wed Aug 2 16:12:03 2017 -0400 Add the bootstrapping/ dir to .gitignore Summary: This is generated when building `ghc-cabal`. Reviewers: hvr, bgamari, austin Subscribers: rwbarton, thomie Differential Revision: https://phabricator.haskell.org/D3813 >--------------------------------------------------------------- 884bd21a917f607b5a44e038e06f78d0b765ea63 .gitignore | 1 + 1 file changed, 1 insertion(+) diff --git a/.gitignore b/.gitignore index 073c5a3..f2d4be5 100644 --- a/.gitignore +++ b/.gitignore @@ -92,6 +92,7 @@ _darcs/ /bindistprep/ /bindisttest/HelloWorld /bindisttest/ +/bootstrapping/ /ch01.html /ch02.html /compiler/dist/ From git at git.haskell.org Wed Aug 2 21:40:17 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 2 Aug 2017 21:40:17 +0000 (UTC) Subject: [commit: ghc] ghc-8.2: Fix compact regions notes (dad18c2) Message-ID: <20170802214017.4F6C93A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.2 Link : http://ghc.haskell.org/trac/ghc/changeset/dad18c2be08bb2a4730936116422928d3195a6ba/ghc >--------------------------------------------------------------- commit dad18c2be08bb2a4730936116422928d3195a6ba Author: Ben Gamari Date: Sun Jul 23 10:27:42 2017 -0400 Fix compact regions notes >--------------------------------------------------------------- dad18c2be08bb2a4730936116422928d3195a6ba docs/users_guide/8.2.1-notes.rst | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/docs/users_guide/8.2.1-notes.rst b/docs/users_guide/8.2.1-notes.rst index e165998..e2231ba 100644 --- a/docs/users_guide/8.2.1-notes.rst +++ b/docs/users_guide/8.2.1-notes.rst @@ -319,8 +319,9 @@ Runtime system move long-lived data outside of the heap so that the garbage collector does not have to trace it repeatedly. Compacted data can also be serialized, stored, and deserialized again later by the same - program. For more details see the :compact-ref:`GHC.Compact - ` module. + program. For more details see the :ghc-compact-ref:`GHC.Compact + ` module. Moreover, see the ``compact`` library on `Hackage + `_ for a high-level interface. - There is new support for improving performance on machines with a Non-Uniform Memory Architecture (NUMA). See :rts-flag:`--numa`. From git at git.haskell.org Wed Aug 2 21:40:20 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 2 Aug 2017 21:40:20 +0000 (UTC) Subject: [commit: ghc] ghc-8.2: Fix up ghci changelog (dd750cc) Message-ID: <20170802214020.161213A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.2 Link : http://ghc.haskell.org/trac/ghc/changeset/dd750cccfef512478314531f90b1439ba9093bb8/ghc >--------------------------------------------------------------- commit dd750cccfef512478314531f90b1439ba9093bb8 Author: Ben Gamari Date: Sun Jul 23 11:15:06 2017 -0400 Fix up ghci changelog >--------------------------------------------------------------- dd750cccfef512478314531f90b1439ba9093bb8 libraries/ghci/changelog.md | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/libraries/ghci/changelog.md b/libraries/ghci/changelog.md index 3775eda..5ba7dd1 100644 --- a/libraries/ghci/changelog.md +++ b/libraries/ghci/changelog.md @@ -1,3 +1,11 @@ +## 8.2.1 Jul 2017 + + * Bundled with GHC 8.2.1 + + * Add support for StaticPointers in GHCi (#12356) + + * Move Typeable Binary instances to `binary` package + ## 8.0.1 *Feb 2016* * Bundled with GHC 8.0.1 From git at git.haskell.org Wed Aug 2 21:40:22 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 2 Aug 2017 21:40:22 +0000 (UTC) Subject: [commit: ghc] ghc-8.2: distrib/configure: Carry FFI include/lib paths from source distribution (4911213) Message-ID: <20170802214022.C517D3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.2 Link : http://ghc.haskell.org/trac/ghc/changeset/4911213f7eb388aa3ad5729b3b6001103601f312/ghc >--------------------------------------------------------------- commit 4911213f7eb388aa3ad5729b3b6001103601f312 Author: Ben Gamari Date: Sun Jul 23 10:43:52 2017 -0400 distrib/configure: Carry FFI include/lib paths from source distribution `FFILibDir` and `FFIIncludeDir` both show up in the `rts` library's package registration file. We therefore must define them or else we'll end up with spurious `@FFILibDir@` strings in the package registration. In principle I think we could also take these as arguments to the bindist configure but this seems simpler and I don't want to verify this at the moment. Test Plan: Build bindist while passing `--with-ffi-libraries=...` to source distribution configure then try to install and use bindist. Reviewers: austin, hvr Subscribers: rwbarton, thomie, erikd Differential Revision: https://phabricator.haskell.org/D3774 (cherry picked from commit 98ab12ad0c13b6723cc667d6a00fe592f1833bf4) >--------------------------------------------------------------- 4911213f7eb388aa3ad5729b3b6001103601f312 distrib/configure.ac.in | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/distrib/configure.ac.in b/distrib/configure.ac.in index 27ae965..1f47ff1 100644 --- a/distrib/configure.ac.in +++ b/distrib/configure.ac.in @@ -12,8 +12,15 @@ dnl-------------------------------------------------------------------- FP_GMP +dnl Various things from the source distribution configure bootstrap_target=@TargetPlatform@ +FFIIncludeDir=@FFIIncludeDir@ +FFILibDir=@FFILibDir@ +AC_SUBST(FFILibDir) +AC_SUBST(FFIIncludeDir) + + # We have to run these unconditionally as FPTOOLS_SET_PLATFORM_VARS wants the # values it computes. AC_CANONICAL_BUILD From git at git.haskell.org Wed Aug 2 21:40:25 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 2 Aug 2017 21:40:25 +0000 (UTC) Subject: [commit: ghc] ghc-8.2: users-guide: Standardize and repair all flag references (df5e225) Message-ID: <20170802214025.98C0D3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.2 Link : http://ghc.haskell.org/trac/ghc/changeset/df5e2256d7345bc2785443ebea8ae6bd1873750e/ghc >--------------------------------------------------------------- commit df5e2256d7345bc2785443ebea8ae6bd1873750e Author: Patrick Dougherty Date: Sun Jul 23 12:55:37 2017 -0400 users-guide: Standardize and repair all flag references This patch does three things: 1.) It simplifies the flag parsing code in `conf.py` to properly display flag definitions created by `.. (ghc|rts)-flag::`. Additionally, all flag references must include the associated arguments. Documentation has been added to `editing-guide.rst` to explain this. 2.) It normalizes all flag definitions to a similar format. Notably, all instances of `<>` have been replaced with `⟨⟩`. All references across the users guide have been updated to match. 3.) It fixes a couple issues with the flag reference table's generation code, which did not handle comma separated flags in the same cell and did not properly reference flags with arguments. Test Plan: `SPHINXOPTS = -n` to activate "nitpicky" mode, which reports all broken references. All remaining errors are references to flags without any documentation. Reviewers: austin, bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie GHC Trac Issues: #13980 Differential Revision: https://phabricator.haskell.org/D3778 (cherry picked from commit 44b090be9a6d0165e2281542a7c713da1799e885) >--------------------------------------------------------------- df5e2256d7345bc2785443ebea8ae6bd1873750e docs/users_guide/8.2.1-notes.rst | 4 +- docs/users_guide/conf.py | 52 ++++--- docs/users_guide/debug-info.rst | 3 +- docs/users_guide/debugging.rst | 8 +- docs/users_guide/editing-guide.rst | 26 +++- docs/users_guide/extending_ghc.rst | 65 ++++----- docs/users_guide/ffi-chap.rst | 14 +- docs/users_guide/ghci.rst | 38 ++--- docs/users_guide/glasgow_exts.rst | 44 +++--- docs/users_guide/packages.rst | 82 +++++------ docs/users_guide/phases.rst | 84 +++++------ docs/users_guide/profiling.rst | 89 +++++++----- docs/users_guide/runtime_control.rst | 161 +++++++++------------ docs/users_guide/separate_compilation.rst | 48 +++--- docs/users_guide/shared_libs.rst | 21 ++- docs/users_guide/sooner.rst | 34 ++--- docs/users_guide/using-concurrent.rst | 18 +-- docs/users_guide/using-optimisation.rst | 51 +++---- docs/users_guide/using-warnings.rst | 6 +- docs/users_guide/using.rst | 21 +-- utils/mkUserGuidePart/Main.hs | 9 +- utils/mkUserGuidePart/Options/CompilerDebugging.hs | 4 +- utils/mkUserGuidePart/Options/FindingImports.hs | 2 +- utils/mkUserGuidePart/Options/Interactive.hs | 2 +- utils/mkUserGuidePart/Options/Linking.hs | 17 ++- utils/mkUserGuidePart/Options/Misc.hs | 5 +- utils/mkUserGuidePart/Options/Modes.hs | 4 +- utils/mkUserGuidePart/Options/Packages.hs | 30 ++-- utils/mkUserGuidePart/Options/PhasePrograms.hs | 24 +-- utils/mkUserGuidePart/Options/PhaseSpecific.hs | 20 +-- utils/mkUserGuidePart/Options/Phases.hs | 4 +- utils/mkUserGuidePart/Options/Plugin.hs | 2 +- utils/mkUserGuidePart/Options/ProgramCoverage.hs | 2 +- utils/mkUserGuidePart/Options/RedirectingOutput.hs | 10 +- utils/mkUserGuidePart/Options/Verbosity.hs | 2 +- utils/mkUserGuidePart/Options/Warnings.hs | 10 +- 36 files changed, 521 insertions(+), 495 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 df5e2256d7345bc2785443ebea8ae6bd1873750e From git at git.haskell.org Wed Aug 2 21:40:28 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 2 Aug 2017 21:40:28 +0000 (UTC) Subject: [commit: ghc] ghc-8.2: users-guide: Fix various wibbles (eeb2aa4) Message-ID: <20170802214028.508F63A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.2 Link : http://ghc.haskell.org/trac/ghc/changeset/eeb2aa4e1f31306fc4b2ef65e970d11c15ecffe6/ghc >--------------------------------------------------------------- commit eeb2aa4e1f31306fc4b2ef65e970d11c15ecffe6 Author: Ben Gamari Date: Sun Jul 23 12:59:49 2017 -0400 users-guide: Fix various wibbles (cherry picked from commit c9451959d8796ee5458cd0666dd2bc2114ac10d7) >--------------------------------------------------------------- eeb2aa4e1f31306fc4b2ef65e970d11c15ecffe6 docs/users_guide/profiling.rst | 19 +++++++++++-------- docs/users_guide/runtime_control.rst | 4 ++-- docs/users_guide/separate_compilation.rst | 6 +++--- 3 files changed, 16 insertions(+), 13 deletions(-) diff --git a/docs/users_guide/profiling.rst b/docs/users_guide/profiling.rst index 0a4ba09..e3796ed 100644 --- a/docs/users_guide/profiling.rst +++ b/docs/users_guide/profiling.rst @@ -429,6 +429,8 @@ enclosed between ``+RTS ... -RTS`` as usual): .. rts-flag:: -V ⟨secs⟩ + :default: 0.02 + Sets the interval that the RTS clock ticks at, which is also the sampling interval of the time and allocation profile. The default is 0.02 seconds. The runtime uses a single timer signal to count ticks; this timer signal is @@ -929,14 +931,15 @@ reasons for this: - Garbage collection requires more memory than the actual residency. The factor depends on the kind of garbage collection algorithm in use: a major GC - in the standard generation copying collector will usually require 3L bytes of - memory, where L is the amount of live data. This is because by default (see - the RTS :rts-flag:`-F ⟨factor⟩` option) we allow the old generation to grow - to twice its size (2L) before collecting it, and we require additionally L - bytes to copy the live 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 ⟨factor⟩` option. Also add the size of the - allocation area (see :rts-flag:`-A ⟨size⟩`). + in the standard generation copying collector will usually require :math:`3L` + bytes of memory, where :math:`L` is the amount of live data. This is because + by default (see the RTS :rts-flag:`-F ⟨factor⟩` option) we allow the old + generation to grow to twice its size (:math:`2L`) before collecting it, and + we require additionally :math:`L` bytes to copy the live data into. When + using compacting collection (see the :rts-flag:`-c` option), this is reduced + to :math:`2L`, and can further be reduced by tweaking the :rts-flag:`-F + ⟨factor⟩` option. Also add the size of the allocation area (see :rts-flag:`-A + ⟨size⟩`). - 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 5286784..682ced8 100644 --- a/docs/users_guide/runtime_control.rst +++ b/docs/users_guide/runtime_control.rst @@ -253,7 +253,7 @@ Miscellaneous RTS options This option relates to allocation limits; for more about this see :base-ref:`enableAllocationLimit `. When a thread hits its allocation limit, the RTS throws an exception - to the thread, and the thread gets an additional quota of allo + to the thread, and the thread gets an additional quota of allocation before the exception is raised again, the idea being so that the thread can execute its exception handlers. The ``-xq`` controls the size of this additional quota. @@ -339,7 +339,7 @@ performance. .. index:: single: allocation area, chunk size - [Example: ``-n4m``\ ] When set to a non-zero value, this + [Example: ``-n4m`` ] When set to a non-zero value, this option divides the allocation area (``-A`` value) into chunks of the specified size. During execution, when a processor exhausts its current chunk, it is given another chunk from the pool until the diff --git a/docs/users_guide/separate_compilation.rst b/docs/users_guide/separate_compilation.rst index 04ef591..06af6f0 100644 --- a/docs/users_guide/separate_compilation.rst +++ b/docs/users_guide/separate_compilation.rst @@ -1190,8 +1190,8 @@ generation are: .. ghc-flag:: -dep-suffix ⟨suffix⟩ Make dependencies that declare that files with suffix - ``.`` depend on interface files with suffix - ``.hi``, or (for ``{-# SOURCE #-}`` imports) on ``.hi-boot``. + ``.⟨suf⟩⟨osuf⟩`` depend on interface files with suffix + ``.⟨suf⟩hi``, or (for ``{-# SOURCE #-}`` imports) on ``.hi-boot``. Multiple ``-dep-suffix`` flags are permitted. For example, ``-dep-suffix a_ -dep-suffix b_`` will make dependencies for ``.hs`` on ``.hi``, ``.a_hs`` on ``.a_hi``, and ``.b_hs`` on ``.b_hi``. @@ -1200,7 +1200,7 @@ generation are: .. ghc-flag:: --exclude-module=⟨file⟩ - Regard ```` as "stable"; i.e., exclude it from having + Regard ``⟨file⟩`` as "stable"; i.e., exclude it from having dependencies on it. .. ghc-flag:: -include-pkg-deps From git at git.haskell.org Wed Aug 2 21:40:31 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 2 Aug 2017 21:40:31 +0000 (UTC) Subject: [commit: ghc] ghc-8.2: Fix more documentation wibbles (5c11e7a) Message-ID: <20170802214031.2DDE73A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.2 Link : http://ghc.haskell.org/trac/ghc/changeset/5c11e7a4f9f880348cd51e410c349319d489ec1f/ghc >--------------------------------------------------------------- commit 5c11e7a4f9f880348cd51e410c349319d489ec1f Author: Ben Gamari Date: Sun Jul 23 14:13:16 2017 -0400 Fix more documentation wibbles Fixes #14020, #14016, #14015, #14019 (cherry picked from commit 2dff2c7fbb5aa68445e617d691451c0427fad0a5) >--------------------------------------------------------------- 5c11e7a4f9f880348cd51e410c349319d489ec1f docs/users_guide/8.0.2-notes.rst | 2 +- docs/users_guide/8.2.1-notes.rst | 17 ++--- docs/users_guide/conf.py | 2 +- docs/users_guide/editing-guide.rst | 15 +++++ docs/users_guide/ffi-chap.rst | 5 +- docs/users_guide/ghc_config.py.in | 8 ++- docs/users_guide/ghci.rst | 5 ++ docs/users_guide/glasgow_exts.rst | 45 +++++++------ docs/users_guide/packages.rst | 2 +- docs/users_guide/parallel.rst | 8 +-- docs/users_guide/phases.rst | 13 ++-- docs/users_guide/profiling.rst | 11 +++- docs/users_guide/runghc.rst | 2 +- docs/users_guide/runtime_control.rst | 98 +++++++++++++--------------- docs/users_guide/safe_haskell.rst | 2 +- docs/users_guide/sooner.rst | 2 +- docs/users_guide/using-concurrent.rst | 18 ++--- docs/users_guide/using-warnings.rst | 13 ++-- docs/users_guide/using.rst | 12 ++-- utils/mkUserGuidePart/Options/Interactive.hs | 2 +- utils/mkUserGuidePart/Options/Verbosity.hs | 2 +- 21 files changed, 165 insertions(+), 119 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 5c11e7a4f9f880348cd51e410c349319d489ec1f From git at git.haskell.org Wed Aug 2 21:40:33 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 2 Aug 2017 21:40:33 +0000 (UTC) Subject: [commit: ghc] ghc-8.2: Fix errant whitespace (f2fdf39) Message-ID: <20170802214033.DB3EE3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.2 Link : http://ghc.haskell.org/trac/ghc/changeset/f2fdf391aec6663a5fa91a848199b3014ed14237/ghc >--------------------------------------------------------------- commit f2fdf391aec6663a5fa91a848199b3014ed14237 Author: Ben Gamari Date: Sun Jul 23 15:48:56 2017 -0400 Fix errant whitespace [skip-ci] (cherry picked from commit 0ff40df30128d24118947c82bd970fc013522e18) >--------------------------------------------------------------- f2fdf391aec6663a5fa91a848199b3014ed14237 docs/users_guide/runtime_control.rst | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/docs/users_guide/runtime_control.rst b/docs/users_guide/runtime_control.rst index b3ab08f..5f64409 100644 --- a/docs/users_guide/runtime_control.rst +++ b/docs/users_guide/runtime_control.rst @@ -643,7 +643,7 @@ performance. ``-F`` parameter will be reduced in order to avoid exceeding the maximum heap size. -.. rts-flag:: -Mgrace= ⟨size⟩ +.. rts-flag:: -Mgrace=⟨size⟩ :default: 1M From git at git.haskell.org Wed Aug 2 21:40:36 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 2 Aug 2017 21:40:36 +0000 (UTC) Subject: [commit: ghc] ghc-8.2: Fix lld detection if both gold and lld are found (2fbdd42) Message-ID: <20170802214036.95C1D3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.2 Link : http://ghc.haskell.org/trac/ghc/changeset/2fbdd42c27a589d33a3583d13162641dada9ed2c/ghc >--------------------------------------------------------------- commit 2fbdd42c27a589d33a3583d13162641dada9ed2c Author: Ben Gamari Date: Fri Jul 28 11:48:52 2017 -0400 Fix lld detection if both gold and lld are found If you have ld.gold and ld.lld, then ld.gold will be selected by the detection logic. This patch prioritizes lld by changing the order. The rationale for checking lld first is that it's (right now) not part of, say, a default Linux distro installation and if it's available, it's very likely that it was installed explicitly and should be seen as a sign of preference. On FreeBSD LLVM is the (default) base toolchain and the changed order makes sense there as well, since ld.gold can be available in /usr/local via ports/pkg. I don't have access to macOS and can't say anything about their LLVM toolchain. At some point we could add a check for LD=ld.lld or LD=ld.gold as an optional override to explicitly select a linker. Since I cannot really remove gcc on Linux, this was the only way to configure GHC to use ld.lld. Reviewers: austin, hvr, bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie, erikd Tags: PHID-PROJ-5azim3sqhsf7wzvlvaag Differential Revision: https://phabricator.haskell.org/D3790 (cherry picked from commit 2974f81f8c3529657a0b808b8415a4d2ad9ed6d1) >--------------------------------------------------------------- 2fbdd42c27a589d33a3583d13162641dada9ed2c aclocal.m4 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/aclocal.m4 b/aclocal.m4 index fe2c43d..3e5c5dc 100644 --- a/aclocal.m4 +++ b/aclocal.m4 @@ -2339,7 +2339,7 @@ AC_DEFUN([FIND_LD],[ [enable_ld_override=yes]) if test "x$enable_ld_override" = "xyes"; then - AC_CHECK_TARGET_TOOLS([TmpLd], [ld.gold ld.lld ld]) + AC_CHECK_TARGET_TOOLS([TmpLd], [ld.lld ld.gold ld]) out=`$TmpLd --version` case $out in From git at git.haskell.org Wed Aug 2 21:40:39 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 2 Aug 2017 21:40:39 +0000 (UTC) Subject: [commit: ghc] ghc-8.2: configure: Ensure that user's LD setting is respected (b0d0291) Message-ID: <20170802214039.635723A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.2 Link : http://ghc.haskell.org/trac/ghc/changeset/b0d0291085a81e0c192e3e95e66ff078c28e1956/ghc >--------------------------------------------------------------- commit b0d0291085a81e0c192e3e95e66ff078c28e1956 Author: Ben Gamari Date: Fri Jul 28 13:35:01 2017 -0400 configure: Ensure that user's LD setting is respected This broke in the fix for #13541. (cherry picked from commit d08b9ccdf2812e8f8fa34d0c89275deee574524c) >--------------------------------------------------------------- b0d0291085a81e0c192e3e95e66ff078c28e1956 aclocal.m4 | 1 + 1 file changed, 1 insertion(+) diff --git a/aclocal.m4 b/aclocal.m4 index 3e5c5dc..c48b42c 100644 --- a/aclocal.m4 +++ b/aclocal.m4 @@ -2339,6 +2339,7 @@ AC_DEFUN([FIND_LD],[ [enable_ld_override=yes]) if test "x$enable_ld_override" = "xyes"; then + TmpLd="$LD" # In case the user set LD AC_CHECK_TARGET_TOOLS([TmpLd], [ld.lld ld.gold ld]) out=`$TmpLd --version` From git at git.haskell.org Wed Aug 2 21:40:42 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 2 Aug 2017 21:40:42 +0000 (UTC) Subject: [commit: ghc] ghc-8.2: aclocal.m4: respect user's --with-ar= choice (948d777) Message-ID: <20170802214042.1B36A3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.2 Link : http://ghc.haskell.org/trac/ghc/changeset/948d7774b3f41779998a5b71d646198c8dd76257/ghc >--------------------------------------------------------------- commit 948d7774b3f41779998a5b71d646198c8dd76257 Author: Sergei Trofimovich Date: Mon Apr 17 09:41:49 2017 +0100 aclocal.m4: respect user's --with-ar= choice 'FP_PROG_AR' macro has a minor bug: it ignores already existing value stored in '$fp_prog_ar'. I've noticed it when tried to built UNREG ghc using thin LTO: $ ./configure --enable-unregisterised \ --with-nm=gcc-nm \ --with-ar=gcc-ar \ --with-ranlib=gcc-ranlib \ ./configure refused to use 'gcc-ar' (LTO-aware variant of 'ar') and kept using 'ar'. '$fp_prog_ar' is initialized (in a complex manner) in 'configure.ac' as: FP_ARG_WITH_PATH_GNU_PROG([AR], [ar], [ar]) ArCmd="$AR" fp_prog_ar="$AR" AC_SUBST([ArCmd]) The change keeps that value. Signed-off-by: Sergei Trofimovich (cherry picked from commit 79848f18805ad8eba48c9897c5d53afbd17ab44d) >--------------------------------------------------------------- 948d7774b3f41779998a5b71d646198c8dd76257 aclocal.m4 | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/aclocal.m4 b/aclocal.m4 index c48b42c..516584b 100644 --- a/aclocal.m4 +++ b/aclocal.m4 @@ -1114,7 +1114,9 @@ AC_SUBST([LdHasFilelist]) # ---------- # Sets fp_prog_ar to a path to ar. Exits if no ar can be found AC_DEFUN([FP_PROG_AR], -[AC_PATH_PROG([fp_prog_ar], [ar]) +[if test -z "$fp_prog_ar"; then + AC_PATH_PROG([fp_prog_ar], [ar]) +fi if test -z "$fp_prog_ar"; then AC_MSG_ERROR([cannot find ar in your PATH, no idea how to make a library]) fi From git at git.haskell.org Wed Aug 2 21:40:44 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 2 Aug 2017 21:40:44 +0000 (UTC) Subject: [commit: ghc] ghc-8.2: Document that type holes kill polymorphic recursion (c850aed) Message-ID: <20170802214044.D47633A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.2 Link : http://ghc.haskell.org/trac/ghc/changeset/c850aed3221a1811f60a0c794ea813fe1220e55f/ghc >--------------------------------------------------------------- commit c850aed3221a1811f60a0c794ea813fe1220e55f Author: Richard Eisenberg Date: Tue Jul 18 15:55:21 2017 -0400 Document that type holes kill polymorphic recursion This "fixes" #11995. (cherry picked from commit ca471860494484210b6291dd96d1e0868da750e7) >--------------------------------------------------------------- c850aed3221a1811f60a0c794ea813fe1220e55f docs/users_guide/glasgow_exts.rst | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/docs/users_guide/glasgow_exts.rst b/docs/users_guide/glasgow_exts.rst index 0b82b3d..3f039a2 100644 --- a/docs/users_guide/glasgow_exts.rst +++ b/docs/users_guide/glasgow_exts.rst @@ -10151,6 +10151,10 @@ warnings instead of errors. Additionally, these warnings can be silenced with the :ghc-flag:`-Wno-partial-type-signatures <-Wpartial-type-signatures>` flag. +However, because GHC must *infer* the type when part of a type is left +out, it is unable to use polymorphic recursion. The same restriction +takes place when the type signature is omitted completely. + .. _pts-syntax: Syntax From git at git.haskell.org Thu Aug 3 09:56:48 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 3 Aug 2017 09:56:48 +0000 (UTC) Subject: [commit: packages/parsec] master: Update .gitignore (2a23ae7) Message-ID: <20170803095648.780E63A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/parsec On branch : master Link : http://git.haskell.org/packages/parsec.git/commitdiff/2a23ae7f3455f4faf87344c0b380a85122f9a83a >--------------------------------------------------------------- commit 2a23ae7f3455f4faf87344c0b380a85122f9a83a Author: Doug Wilson Date: Wed Aug 2 09:04:39 2017 +1200 Update .gitignore These files are generated while building ghc >--------------------------------------------------------------- 2a23ae7f3455f4faf87344c0b380a85122f9a83a .gitignore | 2 ++ 1 file changed, 2 insertions(+) diff --git a/.gitignore b/.gitignore index ed6c796..d55f5d8 100644 --- a/.gitignore +++ b/.gitignore @@ -4,3 +4,5 @@ /.cabal-sandbox /cabal.sandbox.config *~ +ghc.mk +GNUMakefile From git at git.haskell.org Thu Aug 3 09:58:08 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 3 Aug 2017 09:58:08 +0000 (UTC) Subject: [commit: packages/mtl] master: Ensure strictness in the state in modify'. (56d2703) Message-ID: <20170803095808.2DD143A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/mtl On branch : master Link : http://git.haskell.org/packages/mtl.git/commitdiff/56d270389ce1b852e522ce70c93e79660852a753 >--------------------------------------------------------------- commit 56d270389ce1b852e522ce70c93e79660852a753 Author: Philipp Date: Thu Jun 5 13:32:58 2014 +0200 Ensure strictness in the state in modify'. The old implementation of modify' used state f with a function f that was strict in the new state. However, in state itself, f is applied to the state in a non-strict way, so the strictness is lost. The implementation suggested here should ensure that the state is evaluated. >--------------------------------------------------------------- 56d270389ce1b852e522ce70c93e79660852a753 Control/Monad/State/Class.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/Control/Monad/State/Class.hs b/Control/Monad/State/Class.hs index 82f695f..3efe077 100644 --- a/Control/Monad/State/Class.hs +++ b/Control/Monad/State/Class.hs @@ -87,7 +87,9 @@ modify f = state (\s -> ((), f s)) -- | A variant of 'modify' in which the computation is strict in the -- new state. modify' :: MonadState s m => (s -> s) -> m () -modify' f = state (\s -> let s' = f s in s' `seq` ((), s')) +modify' f = do + s' <- liftM f get + s' `seq` put s' -- | Gets specific component of the state, using a projection function -- supplied. From git at git.haskell.org Thu Aug 3 09:58:10 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 3 Aug 2017 09:58:10 +0000 (UTC) Subject: [commit: packages/mtl] master: Update URLs in mtl.cabal to reflect new home (fb0f899) Message-ID: <20170803095810.332DD3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/mtl On branch : master Link : http://git.haskell.org/packages/mtl.git/commitdiff/fb0f8992f527a1228589a2d986bab144999a26c2 >--------------------------------------------------------------- commit fb0f8992f527a1228589a2d986bab144999a26c2 Author: Herbert Valerio Riedel Date: Thu Jul 20 19:13:09 2017 +0200 Update URLs in mtl.cabal to reflect new home The previous URLs will continue to work via HTTP redirects >--------------------------------------------------------------- fb0f8992f527a1228589a2d986bab144999a26c2 mtl.cabal | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/mtl.cabal b/mtl.cabal index a6ce4ba..e0798dc 100644 --- a/mtl.cabal +++ b/mtl.cabal @@ -7,8 +7,8 @@ author: Andy Gill maintainer: Edward Kmett category: Control synopsis: Monad classes, using functional dependencies -homepage: http://github.com/ekmett/mtl -bug-reports: http://github.com/ekmett/mtl/issues +homepage: http://github.com/haskell/mtl +bug-reports: http://github.com/haskell/mtl/issues description: Monad classes using functional dependencies, with instances for various monad transformers, inspired by the paper @@ -30,7 +30,7 @@ tested-with: source-repository head type: git - location: https://github.com/ekmett/mtl.git + location: https://github.com/haskell/mtl.git Library exposed-modules: From git at git.haskell.org Thu Aug 3 09:58:14 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 3 Aug 2017 09:58:14 +0000 (UTC) Subject: [commit: packages/mtl] master: [docs typo] easy done -> easily done (#22) (34c38d5) Message-ID: <20170803095814.3D7753A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/mtl On branch : master Link : http://git.haskell.org/packages/mtl.git/commitdiff/34c38d5eab7b20f251e0dc3e7781790ce6e4e720 >--------------------------------------------------------------- commit 34c38d5eab7b20f251e0dc3e7781790ce6e4e720 Author: Ricky Elrod Date: Thu Jul 20 13:55:38 2017 -0400 [docs typo] easy done -> easily done (#22) >--------------------------------------------------------------- 34c38d5eab7b20f251e0dc3e7781790ce6e4e720 Control/Monad/Reader.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Control/Monad/Reader.hs b/Control/Monad/Reader.hs index 70db0f6..13ea1c6 100644 --- a/Control/Monad/Reader.hs +++ b/Control/Monad/Reader.hs @@ -130,7 +130,7 @@ Shows how to modify Reader content with 'local'. Now you are thinking: 'Wow, what a great monad! I wish I could use Reader functionality in MyFavoriteComplexMonad!'. Don't worry. -This can be easy done with the 'ReaderT' monad transformer. +This can be easily done with the 'ReaderT' monad transformer. This example shows how to combine @ReaderT@ with the IO monad. >-- The Reader/IO combined monad, where Reader stores a string. From git at git.haskell.org Thu Aug 3 09:58:16 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 3 Aug 2017 09:58:16 +0000 (UTC) Subject: [commit: packages/mtl] master: Add a README (af2b156) Message-ID: <20170803095816.42C0E3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/mtl On branch : master Link : http://git.haskell.org/packages/mtl.git/commitdiff/af2b1560f26fc9b65a1887ed1d888666a371bd77 >--------------------------------------------------------------- commit af2b1560f26fc9b65a1887ed1d888666a371bd77 Author: Ryan Scott Date: Thu Jul 20 14:10:12 2017 -0400 Add a README >--------------------------------------------------------------- af2b1560f26fc9b65a1887ed1d888666a371bd77 README.markdown | 4 ++++ mtl.cabal | 2 +- 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/README.markdown b/README.markdown new file mode 100644 index 0000000..d8fa1b4 --- /dev/null +++ b/README.markdown @@ -0,0 +1,4 @@ +The `mtl` Package [![Hackage](https://img.shields.io/hackage/v/mtl.svg)](https://hackage.haskell.org/package/mtl) [![Build Status](https://travis-ci.org/haskell/mtl.svg)](https://travis-ci.org/haskell/mtl) +===================== + +See [`mtl` on Hackage](http://hackage.haskell.org/package/mtl) for more information. diff --git a/mtl.cabal b/mtl.cabal index e0798dc..68d45d6 100644 --- a/mtl.cabal +++ b/mtl.cabal @@ -16,7 +16,7 @@ description: by Mark P Jones, in /Advanced School of Functional Programming/, 1995 (). build-type: Simple -extra-source-files: CHANGELOG.markdown +extra-source-files: CHANGELOG.markdown, README.markdown tested-with: GHC==7.0.4, GHC==7.2.2, From git at git.haskell.org Thu Aug 3 09:58:18 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 3 Aug 2017 09:58:18 +0000 (UTC) Subject: [commit: packages/mtl] master: Merge branch 'master' of https://github.com/kantp/mtl into kantp-master (8209ee5) Message-ID: <20170803095818.4A6433A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/mtl On branch : master Link : http://git.haskell.org/packages/mtl.git/commitdiff/8209ee55a6c349c9b4027f0c8337c91b64e33999 >--------------------------------------------------------------- commit 8209ee55a6c349c9b4027f0c8337c91b64e33999 Merge: af2b156 56d2703 Author: Ryan Scott Date: Mon Jul 24 16:30:50 2017 -0400 Merge branch 'master' of https://github.com/kantp/mtl into kantp-master >--------------------------------------------------------------- 8209ee55a6c349c9b4027f0c8337c91b64e33999 Control/Monad/State/Class.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) From git at git.haskell.org Thu Aug 3 09:58:12 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 3 Aug 2017 09:58:12 +0000 (UTC) Subject: [commit: packages/mtl] master: Fix broken link to the paper 'Generalising Monads to Arrows' (#34) (42b1c92) Message-ID: <20170803095812.386BC3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/mtl On branch : master Link : http://git.haskell.org/packages/mtl.git/commitdiff/42b1c92d464ed803769924ab074e54304305a6a2 >--------------------------------------------------------------- commit 42b1c92d464ed803769924ab074e54304305a6a2 Author: Nico Schottelius Date: Thu Jul 20 19:55:10 2017 +0200 Fix broken link to the paper 'Generalising Monads to Arrows' (#34) Signed-off-by: Nico Schottelius >--------------------------------------------------------------- 42b1c92d464ed803769924ab074e54304305a6a2 Control/Monad/State/Lazy.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Control/Monad/State/Lazy.hs b/Control/Monad/State/Lazy.hs index 8de3120..a715abb 100644 --- a/Control/Monad/State/Lazy.hs +++ b/Control/Monad/State/Lazy.hs @@ -59,7 +59,7 @@ import Control.Monad.Fix -- $examples -- A function to increment a counter. Taken from the paper -- /Generalising Monads to Arrows/, John --- Hughes (), November 1998: +-- Hughes (), November 1998: -- -- > tick :: State Int Int -- > tick = do n <- get From git at git.haskell.org Thu Aug 3 09:58:20 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 3 Aug 2017 09:58:20 +0000 (UTC) Subject: [commit: packages/mtl] master: Use the implemention of modify' from transformers (e1b2542) Message-ID: <20170803095820.5042D3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/mtl On branch : master Link : http://git.haskell.org/packages/mtl.git/commitdiff/e1b25421a980a37c08967a1c6c6e830f2256c0bf >--------------------------------------------------------------- commit e1b25421a980a37c08967a1c6c6e830f2256c0bf Author: Ryan Scott Date: Mon Jul 24 16:33:29 2017 -0400 Use the implemention of modify' from transformers >--------------------------------------------------------------- e1b25421a980a37c08967a1c6c6e830f2256c0bf CHANGELOG.markdown | 2 ++ Control/Monad/State/Class.hs | 4 ++-- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/CHANGELOG.markdown b/CHANGELOG.markdown index c9c26e2..16ef937 100644 --- a/CHANGELOG.markdown +++ b/CHANGELOG.markdown @@ -1,6 +1,8 @@ 2.2.2 ----- * `Control.Monad.Identity` now re-exports `Control.Monad.Trans.Identity` +* Fix a bug in which `Control.Monad.State.Class.modify'` was not as strict in + the new state as its counterparts in `transformers` 2.2.1 ------- diff --git a/Control/Monad/State/Class.hs b/Control/Monad/State/Class.hs index 23982cd..40ea931 100644 --- a/Control/Monad/State/Class.hs +++ b/Control/Monad/State/Class.hs @@ -91,8 +91,8 @@ modify f = state (\s -> ((), f s)) -- new state. modify' :: MonadState s m => (s -> s) -> m () modify' f = do - s' <- liftM f get - s' `seq` put s' + s' <- get + put $! f s' -- | Gets specific component of the state, using a projection function -- supplied. From git at git.haskell.org Thu Aug 3 09:58:22 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 3 Aug 2017 09:58:22 +0000 (UTC) Subject: [commit: packages/mtl] master: Merge branch 'kantp-master' (6f2ad30) Message-ID: <20170803095822.55ED53A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/mtl On branch : master Link : http://git.haskell.org/packages/mtl.git/commitdiff/6f2ad3024c3d5e360c44c1ea522534b270c22159 >--------------------------------------------------------------- commit 6f2ad3024c3d5e360c44c1ea522534b270c22159 Merge: af2b156 e1b2542 Author: Ryan Scott Date: Mon Jul 24 16:33:42 2017 -0400 Merge branch 'kantp-master' >--------------------------------------------------------------- 6f2ad3024c3d5e360c44c1ea522534b270c22159 CHANGELOG.markdown | 2 ++ Control/Monad/State/Class.hs | 4 +++- 2 files changed, 5 insertions(+), 1 deletion(-) From git at git.haskell.org Thu Aug 3 09:58:24 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 3 Aug 2017 09:58:24 +0000 (UTC) Subject: [commit: packages/mtl] master: Update .gitignore (#45) (1b29ec6) Message-ID: <20170803095824.5AAE23A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/mtl On branch : master Link : http://git.haskell.org/packages/mtl.git/commitdiff/1b29ec6a9eaa0e9fcf9facfa69ac320d6a667b28 >--------------------------------------------------------------- commit 1b29ec6a9eaa0e9fcf9facfa69ac320d6a667b28 Author: Doug Wilson Date: Wed Aug 2 09:11:03 2017 +1200 Update .gitignore (#45) These files are generated while building ghc >--------------------------------------------------------------- 1b29ec6a9eaa0e9fcf9facfa69ac320d6a667b28 .gitignore | 2 ++ 1 file changed, 2 insertions(+) diff --git a/.gitignore b/.gitignore index 1521c8b..6597493 100644 --- a/.gitignore +++ b/.gitignore @@ -1 +1,3 @@ dist +ghc.mk +GNUMakefile From git at git.haskell.org Sat Aug 5 16:12:53 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 5 Aug 2017 16:12:53 +0000 (UTC) Subject: [commit: ghc] master: Remove the deprecated Typeable{1..7} type synonyms (a81b5b0) Message-ID: <20170805161253.BB8AB3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a81b5b0067b6530f5883aeb0154a407a54d14c62/ghc >--------------------------------------------------------------- commit a81b5b0067b6530f5883aeb0154a407a54d14c62 Author: Ryan Scott Date: Sat Aug 5 12:02:41 2017 -0400 Remove the deprecated Typeable{1..7} type synonyms Summary: `Typeable{1..7}` (type synonyms for the poly-kinded `Typeable`) have been deprecated since GHC 7.8. They're now causing problems for users who try to still work with them in legacy code, since they can no longer be used in instances. To avoid this sort of confusion, let's just remove `Typeable{1..7}` altogether. Resolves #14047. Reviewers: bgamari, austin, hvr Reviewed By: bgamari Subscribers: rwbarton, thomie GHC Trac Issues: #14047 Differential Revision: https://phabricator.haskell.org/D3817 >--------------------------------------------------------------- a81b5b0067b6530f5883aeb0154a407a54d14c62 libraries/base/Data/Typeable.hs | 18 ------------------ libraries/base/changelog.md | 2 ++ testsuite/tests/deriving/should_run/T3087.hs | 2 +- 3 files changed, 3 insertions(+), 19 deletions(-) diff --git a/libraries/base/Data/Typeable.hs b/libraries/base/Data/Typeable.hs index 6157e82..61b70cf 100644 --- a/libraries/base/Data/Typeable.hs +++ b/libraries/base/Data/Typeable.hs @@ -86,8 +86,6 @@ module Data.Typeable -- * For backwards compatibility , typeOf1, typeOf2, typeOf3, typeOf4, typeOf5, typeOf6, typeOf7 - , Typeable1, Typeable2, Typeable3, Typeable4 - , Typeable5, Typeable6, Typeable7 ) where import qualified Data.Typeable.Internal as I @@ -225,19 +223,3 @@ typeOf6 _ = I.someTypeRep (Proxy :: Proxy t) typeOf7 :: forall t (a :: *) (b :: *) (c :: *) (d :: *) (e :: *) (f :: *) (g :: *). Typeable t => t a b c d e f g -> TypeRep typeOf7 _ = I.someTypeRep (Proxy :: Proxy t) - -type Typeable1 (a :: * -> *) = Typeable a -type Typeable2 (a :: * -> * -> *) = Typeable a -type Typeable3 (a :: * -> * -> * -> *) = Typeable a -type Typeable4 (a :: * -> * -> * -> * -> *) = Typeable a -type Typeable5 (a :: * -> * -> * -> * -> * -> *) = Typeable a -type Typeable6 (a :: * -> * -> * -> * -> * -> * -> *) = Typeable a -type Typeable7 (a :: * -> * -> * -> * -> * -> * -> * -> *) = Typeable a - -{-# DEPRECATED Typeable1 "renamed to 'Typeable'" #-} -- deprecated in 7.8 -{-# DEPRECATED Typeable2 "renamed to 'Typeable'" #-} -- deprecated in 7.8 -{-# DEPRECATED Typeable3 "renamed to 'Typeable'" #-} -- deprecated in 7.8 -{-# DEPRECATED Typeable4 "renamed to 'Typeable'" #-} -- deprecated in 7.8 -{-# DEPRECATED Typeable5 "renamed to 'Typeable'" #-} -- deprecated in 7.8 -{-# DEPRECATED Typeable6 "renamed to 'Typeable'" #-} -- deprecated in 7.8 -{-# DEPRECATED Typeable7 "renamed to 'Typeable'" #-} -- deprecated in 7.8 diff --git a/libraries/base/changelog.md b/libraries/base/changelog.md index a9f2992..708676f 100644 --- a/libraries/base/changelog.md +++ b/libraries/base/changelog.md @@ -12,6 +12,8 @@ * Add `<&>` operator to `Data.Functor` (#14029) + * Remove the deprecated `Typeable{1..7}` type synonyms (#14047) + ## 4.10.0.0 *April 2017* * Bundled with GHC *TBA* diff --git a/testsuite/tests/deriving/should_run/T3087.hs b/testsuite/tests/deriving/should_run/T3087.hs index 9d3be07..1e20b9e 100644 --- a/testsuite/tests/deriving/should_run/T3087.hs +++ b/testsuite/tests/deriving/should_run/T3087.hs @@ -14,7 +14,7 @@ test1' = undefined `ext1Q` (\ (MyJust _) -> ()) $ MyJust () newtype Q r a = Q { unQ :: a -> r } -ext2Q :: (Data d, Typeable2 t) +ext2Q :: (Data d, Typeable t) => (d -> q) -> (forall d1 d2. (Data d1, Data d2) => t d1 d2 -> q) -> d -> q ext2Q def ext arg = From git at git.haskell.org Sat Aug 5 16:12:51 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 5 Aug 2017 16:12:51 +0000 (UTC) Subject: [commit: ghc] master: Add MonadIO Q - by requiring MonadIO => Quasi (394c391) Message-ID: <20170805161251.09BEF3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/394c391a41539914dc445368854638f396c824f9/ghc >--------------------------------------------------------------- commit 394c391a41539914dc445368854638f396c824f9 Author: Oleg Grenrus Date: Sat Aug 5 12:02:16 2017 -0400 Add MonadIO Q - by requiring MonadIO => Quasi Summary: This is follow-up to https://ghc.haskell.org/trac/ghc/ticket/10773 Reviewers: austin, goldfire, bgamari, RyanGlScott Reviewed By: RyanGlScott Subscribers: RyanGlScott, rwbarton, thomie Differential Revision: https://phabricator.haskell.org/D3816 >--------------------------------------------------------------- 394c391a41539914dc445368854638f396c824f9 compiler/typecheck/TcSplice.hs | 1 - libraries/ghci/GHCi/TH.hs | 5 ++++- libraries/template-haskell/Language/Haskell/TH/Syntax.hs | 10 ++++++---- libraries/template-haskell/changelog.md | 5 +++++ testsuite/tests/stranal/should_compile/T9208.hs | 4 +++- 5 files changed, 18 insertions(+), 7 deletions(-) diff --git a/compiler/typecheck/TcSplice.hs b/compiler/typecheck/TcSplice.hs index 266a4df..77c97f7 100644 --- a/compiler/typecheck/TcSplice.hs +++ b/compiler/typecheck/TcSplice.hs @@ -869,7 +869,6 @@ instance TH.Quasi TcM where -- the recovery action is chosen. Otherwise -- we'll only fail higher up. qRecover recover main = tryTcDiscardingErrs recover main - qRunIO io = liftIO io qAddDependentFile fp = do ref <- fmap tcg_dependent_files getGblEnv diff --git a/libraries/ghci/GHCi/TH.hs b/libraries/ghci/GHCi/TH.hs index 1b08501..09fbca7 100644 --- a/libraries/ghci/GHCi/TH.hs +++ b/libraries/ghci/GHCi/TH.hs @@ -97,6 +97,7 @@ import GHC.Serialized import Control.Exception import qualified Control.Monad.Fail as Fail +import Control.Monad.IO.Class (MonadIO (..)) import Data.Binary import Data.Binary.Put import Data.ByteString (ByteString) @@ -160,6 +161,9 @@ ghcCmd m = GHCiQ $ \s -> do THException str -> throwIO (GHCiQException s str) THComplete res -> return (res, s) +instance MonadIO GHCiQ where + liftIO m = GHCiQ $ \s -> fmap (,s) m + instance TH.Quasi GHCiQ where qNewName str = ghcCmd (NewName str) qReport isError msg = ghcCmd (Report isError msg) @@ -190,7 +194,6 @@ instance TH.Quasi GHCiQ where qReifyModule m = ghcCmd (ReifyModule m) qReifyConStrictness name = ghcCmd (ReifyConStrictness name) qLocation = fromMaybe noLoc . qsLocation <$> getState - qRunIO m = GHCiQ $ \s -> fmap (,s) m qAddDependentFile file = ghcCmd (AddDependentFile file) qAddTopDecls decls = ghcCmd (AddTopDecls decls) qAddForeignFile str lang = ghcCmd (AddForeignFile str lang) diff --git a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs index 90c7282..b8e1601 100644 --- a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs +++ b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs @@ -30,6 +30,7 @@ import Data.Data hiding (Fixity(..)) import Data.IORef import System.IO.Unsafe ( unsafePerformIO ) import Control.Monad (liftM) +import Control.Monad.IO.Class (MonadIO (..)) import System.IO ( hPutStrLn, stderr ) import Data.Char ( isAlpha, isAlphaNum, isUpper ) import Data.Int @@ -49,7 +50,7 @@ import qualified Control.Monad.Fail as Fail -- ----------------------------------------------------- -class Fail.MonadFail m => Quasi m where +class (MonadIO m, Fail.MonadFail m) => Quasi m where qNewName :: String -> m Name -- ^ Fresh names @@ -78,6 +79,7 @@ class Fail.MonadFail m => Quasi m where qLocation :: m Loc qRunIO :: IO a -> m a + qRunIO = liftIO -- ^ Input/output (dangerous) qAddDependentFile :: FilePath -> m () @@ -132,8 +134,6 @@ instance Quasi IO where qIsExtEnabled _ = badIO "isExtEnabled" qExtsEnabled = badIO "extsEnabled" - qRunIO m = m - badIO :: String -> IO a badIO op = do { qReport True ("Can't do `" ++ op ++ "' in the IO monad") ; fail "Template Haskell failure" } @@ -494,6 +494,9 @@ isExtEnabled ext = Q (qIsExtEnabled ext) extsEnabled :: Q [Extension] extsEnabled = Q qExtsEnabled +instance MonadIO Q where + liftIO = runIO + instance Quasi Q where qNewName = newName qReport = report @@ -507,7 +510,6 @@ instance Quasi Q where qReifyConStrictness = reifyConStrictness qLookupName = lookupName qLocation = location - qRunIO = runIO qAddDependentFile = addDependentFile qAddTopDecls = addTopDecls qAddForeignFile = addForeignFile diff --git a/libraries/template-haskell/changelog.md b/libraries/template-haskell/changelog.md index 0e3429c..e003f1b 100644 --- a/libraries/template-haskell/changelog.md +++ b/libraries/template-haskell/changelog.md @@ -14,6 +14,11 @@ with Template Haskell. This is not a part of the public API, and as such, there are no API guarantees for this module from version to version. + * `MonadIO` is now a superclass of `Quasi`, `qRunIO` has a default + implementation `qRunIO = liftIO` + + * Add `MonadIO Q` instance + ## 2.12.0.0 *TBA* * Bundled with GHC *TBA* diff --git a/testsuite/tests/stranal/should_compile/T9208.hs b/testsuite/tests/stranal/should_compile/T9208.hs index b8ec6df..5243445 100644 --- a/testsuite/tests/stranal/should_compile/T9208.hs +++ b/testsuite/tests/stranal/should_compile/T9208.hs @@ -25,6 +25,7 @@ import Control.Monad #if __GLASGOW_HASKELL__ >= 800 import Control.Monad.Fail (MonadFail(fail)) #endif +import Control.Monad.IO.Class (MonadIO (..)) import Data.Binary import Data.Binary.Get @@ -81,7 +82,8 @@ instance MonadFail GHCJSQ where fail = undefined #endif -instance TH.Quasi GHCJSQ where qRunIO m = GHCJSQ $ \s -> fmap (,s) m +instance MonadIO GHCJSQ where liftIO m = GHCJSQ $ \s -> fmap (,s) m +instance TH.Quasi GHCJSQ -- | the Template Haskell server runTHServer :: IO () From git at git.haskell.org Sat Aug 5 16:12:56 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 5 Aug 2017 16:12:56 +0000 (UTC) Subject: [commit: ghc] master: Don't warn when empty casing on Type (a267580) Message-ID: <20170805161256.ECBBC3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a267580e4ab37115dcc33f3b8a9af67b9364da12/ghc >--------------------------------------------------------------- commit a267580e4ab37115dcc33f3b8a9af67b9364da12 Author: Ryan Scott Date: Sat Aug 5 12:02:54 2017 -0400 Don't warn when empty casing on Type Summary: `Type` (a.k.a. `TYPE LiftedRep`) can be used at the type level thanks to `TypeInType`. However, expressions like ```lang=haskell f :: Type -> Int f x = case x of {} ``` were falsely claiming that the empty case on the value of type `Type` was non-exhaustive. The reason is a bit silly: `TYPE` is technically not an empty datatype in GHC's eyes, since it's a builtin, primitive type. To convince the pattern coverage checker otherwise, this adds a special case for `TYPE`. Test Plan: make test TEST=T14086 Reviewers: gkaracha, austin, bgamari, goldfire Reviewed By: goldfire Subscribers: goldfire, rwbarton, thomie GHC Trac Issues: #14086 Differential Revision: https://phabricator.haskell.org/D3819 >--------------------------------------------------------------- a267580e4ab37115dcc33f3b8a9af67b9364da12 compiler/deSugar/Check.hs | 14 ++++++++++++++ testsuite/tests/pmcheck/should_compile/T14086.hs | 6 ++++++ testsuite/tests/pmcheck/should_compile/all.T | 2 ++ 3 files changed, 22 insertions(+) diff --git a/compiler/deSugar/Check.hs b/compiler/deSugar/Check.hs index 2b1995c..b0155d3 100644 --- a/compiler/deSugar/Check.hs +++ b/compiler/deSugar/Check.hs @@ -27,6 +27,7 @@ import Id import ConLike import Name import FamInstEnv +import TysPrim (tYPETyCon) import TysWiredIn import TyCon import SrcLoc @@ -440,6 +441,19 @@ inhabitationCandidates fam_insts ty (_:_) -> do var <- liftD $ mkPmId (toTcType core_ty) let va = build_tm (PmVar var) dcs return $ Right [(va, mkIdEq var, emptyBag)] + + -- TYPE (which is the underlying kind behind Type, among others) + -- is conceptually an empty datatype, so one would expect this code + -- (from #14086) to compile without warnings: + -- + -- f :: Type -> Int + -- f x = case x of {} + -- + -- However, since TYPE is a primitive builtin type, not an actual + -- datatype, we must convince the coverage checker of this fact by + -- adding a special case here. + | tc == tYPETyCon -> pure (Right []) + | isClosedAlgType core_ty -> liftD $ do var <- mkPmId (toTcType core_ty) -- it would be wrong to unify x alts <- mapM (mkOneConFull var . RealDataCon) (tyConDataCons tc) diff --git a/testsuite/tests/pmcheck/should_compile/T14086.hs b/testsuite/tests/pmcheck/should_compile/T14086.hs new file mode 100644 index 0000000..de91229 --- /dev/null +++ b/testsuite/tests/pmcheck/should_compile/T14086.hs @@ -0,0 +1,6 @@ +{-# language TypeInType, EmptyCase #-} +module T14086 where +import Data.Kind + +f :: Type -> Int +f x = case x of diff --git a/testsuite/tests/pmcheck/should_compile/all.T b/testsuite/tests/pmcheck/should_compile/all.T index f44034b..cabe239 100644 --- a/testsuite/tests/pmcheck/should_compile/all.T +++ b/testsuite/tests/pmcheck/should_compile/all.T @@ -41,6 +41,8 @@ test('T11276', compile_timeout_multiplier(0.01), compile, ['-fwarn-incomplete-pa test('T11303b', compile_timeout_multiplier(0.01), compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns +RTS -M1G -RTS']) test('T11374', compile_timeout_multiplier(0.01), compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns +RTS -M1G -RTS']) test('T11195', compile_timeout_multiplier(0.60), compile, ['-package ghc -fwarn-incomplete-patterns -fwarn-overlapping-patterns +RTS -M2G -RTS']) +test('T14086', normal, compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) # Other tests test('pmc001', [], compile, From git at git.haskell.org Mon Aug 7 01:56:14 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 7 Aug 2017 01:56:14 +0000 (UTC) Subject: [commit: ghc] master: Fix string escaping in JSON (e8fe12f) Message-ID: <20170807015614.67E613A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e8fe12f83b17dc39d9272d44c4168946fa54e7a0/ghc >--------------------------------------------------------------- commit e8fe12f83b17dc39d9272d44c4168946fa54e7a0 Author: Dmitry Malikov Date: Sat Aug 5 16:28:40 2017 +0200 Fix string escaping in JSON It seems to that double quotes is not escaped well at the moment. We'd noticed this with @alexbiehl during the work on https://github.com/haskell/haddock/pull/645 >--------------------------------------------------------------- e8fe12f83b17dc39d9272d44c4168946fa54e7a0 compiler/utils/Json.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/utils/Json.hs b/compiler/utils/Json.hs index 1318ce2..ffbff50 100644 --- a/compiler/utils/Json.hs +++ b/compiler/utils/Json.hs @@ -39,7 +39,7 @@ escapeJsonString = concatMap escapeChar escapeChar '\n' = "\\n" escapeChar '\r' = "\\r" escapeChar '\t' = "\\t" - escapeChar '"' = "\"" + escapeChar '"' = "\\\"" escapeChar '\\' = "\\\\" escapeChar c | isControl c || fromEnum c >= 0x7f = uni_esc c escapeChar c = [c] From git at git.haskell.org Mon Aug 7 01:56:19 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 7 Aug 2017 01:56:19 +0000 (UTC) Subject: [commit: ghc] master: Convert examples to doctests, and add a handful of new ones (2f29f19) Message-ID: <20170807015619.DEB253A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2f29f198bfd04aadfae3b5a6152c855f9bb999d6/ghc >--------------------------------------------------------------- commit 2f29f198bfd04aadfae3b5a6152c855f9bb999d6 Author: David Luposchainsky Date: Sun Aug 6 13:32:52 2017 +0200 Convert examples to doctests, and add a handful of new ones >--------------------------------------------------------------- 2f29f198bfd04aadfae3b5a6152c855f9bb999d6 libraries/base/Data/OldList.hs | 192 +++++++++++++++++++++++++++++++++-------- 1 file changed, 157 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 2f29f198bfd04aadfae3b5a6152c855f9bb999d6 From git at git.haskell.org Mon Aug 7 01:56:17 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 7 Aug 2017 01:56:17 +0000 (UTC) Subject: [commit: ghc] master: Add forgotten > in Control.Applicative (6ea13e9) Message-ID: <20170807015617.252353A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6ea13e95ff6680c42ca005c70266325a17a9838d/ghc >--------------------------------------------------------------- commit 6ea13e95ff6680c42ca005c70266325a17a9838d Author: Oleg Grenrus Date: Fri Aug 4 18:07:14 2017 +0300 Add forgotten > in Control.Applicative As reported by tabaqui on `#hackage` >--------------------------------------------------------------- 6ea13e95ff6680c42ca005c70266325a17a9838d libraries/base/Control/Applicative.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/base/Control/Applicative.hs b/libraries/base/Control/Applicative.hs index 559cced..3e531e5 100644 --- a/libraries/base/Control/Applicative.hs +++ b/libraries/base/Control/Applicative.hs @@ -107,7 +107,7 @@ newtype ZipList a = ZipList { getZipList :: [a] } -- | -- > f '<$>' 'ZipList' xs1 '<*>' ... '<*>' 'ZipList' xsN --- = 'ZipList' (zipWithN f xs1 ... xsN) +-- > = 'ZipList' (zipWithN f xs1 ... xsN) -- -- where @zipWithN@ refers to the @zipWith@ function of the appropriate arity -- (@zipWith@, @zipWith3@, @zipWith4@, ...). For example: From git at git.haskell.org Mon Aug 7 23:23:27 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 7 Aug 2017 23:23:27 +0000 (UTC) Subject: [commit: ghc] master: Fix EmptyCase documentation (14457cf) Message-ID: <20170807232327.DE8E13A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/14457cf6a50f708eecece8f286f08687791d51f7/ghc >--------------------------------------------------------------- commit 14457cf6a50f708eecece8f286f08687791d51f7 Author: Cyd Parser Date: Sun Aug 6 22:23:23 2017 -0700 Fix EmptyCase documentation >--------------------------------------------------------------- 14457cf6a50f708eecece8f286f08687791d51f7 docs/users_guide/glasgow_exts.rst | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/docs/users_guide/glasgow_exts.rst b/docs/users_guide/glasgow_exts.rst index d50dd40..bc09402 100644 --- a/docs/users_guide/glasgow_exts.rst +++ b/docs/users_guide/glasgow_exts.rst @@ -1701,8 +1701,8 @@ example, consider these two candidate definitions of ``absurd``: :: - data a :==: b where - Refl :: a :==: a + data a :~: b where + Refl :: a :~: a absurd :: True :~: False -> a absurd x = error "absurd" -- (A) @@ -1710,10 +1710,9 @@ example, consider these two candidate definitions of ``absurd``: We much prefer (B). Why? Because GHC can figure out that ``(True :~: False)`` is an empty type. So (B) has no partiality and GHC -should be able to compile with :ghc-flag:`-Wincomplete-patterns`. (Though -the pattern match checking is not yet clever enough to do that.) On the -other hand (A) looks dangerous, and GHC doesn't check to make sure that, -in fact, the function can never get called. +is able to compile with :ghc-flag:`-Wincomplete-patterns` and +:ghc-flag:`-Werror`. On the other hand (A) looks dangerous, and GHC doesn't +check to make sure that, in fact, the function can never get called. .. _multi-way-if: From git at git.haskell.org Tue Aug 8 15:23:13 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 8 Aug 2017 15:23:13 +0000 (UTC) Subject: [commit: packages/text] master: Add unsnoc to changelog (13eaa08) Message-ID: <20170808152313.4B4B43A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/text On branch : master Link : http://git.haskell.org/packages/text.git/commitdiff/13eaa0813d5b65604b1c6c2b3d998454f053f8f0 >--------------------------------------------------------------- commit 13eaa0813d5b65604b1c6c2b3d998454f053f8f0 Author: Bryan O'Sullivan Date: Tue Jun 27 01:24:19 2017 +0100 Add unsnoc to changelog >--------------------------------------------------------------- 13eaa0813d5b65604b1c6c2b3d998454f053f8f0 changelog.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/changelog.md b/changelog.md index beca28f..28cdd7e 100644 --- a/changelog.md +++ b/changelog.md @@ -1,5 +1,7 @@ 1.2.3.0 +* `unsnoc` implemented + * Bug fix: the lazy `takeWhileEnd` function violated the [lazy text invariant](https://github.com/bos/text/blob/1.2.3.0/Data/Text/Internal/Lazy.hs#L51). From git at git.haskell.org Tue Aug 8 15:23:15 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 8 Aug 2017 15:23:15 +0000 (UTC) Subject: [commit: packages/text] master: fix utf8 error recovery (a125908) Message-ID: <20170808152315.4FEB73A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/text On branch : master Link : http://git.haskell.org/packages/text.git/commitdiff/a125908830a974870e835298fd35807b7a529574 >--------------------------------------------------------------- commit a125908830a974870e835298fd35807b7a529574 Author: Kubo Kovac Date: Mon May 22 16:27:20 2017 +0100 fix utf8 error recovery >--------------------------------------------------------------- a125908830a974870e835298fd35807b7a529574 cbits/cbits.c | 9 +++------ tests/Tests/Properties.hs | 18 ++++++++++++++++++ 2 files changed, 21 insertions(+), 6 deletions(-) diff --git a/cbits/cbits.c b/cbits/cbits.c index 9aec02a..029d7e8 100644 --- a/cbits/cbits.c +++ b/cbits/cbits.c @@ -222,12 +222,9 @@ _hs_text_decode_utf8(uint16_t *const dest, size_t *destoff, { uint32_t codepoint; uint32_t state = UTF8_ACCEPT; - uint8_t const *ret = _hs_text_decode_utf8_int(dest, destoff, &src, srcend, - &codepoint, &state); - /* Back up if we have an incomplete or invalid encoding */ - if (state != UTF8_ACCEPT) - ret -= 1; - return ret; + _hs_text_decode_utf8_int(dest, destoff, &src, srcend, + &codepoint, &state); + return src; } void diff --git a/tests/Tests/Properties.hs b/tests/Tests/Properties.hs index 2193562..d490438 100644 --- a/tests/Tests/Properties.hs +++ b/tests/Tests/Properties.hs @@ -180,6 +180,19 @@ genInvalidUTF8 = B.pack <$> oneof [ k <- choose (0,n) vectorOf k gen +-- See http://unicode.org/faq/utf_bom.html#gen8 +-- A sequence such as <110xxxxx2 0xxxxxxx2> is illegal ... +-- When faced with this illegal byte sequence ... a UTF-8 conformant process +-- must treat the first byte 110xxxxx2 as an illegal termination error +-- (e.g. filter it out or replace by 0xFFFD) ... +-- ... and continue processing at the second byte 0xxxxxxx2 +t_decode_with_error2 = + E.decodeUtf8With (\_ _ -> Just 'x') (B.pack [0xC2, 97]) === "xa" +t_decode_with_error3 = + E.decodeUtf8With (\_ _ -> Just 'x') (B.pack [0xE0, 97, 97]) === "xaa" +t_decode_with_error4 = + E.decodeUtf8With (\_ _ -> Just 'x') (B.pack [0xF0, 97, 97, 97]) === "xaaa" + s_Eq s = (s==) `eq` ((S.streamList s==) . S.streamList) where _types = s :: String sf_Eq p s = @@ -955,6 +968,11 @@ tests = testGroup "errors" [ testProperty "t_utf8_err" t_utf8_err, testProperty "t_utf8_err'" t_utf8_err' + ], + testGroup "error recovery" [ + testProperty "t_decode_with_error2" t_decode_with_error2, + testProperty "t_decode_with_error3" t_decode_with_error3, + testProperty "t_decode_with_error4" t_decode_with_error4 ] ], From git at git.haskell.org Tue Aug 8 15:23:17 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 8 Aug 2017 15:23:17 +0000 (UTC) Subject: [commit: packages/text] master: fix utf8 error recovery for stream decoding (c976329) Message-ID: <20170808152317.5646A3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/text On branch : master Link : http://git.haskell.org/packages/text.git/commitdiff/c976329a5eaf1546390adff38625527e6b6f1d85 >--------------------------------------------------------------- commit c976329a5eaf1546390adff38625527e6b6f1d85 Author: Kubo Kovac Date: Mon May 22 17:47:27 2017 +0100 fix utf8 error recovery for stream decoding >--------------------------------------------------------------- c976329a5eaf1546390adff38625527e6b6f1d85 cbits/cbits.c | 6 ++---- tests/Tests/Properties.hs | 15 ++++++++++++++- 2 files changed, 16 insertions(+), 5 deletions(-) diff --git a/cbits/cbits.c b/cbits/cbits.c index 029d7e8..9f46a41 100644 --- a/cbits/cbits.c +++ b/cbits/cbits.c @@ -207,10 +207,8 @@ _hs_text_decode_utf8_state(uint16_t *const dest, size_t *destoff, uint32_t *codepoint0, uint32_t *state0) { uint8_t const *ret = _hs_text_decode_utf8_int(dest, destoff, src, srcend, - codepoint0, state0); - if (*state0 == UTF8_REJECT) - ret -=1; - return ret; + codepoint0, state0); + return *src; } /* diff --git a/tests/Tests/Properties.hs b/tests/Tests/Properties.hs index d490438..04156d9 100644 --- a/tests/Tests/Properties.hs +++ b/tests/Tests/Properties.hs @@ -193,6 +193,16 @@ t_decode_with_error3 = t_decode_with_error4 = E.decodeUtf8With (\_ _ -> Just 'x') (B.pack [0xF0, 97, 97, 97]) === "xaaa" +t_decode_with_error2' = + case E.streamDecodeUtf8With (\_ _ -> Just 'x') (B.pack [0xC2, 97]) of + E.Some x _ _ -> x === "xa" +t_decode_with_error3' = + case E.streamDecodeUtf8With (\_ _ -> Just 'x') (B.pack [0xC2, 97, 97]) of + E.Some x _ _ -> x === "xaa" +t_decode_with_error4' = + case E.streamDecodeUtf8With (\_ _ -> Just 'x') (B.pack [0xC2, 97, 97, 97]) of + E.Some x _ _ -> x === "xaaa" + s_Eq s = (s==) `eq` ((S.streamList s==) . S.streamList) where _types = s :: String sf_Eq p s = @@ -972,7 +982,10 @@ tests = testGroup "error recovery" [ testProperty "t_decode_with_error2" t_decode_with_error2, testProperty "t_decode_with_error3" t_decode_with_error3, - testProperty "t_decode_with_error4" t_decode_with_error4 + testProperty "t_decode_with_error4" t_decode_with_error4, + testProperty "t_decode_with_error2'" t_decode_with_error2', + testProperty "t_decode_with_error3'" t_decode_with_error3', + testProperty "t_decode_with_error4'" t_decode_with_error4' ] ], From git at git.haskell.org Tue Aug 8 15:23:19 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 8 Aug 2017 15:23:19 +0000 (UTC) Subject: [commit: packages/text] master: add an extra test that correct utf8 doesn't disappear (d42bafb) Message-ID: <20170808152319.5C8453A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/text On branch : master Link : http://git.haskell.org/packages/text.git/commitdiff/d42bafbf7709964e86e3b315a9ae4d7bee17847b >--------------------------------------------------------------- commit d42bafbf7709964e86e3b315a9ae4d7bee17847b Author: Kubo Kovac Date: Mon May 22 17:58:43 2017 +0100 add an extra test that correct utf8 doesn't disappear >--------------------------------------------------------------- d42bafbf7709964e86e3b315a9ae4d7bee17847b tests/Tests/Properties.hs | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/tests/Tests/Properties.hs b/tests/Tests/Properties.hs index 04156d9..ec9a1fd 100644 --- a/tests/Tests/Properties.hs +++ b/tests/Tests/Properties.hs @@ -203,6 +203,10 @@ t_decode_with_error4' = case E.streamDecodeUtf8With (\_ _ -> Just 'x') (B.pack [0xC2, 97, 97, 97]) of E.Some x _ _ -> x === "xaaa" +t_infix_concat bs1 text bs2 rep = + text `T.isInfixOf` + E.decodeUtf8With (\_ _ -> rep) (B.concat [bs1, E.encodeUtf8 text, bs2]) + s_Eq s = (s==) `eq` ((S.streamList s==) . S.streamList) where _types = s :: String sf_Eq p s = @@ -985,7 +989,8 @@ tests = testProperty "t_decode_with_error4" t_decode_with_error4, testProperty "t_decode_with_error2'" t_decode_with_error2', testProperty "t_decode_with_error3'" t_decode_with_error3', - testProperty "t_decode_with_error4'" t_decode_with_error4' + testProperty "t_decode_with_error4'" t_decode_with_error4', + testProperty "t_infix_concat" t_infix_concat ] ], From git at git.haskell.org Tue Aug 8 15:23:21 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 8 Aug 2017 15:23:21 +0000 (UTC) Subject: [commit: packages/text] master: Update .gitignore (311805f) Message-ID: <20170808152321.61E723A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/text On branch : master Link : http://git.haskell.org/packages/text.git/commitdiff/311805ffa6d48995556d56965cbedb48ba393e5e >--------------------------------------------------------------- commit 311805ffa6d48995556d56965cbedb48ba393e5e Author: Doug Wilson Date: Wed Aug 2 09:11:09 2017 +1200 Update .gitignore These files are generated while building ghc >--------------------------------------------------------------- 311805ffa6d48995556d56965cbedb48ba393e5e .gitignore | 2 ++ 1 file changed, 2 insertions(+) diff --git a/.gitignore b/.gitignore index ec240f6..6b13280 100644 --- a/.gitignore +++ b/.gitignore @@ -1,3 +1,5 @@ dist cabal-dev cabal.sandbox.config +ghc.mk +GNUMakefile From git at git.haskell.org Tue Aug 8 15:23:23 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 8 Aug 2017 15:23:23 +0000 (UTC) Subject: [commit: packages/text] master: Update GitHub pointers (04dcb4a) Message-ID: <20170808152323.675A33A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/text On branch : master Link : http://git.haskell.org/packages/text.git/commitdiff/04dcb4a3489b024b69dc1d22a2f0dde32ebba65b >--------------------------------------------------------------- commit 04dcb4a3489b024b69dc1d22a2f0dde32ebba65b Author: Bryan O'Sullivan Date: Mon Aug 7 19:14:21 2017 -0700 Update GitHub pointers >--------------------------------------------------------------- 04dcb4a3489b024b69dc1d22a2f0dde32ebba65b text.cabal | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/text.cabal b/text.cabal index 25d20c2..50c5e0f 100644 --- a/text.cabal +++ b/text.cabal @@ -1,7 +1,7 @@ name: text version: 1.2.3.0 -homepage: https://github.com/bos/text -bug-reports: https://github.com/bos/text/issues +homepage: https://github.com/haskell/text +bug-reports: https://github.com/haskell/text/issues synopsis: An efficient packed Unicode text type. description: . @@ -201,7 +201,7 @@ test-suite tests source-repository head type: git - location: https://github.com/bos/text + location: https://github.com/haskell/text source-repository head type: mercurial From git at git.haskell.org Tue Aug 8 15:23:25 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 8 Aug 2017 15:23:25 +0000 (UTC) Subject: [commit: packages/text] master: Merge pull request #189 from duog/master (58962e5) Message-ID: <20170808152325.6C2133A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/text On branch : master Link : http://git.haskell.org/packages/text.git/commitdiff/58962e53fd4a28109c8a3c08d0fc3da165a26144 >--------------------------------------------------------------- commit 58962e53fd4a28109c8a3c08d0fc3da165a26144 Merge: 04dcb4a 311805f Author: Bryan O'Sullivan Date: Mon Aug 7 19:19:22 2017 -0700 Merge pull request #189 from duog/master Update .gitignore >--------------------------------------------------------------- 58962e53fd4a28109c8a3c08d0fc3da165a26144 .gitignore | 2 ++ 1 file changed, 2 insertions(+) From git at git.haskell.org Tue Aug 8 15:23:27 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 8 Aug 2017 15:23:27 +0000 (UTC) Subject: [commit: packages/text] master: Merge pull request #182 from kuk0/decode (45f389b) Message-ID: <20170808152327.717073A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/text On branch : master Link : http://git.haskell.org/packages/text.git/commitdiff/45f389b51535100c12fd26e936ff571d04d1df22 >--------------------------------------------------------------- commit 45f389b51535100c12fd26e936ff571d04d1df22 Merge: 58962e5 d42bafb Author: Bryan O'Sullivan Date: Mon Aug 7 19:26:29 2017 -0700 Merge pull request #182 from kuk0/decode Fixing #181 >--------------------------------------------------------------- 45f389b51535100c12fd26e936ff571d04d1df22 cbits/cbits.c | 15 +++++---------- tests/Tests/Properties.hs | 36 ++++++++++++++++++++++++++++++++++++ 2 files changed, 41 insertions(+), 10 deletions(-) From git at git.haskell.org Tue Aug 8 15:23:29 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 8 Aug 2017 15:23:29 +0000 (UTC) Subject: [commit: packages/text] master: Add benchmarks for gh-165 (2e73fe2) Message-ID: <20170808152329.781F63A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/text On branch : master Link : http://git.haskell.org/packages/text.git/commitdiff/2e73fe2d0e92b22201cecc6b21514a164c4c974e >--------------------------------------------------------------- commit 2e73fe2d0e92b22201cecc6b21514a164c4c974e Author: Bryan O'Sullivan Date: Mon Aug 7 20:33:21 2017 -0700 Add benchmarks for gh-165 I used the code from the gist as the source for the Concat module. >--------------------------------------------------------------- 2e73fe2d0e92b22201cecc6b21514a164c4c974e benchmarks/haskell/Benchmarks.hs | 2 ++ benchmarks/haskell/Benchmarks/Concat.hs | 25 +++++++++++++++++++++++++ benchmarks/text-benchmarks.cabal | 1 + 3 files changed, 28 insertions(+) diff --git a/benchmarks/haskell/Benchmarks.hs b/benchmarks/haskell/Benchmarks.hs index f074ab4..fdecba7 100644 --- a/benchmarks/haskell/Benchmarks.hs +++ b/benchmarks/haskell/Benchmarks.hs @@ -10,6 +10,7 @@ import System.FilePath (()) import System.IO (IOMode (WriteMode), openFile, hSetEncoding, utf8) import qualified Benchmarks.Builder as Builder +import qualified Benchmarks.Concat as Concat import qualified Benchmarks.DecodeUtf8 as DecodeUtf8 import qualified Benchmarks.EncodeUtf8 as EncodeUtf8 import qualified Benchmarks.Equality as Equality @@ -41,6 +42,7 @@ benchmarks = do -- Traditional benchmarks bs <- sequence [ Builder.benchmark + , Concat.benchmark , DecodeUtf8.benchmark "html" (tf "libya-chinese.html") , DecodeUtf8.benchmark "xml" (tf "yiwiki.xml") , DecodeUtf8.benchmark "ascii" (tf "ascii.txt") diff --git a/benchmarks/haskell/Benchmarks/Concat.hs b/benchmarks/haskell/Benchmarks/Concat.hs new file mode 100644 index 0000000..f670e88 --- /dev/null +++ b/benchmarks/haskell/Benchmarks/Concat.hs @@ -0,0 +1,25 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Benchmarks.Concat (benchmark) where + +import Control.Monad.Trans.Writer +import Criterion (Benchmark, bgroup, bench, whnf) +import Data.Text as T + +benchmark :: IO Benchmark +benchmark = return $ bgroup "Concat" + [ bench "append" $ whnf (append4 "Text 1" "Text 2" "Text 3") "Text 4" + , bench "concat" $ whnf (concat4 "Text 1" "Text 2" "Text 3") "Text 4" + , bench "write" $ whnf (write4 "Text 1" "Text 2" "Text 3") "Text 4" + ] + +append4, concat4, write4 :: Text -> Text -> Text -> Text -> Text + +{-# NOINLINE append4 #-} +append4 x1 x2 x3 x4 = x1 `append` x2 `append` x3 `append` x4 + +{-# NOINLINE concat4 #-} +concat4 x1 x2 x3 x4 = T.concat [x1, x2, x3, x4] + +{-# NOINLINE write4 #-} +write4 x1 x2 x3 x4 = execWriter $ tell x1 >> tell x2 >> tell x3 >> tell x4 diff --git a/benchmarks/text-benchmarks.cabal b/benchmarks/text-benchmarks.cabal index 268e6db..b21b61a 100644 --- a/benchmarks/text-benchmarks.cabal +++ b/benchmarks/text-benchmarks.cabal @@ -47,6 +47,7 @@ executable text-benchmarks ghc-prim, integer-gmp, stringsearch, + transformers, utf8-string, vector From git at git.haskell.org Wed Aug 9 15:27:20 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 9 Aug 2017 15:27:20 +0000 (UTC) Subject: [commit: ghc] wip/annotate-core: Push varBinder annotations further in (ffb8f65) Message-ID: <20170809152720.A16CC3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/annotate-core Link : http://ghc.haskell.org/trac/ghc/changeset/ffb8f654d22bd3c2ef5ad497665a0a73938bee88/ghc >--------------------------------------------------------------- commit ffb8f654d22bd3c2ef5ad497665a0a73938bee88 Author: Matthew Pickering Date: Wed Aug 9 14:34:34 2017 +0000 Push varBinder annotations further in >--------------------------------------------------------------- ffb8f654d22bd3c2ef5ad497665a0a73938bee88 compiler/coreSyn/PprCore.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/compiler/coreSyn/PprCore.hs b/compiler/coreSyn/PprCore.hs index d4ae498..2b001d9 100644 --- a/compiler/coreSyn/PprCore.hs +++ b/compiler/coreSyn/PprCore.hs @@ -349,7 +349,7 @@ binders are printed as "_". -- These instances are sadly orphans instance OutputableBndr Var where - pprBndr bs b = addAnn (varBinder b) (pprCoreBinder bs b) + pprBndr bs b = pprCoreBinder bs b pprInfixOcc b = addAnn (varReference b) (pprInfixName (varName b)) pprPrefixOcc b = addAnn (varReference b) (pprPrefixName (varName b)) bndrIsJoin_maybe = isJoinId_maybe @@ -373,7 +373,7 @@ pprCoreBinder bind_site bndr pprUntypedBinder :: Var -> SDoc pprUntypedBinder binder - | isTyVar binder = text "@" <+> ppr binder -- NB: don't print kind + | isTyVar binder = text "@" <+> addAnn (varBinder binder) (ppr binder) -- NB: don't print kind | otherwise = pprIdBndr binder pprTypedLamBinder :: BindingSite -> Bool -> Var -> SDoc @@ -423,12 +423,12 @@ pprTypedLetBinder binder pprKindedTyVarBndr :: TyVar -> SDoc -- Print a type variable binder with its kind (but not if *) pprKindedTyVarBndr tyvar - = text "@" <+> pprTyVar tyvar + = text "@" <+> addAnn (varBinder tyvar) (pprTyVar tyvar) -- pprIdBndr does *not* print the type -- When printing any Id binder in debug mode, we print its inline pragma and one-shot-ness pprIdBndr :: Id -> SDoc -pprIdBndr id = ppr id <+> pprIdBndrInfo (idInfo id) +pprIdBndr id = addAnn (varBinder id) (ppr id) <+> pprIdBndrInfo (idInfo id) pprIdBndrInfo :: IdInfo -> SDoc pprIdBndrInfo info From git at git.haskell.org Wed Aug 9 15:27:23 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 9 Aug 2017 15:27:23 +0000 (UTC) Subject: [commit: ghc] wip/annotate-core: Add reference to ppr_ty for type variables (360cf4c) Message-ID: <20170809152723.5BB323A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/annotate-core Link : http://ghc.haskell.org/trac/ghc/changeset/360cf4c8bc92830d0e6d92cc35d50465a683855d/ghc >--------------------------------------------------------------- commit 360cf4c8bc92830d0e6d92cc35d50465a683855d Author: Matthew Pickering Date: Wed Aug 9 15:23:28 2017 +0000 Add reference to ppr_ty for type variables >--------------------------------------------------------------- 360cf4c8bc92830d0e6d92cc35d50465a683855d compiler/basicTypes/Name.hs-boot | 2 ++ compiler/iface/IfaceType.hs | 3 ++- compiler/utils/OutputableAnnotation.hs | 10 +++++----- compiler/utils/OutputableAnnotation.hs-boot | 6 ++++++ 4 files changed, 15 insertions(+), 6 deletions(-) diff --git a/compiler/basicTypes/Name.hs-boot b/compiler/basicTypes/Name.hs-boot index c4eeca4..6c66846 100644 --- a/compiler/basicTypes/Name.hs-boot +++ b/compiler/basicTypes/Name.hs-boot @@ -1,3 +1,5 @@ module Name where data Name + +class NamedThing a diff --git a/compiler/iface/IfaceType.hs b/compiler/iface/IfaceType.hs index 39e3028..20144cb 100644 --- a/compiler/iface/IfaceType.hs +++ b/compiler/iface/IfaceType.hs @@ -60,6 +60,7 @@ import Name import BasicTypes import Binary import Outputable +import {-# SOURCE #-} OutputableAnnotation import FastString import FastStringEnv import Util @@ -573,7 +574,7 @@ pprPrecIfaceType :: TyPrec -> IfaceType -> SDoc pprPrecIfaceType prec ty = eliminateRuntimeRep (ppr_ty prec) ty ppr_ty :: TyPrec -> IfaceType -> SDoc -ppr_ty _ (IfaceFreeTyVar tyvar) = ppr tyvar -- This is the main reson for IfaceFreeTyVar! +ppr_ty _ (IfaceFreeTyVar tyvar) = addAnn (varReference tyvar) (ppr tyvar) ppr_ty _ (IfaceTyVar tyvar) = ppr tyvar -- See Note [TcTyVars in IfaceType] ppr_ty ctxt_prec (IfaceTyConApp tc tys) = pprTyTcApp ctxt_prec tc tys ppr_ty _ (IfaceTupleTy i p tys) = pprTuple i p tys diff --git a/compiler/utils/OutputableAnnotation.hs b/compiler/utils/OutputableAnnotation.hs index 12a7bba..fe6a39e 100644 --- a/compiler/utils/OutputableAnnotation.hs +++ b/compiler/utils/OutputableAnnotation.hs @@ -6,16 +6,16 @@ import Outputable ( OutputableBndr(..)) import Name (NamedThing) data PExpr where - PCoreExpr :: (OutputableBndr a, NamedThing a) => Expr a -> PExpr - PBind :: (OutputableBndr a, NamedThing a) => Bind a -> PExpr - PVar :: (OutputableBndr a, NamedThing a) => BindType -> a -> PExpr + PCoreExpr :: NamedThing a => Expr a -> PExpr + PBind :: NamedThing a => Bind a -> PExpr + PVar :: NamedThing a => BindType -> a -> PExpr data BindType = Binder | Reference -varBinder :: (OutputableBndr a, NamedThing a) => a -> PExpr +varBinder :: NamedThing a => a -> PExpr varBinder a = PVar Binder a -varReference :: (OutputableBndr a, NamedThing a) => a -> PExpr +varReference :: NamedThing a => a -> PExpr varReference a = PVar Reference a diff --git a/compiler/utils/OutputableAnnotation.hs-boot b/compiler/utils/OutputableAnnotation.hs-boot index d71f632..d7120df 100644 --- a/compiler/utils/OutputableAnnotation.hs-boot +++ b/compiler/utils/OutputableAnnotation.hs-boot @@ -1,3 +1,9 @@ module OutputableAnnotation where +import {-# SOURCE #-} Name (NamedThing) + data PExpr + +data BindType + +varReference :: NamedThing a => a -> PExpr From git at git.haskell.org Wed Aug 9 15:27:26 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 9 Aug 2017 15:27:26 +0000 (UTC) Subject: [commit: ghc] wip/annotate-core: Add binds type for Rec (836dddb) Message-ID: <20170809152726.2C5E63A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/annotate-core Link : http://ghc.haskell.org/trac/ghc/changeset/836dddb535084956b1d2e0f45a8f59dd55feee3d/ghc >--------------------------------------------------------------- commit 836dddb535084956b1d2e0f45a8f59dd55feee3d Author: Matthew Pickering Date: Wed Aug 9 15:27:02 2017 +0000 Add binds type for Rec >--------------------------------------------------------------- 836dddb535084956b1d2e0f45a8f59dd55feee3d compiler/coreSyn/PprCore.hs | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/compiler/coreSyn/PprCore.hs b/compiler/coreSyn/PprCore.hs index 2b001d9..02a0ffb 100644 --- a/compiler/coreSyn/PprCore.hs +++ b/compiler/coreSyn/PprCore.hs @@ -104,12 +104,13 @@ pprTopBind ann b@(NonRec binder expr) pprTopBind _ (Rec []) = text "Rec { }" -pprTopBind ann (Rec (b:bs)) - = vcat [text "Rec {", +pprTopBind ann bi@(Rec (b:bs)) + = addAnn (PBind bi) + (vcat [text "Rec {", ppr_binding ann b, vcat [blankLine $$ ppr_binding ann b | b <- bs], text "end Rec }", - blankLine] + blankLine]) ppr_bind :: (OutputableBndr b, NamedThing b) => Annotation b -> Bind b -> SDoc From git at git.haskell.org Thu Aug 10 07:50:26 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 10 Aug 2017 07:50:26 +0000 (UTC) Subject: [commit: ghc] wip/annotate-core: Recursively annotate core expr (599aa06) Message-ID: <20170810075026.2BB3D3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/annotate-core Link : http://ghc.haskell.org/trac/ghc/changeset/599aa0616211e42cf642a177515d5f8bee431eeb/ghc >--------------------------------------------------------------- commit 599aa0616211e42cf642a177515d5f8bee431eeb Author: Matthew Pickering Date: Thu Aug 10 07:47:26 2017 +0000 Recursively annotate core expr >--------------------------------------------------------------- 599aa0616211e42cf642a177515d5f8bee431eeb compiler/coreSyn/PprCore.hs | 33 +++++++++++++++++++-------------- 1 file changed, 19 insertions(+), 14 deletions(-) diff --git a/compiler/coreSyn/PprCore.hs b/compiler/coreSyn/PprCore.hs index 02a0ffb..a64c13a 100644 --- a/compiler/coreSyn/PprCore.hs +++ b/compiler/coreSyn/PprCore.hs @@ -128,7 +128,7 @@ ppr_binding ann (val_bdr, expr) Just ar -> pp_join_bind ar pp_normal_bind = hang (ppr val_bdr) 2 (equals <+> - addAnn (PCoreExpr expr) (pprCoreExpr expr)) + (pprCoreExpr expr)) -- For a join point of join arity n, we want to print j = \x1 ... xn -> e -- as "j x1 ... xn = e" to differentiate when a join point returns a @@ -153,21 +153,26 @@ pprOptCo co = sdocWithDynFlags $ \dflags -> then angleBrackets (text "Co:" <> int (coercionSize co)) else parens (sep [ppr co, dcolon <+> ppr (coercionType co)]) +-- This version adds an annotation, we want recursive calls +-- to add annotations as well. ppr_expr :: (OutputableBndr b, NamedThing b) => (SDoc -> SDoc) -> Expr b -> SDoc +ppr_expr add_par e = addAnn (PCoreExpr e) (ppr_expr_prim add_par e) + +ppr_expr_prim :: (OutputableBndr b, NamedThing b) => (SDoc -> SDoc) -> Expr b -> SDoc -- The function adds parens in context that need -- an atomic value (e.g. function args) -ppr_expr add_par (Var name) +ppr_expr_prim add_par (Var name) | isJoinId name = add_par ((text "jump") <+> ppr name) | otherwise = addAnn (varReference name) (ppr name) -ppr_expr add_par (Type ty) = add_par (text "TYPE:" <+> ppr ty) -- Weird -ppr_expr add_par (Coercion co) = add_par (text "CO:" <+> ppr co) -ppr_expr add_par (Lit lit) = pprLiteral add_par lit +ppr_expr_prim add_par (Type ty) = add_par (text "TYPE:" <+> ppr ty) -- Weird +ppr_expr_prim add_par (Coercion co) = add_par (text "CO:" <+> ppr co) +ppr_expr_prim add_par (Lit lit) = pprLiteral add_par lit -ppr_expr add_par (Cast expr co) +ppr_expr_prim add_par (Cast expr co) = add_par $ sep [pprParendExpr expr, text "`cast`" <+> pprOptCo co] -ppr_expr add_par expr@(Lam _ _) +ppr_expr_prim add_par expr@(Lam _ _) = let (bndrs, body) = collectBinders expr in @@ -175,7 +180,7 @@ ppr_expr add_par expr@(Lam _ _) hang (text "\\" <+> sep (map (pprBndr LambdaBind) bndrs) <+> arrow) 2 (pprCoreExpr body) -ppr_expr add_par expr@(App {}) +ppr_expr_prim add_par expr@(App {}) = sdocWithDynFlags $ \dflags -> case collectArgs expr of { (fun, args) -> let @@ -208,7 +213,7 @@ ppr_expr add_par expr@(App {}) _ -> parens (hang (pprParendExpr fun) 2 pp_args) } -ppr_expr add_par (Case expr var ty [(con,args,rhs)]) +ppr_expr_prim add_par (Case expr var ty [(con,args,rhs)]) = sdocWithDynFlags $ \dflags -> if gopt Opt_PprCaseAsLet dflags then add_par $ -- See Note [Print case as let] @@ -233,7 +238,7 @@ ppr_expr add_par (Case expr var ty [(con,args,rhs)]) where ppr_bndr = pprBndr CaseBind -ppr_expr add_par (Case expr var ty alts) +ppr_expr_prim add_par (Case expr var ty alts) = add_par $ sep [sep [text "case" <+> pprCoreExpr expr @@ -250,7 +255,7 @@ ppr_expr add_par (Case expr var ty alts) -- ("disgusting" SLPJ) {- -ppr_expr add_par (Let bind@(NonRec val_bdr rhs@(Let _ _)) body) +ppr_expr_prim add_par (Let bind@(NonRec val_bdr rhs@(Let _ _)) body) = add_par $ vcat [ hsep [text "let {", (pprBndr LetBind val_bdr $$ ppr val_bndr), equals], @@ -258,7 +263,7 @@ ppr_expr add_par (Let bind@(NonRec val_bdr rhs@(Let _ _)) body) text "} in", pprCoreExpr body ] -ppr_expr add_par (Let bind@(NonRec val_bdr rhs) expr@(Let _ _)) +ppr_expr_prim add_par (Let bind@(NonRec val_bdr rhs) expr@(Let _ _)) = add_par (hang (text "let {") 2 (hsep [ppr_binding (val_bdr,rhs), @@ -269,7 +274,7 @@ ppr_expr add_par (Let bind@(NonRec val_bdr rhs) expr@(Let _ _)) -- General case (recursive case, too) -ppr_expr add_par (Let bind expr) +ppr_expr_prim add_par (Let bind expr) = add_par $ sep [hang (keyword bind <+> char '{') 2 (ppr_bind noAnn bind <+> text "} in"), pprCoreExpr expr] @@ -282,7 +287,7 @@ ppr_expr add_par (Let bind expr) , isJust (bndrIsJoin_maybe b) = text "joinrec" | otherwise = text "letrec" -ppr_expr add_par (Tick tickish expr) +ppr_expr_prim add_par (Tick tickish expr) = sdocWithDynFlags $ \dflags -> if gopt Opt_SuppressTicks dflags then ppr_expr add_par expr From git at git.haskell.org Thu Aug 10 08:43:51 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 10 Aug 2017 08:43:51 +0000 (UTC) Subject: [commit: ghc] wip/perf-testsuite: Cleaning up my trash code for the perf_notes comparison tool (2fe312a) Message-ID: <20170810084351.1169E3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/perf-testsuite Link : http://ghc.haskell.org/trac/ghc/changeset/2fe312a4329358b2b17c7d1e4b9b19061891f1a9/ghc >--------------------------------------------------------------- commit 2fe312a4329358b2b17c7d1e4b9b19061891f1a9 Author: Jared Weakly Date: Sat Jul 22 20:48:48 2017 -0700 Cleaning up my trash code for the perf_notes comparison tool >--------------------------------------------------------------- 2fe312a4329358b2b17c7d1e4b9b19061891f1a9 testsuite/driver/perf_notes.py | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/testsuite/driver/perf_notes.py b/testsuite/driver/perf_notes.py index ffa7656..a3d856f 100644 --- a/testsuite/driver/perf_notes.py +++ b/testsuite/driver/perf_notes.py @@ -7,6 +7,11 @@ # metrics across arbitrary commits. The file will produce a table comparing # metrics between measurements taken for given commits in the environment given # by --test-env. +<<<<<<< HEAD +======= + +from __future__ import print_function +>>>>>>> Cleaning up my trash code for the perf_notes comparison tool # TODO: Actually figure out what imports I need. import argparse From git at git.haskell.org Thu Aug 10 08:43:56 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 10 Aug 2017 08:43:56 +0000 (UTC) Subject: [commit: ghc] wip/perf-testsuite: Rebase the branch to linearize the history (ed59533) Message-ID: <20170810084356.87CC93A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/perf-testsuite Link : http://ghc.haskell.org/trac/ghc/changeset/ed5953397f8b0d55f196e3f041d407919fb6e757/ghc >--------------------------------------------------------------- commit ed5953397f8b0d55f196e3f041d407919fb6e757 Author: Jared Weakly Date: Fri Jul 28 16:38:49 2017 -0700 Rebase the branch to linearize the history >--------------------------------------------------------------- ed5953397f8b0d55f196e3f041d407919fb6e757 testsuite/driver/runtests.py | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/testsuite/driver/runtests.py b/testsuite/driver/runtests.py index 62d6a8c..4d4b941 100644 --- a/testsuite/driver/runtests.py +++ b/testsuite/driver/runtests.py @@ -98,7 +98,13 @@ if args.threads: if args.verbose: config.verbose = args.verbose + +# Might need to encase these in if statements. config.skip_perf_tests = args.skip_perf_tests +config.only_perf_tests = args.only_perf_tests +config.use_git_notes = args.use_git_notes +config.test_env = args.test_env + config.cygwin = False config.msys = False From git at git.haskell.org Thu Aug 10 08:43:53 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 10 Aug 2017 08:43:53 +0000 (UTC) Subject: [commit: ghc] wip/perf-testsuite: Small changes to address Ben's comments (1ee0a7f) Message-ID: <20170810084353.C584F3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/perf-testsuite Link : http://ghc.haskell.org/trac/ghc/changeset/1ee0a7ff16c4d6714785a02eeceb24360b8220be/ghc >--------------------------------------------------------------- commit 1ee0a7ff16c4d6714785a02eeceb24360b8220be Author: Jared Weakly Date: Tue Jul 18 17:35:34 2017 -0700 Small changes to address Ben's comments Signed-off-by: Jared Weakly >--------------------------------------------------------------- 1ee0a7ff16c4d6714785a02eeceb24360b8220be testsuite/driver/runtests.py | 5 +++++ testsuite/driver/testlib.py | 1 - 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/testsuite/driver/runtests.py b/testsuite/driver/runtests.py index 25643e9..796a2c5 100644 --- a/testsuite/driver/runtests.py +++ b/testsuite/driver/runtests.py @@ -307,6 +307,11 @@ else: summary(t, sys.stdout, config.no_print_summary) + # This here is loading up all of the git notes into memory. + # It's most likely in the wrong spot and I haven't fully fleshed out + # where exactly I'm putting this and how I'm refactoring the performance + # test running logic. + # Currently this is useful for debugging, at least. if config.use_git_notes: note = subprocess.check_output(["git","notes","--ref=perf","append","-m", "\n".join(config.accumulate_metrics)]) parse_git_notes('perf') # Should this be hardcoded? Most likely not... diff --git a/testsuite/driver/testlib.py b/testsuite/driver/testlib.py index a24ee6c..8fc3ed7 100644 --- a/testsuite/driver/testlib.py +++ b/testsuite/driver/testlib.py @@ -1086,7 +1086,6 @@ def stats( name, way, stats_file ): # Check -t stats info def checkStats(name, way, stats_file, range_fields): - full_name = name + '(' + way + ')' result = passed() From git at git.haskell.org Thu Aug 10 08:43:59 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 10 Aug 2017 08:43:59 +0000 (UTC) Subject: [commit: ghc] wip/perf-testsuite: Can now load up git note data into python (1f7584c) Message-ID: <20170810084359.495C03A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/perf-testsuite Link : http://ghc.haskell.org/trac/ghc/changeset/1f7584c0952beaa9a2f5abc28f66376b7790a8e7/ghc >--------------------------------------------------------------- commit 1f7584c0952beaa9a2f5abc28f66376b7790a8e7 Author: Jared Weakly Date: Tue Jul 18 12:17:57 2017 -0700 Can now load up git note data into python >--------------------------------------------------------------- 1f7584c0952beaa9a2f5abc28f66376b7790a8e7 testsuite/driver/runtests.py | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/testsuite/driver/runtests.py b/testsuite/driver/runtests.py index 8d158f8..25643e9 100644 --- a/testsuite/driver/runtests.py +++ b/testsuite/driver/runtests.py @@ -306,8 +306,10 @@ else: sys.stdout.flush() summary(t, sys.stdout, config.no_print_summary) - print("Only perf tests: " + str(config.only_perf_tests) + "\n") - print("Skip perf tests: " + str(config.skip_perf_tests) + "\n") + + if config.use_git_notes: + note = subprocess.check_output(["git","notes","--ref=perf","append","-m", "\n".join(config.accumulate_metrics)]) + parse_git_notes('perf') # Should this be hardcoded? Most likely not... # This here is loading up all of the git notes into memory. # It's most likely in the wrong spot and I haven't fully fleshed out From git at git.haskell.org Thu Aug 10 08:44:02 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 10 Aug 2017 08:44:02 +0000 (UTC) Subject: [commit: ghc] wip/perf-testsuite: ONLY_PERF_TESTS=YES now fully implemented (42b7e42) Message-ID: <20170810084402.1016F3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/perf-testsuite Link : http://ghc.haskell.org/trac/ghc/changeset/42b7e42beb837647b84db970a1e65031c91a469d/ghc >--------------------------------------------------------------- commit 42b7e42beb837647b84db970a1e65031c91a469d Author: Jared Weakly Date: Wed Jul 12 17:30:31 2017 -0700 ONLY_PERF_TESTS=YES now fully implemented >--------------------------------------------------------------- 42b7e42beb837647b84db970a1e65031c91a469d testsuite/driver/runtests.py | 2 ++ testsuite/driver/testlib.py | 1 + 2 files changed, 3 insertions(+) diff --git a/testsuite/driver/runtests.py b/testsuite/driver/runtests.py index 3e03ed3..30f320a 100644 --- a/testsuite/driver/runtests.py +++ b/testsuite/driver/runtests.py @@ -306,6 +306,8 @@ else: sys.stdout.flush() summary(t, sys.stdout, config.no_print_summary) + print("Only perf tests: " + str(config.only_perf_tests) + "\n") + print("Skip perf tests: " + str(config.skip_perf_tests) + "\n") if config.summary_file: with open(config.summary_file, 'w') as file: diff --git a/testsuite/driver/testlib.py b/testsuite/driver/testlib.py index 0da86f2..45b44a5 100644 --- a/testsuite/driver/testlib.py +++ b/testsuite/driver/testlib.py @@ -714,6 +714,7 @@ def test_common_work(watcher, name, opts, func, args): and (getTestOpts().only_ways == None or way in getTestOpts().only_ways) \ and (config.cmdline_ways == [] or way in config.cmdline_ways) \ and (not (config.skip_perf_tests and isStatsTest())) \ + and (not (config.only_perf_tests and (not isStatsTest()))) \ and way not in getTestOpts().omit_ways # Which ways we are asked to skip From git at git.haskell.org Thu Aug 10 08:44:04 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 10 Aug 2017 08:44:04 +0000 (UTC) Subject: [commit: ghc] wip/perf-testsuite: Added initial metric comparison tooling (864ed76) Message-ID: <20170810084404.D217D3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/perf-testsuite Link : http://ghc.haskell.org/trac/ghc/changeset/864ed7684ad5bdd569570c9a72b0516e2bd556b4/ghc >--------------------------------------------------------------- commit 864ed7684ad5bdd569570c9a72b0516e2bd556b4 Author: Jared Weakly Date: Thu Jul 20 17:30:21 2017 -0700 Added initial metric comparison tooling >--------------------------------------------------------------- 864ed7684ad5bdd569570c9a72b0516e2bd556b4 testsuite/driver/runtests.py | 9 +++------ testsuite/driver/testutil.py | 10 ++++++---- 2 files changed, 9 insertions(+), 10 deletions(-) diff --git a/testsuite/driver/runtests.py b/testsuite/driver/runtests.py index 796a2c5..540f090 100644 --- a/testsuite/driver/runtests.py +++ b/testsuite/driver/runtests.py @@ -307,14 +307,11 @@ else: summary(t, sys.stdout, config.no_print_summary) - # This here is loading up all of the git notes into memory. - # It's most likely in the wrong spot and I haven't fully fleshed out - # where exactly I'm putting this and how I'm refactoring the performance - # test running logic. - # Currently this is useful for debugging, at least. + # Write our accumulated metrics into the git notes for this commit. if config.use_git_notes: note = subprocess.check_output(["git","notes","--ref=perf","append","-m", "\n".join(config.accumulate_metrics)]) - parse_git_notes('perf') # Should this be hardcoded? Most likely not... + # v-- This is in a nonsensical area. It should be happening before all of the tests are even run. + # parse_git_notes('perf') # Should it even be happening in the test-driver logic anymore? # This here is loading up all of the git notes into memory. # It's most likely in the wrong spot and I haven't fully fleshed out diff --git a/testsuite/driver/testutil.py b/testsuite/driver/testutil.py index 1fe1c20..bf9ed2a 100644 --- a/testsuite/driver/testutil.py +++ b/testsuite/driver/testutil.py @@ -3,7 +3,6 @@ import os import platform import subprocess import shutil - import threading def strip_quotes(s): @@ -50,14 +49,17 @@ def lndir(srcdir, dstdir): # This function allows one to read in git notes from the commandline # and then breaks it into a list of dictionaries that can be parsed # later on in the testing functions. -def parse_git_notes(namespace): +# I wanted to put it in perf_notes.py but couldn't figure out a nice way to do that. +def parse_git_notes(namespace, commits=['HEAD']): logFields = ['TEST_ENV','TEST','WAY','METRIC','VALUE'] - log = subprocess.check_output(['git', 'notes', '--ref=' + namespace, 'show']).decode('utf-8') + log = "" + for commit in commits: + log += subprocess.check_output(['git', 'notes', '--ref=' + namespace, 'show', commit]).decode('utf-8') + log = log.strip('\n').split('\n') log = [line.strip('\t').split('\t') for line in log] log = [dict(zip(logFields, field)) for field in log] return log - # Add a print statement here if you want to see what's being loaded from git notes. # On Windows, os.symlink is not defined with Python 2.7, but is in Python 3 # when using msys2, as GHC does. Unfortunately, only Administrative users have From git at git.haskell.org Thu Aug 10 08:44:07 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 10 Aug 2017 08:44:07 +0000 (UTC) Subject: [commit: ghc] wip/perf-testsuite: Initial tooling to compare across commits (but for actual this time) (56b3a87) Message-ID: <20170810084407.E01A23A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/perf-testsuite Link : http://ghc.haskell.org/trac/ghc/changeset/56b3a87ff349e886b217c16d03cbaa4e1c43577d/ghc >--------------------------------------------------------------- commit 56b3a87ff349e886b217c16d03cbaa4e1c43577d Author: Jared Weakly Date: Thu Jul 20 17:43:27 2017 -0700 Initial tooling to compare across commits (but for actual this time) >--------------------------------------------------------------- 56b3a87ff349e886b217c16d03cbaa4e1c43577d testsuite/driver/perf_notes.py | 85 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 85 insertions(+) diff --git a/testsuite/driver/perf_notes.py b/testsuite/driver/perf_notes.py new file mode 100644 index 0000000..ea289fc --- /dev/null +++ b/testsuite/driver/perf_notes.py @@ -0,0 +1,85 @@ +#1/usr/bin/env python3 + +# +# (c) Jared Weakly 2017 +# +# This file will be a utility to help facilitate the comparison of performance +# metrics across arbitrary commits. The file will produce a table comparing +# metrics between measurements taken for given commits in the environment given +# by --test-env. +# +# The file will also (for now) exist as a library to import git-note +# functionality for the project into other files so everywhere has access to +# functions such as parse_git_notes. +# +# It will take a few arguments: +# --test-env= +# --test-name= (optional: If given, filters table to include only tests matching the given regular expression.) +# --min-delta= (optional: Display only tests where the relative spread is greater than the given value.) +# All following arguments will be the commits to compare. + +from __future__ import print_function + +# TODO: Actually figure out what imports I need. +import argparse +import re +import os +import string +import subprocess + +from testutil import parse_git_notes + +# --------- Comparison Utilities -------- # +parser = argparse.ArgumentParser() +parser.add_argument("--test-env", + help="The given test environment to be compared.") #, + # required=True) # Should I make this required? +parser.add_argument("--test-name", + help="Optional: If given, filters table to include only \ + tests matching the given regular expression.") +parser.add_argument("--min-delta", + help="Optional: Display only tests where the relative \ + spread is greater than the given value.") +parser.add_argument("commits", nargs=argparse.REMAINDER) + +args = parser.parse_args() + +# Defaults +env = 'local' +name = re.compile('.*') +metrics = [] + +# I should figure out a nice way to mark data with the commit it comes from +# so that I can display test performance numbers in order from oldest to newest commit. +if args.commits: + print(args.commits) + metrics = parse_git_notes('perf',args.commits) + +if args.test_env: + env = args.test_env + metrics = [test for test in metrics if test['TEST_ENV'] == env] + +if args.test_name: + name = re.compile(args.test_name) + metrics = [test for test in metrics if name.search(test.get('TEST',''))] + +# Logic should probably go here to sort, group, and otherwise prepare the list +# of dicts for being pretty printed. +print(metrics) + +# I'll redo this table almost entirely, it's just a proof of concept for now. +# Ideally the list of metrics should be grouped by same test and organized from oldest to newest commits +# and each test will have its own small paragraph. I'm envisioning something like: +# -------------------------------- +# Test Foo: test_env, test_way, metric +# --------------------------------- +# commit1 commit2 commit3 ... +# number1 number2 number3 ... +# +# Gosh, I want to just print a list of dictionaries pretty like but don't want to just add some random dependency... +# Table is hardcoded and pretty ugly, but... it works. +# For now, this table just pretty prints the list of dictionaries. +print("{:<12} {:<10} {:<10} {:<20} {:<15}".format('TEST_ENV','TEST','WAY','METRIC','VALUE')) +for key in metrics: + print("{:<12} {:<10} {:<10} {:<20} {:<15}" + .format(key['TEST_ENV'],key['TEST'],key['WAY'],key['METRIC'],key['VALUE'])) From git at git.haskell.org Thu Aug 10 08:44:10 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 10 Aug 2017 08:44:10 +0000 (UTC) Subject: [commit: ghc] wip/perf-testsuite: Small changes to address Ben's comments (4961e16) Message-ID: <20170810084410.9E0373A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/perf-testsuite Link : http://ghc.haskell.org/trac/ghc/changeset/4961e16c53fbc4dee44ede6639e28701fa82ac40/ghc >--------------------------------------------------------------- commit 4961e16c53fbc4dee44ede6639e28701fa82ac40 Author: Jared Weakly Date: Tue Jul 18 17:35:34 2017 -0700 Small changes to address Ben's comments Signed-off-by: Jared Weakly >--------------------------------------------------------------- 4961e16c53fbc4dee44ede6639e28701fa82ac40 testsuite/driver/testlib.py | 1 - 1 file changed, 1 deletion(-) diff --git a/testsuite/driver/testlib.py b/testsuite/driver/testlib.py index a24ee6c..8fc3ed7 100644 --- a/testsuite/driver/testlib.py +++ b/testsuite/driver/testlib.py @@ -1086,7 +1086,6 @@ def stats( name, way, stats_file ): # Check -t stats info def checkStats(name, way, stats_file, range_fields): - full_name = name + '(' + way + ')' result = passed() From git at git.haskell.org Thu Aug 10 08:44:13 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 10 Aug 2017 08:44:13 +0000 (UTC) Subject: [commit: ghc] wip/perf-testsuite: Basic metrics collection and command line options working (e8a6405) Message-ID: <20170810084413.6215A3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/perf-testsuite Link : http://ghc.haskell.org/trac/ghc/changeset/e8a6405cb9edeae1bd34752691ea451685de1010/ghc >--------------------------------------------------------------- commit e8a6405cb9edeae1bd34752691ea451685de1010 Author: Jared Weakly Date: Thu Jul 6 17:16:49 2017 -0700 Basic metrics collection and command line options working >--------------------------------------------------------------- e8a6405cb9edeae1bd34752691ea451685de1010 testsuite/driver/testlib.py | 1 + 1 file changed, 1 insertion(+) diff --git a/testsuite/driver/testlib.py b/testsuite/driver/testlib.py index 8fc3ed7..a24ee6c 100644 --- a/testsuite/driver/testlib.py +++ b/testsuite/driver/testlib.py @@ -1086,6 +1086,7 @@ def stats( name, way, stats_file ): # Check -t stats info def checkStats(name, way, stats_file, range_fields): + full_name = name + '(' + way + ')' result = passed() From git at git.haskell.org Thu Aug 10 08:44:16 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 10 Aug 2017 08:44:16 +0000 (UTC) Subject: [commit: ghc] wip/perf-testsuite: Greatly improved printing. Fixed the delta function. Made things simpler (fa4fb52) Message-ID: <20170810084416.310103A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/perf-testsuite Link : http://ghc.haskell.org/trac/ghc/changeset/fa4fb52e07fb998bce62d91fd62e043ce1e366dc/ghc >--------------------------------------------------------------- commit fa4fb52e07fb998bce62d91fd62e043ce1e366dc Author: Jared Weakly Date: Wed Jul 26 18:30:37 2017 -0700 Greatly improved printing. Fixed the delta function. Made things simpler Signed-off-by: Jared Weakly >--------------------------------------------------------------- fa4fb52e07fb998bce62d91fd62e043ce1e366dc testsuite/driver/perf_notes.py | 104 +++++++++++++++++++---------------------- testsuite/driver/testutil.py | 9 ++-- 2 files changed, 51 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 fa4fb52e07fb998bce62d91fd62e043ce1e366dc From git at git.haskell.org Thu Aug 10 08:44:18 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 10 Aug 2017 08:44:18 +0000 (UTC) Subject: [commit: ghc] wip/perf-testsuite: Cleaning up my trash code for the perf_notes comparison tool (fa1ac5d) Message-ID: <20170810084418.F21DA3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/perf-testsuite Link : http://ghc.haskell.org/trac/ghc/changeset/fa1ac5d0e1044d19e85d3676c647a456071fe2e6/ghc >--------------------------------------------------------------- commit fa1ac5d0e1044d19e85d3676c647a456071fe2e6 Author: Jared Weakly Date: Sat Jul 22 20:48:48 2017 -0700 Cleaning up my trash code for the perf_notes comparison tool >--------------------------------------------------------------- fa1ac5d0e1044d19e85d3676c647a456071fe2e6 testsuite/driver/perf_notes.py | 105 +++++++++++++---------------------------- 1 file changed, 34 insertions(+), 71 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 fa1ac5d0e1044d19e85d3676c647a456071fe2e6 From git at git.haskell.org Thu Aug 10 08:44:21 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 10 Aug 2017 08:44:21 +0000 (UTC) Subject: [commit: ghc] wip/perf-testsuite: Changed perf_notes quite a bit. Should be much closer to actually usable now (434366f) Message-ID: <20170810084421.B15EA3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/perf-testsuite Link : http://ghc.haskell.org/trac/ghc/changeset/434366f86b71f724113af68dba305f2bdc5f1c41/ghc >--------------------------------------------------------------- commit 434366f86b71f724113af68dba305f2bdc5f1c41 Author: Jared Weakly Date: Sat Jul 22 20:18:22 2017 -0700 Changed perf_notes quite a bit. Should be much closer to actually usable now >--------------------------------------------------------------- 434366f86b71f724113af68dba305f2bdc5f1c41 testsuite/driver/runtests.py | 6 ------ 1 file changed, 6 deletions(-) diff --git a/testsuite/driver/runtests.py b/testsuite/driver/runtests.py index 7dea1c7..9d8d1c5 100644 --- a/testsuite/driver/runtests.py +++ b/testsuite/driver/runtests.py @@ -316,12 +316,6 @@ else: # v-- This is in a nonsensical area. It should be happening before all of the tests are even run. # parse_git_notes('perf') # Should it even be happening in the test-driver logic anymore? - # Write our accumulated metrics into the git notes for this commit. - if config.use_git_notes: - note = subprocess.check_output(["git","notes","--ref=perf","append","-m", "\n".join(config.accumulate_metrics)]) - # v-- This is in a nonsensical area. It should be happening before all of the tests are even run. - # parse_git_notes('perf') # Should it even be happening in the test-driver logic anymore? - if config.summary_file: with open(config.summary_file, 'w') as file: summary(t, file) From git at git.haskell.org Thu Aug 10 08:44:24 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 10 Aug 2017 08:44:24 +0000 (UTC) Subject: [commit: ghc] wip/perf-testsuite: Small changes to address Ben's comments (2982cf8) Message-ID: <20170810084424.814333A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/perf-testsuite Link : http://ghc.haskell.org/trac/ghc/changeset/2982cf8b7921a41fe1dfa6a55d0240c03f440308/ghc >--------------------------------------------------------------- commit 2982cf8b7921a41fe1dfa6a55d0240c03f440308 Author: Jared Weakly Date: Tue Jul 18 17:35:34 2017 -0700 Small changes to address Ben's comments Signed-off-by: Jared Weakly >--------------------------------------------------------------- 2982cf8b7921a41fe1dfa6a55d0240c03f440308 testsuite/driver/runtests.py | 5 +++++ testsuite/driver/testglobals.py | 2 +- testsuite/driver/testlib.py | 5 ++--- testsuite/driver/testutil.py | 6 ++++-- 4 files changed, 12 insertions(+), 6 deletions(-) diff --git a/testsuite/driver/runtests.py b/testsuite/driver/runtests.py index e102a94..8d0b337 100644 --- a/testsuite/driver/runtests.py +++ b/testsuite/driver/runtests.py @@ -307,6 +307,11 @@ else: summary(t, sys.stdout, config.no_print_summary) + # This here is loading up all of the git notes into memory. + # It's most likely in the wrong spot and I haven't fully fleshed out + # where exactly I'm putting this and how I'm refactoring the performance + # test running logic. + # Currently this is useful for debugging, at least. if config.use_git_notes: note = subprocess.check_output(["git","notes","--ref=perf","append","-m", "\n".join(config.accumulate_metrics)]) parse_git_notes('perf') # Should this be hardcoded? Most likely not... diff --git a/testsuite/driver/testglobals.py b/testsuite/driver/testglobals.py index 5ed54bd..6d8cd3d 100644 --- a/testsuite/driver/testglobals.py +++ b/testsuite/driver/testglobals.py @@ -125,7 +125,7 @@ class TestConfig: # To accumulate the metrics for the git notes self.accumulate_metrics = [] # Has the user defined a custom test environment? Local is default. - self.TEST_ENV = 'local' + self.test_env = 'local' global config config = TestConfig() diff --git a/testsuite/driver/testlib.py b/testsuite/driver/testlib.py index 45b44a5..8fc3ed7 100644 --- a/testsuite/driver/testlib.py +++ b/testsuite/driver/testlib.py @@ -1086,7 +1086,6 @@ def stats( name, way, stats_file ): # Check -t stats info def checkStats(name, way, stats_file, range_fields): - full_name = name + '(' + way + ')' result = passed() @@ -1112,8 +1111,8 @@ def checkStats(name, way, stats_file, range_fields): # Add val into the git note if option is set. if config.use_git_notes: - test_env = config.TEST_ENV - config.accumulate_metrics.append(test_env + '\t' + name + '\t' + way + '\t' + field + '\t' + str(val)) + test_env = config.test_env + config.accumulate_metrics.append('\t'.join([test_env, name, way, field, str(val)])) if val < lowerBound: print(field, 'value is too low:') diff --git a/testsuite/driver/testutil.py b/testsuite/driver/testutil.py index 59906a0..1fe1c20 100644 --- a/testsuite/driver/testutil.py +++ b/testsuite/driver/testutil.py @@ -54,8 +54,10 @@ def parse_git_notes(namespace): logFields = ['TEST_ENV','TEST','WAY','METRIC','VALUE'] log = subprocess.check_output(['git', 'notes', '--ref=' + namespace, 'show']).decode('utf-8') log = log.strip('\n').split('\n') - log = [entry.strip('\t').split('\t') for entry in log] - log = [dict(zip(logFields, row)) for row in log] + log = [line.strip('\t').split('\t') for line in log] + log = [dict(zip(logFields, field)) for field in log] + return log + # Add a print statement here if you want to see what's being loaded from git notes. # On Windows, os.symlink is not defined with Python 2.7, but is in Python 3 # when using msys2, as GHC does. Unfortunately, only Administrative users have From git at git.haskell.org Thu Aug 10 08:44:27 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 10 Aug 2017 08:44:27 +0000 (UTC) Subject: [commit: ghc] wip/perf-testsuite: This should actually split things out this time (f81cb82) Message-ID: <20170810084427.3F35B3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/perf-testsuite Link : http://ghc.haskell.org/trac/ghc/changeset/f81cb82587de14333b6196e7b46d8cad93afe4b9/ghc >--------------------------------------------------------------- commit f81cb82587de14333b6196e7b46d8cad93afe4b9 Author: Jared Weakly Date: Wed Jul 26 13:52:07 2017 -0700 This should actually split things out this time >--------------------------------------------------------------- f81cb82587de14333b6196e7b46d8cad93afe4b9 testsuite/driver/runtests.py | 10 ---------- 1 file changed, 10 deletions(-) diff --git a/testsuite/driver/runtests.py b/testsuite/driver/runtests.py index 6e4820f..62d6a8c 100644 --- a/testsuite/driver/runtests.py +++ b/testsuite/driver/runtests.py @@ -6,7 +6,6 @@ from __future__ import print_function -import argparse import signal import sys import os @@ -316,15 +315,6 @@ else: # v-- This is in a nonsensical area. It should be happening before all of the tests are even run. # parse_git_notes('perf') # Should it even be happening in the test-driver logic anymore? - # This here is loading up all of the git notes into memory. - # It's most likely in the wrong spot and I haven't fully fleshed out - # where exactly I'm putting this and how I'm refactoring the performance - # test running logic. - # Currently this is useful for debugging, at least. - if config.use_git_notes: - note = subprocess.check_output(["git","notes","--ref=perf","append","-m", "\n".join(config.accumulate_metrics)]) - parse_git_notes('perf') # Should this be hardcoded? Most likely not... - if config.summary_file: with open(config.summary_file, 'w') as file: summary(t, file) From git at git.haskell.org Thu Aug 10 08:44:29 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 10 Aug 2017 08:44:29 +0000 (UTC) Subject: [commit: ghc] wip/perf-testsuite: Added initial metric comparison tooling (fb98a4f) Message-ID: <20170810084429.F179F3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/perf-testsuite Link : http://ghc.haskell.org/trac/ghc/changeset/fb98a4f24d183990665f3f9b5f0101cb2638618b/ghc >--------------------------------------------------------------- commit fb98a4f24d183990665f3f9b5f0101cb2638618b Author: Jared Weakly Date: Thu Jul 20 17:30:21 2017 -0700 Added initial metric comparison tooling >--------------------------------------------------------------- fb98a4f24d183990665f3f9b5f0101cb2638618b testsuite/driver/runtests.py | 9 +++------ 1 file changed, 3 insertions(+), 6 deletions(-) diff --git a/testsuite/driver/runtests.py b/testsuite/driver/runtests.py index 0f977b5..7dea1c7 100644 --- a/testsuite/driver/runtests.py +++ b/testsuite/driver/runtests.py @@ -310,14 +310,11 @@ else: summary(t, sys.stdout, config.no_print_summary) - # This here is loading up all of the git notes into memory. - # It's most likely in the wrong spot and I haven't fully fleshed out - # where exactly I'm putting this and how I'm refactoring the performance - # test running logic. - # Currently this is useful for debugging, at least. + # Write our accumulated metrics into the git notes for this commit. if config.use_git_notes: note = subprocess.check_output(["git","notes","--ref=perf","append","-m", "\n".join(config.accumulate_metrics)]) - parse_git_notes('perf') # Should this be hardcoded? Most likely not... + # v-- This is in a nonsensical area. It should be happening before all of the tests are even run. + # parse_git_notes('perf') # Should it even be happening in the test-driver logic anymore? # Write our accumulated metrics into the git notes for this commit. if config.use_git_notes: From git at git.haskell.org Thu Aug 10 08:44:32 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 10 Aug 2017 08:44:32 +0000 (UTC) Subject: [commit: ghc] wip/perf-testsuite: Basic metrics collection and command line options working (6da06d6) Message-ID: <20170810084432.B71F53A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/perf-testsuite Link : http://ghc.haskell.org/trac/ghc/changeset/6da06d67e6ccb5d6c115ab6db72eaa634838a6e2/ghc >--------------------------------------------------------------- commit 6da06d67e6ccb5d6c115ab6db72eaa634838a6e2 Author: Jared Weakly Date: Thu Jul 6 17:16:49 2017 -0700 Basic metrics collection and command line options working >--------------------------------------------------------------- 6da06d67e6ccb5d6c115ab6db72eaa634838a6e2 libraries/array | 2 +- libraries/hoopl | 1 + testsuite/driver/testglobals.py | 11 ++++++++++- testsuite/driver/testlib.py | 6 ++++++ testsuite/driver/testutil.py | 4 ++++ testsuite/mk/test.mk | 12 ++++++++++++ 6 files changed, 34 insertions(+), 2 deletions(-) diff --git a/libraries/array b/libraries/array index 9a23fea..f7b69e9 160000 --- a/libraries/array +++ b/libraries/array @@ -1 +1 @@ -Subproject commit 9a23feac0b78e713c0f7877066fa24dbc2217c20 +Subproject commit f7b69e9cb914cb69bbede5264729523fb8669db1 diff --git a/libraries/hoopl b/libraries/hoopl new file mode 160000 index 0000000..ac24864 --- /dev/null +++ b/libraries/hoopl @@ -0,0 +1 @@ +Subproject commit ac24864c2db7951a6f34674e2b11b69d37ef84ff diff --git a/testsuite/driver/testglobals.py b/testsuite/driver/testglobals.py index 5e7142d..5ed54bd 100644 --- a/testsuite/driver/testglobals.py +++ b/testsuite/driver/testglobals.py @@ -117,6 +117,16 @@ class TestConfig: # Should we skip performance tests self.skip_perf_tests = False + # Only do performance tests + self.only_perf_tests = False + + # Should we dump statistics to git notes? + self.use_git_notes = False + # To accumulate the metrics for the git notes + self.accumulate_metrics = [] + # Has the user defined a custom test environment? Local is default. + self.TEST_ENV = 'local' + global config config = TestConfig() @@ -284,4 +294,3 @@ default_testopts = TestOptions() # (bug, directory, name) of tests marked broken global brokens brokens = [] - diff --git a/testsuite/driver/testlib.py b/testsuite/driver/testlib.py index 15c773e..0da86f2 100644 --- a/testsuite/driver/testlib.py +++ b/testsuite/driver/testlib.py @@ -1085,6 +1085,7 @@ def stats( name, way, stats_file ): # Check -t stats info def checkStats(name, way, stats_file, range_fields): + full_name = name + '(' + way + ')' result = passed() @@ -1108,6 +1109,11 @@ def checkStats(name, way, stats_file, range_fields): deviation = round(((float(val) * 100)/ expected) - 100, 1) + # Add val into the git note if option is set. + if config.use_git_notes: + test_env = config.TEST_ENV + config.accumulate_metrics.append(test_env + '\t' + name + '\t' + way + '\t' + field + '\t' + str(val)) + if val < lowerBound: print(field, 'value is too low:') print('(If this is because you have improved GHC, please') diff --git a/testsuite/driver/testutil.py b/testsuite/driver/testutil.py index dcba177..c6297ff 100644 --- a/testsuite/driver/testutil.py +++ b/testsuite/driver/testutil.py @@ -47,6 +47,10 @@ def lndir(srcdir, dstdir): os.mkdir(dst) lndir(src, dst) +# def git_append(note): +# def print_metrics(): +# print(config.accumulate_metrics) + # On Windows, os.symlink is not defined with Python 2.7, but is in Python 3 # when using msys2, as GHC does. Unfortunately, only Administrative users have # the privileges necessary to create symbolic links by default. Consequently we diff --git a/testsuite/mk/test.mk b/testsuite/mk/test.mk index a21c4bb..273b37b 100644 --- a/testsuite/mk/test.mk +++ b/testsuite/mk/test.mk @@ -195,6 +195,18 @@ ifeq "$(SKIP_PERF_TESTS)" "YES" RUNTEST_OPTS += --skip-perf-tests endif +ifeq "$(ONLY_PERF_TESTS)" "YES" +RUNTEST_OPTS += --only-perf-tests +endif + +ifeq "$(USE_GIT_NOTES)" "YES" +RUNTEST_OPTS += --use-git-notes +endif + +ifneq "$(TEST_ENV)" "" +RUNTEST_OPTS += --TEST_ENV="$(TEST_ENV)" +endif + ifeq "$(CLEANUP)" "0" RUNTEST_OPTS += -e config.cleanup=False else ifeq "$(CLEANUP)" "NO" From git at git.haskell.org Thu Aug 10 08:44:36 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 10 Aug 2017 08:44:36 +0000 (UTC) Subject: [commit: ghc] wip/perf-testsuite: Changed perf_notes quite a bit. Should be much closer to actually usable now (776deec) Message-ID: <20170810084436.2A4343A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/perf-testsuite Link : http://ghc.haskell.org/trac/ghc/changeset/776deec24636ae414cba6507497100629f9f25eb/ghc >--------------------------------------------------------------- commit 776deec24636ae414cba6507497100629f9f25eb Author: Jared Weakly Date: Sat Jul 22 20:18:22 2017 -0700 Changed perf_notes quite a bit. Should be much closer to actually usable now >--------------------------------------------------------------- 776deec24636ae414cba6507497100629f9f25eb testsuite/driver/perf_notes.py | 84 +++++++++++++++++++++++++++++++++++++++--- testsuite/driver/runtests.py | 3 ++ testsuite/driver/test_val | 76 ++++++++++++++++++++++++++++++++++++++ 3 files changed, 158 insertions(+), 5 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 776deec24636ae414cba6507497100629f9f25eb From git at git.haskell.org Thu Aug 10 08:44:38 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 10 Aug 2017 08:44:38 +0000 (UTC) Subject: [commit: ghc] wip/perf-testsuite: Small changes to address Ben's comments (7953e3c) Message-ID: <20170810084438.DFBEB3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/perf-testsuite Link : http://ghc.haskell.org/trac/ghc/changeset/7953e3c2f9f31b8491396642c4e124b3683f93c7/ghc >--------------------------------------------------------------- commit 7953e3c2f9f31b8491396642c4e124b3683f93c7 Author: Jared Weakly Date: Tue Jul 18 17:35:34 2017 -0700 Small changes to address Ben's comments Signed-off-by: Jared Weakly >--------------------------------------------------------------- 7953e3c2f9f31b8491396642c4e124b3683f93c7 testsuite/driver/runtests.py | 5 +++++ testsuite/driver/testlib.py | 1 - 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/testsuite/driver/runtests.py b/testsuite/driver/runtests.py index 21405bf..0f977b5 100644 --- a/testsuite/driver/runtests.py +++ b/testsuite/driver/runtests.py @@ -310,6 +310,11 @@ else: summary(t, sys.stdout, config.no_print_summary) + # This here is loading up all of the git notes into memory. + # It's most likely in the wrong spot and I haven't fully fleshed out + # where exactly I'm putting this and how I'm refactoring the performance + # test running logic. + # Currently this is useful for debugging, at least. if config.use_git_notes: note = subprocess.check_output(["git","notes","--ref=perf","append","-m", "\n".join(config.accumulate_metrics)]) parse_git_notes('perf') # Should this be hardcoded? Most likely not... diff --git a/testsuite/driver/testlib.py b/testsuite/driver/testlib.py index a24ee6c..8fc3ed7 100644 --- a/testsuite/driver/testlib.py +++ b/testsuite/driver/testlib.py @@ -1086,7 +1086,6 @@ def stats( name, way, stats_file ): # Check -t stats info def checkStats(name, way, stats_file, range_fields): - full_name = name + '(' + way + ')' result = passed() From git at git.haskell.org Thu Aug 10 08:44:41 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 10 Aug 2017 08:44:41 +0000 (UTC) Subject: [commit: ghc] wip/perf-testsuite: Can now load up git note data into python (1444349) Message-ID: <20170810084441.A1CB03A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/perf-testsuite Link : http://ghc.haskell.org/trac/ghc/changeset/14443499167a71108431ca2d014f53b785acb435/ghc >--------------------------------------------------------------- commit 14443499167a71108431ca2d014f53b785acb435 Author: Jared Weakly Date: Tue Jul 18 12:17:57 2017 -0700 Can now load up git note data into python >--------------------------------------------------------------- 14443499167a71108431ca2d014f53b785acb435 testsuite/driver/runtests.py | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/testsuite/driver/runtests.py b/testsuite/driver/runtests.py index d11ad80..21405bf 100644 --- a/testsuite/driver/runtests.py +++ b/testsuite/driver/runtests.py @@ -309,8 +309,10 @@ else: sys.stdout.flush() summary(t, sys.stdout, config.no_print_summary) - print("Only perf tests: " + str(config.only_perf_tests) + "\n") - print("Skip perf tests: " + str(config.skip_perf_tests) + "\n") + + if config.use_git_notes: + note = subprocess.check_output(["git","notes","--ref=perf","append","-m", "\n".join(config.accumulate_metrics)]) + parse_git_notes('perf') # Should this be hardcoded? Most likely not... # Write our accumulated metrics into the git notes for this commit. if config.use_git_notes: From git at git.haskell.org Thu Aug 10 08:44:44 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 10 Aug 2017 08:44:44 +0000 (UTC) Subject: [commit: ghc] wip/perf-testsuite: ONLY_PERF_TESTS=YES now fully implemented (5a9fd14) Message-ID: <20170810084444.6790C3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/perf-testsuite Link : http://ghc.haskell.org/trac/ghc/changeset/5a9fd14a605e530b74ff973060d53addb0eec44d/ghc >--------------------------------------------------------------- commit 5a9fd14a605e530b74ff973060d53addb0eec44d Author: Jared Weakly Date: Wed Jul 12 17:30:31 2017 -0700 ONLY_PERF_TESTS=YES now fully implemented >--------------------------------------------------------------- 5a9fd14a605e530b74ff973060d53addb0eec44d testsuite/driver/runtests.py | 2 ++ 1 file changed, 2 insertions(+) diff --git a/testsuite/driver/runtests.py b/testsuite/driver/runtests.py index 62d6a8c..70e2069 100644 --- a/testsuite/driver/runtests.py +++ b/testsuite/driver/runtests.py @@ -308,6 +308,8 @@ else: sys.stdout.flush() summary(t, sys.stdout, config.no_print_summary) + print("Only perf tests: " + str(config.only_perf_tests) + "\n") + print("Skip perf tests: " + str(config.skip_perf_tests) + "\n") # Write our accumulated metrics into the git notes for this commit. if config.use_git_notes: From git at git.haskell.org Thu Aug 10 08:44:47 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 10 Aug 2017 08:44:47 +0000 (UTC) Subject: [commit: ghc] wip/perf-testsuite: Greatly improved printing. Fixed the delta function. Made things simpler (70a05c5) Message-ID: <20170810084447.289073A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/perf-testsuite Link : http://ghc.haskell.org/trac/ghc/changeset/70a05c51226843c2a73bd57ab477f78474a891dd/ghc >--------------------------------------------------------------- commit 70a05c51226843c2a73bd57ab477f78474a891dd Author: Jared Weakly Date: Wed Jul 26 18:30:37 2017 -0700 Greatly improved printing. Fixed the delta function. Made things simpler Signed-off-by: Jared Weakly >--------------------------------------------------------------- 70a05c51226843c2a73bd57ab477f78474a891dd testsuite/driver/perf_notes.py | 5 ----- 1 file changed, 5 deletions(-) diff --git a/testsuite/driver/perf_notes.py b/testsuite/driver/perf_notes.py index a3d856f..ffa7656 100644 --- a/testsuite/driver/perf_notes.py +++ b/testsuite/driver/perf_notes.py @@ -7,11 +7,6 @@ # metrics across arbitrary commits. The file will produce a table comparing # metrics between measurements taken for given commits in the environment given # by --test-env. -<<<<<<< HEAD -======= - -from __future__ import print_function ->>>>>>> Cleaning up my trash code for the perf_notes comparison tool # TODO: Actually figure out what imports I need. import argparse From git at git.haskell.org Thu Aug 10 08:44:49 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 10 Aug 2017 08:44:49 +0000 (UTC) Subject: [commit: ghc] wip/perf-testsuite: ONLY_PERF_TESTS=YES now fully implemented (d86dead) Message-ID: <20170810084449.DFBF23A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/perf-testsuite Link : http://ghc.haskell.org/trac/ghc/changeset/d86dead6a8d815df038f491574cec6887e6cc58f/ghc >--------------------------------------------------------------- commit d86dead6a8d815df038f491574cec6887e6cc58f Author: Jared Weakly Date: Wed Jul 12 17:30:31 2017 -0700 ONLY_PERF_TESTS=YES now fully implemented >--------------------------------------------------------------- d86dead6a8d815df038f491574cec6887e6cc58f testsuite/driver/runtests.py | 2 ++ 1 file changed, 2 insertions(+) diff --git a/testsuite/driver/runtests.py b/testsuite/driver/runtests.py index 9d8d1c5..d11ad80 100644 --- a/testsuite/driver/runtests.py +++ b/testsuite/driver/runtests.py @@ -309,6 +309,8 @@ else: sys.stdout.flush() summary(t, sys.stdout, config.no_print_summary) + print("Only perf tests: " + str(config.only_perf_tests) + "\n") + print("Skip perf tests: " + str(config.skip_perf_tests) + "\n") # Write our accumulated metrics into the git notes for this commit. if config.use_git_notes: From git at git.haskell.org Thu Aug 10 08:44:52 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 10 Aug 2017 08:44:52 +0000 (UTC) Subject: [commit: ghc] wip/perf-testsuite: Can now load up git note data into python (737325c) Message-ID: <20170810084452.A44093A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/perf-testsuite Link : http://ghc.haskell.org/trac/ghc/changeset/737325cb0b62bdd3d4bdedee854b8a03c66389e4/ghc >--------------------------------------------------------------- commit 737325cb0b62bdd3d4bdedee854b8a03c66389e4 Author: Jared Weakly Date: Tue Jul 18 12:17:57 2017 -0700 Can now load up git note data into python >--------------------------------------------------------------- 737325cb0b62bdd3d4bdedee854b8a03c66389e4 testsuite/driver/runtests.py | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/testsuite/driver/runtests.py b/testsuite/driver/runtests.py index 70e2069..9d8d1c5 100644 --- a/testsuite/driver/runtests.py +++ b/testsuite/driver/runtests.py @@ -6,6 +6,7 @@ from __future__ import print_function +import argparse import signal import sys import os @@ -308,8 +309,6 @@ else: sys.stdout.flush() summary(t, sys.stdout, config.no_print_summary) - print("Only perf tests: " + str(config.only_perf_tests) + "\n") - print("Skip perf tests: " + str(config.skip_perf_tests) + "\n") # Write our accumulated metrics into the git notes for this commit. if config.use_git_notes: From git at git.haskell.org Thu Aug 10 08:44:55 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 10 Aug 2017 08:44:55 +0000 (UTC) Subject: [commit: ghc] wip/perf-testsuite: ONLY_PERF_TESTS=YES now fully implemented (3633ff1) Message-ID: <20170810084455.64AC33A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/perf-testsuite Link : http://ghc.haskell.org/trac/ghc/changeset/3633ff1ab09208a6d9e69e2cfc9e4ef832092598/ghc >--------------------------------------------------------------- commit 3633ff1ab09208a6d9e69e2cfc9e4ef832092598 Author: Jared Weakly Date: Wed Jul 12 17:30:31 2017 -0700 ONLY_PERF_TESTS=YES now fully implemented >--------------------------------------------------------------- 3633ff1ab09208a6d9e69e2cfc9e4ef832092598 testsuite/driver/runtests.py | 2 ++ 1 file changed, 2 insertions(+) diff --git a/testsuite/driver/runtests.py b/testsuite/driver/runtests.py index 8d0b337..8d158f8 100644 --- a/testsuite/driver/runtests.py +++ b/testsuite/driver/runtests.py @@ -306,6 +306,8 @@ else: sys.stdout.flush() summary(t, sys.stdout, config.no_print_summary) + print("Only perf tests: " + str(config.only_perf_tests) + "\n") + print("Skip perf tests: " + str(config.skip_perf_tests) + "\n") # This here is loading up all of the git notes into memory. # It's most likely in the wrong spot and I haven't fully fleshed out From git at git.haskell.org Thu Aug 10 08:44:58 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 10 Aug 2017 08:44:58 +0000 (UTC) Subject: [commit: ghc] wip/perf-testsuite: This should actually split things out this time (1aade90) Message-ID: <20170810084458.2219D3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/perf-testsuite Link : http://ghc.haskell.org/trac/ghc/changeset/1aade9012d86941d4df107f7f54ab2d5d0bd1b81/ghc >--------------------------------------------------------------- commit 1aade9012d86941d4df107f7f54ab2d5d0bd1b81 Author: Jared Weakly Date: Wed Jul 26 13:52:07 2017 -0700 This should actually split things out this time >--------------------------------------------------------------- 1aade9012d86941d4df107f7f54ab2d5d0bd1b81 testsuite/driver/runtests.py | 1 - 1 file changed, 1 deletion(-) diff --git a/testsuite/driver/runtests.py b/testsuite/driver/runtests.py index 9d8d1c5..62d6a8c 100644 --- a/testsuite/driver/runtests.py +++ b/testsuite/driver/runtests.py @@ -6,7 +6,6 @@ from __future__ import print_function -import argparse import signal import sys import os From git at git.haskell.org Thu Aug 10 08:45:00 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 10 Aug 2017 08:45:00 +0000 (UTC) Subject: [commit: ghc] wip/perf-testsuite: Basic metrics collection and command line options working (8a37b42) Message-ID: <20170810084500.D47033A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/perf-testsuite Link : http://ghc.haskell.org/trac/ghc/changeset/8a37b4265b029d06c6df144ddb53e07a4194b655/ghc >--------------------------------------------------------------- commit 8a37b4265b029d06c6df144ddb53e07a4194b655 Author: Jared Weakly Date: Thu Jul 6 17:16:49 2017 -0700 Basic metrics collection and command line options working >--------------------------------------------------------------- 8a37b4265b029d06c6df144ddb53e07a4194b655 testsuite/driver/testlib.py | 1 + 1 file changed, 1 insertion(+) diff --git a/testsuite/driver/testlib.py b/testsuite/driver/testlib.py index 8fc3ed7..a24ee6c 100644 --- a/testsuite/driver/testlib.py +++ b/testsuite/driver/testlib.py @@ -1086,6 +1086,7 @@ def stats( name, way, stats_file ): # Check -t stats info def checkStats(name, way, stats_file, range_fields): + full_name = name + '(' + way + ')' result = passed() From git at git.haskell.org Thu Aug 10 08:45:03 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 10 Aug 2017 08:45:03 +0000 (UTC) Subject: [commit: ghc] wip/perf-testsuite: Basic metrics collection and command line options working (0ec2ede) Message-ID: <20170810084503.993F13A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/perf-testsuite Link : http://ghc.haskell.org/trac/ghc/changeset/0ec2edeeb73af46384a383fad9590e1baf3b257d/ghc >--------------------------------------------------------------- commit 0ec2edeeb73af46384a383fad9590e1baf3b257d Author: Jared Weakly Date: Thu Jul 6 17:16:49 2017 -0700 Basic metrics collection and command line options working >--------------------------------------------------------------- 0ec2edeeb73af46384a383fad9590e1baf3b257d testsuite/driver/testlib.py | 1 + 1 file changed, 1 insertion(+) diff --git a/testsuite/driver/testlib.py b/testsuite/driver/testlib.py index 8fc3ed7..a24ee6c 100644 --- a/testsuite/driver/testlib.py +++ b/testsuite/driver/testlib.py @@ -1086,6 +1086,7 @@ def stats( name, way, stats_file ): # Check -t stats info def checkStats(name, way, stats_file, range_fields): + full_name = name + '(' + way + ')' result = passed() From git at git.haskell.org Thu Aug 10 08:45:06 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 10 Aug 2017 08:45:06 +0000 (UTC) Subject: [commit: ghc] wip/perf-testsuite: Can now load up git note data into python (b792c54) Message-ID: <20170810084506.5B92C3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/perf-testsuite Link : http://ghc.haskell.org/trac/ghc/changeset/b792c540fc8bf28a7ef3d0e1898b2cd946a531f1/ghc >--------------------------------------------------------------- commit b792c540fc8bf28a7ef3d0e1898b2cd946a531f1 Author: Jared Weakly Date: Tue Jul 18 12:17:57 2017 -0700 Can now load up git note data into python >--------------------------------------------------------------- b792c540fc8bf28a7ef3d0e1898b2cd946a531f1 testsuite/driver/runtests.py | 6 ++++-- testsuite/driver/testutil.py | 12 +++++++++--- 2 files changed, 13 insertions(+), 5 deletions(-) diff --git a/testsuite/driver/runtests.py b/testsuite/driver/runtests.py index 30f320a..e102a94 100644 --- a/testsuite/driver/runtests.py +++ b/testsuite/driver/runtests.py @@ -306,8 +306,10 @@ else: sys.stdout.flush() summary(t, sys.stdout, config.no_print_summary) - print("Only perf tests: " + str(config.only_perf_tests) + "\n") - print("Skip perf tests: " + str(config.skip_perf_tests) + "\n") + + if config.use_git_notes: + note = subprocess.check_output(["git","notes","--ref=perf","append","-m", "\n".join(config.accumulate_metrics)]) + parse_git_notes('perf') # Should this be hardcoded? Most likely not... if config.summary_file: with open(config.summary_file, 'w') as file: diff --git a/testsuite/driver/testutil.py b/testsuite/driver/testutil.py index c6297ff..59906a0 100644 --- a/testsuite/driver/testutil.py +++ b/testsuite/driver/testutil.py @@ -47,9 +47,15 @@ def lndir(srcdir, dstdir): os.mkdir(dst) lndir(src, dst) -# def git_append(note): -# def print_metrics(): -# print(config.accumulate_metrics) +# This function allows one to read in git notes from the commandline +# and then breaks it into a list of dictionaries that can be parsed +# later on in the testing functions. +def parse_git_notes(namespace): + logFields = ['TEST_ENV','TEST','WAY','METRIC','VALUE'] + log = subprocess.check_output(['git', 'notes', '--ref=' + namespace, 'show']).decode('utf-8') + log = log.strip('\n').split('\n') + log = [entry.strip('\t').split('\t') for entry in log] + log = [dict(zip(logFields, row)) for row in log] # On Windows, os.symlink is not defined with Python 2.7, but is in Python 3 # when using msys2, as GHC does. Unfortunately, only Administrative users have From git at git.haskell.org Thu Aug 10 08:45:09 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 10 Aug 2017 08:45:09 +0000 (UTC) Subject: [commit: ghc] wip/perf-testsuite: Change output of comparison tool to resemble nofib (4e6f338) Message-ID: <20170810084509.289603A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/perf-testsuite Link : http://ghc.haskell.org/trac/ghc/changeset/4e6f33852e7f20829d786f3e00002521abee3672/ghc >--------------------------------------------------------------- commit 4e6f33852e7f20829d786f3e00002521abee3672 Author: Jared Weakly Date: Thu Aug 10 01:02:21 2017 -0700 Change output of comparison tool to resemble nofib >--------------------------------------------------------------- 4e6f33852e7f20829d786f3e00002521abee3672 testsuite/driver/perf_notes.py | 94 +++++++++++++++++++++++++++++------------- testsuite/driver/runtests.py | 45 ++++++++++++-------- testsuite/mk/test.mk | 2 +- 3 files changed, 94 insertions(+), 47 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 4e6f33852e7f20829d786f3e00002521abee3672 From git at git.haskell.org Thu Aug 10 08:45:12 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 10 Aug 2017 08:45:12 +0000 (UTC) Subject: [commit: ghc] wip/perf-testsuite: Fix errors and difficulties related to pulling (9f3f184) Message-ID: <20170810084512.213643A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/perf-testsuite Link : http://ghc.haskell.org/trac/ghc/changeset/9f3f184a398978cef8f55433238b0a45fbfb366c/ghc >--------------------------------------------------------------- commit 9f3f184a398978cef8f55433238b0a45fbfb366c Merge: 4e6f338 7d0754a Author: Jared Weakly Date: Thu Aug 10 01:45:47 2017 -0700 Fix errors and difficulties related to pulling >--------------------------------------------------------------- 9f3f184a398978cef8f55433238b0a45fbfb366c libraries/Cabal | 2 +- libraries/Win32 | 2 +- libraries/binary | 2 +- libraries/deepseq | 2 +- libraries/parallel | 2 +- libraries/process | 2 +- libraries/time | 2 +- libraries/unix | 2 +- libraries/xhtml | 2 +- testsuite/driver/runtests.py | 15 +++++++-------- utils/haddock | 2 +- 11 files changed, 17 insertions(+), 18 deletions(-) diff --cc testsuite/driver/runtests.py index ce6f28e,0b119aa..2c724aa --- a/testsuite/driver/runtests.py +++ b/testsuite/driver/runtests.py @@@ -57,35 -58,26 +58,36 @@@ parser.add_argument("--skipway", action parser.add_argument("--threads", type=int, help="threads to run simultaneously") parser.add_argument("--check-files-written", help="check files aren't written by multiple tests") # NOTE: This doesn't seem to exist? parser.add_argument("--verbose", type=int, choices=[0,1,2,3,4,5], help="verbose (Values 0 through 5 accepted)") - perf_group.add_argument("--skip-perf-tests", action="store_true", help="skip performance tests") - perf_group.add_argument("--only-perf-tests", action="store_true", help="Only do performance tests") + group.add_argument("--skip-perf-tests", action="store_true", help="skip performance tests") + group.add_argument("--only-perf-tests", action="store_true", help="Only do performance tests") -parser.add_argument("--use-git-notes", action="store_true", help="use git notes to store metrics. NOTE: This is expected to become the default and will eventually be taken out.") -parser.add_argument("--test-env=", help="Override default chosen test-env.") parser.add_argument("--junit", type=argparse.FileType('wb'), help="output testsuite summary in JUnit format") +parser.add_argument("--use-git-notes", action="store_true", help="use git notes to store metrics. NOTE: This is expected to become the default and will eventually be taken out.") +parser.add_argument("--test-env", default='local', help="Override default chosen test-env.") + args = parser.parse_args() -for e in args.e: - exec(e) +if args.e: + for e in args.e: + exec(e) + +if args.configfile: + for arg in args.configfile: + exec(open(arg).read()) -for arg in args.config_file: - exec(open(arg).read()) +if args.config_file: + for arg in args.config_file: + exec(open(arg).read()) + +if args.config: + for arg in args.config: + field, value = arg.split('=', 1) + setattr(config, field, value) + +if args.rootdir: + config.rootdirs = args.rootdir -for arg in args.config: - field, value = arg.split('=', 1) - setattr(config, field, value) -config.rootdirs = args.rootdir config.summary_file = args.summary_file config.no_print_summary = args.no_print_summary @@@ -114,11 -106,9 +116,8 @@@ if args.verbose config.skip_perf_tests = args.skip_perf_tests config.only_perf_tests = args.only_perf_tests config.use_git_notes = args.use_git_notes - - if args.test_env: - config.test_env = args.test_env + config.test_env = args.test_env - config.cygwin = False config.msys = False From git at git.haskell.org Thu Aug 10 08:45:14 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 10 Aug 2017 08:45:14 +0000 (UTC) Subject: [commit: ghc] wip/perf-testsuite's head updated: Fix errors and difficulties related to pulling (9f3f184) Message-ID: <20170810084514.BC77D3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/perf-testsuite' now includes: 0e3c101 Ensure that we always link against libm 0e3eacc testsuite: Don't pass allow_abbrev 121fee9 Remove unnecessary GHC option from SrcLoc 9e9fb57 Fix hs-boot knot-tying with record wild cards. d75bba8 Add rtsopts ignore and ignoreAll. 84f8e86 Ensure that GHC.Stack.callStack doesn't fail 9cfabbb Add '<&>' operator to Data.Functor. '<&>' calls '<$>' with flipped arguments. d1ef223 Fix #14045 by omitting an unnecessary check f839b9d Add regression test for #14055 7089dc2 Follow-up to #13887, for promoted infix constructors 9699286 Typofixes [ci skip] f2c12c3 Add haddock markup 49e334c Allow Windows to set blank environment variables c6d4219 Clarify comment about data family arities 2535a67 Refactoring around FunRhs 4636886 Improve the desugaring of -XStrict 3ab342e Do a bit more CSE af89d68 Reject top-level banged bindings 7f2dee8 Remove redundant goop 4fdc523 Use field names for all uses of datacon Match 2ef973e A bunch of typofixes 7a74f50 Typofixes [ci skip] 5a7af95 KnownUniques: Handle DataCon wrapper names 29f07b1 Allow bundling pattern synonyms with exported data families 74c7016 rts: Fix "variable set but not used" warning b311096 Simplify OccurAnal.tagRecBinders c13720c Drop GHC 7.10 compatibility 36fe21a Enable building Cabal with parsec 9df71bf Bump unix submodule 8ef8520 Add .gitmodules entries for text, parsec, mtl submodules d74983e Get the roles right for newtype instances f68a00c Remove unneeded uses of ImplicitParams 884bd21 Add the bootstrapping/ dir to .gitignore 394c391 Add MonadIO Q - by requiring MonadIO => Quasi a81b5b0 Remove the deprecated Typeable{1..7} type synonyms a267580 Don't warn when empty casing on Type 6ea13e9 Add forgotten > in Control.Applicative e8fe12f Fix string escaping in JSON 2f29f19 Convert examples to doctests, and add a handful of new ones 14457cf Fix EmptyCase documentation 6da06d6 Basic metrics collection and command line options working 42b7e42 ONLY_PERF_TESTS=YES now fully implemented b792c54 Can now load up git note data into python 2982cf8 Small changes to address Ben's comments 0ec2ede Basic metrics collection and command line options working 3633ff1 ONLY_PERF_TESTS=YES now fully implemented 1f7584c Can now load up git note data into python 1ee0a7f Small changes to address Ben's comments 864ed76 Added initial metric comparison tooling 56b3a87 Initial tooling to compare across commits (but for actual this time) 776deec Changed perf_notes quite a bit. Should be much closer to actually usable now fa1ac5d Cleaning up my trash code for the perf_notes comparison tool f81cb82 This should actually split things out this time fa4fb52 Greatly improved printing. Fixed the delta function. Made things simpler e8a6405 Basic metrics collection and command line options working 5a9fd14 ONLY_PERF_TESTS=YES now fully implemented 737325c Can now load up git note data into python 4961e16 Small changes to address Ben's comments 8a37b42 Basic metrics collection and command line options working d86dead ONLY_PERF_TESTS=YES now fully implemented 1444349 Can now load up git note data into python 7953e3c Small changes to address Ben's comments fb98a4f Added initial metric comparison tooling 434366f Changed perf_notes quite a bit. Should be much closer to actually usable now 2fe312a Cleaning up my trash code for the perf_notes comparison tool 1aade90 This should actually split things out this time 70a05c5 Greatly improved printing. Fixed the delta function. Made things simpler ed59533 Rebase the branch to linearize the history 4e6f338 Change output of comparison tool to resemble nofib 9f3f184 Fix errors and difficulties related to pulling From git at git.haskell.org Thu Aug 10 08:53:38 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 10 Aug 2017 08:53:38 +0000 (UTC) Subject: [commit: ghc] wip/perf-testsuite: Fix errors and difficulties related to pulling (312f4d8) Message-ID: <20170810085338.B6F503A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/perf-testsuite Link : http://ghc.haskell.org/trac/ghc/changeset/312f4d8dea3f0547b3dc625ae350e0f2f72aafb0/ghc >--------------------------------------------------------------- commit 312f4d8dea3f0547b3dc625ae350e0f2f72aafb0 Author: Jared Weakly Date: Thu Aug 10 01:55:39 2017 -0700 Fix errors and difficulties related to pulling >--------------------------------------------------------------- 312f4d8dea3f0547b3dc625ae350e0f2f72aafb0 testsuite/driver/runtests.py | 1 + 1 file changed, 1 insertion(+) diff --git a/testsuite/driver/runtests.py b/testsuite/driver/runtests.py index 2c724aa..82c2ecb 100644 --- a/testsuite/driver/runtests.py +++ b/testsuite/driver/runtests.py @@ -6,6 +6,7 @@ from __future__ import print_function +import argparse import signal import sys import os From git at git.haskell.org Sat Aug 12 18:14:12 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 12 Aug 2017 18:14:12 +0000 (UTC) Subject: [commit: packages/mtl] master: Fix GNUmakefile capitalization (fc9578a) Message-ID: <20170812181412.D725F3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/mtl On branch : master Link : http://git.haskell.org/packages/mtl.git/commitdiff/fc9578af042d226a8abaccb33b2bb99c63736134 >--------------------------------------------------------------- commit fc9578af042d226a8abaccb33b2bb99c63736134 Author: Ryan Scott Date: Tue Aug 8 11:32:44 2017 -0400 Fix GNUmakefile capitalization [ci skip] >--------------------------------------------------------------- fc9578af042d226a8abaccb33b2bb99c63736134 .gitignore | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.gitignore b/.gitignore index 6597493..2a93d1f 100644 --- a/.gitignore +++ b/.gitignore @@ -1,3 +1,3 @@ dist ghc.mk -GNUMakefile +GNUmakefile From git at git.haskell.org Sat Aug 12 20:18:23 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 12 Aug 2017 20:18:23 +0000 (UTC) Subject: [commit: ghc] master: Split out inferConstraintsDataConArgs from inferConstraints (a4f347c) Message-ID: <20170812201823.073E13A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a4f347c23ed926c24d178fec54c27d94f1fae0e4/ghc >--------------------------------------------------------------- commit a4f347c23ed926c24d178fec54c27d94f1fae0e4 Author: Ryan Scott Date: Sat Aug 12 15:46:22 2017 -0400 Split out inferConstraintsDataConArgs from inferConstraints Summary: Addresses point (1) of https://phabricator.haskell.org/D3337#107865. Before, `inferConstraints` awkwardly combined all of the logic needed to handle stock, newtype, and anyclass deriving. Really, though, the stock/newtype logic is quite different from the anyclass logic, so this splits off `inferConstraintsDataConArgs` (so named because it infers constraints by inspecting the types of the arguments to data constructors) from `inferConstraints` to handle the stock/newtype-specific bits. Aside from making the code somewhat clearer, this allows us to factor out superclass constraint inference, which is done regardless of deriving strategy. Test Plan: If it builds, ship it Reviewers: bgamari, austin Subscribers: rwbarton, thomie Differential Revision: https://phabricator.haskell.org/D3827 >--------------------------------------------------------------- a4f347c23ed926c24d178fec54c27d94f1fae0e4 compiler/typecheck/TcDerivInfer.hs | 62 +++++++++++++++++++++++++------------- 1 file changed, 41 insertions(+), 21 deletions(-) diff --git a/compiler/typecheck/TcDerivInfer.hs b/compiler/typecheck/TcDerivInfer.hs index 515ae52..7d39c31 100644 --- a/compiler/typecheck/TcDerivInfer.hs +++ b/compiler/typecheck/TcDerivInfer.hs @@ -67,10 +67,43 @@ inferConstraints :: [TyVar] -> Class -> [TcType] -> TcType inferConstraints tvs main_cls cls_tys inst_ty rep_tc rep_tc_args mechanism - | is_generic && not is_anyclass -- Generic constraints are easy + = do { (inferred_constraints, tvs', inst_tys') <- infer_constraints + ; traceTc "inferConstraints" $ vcat + [ ppr main_cls <+> ppr inst_tys' + , ppr inferred_constraints + ] + ; return ( sc_constraints ++ inferred_constraints + , tvs', inst_tys' ) } + where + is_anyclass = isDerivSpecAnyClass mechanism + infer_constraints + | is_anyclass = inferConstraintsDAC tvs main_cls inst_tys + | otherwise = inferConstraintsDataConArgs tvs main_cls cls_tys inst_ty + rep_tc rep_tc_args + + inst_tys = cls_tys ++ [inst_ty] + + -- Constraints arising from superclasses + -- See Note [Superclasses of derived instance] + cls_tvs = classTyVars main_cls + sc_constraints = ASSERT2( equalLength cls_tvs inst_tys + , ppr main_cls <+> ppr inst_tys ) + [ mkThetaOrigin DerivOrigin TypeLevel [] [] $ + substTheta cls_subst (classSCTheta main_cls) ] + cls_subst = ASSERT( equalLength cls_tvs inst_tys ) + zipTvSubst cls_tvs inst_tys + +-- | Like 'inferConstraints', but used only in the case of deriving strategies +-- where the constraints are inferred by inspecting the fields of each data +-- constructor (i.e., stock- and newtype-deriving). +inferConstraintsDataConArgs + :: [TyVar] -> Class -> [TcType] -> TcType -> TyCon -> [TcType] + -> TcM ([ThetaOrigin], [TyVar], [TcType]) +inferConstraintsDataConArgs tvs main_cls cls_tys inst_ty rep_tc rep_tc_args + | is_generic -- Generic constraints are easy = return ([], tvs, inst_tys) - | is_generic1 && not is_anyclass -- Generic1 needs Functor + | is_generic1 -- Generic1 needs Functor = ASSERT( rep_tc_tvs `lengthExceeds` 0 ) -- See Note [Getting base classes] ASSERT( cls_tys `lengthIs` 1 ) -- Generic1 has a single kind variable do { functorClass <- tcLookupClass functorClassName @@ -82,20 +115,15 @@ inferConstraints tvs main_cls cls_tys inst_ty ASSERT2( equalLength rep_tc_tvs all_rep_tc_args , ppr main_cls <+> ppr rep_tc $$ ppr rep_tc_tvs $$ ppr all_rep_tc_args ) - do { (arg_constraints, tvs', inst_tys') <- infer_constraints - ; traceTc "inferConstraints" $ vcat + do { (arg_constraints, tvs', inst_tys') + <- con_arg_constraints get_std_constrained_tys + ; traceTc "inferConstraintsDataConArgs" $ vcat [ ppr main_cls <+> ppr inst_tys' , ppr arg_constraints ] - ; return (stupid_constraints ++ extra_constraints - ++ sc_constraints ++ arg_constraints + ; return ( stupid_constraints ++ extra_constraints ++ arg_constraints , tvs', inst_tys') } where - is_anyclass = isDerivSpecAnyClass mechanism - infer_constraints - | is_anyclass = inferConstraintsDAC main_cls tvs inst_tys - | otherwise = con_arg_constraints get_std_constrained_tys - tc_binders = tyConBinders rep_tc choose_level bndr | isNamedTyConBinder bndr = KindLevel @@ -187,15 +215,7 @@ inferConstraints tvs main_cls cls_tys inst_ty all_rep_tc_args = rep_tc_args ++ map mkTyVarTy (drop (length rep_tc_args) rep_tc_tvs) - -- Constraints arising from superclasses - -- See Note [Superclasses of derived instance] - cls_tvs = classTyVars main_cls inst_tys = cls_tys ++ [inst_ty] - sc_constraints = ASSERT2( equalLength cls_tvs inst_tys, ppr main_cls <+> ppr rep_tc) - [ mkThetaOrigin DerivOrigin TypeLevel [] [] $ - substTheta cls_subst (classSCTheta main_cls) ] - cls_subst = ASSERT( equalLength cls_tvs inst_tys ) - zipTvSubst cls_tvs inst_tys -- Stupid constraints stupid_constraints = [ mkThetaOrigin DerivOrigin TypeLevel [] [] $ @@ -240,9 +260,9 @@ typeToTypeKind = liftedTypeKind `mkFunTy` liftedTypeKind -- See Note [Gathering and simplifying constraints for DeriveAnyClass] -- for an explanation of how these constraints are used to determine the -- derived instance context. -inferConstraintsDAC :: Class -> [TyVar] -> [TcType] +inferConstraintsDAC :: [TyVar] -> Class -> [TcType] -> TcM ([ThetaOrigin], [TyVar], [TcType]) -inferConstraintsDAC cls tvs inst_tys +inferConstraintsDAC tvs cls inst_tys = do { let gen_dms = [ (sel_id, dm_ty) | (sel_id, Just (_, GenericDM dm_ty)) <- classOpItems cls ] From git at git.haskell.org Sat Aug 12 20:18:26 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 12 Aug 2017 20:18:26 +0000 (UTC) Subject: [commit: ghc] master: Don't suppress unimplemented type family warnings with DeriveAnyClass (3f05e5f) Message-ID: <20170812201826.ECE213A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3f05e5f6becc2f7174898726b6f027105b12a780/ghc >--------------------------------------------------------------- commit 3f05e5f6becc2f7174898726b6f027105b12a780 Author: Ryan Scott Date: Sat Aug 12 15:46:44 2017 -0400 Don't suppress unimplemented type family warnings with DeriveAnyClass Summary: For some asinine reason, we were suppressing warnings when deriving associated type family instances with `DeriveAnyClass`. That seems like a bad idea. Let's not do that. Along the way, I noticed that the error contexts associated with these newly emitted warnings were less than ideal, so I did some minor refactoring to improve the story there. Fixes #14094 Test Plan: ./validate Reviewers: bgamari, austin Subscribers: rwbarton, thomie GHC Trac Issues: #14094 Differential Revision: https://phabricator.haskell.org/D3828 >--------------------------------------------------------------- 3f05e5f6becc2f7174898726b6f027105b12a780 compiler/typecheck/TcClassDcl.hs | 27 ++++++++++++++++++---- compiler/typecheck/TcDeriv.hs | 22 ++++++++++-------- compiler/typecheck/TcInstDcls.hs | 2 +- testsuite/tests/deriving/should_compile/T14094.hs | 13 +++++++++++ .../tests/deriving/should_compile/T14094.stderr | 26 +++++++++++++++++++++ testsuite/tests/deriving/should_compile/all.T | 1 + .../tests/deriving/should_fail/T10598_fail3.stderr | 7 +++--- .../tests/deriving/should_fail/T8165_fail2.stderr | 7 +++--- 8 files changed, 82 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 3f05e5f6becc2f7174898726b6f027105b12a780 From git at git.haskell.org Sat Aug 12 20:18:29 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 12 Aug 2017 20:18:29 +0000 (UTC) Subject: [commit: ghc] master: Use NonEmpty lists to represent lists of duplicate elements (7d69978) Message-ID: <20170812201829.C04C53A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7d699782bf6148c115a49b5f31ada9bd7c32a7d6/ghc >--------------------------------------------------------------- commit 7d699782bf6148c115a49b5f31ada9bd7c32a7d6 Author: Ryan Scott Date: Sat Aug 12 15:47:27 2017 -0400 Use NonEmpty lists to represent lists of duplicate elements Summary: Three functions in `ListSetOps` which compute duplicate elements represent lists of duplicates of `[a]`. This is a really bad way to go about things, because these lists are guaranteed to always have at least one element (the "representative" of the duplicates), and several places in the GHC API call `head` (a partial function) on these lists of duplicates to retrieve the representative. This changes the representation of duplicates to `NonEmpty` lists instead, which allow for many partial uses of `head` to be made total. Fixes #13823. Test Plan: ./validate Reviewers: bgamari, austin, goldfire Reviewed By: bgamari Subscribers: goldfire, rwbarton, thomie GHC Trac Issues: #13823 Differential Revision: https://phabricator.haskell.org/D3823 >--------------------------------------------------------------- 7d699782bf6148c115a49b5f31ada9bd7c32a7d6 compiler/coreSyn/CoreLint.hs | 10 ++++++---- compiler/rename/RnBinds.hs | 17 ++++++++++------- compiler/rename/RnExpr.hs | 3 ++- compiler/rename/RnPat.hs | 9 +++++---- compiler/rename/RnSource.hs | 21 +++++++++++---------- compiler/rename/RnTypes.hs | 7 ++++--- compiler/rename/RnUtils.hs | 7 ++++--- compiler/typecheck/TcBinds.hs | 3 ++- compiler/typecheck/TcErrors.hs | 3 ++- compiler/typecheck/TcSimplify.hs | 13 ++++++++----- compiler/typecheck/TcTyClsDecls.hs | 4 ++-- compiler/typecheck/TcValidity.hs | 5 +++-- compiler/utils/ListSetOps.hs | 26 ++++++++++++++------------ 13 files changed, 73 insertions(+), 55 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 7d699782bf6148c115a49b5f31ada9bd7c32a7d6 From git at git.haskell.org Sat Aug 12 20:18:32 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 12 Aug 2017 20:18:32 +0000 (UTC) Subject: [commit: ghc] master: Change isClosedAlgType to be TYPE-aware, and rename it to pmIsClosedType (4f1f986) Message-ID: <20170812201832.86DFD3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4f1f9868ae79b5730c6aa14b05394d3f1d10a857/ghc >--------------------------------------------------------------- commit 4f1f9868ae79b5730c6aa14b05394d3f1d10a857 Author: Ryan Scott Date: Sat Aug 12 15:51:37 2017 -0400 Change isClosedAlgType to be TYPE-aware, and rename it to pmIsClosedType Summary: In a267580e4ab37115dcc33f3b8a9af67b9364da12, I somewhat awkwardly inserted a special case for `TYPE` in the `EmptyCase` coverage checker. Instead of placing it there, @mpickering noted that `isClosedAlgType` would be a better fit for it. I do just that in this patch. I also renamed `isClosedAlgType` to `pmIsClosedType`, reflecting the fact that `TYPE` technically isn't an algebraic type (it's a primitive one), and that its behavior is pattern-match coverage checking-oriented. I also moved it to `Check`, which is a better home for this function than `Type`. Luckily, the only call sites for `isClosedAlgType` were in the pattern-match coverage checker anyways, so this change is simple enough. Test Plan: ./validate Reviewers: mpickering, austin, goldfire, bgamari Reviewed By: goldfire Subscribers: rwbarton, thomie, mpickering GHC Trac Issues: #14086 Differential Revision: https://phabricator.haskell.org/D3830 >--------------------------------------------------------------- 4f1f9868ae79b5730c6aa14b05394d3f1d10a857 compiler/deSugar/Check.hs | 161 +++++++++++++++++++++++++++++++++++++++---- compiler/types/FamInstEnv.hs | 114 +----------------------------- compiler/types/Type.hs | 13 +--- 3 files changed, 150 insertions(+), 138 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 4f1f9868ae79b5730c6aa14b05394d3f1d10a857 From git at git.haskell.org Sat Aug 12 20:18:35 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 12 Aug 2017 20:18:35 +0000 (UTC) Subject: [commit: ghc] master: Expand type synonyms during role inference (0bb1e84) Message-ID: <20170812201835.440B73A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/0bb1e84034a12d7f700b48fca6710c01bd08f397/ghc >--------------------------------------------------------------- commit 0bb1e84034a12d7f700b48fca6710c01bd08f397 Author: Ryan Scott Date: Sat Aug 12 15:52:08 2017 -0400 Expand type synonyms during role inference Summary: During role inference, we need to expand type synonyms, since oversaturated applications of type synonym tycons would otherwise have overly conservative roles inferred for its arguments. Fixes #14101. Test Plan: ./validate Reviewers: goldfire, austin, bgamari Reviewed By: goldfire Subscribers: rwbarton, thomie GHC Trac Issues: #14101 Differential Revision: https://phabricator.haskell.org/D3838 >--------------------------------------------------------------- 0bb1e84034a12d7f700b48fca6710c01bd08f397 compiler/typecheck/TcTyClsDecls.hs | 4 ++++ compiler/typecheck/TcTyDecls.hs | 2 ++ compiler/types/Coercion.hs | 2 ++ 3 files changed, 8 insertions(+) diff --git a/compiler/typecheck/TcTyClsDecls.hs b/compiler/typecheck/TcTyClsDecls.hs index 8915364..ba35db5 100644 --- a/compiler/typecheck/TcTyClsDecls.hs +++ b/compiler/typecheck/TcTyClsDecls.hs @@ -2994,6 +2994,10 @@ checkValidRoles tc ex_roles = mkVarEnv (map (, Nominal) ex_tvs) role_env = univ_roles `plusVarEnv` ex_roles + check_ty_roles env role ty + | Just ty' <- coreView ty -- #14101 + = check_ty_roles env role ty' + check_ty_roles env role (TyVarTy tv) = case lookupVarEnv env tv of Just role' -> unless (role' `ltRole` role || role' == role) $ diff --git a/compiler/typecheck/TcTyDecls.hs b/compiler/typecheck/TcTyDecls.hs index 41482cc..e55b8e8 100644 --- a/compiler/typecheck/TcTyDecls.hs +++ b/compiler/typecheck/TcTyDecls.hs @@ -580,6 +580,8 @@ irDataCon datacon irType :: VarSet -> Type -> RoleM () irType = go where + go lcls ty | Just ty' <- coreView ty -- #14101 + = go lcls ty' go lcls (TyVarTy tv) = unless (tv `elemVarSet` lcls) $ updateRole Representational tv go lcls (AppTy t1 t2) = go lcls t1 >> markNominal lcls t2 diff --git a/compiler/types/Coercion.hs b/compiler/types/Coercion.hs index b0b13b8..214fe2d 100644 --- a/compiler/types/Coercion.hs +++ b/compiler/types/Coercion.hs @@ -1513,6 +1513,8 @@ ty_co_subst lc role ty = go role ty where go :: Role -> Type -> Coercion + go r ty | Just ty' <- coreView ty + = go r ty' go Phantom ty = lift_phantom ty go r (TyVarTy tv) = expectJust "ty_co_subst bad roles" $ liftCoSubstTyVar lc r tv From git at git.haskell.org Sat Aug 12 20:25:49 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 12 Aug 2017 20:25:49 +0000 (UTC) Subject: [commit: ghc] master: Add test for #14101 (c6462ab) Message-ID: <20170812202549.4F9133A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c6462ab02882779d7e33f2cac00cd89a9ac192f1/ghc >--------------------------------------------------------------- commit c6462ab02882779d7e33f2cac00cd89a9ac192f1 Author: Ryan Scott Date: Sat Aug 12 16:24:19 2017 -0400 Add test for #14101 I forgot to do this in 0bb1e84034a12d7f700b48fca6710c01bd08f397. >--------------------------------------------------------------- c6462ab02882779d7e33f2cac00cd89a9ac192f1 testsuite/tests/roles/should_compile/T14101.hs | 10 ++++++++++ testsuite/tests/roles/should_compile/all.T | 1 + 2 files changed, 11 insertions(+) diff --git a/testsuite/tests/roles/should_compile/T14101.hs b/testsuite/tests/roles/should_compile/T14101.hs new file mode 100644 index 0000000..3a23b5a --- /dev/null +++ b/testsuite/tests/roles/should_compile/T14101.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE RoleAnnotations #-} +module T14101 where + +type role Array representational +data Array a + +type Arr = Array + +data Foo a = Foo (Arr a) +type role Foo representational diff --git a/testsuite/tests/roles/should_compile/all.T b/testsuite/tests/roles/should_compile/all.T index c0b0d82..8d7c31f 100644 --- a/testsuite/tests/roles/should_compile/all.T +++ b/testsuite/tests/roles/should_compile/all.T @@ -7,3 +7,4 @@ test('Roles14', only_ways('normal'), compile, ['-ddump-tc -dsuppress-uniques']) test('T8958', [normalise_fun(normalise_errmsg), only_ways('normal')], compile, ['-ddump-tc -dsuppress-uniques -fprint-typechecker-elaboration']) test('T10263', normal, compile, ['']) test('T9204b', [], multimod_compile, ['T9204b', '-v0']) +test('T14101', normal, compile, ['']) From git at git.haskell.org Tue Aug 15 01:35:10 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 15 Aug 2017 01:35:10 +0000 (UTC) Subject: [commit: nofib] master: gray: AMP compatibility (576aee6) Message-ID: <20170815013510.C41AE3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/nofib On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/576aee6c99f9d06a4faa44f4cef17b68672f07d0/nofib >--------------------------------------------------------------- commit 576aee6c99f9d06a4faa44f4cef17b68672f07d0 Author: Ben Gamari Date: Mon Aug 14 20:45:14 2017 -0400 gray: AMP compatibility Reviewers: O26 nofib, michalt Reviewed By: O26 nofib, michalt Subscribers: michalt Differential Revision: https://phabricator.haskell.org/D3730 >--------------------------------------------------------------- 576aee6c99f9d06a4faa44f4cef17b68672f07d0 parallel/gray/Eval.hs | 17 ++++++++++++++++- 1 file changed, 16 insertions(+), 1 deletion(-) diff --git a/parallel/gray/Eval.hs b/parallel/gray/Eval.hs index 367942b..29c2bac 100644 --- a/parallel/gray/Eval.hs +++ b/parallel/gray/Eval.hs @@ -14,6 +14,7 @@ import Data import Parse (rayParse, rayParseF) import Control.Parallel +import Control.Monad (ap) class Monad m => MonadEval m where doOp :: PrimOp -> GMLOp -> Stack -> m Stack @@ -24,6 +25,13 @@ class Monad m => MonadEval m where newtype Pure a = Pure a deriving Show +instance Functor Pure where + fmap f (Pure x) = Pure (f x) + +instance Applicative Pure where + pure = Pure + Pure f <*> Pure x = Pure (f x) + instance Monad Pure where Pure x >>= k = k x return = Pure @@ -293,11 +301,18 @@ newtype Abs a = Abs { runAbs :: Int -> AbsState a } data AbsState a = AbsState a !Int | AbsFail String +instance Functor Abs where + fmap f = (pure f <*>) + +instance Applicative Abs where + pure x = Abs (\ n -> AbsState x n) + (<*>) = ap + instance Monad Abs where (Abs fn) >>= k = Abs (\ s -> case fn s of AbsState r s' -> runAbs (k r) s' AbsFail m -> AbsFail m) - return x = Abs (\ n -> AbsState x n) + return = pure fail s = Abs (\ n -> AbsFail s) instance MonadEval Abs where From git at git.haskell.org Tue Aug 15 01:35:13 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 15 Aug 2017 01:35:13 +0000 (UTC) Subject: [commit: nofib] master: Add State monad benchmarks by Andras Kovacs (c7e6c90) Message-ID: <20170815013513.045AC3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/nofib On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c7e6c9074511f74f73eaa3b41051afc94aeb653a/nofib >--------------------------------------------------------------- commit c7e6c9074511f74f73eaa3b41051afc94aeb653a Author: Matthew Pickering Date: Mon Aug 14 20:45:33 2017 -0400 Add State monad benchmarks by Andras Kovacs Summary: They are originally from https://github.com/AndrasKovacs/misc-stuff/blob/master/haskell/Eff/EffBench.hs They show interesting interactions with call arity, spec constr and SAT. Reviewers: O26 nofib, michalt, simonpj, bgamari Reviewed By: bgamari Subscribers: RyanGlScott GHC Trac Issues: #13892 Differential Revision: https://phabricator.haskell.org/D3683 >--------------------------------------------------------------- c7e6c9074511f74f73eaa3b41051afc94aeb653a real/Makefile | 2 +- real/eff/CS/CS.stdout | 1 + real/eff/CS/EffBench.hs | 71 ++++++++++++++++++++++++++++++ real/eff/CS/Main.hs | 13 ++++++ real/{compress2 => eff/CS}/Makefile | 4 +- real/eff/CSD/CSD.stdout | 1 + real/eff/CSD/EffBench.hs | 47 ++++++++++++++++++++ real/eff/CSD/Main.hs | 13 ++++++ real/{compress2 => eff/CSD}/Makefile | 2 +- real/eff/FS/EffBench.hs | 57 ++++++++++++++++++++++++ real/eff/FS/FS.stdout | 1 + real/eff/FS/Main.hs | 13 ++++++ real/{compress2 => eff/FS}/Makefile | 2 +- {parallel/OLD/par001 => real/eff}/Makefile | 3 +- real/eff/S/Main.hs | 19 ++++++++ real/{compress2 => eff/S}/Makefile | 4 +- real/eff/S/S.stdout | 1 + real/eff/VS/EffBench.hs | 70 +++++++++++++++++++++++++++++ real/eff/VS/Main.hs | 13 ++++++ real/{compress2 => eff/VS}/Makefile | 4 +- real/eff/VS/VS.stdout | 1 + real/eff/VSD/EffBench.hs | 35 +++++++++++++++ real/eff/VSD/Main.hs | 14 ++++++ real/{compress2 => eff/VSD}/Makefile | 4 +- real/eff/VSD/VSD.stdout | 1 + real/eff/VSM/EffBench.hs | 58 ++++++++++++++++++++++++ real/eff/VSM/Main.hs | 13 ++++++ real/{compress2 => eff/VSM}/Makefile | 4 +- real/eff/VSM/VSM.stdout | 1 + 29 files changed, 458 insertions(+), 14 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 c7e6c9074511f74f73eaa3b41051afc94aeb653a From git at git.haskell.org Tue Aug 15 01:35:15 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 15 Aug 2017 01:35:15 +0000 (UTC) Subject: [commit: nofib] master: Don't use uname -o (7debffc) Message-ID: <20170815013515.0D2A93A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/nofib On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7debffc19e17ceec7a5fc4bde9aa9780847dda17/nofib >--------------------------------------------------------------- commit 7debffc19e17ceec7a5fc4bde9aa9780847dda17 Author: Ben Gamari Date: Mon Aug 14 20:45:40 2017 -0400 Don't use uname -o Summary: It's not required by the POSIX specification and OS X doesn't support it; instead use uname -s. Test Plan: V Reviewers: O26 nofib, michalt, mpickering Reviewed By: O26 nofib, michalt, mpickering Subscribers: mpickering GHC Trac Issues: #13711 Differential Revision: https://phabricator.haskell.org/D3594 >--------------------------------------------------------------- 7debffc19e17ceec7a5fc4bde9aa9780847dda17 mk/boilerplate.mk | 2 +- runstdtest/runstdtest.prl | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/mk/boilerplate.mk b/mk/boilerplate.mk index 45344ca..c2a5cd6 100644 --- a/mk/boilerplate.mk +++ b/mk/boilerplate.mk @@ -23,7 +23,7 @@ CONTEXT_DIFF_RAW = diff -U 1 EXECUTABLE_FILE = chmod +x # Windows MSYS specific settings -ifeq ($(shell uname -o), Msys) +ifeq ($(shell uname -s | grep -c MSYS), 1) exeext=.exe CONTEXT_DIFF=$(CONTEXT_DIFF_RAW) --strip-trailing-cr else diff --git a/runstdtest/runstdtest.prl b/runstdtest/runstdtest.prl index 8af3c0b..f1ebbd8 100644 --- a/runstdtest/runstdtest.prl +++ b/runstdtest/runstdtest.prl @@ -57,7 +57,7 @@ if ( $ENV{'TMPDIR'} ) { # where to make tmp file names } $cmp = "cmp -s"; # If this is Msys, ignore eol and CR characters. -if ( `uname -o | grep Msys` ) { +if ( `uname -s | grep MSYS` ) { $CONTEXT_DIFF=$CONTEXT_DIFF . " --strip-trailing-cr" ; $cmp = $CONTEXT_DIFF . " -q"; } From git at git.haskell.org Tue Aug 15 01:35:17 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 15 Aug 2017 01:35:17 +0000 (UTC) Subject: [commit: nofib] master: Fix CRLF handling in NoFib (63ce82a) Message-ID: <20170815013517.162943A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/nofib On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/63ce82acf38ef20d20fde6e80c5075c14fe8246c/nofib >--------------------------------------------------------------- commit 63ce82acf38ef20d20fde6e80c5075c14fe8246c Author: Ben Gamari Date: Mon Aug 14 20:48:53 2017 -0400 Fix CRLF handling in NoFib See https://phabricator.haskell.org/D3030#98590. The current master uses the diff alias for comparison, which pollutes stdout. I fixed the tr -d '\r' calls that previously were in place, but broken due to escaping. I also did the same for golden master generation in shootout Makefiles. Test Plan: ``` make clean && \ make NoFibRuns=1 2>&1 > nofib.log && \ nofib-analyse/nofib-analyse nofib.log ``` Differential Revision: https://phabricator.haskell.org/D3450 >--------------------------------------------------------------- 63ce82acf38ef20d20fde6e80c5075c14fe8246c .gitignore | 1 + runstdtest/runstdtest.prl | 12 +++++------- shootout/fasta/Makefile | 6 +++--- shootout/reverse-complement/Makefile | 6 +++--- 4 files changed, 12 insertions(+), 13 deletions(-) diff --git a/.gitignore b/.gitignore index c5604e8..baaa6e3 100644 --- a/.gitignore +++ b/.gitignore @@ -1,4 +1,5 @@ # Generated file patterns +*.exe *.o *.hi .depend diff --git a/runstdtest/runstdtest.prl b/runstdtest/runstdtest.prl index f1ebbd8..648f381 100644 --- a/runstdtest/runstdtest.prl +++ b/runstdtest/runstdtest.prl @@ -55,11 +55,9 @@ if ( $ENV{'TMPDIR'} ) { # where to make tmp file names $TmpPrefix = '/tmp'; $ENV{'TMPDIR'} = '/tmp'; # set the env var as well } -$cmp = "cmp -s"; # If this is Msys, ignore eol and CR characters. if ( `uname -s | grep MSYS` ) { $CONTEXT_DIFF=$CONTEXT_DIFF . " --strip-trailing-cr" ; - $cmp = $CONTEXT_DIFF . " -q"; } $ScriptFile = "$TmpPrefix/run_me$$"; $DefaultStdoutFile = "$TmpPrefix/no_stdout$$"; # can't use /dev/null (e.g. Alphas) @@ -235,17 +233,17 @@ $TimeCmd /bin/sh -c \'$CachegrindPrefix $ToRun $TimingMagic @PgmArgs < $PgmStdin progexit=\$? if [ "$StdoutBinary" = "0" ]; then # remove Windows \r carraige-returns - LC_CTYPE=C tr -d '\r' < $TmpPrefix/runtest$$.1.raw > $TmpPrefix/runtest$$.1 + LC_CTYPE=C tr -d '\\r' < $TmpPrefix/runtest$$.1.raw > $TmpPrefix/runtest$$.1 else cp $TmpPrefix/runtest$$.1.raw $TmpPrefix/runtest$$.1 fi if [ "$StderrBinary" = "0" ]; then # remove Windows \r carraige-returns - LC_CTYPE=C tr -d '\r' < $TmpPrefix/runtest$$.2.raw > $TmpPrefix/runtest$$.2 + LC_CTYPE=C tr -d '\\r' < $TmpPrefix/runtest$$.2.raw > $TmpPrefix/runtest$$.2 else cp $TmpPrefix/runtest$$.2.raw $TmpPrefix/runtest$$.2 fi -LC_CTYPE=C tr -d '\r' < $TmpPrefix/runtest$$.3.raw > $TmpPrefix/runtest$$.3 +LC_CTYPE=C tr -d '\\r' < $TmpPrefix/runtest$$.3.raw > $TmpPrefix/runtest$$.3 if [ \$progexit -eq 0 ] && [ $PgmFail -ne 0 ]; then echo $ToRun @PgmArgs \\< $PgmStdinFile echo "****" expected a failure, but was successful @@ -259,7 +257,7 @@ else $PostScriptLines hit='NO' for out_file in @PgmStdoutFile ; do - if $cmp \$out_file $TmpPrefix/runtest$$.1 ; then + if cmp -s \$out_file $TmpPrefix/runtest$$.1 ; then hit='YES' fi done @@ -285,7 +283,7 @@ fi hit='NO' for out_file in @PgmStderrFile ; do - if $cmp \$out_file $TmpPrefix/runtest$$.2 ; then + if cmp -s \$out_file $TmpPrefix/runtest$$.2 ; then hit='YES' fi done diff --git a/shootout/fasta/Makefile b/shootout/fasta/Makefile index 68e6279..f6beb8e 100644 --- a/shootout/fasta/Makefile +++ b/shootout/fasta/Makefile @@ -20,13 +20,13 @@ fasta-c : fasta-c.c $(CC) -std=gnu99 -O3 -fomit-frame-pointer $< -o $@ fasta.faststdout : fasta-c - ./fasta-c $(FAST_OPTS) > $@ + ./fasta-c $(FAST_OPTS) | tr -d '\r' > $@ fasta.stdout : fasta-c - ./fasta-c $(NORM_OPTS) > $@ + ./fasta-c $(NORM_OPTS) | tr -d '\r' > $@ fasta.slowstdout : fasta-c - ./fasta-c $(SLOW_OPTS) > $@ + ./fasta-c $(SLOW_OPTS) | tr -d '\r' > $@ # Since we only decide here what the INPUT_FILE is, it's required to first run # `make boot` and only than `make` (otherwise `make` doesn't "see" the file and diff --git a/shootout/reverse-complement/Makefile b/shootout/reverse-complement/Makefile index 8fd7a9d..c165f2f 100644 --- a/shootout/reverse-complement/Makefile +++ b/shootout/reverse-complement/Makefile @@ -51,13 +51,13 @@ revcomp-c : revcomp-c.o gcc $< -o $@ -pthread reverse-complement.faststdout : revcomp-c $(INPUT_FILE) - ./revcomp-c < $(INPUT_FILE) > $@ + ./revcomp-c < $(INPUT_FILE) | tr -d '\r' > $@ reverse-complement.stdout : revcomp-c $(INPUT_FILE) - ./revcomp-c < $(INPUT_FILE) > $@ + ./revcomp-c < $(INPUT_FILE) | tr -d '\r' > $@ reverse-complement.slowstdout : revcomp-c $(INPUT_FILE) - ./revcomp-c < $(INPUT_FILE) > $@ + ./revcomp-c < $(INPUT_FILE) | tr -d '\r' > $@ # Since we only decide here what the OUTPUT_FILE is, it's required to first run # `make boot` and only than `make` (otherwise `make` doesn't "see" the file and From git at git.haskell.org Tue Aug 15 01:35:33 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 15 Aug 2017 01:35:33 +0000 (UTC) Subject: [commit: ghc] master: Point to FunDeps documentation on Haskell wiki (7c37ffe) Message-ID: <20170815013533.7C2683A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7c37ffe8f0acd2f72e3d3aeeb517991fa7d45a16/ghc >--------------------------------------------------------------- commit 7c37ffe8f0acd2f72e3d3aeeb517991fa7d45a16 Author: Ben Gamari Date: Mon Aug 7 23:40:51 2017 -0400 Point to FunDeps documentation on Haskell wiki >--------------------------------------------------------------- 7c37ffe8f0acd2f72e3d3aeeb517991fa7d45a16 docs/users_guide/glasgow_exts.rst | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/docs/users_guide/glasgow_exts.rst b/docs/users_guide/glasgow_exts.rst index bc09402..378beb2 100644 --- a/docs/users_guide/glasgow_exts.rst +++ b/docs/users_guide/glasgow_exts.rst @@ -5407,8 +5407,8 @@ of a class declaration; e.g. :: class Foo a b c | a b -> c where ... -There should be more documentation, but there isn't (yet). Yell if you -need it. +More documentation can be found in the `Haskell Wiki +`_. .. [Jones2000] "`Type Classes with Functional From git at git.haskell.org Tue Aug 15 01:35:37 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 15 Aug 2017 01:35:37 +0000 (UTC) Subject: [commit: ghc] master: Fix #14060 by more conservatively annotating TH-reified types (ad7b945) Message-ID: <20170815013537.1CDBA3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ad7b945257ea262e3f6f46daa4ff3e451aeeae0b/ghc >--------------------------------------------------------------- commit ad7b945257ea262e3f6f46daa4ff3e451aeeae0b Author: Ryan Scott Date: Mon Aug 14 20:53:57 2017 -0400 Fix #14060 by more conservatively annotating TH-reified types Before, TH was quite generous in applying kind annotations to reified type constructors whose result kind happened to mention type variables. This could result in agonizingly large reified types, so this patch aims to quell this a bit by adopting a more nuanced algorithm for determining when a tycon application deserves a kind annotation. This implements the algorithm laid out in https://ghc.haskell.org/trac/ghc/ticket/14060#comment:1. I've updated `Note [Kind annotations on TyConApps]` to reflect the new wisdom. Essentially, instead of only checking if the result kind contains free variables, we also check if any of those variables do not appear free in injective positions in the argument kinds—only then do we put on a kind annotation. Bumps `haddock` submodule. Test Plan: make test TEST=T14060 Reviewers: goldfire, austin, bgamari Reviewed By: goldfire Subscribers: rwbarton, thomie GHC Trac Issues: #14060 Differential Revision: https://phabricator.haskell.org/D3807 >--------------------------------------------------------------- ad7b945257ea262e3f6f46daa4ff3e451aeeae0b compiler/iface/MkIface.hs | 2 +- compiler/typecheck/FamInst.hs | 4 +- compiler/typecheck/TcInteract.hs | 6 +- compiler/typecheck/TcRnDriver.hs | 4 +- compiler/typecheck/TcSplice.hs | 128 +++++++++++++++++++++++++++++++------ compiler/typecheck/TcValidity.hs | 2 +- compiler/types/TyCon.hs | 18 ++++-- compiler/types/Unify.hs | 2 +- testsuite/tests/th/T12403.stdout | 6 +- testsuite/tests/th/T12478_1.stdout | 2 +- testsuite/tests/th/T14060.hs | 38 +++++++++++ testsuite/tests/th/T14060.stdout | 11 ++++ testsuite/tests/th/T8953.stderr | 6 +- testsuite/tests/th/all.T | 1 + utils/haddock | 2 +- 15 files changed, 188 insertions(+), 44 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc ad7b945257ea262e3f6f46daa4ff3e451aeeae0b From git at git.haskell.org Tue Aug 15 01:35:39 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 15 Aug 2017 01:35:39 +0000 (UTC) Subject: [commit: ghc] master: Properly handle dlerror() message on FreeBSD when linking linker scripts (0a891c8) Message-ID: <20170815013539.CE15E3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/0a891c8c448a0e70abb075702857d743674ad1ad/ghc >--------------------------------------------------------------- commit 0a891c8c448a0e70abb075702857d743674ad1ad Author: Gleb Popov <6yearold at gmail.com> Date: Mon Aug 14 20:54:36 2017 -0400 Properly handle dlerror() message on FreeBSD when linking linker scripts Test Plan: `GHCi.loadDll "/usr/lib/libc++.so` now works on FreeBSD. Reviewers: austin, bgamari, erikd, simonmar Reviewed By: simonmar Subscribers: rwbarton, thomie Differential Revision: https://phabricator.haskell.org/D3841 >--------------------------------------------------------------- 0a891c8c448a0e70abb075702857d743674ad1ad rts/Linker.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/rts/Linker.c b/rts/Linker.c index 3700726..18f2c6b 100644 --- a/rts/Linker.c +++ b/rts/Linker.c @@ -482,7 +482,7 @@ initLinker_ (int retain_cafs) # endif /* RTLD_DEFAULT */ compileResult = regcomp(&re_invalid, - "(([^ \t()])+\\.so([^ \t:()])*):([ \t])*(invalid ELF header|file too short)", + "(([^ \t()])+\\.so([^ \t:()])*):([ \t])*(invalid ELF header|file too short|invalid file format)", REG_EXTENDED); if (compileResult != 0) { barf("Compiling re_invalid failed"); From git at git.haskell.org Tue Aug 15 01:35:42 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 15 Aug 2017 01:35:42 +0000 (UTC) Subject: [commit: ghc] master: Use a ReaderT in TcDeriv to avoid some tedious plumbing (ed7a830) Message-ID: <20170815013542.9691B3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ed7a830de6a2ea74dd6bb81f8ec55b9fe0b52f28/ghc >--------------------------------------------------------------- commit ed7a830de6a2ea74dd6bb81f8ec55b9fe0b52f28 Author: Ryan Scott Date: Mon Aug 14 20:56:04 2017 -0400 Use a ReaderT in TcDeriv to avoid some tedious plumbing Addresses point (2) of https://phabricator.haskell.org/D3337#107865. Before, several functions in `TcDeriv` and `TcDerivInfer` which compute an `EarlyDerivSpec` were manually threading through about 10 different arguments, which contribute to quite a lot of clutter whenever they need to be updated. To minimize this plumbing, and to make it clearer which of these 10 values are being used where, I refactored the code in `TcDeriv` and `TcDerivInfer` to use a new `DerivM` type: ```lang=haskell type DerivM = ReaderT DerivEnv TcRn ``` where `DerivEnv` contains the 10 aforementioned values. In addition to cleaning up the code, this should make some subsequent changes planned for later less noisy. Test Plan: ./validate Reviewers: austin, bgamari Subscribers: rwbarton, thomie Differential Revision: https://phabricator.haskell.org/D3846 >--------------------------------------------------------------- ed7a830de6a2ea74dd6bb81f8ec55b9fe0b52f28 compiler/typecheck/TcDeriv.hs | 767 +++++++++++++++++++------------------ compiler/typecheck/TcDerivInfer.hs | 452 ++++++++++++---------- compiler/typecheck/TcDerivUtils.hs | 60 +++ 3 files changed, 693 insertions(+), 586 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 ed7a830de6a2ea74dd6bb81f8ec55b9fe0b52f28 From git at git.haskell.org Tue Aug 15 01:35:45 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 15 Aug 2017 01:35:45 +0000 (UTC) Subject: [commit: ghc] master: Bump mtl, parsec, text submodules (a520adc) Message-ID: <20170815013545.56DC23A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a520adcce27908c799b64214618cf9b33572dc37/ghc >--------------------------------------------------------------- commit a520adcce27908c799b64214618cf9b33572dc37 Author: Ryan Scott Date: Mon Aug 14 20:57:11 2017 -0400 Bump mtl, parsec, text submodules These three submodules have commits which add certain files to their respective .gitignores which GHC's build system produces. Also update the packages file accordingly. Test Plan: If it builds, ship it Reviewers: hvr, austin, bgamari Subscribers: rwbarton, thomie Differential Revision: https://phabricator.haskell.org/D3842 >--------------------------------------------------------------- a520adcce27908c799b64214618cf9b33572dc37 packages | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/packages b/packages index a44e316..9af1b64 100644 --- a/packages +++ b/packages @@ -52,12 +52,12 @@ libraries/directory - - ssh://g libraries/filepath - - ssh://git at github.com/haskell/filepath.git libraries/haskeline - - https://github.com/judah/haskeline.git libraries/hpc - - - -libraries/mtl - - https://github.com/ekmett/mtl.git +libraries/mtl - - https://github.com/haskell/mtl.git libraries/parsec - - https://github.com/haskell/parsec.git libraries/pretty - - https://github.com/haskell/pretty.git libraries/process - - ssh://git at github.com/haskell/process.git libraries/terminfo - - https://github.com/judah/terminfo.git -libraries/text - - https://github.com/bos/text.git +libraries/text - - https://github.com/haskell/text.git libraries/time - - https://github.com/haskell/time.git libraries/transformers - - https://git.haskell.org/darcs-mirrors/transformers.git libraries/unix - - ssh://git at github.com/haskell/unix.git From git at git.haskell.org Tue Aug 15 01:35:48 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 15 Aug 2017 01:35:48 +0000 (UTC) Subject: [commit: ghc] master: Recognize FreeBSD compiler as Clang. (21bd9b2) Message-ID: <20170815013548.122AD3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/21bd9b2f3f48af453348f40a740ee8f4c26fdace/ghc >--------------------------------------------------------------- commit 21bd9b2f3f48af453348f40a740ee8f4c26fdace Author: Gleb Popov <6yearold at gmail.com> Date: Mon Aug 14 20:56:44 2017 -0400 Recognize FreeBSD compiler as Clang. Reviewers: austin, bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie Differential Revision: https://phabricator.haskell.org/D3840 >--------------------------------------------------------------- 21bd9b2f3f48af453348f40a740ee8f4c26fdace compiler/main/SysTools.hs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/compiler/main/SysTools.hs b/compiler/main/SysTools.hs index c73e47c..faf6f11 100644 --- a/compiler/main/SysTools.hs +++ b/compiler/main/SysTools.hs @@ -868,6 +868,9 @@ getCompilerInfo' dflags = do -- Regular clang | any ("clang version" `isInfixOf`) stde = return Clang + -- FreeBSD clang + | any ("FreeBSD clang version" `isInfixOf`) stde = + return Clang -- XCode 5.1 clang | any ("Apple LLVM version 5.1" `isPrefixOf`) stde = return AppleClang51 From git at git.haskell.org Tue Aug 15 01:35:50 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 15 Aug 2017 01:35:50 +0000 (UTC) Subject: [commit: ghc] master: Add Semigroup/Monoid instances to ST monad (441c52d) Message-ID: <20170815013550.C57E03A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/441c52de0621ac68a2248cf691b4de31fba48a34/ghc >--------------------------------------------------------------- commit 441c52de0621ac68a2248cf691b4de31fba48a34 Author: Ben Gamari Date: Mon Aug 14 20:58:16 2017 -0400 Add Semigroup/Monoid instances to ST monad Fixes #14107. Signed-off-by: Philipp Middendorf Reviewers: austin, hvr, bgamari, RyanGlScott Reviewed By: bgamari Subscribers: RyanGlScott, rwbarton, thomie GHC Trac Issues: #14107 Differential Revision: https://phabricator.haskell.org/D3845 >--------------------------------------------------------------- 441c52de0621ac68a2248cf691b4de31fba48a34 libraries/base/Data/Semigroup.hs | 5 +++++ libraries/base/GHC/ST.hs | 5 +++++ libraries/base/changelog.md | 2 ++ 3 files changed, 12 insertions(+) diff --git a/libraries/base/Data/Semigroup.hs b/libraries/base/Data/Semigroup.hs index fae207e..8631b11 100644 --- a/libraries/base/Data/Semigroup.hs +++ b/libraries/base/Data/Semigroup.hs @@ -72,6 +72,7 @@ import Prelude hiding (foldr1) import Control.Applicative import Control.Monad import Control.Monad.Fix +import Control.Monad.ST(ST) import Data.Bifoldable import Data.Bifunctor import Data.Bitraversable @@ -725,6 +726,10 @@ instance Semigroup (Proxy s) where instance Semigroup a => Semigroup (IO a) where (<>) = liftA2 (<>) +-- | @since 4.11.0.0 +instance Semigroup a => Semigroup (ST s a) where + (<>) = liftA2 (<>) + #if !defined(mingw32_HOST_OS) -- | @since 4.10.0.0 instance Semigroup Event where diff --git a/libraries/base/GHC/ST.hs b/libraries/base/GHC/ST.hs index 4e00c0e..a245b9f 100644 --- a/libraries/base/GHC/ST.hs +++ b/libraries/base/GHC/ST.hs @@ -77,6 +77,11 @@ instance Monad (ST s) where case (k r) of { ST k2 -> (k2 new_s) }}) +-- | @since 4.11.0.0 +instance Monoid a => Monoid (ST s a) where + mempty = pure mempty + mappend = liftA2 mappend + data STret s a = STret (State# s) a -- liftST is useful when we want a lifted result from an ST computation. See diff --git a/libraries/base/changelog.md b/libraries/base/changelog.md index 708676f..ab304a3 100644 --- a/libraries/base/changelog.md +++ b/libraries/base/changelog.md @@ -14,6 +14,8 @@ * Remove the deprecated `Typeable{1..7}` type synonyms (#14047) + * Add instances `Semigroup` and `Monoid` for `Control.Monad.ST` (#14107). + ## 4.10.0.0 *April 2017* * Bundled with GHC *TBA* From git at git.haskell.org Tue Aug 15 01:35:53 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 15 Aug 2017 01:35:53 +0000 (UTC) Subject: [commit: ghc] master: Don't drop GHCi-defined functions with -fobject-code enabled (ddb870b) Message-ID: <20170815013553.871FC3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ddb870bf7055ccc8ff8b86c161f31aad81d01add/ghc >--------------------------------------------------------------- commit ddb870bf7055ccc8ff8b86c161f31aad81d01add Author: Ryan Scott Date: Mon Aug 14 20:55:39 2017 -0400 Don't drop GHCi-defined functions with -fobject-code enabled The desugarer was using `targetRetainsAllBindings` as a litmus test for determining if a function was defined in interactive mode (and thus should be exported). However, there is a corner case where one can be in interactive mode and have `targetRetainsAllBindings` return `False`: if `-fobject-code` is enabled (since the target will no longer be `HscInteractive`). In such a scenario, we should fall back on a different test for determining if we are in a GHCi session. I chose to use `isInteractiveModule`, which appears to do the trick. Test Plan: make test TEST=T12091 Reviewers: austin, bgamari Subscribers: rwbarton, thomie GHC Trac Issues: #12091 Differential Revision: https://phabricator.haskell.org/D3849 >--------------------------------------------------------------- ddb870bf7055ccc8ff8b86c161f31aad81d01add compiler/deSugar/Desugar.hs | 19 +++++++++++++++---- testsuite/tests/ghci/scripts/all.T | 5 ++--- 2 files changed, 17 insertions(+), 7 deletions(-) diff --git a/compiler/deSugar/Desugar.hs b/compiler/deSugar/Desugar.hs index 3d8a28f..4bfd10f 100644 --- a/compiler/deSugar/Desugar.hs +++ b/compiler/deSugar/Desugar.hs @@ -148,7 +148,8 @@ deSugar hsc_env keep_alive <- readIORef keep_var ; let (rules_for_locals, rules_for_imps) = partition isLocalRule all_rules final_prs = addExportFlagsAndRules target export_set keep_alive - rules_for_locals (fromOL all_prs) + mod rules_for_locals + (fromOL all_prs) final_pgm = combineEvBinds ds_ev_binds final_prs -- Notice that we put the whole lot in a big Rec, even the foreign binds @@ -278,9 +279,9 @@ deSugarExpr hsc_env tc_expr = do { -} addExportFlagsAndRules - :: HscTarget -> NameSet -> NameSet -> [CoreRule] + :: HscTarget -> NameSet -> NameSet -> Module -> [CoreRule] -> [(Id, t)] -> [(Id, t)] -addExportFlagsAndRules target exports keep_alive rules prs +addExportFlagsAndRules target exports keep_alive mod rules prs = mapFst add_one prs where add_one bndr = add_rules name (add_export name bndr) @@ -313,10 +314,20 @@ addExportFlagsAndRules target exports keep_alive rules prs -- simplification), and retain them all in the TypeEnv so they are -- available from the command line. -- + -- Most of the time, this can be accomplished by use of + -- targetRetainsAllBindings, which returns True if the target is + -- HscInteractive. However, there are cases when one can use GHCi with + -- a target other than HscInteractive (e.g., with the -fobject-code + -- flag enabled, as in #12091). In such scenarios, + -- targetRetainsAllBindings can return False, so we must fall back on + -- isInteractiveModule to be doubly sure we export entities defined in + -- a GHCi session. + -- -- isExternalName separates the user-defined top-level names from those -- introduced by the type checker. is_exported :: Name -> Bool - is_exported | targetRetainsAllBindings target = isExternalName + is_exported | targetRetainsAllBindings target + || isInteractiveModule mod = isExternalName | otherwise = (`elemNameSet` exports) {- diff --git a/testsuite/tests/ghci/scripts/all.T b/testsuite/tests/ghci/scripts/all.T index 8c3a2f5..1f4e5b1 100755 --- a/testsuite/tests/ghci/scripts/all.T +++ b/testsuite/tests/ghci/scripts/all.T @@ -240,9 +240,8 @@ test('T11975', normal, ghci_script, ['T11975.script']) test('T10963', normal, ghci_script, ['T10963.script']) test('T11547', normal, ghci_script, ['T11547.script']) test('T12520', normal, ghci_script, ['T12520.script']) -test('T12091', - [expect_broken(12091), extra_run_opts('-fobject-code')], - ghci_script, ['T12091.script']) +test('T12091', [extra_run_opts('-fobject-code')], ghci_script, + ['T12091.script']) test('T12523', normal, ghci_script, ['T12523.script']) test('T12024', normal, ghci_script, ['T12024.script']) test('T12447', expect_broken(12447), ghci_script, ['T12447.script']) From git at git.haskell.org Tue Aug 15 01:35:56 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 15 Aug 2017 01:35:56 +0000 (UTC) Subject: [commit: ghc] master: Bump nofib submodule (b0285d1) Message-ID: <20170815013556.46F223A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b0285d1fa76769d59e69cb9bf97675868d90a028/ghc >--------------------------------------------------------------- commit b0285d1fa76769d59e69cb9bf97675868d90a028 Author: Ben Gamari Date: Mon Aug 14 20:52:57 2017 -0400 Bump nofib submodule >--------------------------------------------------------------- b0285d1fa76769d59e69cb9bf97675868d90a028 nofib | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/nofib b/nofib index eccf532..63ce82a 160000 --- a/nofib +++ b/nofib @@ -1 +1 @@ -Subproject commit eccf532410eee45f30c07f389f7029871fd603db +Subproject commit 63ce82acf38ef20d20fde6e80c5075c14fe8246c From git at git.haskell.org Tue Aug 15 13:08:33 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 15 Aug 2017 13:08:33 +0000 (UTC) Subject: [commit: ghc] master: Bump mtl, parsec, text submodules (e054c5f) Message-ID: <20170815130833.B107D3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e054c5f06451def4437d9d770ae156f034796c59/ghc >--------------------------------------------------------------- commit e054c5f06451def4437d9d770ae156f034796c59 Author: Ben Gamari Date: Tue Aug 15 08:28:50 2017 -0400 Bump mtl, parsec, text submodules a520adcce27908c799b64214618cf9b33572dc37 updated the upstream repository locations but failed to update the commits themselves. >--------------------------------------------------------------- e054c5f06451def4437d9d770ae156f034796c59 libraries/mtl | 2 +- libraries/parsec | 2 +- libraries/text | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/libraries/mtl b/libraries/mtl index b4725fe..fc9578a 160000 --- a/libraries/mtl +++ b/libraries/mtl @@ -1 +1 @@ -Subproject commit b4725fe28cba8a535e969e0ddbce3d5e05146ccd +Subproject commit fc9578af042d226a8abaccb33b2bb99c63736134 diff --git a/libraries/parsec b/libraries/parsec index d21d863..36615b6 160000 --- a/libraries/parsec +++ b/libraries/parsec @@ -1 +1 @@ -Subproject commit d21d86387998614de31697a26fd8fec15d40e62b +Subproject commit 36615b6f8a52943eda663ece1d0f612a0a681acc diff --git a/libraries/text b/libraries/text index 81f9de1..315eb59 160000 --- a/libraries/text +++ b/libraries/text @@ -1 +1 @@ -Subproject commit 81f9de11424b79e075d0d22cee23ce9ad90b506b +Subproject commit 315eb59f2ae40f6330afb854a011ecafedf01165 From git at git.haskell.org Wed Aug 16 02:40:12 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 16 Aug 2017 02:40:12 +0000 (UTC) Subject: [commit: ghc] wip/jenkins: testsuite/junit: Properly escape strings (526e6d7) Message-ID: <20170816024012.C62CB3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/jenkins Link : http://ghc.haskell.org/trac/ghc/changeset/526e6d770ce78cddeaa2747e00f16323abfa2cda/ghc >--------------------------------------------------------------- commit 526e6d770ce78cddeaa2747e00f16323abfa2cda Author: Ben Gamari Date: Mon Jul 31 11:36:49 2017 -0400 testsuite/junit: Properly escape strings >--------------------------------------------------------------- 526e6d770ce78cddeaa2747e00f16323abfa2cda testsuite/driver/junit.py | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/testsuite/driver/junit.py b/testsuite/driver/junit.py index f9689de..4015c19 100644 --- a/testsuite/driver/junit.py +++ b/testsuite/driver/junit.py @@ -1,5 +1,6 @@ from datetime import datetime import xml.etree.ElementTree as ET +from xml.sax.saxutils import escape def junit(t): testsuites = ET.Element('testsuites') @@ -18,21 +19,21 @@ def junit(t): classname = testname, name = way) result = ET.SubElement(testcase, 'failure', - type = reason, - message = result) + type = 'unexpected failure', + message = escape(reason)) for (directory, testname, reason, way) in t.framework_failures: testcase = ET.SubElement(testsuite, 'testcase', classname = testname, - name = way) + name = escape(way)) result = ET.SubElement(testcase, 'error', type = "framework failure", - message = reason) + message = escape(reason)) for (directory, testname, way) in t.expected_passes: testcase = ET.SubElement(testsuite, 'testcase', classname = testname, - name = way) + name = escape(way)) return ET.ElementTree(testsuites) From git at git.haskell.org Wed Aug 16 02:40:18 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 16 Aug 2017 02:40:18 +0000 (UTC) Subject: [commit: ghc] wip/jenkins: Testing simpler Jenkinsfile (877d3dc) Message-ID: <20170816024018.CDFAA3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/jenkins Link : http://ghc.haskell.org/trac/ghc/changeset/877d3dc787a8e826a52845a6c31ed51bc3354580/ghc >--------------------------------------------------------------- commit 877d3dc787a8e826a52845a6c31ed51bc3354580 Author: Ben Gamari Date: Fri Apr 21 14:29:34 2017 -0400 Testing simpler Jenkinsfile >--------------------------------------------------------------- 877d3dc787a8e826a52845a6c31ed51bc3354580 Jenkinsfile | 366 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Makefile | 4 + ghc.mk | 4 + mk/config.mk.in | 2 +- 4 files changed, 375 insertions(+), 1 deletion(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 877d3dc787a8e826a52845a6c31ed51bc3354580 From git at git.haskell.org Wed Aug 16 02:40:15 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 16 Aug 2017 02:40:15 +0000 (UTC) Subject: [commit: ghc] wip/jenkins: Fix JUnit (db9117d) Message-ID: <20170816024015.81A883A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/jenkins Link : http://ghc.haskell.org/trac/ghc/changeset/db9117df0a5efab25c9363a8e6e3229da08ea5b1/ghc >--------------------------------------------------------------- commit db9117df0a5efab25c9363a8e6e3229da08ea5b1 Author: Ben Gamari Date: Fri Jul 28 19:06:29 2017 -0400 Fix JUnit >--------------------------------------------------------------- db9117df0a5efab25c9363a8e6e3229da08ea5b1 Jenkinsfile | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Jenkinsfile b/Jenkinsfile index ee6a884..23b6ced 100644 --- a/Jenkinsfile +++ b/Jenkinsfile @@ -302,8 +302,8 @@ def testGhc(params) { if (params.nightly) { target = 'slowtest' } - sh "${makeCmd} -Ctestsuite/tests LOCAL=0 BINDIST=YES THREADS=${env.THREADS} TEST_HC=\"${testGhc}\" ${target}" - junit 'testsuite*.xml' + sh "${makeCmd} -Ctestsuite/tests LOCAL=0 BINDIST=YES THREADS=${env.THREADS} TEST_HC=\"${testGhc}\" JUNIT_FILE=testsuite.xml ${target}" + junit 'testsuite.xml' } } } From git at git.haskell.org Wed Aug 16 02:40:24 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 16 Aug 2017 02:40:24 +0000 (UTC) Subject: [commit: ghc] wip/jenkins: Bump GHC to 8.2.1 (a731dd5) Message-ID: <20170816024024.4BDD63A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/jenkins Link : http://ghc.haskell.org/trac/ghc/changeset/a731dd5b66ffdbc69d5cc39b5d5393b6b1a858d3/ghc >--------------------------------------------------------------- commit a731dd5b66ffdbc69d5cc39b5d5393b6b1a858d3 Author: Ben Gamari Date: Sun Jul 30 23:09:12 2017 -0400 Bump GHC to 8.2.1 >--------------------------------------------------------------- a731dd5b66ffdbc69d5cc39b5d5393b6b1a858d3 Jenkinsfile | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Jenkinsfile b/Jenkinsfile index 8501f87..7eac8ff 100644 --- a/Jenkinsfile +++ b/Jenkinsfile @@ -119,11 +119,11 @@ def withMingw(String msystem, Closure f) { if (msystem == 'MINGW32') { prefix = "${msysRoot}\\mingw32" carch = 'i686' - ghcPath = "${home}/ghc-8.0.1-i386/bin" + ghcPath = "${home}/ghc-8.2.1-i386/bin" } else if (msystem == 'MINGW64') { prefix = "${msysRoot}\\mingw64" carch = 'x86_64' - ghcPath = "${home}/ghc-8.0.2-x86_64/bin" + ghcPath = "${home}/ghc-8.2.1-x86_64/bin" } else { fail } From git at git.haskell.org Wed Aug 16 02:40:21 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 16 Aug 2017 02:40:21 +0000 (UTC) Subject: [commit: ghc] wip/jenkins: Fix junit output path (561f651) Message-ID: <20170816024021.8CF893A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/jenkins Link : http://ghc.haskell.org/trac/ghc/changeset/561f651021f3b26497a53de18b694760a1d179a5/ghc >--------------------------------------------------------------- commit 561f651021f3b26497a53de18b694760a1d179a5 Author: Ben Gamari Date: Mon Jul 31 00:41:25 2017 -0400 Fix junit output path >--------------------------------------------------------------- 561f651021f3b26497a53de18b694760a1d179a5 Jenkinsfile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Jenkinsfile b/Jenkinsfile index 7eac8ff..c86060c 100644 --- a/Jenkinsfile +++ b/Jenkinsfile @@ -302,7 +302,7 @@ def testGhc(params) { if (params.nightly) { target = 'slowtest' } - sh "${makeCmd} -Ctestsuite/tests LOCAL=0 BINDIST=YES THREADS=${env.THREADS} TEST_HC=\"${testGhc}\" JUNIT_FILE=testsuite.xml ${target}" + sh "${makeCmd} -Ctestsuite/tests LOCAL=0 BINDIST=YES THREADS=${env.THREADS} TEST_HC=\"${testGhc}\" JUNIT_FILE=../../testsuite.xml ${target}" junit 'testsuite.xml' } } From git at git.haskell.org Wed Aug 16 02:40:27 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 16 Aug 2017 02:40:27 +0000 (UTC) Subject: [commit: ghc] wip/jenkins: testsuite/junit: Flip type and message (6b957cc) Message-ID: <20170816024027.0829D3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/jenkins Link : http://ghc.haskell.org/trac/ghc/changeset/6b957cc49f3c86d6d781a17233482927ba29a3cf/ghc >--------------------------------------------------------------- commit 6b957cc49f3c86d6d781a17233482927ba29a3cf Author: Ben Gamari Date: Mon Jul 31 08:44:40 2017 -0400 testsuite/junit: Flip type and message type apparently can't contain < characters. >--------------------------------------------------------------- 6b957cc49f3c86d6d781a17233482927ba29a3cf testsuite/driver/junit.py | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/testsuite/driver/junit.py b/testsuite/driver/junit.py index 01a5f47..f9689de 100644 --- a/testsuite/driver/junit.py +++ b/testsuite/driver/junit.py @@ -18,8 +18,8 @@ def junit(t): classname = testname, name = way) result = ET.SubElement(testcase, 'failure', - type = result, - message = reason) + type = reason, + message = result) for (directory, testname, reason, way) in t.framework_failures: testcase = ET.SubElement(testsuite, 'testcase', From git at git.haskell.org Wed Aug 16 02:40:29 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 16 Aug 2017 02:40:29 +0000 (UTC) Subject: [commit: ghc] wip/jenkins: Fix whitespace (80e3ddc) Message-ID: <20170816024029.CB3AE3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/jenkins Link : http://ghc.haskell.org/trac/ghc/changeset/80e3ddc20f24f0fb4631ae039045eab61137ff0f/ghc >--------------------------------------------------------------- commit 80e3ddc20f24f0fb4631ae039045eab61137ff0f Author: Ben Gamari Date: Sun Jul 30 23:09:03 2017 -0400 Fix whitespace >--------------------------------------------------------------- 80e3ddc20f24f0fb4631ae039045eab61137ff0f Jenkinsfile | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/Jenkinsfile b/Jenkinsfile index 23b6ced..8501f87 100644 --- a/Jenkinsfile +++ b/Jenkinsfile @@ -315,11 +315,11 @@ def nofib(params) { stage('Run nofib') { installPkgs(['regex-compat']) sh """ - cd nofib - ${makeCmd} clean - ${makeCmd} boot - ${makeCmd} >../nofib.log 2>&1 - """ + cd nofib + ${makeCmd} clean + ${makeCmd} boot + ${makeCmd} >../nofib.log 2>&1 + """ archiveArtifacts artifacts: 'nofib.log' } } From git at git.haskell.org Wed Aug 16 02:40:32 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 16 Aug 2017 02:40:32 +0000 (UTC) Subject: [commit: ghc] wip/jenkins's head updated: testsuite/junit: Properly escape strings (526e6d7) Message-ID: <20170816024032.E3F6B3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/jenkins' now includes: f134bfb gitmodules: Delete entry for dead hoopl submodule d08b9cc configure: Ensure that user's LD setting is respected 0e3c101 Ensure that we always link against libm 0e3eacc testsuite: Don't pass allow_abbrev 121fee9 Remove unnecessary GHC option from SrcLoc 9e9fb57 Fix hs-boot knot-tying with record wild cards. d75bba8 Add rtsopts ignore and ignoreAll. 84f8e86 Ensure that GHC.Stack.callStack doesn't fail 9cfabbb Add '<&>' operator to Data.Functor. '<&>' calls '<$>' with flipped arguments. d1ef223 Fix #14045 by omitting an unnecessary check f839b9d Add regression test for #14055 7089dc2 Follow-up to #13887, for promoted infix constructors 9699286 Typofixes [ci skip] f2c12c3 Add haddock markup 49e334c Allow Windows to set blank environment variables c6d4219 Clarify comment about data family arities 2535a67 Refactoring around FunRhs 4636886 Improve the desugaring of -XStrict 3ab342e Do a bit more CSE af89d68 Reject top-level banged bindings 7f2dee8 Remove redundant goop 4fdc523 Use field names for all uses of datacon Match 2ef973e A bunch of typofixes 7a74f50 Typofixes [ci skip] 5a7af95 KnownUniques: Handle DataCon wrapper names 29f07b1 Allow bundling pattern synonyms with exported data families 74c7016 rts: Fix "variable set but not used" warning b311096 Simplify OccurAnal.tagRecBinders c13720c Drop GHC 7.10 compatibility 36fe21a Enable building Cabal with parsec 9df71bf Bump unix submodule 8ef8520 Add .gitmodules entries for text, parsec, mtl submodules d74983e Get the roles right for newtype instances f68a00c Remove unneeded uses of ImplicitParams 884bd21 Add the bootstrapping/ dir to .gitignore 394c391 Add MonadIO Q - by requiring MonadIO => Quasi a81b5b0 Remove the deprecated Typeable{1..7} type synonyms a267580 Don't warn when empty casing on Type 6ea13e9 Add forgotten > in Control.Applicative e8fe12f Fix string escaping in JSON 2f29f19 Convert examples to doctests, and add a handful of new ones 14457cf Fix EmptyCase documentation a4f347c Split out inferConstraintsDataConArgs from inferConstraints 3f05e5f Don't suppress unimplemented type family warnings with DeriveAnyClass 7d69978 Use NonEmpty lists to represent lists of duplicate elements 4f1f986 Change isClosedAlgType to be TYPE-aware, and rename it to pmIsClosedType 0bb1e84 Expand type synonyms during role inference c6462ab Add test for #14101 7c37ffe Point to FunDeps documentation on Haskell wiki ad7b945 Fix #14060 by more conservatively annotating TH-reified types 0a891c8 Properly handle dlerror() message on FreeBSD when linking linker scripts ddb870b Don't drop GHCi-defined functions with -fobject-code enabled ed7a830 Use a ReaderT in TcDeriv to avoid some tedious plumbing 21bd9b2 Recognize FreeBSD compiler as Clang. a520adc Bump mtl, parsec, text submodules 441c52d Add Semigroup/Monoid instances to ST monad b0285d1 Bump nofib submodule e054c5f Bump mtl, parsec, text submodules 877d3dc Testing simpler Jenkinsfile db9117d Fix JUnit 80e3ddc Fix whitespace a731dd5 Bump GHC to 8.2.1 561f651 Fix junit output path 6b957cc testsuite/junit: Flip type and message 526e6d7 testsuite/junit: Properly escape strings From git at git.haskell.org Wed Aug 16 15:53:01 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 16 Aug 2017 15:53:01 +0000 (UTC) Subject: [commit: ghc] master: Bump mtl, parsec, text submodules (again) (6e9c8eb) Message-ID: <20170816155301.AE2733A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6e9c8eb9885f894eed7e01a074ee7d83b251b1b1/ghc >--------------------------------------------------------------- commit 6e9c8eb9885f894eed7e01a074ee7d83b251b1b1 Author: Ryan Scott Date: Wed Aug 16 11:50:41 2017 -0400 Bump mtl, parsec, text submodules (again) We failed to add dist-install and dist-boot to .gitignore in the commits brought in via commit e054c5f06451def4437d9d770ae156f034796c59. This round of submodule commits should do the trick. >--------------------------------------------------------------- 6e9c8eb9885f894eed7e01a074ee7d83b251b1b1 libraries/mtl | 2 +- libraries/parsec | 2 +- libraries/text | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/libraries/mtl b/libraries/mtl index fc9578a..bf4af11 160000 --- a/libraries/mtl +++ b/libraries/mtl @@ -1 +1 @@ -Subproject commit fc9578af042d226a8abaccb33b2bb99c63736134 +Subproject commit bf4af114ba3d35b2937fc74926aa49e128dd6c1f diff --git a/libraries/parsec b/libraries/parsec index 36615b6..1c56e08 160000 --- a/libraries/parsec +++ b/libraries/parsec @@ -1 +1 @@ -Subproject commit 36615b6f8a52943eda663ece1d0f612a0a681acc +Subproject commit 1c56e0885173accbd3296aa5591a3e0c18084e7a diff --git a/libraries/text b/libraries/text index 315eb59..1707aa5 160000 --- a/libraries/text +++ b/libraries/text @@ -1 +1 @@ -Subproject commit 315eb59f2ae40f6330afb854a011ecafedf01165 +Subproject commit 1707aa5f2ad5c254c45ac9ffcac749e4d6b67a6e From git at git.haskell.org Wed Aug 16 18:55:58 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 16 Aug 2017 18:55:58 +0000 (UTC) Subject: [commit: ghc] wip/jenkins: testsuite/junit: Properly escape strings (d8dcaac) Message-ID: <20170816185558.0FFC83A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/jenkins Link : http://ghc.haskell.org/trac/ghc/changeset/d8dcaacbaaa7d40602eac6880626db0c6b3fb8d4/ghc >--------------------------------------------------------------- commit d8dcaacbaaa7d40602eac6880626db0c6b3fb8d4 Author: Ben Gamari Date: Mon Jul 31 11:36:49 2017 -0400 testsuite/junit: Properly escape strings >--------------------------------------------------------------- d8dcaacbaaa7d40602eac6880626db0c6b3fb8d4 testsuite/driver/junit.py | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/testsuite/driver/junit.py b/testsuite/driver/junit.py index f9689de..4015c19 100644 --- a/testsuite/driver/junit.py +++ b/testsuite/driver/junit.py @@ -1,5 +1,6 @@ from datetime import datetime import xml.etree.ElementTree as ET +from xml.sax.saxutils import escape def junit(t): testsuites = ET.Element('testsuites') @@ -18,21 +19,21 @@ def junit(t): classname = testname, name = way) result = ET.SubElement(testcase, 'failure', - type = reason, - message = result) + type = 'unexpected failure', + message = escape(reason)) for (directory, testname, reason, way) in t.framework_failures: testcase = ET.SubElement(testsuite, 'testcase', classname = testname, - name = way) + name = escape(way)) result = ET.SubElement(testcase, 'error', type = "framework failure", - message = reason) + message = escape(reason)) for (directory, testname, way) in t.expected_passes: testcase = ET.SubElement(testsuite, 'testcase', classname = testname, - name = way) + name = escape(way)) return ET.ElementTree(testsuites) From git at git.haskell.org Wed Aug 16 18:56:00 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 16 Aug 2017 18:56:00 +0000 (UTC) Subject: [commit: ghc] wip/jenkins: Fix junit output path (68bdd0f) Message-ID: <20170816185600.BE56B3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/jenkins Link : http://ghc.haskell.org/trac/ghc/changeset/68bdd0ff53e43a01db89af31db3ef124bc7a2ed6/ghc >--------------------------------------------------------------- commit 68bdd0ff53e43a01db89af31db3ef124bc7a2ed6 Author: Ben Gamari Date: Mon Jul 31 00:41:25 2017 -0400 Fix junit output path >--------------------------------------------------------------- 68bdd0ff53e43a01db89af31db3ef124bc7a2ed6 Jenkinsfile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Jenkinsfile b/Jenkinsfile index 7eac8ff..c86060c 100644 --- a/Jenkinsfile +++ b/Jenkinsfile @@ -302,7 +302,7 @@ def testGhc(params) { if (params.nightly) { target = 'slowtest' } - sh "${makeCmd} -Ctestsuite/tests LOCAL=0 BINDIST=YES THREADS=${env.THREADS} TEST_HC=\"${testGhc}\" JUNIT_FILE=testsuite.xml ${target}" + sh "${makeCmd} -Ctestsuite/tests LOCAL=0 BINDIST=YES THREADS=${env.THREADS} TEST_HC=\"${testGhc}\" JUNIT_FILE=../../testsuite.xml ${target}" junit 'testsuite.xml' } } From git at git.haskell.org Wed Aug 16 18:56:03 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 16 Aug 2017 18:56:03 +0000 (UTC) Subject: [commit: ghc] wip/jenkins: testsuite/junit: Flip type and message (90bf85b) Message-ID: <20170816185603.8E5083A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/jenkins Link : http://ghc.haskell.org/trac/ghc/changeset/90bf85bc5352fe99743651eb7ab5d270f6f260d0/ghc >--------------------------------------------------------------- commit 90bf85bc5352fe99743651eb7ab5d270f6f260d0 Author: Ben Gamari Date: Mon Jul 31 08:44:40 2017 -0400 testsuite/junit: Flip type and message type apparently can't contain < characters. >--------------------------------------------------------------- 90bf85bc5352fe99743651eb7ab5d270f6f260d0 testsuite/driver/junit.py | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/testsuite/driver/junit.py b/testsuite/driver/junit.py index 01a5f47..f9689de 100644 --- a/testsuite/driver/junit.py +++ b/testsuite/driver/junit.py @@ -18,8 +18,8 @@ def junit(t): classname = testname, name = way) result = ET.SubElement(testcase, 'failure', - type = result, - message = reason) + type = reason, + message = result) for (directory, testname, reason, way) in t.framework_failures: testcase = ET.SubElement(testsuite, 'testcase', From git at git.haskell.org Wed Aug 16 18:56:06 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 16 Aug 2017 18:56:06 +0000 (UTC) Subject: [commit: ghc] wip/jenkins: Fix JUnit (d284eef) Message-ID: <20170816185606.4AA493A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/jenkins Link : http://ghc.haskell.org/trac/ghc/changeset/d284eef77a0298443545784a1f09d24a1fb6058a/ghc >--------------------------------------------------------------- commit d284eef77a0298443545784a1f09d24a1fb6058a Author: Ben Gamari Date: Fri Jul 28 19:06:29 2017 -0400 Fix JUnit >--------------------------------------------------------------- d284eef77a0298443545784a1f09d24a1fb6058a Jenkinsfile | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Jenkinsfile b/Jenkinsfile index ee6a884..23b6ced 100644 --- a/Jenkinsfile +++ b/Jenkinsfile @@ -302,8 +302,8 @@ def testGhc(params) { if (params.nightly) { target = 'slowtest' } - sh "${makeCmd} -Ctestsuite/tests LOCAL=0 BINDIST=YES THREADS=${env.THREADS} TEST_HC=\"${testGhc}\" ${target}" - junit 'testsuite*.xml' + sh "${makeCmd} -Ctestsuite/tests LOCAL=0 BINDIST=YES THREADS=${env.THREADS} TEST_HC=\"${testGhc}\" JUNIT_FILE=testsuite.xml ${target}" + junit 'testsuite.xml' } } } From git at git.haskell.org Wed Aug 16 18:56:09 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 16 Aug 2017 18:56:09 +0000 (UTC) Subject: [commit: ghc] wip/jenkins: Fix whitespace (5806b4c) Message-ID: <20170816185609.1184B3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/jenkins Link : http://ghc.haskell.org/trac/ghc/changeset/5806b4c5108b726aa905375ae44d8625560d7fd7/ghc >--------------------------------------------------------------- commit 5806b4c5108b726aa905375ae44d8625560d7fd7 Author: Ben Gamari Date: Sun Jul 30 23:09:03 2017 -0400 Fix whitespace >--------------------------------------------------------------- 5806b4c5108b726aa905375ae44d8625560d7fd7 Jenkinsfile | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/Jenkinsfile b/Jenkinsfile index 23b6ced..8501f87 100644 --- a/Jenkinsfile +++ b/Jenkinsfile @@ -315,11 +315,11 @@ def nofib(params) { stage('Run nofib') { installPkgs(['regex-compat']) sh """ - cd nofib - ${makeCmd} clean - ${makeCmd} boot - ${makeCmd} >../nofib.log 2>&1 - """ + cd nofib + ${makeCmd} clean + ${makeCmd} boot + ${makeCmd} >../nofib.log 2>&1 + """ archiveArtifacts artifacts: 'nofib.log' } } From git at git.haskell.org Wed Aug 16 18:56:11 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 16 Aug 2017 18:56:11 +0000 (UTC) Subject: [commit: ghc] wip/jenkins: Bump GHC to 8.2.1 (6b3d695) Message-ID: <20170816185611.C2E053A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/jenkins Link : http://ghc.haskell.org/trac/ghc/changeset/6b3d6955536111d4c9120680843c5bd5d2ddb82a/ghc >--------------------------------------------------------------- commit 6b3d6955536111d4c9120680843c5bd5d2ddb82a Author: Ben Gamari Date: Sun Jul 30 23:09:12 2017 -0400 Bump GHC to 8.2.1 >--------------------------------------------------------------- 6b3d6955536111d4c9120680843c5bd5d2ddb82a Jenkinsfile | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Jenkinsfile b/Jenkinsfile index 8501f87..7eac8ff 100644 --- a/Jenkinsfile +++ b/Jenkinsfile @@ -119,11 +119,11 @@ def withMingw(String msystem, Closure f) { if (msystem == 'MINGW32') { prefix = "${msysRoot}\\mingw32" carch = 'i686' - ghcPath = "${home}/ghc-8.0.1-i386/bin" + ghcPath = "${home}/ghc-8.2.1-i386/bin" } else if (msystem == 'MINGW64') { prefix = "${msysRoot}\\mingw64" carch = 'x86_64' - ghcPath = "${home}/ghc-8.0.2-x86_64/bin" + ghcPath = "${home}/ghc-8.2.1-x86_64/bin" } else { fail } From git at git.haskell.org Wed Aug 16 18:56:15 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 16 Aug 2017 18:56:15 +0000 (UTC) Subject: [commit: ghc] wip/jenkins: Testing simpler Jenkinsfile (29a4b3d) Message-ID: <20170816185615.15D823A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/jenkins Link : http://ghc.haskell.org/trac/ghc/changeset/29a4b3d0e7ba30ea303b7e7a30f29c916d022edd/ghc >--------------------------------------------------------------- commit 29a4b3d0e7ba30ea303b7e7a30f29c916d022edd Author: Ben Gamari Date: Fri Apr 21 14:29:34 2017 -0400 Testing simpler Jenkinsfile >--------------------------------------------------------------- 29a4b3d0e7ba30ea303b7e7a30f29c916d022edd Jenkinsfile | 366 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Makefile | 4 + ghc.mk | 4 + mk/config.mk.in | 2 +- 4 files changed, 375 insertions(+), 1 deletion(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 29a4b3d0e7ba30ea303b7e7a30f29c916d022edd From git at git.haskell.org Wed Aug 16 18:56:17 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 16 Aug 2017 18:56:17 +0000 (UTC) Subject: [commit: ghc] wip/jenkins's head updated: testsuite/junit: Properly escape strings (d8dcaac) Message-ID: <20170816185617.F07EE3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/jenkins' now includes: 6e9c8eb Bump mtl, parsec, text submodules (again) 29a4b3d Testing simpler Jenkinsfile d284eef Fix JUnit 5806b4c Fix whitespace 6b3d695 Bump GHC to 8.2.1 68bdd0f Fix junit output path 90bf85b testsuite/junit: Flip type and message d8dcaac testsuite/junit: Properly escape strings From git at git.haskell.org Wed Aug 16 19:18:36 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 16 Aug 2017 19:18:36 +0000 (UTC) Subject: [commit: ghc] wip/rae: Test #14038 in dependent/should_compile/T14038 (a0c6a10) Message-ID: <20170816191836.365683A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/a0c6a10d74d7dbf36822aec75446664485cd5059/ghc >--------------------------------------------------------------- commit a0c6a10d74d7dbf36822aec75446664485cd5059 Author: Richard Eisenberg Date: Tue Aug 8 18:20:42 2017 -0400 Test #14038 in dependent/should_compile/T14038 >--------------------------------------------------------------- a0c6a10d74d7dbf36822aec75446664485cd5059 .../should_compile/T14038.hs} | 27 +++++++++++----------- testsuite/tests/dependent/should_compile/all.T | 1 + 2 files changed, 15 insertions(+), 13 deletions(-) diff --git a/testsuite/tests/indexed-types/should_fail/T13877.hs b/testsuite/tests/dependent/should_compile/T14038.hs similarity index 72% copy from testsuite/tests/indexed-types/should_fail/T13877.hs copy to testsuite/tests/dependent/should_compile/T14038.hs index ee5f16b..839220a 100644 --- a/testsuite/tests/indexed-types/should_fail/T13877.hs +++ b/testsuite/tests/dependent/should_compile/T14038.hs @@ -1,31 +1,32 @@ {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE Trustworthy #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeInType #-} {-# LANGUAGE TypeOperators #-} -module T13877 where +module T14038 where -import Data.Kind +import Data.Kind (Type) data family Sing (a :: k) data instance Sing (z :: [a]) where SNil :: Sing '[] SCons :: Sing x -> Sing xs -> Sing (x:xs) -data TyFun :: * -> * -> * -type a ~> b = TyFun a b -> * +data TyFun :: Type -> Type -> Type +type a ~> b = TyFun a b -> Type infixr 0 ~> type family Apply (f :: k1 ~> k2) (x :: k1) :: k2 type a @@ b = Apply a b infixl 9 @@ -data FunArrow = (:->) | (:~>) +data FunArrow = (:->) -- ^ '(->)' + | (:~>) -- ^ '(~>)' class FunType (arr :: FunArrow) where type Fun (k1 :: Type) arr (k2 :: Type) :: Type @@ -50,25 +51,25 @@ instance AppType (:~>) where infixr 0 -?> type (-?>) (k1 :: Type) (k2 :: Type) (arr :: FunArrow) = Fun k1 arr k2 -listElim :: forall (a :: Type) (p :: [a] -> Type) (l :: [a]). +elimList :: forall (a :: Type) (p :: [a] -> Type) (l :: [a]). Sing l -> p '[] -> (forall (x :: a) (xs :: [a]). Sing x -> Sing xs -> p xs -> p (x:xs)) -> p l -listElim = listElimPoly @(:->) @a @p @l +elimList = elimListPoly @(:->) -listElimTyFun :: forall (a :: Type) (p :: [a] ~> Type) (l :: [a]). +elimListTyFun :: forall (a :: Type) (p :: [a] ~> Type) (l :: [a]). Sing l -> p @@ '[] -> (forall (x :: a) (xs :: [a]). Sing x -> Sing xs -> p @@ xs -> p @@ (x:xs)) -> p @@ l -listElimTyFun = listElimPoly @(:->) @a @p @l +elimListTyFun = elimListPoly @(:~>) @_ @p -listElimPoly :: forall (arr :: FunArrow) (a :: Type) (p :: ([a] -?> Type) arr) (l :: [a]). +elimListPoly :: forall (arr :: FunArrow) (a :: Type) (p :: ([a] -?> Type) arr) (l :: [a]). FunApp arr => Sing l -> App [a] arr Type p '[] -> (forall (x :: a) (xs :: [a]). Sing x -> Sing xs -> App [a] arr Type p xs -> App [a] arr Type p (x:xs)) -> App [a] arr Type p l -listElimPoly SNil pNil _ = pNil -listElimPoly (SCons x (xs :: Sing xs)) pNil pCons = pCons x xs (listElimPoly @arr @a @p @xs xs pNil pCons) +elimListPoly SNil pNil _ = pNil +elimListPoly (SCons x (xs :: Sing xs)) pNil pCons = pCons x xs (elimListPoly @arr @a @p @xs xs pNil pCons) diff --git a/testsuite/tests/dependent/should_compile/all.T b/testsuite/tests/dependent/should_compile/all.T index b854f1d..a135892 100644 --- a/testsuite/tests/dependent/should_compile/all.T +++ b/testsuite/tests/dependent/should_compile/all.T @@ -25,3 +25,4 @@ test('T11966', normal, compile, ['']) test('T12442', normal, compile, ['']) test('T13538', normal, compile, ['']) test('T12176', normal, compile, ['']) +test('T14038', expect_broken(14038), compile, ['']) From git at git.haskell.org Wed Aug 16 19:18:39 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 16 Aug 2017 19:18:39 +0000 (UTC) Subject: [commit: ghc] wip/rae: Regression test for #12742 (ac03a73) Message-ID: <20170816191839.7AF5F3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/ac03a737058e8e9d8b08dfc504f926623d9f837d/ghc >--------------------------------------------------------------- commit ac03a737058e8e9d8b08dfc504f926623d9f837d Author: Richard Eisenberg Date: Tue Aug 15 14:52:53 2017 -0400 Regression test for #12742 Location: dependent/should_compile/T12742 >--------------------------------------------------------------- ac03a737058e8e9d8b08dfc504f926623d9f837d testsuite/tests/dependent/should_compile/T12742.hs | 11 +++++++++++ testsuite/tests/dependent/should_compile/all.T | 1 + 2 files changed, 12 insertions(+) diff --git a/testsuite/tests/dependent/should_compile/T12742.hs b/testsuite/tests/dependent/should_compile/T12742.hs new file mode 100644 index 0000000..baa3e2c --- /dev/null +++ b/testsuite/tests/dependent/should_compile/T12742.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE TypeInType, RankNTypes, TypeFamilies #-} + +module T12742 where + +import Data.Kind + +type family F :: forall k2. (k1, k2) + +data T :: (forall k2. (Bool, k2)) -> Type + +type S = T F diff --git a/testsuite/tests/dependent/should_compile/all.T b/testsuite/tests/dependent/should_compile/all.T index a135892..774cdce 100644 --- a/testsuite/tests/dependent/should_compile/all.T +++ b/testsuite/tests/dependent/should_compile/all.T @@ -26,3 +26,4 @@ test('T12442', normal, compile, ['']) test('T13538', normal, compile, ['']) test('T12176', normal, compile, ['']) test('T14038', expect_broken(14038), compile, ['']) +test('T12742', normal, compile, ['']) From git at git.haskell.org Wed Aug 16 19:18:42 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 16 Aug 2017 19:18:42 +0000 (UTC) Subject: [commit: ghc] wip/rae: Test #12938 in indexed-types/should_compile/T12938 (763d153) Message-ID: <20170816191842.AB3973A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/763d153bde8e756f87a87bce8224b1043074a08a/ghc >--------------------------------------------------------------- commit 763d153bde8e756f87a87bce8224b1043074a08a Author: Richard Eisenberg Date: Tue Aug 15 14:56:31 2017 -0400 Test #12938 in indexed-types/should_compile/T12938 >--------------------------------------------------------------- 763d153bde8e756f87a87bce8224b1043074a08a testsuite/tests/indexed-types/should_compile/T12938.hs | 8 ++++++++ testsuite/tests/indexed-types/should_compile/all.T | 1 + 2 files changed, 9 insertions(+) diff --git a/testsuite/tests/indexed-types/should_compile/T12938.hs b/testsuite/tests/indexed-types/should_compile/T12938.hs new file mode 100644 index 0000000..1c8f47e --- /dev/null +++ b/testsuite/tests/indexed-types/should_compile/T12938.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE TypeInType, TypeFamilies #-} + +module Bug where + +import GHC.Exts + +class HasRep a where + type Rep a :: TYPE r diff --git a/testsuite/tests/indexed-types/should_compile/all.T b/testsuite/tests/indexed-types/should_compile/all.T index 359e7d5..9014423 100644 --- a/testsuite/tests/indexed-types/should_compile/all.T +++ b/testsuite/tests/indexed-types/should_compile/all.T @@ -267,3 +267,4 @@ test('T13662', normal, compile, ['']) test('T13705', normal, compile, ['']) test('T12369', normal, compile, ['']) test('T14045', normal, compile, ['']) +test('T12938', normal, compile, ['']) From git at git.haskell.org Wed Aug 16 19:18:49 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 16 Aug 2017 19:18:49 +0000 (UTC) Subject: [commit: ghc] wip/rae: Fix #13909 by tweaking an error message. (f5e7cf0) Message-ID: <20170816191849.7BB203A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/f5e7cf0c64006523c8c71ee18bf6c84c31aec329/ghc >--------------------------------------------------------------- commit f5e7cf0c64006523c8c71ee18bf6c84c31aec329 Author: Richard Eisenberg Date: Tue Aug 15 19:07:59 2017 -0400 Fix #13909 by tweaking an error message. GHC was complaining about numbers of arguments when the real problem is impredicativity. test case: typecheck/should_fail/T13909 >--------------------------------------------------------------- f5e7cf0c64006523c8c71ee18bf6c84c31aec329 compiler/typecheck/TcErrors.hs | 7 ++++++- testsuite/tests/typecheck/should_fail/T13909.hs | 12 ++++++++++++ testsuite/tests/typecheck/should_fail/T13909.stderr | 5 +++++ testsuite/tests/typecheck/should_fail/all.T | 1 + 4 files changed, 24 insertions(+), 1 deletion(-) diff --git a/compiler/typecheck/TcErrors.hs b/compiler/typecheck/TcErrors.hs index 3aa5dd8..325c837 100644 --- a/compiler/typecheck/TcErrors.hs +++ b/compiler/typecheck/TcErrors.hs @@ -2015,8 +2015,11 @@ mkExpectedActualMsg ty1 ty2 (TypeEqOrigin { uo_actual = act | otherwise = text "kind" <+> quotes (ppr exp) num_args_msg = case level of - TypeLevel -> Nothing KindLevel + | not (isMetaTyVarTy exp) && not (isMetaTyVarTy act) + -- if one is a meta-tyvar, then it's possible that the user + -- has asked for something impredicative, and we couldn't unify. + -- Don't bother with counting arguments. -> let n_act = count_args act n_exp = count_args exp in case n_act - n_exp of @@ -2031,6 +2034,8 @@ mkExpectedActualMsg ty1 ty2 (TypeEqOrigin { uo_actual = act | otherwise = text "more arguments to" -- n > 1 _ -> Nothing + _ -> Nothing + maybe_num_args_msg = case num_args_msg of Nothing -> empty Just m -> m diff --git a/testsuite/tests/typecheck/should_fail/T13909.hs b/testsuite/tests/typecheck/should_fail/T13909.hs new file mode 100644 index 0000000..4f0cbdc --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T13909.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE TypeInType #-} +module T13909 where + +import Data.Kind + +data Hm (k :: Type) (a :: k) :: Type + +class HasName (a :: k) where + getName :: proxy a -> String + +instance HasName Hm where + getName _ = "Hm" diff --git a/testsuite/tests/typecheck/should_fail/T13909.stderr b/testsuite/tests/typecheck/should_fail/T13909.stderr new file mode 100644 index 0000000..599be5a --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T13909.stderr @@ -0,0 +1,5 @@ + +T13909.hs:11:18: error: + • Expected kind ‘k0’, but ‘Hm’ has kind ‘forall k -> k -> *’ + • In the first argument of ‘HasName’, namely ‘Hm’ + In the instance declaration for ‘HasName Hm’ diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T index d865c76..7127a5d 100644 --- a/testsuite/tests/typecheck/should_fail/all.T +++ b/testsuite/tests/typecheck/should_fail/all.T @@ -454,3 +454,4 @@ test('T13819', normal, compile_fail, ['']) test('T11963', normal, compile_fail, ['']) test('T14000', normal, compile_fail, ['']) test('T14055', normal, compile_fail, ['']) +test('T13909', normal, compile_fail, ['']) From git at git.haskell.org Wed Aug 16 19:18:52 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 16 Aug 2017 19:18:52 +0000 (UTC) Subject: [commit: ghc] wip/rae: Fix #13399 by documenting higher-rank kinds. (3062e95) Message-ID: <20170816191852.3D35C3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/3062e9553c9d1f0446d5ae6c475ce188d423a8f2/ghc >--------------------------------------------------------------- commit 3062e9553c9d1f0446d5ae6c475ce188d423a8f2 Author: Richard Eisenberg Date: Tue Aug 15 17:47:31 2017 -0400 Fix #13399 by documenting higher-rank kinds. >--------------------------------------------------------------- 3062e9553c9d1f0446d5ae6c475ce188d423a8f2 docs/users_guide/glasgow_exts.rst | 39 +++++++++++++++++++++++++++++++++++++++ 1 file changed, 39 insertions(+) diff --git a/docs/users_guide/glasgow_exts.rst b/docs/users_guide/glasgow_exts.rst index 378beb2..3444ca7 100644 --- a/docs/users_guide/glasgow_exts.rst +++ b/docs/users_guide/glasgow_exts.rst @@ -8313,6 +8313,45 @@ It is thus only possible to use this feature if you have provided a complete user-supplied kind signature for the datatype (:ref:`complete-kind-signatures`). +Higher-rank kinds +----------------- + +In concert with :ghc-flag:`-XRankNTypes`, GHC supports higher-rank kinds. +Here is an example:: + + -- Heterogeneous propositional equality + data (a :: k1) :~~: (b :: k2) where + HRefl :: a :~~: a + + class HTestEquality (t :: forall k. k -> Type) where + hTestEquality :: forall k1 k2 (a :: k1) (b :: k2). t a -> t b -> Maybe (a :~~: b) + +Note that ``hTestEquality`` takes two arguments where the type variable ``t`` is applied +to types of different kinds. That type variable must then be polykinded. Accordingly, +the kind of ``HTestEquality`` (the class) is ``(forall k. k -> Type) -> Constraint``, +a higher-rank kind. + +A big difference with higher-rank kinds as compared with higher-rank types is that +``forall``\s in kinds *cannot* be moved. This is best illustrated by example. +Suppose we want to have an instance of ``HTestEquality`` for ``(:~~:)``. :: + + instance HTestEquality ((:~~:) a) where + hTestEquality HRefl HRefl = Just HRefl + +With the declaration of ``(:~~:)`` above, it gets kind ``forall k1 k2. k1 -> k2 -> Type``. +Thus, the type ``(:~~:) a`` has kind ``k2 -> Type`` for some ``k2``. GHC cannot +then *regeneralize* this kind to become ``forall k2. k2 -> Type`` as desired. Thus, the +instance is rejected as ill-kinded. + +To allow for such an instance, we would have to define ``(:~~:)`` as follows:: + + data (:~~:) :: forall k1. k1 -> forall k2. k2 -> Type where + HRefl :: a :~~: a + +In this redefinition, we give an explicit kind for ``(:~~:)``, deferring the choice +of ``k2`` until after the first argument (``a``) has been given. With this declaration +for ``(:~~:)``, the instance for ``HTestEquality`` is accepted. + Constraints in kinds -------------------- From git at git.haskell.org Wed Aug 16 19:18:46 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 16 Aug 2017 19:18:46 +0000 (UTC) Subject: [commit: ghc] wip/rae: Fix #13391 by checking for kind-GADTs (75fedb8) Message-ID: <20170816191846.2ABDC3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/75fedb89688808b9bf0d1516e0b90cf2e1d0b20b/ghc >--------------------------------------------------------------- commit 75fedb89688808b9bf0d1516e0b90cf2e1d0b20b Author: Richard Eisenberg Date: Tue Aug 15 17:22:50 2017 -0400 Fix #13391 by checking for kind-GADTs The check is a bit gnarly, but I couldn't think of a better way. See the new code in TcTyClsDecls. test case: polykinds/T13391 >--------------------------------------------------------------- 75fedb89688808b9bf0d1516e0b90cf2e1d0b20b compiler/basicTypes/DataCon.hs | 2 ++ compiler/typecheck/TcTyClsDecls.hs | 29 ++++++++++++++++++++++ .../should_compile/Dep2.hs => polykinds/T13391.hs} | 6 ++--- testsuite/tests/polykinds/T13391.stderr | 7 ++++++ testsuite/tests/polykinds/all.T | 1 + 5 files changed, 42 insertions(+), 3 deletions(-) diff --git a/compiler/basicTypes/DataCon.hs b/compiler/basicTypes/DataCon.hs index fa8e0a8..06bb504 100644 --- a/compiler/basicTypes/DataCon.hs +++ b/compiler/basicTypes/DataCon.hs @@ -310,6 +310,8 @@ data DataCon -- Universally-quantified type vars [a,b,c] -- INVARIANT: length matches arity of the dcRepTyCon -- INVARIANT: result type of data con worker is exactly (T a b c) + -- COROLLARY: The dcUnivTyVars are always in one-to-one correspondence with + -- the tyConTyVars of the parent TyCon dcUnivTyVars :: [TyVarBinder], -- Existentially-quantified type vars [x,y] diff --git a/compiler/typecheck/TcTyClsDecls.hs b/compiler/typecheck/TcTyClsDecls.hs index ba35db5..a944e09 100644 --- a/compiler/typecheck/TcTyClsDecls.hs +++ b/compiler/typecheck/TcTyClsDecls.hs @@ -2492,6 +2492,26 @@ checkValidDataCon dflags existential_ok tc con ; checkTc (existential_ok || isVanillaDataCon con) (badExistential con) + ; typeintype <- xoptM LangExt.TypeInType + ; let invisible_gadt_eq_specs = filter is_invisible_eq_spec (dataConEqSpec con) + univ_tvs = dataConUnivTyVars con + tc_bndrs = tyConBinders tc + + -- find the index of the univ tv mentioned in the eq_spec + -- then, look that up in the TyConBinders to see if it's visible + -- Maybe there's a better way, but I don't see it. + -- See Note [Wrong visibility for GADTs], though. + is_invisible_eq_spec eq_spec + = let eq_tv = eqSpecTyVar eq_spec + tv_index = expectJust "checkValidDataCon" $ + elemIndex eq_tv univ_tvs + tc_bndr = tc_bndrs `getNth` tv_index + in + isInvisibleTyConBinder tc_bndr + + ; checkTc (typeintype || null invisible_gadt_eq_specs) + (badGADT con invisible_gadt_eq_specs) + -- Check that UNPACK pragmas and bangs work out -- E.g. reject data T = MkT {-# UNPACK #-} Int -- No "!" -- data T = MkT {-# UNPACK #-} !a -- Can't unpack @@ -3154,6 +3174,15 @@ badExistential con 2 (vcat [ ppr con <+> dcolon <+> ppr (dataConUserType con) , parens $ text "Use ExistentialQuantification or GADTs to allow this" ]) +badGADT :: DataCon -> [EqSpec] -> SDoc +badGADT con eq_specs + = hang (text "Data constructor" <+> quotes (ppr con) <+> + text "constrains the choice of kind parameter" <> plural eq_specs <> colon) + 2 (vcat (map ppr_eq_spec eq_specs)) $$ + text "Use TypeInType to allow this" + where + ppr_eq_spec eq_spec = ppr (eqSpecTyVar eq_spec) <+> char '~' <+> ppr (eqSpecType eq_spec) + badStupidTheta :: Name -> SDoc badStupidTheta tc_name = text "A data type declared in GADT style cannot have a context:" <+> quotes (ppr tc_name) diff --git a/testsuite/tests/dependent/should_compile/Dep2.hs b/testsuite/tests/polykinds/T13391.hs similarity index 50% copy from testsuite/tests/dependent/should_compile/Dep2.hs copy to testsuite/tests/polykinds/T13391.hs index 34be3cf..6de3c3a 100644 --- a/testsuite/tests/dependent/should_compile/Dep2.hs +++ b/testsuite/tests/polykinds/T13391.hs @@ -1,7 +1,7 @@ {-# LANGUAGE PolyKinds, GADTs #-} -module Dep2 where +module T13391 where data G (a :: k) where - G1 :: G Int - G2 :: G Maybe + GInt :: G Int + GMaybe :: G Maybe diff --git a/testsuite/tests/polykinds/T13391.stderr b/testsuite/tests/polykinds/T13391.stderr new file mode 100644 index 0000000..55fff35 --- /dev/null +++ b/testsuite/tests/polykinds/T13391.stderr @@ -0,0 +1,7 @@ + +T13391.hs:6:3: error: + • Data constructor ‘GInt’ constrains the choice of kind parameter: + k ~ * + Use TypeInType to allow this + • In the definition of data constructor ‘GInt’ + In the data type declaration for ‘G’ diff --git a/testsuite/tests/polykinds/all.T b/testsuite/tests/polykinds/all.T index 900faca..ebe5f85 100644 --- a/testsuite/tests/polykinds/all.T +++ b/testsuite/tests/polykinds/all.T @@ -163,3 +163,4 @@ test('T13393', normal, compile_fail, ['']) test('T13555', normal, compile_fail, ['']) test('T13659', normal, compile_fail, ['']) test('T13625', normal, compile_fail, ['']) +test('T13391', normal, compile_fail, ['']) From git at git.haskell.org Wed Aug 16 19:18:58 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 16 Aug 2017 19:18:58 +0000 (UTC) Subject: [commit: ghc] wip/rae: Fix #13407 by suppressing invisibles better. (c93e798) Message-ID: <20170816191858.832F63A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/c93e7981bc1f8c1de1d1200301ea876aaddb1631/ghc >--------------------------------------------------------------- commit c93e7981bc1f8c1de1d1200301ea876aaddb1631 Author: Richard Eisenberg Date: Tue Aug 15 18:04:32 2017 -0400 Fix #13407 by suppressing invisibles better. Previously, the iface-invisible-suppresser assumed that all invisible things are up front. Not true! test case: ghci/scripts/T13407 >--------------------------------------------------------------- c93e7981bc1f8c1de1d1200301ea876aaddb1631 compiler/iface/IfaceType.hs | 6 +++--- testsuite/tests/ghci/scripts/T13407.script | 4 ++++ testsuite/tests/ghci/scripts/T13407.stdout | 3 +++ testsuite/tests/ghci/scripts/all.T | 1 + 4 files changed, 11 insertions(+), 3 deletions(-) diff --git a/compiler/iface/IfaceType.hs b/compiler/iface/IfaceType.hs index b1ad780..c7405b3 100644 --- a/compiler/iface/IfaceType.hs +++ b/compiler/iface/IfaceType.hs @@ -321,9 +321,9 @@ suppressIfaceInvisibles dflags tys xs where suppress _ [] = [] suppress [] a = a - suppress (k:ks) a@(_:xs) - | isInvisibleTyConBinder k = suppress ks xs - | otherwise = a + suppress (k:ks) (x:xs) + | isInvisibleTyConBinder k = suppress ks xs + | otherwise = x : suppress ks xs stripIfaceInvisVars :: DynFlags -> [IfaceTyConBinder] -> [IfaceTyConBinder] stripIfaceInvisVars dflags tyvars diff --git a/testsuite/tests/ghci/scripts/T13407.script b/testsuite/tests/ghci/scripts/T13407.script new file mode 100644 index 0000000..f77fd42 --- /dev/null +++ b/testsuite/tests/ghci/scripts/T13407.script @@ -0,0 +1,4 @@ +:set -XTypeInType -XRankNTypes +import Data.Kind +data Foo :: (* -> *) -> (forall k. k -> *) +:info Foo diff --git a/testsuite/tests/ghci/scripts/T13407.stdout b/testsuite/tests/ghci/scripts/T13407.stdout new file mode 100644 index 0000000..7607413 --- /dev/null +++ b/testsuite/tests/ghci/scripts/T13407.stdout @@ -0,0 +1,3 @@ +type role Foo phantom phantom +data Foo (a :: * -> *) (c :: k) + -- Defined at :3:1 diff --git a/testsuite/tests/ghci/scripts/all.T b/testsuite/tests/ghci/scripts/all.T index 1f4e5b1..0861b70 100755 --- a/testsuite/tests/ghci/scripts/all.T +++ b/testsuite/tests/ghci/scripts/all.T @@ -256,3 +256,4 @@ test('T13466', normal, ghci_script, ['T13466.script']) test('GhciCurDir', normal, ghci_script, ['GhciCurDir.script']) test('T13591', expect_broken(13591), ghci_script, ['T13591.script']) test('T13699', normal, ghci_script, ['T13699.script']) +test('T13407', normal, ghci_script, ['T13407.script']) From git at git.haskell.org Wed Aug 16 19:18:55 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 16 Aug 2017 19:18:55 +0000 (UTC) Subject: [commit: ghc] wip/rae: Make rejigConRes do kind substitutions (1617cab) Message-ID: <20170816191855.546683A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/1617cab3edc84d2ce26c1d57611f00f4ee5c054f/ghc >--------------------------------------------------------------- commit 1617cab3edc84d2ce26c1d57611f00f4ee5c054f Author: Richard Eisenberg Date: Wed Aug 16 10:43:41 2017 -0400 Make rejigConRes do kind substitutions This was a lurking bug discovered on the hunt for #13910, but it doesn't fix that bug. The old version of rejigConRes was just wrong, forgetting to propagate a kind-change. >--------------------------------------------------------------- 1617cab3edc84d2ce26c1d57611f00f4ee5c054f compiler/typecheck/TcTyClsDecls.hs | 3 +- compiler/types/Type.hs | 3 +- testsuite/tests/dependent/should_compile/T13910.hs | 147 +++++++++++++++++++++ testsuite/tests/dependent/should_compile/all.T | 1 + 4 files changed, 152 insertions(+), 2 deletions(-) diff --git a/compiler/typecheck/TcTyClsDecls.hs b/compiler/typecheck/TcTyClsDecls.hs index a944e09..3996754 100644 --- a/compiler/typecheck/TcTyClsDecls.hs +++ b/compiler/typecheck/TcTyClsDecls.hs @@ -2165,7 +2165,8 @@ mkGADTVars tmpl_tvs dc_tvs subst -- not a simple substitution. make an equality predicate _ -> choose (t_tv':univs) (mkEqSpec t_tv' r_ty : eqs) - t_sub r_sub t_tvs + (extendTvSubst t_sub t_tv (mkTyVarTy t_tv')) + r_sub t_tvs where t_tv' = updateTyVarKind (substTy t_sub) t_tv | otherwise diff --git a/compiler/types/Type.hs b/compiler/types/Type.hs index f43e0e0..49e12ba 100644 --- a/compiler/types/Type.hs +++ b/compiler/types/Type.hs @@ -1121,7 +1121,8 @@ repSplitTyConApp_maybe (FunTy arg res) = Just (funTyCon, [rep1, rep2, arg, res]) | otherwise = pprPanic "repSplitTyConApp_maybe" - (ppr arg $$ ppr res $$ ppr (typeKind res)) + (ppr arg <+> dcolon <+> ppr (typeKind arg) $$ + ppr res <+> dcolon <+> ppr (typeKind res)) repSplitTyConApp_maybe _ = Nothing -- | Attempts to tease a list type apart and gives the type of the elements if diff --git a/testsuite/tests/dependent/should_compile/T13910.hs b/testsuite/tests/dependent/should_compile/T13910.hs new file mode 100644 index 0000000..82d47e4 --- /dev/null +++ b/testsuite/tests/dependent/should_compile/T13910.hs @@ -0,0 +1,147 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE Trustworthy #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilyDependencies #-} +{-# LANGUAGE TypeInType #-} +{-# LANGUAGE TypeOperators #-} +module T13910 where + +import Data.Kind +import Data.Type.Equality + +data family Sing (a :: k) + +class SingKind k where + type Demote k = (r :: *) | r -> k + fromSing :: Sing (a :: k) -> Demote k + toSing :: Demote k -> SomeSing k + +data SomeSing k where + SomeSing :: Sing (a :: k) -> SomeSing k + +withSomeSing :: forall k r + . SingKind k + => Demote k + -> (forall (a :: k). Sing a -> r) + -> r +withSomeSing x f = + case toSing x of + SomeSing x' -> f x' + +data TyFun :: * -> * -> * +type a ~> b = TyFun a b -> * +infixr 0 ~> + +type family Apply (f :: k1 ~> k2) (x :: k1) :: k2 +type a @@ b = Apply a b +infixl 9 @@ + +data FunArrow = (:->) | (:~>) + +class FunType (arr :: FunArrow) where + type Fun (k1 :: Type) arr (k2 :: Type) :: Type + +class FunType arr => AppType (arr :: FunArrow) where + type App k1 arr k2 (f :: Fun k1 arr k2) (x :: k1) :: k2 + +type FunApp arr = (FunType arr, AppType arr) + +instance FunType (:->) where + type Fun k1 (:->) k2 = k1 -> k2 + +$(return []) -- This is only necessary for GHC 8.0 -- GHC 8.2 is smarter + +instance AppType (:->) where + type App k1 (:->) k2 (f :: k1 -> k2) x = f x + +instance FunType (:~>) where + type Fun k1 (:~>) k2 = k1 ~> k2 + +$(return []) + +instance AppType (:~>) where + type App k1 (:~>) k2 (f :: k1 ~> k2) x = f @@ x + +infixr 0 -?> +type (-?>) (k1 :: Type) (k2 :: Type) (arr :: FunArrow) = Fun k1 arr k2 + +data instance Sing (z :: a :~: b) where + SRefl :: Sing Refl + +instance SingKind (a :~: b) where + type Demote (a :~: b) = a :~: b + fromSing SRefl = Refl + toSing Refl = SomeSing SRefl + +(~>:~:) :: forall (k :: Type) (a :: k) (b :: k) (r :: a :~: b) (p :: forall (y :: k). a :~: y ~> Type). + Sing r + -> p @@ Refl + -> p @@ r +(~>:~:) SRefl pRefl = pRefl + +type WhyReplacePoly (arr :: FunArrow) (from :: t) (p :: (t -?> Type) arr) + (y :: t) (e :: from :~: y) = App t arr Type p y +data WhyReplacePolySym (arr :: FunArrow) (from :: t) (p :: (t -?> Type) arr) + :: forall (y :: t). from :~: y ~> Type +type instance Apply (WhyReplacePolySym arr from p :: from :~: y ~> Type) x + = WhyReplacePoly arr from p y x + +replace :: forall (t :: Type) (from :: t) (to :: t) (p :: t -> Type). + p from + -> from :~: to + -> p to +replace = replacePoly @(:->) + +replaceTyFun :: forall (t :: Type) (from :: t) (to :: t) (p :: t ~> Type). + p @@ from + -> from :~: to + -> p @@ to +replaceTyFun = replacePoly @(:~>) @_ @_ @_ @p + +replacePoly :: forall (arr :: FunArrow) (t :: Type) (from :: t) (to :: t) + (p :: (t -?> Type) arr). + FunApp arr + => App t arr Type p from + -> from :~: to + -> App t arr Type p to +replacePoly from eq = + withSomeSing eq $ \(singEq :: Sing r) -> + (~>:~:) @t @from @to @r @(WhyReplacePolySym arr from p) singEq from + +type WhyLeibnizPoly (arr :: FunArrow) (f :: (t -?> Type) arr) (a :: t) (z :: t) + = App t arr Type f a -> App t arr Type f z +data WhyLeibnizPolySym (arr :: FunArrow) (f :: (t -?> Type) arr) (a :: t) + :: t ~> Type +type instance Apply (WhyLeibnizPolySym arr f a) z = WhyLeibnizPoly arr f a z + +leibnizPoly :: forall (arr :: FunArrow) (t :: Type) (f :: (t -?> Type) arr) + (a :: t) (b :: t). + FunApp arr + => a :~: b + -> App t arr Type f a + -> App t arr Type f b +leibnizPoly = replaceTyFun @t @a @b @(WhyLeibnizPolySym arr f a) id + +leibniz :: forall (t :: Type) (f :: t -> Type) (a :: t) (b :: t). + a :~: b + -> f a + -> f b +leibniz = replaceTyFun @t @a @b @(WhyLeibnizPolySym (:->) f a) id +-- The line above is what you get if you inline the definition of leibnizPoly. +-- It causes a panic, however. +-- +-- An equivalent implementation is commented out below, which does *not* +-- cause GHC to panic. +-- +-- leibniz = leibnizPoly @(:->) + +leibnizTyFun :: forall (t :: Type) (f :: t ~> Type) (a :: t) (b :: t). + a :~: b + -> f @@ a + -> f @@ b +leibnizTyFun = leibnizPoly @(:~>) @_ @f diff --git a/testsuite/tests/dependent/should_compile/all.T b/testsuite/tests/dependent/should_compile/all.T index 774cdce..bb21df7 100644 --- a/testsuite/tests/dependent/should_compile/all.T +++ b/testsuite/tests/dependent/should_compile/all.T @@ -27,3 +27,4 @@ test('T13538', normal, compile, ['']) test('T12176', normal, compile, ['']) test('T14038', expect_broken(14038), compile, ['']) test('T12742', normal, compile, ['']) +test('T13910', expect_broken(13910), compile, ['']) From git at git.haskell.org Wed Aug 16 19:19:02 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 16 Aug 2017 19:19:02 +0000 (UTC) Subject: [commit: ghc] wip/rae: Fix #13929 by adding another levity polymorphism check (483bb2b) Message-ID: <20170816191902.153F13A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/483bb2b1f45895fa983a9b5c2f2060abae576655/ghc >--------------------------------------------------------------- commit 483bb2b1f45895fa983a9b5c2f2060abae576655 Author: Richard Eisenberg Date: Wed Aug 16 11:35:26 2017 -0400 Fix #13929 by adding another levity polymorphism check test case: typecheck/should_fail/T13929 >--------------------------------------------------------------- 483bb2b1f45895fa983a9b5c2f2060abae576655 compiler/deSugar/DsExpr.hs | 9 +++--- testsuite/tests/typecheck/should_compile/all.T | 1 + testsuite/tests/typecheck/should_fail/T13929.hs | 32 ++++++++++++++++++++++ .../tests/typecheck/should_fail/T13929.stderr | 12 ++++++++ testsuite/tests/typecheck/should_fail/all.T | 1 + 5 files changed, 50 insertions(+), 5 deletions(-) diff --git a/compiler/deSugar/DsExpr.hs b/compiler/deSugar/DsExpr.hs index 048d558..853c42d 100644 --- a/compiler/deSugar/DsExpr.hs +++ b/compiler/deSugar/DsExpr.hs @@ -368,14 +368,13 @@ ds_expr _ (ExplicitTuple tup_args boxity) go (lam_vars, args) (L _ (Present expr)) -- Expressions that are present don't generate -- lambdas, just arguments. - = do { core_expr <- dsLExpr expr + = do { core_expr <- dsLExprNoLP expr ; return (lam_vars, core_expr : args) } - ; (lam_vars, args) <- foldM go ([], []) (reverse tup_args) + ; dsWhenNoErrs (foldM go ([], []) (reverse tup_args)) -- The reverse is because foldM goes left-to-right - - ; return $ mkCoreLams lam_vars $ - mkCoreTupBoxity boxity args } + (\(lam_vars, args) -> mkCoreLams lam_vars $ + mkCoreTupBoxity boxity args) } ds_expr _ (ExplicitSum alt arity expr types) = do { core_expr <- dsLExpr expr diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index c18c73b..0eb73ef 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -571,3 +571,4 @@ test('T13881', normal, compile, ['']) test('T13915a', normal, multimod_compile, ['T13915a', '-v0']) test('T13915b', normal, compile, ['']) test('T13984', normal, compile, ['']) +test('T13643', normal, compile, ['']) diff --git a/testsuite/tests/typecheck/should_fail/T13929.hs b/testsuite/tests/typecheck/should_fail/T13929.hs new file mode 100644 index 0000000..f0a026d --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T13929.hs @@ -0,0 +1,32 @@ +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeInType #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DefaultSignatures #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE AllowAmbiguousTypes #-} + +module Main where + +import GHC.Exts +import Data.Kind +import GHC.Generics + +class GUnbox (f :: Type -> Type) (r :: RuntimeRep) where + type GUnboxed f r :: TYPE r + gunbox :: f p -> GUnboxed f r + +instance (GUnbox f rf, GUnbox g rg) => GUnbox (f :*: g) ('TupleRep '[rf, rg]) where + type GUnboxed (f :*: g) ('TupleRep '[rf, rg]) = (# GUnboxed f rf, GUnboxed g rg #) + -- if I remove implementation of `gunbox` it compiles successfully + gunbox (x :*: y) = (# gunbox x, gunbox y #) + +main :: IO () +main = pure () diff --git a/testsuite/tests/typecheck/should_fail/T13929.stderr b/testsuite/tests/typecheck/should_fail/T13929.stderr new file mode 100644 index 0000000..3ddf5b3 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T13929.stderr @@ -0,0 +1,12 @@ + +T13929.hs:29:27: error: + A levity-polymorphic type is not allowed here: + Type: GUnboxed f rf + Kind: TYPE rf + In the type of expression: gunbox x + +T13929.hs:29:37: error: + A levity-polymorphic type is not allowed here: + Type: GUnboxed g rg + Kind: TYPE rg + In the type of expression: gunbox y diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T index 7127a5d..a28daa5 100644 --- a/testsuite/tests/typecheck/should_fail/all.T +++ b/testsuite/tests/typecheck/should_fail/all.T @@ -455,3 +455,4 @@ test('T11963', normal, compile_fail, ['']) test('T14000', normal, compile_fail, ['']) test('T14055', normal, compile_fail, ['']) test('T13909', normal, compile_fail, ['']) +test('T13929', normal, compile_fail, ['']) From git at git.haskell.org Wed Aug 16 19:19:05 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 16 Aug 2017 19:19:05 +0000 (UTC) Subject: [commit: ghc] wip/rae: Test #13938, with expect_broken (59e7fa5) Message-ID: <20170816191905.201503A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/59e7fa57d9460ed0e2cd965bc485154f1850c891/ghc >--------------------------------------------------------------- commit 59e7fa57d9460ed0e2cd965bc485154f1850c891 Author: Richard Eisenberg Date: Wed Aug 16 11:49:49 2017 -0400 Test #13938, with expect_broken test case: dependent/should_compile/T13938 >--------------------------------------------------------------- 59e7fa57d9460ed0e2cd965bc485154f1850c891 testsuite/tests/dependent/should_compile/{T14038.hs => T13938.hs} | 7 ++++++- testsuite/tests/dependent/should_compile/all.T | 1 + 2 files changed, 7 insertions(+), 1 deletion(-) diff --git a/testsuite/tests/dependent/should_compile/T14038.hs b/testsuite/tests/dependent/should_compile/T13938.hs similarity index 94% copy from testsuite/tests/dependent/should_compile/T14038.hs copy to testsuite/tests/dependent/should_compile/T13938.hs index 839220a..3ba9e27 100644 --- a/testsuite/tests/dependent/should_compile/T14038.hs +++ b/testsuite/tests/dependent/should_compile/T13938.hs @@ -4,11 +4,12 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeInType #-} {-# LANGUAGE TypeOperators #-} -module T14038 where +module T13938 where import Data.Kind (Type) @@ -39,12 +40,16 @@ type FunApp arr = (FunType arr, AppType arr) instance FunType (:->) where type Fun k1 (:->) k2 = k1 -> k2 +$(return []) -- This is only necessary for GHC 8.0 -- GHC 8.2 is smarter + instance AppType (:->) where type App k1 (:->) k2 (f :: k1 -> k2) x = f x instance FunType (:~>) where type Fun k1 (:~>) k2 = k1 ~> k2 +$(return []) + instance AppType (:~>) where type App k1 (:~>) k2 (f :: k1 ~> k2) x = f @@ x diff --git a/testsuite/tests/dependent/should_compile/all.T b/testsuite/tests/dependent/should_compile/all.T index bb21df7..a120bec 100644 --- a/testsuite/tests/dependent/should_compile/all.T +++ b/testsuite/tests/dependent/should_compile/all.T @@ -28,3 +28,4 @@ test('T12176', normal, compile, ['']) test('T14038', expect_broken(14038), compile, ['']) test('T12742', normal, compile, ['']) test('T13910', expect_broken(13910), compile, ['']) +test('T13938', normal, compile, ['']) From git at git.haskell.org Wed Aug 16 19:19:08 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 16 Aug 2017 19:19:08 +0000 (UTC) Subject: [commit: ghc] wip/rae: Fix egregious duplication of vars in RnTypes (7069a5d) Message-ID: <20170816191908.85ED43A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/7069a5d9ca54a5c876f401c0ffb9339868775a2a/ghc >--------------------------------------------------------------- commit 7069a5d9ca54a5c876f401c0ffb9339868775a2a Author: Richard Eisenberg Date: Wed Aug 16 15:07:16 2017 -0400 Fix egregious duplication of vars in RnTypes RnTypes contains a fairly intricate algorith to extract the kind and type variables of an HsType. This algorithm carefully maintains the separation between type variables and kind variables so that the difference between -XPolyKinds and -XTypeInType can be respected. But it stupidly just concatenated the lists at the end. If a variable were used as both a type and a kind, the algorithm would produce *both*! This led to all kinds of problems, including #13988. test case: ghci/scripts/T13988 >--------------------------------------------------------------- 7069a5d9ca54a5c876f401c0ffb9339868775a2a compiler/rename/RnTypes.hs | 11 ++++++----- testsuite/tests/ghci/scripts/T13988.hs | 8 ++++++++ testsuite/tests/ghci/scripts/T13988.script | 2 ++ testsuite/tests/ghci/scripts/T13988.stdout | 1 + testsuite/tests/ghci/scripts/all.T | 1 + 5 files changed, 18 insertions(+), 5 deletions(-) diff --git a/compiler/rename/RnTypes.hs b/compiler/rename/RnTypes.hs index cfe1517..df9ded2 100644 --- a/compiler/rename/RnTypes.hs +++ b/compiler/rename/RnTypes.hs @@ -1575,10 +1575,8 @@ extractHsTyRdrTyVars :: LHsType GhcPs -> RnM FreeKiTyVars -- occurrence is returned. -- See Note [Kind and type-variable binders] extractHsTyRdrTyVars ty - = do { FKTV kis tys <- extract_lty TypeLevel ty emptyFKTV - ; return (FKTV (nubL kis) - (nubL tys)) } - + = do { fvs <- extract_lty TypeLevel ty emptyFKTV + ; return (rmDupsInRdrTyVars fvs) } -- | Extracts free type and kind variables from types in a list. -- When the same name occurs multiple times in the types, only the first @@ -1598,7 +1596,10 @@ extractHsTysRdrTyVarsDups tys -- | Removes multiple occurrences of the same name from FreeKiTyVars. rmDupsInRdrTyVars :: FreeKiTyVars -> FreeKiTyVars rmDupsInRdrTyVars (FKTV kis tys) - = FKTV (nubL kis) (nubL tys) + = FKTV kis' tys' + where + kis' = nubL kis + tys' = nubL (filterOut (`elemRdr` kis') tys) extractRdrKindSigVars :: LFamilyResultSig GhcPs -> RnM [Located RdrName] extractRdrKindSigVars (L _ resultSig) diff --git a/testsuite/tests/ghci/scripts/T13988.hs b/testsuite/tests/ghci/scripts/T13988.hs new file mode 100644 index 0000000..54969ca --- /dev/null +++ b/testsuite/tests/ghci/scripts/T13988.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE TypeInType, GADTs #-} + +module T13988 where + +import Data.Kind + +data Foo (a :: k) where + MkFoo :: (k ~ Type) => Foo (a :: k) diff --git a/testsuite/tests/ghci/scripts/T13988.script b/testsuite/tests/ghci/scripts/T13988.script new file mode 100644 index 0000000..06aa686 --- /dev/null +++ b/testsuite/tests/ghci/scripts/T13988.script @@ -0,0 +1,2 @@ +:load T13988 +:type +v MkFoo diff --git a/testsuite/tests/ghci/scripts/T13988.stdout b/testsuite/tests/ghci/scripts/T13988.stdout new file mode 100644 index 0000000..a89ff33 --- /dev/null +++ b/testsuite/tests/ghci/scripts/T13988.stdout @@ -0,0 +1 @@ +MkFoo :: forall k (a :: k). (k ~ *) => Foo a diff --git a/testsuite/tests/ghci/scripts/all.T b/testsuite/tests/ghci/scripts/all.T index e3eb427..cbab76b 100755 --- a/testsuite/tests/ghci/scripts/all.T +++ b/testsuite/tests/ghci/scripts/all.T @@ -258,3 +258,4 @@ test('T13591', expect_broken(13591), ghci_script, ['T13591.script']) test('T13699', normal, ghci_script, ['T13699.script']) test('T13407', normal, ghci_script, ['T13407.script']) test('T13963', normal, ghci_script, ['T13963.script']) +test('T13988', normal, ghci_script, ['T13988.script']) From git at git.haskell.org Wed Aug 16 19:19:12 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 16 Aug 2017 19:19:12 +0000 (UTC) Subject: [commit: ghc] wip/rae: Fix #13963. (68c1186) Message-ID: <20170816191912.04F083A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/68c11868dff2ea8e6e581c7dced9d761ebe10124/ghc >--------------------------------------------------------------- commit 68c11868dff2ea8e6e581c7dced9d761ebe10124 Author: Richard Eisenberg Date: Wed Aug 16 14:33:06 2017 -0400 Fix #13963. This commit fixes several things: 1. RuntimeRep arg suppression was overeager for *visibly*-quantified RuntimeReps, which should remain. 2. The choice of whether to used a Named TyConBinder or an anonymous was sometimes wrong. Now, we do an extra little pass right before constructing the tycon to fix these. 3. TyCons that normally cannot appear unsaturated can appear unsaturated in :kind. But this fact was not propagated into the type checker. It now is. >--------------------------------------------------------------- 68c11868dff2ea8e6e581c7dced9d761ebe10124 compiler/iface/IfaceType.hs | 4 +- compiler/typecheck/TcHsType.hs | 61 ++++++++++++++++++++++++++---- compiler/typecheck/TcRnDriver.hs | 2 +- testsuite/tests/ghci/scripts/T13963.script | 9 +++++ testsuite/tests/ghci/scripts/T13963.stdout | 4 ++ testsuite/tests/ghci/scripts/all.T | 1 + 6 files changed, 71 insertions(+), 10 deletions(-) diff --git a/compiler/iface/IfaceType.hs b/compiler/iface/IfaceType.hs index c7405b3..684fc9c 100644 --- a/compiler/iface/IfaceType.hs +++ b/compiler/iface/IfaceType.hs @@ -677,11 +677,13 @@ defaultRuntimeRepVars = go emptyFsEnv go :: FastStringEnv () -> IfaceType -> IfaceType go subs (IfaceForAllTy bndr ty) | isRuntimeRep var_kind + , isInvisibleArgFlag (binderArgFlag bndr) -- don't default *visible* quantification + -- or we get the mess in #13963 = let subs' = extendFsEnv subs var () in go subs' ty | otherwise = IfaceForAllTy (TvBndr (var, go subs var_kind) (binderArgFlag bndr)) - (go subs ty) + (go subs ty) where var :: IfLclName (var, var_kind) = binderVar bndr diff --git a/compiler/typecheck/TcHsType.hs b/compiler/typecheck/TcHsType.hs index 6e2720b..162c904 100644 --- a/compiler/typecheck/TcHsType.hs +++ b/compiler/typecheck/TcHsType.hs @@ -30,7 +30,7 @@ module TcHsType ( kcHsTyVarBndrs, tcHsLiftedType, tcHsOpenType, tcHsLiftedTypeNC, tcHsOpenTypeNC, - tcLHsType, tcCheckLHsType, + tcLHsType, tcLHsTypeUnsaturated, tcCheckLHsType, tcHsContext, tcLHsPredType, tcInferApps, tcTyApps, solveEqualities, -- useful re-export @@ -86,7 +86,7 @@ import PrelNames hiding ( wildCardName ) import qualified GHC.LanguageExtensions as LangExt import Maybes -import Data.List ( partition, zipWith4 ) +import Data.List ( partition, zipWith4, mapAccumR ) import Control.Monad {- @@ -331,6 +331,13 @@ tcLHsType :: LHsType GhcRn -> TcM (TcType, TcKind) -- Called from outside: set the context tcLHsType ty = addTypeCtxt ty (tc_infer_lhs_type typeLevelMode ty) +-- Like tcLHsType, but use it in a context where type synonyms and type families +-- do not need to be saturated, like in a GHCi :kind call +tcLHsTypeUnsaturated :: LHsType GhcRn -> TcM (TcType, TcKind) +tcLHsTypeUnsaturated ty = addTypeCtxt ty (tc_infer_lhs_type mode ty) + where + mode = allowUnsaturated typeLevelMode + --------------------------- -- | Should we generalise the kind of this type signature? -- We *should* generalise if the type is closed @@ -390,15 +397,21 @@ concern things that the renamer can't handle. -- differentiates only between types and kinds, but this will likely -- grow, at least to include the distinction between patterns and -- not-patterns. -newtype TcTyMode - = TcTyMode { mode_level :: TypeOrKind -- True <=> type, False <=> kind +data TcTyMode + = TcTyMode { mode_level :: TypeOrKind + , mode_unsat :: Bool -- True <=> allow unsaturated type families } + -- The mode_unsat field is solely so that type families/synonyms can be unsaturated + -- in GHCi :kind calls typeLevelMode :: TcTyMode -typeLevelMode = TcTyMode { mode_level = TypeLevel } +typeLevelMode = TcTyMode { mode_level = TypeLevel, mode_unsat = False } kindLevelMode :: TcTyMode -kindLevelMode = TcTyMode { mode_level = KindLevel } +kindLevelMode = TcTyMode { mode_level = KindLevel, mode_unsat = False } + +allowUnsaturated :: TcTyMode -> TcTyMode +allowUnsaturated mode = mode { mode_unsat = True } -- switch to kind level kindLevel :: TcTyMode -> TcTyMode @@ -1036,7 +1049,8 @@ tcTyVar mode name -- Could be a tyvar, a tycon, or a datacon -> TcTyCon -- a non-loopy version of the tycon -> TcM (TcType, TcKind) handle_tyfams tc tc_tc - | mightBeUnsaturatedTyCon tc_tc + | mightBeUnsaturatedTyCon tc_tc || mode_unsat mode + -- This is where mode_unsat is used = do { traceTc "tcTyVar2a" (ppr tc_tc $$ ppr tc_kind) ; return (ty, tc_kind) } @@ -1758,8 +1772,8 @@ tcTyClTyVars tycon_name thing_inside ; let scoped_tvs = tcTyConScopedTyVars tycon -- these are all zonked: - binders = tyConBinders tycon res_kind = tyConResKind tycon + binders = correct_binders (tyConBinders tycon) res_kind -- See Note [Free-floating kind vars] ; zonked_scoped_tvs <- mapM zonkTcTyVarToTyVar scoped_tvs @@ -1771,6 +1785,37 @@ tcTyClTyVars tycon_name thing_inside -- are the ones mentioned in the source. ; tcExtendTyVarEnv scoped_tvs $ thing_inside binders res_kind } + where + -- Given some TyConBinders and a TyCon's result kind, make sure that the + -- correct any wrong Named/Anon choices. For example, consider + -- type Syn k = forall (a :: k). Proxy a + -- At first, it looks like k should be named -- after all, it appears on the RHS. + -- However, the correct kind for Syn is (* -> *). + correct_binders :: [TyConBinder] -> Kind -> [TyConBinder] + correct_binders binders kind + = binders' + where + (_, binders') = mapAccumR go (tyCoVarsOfType kind) binders + + go :: TyCoVarSet -> TyConBinder -> (TyCoVarSet, TyConBinder) + go fvs binder + | isNamedTyConBinder binder + , not (tv `elemVarSet` fvs) + = (new_fvs, mkAnonTyConBinder tv) + + | not (isNamedTyConBinder binder) + , tv `elemVarSet` fvs + = (new_fvs, mkNamedTyConBinder Required tv) + -- always Required, because it was anonymous (i.e. visible) previously + + | otherwise + = (new_fvs, binder) + + where + tv = binderVar binder + new_fvs = fvs `delVarSet` tv `unionVarSet` tyCoVarsOfType (tyVarKind tv) + + ----------------------------------- tcDataKindSig :: Bool -- ^ Do we require the result to be *? diff --git a/compiler/typecheck/TcRnDriver.hs b/compiler/typecheck/TcRnDriver.hs index 8189a78..7face41 100644 --- a/compiler/typecheck/TcRnDriver.hs +++ b/compiler/typecheck/TcRnDriver.hs @@ -2255,7 +2255,7 @@ tcRnType hsc_env normalise rdr_type ; traceTc "tcRnType" (vcat [ppr wcs, ppr rn_type]) ; (ty, kind) <- solveEqualities $ tcWildCardBinders wcs $ \ _ -> - tcLHsType rn_type + tcLHsTypeUnsaturated rn_type -- Do kind generalisation; see Note [Kind-generalise in tcRnType] ; kvs <- kindGeneralize kind diff --git a/testsuite/tests/ghci/scripts/T13963.script b/testsuite/tests/ghci/scripts/T13963.script new file mode 100644 index 0000000..630e5cd --- /dev/null +++ b/testsuite/tests/ghci/scripts/T13963.script @@ -0,0 +1,9 @@ +:set -XTypeInType -XRankNTypes +import GHC.Exts (TYPE, RuntimeRep(LiftedRep)) +type Pair (a :: TYPE rep) (b :: TYPE rep') rep'' = forall (r :: TYPE rep''). (a -> b -> r) +:kind Pair +:kind Pair Int +:kind Pair Int Float +:kind Pair Int Float LiftedRep + + diff --git a/testsuite/tests/ghci/scripts/T13963.stdout b/testsuite/tests/ghci/scripts/T13963.stdout new file mode 100644 index 0000000..9e31d8b --- /dev/null +++ b/testsuite/tests/ghci/scripts/T13963.stdout @@ -0,0 +1,4 @@ +Pair :: TYPE rep -> TYPE rep' -> RuntimeRep -> * +Pair Int :: * -> RuntimeRep -> * +Pair Int Float :: RuntimeRep -> * +Pair Int Float LiftedRep :: * diff --git a/testsuite/tests/ghci/scripts/all.T b/testsuite/tests/ghci/scripts/all.T index 0861b70..e3eb427 100755 --- a/testsuite/tests/ghci/scripts/all.T +++ b/testsuite/tests/ghci/scripts/all.T @@ -257,3 +257,4 @@ test('GhciCurDir', normal, ghci_script, ['GhciCurDir.script']) test('T13591', expect_broken(13591), ghci_script, ['T13591.script']) test('T13699', normal, ghci_script, ['T13699.script']) test('T13407', normal, ghci_script, ['T13407.script']) +test('T13963', normal, ghci_script, ['T13963.script']) From git at git.haskell.org Wed Aug 16 19:19:14 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 16 Aug 2017 19:19:14 +0000 (UTC) Subject: [commit: ghc] wip/rae's head updated: Fix egregious duplication of vars in RnTypes (7069a5d) Message-ID: <20170816191914.92CF33A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/rae' now includes: 362339d Fix note references and some typos d774b4e Fix #13968 by consulting isBuiltInOcc_maybe 4a26415 Remove unneeded import 8e15e3d Improve error messages around kind mismatches. c9667d3 Fix #11400, #11560 by documenting an infelicity. 9a54975 Test #11672 in typecheck/should_fail/T11672. ef39af7 Don't tidy vars when dumping a type bb2a446 Preserve CoVar uniques during pretty printing 79cfb19 Remove old coercion pretty-printer c2417b8 Fix #13819 by refactoring TypeEqOrigin.uo_thing fb75213 Track visibility in TypeEqOrigin 10d13b6 Fix #11963 by checking for more mixed type/kinds ca47186 Document that type holes kill polymorphic recursion 1696dbf Fix #12176 by being a bit more careful instantiating. 4239238 Fix #12369 by being more flexible with data insts 791947d Refactor tcInferApps. 7af0b90 Initialize hs_init with UTF8 encoded arguments on Windows. 6b77914 Fix instantiation of pattern synonyms af6d225 Remove redundant constraint in context b1317a3 Fix ASSERT failure in tc269 452755d Do not discard insolubles in implications ad0037e Add DebugCallStack to piResultTy d618649 Error eagerly after renaming failures in reifyInstances b3b564f Merge types and kinds in DsMeta 424ecad Add regression tests for #13601, #13780, #13877 5e940bd Switched out optparse for argparse in runtests.py 54d3a1f testsuite: Produce JUnit output 262bb95 testsuite: Add test for #14028 274e9b2 Add “BINARY_DIST_DIR” to Makefile dac4b9d ByteCodeGen: use byte indexing for BCenv 2974f81 Fix lld detection if both gold and lld are found f134bfb gitmodules: Delete entry for dead hoopl submodule d08b9cc configure: Ensure that user's LD setting is respected 0e3c101 Ensure that we always link against libm 0e3eacc testsuite: Don't pass allow_abbrev 121fee9 Remove unnecessary GHC option from SrcLoc 9e9fb57 Fix hs-boot knot-tying with record wild cards. d75bba8 Add rtsopts ignore and ignoreAll. 84f8e86 Ensure that GHC.Stack.callStack doesn't fail 9cfabbb Add '<&>' operator to Data.Functor. '<&>' calls '<$>' with flipped arguments. d1ef223 Fix #14045 by omitting an unnecessary check f839b9d Add regression test for #14055 7089dc2 Follow-up to #13887, for promoted infix constructors 9699286 Typofixes [ci skip] f2c12c3 Add haddock markup 49e334c Allow Windows to set blank environment variables c6d4219 Clarify comment about data family arities 2535a67 Refactoring around FunRhs 4636886 Improve the desugaring of -XStrict 3ab342e Do a bit more CSE af89d68 Reject top-level banged bindings 7f2dee8 Remove redundant goop 4fdc523 Use field names for all uses of datacon Match 2ef973e A bunch of typofixes 7a74f50 Typofixes [ci skip] 5a7af95 KnownUniques: Handle DataCon wrapper names 29f07b1 Allow bundling pattern synonyms with exported data families 74c7016 rts: Fix "variable set but not used" warning b311096 Simplify OccurAnal.tagRecBinders c13720c Drop GHC 7.10 compatibility 36fe21a Enable building Cabal with parsec 9df71bf Bump unix submodule 8ef8520 Add .gitmodules entries for text, parsec, mtl submodules d74983e Get the roles right for newtype instances f68a00c Remove unneeded uses of ImplicitParams 884bd21 Add the bootstrapping/ dir to .gitignore 394c391 Add MonadIO Q - by requiring MonadIO => Quasi a81b5b0 Remove the deprecated Typeable{1..7} type synonyms a267580 Don't warn when empty casing on Type 6ea13e9 Add forgotten > in Control.Applicative e8fe12f Fix string escaping in JSON 2f29f19 Convert examples to doctests, and add a handful of new ones 14457cf Fix EmptyCase documentation a4f347c Split out inferConstraintsDataConArgs from inferConstraints 3f05e5f Don't suppress unimplemented type family warnings with DeriveAnyClass 7d69978 Use NonEmpty lists to represent lists of duplicate elements 4f1f986 Change isClosedAlgType to be TYPE-aware, and rename it to pmIsClosedType 0bb1e84 Expand type synonyms during role inference c6462ab Add test for #14101 7c37ffe Point to FunDeps documentation on Haskell wiki ad7b945 Fix #14060 by more conservatively annotating TH-reified types 0a891c8 Properly handle dlerror() message on FreeBSD when linking linker scripts ddb870b Don't drop GHCi-defined functions with -fobject-code enabled ed7a830 Use a ReaderT in TcDeriv to avoid some tedious plumbing 21bd9b2 Recognize FreeBSD compiler as Clang. a520adc Bump mtl, parsec, text submodules 441c52d Add Semigroup/Monoid instances to ST monad b0285d1 Bump nofib submodule e054c5f Bump mtl, parsec, text submodules 6e9c8eb Bump mtl, parsec, text submodules (again) a0c6a10 Test #14038 in dependent/should_compile/T14038 ac03a73 Regression test for #12742 763d153 Test #12938 in indexed-types/should_compile/T12938 75fedb8 Fix #13391 by checking for kind-GADTs 3062e95 Fix #13399 by documenting higher-rank kinds. c93e798 Fix #13407 by suppressing invisibles better. f5e7cf0 Fix #13909 by tweaking an error message. 1617cab Make rejigConRes do kind substitutions 483bb2b Fix #13929 by adding another levity polymorphism check 59e7fa5 Test #13938, with expect_broken 68c1186 Fix #13963. 7069a5d Fix egregious duplication of vars in RnTypes From git at git.haskell.org Wed Aug 16 22:47:31 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 16 Aug 2017 22:47:31 +0000 (UTC) Subject: [commit: ghc] branch 'wip/prettyprinter' created Message-ID: <20170816224731.5C6433A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/prettyprinter Referencing: 56568b5cd0118835aaede71171e368b65dd707d0 From git at git.haskell.org Wed Aug 16 22:47:36 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 16 Aug 2017 22:47:36 +0000 (UTC) Subject: [commit: ghc] wip/prettyprinter: Use prettyprinter (2f6366f) Message-ID: <20170816224736.E38203A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/prettyprinter Link : http://ghc.haskell.org/trac/ghc/changeset/2f6366f31c8bee8adb53de020052d19653549640/ghc >--------------------------------------------------------------- commit 2f6366f31c8bee8adb53de020052d19653549640 Author: Ben Gamari Date: Sat Jun 24 10:05:38 2017 -0400 Use prettyprinter >--------------------------------------------------------------- 2f6366f31c8bee8adb53de020052d19653549640 compiler/llvmGen/LlvmCodeGen.hs | 4 +- compiler/llvmGen/LlvmCodeGen/Base.hs | 6 +- compiler/main/HscMain.hs | 3 + compiler/nativeGen/AsmCodeGen.hs | 23 ++--- compiler/utils/Outputable.hs | 18 ++-- compiler/utils/Pretty.hs | 185 ++++++++++++++++++++++++++++++++--- ghc/Main.hs | 2 + 7 files changed, 205 insertions(+), 36 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 2f6366f31c8bee8adb53de020052d19653549640 From git at git.haskell.org Wed Aug 16 22:47:39 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 16 Aug 2017 22:47:39 +0000 (UTC) Subject: [commit: ghc] wip/prettyprinter: Try something (2e06574) Message-ID: <20170816224739.9FADB3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/prettyprinter Link : http://ghc.haskell.org/trac/ghc/changeset/2e0657415aaa2cfead23cb44f8bc671df6269fc6/ghc >--------------------------------------------------------------- commit 2e0657415aaa2cfead23cb44f8bc671df6269fc6 Author: Ben Gamari Date: Sat Jun 24 13:01:37 2017 -0400 Try something >--------------------------------------------------------------- 2e0657415aaa2cfead23cb44f8bc671df6269fc6 compiler/utils/Pretty.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/compiler/utils/Pretty.hs b/compiler/utils/Pretty.hs index 0f6ca4b..a7969e6 100644 --- a/compiler/utils/Pretty.hs +++ b/compiler/utils/Pretty.hs @@ -1008,10 +1008,10 @@ renderStyle s d = TL.unpack $ renderLazy (layoutPretty (styleToLayoutOptions s) printDoc :: Mode -> Int -> Handle -> Doc a -> IO () -- printDoc adds a newline to the end -printDoc mode cols hdl doc = printDoc_ mode cols hdl (doc <> hardline) +printDoc mode cols hdl doc = printDoc_ mode cols hdl (doc) printDoc_ :: Mode -> Int -> Handle -> Doc a -> IO () -printDoc_ mode pprCols hdl doc = TL.hPutStr hdl (renderLazy $ layoutPretty (mkLayoutOptions mode pprCols) doc) where +printDoc_ mode pprCols hdl doc = TL.hPutStrLn hdl (renderLazy $ layoutPretty (mkLayoutOptions mode pprCols) doc) where mkLayoutOptions :: Mode -> Int -> LayoutOptions -- Note that this should technically be 1.5 as per the old implementation. -- I have no idea why that is. From git at git.haskell.org Wed Aug 16 22:47:34 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 16 Aug 2017 22:47:34 +0000 (UTC) Subject: [commit: ghc] wip/prettyprinter: Add pretty-printer dependency (6778e70) Message-ID: <20170816224734.22A1A3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/prettyprinter Link : http://ghc.haskell.org/trac/ghc/changeset/6778e709d4c4c1d963a6a7352a73470dff182d75/ghc >--------------------------------------------------------------- commit 6778e709d4c4c1d963a6a7352a73470dff182d75 Author: Ben Gamari Date: Sat Jun 24 10:05:14 2017 -0400 Add pretty-printer dependency >--------------------------------------------------------------- 6778e709d4c4c1d963a6a7352a73470dff182d75 .gitmodules | 3 +++ compiler/ghc.cabal.in | 2 ++ ghc.mk | 3 ++- ghc/ghc-bin.cabal.in | 2 ++ libraries/Cabal | 2 +- libraries/Win32 | 2 +- libraries/binary | 2 +- libraries/deepseq | 2 +- libraries/parallel | 2 +- libraries/prettyprinter-core | 1 + libraries/process | 2 +- libraries/text | 2 +- libraries/time | 2 +- libraries/unix | 2 +- libraries/xhtml | 2 +- nofib | 2 +- packages | 1 + utils/haddock | 2 +- 18 files changed, 23 insertions(+), 13 deletions(-) diff --git a/.gitmodules b/.gitmodules index 9e0e805..9b75158 100644 --- a/.gitmodules +++ b/.gitmodules @@ -129,3 +129,6 @@ [submodule ".arc-linters/arcanist-external-json-linter"] path = .arc-linters/arcanist-external-json-linter url = ../arcanist-external-json-linter.git +[submodule "libraries/prettyprinter-core"] + path = libraries/prettyprinter-core + url = https://github.com/bollu/prettyprinter-core.git diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in index 152e156..a14297b 100644 --- a/compiler/ghc.cabal.in +++ b/compiler/ghc.cabal.in @@ -62,6 +62,8 @@ Library template-haskell == 2.12.*, hpc == 0.6.*, transformers == 0.5.*, + text == 1.2.*, + prettyprinter == 1.1.*, ghc-boot == @ProjectVersionMunged@, ghc-boot-th == @ProjectVersionMunged@, ghci == @ProjectVersionMunged@ diff --git a/ghc.mk b/ghc.mk index 55cc119..774753c 100644 --- a/ghc.mk +++ b/ghc.mk @@ -430,7 +430,7 @@ else # CLEANING # programs such as GHC and ghc-pkg, that we do not assume the stage0 # compiler already has installed (or up-to-date enough). -PACKAGES_STAGE0 = binary text transformers mtl parsec Cabal/Cabal hpc ghc-boot-th ghc-boot template-haskell ghci +PACKAGES_STAGE0 = binary text transformers mtl parsec Cabal/Cabal hpc ghc-boot-th ghc-boot template-haskell ghci prettyprinter-core ifeq "$(Windows_Host)" "NO" PACKAGES_STAGE0 += terminfo endif @@ -469,6 +469,7 @@ PACKAGES_STAGE1 += ghc-boot-th PACKAGES_STAGE1 += ghc-boot PACKAGES_STAGE1 += template-haskell PACKAGES_STAGE1 += ghc-compact +PACKAGES_STAGE1 += prettyprinter-core ifeq "$(HADDOCK_DOCS)" "YES" PACKAGES_STAGE1 += xhtml diff --git a/ghc/ghc-bin.cabal.in b/ghc/ghc-bin.cabal.in index b04c13a..74793bc 100644 --- a/ghc/ghc-bin.cabal.in +++ b/ghc/ghc-bin.cabal.in @@ -34,6 +34,8 @@ Executable ghc directory >= 1 && < 1.4, process >= 1 && < 1.7, filepath >= 1 && < 1.5, + text == 1.2.*, + prettyprinter == 1.1.*, ghc-boot == @ProjectVersionMunged@, ghc == @ProjectVersionMunged@ diff --git a/libraries/Cabal b/libraries/Cabal index 082cf20..ece0273 160000 --- a/libraries/Cabal +++ b/libraries/Cabal @@ -1 +1 @@ -Subproject commit 082cf2066b7206d3b12a9f92d832236e2484b4c1 +Subproject commit ece0273b48b7ff19fff6cd82913717d86d3ffbfa diff --git a/libraries/Win32 b/libraries/Win32 index 147a0af..b5ebb64 160000 --- a/libraries/Win32 +++ b/libraries/Win32 @@ -1 +1 @@ -Subproject commit 147a0af92ac74ec58b209e16aeb1cf03bddf9482 +Subproject commit b5ebb64894cf166f9ee84ee91802486c76e480cf diff --git a/libraries/binary b/libraries/binary index d4a030a..0147456 160000 --- a/libraries/binary +++ b/libraries/binary @@ -1 +1 @@ -Subproject commit d4a030ab448191f664fc734bfbee61450a6fa5af +Subproject commit 0147456b11c38d1121fd84a2b53effefde111240 diff --git a/libraries/deepseq b/libraries/deepseq index 0b22c98..65dd864 160000 --- a/libraries/deepseq +++ b/libraries/deepseq @@ -1 +1 @@ -Subproject commit 0b22c9825ef79c1ee41d2f19e7c997f5cdc93494 +Subproject commit 65dd864d0d2f5cf415064fc214261b9270a924cf diff --git a/libraries/parallel b/libraries/parallel index d2e2a5e..040c4f0 160000 --- a/libraries/parallel +++ b/libraries/parallel @@ -1 +1 @@ -Subproject commit d2e2a5e630fdfa0e9bc8c2d8c7d134ad3500b5de +Subproject commit 040c4f0226a5a9a1e720d89a9e1239028d9f62d9 diff --git a/libraries/prettyprinter-core b/libraries/prettyprinter-core new file mode 160000 index 0000000..8697cc9 --- /dev/null +++ b/libraries/prettyprinter-core @@ -0,0 +1 @@ +Subproject commit 8697cc9cfe6937d6479396a96c600a4b6d556ab5 diff --git a/libraries/process b/libraries/process index 423a9ef..88547b0 160000 --- a/libraries/process +++ b/libraries/process @@ -1 +1 @@ -Subproject commit 423a9efa8b1b22304af0acc8b950289026b288eb +Subproject commit 88547b0fae8644f8f69be32c7ee5a3b76051c82f diff --git a/libraries/text b/libraries/text index 1707aa5..f127122 160000 --- a/libraries/text +++ b/libraries/text @@ -1 +1 @@ -Subproject commit 1707aa5f2ad5c254c45ac9ffcac749e4d6b67a6e +Subproject commit f12712241987d5b8f0ebb1bdcd64edfc26ea582e diff --git a/libraries/time b/libraries/time index 1fcaa07..d03429e 160000 --- a/libraries/time +++ b/libraries/time @@ -1 +1 @@ -Subproject commit 1fcaa07e10d7966356373ed0e946eb078fcdd6e6 +Subproject commit d03429e1913b6babd3b59d0bfdd7d3904b1b6f0b diff --git a/libraries/unix b/libraries/unix index 063aea3..eb5fc94 160000 --- a/libraries/unix +++ b/libraries/unix @@ -1 +1 @@ -Subproject commit 063aea3fbc5a8caa03d0deb9a887763006ab86df +Subproject commit eb5fc942f8f570e754bba0f57a8fdaec3400194f diff --git a/libraries/xhtml b/libraries/xhtml index 6358594..8a8c8a4 160000 --- a/libraries/xhtml +++ b/libraries/xhtml @@ -1 +1 @@ -Subproject commit 6358594eb5139f6760e2ada72718d69fed5a1015 +Subproject commit 8a8c8a48bac2d3ed306b610a2e9fa393b5a7ffa5 diff --git a/nofib b/nofib index 63ce82a..eccf532 160000 --- a/nofib +++ b/nofib @@ -1 +1 @@ -Subproject commit 63ce82acf38ef20d20fde6e80c5075c14fe8246c +Subproject commit eccf532410eee45f30c07f389f7029871fd603db diff --git a/packages b/packages index 9af1b64..62a3373 100644 --- a/packages +++ b/packages @@ -41,6 +41,7 @@ ghc-tarballs windows ghc-tarballs.git - libffi-tarballs - - - utils/hsc2hs - - - utils/haddock - - ssh://git at github.com/haskell/haddock.git +libraries/prettyprinter-core - - https://github.com/bollu/prettyprinter-core.git libraries/array - - - libraries/binary - - https://github.com/kolmodin/binary.git libraries/bytestring - - https://github.com/haskell/bytestring.git diff --git a/utils/haddock b/utils/haddock index c8a01b8..7cecbd9 160000 --- a/utils/haddock +++ b/utils/haddock @@ -1 +1 @@ -Subproject commit c8a01b83be52e45d3890db173ffe7b09ccd4f351 +Subproject commit 7cecbd969298d5aa576750864a69fa5f70f71c32 From git at git.haskell.org Wed Aug 16 22:47:42 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 16 Aug 2017 22:47:42 +0000 (UTC) Subject: [commit: ghc] wip/prettyprinter: Fix errant newlines (54cb35b) Message-ID: <20170816224742.5B1D73A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/prettyprinter Link : http://ghc.haskell.org/trac/ghc/changeset/54cb35b757b4aac6b74b4153db27c6ae1e4c6c05/ghc >--------------------------------------------------------------- commit 54cb35b757b4aac6b74b4153db27c6ae1e4c6c05 Author: Ben Gamari Date: Sat Jun 24 12:40:35 2017 -0400 Fix errant newlines >--------------------------------------------------------------- 54cb35b757b4aac6b74b4153db27c6ae1e4c6c05 compiler/utils/Pretty.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/compiler/utils/Pretty.hs b/compiler/utils/Pretty.hs index 15b8c64..0f6ca4b 100644 --- a/compiler/utils/Pretty.hs +++ b/compiler/utils/Pretty.hs @@ -123,6 +123,7 @@ import GHC.Ptr ( Ptr(..) ) import qualified Data.Text as T import qualified Data.Text.Lazy as TL +import qualified Data.Text.Lazy.IO as TL import Data.Text.Prettyprint.Doc -- PI = PrettyprinterInternal @@ -1010,7 +1011,7 @@ printDoc :: Mode -> Int -> Handle -> Doc a -> IO () printDoc mode cols hdl doc = printDoc_ mode cols hdl (doc <> hardline) printDoc_ :: Mode -> Int -> Handle -> Doc a -> IO () -printDoc_ mode pprCols hdl doc = renderIO hdl (layoutPretty (mkLayoutOptions mode pprCols) doc) where +printDoc_ mode pprCols hdl doc = TL.hPutStr hdl (renderLazy $ layoutPretty (mkLayoutOptions mode pprCols) doc) where mkLayoutOptions :: Mode -> Int -> LayoutOptions -- Note that this should technically be 1.5 as per the old implementation. -- I have no idea why that is. From git at git.haskell.org Wed Aug 16 22:47:45 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 16 Aug 2017 22:47:45 +0000 (UTC) Subject: [commit: ghc] wip/prettyprinter: llvmGen: Fix another (933a1e4) Message-ID: <20170816224745.1D1A43A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/prettyprinter Link : http://ghc.haskell.org/trac/ghc/changeset/933a1e4a16c815d95f32e7073572e0e267516789/ghc >--------------------------------------------------------------- commit 933a1e4a16c815d95f32e7073572e0e267516789 Author: Ben Gamari Date: Fri Jul 21 00:18:20 2017 -0400 llvmGen: Fix another >--------------------------------------------------------------- 933a1e4a16c815d95f32e7073572e0e267516789 compiler/llvmGen/LlvmCodeGen.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/compiler/llvmGen/LlvmCodeGen.hs b/compiler/llvmGen/LlvmCodeGen.hs index 121e3b9..dff5c44 100644 --- a/compiler/llvmGen/LlvmCodeGen.hs +++ b/compiler/llvmGen/LlvmCodeGen.hs @@ -23,7 +23,6 @@ import Hoopl.Block import Hoopl.Collections import PprCmm -import BufWrite import DynFlags import ErrUtils import FastString From git at git.haskell.org Wed Aug 16 22:47:47 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 16 Aug 2017 22:47:47 +0000 (UTC) Subject: [commit: ghc] wip/prettyprinter: llvmGen: Clean up warning (6d73fec) Message-ID: <20170816224747.CDBB93A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/prettyprinter Link : http://ghc.haskell.org/trac/ghc/changeset/6d73fec6eff2f677c586c6be17cf447d5000c1de/ghc >--------------------------------------------------------------- commit 6d73fec6eff2f677c586c6be17cf447d5000c1de Author: Ben Gamari Date: Fri Jul 21 00:16:34 2017 -0400 llvmGen: Clean up warning >--------------------------------------------------------------- 6d73fec6eff2f677c586c6be17cf447d5000c1de compiler/llvmGen/LlvmCodeGen/Base.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/compiler/llvmGen/LlvmCodeGen/Base.hs b/compiler/llvmGen/LlvmCodeGen/Base.hs index 99202b7..6e42f52 100644 --- a/compiler/llvmGen/LlvmCodeGen/Base.hs +++ b/compiler/llvmGen/LlvmCodeGen/Base.hs @@ -49,7 +49,6 @@ import Outputable as Outp import Platform import UniqFM import Unique -import BufWrite ( BufHandle ) import System.IO (Handle) import UniqSet import UniqSupply From git at git.haskell.org Wed Aug 16 22:47:50 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 16 Aug 2017 22:47:50 +0000 (UTC) Subject: [commit: ghc] wip/prettyprinter: Never tick primitive string literals (0b6b760) Message-ID: <20170816224750.9140B3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/prettyprinter Link : http://ghc.haskell.org/trac/ghc/changeset/0b6b760398567939c43c165272f04161b82e97b4/ghc >--------------------------------------------------------------- commit 0b6b760398567939c43c165272f04161b82e97b4 Author: Ben Gamari Date: Fri Jul 21 01:23:26 2017 -0400 Never tick primitive string literals Summary: This is a more aggressive approach to the problem initially solved in f5b275a239d2554c4da0b7621211642bf3b10650, where top-level primitive string literals were being wrapped by ticks. This breaks the Core invariant descirbed in Note [CoreSyn top-level string literals]. However, the previous approach was incomplete and left several places where inappropriate ticks could sneak in. This commit kills the problem at the source: we simply never tick any primitive string literal expression. The assumption here is that these expressions are destined for the top-level, where they cannot be ticked, anyways. So even if they haven't been floated out yet there is no reason to tick them. This partially reverts commit f5b275a239d2554c4da0b7621211642bf3b10650. Test Plan: Validate with `-g` Reviewers: scpmw, simonmar, dfeuer, simonpj, austin Subscribers: dfeuer, simonmar, thomie Differential Revision: https://phabricator.haskell.org/D3063 >--------------------------------------------------------------- 0b6b760398567939c43c165272f04161b82e97b4 compiler/coreSyn/CoreSyn.hs | 2 ++ compiler/coreSyn/CoreUtils.hs | 5 +++++ compiler/simplCore/FloatOut.hs | 32 ++++++++++++-------------------- compiler/simplCore/Simplify.hs | 15 +++------------ 4 files changed, 22 insertions(+), 32 deletions(-) diff --git a/compiler/coreSyn/CoreSyn.hs b/compiler/coreSyn/CoreSyn.hs index 99478d2..41202c3 100644 --- a/compiler/coreSyn/CoreSyn.hs +++ b/compiler/coreSyn/CoreSyn.hs @@ -402,6 +402,8 @@ It is important to note that top-level primitive string literals cannot be wrapped in Ticks, as is otherwise done with lifted bindings. CoreToStg expects to see just a plain (Lit (MachStr ...)) expression on the RHS of primitive string bindings; anything else and things break. CoreLint checks this invariant. +To ensure that ticks don't sneak in CoreUtils.mkTick refuses to wrap any +primitive string expression with a tick. Also see Note [Compilation plan for top-level string literals]. diff --git a/compiler/coreSyn/CoreUtils.hs b/compiler/coreSyn/CoreUtils.hs index 540a36e..3b80fb6 100644 --- a/compiler/coreSyn/CoreUtils.hs +++ b/compiler/coreSyn/CoreUtils.hs @@ -300,6 +300,11 @@ mkTick t orig_expr = mkTick' id id orig_expr -> CoreExpr mkTick' top rest expr = case expr of + -- Never tick primitive string literals. These should ultimately float up to + -- the top-level where they must be unadorned. See Note + -- [CoreSyn top-level string literals] for details. + _ | exprIsLiteralString expr -> expr + -- Cost centre ticks should never be reordered relative to each -- other. Therefore we can stop whenever two collide. Tick t2 e diff --git a/compiler/simplCore/FloatOut.hs b/compiler/simplCore/FloatOut.hs index 72fc0d1..06062bd 100644 --- a/compiler/simplCore/FloatOut.hs +++ b/compiler/simplCore/FloatOut.hs @@ -21,7 +21,6 @@ import DynFlags import ErrUtils ( dumpIfSet_dyn ) import Id ( Id, idArity, idType, isBottomingId, isJoinId, isJoinId_maybe ) -import BasicTypes ( TopLevelFlag(..), isTopLevel ) import SetLevels import UniqSupply ( UniqSupply ) import Bag @@ -735,26 +734,19 @@ atJoinCeiling (fs, floats, expr') wrapTick :: Tickish Id -> FloatBinds -> FloatBinds wrapTick t (FB tops ceils defns) - = FB (mapBag (wrap_bind TopLevel) tops) - (wrap_defns NotTopLevel ceils) - (M.map (M.map (wrap_defns NotTopLevel)) defns) + = FB (mapBag wrap_bind tops) (wrap_defns ceils) + (M.map (M.map wrap_defns) defns) where - wrap_defns toplvl = mapBag (wrap_one toplvl) - - wrap_bind toplvl (NonRec binder rhs) = NonRec binder (maybe_tick toplvl rhs) - wrap_bind toplvl (Rec pairs) = Rec (mapSnd (maybe_tick toplvl) pairs) - - wrap_one toplvl (FloatLet bind) = FloatLet (wrap_bind toplvl bind) - wrap_one toplvl (FloatCase e b c bs) = FloatCase (maybe_tick toplvl e) b c bs - - maybe_tick :: TopLevelFlag -> CoreExpr -> CoreExpr - maybe_tick toplvl e - -- We must take care not to tick top-level literal - -- strings as this violated the Core invariants. See Note [CoreSyn - -- top-level string literals]. - | isTopLevel toplvl && exprIsLiteralString e = e - | exprIsHNF e = tickHNFArgs t e - | otherwise = mkTick t e + wrap_defns = mapBag wrap_one + + wrap_bind (NonRec binder rhs) = NonRec binder (maybe_tick rhs) + wrap_bind (Rec pairs) = Rec (mapSnd maybe_tick pairs) + + wrap_one (FloatLet bind) = FloatLet (wrap_bind bind) + wrap_one (FloatCase e b c bs) = FloatCase (maybe_tick e) b c bs + + maybe_tick e | exprIsHNF e = tickHNFArgs t e + | otherwise = mkTick t e -- we don't need to wrap a tick around an HNF when we float it -- outside a tick: that is an invariant of the tick semantics -- Conversely, inlining of HNFs inside an SCC is allowed, and diff --git a/compiler/simplCore/Simplify.hs b/compiler/simplCore/Simplify.hs index 1fc9112..00fdee7 100644 --- a/compiler/simplCore/Simplify.hs +++ b/compiler/simplCore/Simplify.hs @@ -610,19 +610,10 @@ prepareRhs top_lvl env0 id rhs0 -- On the other hand, for scoping ticks we need to be able to -- copy them on the floats, which in turn is only allowed if -- we can obtain non-counting ticks. - | (not (tickishCounts t) || tickishCanSplit t) + | not (tickishCounts t) || tickishCanSplit t = do { (is_exp, env', rhs') <- go n_val_args (zapFloats env) rhs - -- env' has the extra let-bindings from - -- the makeTrivial calls in 'go'; no join floats - ; let tickIt (id, expr) - -- we have to take care not to tick top-level literal - -- strings. See Note [CoreSyn top-level string literals]. - | isTopLevel top_lvl && exprIsLiteralString expr - = (id, expr) - | otherwise - = (id, mkTick (mkNoCount t) expr) - floats' = seLetFloats env `addFlts` - mapFloats (seLetFloats env') tickIt + ; let tickIt (id, expr) = (id, mkTick (mkNoCount t) expr) + floats' = seLetFloats env `addFlts` mapFloats (seLetFloats env') tickIt ; return (is_exp, env' { seLetFloats = floats' }, Tick t rhs') } go _ env other From git at git.haskell.org Wed Aug 16 22:47:53 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 16 Aug 2017 22:47:53 +0000 (UTC) Subject: [commit: ghc] wip/prettyprinter: Debugging ghc-pkg (092ccef) Message-ID: <20170816224753.563E13A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/prettyprinter Link : http://ghc.haskell.org/trac/ghc/changeset/092ccefae9cb992271b424519616969f06b8d004/ghc >--------------------------------------------------------------- commit 092ccefae9cb992271b424519616969f06b8d004 Author: Ben Gamari Date: Fri Jul 21 00:11:14 2017 -0400 Debugging ghc-pkg >--------------------------------------------------------------- 092ccefae9cb992271b424519616969f06b8d004 libraries/ghc-boot/GHC/PackageDb.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/ghc-boot/GHC/PackageDb.hs b/libraries/ghc-boot/GHC/PackageDb.hs index bf83d25..f1ccf16 100644 --- a/libraries/ghc-boot/GHC/PackageDb.hs +++ b/libraries/ghc-boot/GHC/PackageDb.hs @@ -352,7 +352,7 @@ getHeader :: Get (Word32, Word32) getHeader = do magic <- getByteString (BS.length headerMagic) when (magic /= headerMagic) $ - fail "not a ghc-pkg db file, wrong file magic number" + fail $ "not a ghc-pkg db file, wrong file magic number (saw "++show magic++", expected "++show headerMagic++")" majorVersion <- get :: Get Word32 -- The major version is for incompatible changes From git at git.haskell.org Wed Aug 16 22:47:56 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 16 Aug 2017 22:47:56 +0000 (UTC) Subject: [commit: ghc] wip/prettyprinter: nativeGen: Clean up warning (8236520) Message-ID: <20170816224756.138313A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/prettyprinter Link : http://ghc.haskell.org/trac/ghc/changeset/82365202d2771eb64a8a62efdb3a9e146f635be3/ghc >--------------------------------------------------------------- commit 82365202d2771eb64a8a62efdb3a9e146f635be3 Author: Ben Gamari Date: Fri Jul 21 00:17:27 2017 -0400 nativeGen: Clean up warning >--------------------------------------------------------------- 82365202d2771eb64a8a62efdb3a9e146f635be3 compiler/nativeGen/AsmCodeGen.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/compiler/nativeGen/AsmCodeGen.hs b/compiler/nativeGen/AsmCodeGen.hs index e791b86..11bd8a1 100644 --- a/compiler/nativeGen/AsmCodeGen.hs +++ b/compiler/nativeGen/AsmCodeGen.hs @@ -98,7 +98,6 @@ import Data.Maybe import Data.Ord ( comparing ) import Control.Exception import Control.Monad -import System.IO import System.IO (Handle) {- From git at git.haskell.org Wed Aug 16 22:47:58 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 16 Aug 2017 22:47:58 +0000 (UTC) Subject: [commit: ghc] wip/prettyprinter: Hack: Produce latin1 asm output (56568b5) Message-ID: <20170816224758.C62293A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/prettyprinter Link : http://ghc.haskell.org/trac/ghc/changeset/56568b5cd0118835aaede71171e368b65dd707d0/ghc >--------------------------------------------------------------- commit 56568b5cd0118835aaede71171e368b65dd707d0 Author: Ben Gamari Date: Fri Jul 21 14:28:57 2017 -0400 Hack: Produce latin1 asm output >--------------------------------------------------------------- 56568b5cd0118835aaede71171e368b65dd707d0 compiler/nativeGen/AsmCodeGen.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/compiler/nativeGen/AsmCodeGen.hs b/compiler/nativeGen/AsmCodeGen.hs index 11bd8a1..ec6f113 100644 --- a/compiler/nativeGen/AsmCodeGen.hs +++ b/compiler/nativeGen/AsmCodeGen.hs @@ -98,7 +98,7 @@ import Data.Maybe import Data.Ord ( comparing ) import Control.Exception import Control.Monad -import System.IO (Handle) +import System.IO {- The native-code generator has machine-independent and @@ -330,6 +330,7 @@ nativeCodeGen' :: (Outputable statics, Outputable instr, Instruction instr) -> IO UniqSupply nativeCodeGen' dflags this_mod modLoc ncgImpl h us cmms = do + hSetEncoding h latin1 let ngs0 = NGS [] [] [] [] [] [] emptyUFM mapEmpty (ngs, us') <- cmmNativeGenStream dflags this_mod modLoc ncgImpl h us cmms ngs0 From git at git.haskell.org Wed Aug 16 23:02:41 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 16 Aug 2017 23:02:41 +0000 (UTC) Subject: [commit: ghc] master: Allow TcDerivInfer to compile with GHC 8.0.1 (b0ed07f) Message-ID: <20170816230241.E30383A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b0ed07fafbe96c3eee6c7f41ef937973bedbf1dc/ghc >--------------------------------------------------------------- commit b0ed07fafbe96c3eee6c7f41ef937973bedbf1dc Author: Ben Gamari Date: Wed Aug 16 19:01:59 2017 -0400 Allow TcDerivInfer to compile with GHC 8.0.1 As of ed7a830de6a2ea74dd6bb81f8ec55b9fe0b52f28 this module uses MultiWayIf, the parsing behavior of which changed in 8.0.2 due to #10807. Reformat the code so that it compiles under both 8.0.1 and 8.0.2/8.2.1. Test Plan: Validate bootstrapping with 8.0.1 Reviewers: austin Subscribers: rwbarton, thomie, RyanGlScott GHC Trac Issues: #14130 Differential Revision: https://phabricator.haskell.org/D3863 >--------------------------------------------------------------- b0ed07fafbe96c3eee6c7f41ef937973bedbf1dc compiler/typecheck/TcDerivInfer.hs | 42 +++++++++++++++++++------------------- 1 file changed, 21 insertions(+), 21 deletions(-) diff --git a/compiler/typecheck/TcDerivInfer.hs b/compiler/typecheck/TcDerivInfer.hs index 85ff250..81bbfd9 100644 --- a/compiler/typecheck/TcDerivInfer.hs +++ b/compiler/typecheck/TcDerivInfer.hs @@ -247,34 +247,34 @@ inferConstraintsDataConArgs inst_ty inst_tys if -- Generic constraints are easy | is_generic - -> return ([], tvs, inst_tys) + -> return ([], tvs, inst_tys) -- Generic1 needs Functor -- See Note [Getting base classes] | is_generic1 - -> ASSERT( rep_tc_tvs `lengthExceeds` 0 ) - -- Generic1 has a single kind variable - ASSERT( cls_tys `lengthIs` 1 ) - do { functorClass <- lift $ tcLookupClass functorClassName - ; pure $ con_arg_constraints - $ get_gen1_constraints functorClass } + -> ASSERT( rep_tc_tvs `lengthExceeds` 0 ) + -- Generic1 has a single kind variable + ASSERT( cls_tys `lengthIs` 1 ) + do { functorClass <- lift $ tcLookupClass functorClassName + ; pure $ con_arg_constraints + $ get_gen1_constraints functorClass } -- The others are a bit more complicated | otherwise - -> -- See the comment with all_rep_tc_args for an explanation of - -- this assertion - ASSERT2( equalLength rep_tc_tvs all_rep_tc_args - , ppr main_cls <+> ppr rep_tc - $$ ppr rep_tc_tvs $$ ppr all_rep_tc_args ) - do { let (arg_constraints, tvs', inst_tys') - = con_arg_constraints get_std_constrained_tys - ; lift $ traceTc "inferConstraintsDataConArgs" $ vcat - [ ppr main_cls <+> ppr inst_tys' - , ppr arg_constraints - ] - ; return ( stupid_constraints ++ extra_constraints - ++ arg_constraints - , tvs', inst_tys') } + -> -- See the comment with all_rep_tc_args for an explanation of + -- this assertion + ASSERT2( equalLength rep_tc_tvs all_rep_tc_args + , ppr main_cls <+> ppr rep_tc + $$ ppr rep_tc_tvs $$ ppr all_rep_tc_args ) + do { let (arg_constraints, tvs', inst_tys') + = con_arg_constraints get_std_constrained_tys + ; lift $ traceTc "inferConstraintsDataConArgs" $ vcat + [ ppr main_cls <+> ppr inst_tys' + , ppr arg_constraints + ] + ; return ( stupid_constraints ++ extra_constraints + ++ arg_constraints + , tvs', inst_tys') } typeToTypeKind :: Kind typeToTypeKind = liftedTypeKind `mkFunTy` liftedTypeKind From git at git.haskell.org Wed Aug 16 23:02:45 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 16 Aug 2017 23:02:45 +0000 (UTC) Subject: [commit: ghc] master: Speed up compilation of profiling stubs (a8da0de) Message-ID: <20170816230245.25C003A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a8da0de27e600211f04601ac737c329d6603c700/ghc >--------------------------------------------------------------- commit a8da0de27e600211f04601ac737c329d6603c700 Author: Ben Gamari Date: Wed Aug 16 19:01:05 2017 -0400 Speed up compilation of profiling stubs Here we encode the cost centre list as static data. This means that the initialization stubs are small functions which should be easy for GCC to compile, even with optimization. Fixes #7960. Test Plan: Test profiling Reviewers: austin, erikd, simonmar Reviewed By: simonmar Subscribers: rwbarton, thomie GHC Trac Issues: #7960 Differential Revision: https://phabricator.haskell.org/D3853 >--------------------------------------------------------------- a8da0de27e600211f04601ac737c329d6603c700 compiler/profiling/ProfInit.hs | 46 +++++++++++++++++++++----------- includes/Rts.h | 1 + includes/rts/{Parallel.h => Profiling.h} | 7 ++--- rts/Profiling.c | 19 +++++++++++++ 4 files changed, 55 insertions(+), 18 deletions(-) diff --git a/compiler/profiling/ProfInit.hs b/compiler/profiling/ProfInit.hs index 9add61e..0de8069 100644 --- a/compiler/profiling/ProfInit.hs +++ b/compiler/profiling/ProfInit.hs @@ -12,7 +12,6 @@ import CLabel import CostCentre import DynFlags import Outputable -import FastString import Module -- ----------------------------------------------------------------------------- @@ -27,20 +26,37 @@ profilingInitCode this_mod (local_CCs, ___extern_CCs, singleton_CCSs) if not (gopt Opt_SccProfilingOn dflags) then empty else vcat - [ text "static void prof_init_" <> ppr this_mod - <> text "(void) __attribute__((constructor));" - , text "static void prof_init_" <> ppr this_mod <> text "(void)" - , braces (vcat ( - map emitRegisterCC local_CCs ++ - map emitRegisterCCS singleton_CCSs - )) - ] + $ map emit_cc_decl local_CCs + ++ map emit_ccs_decl singleton_CCSs + ++ [emit_cc_list local_CCs] + ++ [emit_ccs_list singleton_CCSs] + ++ [ text "static void prof_init_" <> ppr this_mod + <> text "(void) __attribute__((constructor));" + , text "static void prof_init_" <> ppr this_mod <> text "(void)" + , braces (vcat + [ text "registerCcList" <> parens local_cc_list_label <> semi + , text "registerCcsList" <> parens singleton_cc_list_label <> semi + ]) + ] where - emitRegisterCC cc = - text "extern CostCentre " <> cc_lbl <> ptext (sLit "[];") $$ - text "REGISTER_CC(" <> cc_lbl <> char ')' <> semi + emit_cc_decl cc = + text "extern CostCentre" <+> cc_lbl <> text "[];" where cc_lbl = ppr (mkCCLabel cc) - emitRegisterCCS ccs = - text "extern CostCentreStack " <> ccs_lbl <> ptext (sLit "[];") $$ - text "REGISTER_CCS(" <> ccs_lbl <> char ')' <> semi + local_cc_list_label = text "local_cc_" <> ppr this_mod + emit_cc_list ccs = + text "static CostCentre *" <> local_cc_list_label <> text "[] =" + <+> braces (vcat $ [ ppr (mkCCLabel cc) <> comma + | cc <- ccs + ] ++ [text "NULL"]) + <> semi + + emit_ccs_decl ccs = + text "extern CostCentreStack" <+> ccs_lbl <> text "[];" where ccs_lbl = ppr (mkCCSLabel ccs) + singleton_cc_list_label = text "singleton_cc_" <> ppr this_mod + emit_ccs_list ccs = + text "static CostCentreStack *" <> singleton_cc_list_label <> text "[] =" + <+> braces (vcat $ [ ppr (mkCCSLabel cc) <> comma + | cc <- ccs + ] ++ [text "NULL"]) + <> semi diff --git a/includes/Rts.h b/includes/Rts.h index a59a8ca..dd81033 100644 --- a/includes/Rts.h +++ b/includes/Rts.h @@ -202,6 +202,7 @@ void _assertFail(const char *filename, unsigned int linenum) #include "rts/Utils.h" #include "rts/PrimFloat.h" #include "rts/Main.h" +#include "rts/Profiling.h" #include "rts/StaticPtrTable.h" #include "rts/Libdw.h" #include "rts/LibdwPool.h" diff --git a/includes/rts/Parallel.h b/includes/rts/Profiling.h similarity index 72% copy from includes/rts/Parallel.h copy to includes/rts/Profiling.h index de1c6e1..f1dafb7 100644 --- a/includes/rts/Parallel.h +++ b/includes/rts/Profiling.h @@ -1,8 +1,8 @@ /* ----------------------------------------------------------------------------- * - * (c) The GHC Team, 1998-2009 + * (c) The GHC Team, 2017-2018 * - * Parallelism-related functionality + * Cost-centre profiling API * * Do not #include this file directly: #include "Rts.h" instead. * @@ -13,4 +13,5 @@ #pragma once -StgInt newSpark (StgRegTable *reg, StgClosure *p); +void registerCcList(CostCentre **cc_list); +void registerCcsList(CostCentreStack **cc_list); diff --git a/rts/Profiling.c b/rts/Profiling.c index 9523572..803f86b 100644 --- a/rts/Profiling.c +++ b/rts/Profiling.c @@ -307,6 +307,25 @@ endProfiling ( void ) } } + +/* + These are used in the C stubs produced by the code generator + to register code. + */ +void registerCcList(CostCentre **cc_list) +{ + for (CostCentre **i = cc_list; *i != NULL; i++) { + REGISTER_CC(*i); + } +} + +void registerCcsList(CostCentreStack **cc_list) +{ + for (CostCentreStack **i = cc_list; *i != NULL; i++) { + REGISTER_CCS(*i); + } +} + /* ----------------------------------------------------------------------------- Set CCCS when entering a function. From git at git.haskell.org Wed Aug 16 23:02:56 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 16 Aug 2017 23:02:56 +0000 (UTC) Subject: [commit: ghc] wip/jenkins: testsuite/junit: Flip type and message (8eb408b) Message-ID: <20170816230256.C703D3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/jenkins Link : http://ghc.haskell.org/trac/ghc/changeset/8eb408b954f48c2f37434f7405361a00d9e959b2/ghc >--------------------------------------------------------------- commit 8eb408b954f48c2f37434f7405361a00d9e959b2 Author: Ben Gamari Date: Mon Jul 31 08:44:40 2017 -0400 testsuite/junit: Flip type and message type apparently can't contain < characters. >--------------------------------------------------------------- 8eb408b954f48c2f37434f7405361a00d9e959b2 testsuite/driver/junit.py | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/testsuite/driver/junit.py b/testsuite/driver/junit.py index 01a5f47..f9689de 100644 --- a/testsuite/driver/junit.py +++ b/testsuite/driver/junit.py @@ -18,8 +18,8 @@ def junit(t): classname = testname, name = way) result = ET.SubElement(testcase, 'failure', - type = result, - message = reason) + type = reason, + message = result) for (directory, testname, reason, way) in t.framework_failures: testcase = ET.SubElement(testsuite, 'testcase', From git at git.haskell.org Wed Aug 16 23:02:59 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 16 Aug 2017 23:02:59 +0000 (UTC) Subject: [commit: ghc] wip/jenkins: Fix whitespace (ed2a53b) Message-ID: <20170816230259.8B6DE3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/jenkins Link : http://ghc.haskell.org/trac/ghc/changeset/ed2a53b4a8f0bc27b5eddca476c9e82a17b60d2b/ghc >--------------------------------------------------------------- commit ed2a53b4a8f0bc27b5eddca476c9e82a17b60d2b Author: Ben Gamari Date: Sun Jul 30 23:09:03 2017 -0400 Fix whitespace >--------------------------------------------------------------- ed2a53b4a8f0bc27b5eddca476c9e82a17b60d2b Jenkinsfile | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/Jenkinsfile b/Jenkinsfile index 23b6ced..8501f87 100644 --- a/Jenkinsfile +++ b/Jenkinsfile @@ -315,11 +315,11 @@ def nofib(params) { stage('Run nofib') { installPkgs(['regex-compat']) sh """ - cd nofib - ${makeCmd} clean - ${makeCmd} boot - ${makeCmd} >../nofib.log 2>&1 - """ + cd nofib + ${makeCmd} clean + ${makeCmd} boot + ${makeCmd} >../nofib.log 2>&1 + """ archiveArtifacts artifacts: 'nofib.log' } } From git at git.haskell.org Wed Aug 16 23:03:02 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 16 Aug 2017 23:03:02 +0000 (UTC) Subject: [commit: ghc] wip/jenkins: Fix JUnit (097f485) Message-ID: <20170816230302.6F8AF3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/jenkins Link : http://ghc.haskell.org/trac/ghc/changeset/097f4855c06f142f23d38c25f118e020e3dcb950/ghc >--------------------------------------------------------------- commit 097f4855c06f142f23d38c25f118e020e3dcb950 Author: Ben Gamari Date: Fri Jul 28 19:06:29 2017 -0400 Fix JUnit >--------------------------------------------------------------- 097f4855c06f142f23d38c25f118e020e3dcb950 Jenkinsfile | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Jenkinsfile b/Jenkinsfile index ee6a884..23b6ced 100644 --- a/Jenkinsfile +++ b/Jenkinsfile @@ -302,8 +302,8 @@ def testGhc(params) { if (params.nightly) { target = 'slowtest' } - sh "${makeCmd} -Ctestsuite/tests LOCAL=0 BINDIST=YES THREADS=${env.THREADS} TEST_HC=\"${testGhc}\" ${target}" - junit 'testsuite*.xml' + sh "${makeCmd} -Ctestsuite/tests LOCAL=0 BINDIST=YES THREADS=${env.THREADS} TEST_HC=\"${testGhc}\" JUNIT_FILE=testsuite.xml ${target}" + junit 'testsuite.xml' } } } From git at git.haskell.org Wed Aug 16 23:03:08 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 16 Aug 2017 23:03:08 +0000 (UTC) Subject: [commit: ghc] wip/jenkins: Fix junit output path (4411266) Message-ID: <20170816230308.A30C33A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/jenkins Link : http://ghc.haskell.org/trac/ghc/changeset/44112662e2ddb888dc4048a4236d168c43fffb28/ghc >--------------------------------------------------------------- commit 44112662e2ddb888dc4048a4236d168c43fffb28 Author: Ben Gamari Date: Mon Jul 31 00:41:25 2017 -0400 Fix junit output path >--------------------------------------------------------------- 44112662e2ddb888dc4048a4236d168c43fffb28 Jenkinsfile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Jenkinsfile b/Jenkinsfile index 7eac8ff..c86060c 100644 --- a/Jenkinsfile +++ b/Jenkinsfile @@ -302,7 +302,7 @@ def testGhc(params) { if (params.nightly) { target = 'slowtest' } - sh "${makeCmd} -Ctestsuite/tests LOCAL=0 BINDIST=YES THREADS=${env.THREADS} TEST_HC=\"${testGhc}\" JUNIT_FILE=testsuite.xml ${target}" + sh "${makeCmd} -Ctestsuite/tests LOCAL=0 BINDIST=YES THREADS=${env.THREADS} TEST_HC=\"${testGhc}\" JUNIT_FILE=../../testsuite.xml ${target}" junit 'testsuite.xml' } } From git at git.haskell.org Wed Aug 16 23:03:05 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 16 Aug 2017 23:03:05 +0000 (UTC) Subject: [commit: ghc] wip/jenkins: Testing simpler Jenkinsfile (cbd85e1) Message-ID: <20170816230305.E21C63A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/jenkins Link : http://ghc.haskell.org/trac/ghc/changeset/cbd85e1b7169bb4aa3a3f16595371c2abd1dee89/ghc >--------------------------------------------------------------- commit cbd85e1b7169bb4aa3a3f16595371c2abd1dee89 Author: Ben Gamari Date: Fri Apr 21 14:29:34 2017 -0400 Testing simpler Jenkinsfile >--------------------------------------------------------------- cbd85e1b7169bb4aa3a3f16595371c2abd1dee89 Jenkinsfile | 366 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Makefile | 4 + ghc.mk | 4 + mk/config.mk.in | 2 +- 4 files changed, 375 insertions(+), 1 deletion(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc cbd85e1b7169bb4aa3a3f16595371c2abd1dee89 From git at git.haskell.org Wed Aug 16 23:03:11 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 16 Aug 2017 23:03:11 +0000 (UTC) Subject: [commit: ghc] wip/jenkins: Bump GHC to 8.2.1 (942072c) Message-ID: <20170816230311.646FF3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/jenkins Link : http://ghc.haskell.org/trac/ghc/changeset/942072c4c0d1961b40d948ad25215250c9b269b5/ghc >--------------------------------------------------------------- commit 942072c4c0d1961b40d948ad25215250c9b269b5 Author: Ben Gamari Date: Sun Jul 30 23:09:12 2017 -0400 Bump GHC to 8.2.1 >--------------------------------------------------------------- 942072c4c0d1961b40d948ad25215250c9b269b5 Jenkinsfile | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Jenkinsfile b/Jenkinsfile index 8501f87..7eac8ff 100644 --- a/Jenkinsfile +++ b/Jenkinsfile @@ -119,11 +119,11 @@ def withMingw(String msystem, Closure f) { if (msystem == 'MINGW32') { prefix = "${msysRoot}\\mingw32" carch = 'i686' - ghcPath = "${home}/ghc-8.0.1-i386/bin" + ghcPath = "${home}/ghc-8.2.1-i386/bin" } else if (msystem == 'MINGW64') { prefix = "${msysRoot}\\mingw64" carch = 'x86_64' - ghcPath = "${home}/ghc-8.0.2-x86_64/bin" + ghcPath = "${home}/ghc-8.2.1-x86_64/bin" } else { fail } From git at git.haskell.org Wed Aug 16 23:03:14 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 16 Aug 2017 23:03:14 +0000 (UTC) Subject: [commit: ghc] wip/jenkins: testsuite/junit: Properly escape strings (7cf2b89) Message-ID: <20170816230314.2CE123A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/jenkins Link : http://ghc.haskell.org/trac/ghc/changeset/7cf2b89d84584fb09df3a0822a9c1a82960ad806/ghc >--------------------------------------------------------------- commit 7cf2b89d84584fb09df3a0822a9c1a82960ad806 Author: Ben Gamari Date: Mon Jul 31 11:36:49 2017 -0400 testsuite/junit: Properly escape strings >--------------------------------------------------------------- 7cf2b89d84584fb09df3a0822a9c1a82960ad806 testsuite/driver/junit.py | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/testsuite/driver/junit.py b/testsuite/driver/junit.py index f9689de..4015c19 100644 --- a/testsuite/driver/junit.py +++ b/testsuite/driver/junit.py @@ -1,5 +1,6 @@ from datetime import datetime import xml.etree.ElementTree as ET +from xml.sax.saxutils import escape def junit(t): testsuites = ET.Element('testsuites') @@ -18,21 +19,21 @@ def junit(t): classname = testname, name = way) result = ET.SubElement(testcase, 'failure', - type = reason, - message = result) + type = 'unexpected failure', + message = escape(reason)) for (directory, testname, reason, way) in t.framework_failures: testcase = ET.SubElement(testsuite, 'testcase', classname = testname, - name = way) + name = escape(way)) result = ET.SubElement(testcase, 'error', type = "framework failure", - message = reason) + message = escape(reason)) for (directory, testname, way) in t.expected_passes: testcase = ET.SubElement(testsuite, 'testcase', classname = testname, - name = way) + name = escape(way)) return ET.ElementTree(testsuites) From git at git.haskell.org Wed Aug 16 23:03:17 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 16 Aug 2017 23:03:17 +0000 (UTC) Subject: [commit: ghc] wip/jenkins's head updated: testsuite/junit: Properly escape strings (7cf2b89) Message-ID: <20170816230317.135E73A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/jenkins' now includes: a8da0de Speed up compilation of profiling stubs b0ed07f Allow TcDerivInfer to compile with GHC 8.0.1 cbd85e1 Testing simpler Jenkinsfile 097f485 Fix JUnit ed2a53b Fix whitespace 942072c Bump GHC to 8.2.1 4411266 Fix junit output path 8eb408b testsuite/junit: Flip type and message 7cf2b89 testsuite/junit: Properly escape strings From git at git.haskell.org Thu Aug 17 14:16:35 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 17 Aug 2017 14:16:35 +0000 (UTC) Subject: [commit: ghc] master: Fix #13972 by producing tidier errors (38260a9) Message-ID: <20170817141635.0F8C43A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/38260a9e9f8c38edd25f4b4c06e0ea5d88fc6bf2/ghc >--------------------------------------------------------------- commit 38260a9e9f8c38edd25f4b4c06e0ea5d88fc6bf2 Author: Ryan Scott Date: Thu Aug 17 10:06:32 2017 -0400 Fix #13972 by producing tidier errors Summary: Previously, one could experience an error message like this: ``` Expected: T (a -> Either a b) Actual: T (a -> Either a b) ``` This makes the error message an iota clearer by tidying it first, which will instead produce: ``` Expected: T (a1 -> Either a1 b1) Actual: T (a -> Either a b) ``` Which steers users towards the understanding that the two sets of tyvars are actually different. Test Plan: make test TEST=T13972 Reviewers: simonpj, austin, bgamari, goldfire Reviewed By: goldfire Subscribers: goldfire, rwbarton, thomie GHC Trac Issues: #13972 Differential Revision: https://phabricator.haskell.org/D3820 >--------------------------------------------------------------- 38260a9e9f8c38edd25f4b4c06e0ea5d88fc6bf2 compiler/typecheck/TcValidity.hs | 15 ++++++++++++--- testsuite/tests/indexed-types/should_fail/T13972.hs | 12 ++++++++++++ testsuite/tests/indexed-types/should_fail/T13972.stderr | 7 +++++++ testsuite/tests/indexed-types/should_fail/all.T | 1 + 4 files changed, 32 insertions(+), 3 deletions(-) diff --git a/compiler/typecheck/TcValidity.hs b/compiler/typecheck/TcValidity.hs index bd4938e..65c7afd 100644 --- a/compiler/typecheck/TcValidity.hs +++ b/compiler/typecheck/TcValidity.hs @@ -1555,8 +1555,8 @@ checkConsistentFamInst (Just (clas, inst_tvs, mini_env)) fam_tc at_tys pp_hs_pat ; checkTc (all check_arg type_shapes) pp_wrong_at_arg -- And now kind args - ; checkTc (all check_arg kind_shapes) - (pp_wrong_at_arg $$ ppSuggestExplicitKinds) + ; checkTcM (all check_arg kind_shapes) + (tidy_env2, pp_wrong_at_arg $$ ppSuggestExplicitKinds) ; traceTc "cfi" (vcat [ ppr inst_tvs , ppr arg_shapes @@ -1585,7 +1585,16 @@ checkConsistentFamInst (Just (clas, inst_tvs, mini_env)) fam_tc at_tys pp_hs_pat vcat [ text "where the `' arguments are type variables," , text "distinct from each other and from the instance variables" ] ] - expected_args = [ exp_ty `orElse` mk_tv at_ty | (exp_ty, at_ty) <- arg_shapes ] + -- We need to tidy, since it's possible that expected_args will contain + -- inferred kind variables with names identical to those in at_tys. If we + -- don't, we'll end up with horrible messages like this one (#13972): + -- + -- Expected: T (a -> Either a b) + -- Actual: T (a -> Either a b) + (tidy_env1, _) = tidyOpenTypes emptyTidyEnv at_tys + (tidy_env2, expected_args) + = tidyOpenTypes tidy_env1 [ exp_ty `orElse` mk_tv at_ty + | (exp_ty, at_ty) <- arg_shapes ] mk_tv at_ty = mkTyVarTy (mkTyVar tv_name (typeKind at_ty)) tv_name = mkInternalName (mkAlphaTyVarUnique 1) (mkTyVarOcc "") noSrcSpan diff --git a/testsuite/tests/indexed-types/should_fail/T13972.hs b/testsuite/tests/indexed-types/should_fail/T13972.hs new file mode 100644 index 0000000..8a43e20 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T13972.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeInType #-} +module Bug where + +import Data.Kind + +class C (a :: k) where + type T k :: Type + +instance C Left where + type T (a -> Either a b) = Int diff --git a/testsuite/tests/indexed-types/should_fail/T13972.stderr b/testsuite/tests/indexed-types/should_fail/T13972.stderr new file mode 100644 index 0000000..b1f05b3 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T13972.stderr @@ -0,0 +1,7 @@ + +T13972.hs:12:8: error: + • Type indexes must match class instance head + Expected: T (a1 -> Either a1 b1) + Actual: T (a -> Either a b) + • In the type instance declaration for ‘T’ + In the instance declaration for ‘C Left’ diff --git a/testsuite/tests/indexed-types/should_fail/all.T b/testsuite/tests/indexed-types/should_fail/all.T index c3a2f16..ee4fcce 100644 --- a/testsuite/tests/indexed-types/should_fail/all.T +++ b/testsuite/tests/indexed-types/should_fail/all.T @@ -136,5 +136,6 @@ test('T13271', normal, compile_fail, ['']) test('T13674', normal, compile_fail, ['']) test('T13784', normal, compile_fail, ['']) test('T13877', normal, compile_fail, ['']) +test('T13972', normal, compile_fail, ['']) test('T14033', normal, compile_fail, ['']) test('T14045a', normal, compile_fail, ['']) From git at git.haskell.org Thu Aug 17 14:16:38 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 17 Aug 2017 14:16:38 +0000 (UTC) Subject: [commit: ghc] master: Suggest how to fix illegally nested foralls in GADT constructor type signatures (039fa1b) Message-ID: <20170817141638.87B873A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/039fa1b994a8b0d6be25eb1bc711904db9661db2/ghc >--------------------------------------------------------------- commit 039fa1b994a8b0d6be25eb1bc711904db9661db2 Author: Ryan Scott Date: Thu Aug 17 10:07:03 2017 -0400 Suggest how to fix illegally nested foralls in GADT constructor type signatures Summary: Although the code from #12087 isn't accepted by GHC, we can at least do a better job of letting users know what the problem is, and how to fix it. Test Plan: make test TEST=T12087 Reviewers: goldfire, austin, bgamari Reviewed By: goldfire Subscribers: rwbarton, thomie GHC Trac Issues: #12087 Differential Revision: https://phabricator.haskell.org/D3851 >--------------------------------------------------------------- 039fa1b994a8b0d6be25eb1bc711904db9661db2 compiler/typecheck/TcTyClsDecls.hs | 43 ++++++++++++++++++++++++++++++++++++++ testsuite/tests/gadt/T12087.hs | 18 ++++++++++++++++ testsuite/tests/gadt/T12087.stderr | 35 +++++++++++++++++++++++++++++++ testsuite/tests/gadt/all.T | 1 + 4 files changed, 97 insertions(+) diff --git a/compiler/typecheck/TcTyClsDecls.hs b/compiler/typecheck/TcTyClsDecls.hs index ba35db5..0974fe5 100644 --- a/compiler/typecheck/TcTyClsDecls.hs +++ b/compiler/typecheck/TcTyClsDecls.hs @@ -3138,9 +3138,52 @@ noClassTyVarErr clas fam_tc badDataConTyCon :: DataCon -> Type -> Type -> SDoc badDataConTyCon data_con res_ty_tmpl actual_res_ty + | tcIsForAllTy actual_res_ty + = nested_foralls_contexts_suggestion + | isJust (tcSplitPredFunTy_maybe actual_res_ty) + = nested_foralls_contexts_suggestion + | otherwise = hang (text "Data constructor" <+> quotes (ppr data_con) <+> text "returns type" <+> quotes (ppr actual_res_ty)) 2 (text "instead of an instance of its parent type" <+> quotes (ppr res_ty_tmpl)) + where + -- This suggestion is useful for suggesting how to correct code like what + -- was reported in Trac #12087: + -- + -- data F a where + -- MkF :: Ord a => Eq a => a -> F a + -- + -- Although nested foralls or contexts are allowed in function type + -- signatures, it is much more difficult to engineer GADT constructor type + -- signatures to allow something similar, so we error in the latter case. + -- Nevertheless, we can at least suggest how a user might reshuffle their + -- exotic GADT constructor type signature so that GHC will accept. + nested_foralls_contexts_suggestion = + text "GADT constructor type signature cannot contain nested" + <+> quotes forAllLit <> text "s or contexts" + $+$ hang (text "Suggestion: instead use this type signature:") + 2 (ppr (dataConName data_con) <+> dcolon <+> ppr suggested_ty) + + -- To construct a type that GHC would accept (suggested_ty), we: + -- + -- 1) Find the existentially quantified type variables and the class + -- predicates from the datacon. (NB: We don't need the universally + -- quantified type variables, since rejigConRes won't substitute them in + -- the result type if it fails, as in this scenario.) + -- 2) Split apart the return type (which is headed by a forall or a + -- context) using tcSplitNestedSigmaTys, collecting the type variables + -- and class predicates we find, as well as the rho type lurking + -- underneath the nested foralls and contexts. + -- 3) Smash together the type variables and class predicates from 1) and + -- 2), and prepend them to the rho type from 2). + actual_ex_tvs = dataConExTyVarBinders data_con + actual_theta = dataConTheta data_con + (actual_res_tvs, actual_res_theta, actual_res_rho) + = tcSplitNestedSigmaTys actual_res_ty + actual_res_tvbs = mkTyVarBinders Specified actual_res_tvs + suggested_ty = mkForAllTys (actual_ex_tvs ++ actual_res_tvbs) $ + mkFunTys (actual_theta ++ actual_res_theta) + actual_res_rho badGadtDecl :: Name -> SDoc badGadtDecl tc_name diff --git a/testsuite/tests/gadt/T12087.hs b/testsuite/tests/gadt/T12087.hs new file mode 100644 index 0000000..e56240c --- /dev/null +++ b/testsuite/tests/gadt/T12087.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE RankNTypes #-} +module T12087 where + +data F1 a where + MkF1 :: Ord a => Eq a => a -> F1 a + +data F2 a where + MkF2 :: Ord a => a -> Eq a => F2 a + +data F3 a where + MkF3 :: forall a. Eq a => a -> forall b. Eq b => b -> F3 a + +data F4 a where + MkF4 :: forall a b. Eq a => a -> Eq b => b -> F4 a + +data F5 a where + MkF5 :: Int -> Int -> forall a. a -> Int -> Int -> forall b. b -> F5 a diff --git a/testsuite/tests/gadt/T12087.stderr b/testsuite/tests/gadt/T12087.stderr new file mode 100644 index 0000000..03f2465 --- /dev/null +++ b/testsuite/tests/gadt/T12087.stderr @@ -0,0 +1,35 @@ + +T12087.hs:6:3: error: + • GADT constructor type signature cannot contain nested ‘forall’s or contexts + Suggestion: instead use this type signature: + MkF1 :: forall a. (Ord a, Eq a) => a -> F1 a + • In the definition of data constructor ‘MkF1’ + In the data type declaration for ‘F1’ + +T12087.hs:9:3: error: + • GADT constructor type signature cannot contain nested ‘forall’s or contexts + Suggestion: instead use this type signature: + MkF2 :: forall a. (Ord a, Eq a) => F2 a + • In the definition of data constructor ‘MkF2’ + In the data type declaration for ‘F2’ + +T12087.hs:12:3: error: + • GADT constructor type signature cannot contain nested ‘forall’s or contexts + Suggestion: instead use this type signature: + MkF3 :: forall a b. (Eq a, Eq b) => b -> F3 a + • In the definition of data constructor ‘MkF3’ + In the data type declaration for ‘F3’ + +T12087.hs:15:3: error: + • GADT constructor type signature cannot contain nested ‘forall’s or contexts + Suggestion: instead use this type signature: + MkF4 :: forall a b. (Eq a, Eq b) => b -> F4 a + • In the definition of data constructor ‘MkF4’ + In the data type declaration for ‘F4’ + +T12087.hs:18:3: error: + • GADT constructor type signature cannot contain nested ‘forall’s or contexts + Suggestion: instead use this type signature: + MkF5 :: forall a b. a -> Int -> Int -> b -> F5 a + • In the definition of data constructor ‘MkF5’ + In the data type declaration for ‘F5’ diff --git a/testsuite/tests/gadt/all.T b/testsuite/tests/gadt/all.T index 877943b..3c825f0 100644 --- a/testsuite/tests/gadt/all.T +++ b/testsuite/tests/gadt/all.T @@ -112,4 +112,5 @@ test('T7974', normal, compile, ['']) test('T7558', normal, compile_fail, ['']) test('T9096', normal, compile, ['']) test('T9380', normal, compile_and_run, ['']) +test('T12087', normal, compile_fail, ['']) test('T12468', normal, compile_fail, ['']) From git at git.haskell.org Thu Aug 17 14:16:41 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 17 Aug 2017 14:16:41 +0000 (UTC) Subject: [commit: ghc] master: Fix #11785 by making reifyKind = reifyType (c948b78) Message-ID: <20170817141641.42ED73A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c948b7865ace38d3d6912db0fc271aa7e9f70d2b/ghc >--------------------------------------------------------------- commit c948b7865ace38d3d6912db0fc271aa7e9f70d2b Author: Ryan Scott Date: Thu Aug 17 10:07:32 2017 -0400 Fix #11785 by making reifyKind = reifyType Summary: This ties up the last loose end in Template Haskell's separate code paths for types and kinds. By making `reifyKind = reifyType` in `TcSplice`, types and kinds are now treated on equal terms in TH. This is itself a small patch, but most of the heavy lifting to make this possible was done in ad7b945257ea262e3f6f46daa4ff3e451aeeae0b. Test Plan: ./validate Reviewers: goldfire, austin, bgamari Reviewed By: goldfire Subscribers: rwbarton, thomie GHC Trac Issues: #11785 Differential Revision: https://phabricator.haskell.org/D3854 >--------------------------------------------------------------- c948b7865ace38d3d6912db0fc271aa7e9f70d2b compiler/typecheck/TcSplice.hs | 30 +++--------------------------- 1 file changed, 3 insertions(+), 27 deletions(-) diff --git a/compiler/typecheck/TcSplice.hs b/compiler/typecheck/TcSplice.hs index 6df78f8..8b5ed7d 100644 --- a/compiler/typecheck/TcSplice.hs +++ b/compiler/typecheck/TcSplice.hs @@ -1675,6 +1675,8 @@ reifyFamilyInstance is_poly_tvs inst@(FamInst { fi_flavor = flavor ------------------------------ reifyType :: TyCoRep.Type -> TcM TH.Type -- Monadic only because of failure +reifyType ty | isLiftedTypeKind ty = return TH.StarT + | isConstraintKind ty = return TH.ConstraintT reifyType ty@(ForAllTy {}) = reify_for_all ty reifyType (LitTy t) = do { r <- reifyTyLit t; return (TH.LitT r) } reifyType (TyVarTy tv) = return (TH.VarT (reifyName tv)) @@ -1717,33 +1719,7 @@ reifyPatSynType (univTyVars, req, exTyVars, prov, argTys, resTy) $ TH.ForallT exTyVars' prov' tau' } reifyKind :: Kind -> TcM TH.Kind -reifyKind ki - = do { let (kis, ki') = splitFunTys ki - ; ki'_rep <- reifyNonArrowKind ki' - ; kis_rep <- mapM reifyKind kis - ; return (foldr (TH.AppT . TH.AppT TH.ArrowT) ki'_rep kis_rep) } - where - reifyNonArrowKind k | isLiftedTypeKind k = return TH.StarT - | isConstraintKind k = return TH.ConstraintT - reifyNonArrowKind (TyVarTy v) = return (TH.VarT (reifyName v)) - reifyNonArrowKind (FunTy _ k) = reifyKind k - reifyNonArrowKind (ForAllTy _ k) = reifyKind k - reifyNonArrowKind (TyConApp kc kis) = reify_kc_app kc kis - reifyNonArrowKind (AppTy k1 k2) = do { k1' <- reifyKind k1 - ; k2' <- reifyKind k2 - ; return (TH.AppT k1' k2') - } - reifyNonArrowKind k = noTH (sLit "this kind") (ppr k) - -reify_kc_app :: TyCon -> [TyCoRep.Kind] -> TcM TH.Kind -reify_kc_app kc kis - = fmap (mkThAppTs r_kc) (mapM reifyKind vis_kis) - where - r_kc | isTupleTyCon kc = TH.TupleT (tyConArity kc) - | kc `hasKey` listTyConKey = TH.ListT - | otherwise = TH.ConT (reifyName kc) - - vis_kis = filterOutInvisibleTypes kc kis +reifyKind = reifyType reifyCxt :: [PredType] -> TcM [TH.Pred] reifyCxt = mapM reifyPred From git at git.haskell.org Thu Aug 17 20:43:11 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 17 Aug 2017 20:43:11 +0000 (UTC) Subject: [commit: ghc] master: Doctest for Void.absurd (36d1b08) Message-ID: <20170817204311.2C1E83A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/36d1b08308fdc90e2abaf36cc95ad1a97c0fa8bb/ghc >--------------------------------------------------------------- commit 36d1b08308fdc90e2abaf36cc95ad1a97c0fa8bb Author: David Luposchainsky Date: Fri Aug 11 10:38:24 2017 +0200 Doctest for Void.absurd >--------------------------------------------------------------- 36d1b08308fdc90e2abaf36cc95ad1a97c0fa8bb libraries/base/Data/Void.hs | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/libraries/base/Data/Void.hs b/libraries/base/Data/Void.hs index fd4c0b5..d7fa179 100644 --- a/libraries/base/Data/Void.hs +++ b/libraries/base/Data/Void.hs @@ -67,6 +67,14 @@ instance Exception Void -- | Since 'Void' values logically don't exist, this witnesses the -- logical reasoning tool of \"ex falso quodlibet\". -- +-- >>> let x :: Either Void Int; x = Right 5 +-- >>> :{ +-- case x of +-- Right r -> r +-- Left l -> absurd l +-- :} +-- 5 +-- -- @since 4.8.0.0 absurd :: Void -> a absurd a = case a of {} From git at git.haskell.org Thu Aug 17 20:43:13 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 17 Aug 2017 20:43:13 +0000 (UTC) Subject: [commit: ghc] master: Mention the category laws explicitly (f762181) Message-ID: <20170817204313.E96313A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f762181ec0f48f1af9dd6d367f2a521d13988808/ghc >--------------------------------------------------------------- commit f762181ec0f48f1af9dd6d367f2a521d13988808 Author: David Luposchainsky Date: Fri Aug 11 12:56:32 2017 +0200 Mention the category laws explicitly >--------------------------------------------------------------- f762181ec0f48f1af9dd6d367f2a521d13988808 libraries/base/Control/Category.hs | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/libraries/base/Control/Category.hs b/libraries/base/Control/Category.hs index ba92178..6407a6f 100644 --- a/libraries/base/Control/Category.hs +++ b/libraries/base/Control/Category.hs @@ -28,8 +28,13 @@ import GHC.Prim (coerce) infixr 9 . infixr 1 >>>, <<< --- | A class for categories. --- id and (.) must form a monoid. +-- | A class for categories. Instances should satisfy the laws +-- +-- @ +-- f '.' 'id' = f -- (right identity) +-- 'id' '.' f = f -- (left identity) +-- f '.' (g '.' h) = (f '.' g) '.' h -- (associativity) +-- @ class Category cat where -- | the identity morphism id :: cat a a From git at git.haskell.org Thu Aug 17 20:43:16 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 17 Aug 2017 20:43:16 +0000 (UTC) Subject: [commit: ghc] master: user-guide: fix examples of ghci commands (3385669) Message-ID: <20170817204316.AF3583A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3385669683b8bc150c6df3cb43320dfc6f80fcd9/ghc >--------------------------------------------------------------- commit 3385669683b8bc150c6df3cb43320dfc6f80fcd9 Author: Takenobu Tani Date: Thu Aug 17 10:28:01 2017 -0400 user-guide: fix examples of ghci commands Fix examples of ghci commands: * correct typos * add top-level binding without let statement * modify Time.getClockTime to Data.Time.getZonedTime * modify Directory.setCurrentDirectory * modify ghc version number Test Plan: build Reviewers: austin, bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie Differential Revision: https://phabricator.haskell.org/D3852 >--------------------------------------------------------------- 3385669683b8bc150c6df3cb43320dfc6f80fcd9 docs/users_guide/ghci.rst | 29 +++++++++++++++++++---------- docs/users_guide/using.rst | 4 ++-- 2 files changed, 21 insertions(+), 12 deletions(-) diff --git a/docs/users_guide/ghci.rst b/docs/users_guide/ghci.rst index fe481ae..52fbf6e 100644 --- a/docs/users_guide/ghci.rst +++ b/docs/users_guide/ghci.rst @@ -37,7 +37,7 @@ command ``ghci``: .. code-block:: none $ ghci - GHCi, version 8.0.1: http://www.haskell.org/ghc/ :? for help + GHCi, version 8.y.z: http://www.haskell.org/ghc/ :? for help Prelude> There may be a short pause while GHCi loads the prelude and standard @@ -69,6 +69,15 @@ GHCi, since the expression can also be interpreted in the ``IO`` monad, a ``let`` binding with no accompanying ``in`` statement can be signalled by an empty line, as in the above example. +Since GHC 8.0.1, you can bind values and functions to names without ``let`` statement: + +.. code-block:: none + + Prelude> x = 42 + Prelude> x + 42 + Prelude> + .. _loading-source-files: Loading source files @@ -987,10 +996,10 @@ of type ``a``. eg.: .. code-block:: none - Prelude> Time.getClockTime - Wed Mar 14 12:23:13 GMT 2001 + Prelude> Data.Time.getZonedTime + 2017-04-10 12:34:56.93213581 UTC Prelude> print it - Wed Mar 14 12:23:13 GMT 2001 + 2017-04-10 12:34:56.93213581 UTC The corresponding translation for an IO-typed ``e`` is @@ -1162,7 +1171,7 @@ printed value. Running GHCi with the command: .. code-block:: none - ghci -interactive-print=SpecPrinter.sprinter SpecPrinter + ghci -interactive-print=SpecPrinter.sprint SpecPrinter will start an interactive session where values with be printed using ``sprint``: @@ -1971,7 +1980,7 @@ by using the :ghc-flag:`-package ⟨pkg⟩` flag: .. code-block:: none $ ghci -package readline - GHCi, version 6.8.1: http://www.haskell.org/ghc/ :? for help + GHCi, version 8.y.z: http://www.haskell.org/ghc/ :? for help Loading package base ... linking ... done. Loading package readline-1.0 ... linking ... done. Prelude> @@ -2238,17 +2247,17 @@ commonly used commands. .. code-block:: none - Prelude> let date _ = Time.getClockTime >>= print >> return "" + Prelude> let date _ = Data.Time.getZonedTime >>= print >> return "" Prelude> :def date date Prelude> :date - Fri Mar 23 15:16:40 GMT 2001 + 2017-04-10 12:34:56.93213581 UTC Here's an example of a command that takes an argument. It's a re-implementation of :ghci-cmd:`:cd`: .. code-block:: none - Prelude> let mycd d = Directory.setCurrentDirectory d >> return "" + Prelude> let mycd d = System.Directory.setCurrentDirectory d >> return "" Prelude> :def mycd mycd Prelude> :mycd .. @@ -2745,7 +2754,7 @@ commonly used commands. *X> :type +v length length :: forall (t :: * -> *). Foldable t => forall a. t a -> Int -.. ghci-cmd:: :type +d ⟨expression⟩ +.. ghci-cmd:: :type +d; ⟨expression⟩ Infers and prints the type of ⟨expression⟩, defaulting type variables if possible. In this mode, if the inferred type is constrained by diff --git a/docs/users_guide/using.rst b/docs/users_guide/using.rst index dff9603..6dde0ee 100644 --- a/docs/users_guide/using.rst +++ b/docs/users_guide/using.rst @@ -636,8 +636,8 @@ messages and in GHCi: .. code-block:: none ghci> :set -fprint-unicode-syntax - ghci> :t (>>) - (>>) :: ∀ (m :: * → *) a b. Monad m ⇒ m a → m b → m b + ghci> :t +v (>>) + (>>) ∷ Monad m ⇒ ∀ a b. m a → m b → m b .. _pretty-printing-types: From git at git.haskell.org Thu Aug 17 20:43:19 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 17 Aug 2017 20:43:19 +0000 (UTC) Subject: [commit: ghc] master: Add missing initial version for extension doc. (2c0ab47) Message-ID: <20170817204319.7692D3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2c0ab47f7cab42c2123410f07b909f8a06b6920a/ghc >--------------------------------------------------------------- commit 2c0ab47f7cab42c2123410f07b909f8a06b6920a Author: superfunc Date: Sun Aug 13 20:20:47 2017 -0400 Add missing initial version for extension doc. >--------------------------------------------------------------- 2c0ab47f7cab42c2123410f07b909f8a06b6920a docs/users_guide/glasgow_exts.rst | 2 ++ 1 file changed, 2 insertions(+) diff --git a/docs/users_guide/glasgow_exts.rst b/docs/users_guide/glasgow_exts.rst index 5afc7e1..e6aeaf2 100644 --- a/docs/users_guide/glasgow_exts.rst +++ b/docs/users_guide/glasgow_exts.rst @@ -2912,6 +2912,8 @@ Record field disambiguation .. ghc-flag:: -XDisambiguateRecordFields + :since: 6.8.1 + Allow the compiler to automatically choose between identically-named record selectors based on type (if the choice is unambiguous). From git at git.haskell.org Thu Aug 17 20:43:25 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 17 Aug 2017 20:43:25 +0000 (UTC) Subject: [commit: ghc] master: Fix #13399 by documenting higher-rank kinds. (dc42c0d) Message-ID: <20170817204325.A09963A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/dc42c0dc91e29ca0eba3ee299f5feba03e401483/ghc >--------------------------------------------------------------- commit dc42c0dc91e29ca0eba3ee299f5feba03e401483 Author: Richard Eisenberg Date: Thu Aug 17 10:29:57 2017 -0400 Fix #13399 by documenting higher-rank kinds. Test Plan: Read it. Reviewers: simonpj, RyanGlScott, austin, bgamari Reviewed By: RyanGlScott Subscribers: rwbarton, thomie GHC Trac Issues: #13399 Differential Revision: https://phabricator.haskell.org/D3860 >--------------------------------------------------------------- dc42c0dc91e29ca0eba3ee299f5feba03e401483 docs/users_guide/glasgow_exts.rst | 39 +++++++++++++++++++++++++++++++++++++++ 1 file changed, 39 insertions(+) diff --git a/docs/users_guide/glasgow_exts.rst b/docs/users_guide/glasgow_exts.rst index e6aeaf2..ac64153 100644 --- a/docs/users_guide/glasgow_exts.rst +++ b/docs/users_guide/glasgow_exts.rst @@ -8315,6 +8315,45 @@ It is thus only possible to use this feature if you have provided a complete user-supplied kind signature for the datatype (:ref:`complete-kind-signatures`). +Higher-rank kinds +----------------- + +In concert with :ghc-flag:`-XRankNTypes`, GHC supports higher-rank kinds. +Here is an example:: + + -- Heterogeneous propositional equality + data (a :: k1) :~~: (b :: k2) where + HRefl :: a :~~: a + + class HTestEquality (t :: forall k. k -> Type) where + hTestEquality :: forall k1 k2 (a :: k1) (b :: k2). t a -> t b -> Maybe (a :~~: b) + +Note that ``hTestEquality`` takes two arguments where the type variable ``t`` is applied +to types of different kinds. That type variable must then be polykinded. Accordingly, +the kind of ``HTestEquality`` (the class) is ``(forall k. k -> Type) -> Constraint``, +a higher-rank kind. + +A big difference with higher-rank kinds as compared with higher-rank types is that +``forall``\s in kinds *cannot* be moved. This is best illustrated by example. +Suppose we want to have an instance of ``HTestEquality`` for ``(:~~:)``. :: + + instance HTestEquality ((:~~:) a) where + hTestEquality HRefl HRefl = Just HRefl + +With the declaration of ``(:~~:)`` above, it gets kind ``forall k1 k2. k1 -> k2 -> Type``. +Thus, the type ``(:~~:) a`` has kind ``k2 -> Type`` for some ``k2``. GHC cannot +then *regeneralize* this kind to become ``forall k2. k2 -> Type`` as desired. Thus, the +instance is rejected as ill-kinded. + +To allow for such an instance, we would have to define ``(:~~:)`` as follows:: + + data (:~~:) :: forall k1. k1 -> forall k2. k2 -> Type where + HRefl :: a :~~: a + +In this redefinition, we give an explicit kind for ``(:~~:)``, deferring the choice +of ``k2`` until after the first argument (``a``) has been given. With this declaration +for ``(:~~:)``, the instance for ``HTestEquality`` is accepted. + Constraints in kinds -------------------- From git at git.haskell.org Thu Aug 17 20:43:22 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 17 Aug 2017 20:43:22 +0000 (UTC) Subject: [commit: ghc] master: testsuite: Add test for #13916 (0286214) Message-ID: <20170817204322.D9B913A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/02862140ee3fee6e522f0d73a1ac14e6cf29e501/ghc >--------------------------------------------------------------- commit 02862140ee3fee6e522f0d73a1ac14e6cf29e501 Author: Ben Gamari Date: Thu Aug 17 10:32:58 2017 -0400 testsuite: Add test for #13916 Reviewers: austin Subscribers: rwbarton, thomie Differential Revision: https://phabricator.haskell.org/D3764 >--------------------------------------------------------------- 02862140ee3fee6e522f0d73a1ac14e6cf29e501 testsuite/tests/concurrent/should_run/T13916.hs | 33 +++++ .../tests/concurrent/should_run/T13916_Bracket.hs | 135 +++++++++++++++++++++ testsuite/tests/concurrent/should_run/all.T | 2 + 3 files changed, 170 insertions(+) diff --git a/testsuite/tests/concurrent/should_run/T13916.hs b/testsuite/tests/concurrent/should_run/T13916.hs new file mode 100755 index 0000000..e81aabb --- /dev/null +++ b/testsuite/tests/concurrent/should_run/T13916.hs @@ -0,0 +1,33 @@ +module Main where + +import Data.IORef +import System.IO.Unsafe +import Control.Concurrent.STM +import Control.Concurrent.Async +import Control.Concurrent +import System.IO +import System.Directory +import System.FilePath +import T13916_Bracket + +type Thing = MVar Bool + +main :: IO () +main = do + withEnvCache limit spawner $ \cache -> + forConcurrently_ [1..1000 :: Int] $ \n -> withEnv cache (\handle -> put handle n) + where + limit :: Limit + limit = Hard 1 + + put handle n = return () + +spawner :: Spawner Thing +spawner = Spawner + { maker = mkhandle + , killer = \thing -> takeMVar thing >> putMVar thing True + , isDead = \thing -> readMVar thing + } + +mkhandle :: IO Thing +mkhandle = newMVar False diff --git a/testsuite/tests/concurrent/should_run/T13916_Bracket.hs b/testsuite/tests/concurrent/should_run/T13916_Bracket.hs new file mode 100755 index 0000000..b09adfc --- /dev/null +++ b/testsuite/tests/concurrent/should_run/T13916_Bracket.hs @@ -0,0 +1,135 @@ +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE RecordWildCards #-} +{- | +Module : Bracket +Description : Handling multiple environments with bracket-like apis +Maintainer : robertkennedy at clearwateranalytics.com +Stability : stable + +This module is meant for ie Sql or mongo connections, where you may wish for some number of easy to grab +environments. In particular, this assumes your connection has some initialization/release functions + +This module creates bugs with any optimizations enabled. The bugs do not occur if the program is in the same +module. +-} +module T13916_Bracket ( + -- * Data Types + Spawner(..), Limit(..), Cache, + -- * Usage + withEnvCache, withEnv + ) where + +import Control.Concurrent.STM +import Control.Concurrent.STM.TSem +import Control.Exception hiding (handle) +import Control.Monad +import Data.Vector (Vector) +import qualified Data.Vector as Vector + +-- * Data Types +-- | Tells the program how many environments it is allowed to spawn. +-- A `Lax` limit will spawn extra connections if the `Cache` is empty, +-- while a `Hard` limit will not spawn any more than the given number of connections simultaneously. +-- +-- @since 0.3.7 +data Limit = Hard {getLimit :: {-# unpack #-} !Int} + +data Spawner env = Spawner + { maker :: IO env + , killer :: env -> IO () + , isDead :: env -> IO Bool + } + +type VCache env = Vector (TMVar env) +data Cache env = Unlimited { spawner :: Spawner env + , vcache :: !(VCache env) + } + | Limited { spawner :: Spawner env + , vcache :: !(VCache env) + , envsem :: TSem + } + +-- ** Initialization +withEnvCache :: Limit -> Spawner env -> (Cache env -> IO a) -> IO a +withEnvCache limit spawner = bracket starter releaseCache + where starter = case limit of + Hard n -> Limited spawner <$> initializeEmptyCache n <*> atomically (newTSem n) + +-- ** Using a single value +withEnv :: Cache env -> (env -> IO a) -> IO a +withEnv cache = case cache of + Unlimited{..} -> withEnvUnlimited spawner vcache + Limited{..} -> withEnvLimited spawner vcache envsem + +-- *** Unlimited +-- | Takes an env and returns it on completion of the function. +-- If all envs are already taken or closed, this will spin up a new env. +-- When the function finishes, this will attempt to put the env into the cache. If it cannot, +-- it will kill the env. Note this can lead to many concurrent connections. +-- +-- @since 0.3.5 +withEnvUnlimited :: Spawner env -> VCache env -> (env -> IO a) -> IO a +withEnvUnlimited Spawner{..} cache = bracket taker putter + where + taker = do + mpipe <- atomically $ tryTakeEnv cache + case mpipe of + Nothing -> maker + Just env -> isDead env >>= \b -> if not b then return env else killer env >> maker + + putter env = do + accepted <- atomically $ tryPutEnv cache env + unless accepted $ killer env + +-- *** Limited +-- | Takes an env and returns it on completion of the function. +-- If all envs are already taken, this will wait. This should have a constant number of environments +-- +-- @since 0.3.6 +withEnvLimited :: Spawner env -> VCache env -> TSem -> (env -> IO a) -> IO a +withEnvLimited spawner vcache envsem = bracket taker putter + where + taker = limitMakeEnv spawner vcache envsem + putter env = atomically $ putEnv vcache env + +limitMakeEnv :: Spawner env -> VCache env -> TSem -> IO env +limitMakeEnv Spawner{..} vcache envsem = go + where + go = do + eenvpermission <- atomically $ ( Left <$> takeEnv vcache ) + `orElse` ( Right <$> waitTSem envsem ) + case eenvpermission of + Right () -> maker + Left env -> do + -- Given our env, we check if it's dead. If it's not, we are done and return it. + -- If it is dead, we release it, signal that a new env can be created, and then recurse + isdead <- isDead env + if not isdead then return env + else do + killer env + atomically $ signalTSem envsem + go + +-- * Low level +initializeEmptyCache :: Int -> IO (VCache env) +initializeEmptyCache n | n < 1 = return mempty + | otherwise = Vector.replicateM n newEmptyTMVarIO + +takeEnv :: VCache env -> STM env +takeEnv = Vector.foldl folding retry + where folding m stmenv = m `orElse` takeTMVar stmenv + +tryTakeEnv :: VCache env -> STM (Maybe env) +tryTakeEnv cache = (Just <$> takeEnv cache) `orElse` pure Nothing + +putEnv :: VCache env -> env -> STM () +putEnv cache env = Vector.foldl folding retry cache + where folding m stmenv = m `orElse` putTMVar stmenv env + +tryPutEnv :: VCache env -> env -> STM Bool +tryPutEnv cache env = (putEnv cache env *> return True) `orElse` pure False + +releaseCache :: Cache env -> IO () +releaseCache cache = Vector.mapM_ qkRelease (vcache cache) + where qkRelease tenv = atomically (tryTakeTMVar tenv) + >>= maybe (return ()) (killer $ spawner cache) diff --git a/testsuite/tests/concurrent/should_run/all.T b/testsuite/tests/concurrent/should_run/all.T index 69b8ad7..e7ddf46 100644 --- a/testsuite/tests/concurrent/should_run/all.T +++ b/testsuite/tests/concurrent/should_run/all.T @@ -284,3 +284,5 @@ test('hs_try_putmvar003', # Check forkIO exception determinism under optimization test('T13330', normal, compile_and_run, ['-O']) +test('T13916', [reqlib('vector'), reqlib('stm'), reqlib('async')], + compile_and_run, ['-O2']) From git at git.haskell.org Thu Aug 17 20:43:28 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 17 Aug 2017 20:43:28 +0000 (UTC) Subject: [commit: ghc] master: Remove extra ` from "kind-indexed GADTs" doc (af9f3fa) Message-ID: <20170817204328.643363A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/af9f3fabd72a8b2d627c1360a5c8fc1925f2145d/ghc >--------------------------------------------------------------- commit af9f3fabd72a8b2d627c1360a5c8fc1925f2145d Author: Chris Martin Date: Thu Aug 10 19:37:02 2017 -0400 Remove extra ` from "kind-indexed GADTs" doc >--------------------------------------------------------------- af9f3fabd72a8b2d627c1360a5c8fc1925f2145d docs/users_guide/glasgow_exts.rst | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/docs/users_guide/glasgow_exts.rst b/docs/users_guide/glasgow_exts.rst index 378beb2..5afc7e1 100644 --- a/docs/users_guide/glasgow_exts.rst +++ b/docs/users_guide/glasgow_exts.rst @@ -8300,7 +8300,7 @@ Consider the type :: This datatype ``G`` is GADT-like in both its kind and its type. Suppose you have ``g :: G a``, where ``a :: k``. Then pattern matching to discover that -``g`` is in fact ```GMaybe`` tells you both that ``k ~ (* -> *)`` and +``g`` is in fact ``GMaybe`` tells you both that ``k ~ (* -> *)`` and ``a ~ Maybe``. The definition for ``G`` requires that :ghc-flag:`-XTypeInType` be in effect, but pattern-matching on ``G`` requires no extension beyond :ghc-flag:`-XGADTs`. That this works is actually a straightforward extension From git at git.haskell.org Thu Aug 17 20:43:31 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 17 Aug 2017 20:43:31 +0000 (UTC) Subject: [commit: ghc] master: user-guide: add `:type +d` and `:type +v` in release highlight (82ee71f) Message-ID: <20170817204331.225183A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/82ee71fa85aca087b2cd62cb354fc3df46db4411/ghc >--------------------------------------------------------------- commit 82ee71fa85aca087b2cd62cb354fc3df46db4411 Author: Takenobu Tani Date: Thu Aug 17 10:29:43 2017 -0400 user-guide: add `:type +d` and `:type +v` in release highlight Add new ghci command to release highlight and fix link anchor. This commit is for ghc-8.2 branch. Test Plan: build Reviewers: austin, bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie GHC Trac Issues: #11975 Differential Revision: https://phabricator.haskell.org/D3850 >--------------------------------------------------------------- 82ee71fa85aca087b2cd62cb354fc3df46db4411 docs/users_guide/8.2.1-notes.rst | 2 ++ 1 file changed, 2 insertions(+) diff --git a/docs/users_guide/8.2.1-notes.rst b/docs/users_guide/8.2.1-notes.rst index 76fcc49..89acec8 100644 --- a/docs/users_guide/8.2.1-notes.rst +++ b/docs/users_guide/8.2.1-notes.rst @@ -247,6 +247,8 @@ GHCi - Added support for :ghc-flag:`-XStaticPointers` in interpreted modules. Note, however, that ``static`` expressions are still not allowed in expressions evaluated in the REPL. +- Added support for :ghci-cmd:`:type +d` and :ghci-cmd:`:type +v`. (:ghc-ticket:`11975`) + Template Haskell ~~~~~~~~~~~~~~~~ From git at git.haskell.org Thu Aug 17 20:43:33 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 17 Aug 2017 20:43:33 +0000 (UTC) Subject: [commit: ghc] master: Sections with undefined operators have non-standard behavior (49ddea9) Message-ID: <20170817204333.D5A243A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/49ddea9e8014f109df869831b888bcc285600231/ghc >--------------------------------------------------------------- commit 49ddea9e8014f109df869831b888bcc285600231 Author: David Luposchainsky Date: Fri Aug 11 11:26:52 2017 +0200 Sections with undefined operators have non-standard behavior >--------------------------------------------------------------- 49ddea9e8014f109df869831b888bcc285600231 docs/users_guide/bugs.rst | 23 +++++++++++++++++++++++ 1 file changed, 23 insertions(+) diff --git a/docs/users_guide/bugs.rst b/docs/users_guide/bugs.rst index 7ccb215..f139db1 100644 --- a/docs/users_guide/bugs.rst +++ b/docs/users_guide/bugs.rst @@ -348,6 +348,29 @@ The Foreign Function Interface single: hs_init single: hs_exit +.. _infelicities-operator-sections: + +Operator sections +^^^^^^^^^^^^^^^^^ + +The Haskell Report demands that, for infix operators ``%``, the following +identities hold: + +:: + (% expr) = \x -> x % expr + (expr %) = \x -> expr % x + +However, the second law is violated in the presence of undefined operators, + +:: + (%) = error "urk" + (() %) `seq` () -- urk + (\x -> () % x) `seq` () -- OK, result () + +The operator section is treated like function application of an undefined +function, while the lambda form is in WHNF that contains an application of an +undefined function. + .. _haskell-98-2010-undefined: GHC's interpretation of undefined behaviour in Haskell 98 and Haskell 2010 From git at git.haskell.org Thu Aug 17 20:43:39 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 17 Aug 2017 20:43:39 +0000 (UTC) Subject: [commit: ghc] master: Remove unneeded reqlibs for mtl and parsec in the GHC testsuite (0385347) Message-ID: <20170817204339.5D0C23A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/038534755b1040470453e82531d698a952d4dd05/ghc >--------------------------------------------------------------- commit 038534755b1040470453e82531d698a952d4dd05 Author: Ryan Scott Date: Thu Aug 17 10:31:26 2017 -0400 Remove unneeded reqlibs for mtl and parsec in the GHC testsuite Now that `mtl` and `parsec` are boot libraries, there's no need to qualify various tests in the testsuite with `reqlib('mtl')` or `reqlib('parsec')`. Test Plan: make test TEST="T4809 tcfail126 T4355 tc232 tc223 tc220 tc217 tc183 T5303 DoParamM qq005 qq006 galois_raytrace T1074 mod133 T3787 T4316 prog011 drvfail006 drvfail008" Reviewers: bgamari, austin Subscribers: rwbarton, thomie Differential Revision: https://phabricator.haskell.org/D3855 >--------------------------------------------------------------- 038534755b1040470453e82531d698a952d4dd05 testsuite/tests/deriving/should_fail/all.T | 4 ++-- testsuite/tests/ghci/prog011/prog011.T | 2 +- testsuite/tests/ghci/scripts/all.T | 2 +- testsuite/tests/indexed-types/should_compile/all.T | 2 +- testsuite/tests/module/all.T | 4 ++-- testsuite/tests/programs/galois_raytrace/test.T | 2 +- testsuite/tests/quasiquotation/qq005/test.T | 1 - testsuite/tests/quasiquotation/qq006/test.T | 2 +- testsuite/tests/rebindable/all.T | 2 +- testsuite/tests/simplCore/should_compile/all.T | 2 +- testsuite/tests/typecheck/should_compile/all.T | 12 ++++++------ testsuite/tests/typecheck/should_fail/all.T | 2 +- testsuite/tests/typecheck/should_run/all.T | 2 +- 13 files changed, 19 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 038534755b1040470453e82531d698a952d4dd05 From git at git.haskell.org Thu Aug 17 20:43:36 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 17 Aug 2017 20:43:36 +0000 (UTC) Subject: [commit: ghc] master: Convert documentation examples to doctests for ReadP module (a30187d) Message-ID: <20170817204336.956403A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a30187d530364a9cbfa1fdcbed465fa5eb2d53d9/ghc >--------------------------------------------------------------- commit a30187d530364a9cbfa1fdcbed465fa5eb2d53d9 Author: David Luposchainsky Date: Fri Aug 11 13:46:13 2017 +0200 Convert documentation examples to doctests for ReadP module >--------------------------------------------------------------- a30187d530364a9cbfa1fdcbed465fa5eb2d53d9 libraries/base/Text/ParserCombinators/ReadP.hs | 127 +++++++++++-------------- 1 file changed, 54 insertions(+), 73 deletions(-) diff --git a/libraries/base/Text/ParserCombinators/ReadP.hs b/libraries/base/Text/ParserCombinators/ReadP.hs index fd7c677..dd51f64 100644 --- a/libraries/base/Text/ParserCombinators/ReadP.hs +++ b/libraries/base/Text/ParserCombinators/ReadP.hs @@ -161,8 +161,6 @@ instance Alternative P where newtype ReadP a = R (forall b . (a -> P b) -> P b) --- Functor, Monad, MonadPlus - -- | @since 2.01 instance Functor ReadP where fmap h (R f) = R (\k -> f (k . h)) @@ -171,7 +169,7 @@ instance Functor ReadP where instance Applicative ReadP where pure x = R (\k -> k x) (<*>) = ap - liftA2 = liftM2 + -- liftA2 = liftM2 -- | @since 2.01 instance Monad ReadP where @@ -439,85 +437,68 @@ The following are QuickCheck specifications of what the combinators do. These can be seen as formal specifications of the behavior of the combinators. -We use bags to give semantics to the combinators. +For some values, we only care about the lists contents, not their order, -> type Bag a = [a] +> (=~) :: Ord a => [a] -> [a] -> Bool +> xs =~ ys = sort xs == sort ys -Equality on bags does not care about the order of elements. +Here follow the properties: -> (=~) :: Ord a => Bag a -> Bag a -> Bool -> xs =~ ys = sort xs == sort ys +>>> readP_to_S get [] +[] -A special equality operator to avoid unresolved overloading -when testing the properties. +prop> \c str -> readP_to_S get (c:str) == [(c, str)] -> (=~.) :: Bag (Int,String) -> Bag (Int,String) -> Bool -> (=~.) = (=~) +prop> \str -> readP_to_S look str == [(str, str)] -Here follow the properties: +prop> \str -> readP_to_S pfail str == [] -> prop_Get_Nil = -> readP_to_S get [] =~ [] -> -> prop_Get_Cons c s = -> readP_to_S get (c:s) =~ [(c,s)] -> -> prop_Look s = -> readP_to_S look s =~ [(s,s)] -> -> prop_Fail s = -> readP_to_S pfail s =~. [] -> -> prop_Return x s = -> readP_to_S (return x) s =~. [(x,s)] -> -> prop_Bind p k s = -> readP_to_S (p >>= k) s =~. +prop> \x str -> readP_to_S (return x) s == [(x,s)] + +> prop_Bind p k s = +> readP_to_S (p >>= k) s =~ > [ ys'' > | (x,s') <- readP_to_S p s > , ys'' <- readP_to_S (k (x::Int)) s' > ] -> -> prop_Plus p q s = -> readP_to_S (p +++ q) s =~. -> (readP_to_S p s ++ readP_to_S q s) -> -> prop_LeftPlus p q s = -> readP_to_S (p <++ q) s =~. -> (readP_to_S p s +<+ readP_to_S q s) -> where -> [] +<+ ys = ys -> xs +<+ _ = xs -> -> prop_Gather s = -> forAll readPWithoutReadS $ \p -> -> readP_to_S (gather p) s =~ -> [ ((pre,x::Int),s') -> | (x,s') <- readP_to_S p s -> , let pre = take (length s - length s') s -> ] -> -> prop_String_Yes this s = -> readP_to_S (string this) (this ++ s) =~ -> [(this,s)] -> -> prop_String_Maybe this s = -> readP_to_S (string this) s =~ -> [(this, drop (length this) s) | this `isPrefixOf` s] -> -> prop_Munch p s = -> readP_to_S (munch p) s =~ -> [(takeWhile p s, dropWhile p s)] -> -> prop_Munch1 p s = -> readP_to_S (munch1 p) s =~ -> [(res,s') | let (res,s') = (takeWhile p s, dropWhile p s), not (null res)] -> -> prop_Choice ps s = -> readP_to_S (choice ps) s =~. -> readP_to_S (foldr (+++) pfail ps) s -> -> prop_ReadS r s = -> readP_to_S (readS_to_P r) s =~. r s --} +> prop_Plus p q s = +> readP_to_S (p +++ q) s =~ +> (readP_to_S p s ++ readP_to_S q s) + +> prop_LeftPlus p q s = +> readP_to_S (p <++ q) s =~ +> (readP_to_S p s +<+ readP_to_S q s) +> where +> [] +<+ ys = ys +> xs +<+ _ = xs + +> prop_Gather s = +> forAll readPWithoutReadS $ \p -> +> readP_to_S (gather p) s =~ +> [ ((pre,x::Int),s') +> | (x,s') <- readP_to_S p s +> , let pre = take (length s - length s') s +> ] + +prop> \this str -> readP_to_S (string this) (this ++ str) == [(this,str)] + +> prop_String_Maybe this s = +> readP_to_S (string this) s =~ +> [(this, drop (length this) s) | this `isPrefixOf` s] + +> prop_Munch p s = +> readP_to_S (munch p) s =~ +> [(takeWhile p s, dropWhile p s)] + +> prop_Munch1 p s = +> readP_to_S (munch1 p) s =~ +> [(res,s') | let (res,s') = (takeWhile p s, dropWhile p s), not (null res)] + +> prop_Choice ps s = +> readP_to_S (choice ps) s =~ +> readP_to_S (foldr (+++) pfail ps) s + +> prop_ReadS r s = +> readP_to_S (readS_to_P r) s =~ r s +-} From git at git.haskell.org Thu Aug 17 20:43:44 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 17 Aug 2017 20:43:44 +0000 (UTC) Subject: [commit: ghc] master: Insert missing blank line to fix Applicative doc (43b0c2c) Message-ID: <20170817204344.CECA63A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/43b0c2c13c681033a1ceba25ea90dfbf9a17e2e9/ghc >--------------------------------------------------------------- commit 43b0c2c13c681033a1ceba25ea90dfbf9a17e2e9 Author: David Luposchainsky Date: Fri Aug 11 12:31:23 2017 +0200 Insert missing blank line to fix Applicative doc >--------------------------------------------------------------- 43b0c2c13c681033a1ceba25ea90dfbf9a17e2e9 libraries/base/GHC/Base.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/libraries/base/GHC/Base.hs b/libraries/base/GHC/Base.hs index ffcd7ff..7883e36 100644 --- a/libraries/base/GHC/Base.hs +++ b/libraries/base/GHC/Base.hs @@ -379,6 +379,7 @@ class Functor f where -- the same as their default definitions: -- -- @('<*>') = 'liftA2' 'id'@ +-- -- @'liftA2' f x y = f '<$>' x '<*>' y@ -- -- Further, any definition must satisfy the following: From git at git.haskell.org Thu Aug 17 20:43:42 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 17 Aug 2017 20:43:42 +0000 (UTC) Subject: [commit: ghc] master: Handle ListPat in isStrictPattern (03327bf) Message-ID: <20170817204342.1878C3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/03327bf049acb595c3ba034d16ee5bd0afabe7c4/ghc >--------------------------------------------------------------- commit 03327bf049acb595c3ba034d16ee5bd0afabe7c4 Author: Alexander Biehl Date: Fri Aug 11 08:29:23 2017 +0200 Handle ListPat in isStrictPattern This fixes #14105. >--------------------------------------------------------------- 03327bf049acb595c3ba034d16ee5bd0afabe7c4 compiler/rename/RnExpr.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/compiler/rename/RnExpr.hs b/compiler/rename/RnExpr.hs index 6eabc89..3e5c88f 100644 --- a/compiler/rename/RnExpr.hs +++ b/compiler/rename/RnExpr.hs @@ -1767,6 +1767,7 @@ isStrictPattern (L _ pat) = SigPatIn p _ -> isStrictPattern p SigPatOut p _ -> isStrictPattern p BangPat{} -> True + ListPat{} -> True TuplePat{} -> True SumPat{} -> True PArrPat{} -> True From git at git.haskell.org Thu Aug 17 20:43:47 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 17 Aug 2017 20:43:47 +0000 (UTC) Subject: [commit: ghc] master: Make function intToSBigNat# preserve sign (fixes #14085) (c5605ae) Message-ID: <20170817204347.893FC3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c5605ae00e9bff90db7a5f24ff3b8de2aba3b55b/ghc >--------------------------------------------------------------- commit c5605ae00e9bff90db7a5f24ff3b8de2aba3b55b Author: Olivier Chéron Date: Thu Aug 17 10:32:28 2017 -0400 Make function intToSBigNat# preserve sign (fixes #14085) Impacts only functions gcdExtInteger, powModInteger and recipModInteger which gave invalid results on negative S# inputs. Also fixes gcdExtInteger assertion when first argument is negative. Test Plan: Updated test case integerGmpInternals Reviewers: austin, hvr, goldfire, bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie GHC Trac Issues: #14085 Differential Revision: https://phabricator.haskell.org/D3826 >--------------------------------------------------------------- c5605ae00e9bff90db7a5f24ff3b8de2aba3b55b libraries/integer-gmp/cbits/wrappers.c | 2 +- libraries/integer-gmp/src/GHC/Integer/Type.hs | 2 +- testsuite/tests/lib/integer/integerGmpInternals.hs | 5 ++++- testsuite/tests/lib/integer/integerGmpInternals.stdout | 5 ++++- 4 files changed, 10 insertions(+), 4 deletions(-) diff --git a/libraries/integer-gmp/cbits/wrappers.c b/libraries/integer-gmp/cbits/wrappers.c index c99c017..446a681 100644 --- a/libraries/integer-gmp/cbits/wrappers.c +++ b/libraries/integer-gmp/cbits/wrappers.c @@ -312,7 +312,7 @@ integer_gmp_gcdext(mp_limb_t s0[], mp_limb_t g0[], const mp_size_t ssn = s[0]._mp_size; const mp_size_t sn = mp_size_abs(ssn); - assert(sn <= xn); + assert(sn <= mp_size_abs(xn)); memcpy(s0, s[0]._mp_d, sn*sizeof(mp_limb_t)); mpz_clear (s); diff --git a/libraries/integer-gmp/src/GHC/Integer/Type.hs b/libraries/integer-gmp/src/GHC/Integer/Type.hs index d5f92b3..952ff6d 100644 --- a/libraries/integer-gmp/src/GHC/Integer/Type.hs +++ b/libraries/integer-gmp/src/GHC/Integer/Type.hs @@ -1996,7 +1996,7 @@ intToSBigNat# 0# = PosBN zeroBigNat intToSBigNat# 1# = PosBN oneBigNat intToSBigNat# (-1#) = NegBN oneBigNat intToSBigNat# i# | isTrue# (i# ># 0#) = PosBN (wordToBigNat (int2Word# i#)) - | True = PosBN (wordToBigNat (int2Word# (negateInt# i#))) + | True = NegBN (wordToBigNat (int2Word# (negateInt# i#))) -- | Convert 'Integer' into 'SBigNat' integerToSBigNat :: Integer -> SBigNat diff --git a/testsuite/tests/lib/integer/integerGmpInternals.hs b/testsuite/tests/lib/integer/integerGmpInternals.hs index 628f8e0..4edf5d6 100644 --- a/testsuite/tests/lib/integer/integerGmpInternals.hs +++ b/testsuite/tests/lib/integer/integerGmpInternals.hs @@ -85,10 +85,13 @@ main = do print $ gcdExtInteger e b print $ gcdExtInteger x y print $ gcdExtInteger y x + print $ gcdExtInteger x (-y) + print $ gcdExtInteger (-x) y + print $ gcdExtInteger (-x) (-y) print $ powInteger 12345 0 print $ powInteger 12345 1 print $ powInteger 12345 30 - print $ [ (x,i) | x <- [0..71], let i = recipModInteger x (2*3*11*11*17*17), i /= 0 ] + print $ [ (x,i) | x <- [-7..71], let i = recipModInteger x (2*3*11*11*17*17), i /= 0 ] print $ I.nextPrimeInteger b print $ I.nextPrimeInteger e print $ [ k | k <- [ 0 .. 200 ], S# (I.testPrimeInteger k 25#) `elem` [1,2] ] diff --git a/testsuite/tests/lib/integer/integerGmpInternals.stdout b/testsuite/tests/lib/integer/integerGmpInternals.stdout index e5cf7f6..d5c1374 100644 --- a/testsuite/tests/lib/integer/integerGmpInternals.stdout +++ b/testsuite/tests/lib/integer/integerGmpInternals.stdout @@ -5,10 +5,13 @@ (1,302679100340807588460107986194035692812415103244388831792688023418704) (92889294,115110207004456909698806038261) (92889294,-19137667681784054624628973533) +(92889294,115110207004456909698806038261) +(92889294,-115110207004456909698806038261) +(92889294,-115110207004456909698806038261) 1 12345 555562377826831043419246079513769804614412256811161773362797946971665712715296306339052301636736176350153982639312744140625 -[(1,1),(5,41963),(7,59947),(13,177535),(19,143557),(23,182447),(25,134281),(29,7235),(31,33841),(35,95915),(37,113413),(41,61409),(43,24397),(47,174101),(49,158431),(53,193979),(59,188477),(61,185737),(65,35507),(67,118999),(71,186173)] +[(-7,149867),(-5,167851),(-1,209813),(1,1),(5,41963),(7,59947),(13,177535),(19,143557),(23,182447),(25,134281),(29,7235),(31,33841),(35,95915),(37,113413),(41,61409),(43,24397),(47,174101),(49,158431),(53,193979),(59,188477),(61,185737),(65,35507),(67,118999),(71,186173)] 2988348162058574136915891421498819466320163312926952423791023078876343 2351399303373464486466122544523690094744975233415544072992656881240451 [2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71,73,79,83,89,97,101,103,107,109,113,127,131,137,139,149,151,157,163,167,173,179,181,191,193,197,199] From git at git.haskell.org Thu Aug 17 20:43:50 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 17 Aug 2017 20:43:50 +0000 (UTC) Subject: [commit: ghc] master: rts: Enable USDT probes object on Linux (69a0f01) Message-ID: <20170817204350.478EA3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/69a0f01674e58e5acd0ae250770676f47ab1ac68/ghc >--------------------------------------------------------------- commit 69a0f01674e58e5acd0ae250770676f47ab1ac68 Author: Ben Gamari Date: Thu Aug 17 10:28:39 2017 -0400 rts: Enable USDT probes object on Linux Summary: The dtrace utility shipped with Debian expects this. Reviewers: austin, simonmar Reviewed By: simonmar Subscribers: rwbarton, thomie Differential Revision: https://phabricator.haskell.org/D3829 >--------------------------------------------------------------- 69a0f01674e58e5acd0ae250770676f47ab1ac68 rts/ghc.mk | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/rts/ghc.mk b/rts/ghc.mk index 990f4db..e3de93d 100644 --- a/rts/ghc.mk +++ b/rts/ghc.mk @@ -170,8 +170,12 @@ rts_$1_CMM_OBJS = $$(patsubst rts/%.cmm,rts/dist/build/%.$$($1_osuf),$$(rts_CMM_ rts_$1_OBJS = $$(rts_$1_C_OBJS) $$(rts_$1_S_OBJS) $$(rts_$1_CMM_OBJS) +ifneq "$$(findstring linux solaris2, $(TargetOS_CPP))" "" +NEED_DTRACE_PROBES_OBJ = YES +endif + ifeq "$(USE_DTRACE)" "YES" -ifeq "$(TargetOS_CPP)" "solaris2" +ifeq "$(NEED_DTRACE_PROBES_OBJ)" "YES" # On Darwin we don't need to generate binary containing probes defined # in DTrace script, but DTrace on Solaris expects generation of binary # from the DTrace probes definitions From git at git.haskell.org Thu Aug 17 20:43:53 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 17 Aug 2017 20:43:53 +0000 (UTC) Subject: [commit: ghc] master: Loads of doc(test)s (bfa9048) Message-ID: <20170817204353.109C43A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/bfa9048daa170d0aec0601d1241dfa99bc8fd303/ghc >--------------------------------------------------------------- commit bfa9048daa170d0aec0601d1241dfa99bc8fd303 Author: David Luposchainsky Date: Fri Aug 11 14:25:57 2017 +0200 Loads of doc(test)s >--------------------------------------------------------------- bfa9048daa170d0aec0601d1241dfa99bc8fd303 libraries/base/Control/Monad.hs | 30 ++++++------ libraries/base/Data/Foldable.hs | 3 ++ libraries/base/Data/Function.hs | 25 +++++++++- libraries/base/Data/Proxy.hs | 39 ++++++++++++++- libraries/base/Data/STRef.hs | 24 ++++++++-- libraries/base/Data/Unique.hs | 9 ++++ libraries/base/Debug/Trace.hs | 65 +++++++++++++++++-------- libraries/base/GHC/Base.hs | 24 ++++++---- libraries/base/GHC/Natural.hs | 9 +++- libraries/base/GHC/STRef.hs | 12 +++++ libraries/base/Numeric.hs | 9 ++++ libraries/base/System/Timeout.hs | 7 ++- libraries/base/Text/Printf.hs | 100 ++++++++++++++++++--------------------- libraries/base/Text/Read.hs | 22 ++++++++- 14 files changed, 270 insertions(+), 108 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 bfa9048daa170d0aec0601d1241dfa99bc8fd303 From git at git.haskell.org Thu Aug 17 20:43:55 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 17 Aug 2017 20:43:55 +0000 (UTC) Subject: [commit: ghc] master: Add some Monoid doctests (63397cb) Message-ID: <20170817204355.C31063A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/63397cb3c51c4871990d120b2eaeba2f82729481/ghc >--------------------------------------------------------------- commit 63397cb3c51c4871990d120b2eaeba2f82729481 Author: David Luposchainsky Date: Fri Aug 11 12:50:13 2017 +0200 Add some Monoid doctests >--------------------------------------------------------------- 63397cb3c51c4871990d120b2eaeba2f82729481 libraries/base/Data/Monoid.hs | 34 ++++++++++++++++++++++++++++++++++ libraries/base/GHC/Base.hs | 8 ++++---- 2 files changed, 38 insertions(+), 4 deletions(-) diff --git a/libraries/base/Data/Monoid.hs b/libraries/base/Data/Monoid.hs index 6ccdb34..2e81784 100644 --- a/libraries/base/Data/Monoid.hs +++ b/libraries/base/Data/Monoid.hs @@ -67,6 +67,9 @@ infixr 6 <> -- Monoid instances. -- | The dual of a 'Monoid', obtained by swapping the arguments of 'mappend'. +-- +-- >>> getDual (mappend (Dual "Hello") (Dual "World")) +-- "WorldHello" newtype Dual a = Dual { getDual :: a } deriving (Eq, Ord, Read, Show, Bounded, Generic, Generic1) @@ -89,6 +92,10 @@ instance Monad Dual where m >>= k = k (getDual m) -- | The monoid of endomorphisms under composition. +-- +-- >>> let computation = Endo ("Hello, " ++) <> Endo (++ "!") +-- >>> appEndo computation "Haskell" +-- "Hello, Haskell!" newtype Endo a = Endo { appEndo :: a -> a } deriving (Generic) @@ -98,6 +105,12 @@ instance Monoid (Endo a) where Endo f `mappend` Endo g = Endo (f . g) -- | Boolean monoid under conjunction ('&&'). +-- +-- >>> getAll (All True <> mempty <> All False) +-- False +-- +-- >>> getAll (mconcat (map (\x -> All (even x)) [2,4,6,7,8])) +-- False newtype All = All { getAll :: Bool } deriving (Eq, Ord, Read, Show, Bounded, Generic) @@ -107,6 +120,12 @@ instance Monoid All where All x `mappend` All y = All (x && y) -- | Boolean monoid under disjunction ('||'). +-- +-- >>> getAny (Any True <> mempty <> Any False) +-- True +-- +-- >>> getAny (mconcat (map (\x -> Any (even x)) [2,4,6,7,8])) +-- True newtype Any = Any { getAny :: Bool } deriving (Eq, Ord, Read, Show, Bounded, Generic) @@ -116,6 +135,9 @@ instance Monoid Any where Any x `mappend` Any y = Any (x || y) -- | Monoid under addition. +-- +-- >>> getSum (Sum 1 <> Sum 2 <> mempty) +-- 3 newtype Sum a = Sum { getSum :: a } deriving (Eq, Ord, Read, Show, Bounded, Generic, Generic1, Num) @@ -139,6 +161,9 @@ instance Monad Sum where m >>= k = k (getSum m) -- | Monoid under multiplication. +-- +-- >>> getProduct (Product 3 <> Product 4 <> mempty) +-- 12 newtype Product a = Product { getProduct :: a } deriving (Eq, Ord, Read, Show, Bounded, Generic, Generic1, Num) @@ -197,6 +222,9 @@ instance Monad Product where -- -- @'First' a@ is isomorphic to @'Alt' 'Maybe' a@, but precedes it -- historically. +-- +-- >>> getFirst (First (Just "hello") <> First Nothing <> First (Just "world")) +-- Just "hello" newtype First a = First { getFirst :: Maybe a } deriving (Eq, Ord, Read, Show, Generic, Generic1, Functor, Applicative, Monad) @@ -211,6 +239,9 @@ instance Monoid (First a) where -- -- @'Last' a@ is isomorphic to @'Dual' ('First' a)@, and thus to -- @'Dual' ('Alt' 'Maybe' a)@ +-- +-- >>> getLast (Last (Just "hello") <> Last Nothing <> Last (Just "world")) +-- Just "world" newtype Last a = Last { getLast :: Maybe a } deriving (Eq, Ord, Read, Show, Generic, Generic1, Functor, Applicative, Monad) @@ -253,3 +284,6 @@ prop_mconcatLast x = where listLastToMaybe [] = Nothing listLastToMaybe lst = Just (last lst) -- -} + +-- $setup +-- >>> import Prelude diff --git a/libraries/base/GHC/Base.hs b/libraries/base/GHC/Base.hs index 7883e36..e62ac92 100644 --- a/libraries/base/GHC/Base.hs +++ b/libraries/base/GHC/Base.hs @@ -207,13 +207,13 @@ data Maybe a = Nothing | Just a -- | The class of monoids (types with an associative binary operation that -- has an identity). Instances should satisfy the following laws: -- --- * @mappend mempty x = x@ +-- * @'mappend' 'mempty' x = x@ -- --- * @mappend x mempty = x@ +-- * @'mappend' x 'mempty' = x@ -- --- * @mappend x (mappend y z) = mappend (mappend x y) z@ +-- * @'mappend' x ('mappend' y z) = 'mappend' ('mappend' x y) z@ -- --- * @mconcat = 'foldr' mappend mempty@ +-- * @'mconcat' = 'foldr' 'mappend' 'mempty'@ -- -- The method names refer to the monoid of lists under concatenation, -- but there are many other instances. From git at git.haskell.org Thu Aug 17 20:43:58 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 17 Aug 2017 20:43:58 +0000 (UTC) Subject: [commit: ghc] master: Fix index entries in "separate compilation" section (0e1b6f8) Message-ID: <20170817204358.80FC33A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/0e1b6f85c69834e907ebcb9fcb5c94e6a2fb3287/ghc >--------------------------------------------------------------- commit 0e1b6f85c69834e907ebcb9fcb5c94e6a2fb3287 Author: Chris Martin Date: Mon Aug 14 21:15:22 2017 -0400 Fix index entries in "separate compilation" section This appears to have been a mistake from the translation of the manual into RST format by 4fd6207ec6. >--------------------------------------------------------------- 0e1b6f85c69834e907ebcb9fcb5c94e6a2fb3287 docs/users_guide/separate_compilation.rst | 14 +++++++++----- 1 file changed, 9 insertions(+), 5 deletions(-) diff --git a/docs/users_guide/separate_compilation.rst b/docs/users_guide/separate_compilation.rst index 06af6f0..85c8254 100644 --- a/docs/users_guide/separate_compilation.rst +++ b/docs/users_guide/separate_compilation.rst @@ -522,11 +522,15 @@ files, thus: :: g :: TA -> TB g (MkTA x) = MkTB x -``hs-boot`` files importing, ``hi-boot`` files Here ``A`` imports ``B``, -but ``B`` imports ``A`` with a ``{-# SOURCE #-}`` pragma, which breaks -the circular dependency. Every loop in the module import graph must be -broken by a ``{-# SOURCE #-}`` import; or, equivalently, the module -import graph must be acyclic if ``{-# SOURCE #-}`` imports are ignored. +.. index:: + single: ``hs-boot`` files + single: importing, ``hi-boot`` files + +Here ``A`` imports ``B``, but ``B`` imports ``A`` with a +``{-# SOURCE #-}`` pragma, which breaks the circular dependency. Every +loop in the module import graph must be broken by a ``{-# SOURCE #-}`` +import; or, equivalently, the module import graph must be acyclic if +``{-# SOURCE #-}`` imports are ignored. For every module ``A.hs`` that is ``{-# SOURCE #-}``-imported in this way there must exist a source file ``A.hs-boot``. This file contains an From git at git.haskell.org Fri Aug 18 03:49:59 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 18 Aug 2017 03:49:59 +0000 (UTC) Subject: [commit: ghc] wip/jenkins: Fix JUnit (c7a5e08) Message-ID: <20170818034959.C7B483A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/jenkins Link : http://ghc.haskell.org/trac/ghc/changeset/c7a5e0894da53ef737a2b4dbbcbd7d6f8a3e2808/ghc >--------------------------------------------------------------- commit c7a5e0894da53ef737a2b4dbbcbd7d6f8a3e2808 Author: Ben Gamari Date: Fri Jul 28 19:06:29 2017 -0400 Fix JUnit >--------------------------------------------------------------- c7a5e0894da53ef737a2b4dbbcbd7d6f8a3e2808 Jenkinsfile | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Jenkinsfile b/Jenkinsfile index ee6a884..23b6ced 100644 --- a/Jenkinsfile +++ b/Jenkinsfile @@ -302,8 +302,8 @@ def testGhc(params) { if (params.nightly) { target = 'slowtest' } - sh "${makeCmd} -Ctestsuite/tests LOCAL=0 BINDIST=YES THREADS=${env.THREADS} TEST_HC=\"${testGhc}\" ${target}" - junit 'testsuite*.xml' + sh "${makeCmd} -Ctestsuite/tests LOCAL=0 BINDIST=YES THREADS=${env.THREADS} TEST_HC=\"${testGhc}\" JUNIT_FILE=testsuite.xml ${target}" + junit 'testsuite.xml' } } } From git at git.haskell.org Fri Aug 18 03:50:05 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 18 Aug 2017 03:50:05 +0000 (UTC) Subject: [commit: ghc] wip/jenkins: Testing simpler Jenkinsfile (dde3dac) Message-ID: <20170818035005.CCD203A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/jenkins Link : http://ghc.haskell.org/trac/ghc/changeset/dde3dac012c037135d065387b2b6dfe6238e1161/ghc >--------------------------------------------------------------- commit dde3dac012c037135d065387b2b6dfe6238e1161 Author: Ben Gamari Date: Fri Apr 21 14:29:34 2017 -0400 Testing simpler Jenkinsfile >--------------------------------------------------------------- dde3dac012c037135d065387b2b6dfe6238e1161 Jenkinsfile | 366 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Makefile | 4 + ghc.mk | 4 + mk/config.mk.in | 2 +- 4 files changed, 375 insertions(+), 1 deletion(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc dde3dac012c037135d065387b2b6dfe6238e1161 From git at git.haskell.org Fri Aug 18 03:50:08 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 18 Aug 2017 03:50:08 +0000 (UTC) Subject: [commit: ghc] wip/jenkins: testsuite/junit: Flip type and message (29d6e33) Message-ID: <20170818035008.85AAE3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/jenkins Link : http://ghc.haskell.org/trac/ghc/changeset/29d6e336c14dd184070756d1cfded7213d0e006f/ghc >--------------------------------------------------------------- commit 29d6e336c14dd184070756d1cfded7213d0e006f Author: Ben Gamari Date: Mon Jul 31 08:44:40 2017 -0400 testsuite/junit: Flip type and message type apparently can't contain < characters. >--------------------------------------------------------------- 29d6e336c14dd184070756d1cfded7213d0e006f testsuite/driver/junit.py | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/testsuite/driver/junit.py b/testsuite/driver/junit.py index 01a5f47..f9689de 100644 --- a/testsuite/driver/junit.py +++ b/testsuite/driver/junit.py @@ -18,8 +18,8 @@ def junit(t): classname = testname, name = way) result = ET.SubElement(testcase, 'failure', - type = result, - message = reason) + type = reason, + message = result) for (directory, testname, reason, way) in t.framework_failures: testcase = ET.SubElement(testsuite, 'testcase', From git at git.haskell.org Fri Aug 18 03:50:11 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 18 Aug 2017 03:50:11 +0000 (UTC) Subject: [commit: ghc] wip/jenkins: Fix whitespace (be584e1) Message-ID: <20170818035011.46E233A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/jenkins Link : http://ghc.haskell.org/trac/ghc/changeset/be584e16ee71d624c38eba30ae83035f4a456727/ghc >--------------------------------------------------------------- commit be584e16ee71d624c38eba30ae83035f4a456727 Author: Ben Gamari Date: Sun Jul 30 23:09:03 2017 -0400 Fix whitespace >--------------------------------------------------------------- be584e16ee71d624c38eba30ae83035f4a456727 Jenkinsfile | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/Jenkinsfile b/Jenkinsfile index 23b6ced..8501f87 100644 --- a/Jenkinsfile +++ b/Jenkinsfile @@ -315,11 +315,11 @@ def nofib(params) { stage('Run nofib') { installPkgs(['regex-compat']) sh """ - cd nofib - ${makeCmd} clean - ${makeCmd} boot - ${makeCmd} >../nofib.log 2>&1 - """ + cd nofib + ${makeCmd} clean + ${makeCmd} boot + ${makeCmd} >../nofib.log 2>&1 + """ archiveArtifacts artifacts: 'nofib.log' } } From git at git.haskell.org Fri Aug 18 03:50:02 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 18 Aug 2017 03:50:02 +0000 (UTC) Subject: [commit: ghc] wip/jenkins: Fix junit output path (61f4588) Message-ID: <20170818035002.87C383A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/jenkins Link : http://ghc.haskell.org/trac/ghc/changeset/61f458896df1ae6e6880b975f253d796ff62cdd3/ghc >--------------------------------------------------------------- commit 61f458896df1ae6e6880b975f253d796ff62cdd3 Author: Ben Gamari Date: Mon Jul 31 00:41:25 2017 -0400 Fix junit output path >--------------------------------------------------------------- 61f458896df1ae6e6880b975f253d796ff62cdd3 Jenkinsfile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Jenkinsfile b/Jenkinsfile index 7eac8ff..c86060c 100644 --- a/Jenkinsfile +++ b/Jenkinsfile @@ -302,7 +302,7 @@ def testGhc(params) { if (params.nightly) { target = 'slowtest' } - sh "${makeCmd} -Ctestsuite/tests LOCAL=0 BINDIST=YES THREADS=${env.THREADS} TEST_HC=\"${testGhc}\" JUNIT_FILE=testsuite.xml ${target}" + sh "${makeCmd} -Ctestsuite/tests LOCAL=0 BINDIST=YES THREADS=${env.THREADS} TEST_HC=\"${testGhc}\" JUNIT_FILE=../../testsuite.xml ${target}" junit 'testsuite.xml' } } From git at git.haskell.org Fri Aug 18 03:50:14 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 18 Aug 2017 03:50:14 +0000 (UTC) Subject: [commit: ghc] wip/jenkins: Bump GHC to 8.2.1 (0cd5d6b) Message-ID: <20170818035014.0716F3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/jenkins Link : http://ghc.haskell.org/trac/ghc/changeset/0cd5d6b19a546deac6e105296d28a19fb336a3b0/ghc >--------------------------------------------------------------- commit 0cd5d6b19a546deac6e105296d28a19fb336a3b0 Author: Ben Gamari Date: Sun Jul 30 23:09:12 2017 -0400 Bump GHC to 8.2.1 >--------------------------------------------------------------- 0cd5d6b19a546deac6e105296d28a19fb336a3b0 Jenkinsfile | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Jenkinsfile b/Jenkinsfile index 8501f87..7eac8ff 100644 --- a/Jenkinsfile +++ b/Jenkinsfile @@ -119,11 +119,11 @@ def withMingw(String msystem, Closure f) { if (msystem == 'MINGW32') { prefix = "${msysRoot}\\mingw32" carch = 'i686' - ghcPath = "${home}/ghc-8.0.1-i386/bin" + ghcPath = "${home}/ghc-8.2.1-i386/bin" } else if (msystem == 'MINGW64') { prefix = "${msysRoot}\\mingw64" carch = 'x86_64' - ghcPath = "${home}/ghc-8.0.2-x86_64/bin" + ghcPath = "${home}/ghc-8.2.1-x86_64/bin" } else { fail } From git at git.haskell.org Fri Aug 18 03:50:16 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 18 Aug 2017 03:50:16 +0000 (UTC) Subject: [commit: ghc] wip/jenkins: testsuite/junit: Properly escape strings (9ee04c8) Message-ID: <20170818035016.B56D43A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/jenkins Link : http://ghc.haskell.org/trac/ghc/changeset/9ee04c881e781ba00989da2294a12269086714b8/ghc >--------------------------------------------------------------- commit 9ee04c881e781ba00989da2294a12269086714b8 Author: Ben Gamari Date: Mon Jul 31 11:36:49 2017 -0400 testsuite/junit: Properly escape strings >--------------------------------------------------------------- 9ee04c881e781ba00989da2294a12269086714b8 testsuite/driver/junit.py | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/testsuite/driver/junit.py b/testsuite/driver/junit.py index f9689de..4015c19 100644 --- a/testsuite/driver/junit.py +++ b/testsuite/driver/junit.py @@ -1,5 +1,6 @@ from datetime import datetime import xml.etree.ElementTree as ET +from xml.sax.saxutils import escape def junit(t): testsuites = ET.Element('testsuites') @@ -18,21 +19,21 @@ def junit(t): classname = testname, name = way) result = ET.SubElement(testcase, 'failure', - type = reason, - message = result) + type = 'unexpected failure', + message = escape(reason)) for (directory, testname, reason, way) in t.framework_failures: testcase = ET.SubElement(testsuite, 'testcase', classname = testname, - name = way) + name = escape(way)) result = ET.SubElement(testcase, 'error', type = "framework failure", - message = reason) + message = escape(reason)) for (directory, testname, way) in t.expected_passes: testcase = ET.SubElement(testsuite, 'testcase', classname = testname, - name = way) + name = escape(way)) return ET.ElementTree(testsuites) From git at git.haskell.org Fri Aug 18 03:50:19 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 18 Aug 2017 03:50:19 +0000 (UTC) Subject: [commit: ghc] wip/jenkins's head updated: testsuite/junit: Properly escape strings (9ee04c8) Message-ID: <20170818035019.A8DF33A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/jenkins' now includes: 38260a9 Fix #13972 by producing tidier errors 039fa1b Suggest how to fix illegally nested foralls in GADT constructor type signatures c948b78 Fix #11785 by making reifyKind = reifyType af9f3fa Remove extra ` from "kind-indexed GADTs" doc 03327bf Handle ListPat in isStrictPattern 36d1b08 Doctest for Void.absurd 49ddea9 Sections with undefined operators have non-standard behavior 43b0c2c Insert missing blank line to fix Applicative doc 63397cb Add some Monoid doctests f762181 Mention the category laws explicitly a30187d Convert documentation examples to doctests for ReadP module bfa9048 Loads of doc(test)s 2c0ab47 Add missing initial version for extension doc. 0e1b6f8 Fix index entries in "separate compilation" section 3385669 user-guide: fix examples of ghci commands 69a0f01 rts: Enable USDT probes object on Linux 82ee71f user-guide: add `:type +d` and `:type +v` in release highlight dc42c0d Fix #13399 by documenting higher-rank kinds. 0385347 Remove unneeded reqlibs for mtl and parsec in the GHC testsuite c5605ae Make function intToSBigNat# preserve sign (fixes #14085) 0286214 testsuite: Add test for #13916 dde3dac Testing simpler Jenkinsfile c7a5e08 Fix JUnit be584e1 Fix whitespace 0cd5d6b Bump GHC to 8.2.1 61f4588 Fix junit output path 29d6e33 testsuite/junit: Flip type and message 9ee04c8 testsuite/junit: Properly escape strings From git at git.haskell.org Fri Aug 18 03:50:37 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 18 Aug 2017 03:50:37 +0000 (UTC) Subject: [commit: ghc] wip/jenkins: Debug (9bcaa5a) Message-ID: <20170818035037.3A3CF3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/jenkins Link : http://ghc.haskell.org/trac/ghc/changeset/9bcaa5aa2360d7449b054cecb9ea32337c108c91/ghc >--------------------------------------------------------------- commit 9bcaa5aa2360d7449b054cecb9ea32337c108c91 Author: Ben Gamari Date: Thu Aug 17 23:50:28 2017 -0400 Debug >--------------------------------------------------------------- 9bcaa5aa2360d7449b054cecb9ea32337c108c91 Jenkinsfile | 2 ++ 1 file changed, 2 insertions(+) diff --git a/Jenkinsfile b/Jenkinsfile index c86060c..5c5cebe 100644 --- a/Jenkinsfile +++ b/Jenkinsfile @@ -159,6 +159,8 @@ def buildGhc(params) { String makeCmd = params?.makeCmd ?: 'make' withGhcSrcDist() { + echo '${targetTriple}' + echo '${params}' stage('Configure') { sh 'echo $PATH' sh "which ghc" From git at git.haskell.org Fri Aug 18 03:57:47 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 18 Aug 2017 03:57:47 +0000 (UTC) Subject: [commit: ghc] wip/jenkins: More debug (68b5bfe) Message-ID: <20170818035747.657EB3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/jenkins Link : http://ghc.haskell.org/trac/ghc/changeset/68b5bfeaaae52d77aacd948e7580bd70aee0122c/ghc >--------------------------------------------------------------- commit 68b5bfeaaae52d77aacd948e7580bd70aee0122c Author: Ben Gamari Date: Thu Aug 17 23:52:29 2017 -0400 More debug >--------------------------------------------------------------- 68b5bfeaaae52d77aacd948e7580bd70aee0122c Jenkinsfile | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/Jenkinsfile b/Jenkinsfile index 5c5cebe..1103e80 100644 --- a/Jenkinsfile +++ b/Jenkinsfile @@ -159,8 +159,8 @@ def buildGhc(params) { String makeCmd = params?.makeCmd ?: 'make' withGhcSrcDist() { - echo '${targetTriple}' - echo '${params}' + echo "${targetTriple}" + echo "${params}" stage('Configure') { sh 'echo $PATH' sh "which ghc" @@ -189,7 +189,7 @@ def buildGhc(params) { def configure_opts = [] if (crossCompiling) { - configure_opts += '--target=${targetTriple}' + configure_opts += "--target=${targetTriple}" } if (disableLargeAddrSpace) { configure_opts += '--disable-large-address-space' From git at git.haskell.org Fri Aug 18 12:16:28 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 18 Aug 2017 12:16:28 +0000 (UTC) Subject: [commit: ghc] master: CSE.cseOneExpr: Set InScopeSet correctly (fee253f) Message-ID: <20170818121628.0F2B03A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/fee253fc48d80b0cbd29ec90b5377c1981eb888f/ghc >--------------------------------------------------------------- commit fee253fc48d80b0cbd29ec90b5377c1981eb888f Author: Joachim Breitner Date: Fri Aug 18 14:14:19 2017 +0200 CSE.cseOneExpr: Set InScopeSet correctly because this is a convenience function for API users, calculate the in-scope set from `exprFreeVars`. >--------------------------------------------------------------- fee253fc48d80b0cbd29ec90b5377c1981eb888f compiler/simplCore/CSE.hs | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/compiler/simplCore/CSE.hs b/compiler/simplCore/CSE.hs index ccbdf35..ffbcdb4 100644 --- a/compiler/simplCore/CSE.hs +++ b/compiler/simplCore/CSE.hs @@ -12,13 +12,14 @@ module CSE (cseProgram, cseOneExpr) where import CoreSubst import Var ( Var ) -import VarEnv ( elemInScopeSet ) +import VarEnv ( elemInScopeSet, mkInScopeSet ) import Id ( Id, idType, idInlineActivation, isDeadBinder , zapIdOccInfo, zapIdUsageInfo, idInlinePragma , isJoinId ) import CoreUtils ( mkAltExpr, eqExpr , exprIsLiteralString , stripTicksE, stripTicksT, mkTicks ) +import CoreFVs ( exprFreeVars ) import Type ( tyConAppArgs ) import CoreSyn import Outputable @@ -444,8 +445,13 @@ tryForCSE env expr -- top of the replaced sub-expression. This is probably not too -- useful in practice, but upholds our semantics. +-- | Runs CSE on a single expression. +-- +-- This entry point is not used in the compiler itself, but is provided +-- as a convenient entry point for users of the GHC API. cseOneExpr :: InExpr -> OutExpr -cseOneExpr = cseExpr emptyCSEnv +cseOneExpr e = cseExpr env e + where env = emptyCSEnv {cs_subst = mkEmptySubst (mkInScopeSet (exprFreeVars e)) } cseExpr :: CSEnv -> InExpr -> OutExpr cseExpr env (Type t) = Type (substTy (csEnvSubst env) t) From git at git.haskell.org Fri Aug 18 13:08:52 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 18 Aug 2017 13:08:52 +0000 (UTC) Subject: [commit: ghc] wip/T14068: Update compiler performance numbers (7dc8229) Message-ID: <20170818130852.E25B43A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14068 Link : http://ghc.haskell.org/trac/ghc/changeset/7dc8229330364823d9a29280aeb2480a53768790/ghc >--------------------------------------------------------------- commit 7dc8229330364823d9a29280aeb2480a53768790 Author: Joachim Breitner Date: Wed Aug 2 18:14:29 2017 -0400 Update compiler performance numbers some regression is expected (more inlining means more code!). But no detailed investigation. >--------------------------------------------------------------- 7dc8229330364823d9a29280aeb2480a53768790 testsuite/tests/perf/compiler/all.T | 13 +++++++++---- 1 file changed, 9 insertions(+), 4 deletions(-) diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T index baca57c..62a579f 100644 --- a/testsuite/tests/perf/compiler/all.T +++ b/testsuite/tests/perf/compiler/all.T @@ -196,7 +196,7 @@ test('T3294', # 2013-11-13: 1478325844 (x86/Windows, 64bit machine) # 2014-01-12: 1565185140 (x86/Linux) # 2013-04-04: 1377050640 (x86/Windows, 64bit machine) - (wordsize(64), 2253557280, 5)]), + (wordsize(64), 2419213272, 5)]), # old: 1357587088 (amd64/Linux) # 29/08/2012: 2961778696 (amd64/Linux) # (^ increase due to new codegen, see #7198) @@ -211,6 +211,7 @@ test('T3294', # 2016-07-11: 2739731144 (Windows) after fix for #12227 (ignoring) # 2017-02-17: 2758641264 (amd64/Linux) (Type indexed Typeable) # 2017-05-14: 2253557280 (amd64/Linux) Two-pass CmmLayoutStack + # 2017-08-02: 2419213272 (amd64/Linux) Loopification conf_3294, # Use `+RTS -G1` for more stable residency measurements. Note [residency]. @@ -944,7 +945,7 @@ test('T9233', test('T10370', [ only_ways(['optasm']), compiler_stats_num_field('max_bytes_used', # Note [residency] - [(wordsize(64), 31524048, 15), + [(wordsize(64), 50774760, 15), # 2015-10-22 19548720 # 2016-02-24 22823976 Changing Levity to RuntimeRep; not sure why this regresses though, even after some analysis # 2016-04-14 28256896 final demand analyzer run @@ -961,13 +962,14 @@ test('T10370', # 2017-02-27 43455848 Likely drift from recent simplifier improvements # 2017-02-25 41291976 Early inline patch # 2017-04-30 31524048 Fix leaks in tidy unfoldings + # 2017-08-02 50774760 Loopificatoin (wordsize(32), 19276304, 15), # 2015-10-22 11371496 # 2017-03-24 19276304 (x86/Linux, 64-bit machine) ]), compiler_stats_num_field('peak_megabytes_allocated', # Note [residency] - [(wordsize(64), 117, 15), + [(wordsize(64), 191, 15), # 2015-10-22 76 # 2016-04-14 101 final demand analyzer run # 2016-08-08 121 see above @@ -975,6 +977,7 @@ test('T10370', # 2017-02-17 187 Type-indexed Typeable # 2017-02-25 154 Early inline patch # 2017-04-30 117 Fix leaks in tidy unfoldings + # 2017-08-02 191 Loopification (wordsize(32), 69, 15), # 2015-10-22 39 # 2017-03-24 69 @@ -1163,7 +1166,9 @@ test('Naperian', [ reqlib('vector'), only_ways(['optasm']), compiler_stats_num_field('bytes allocated', - [(wordsize(64), 2381935784, 10)]) + [(wordsize(64), 49646368, 10)]) + # initial 2381935784 + # 2017-08-01 49646368 loopification (fishy) ], compile, ['']) From git at git.haskell.org Fri Aug 18 13:08:55 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 18 Aug 2017 13:08:55 +0000 (UTC) Subject: [commit: ghc] wip/T14068: Prevent inlining of loopified programs (b726f71) Message-ID: <20170818130855.9C6593A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14068 Link : http://ghc.haskell.org/trac/ghc/changeset/b726f715cfef0e52476b8866308c857c60331ae0/ghc >--------------------------------------------------------------- commit b726f715cfef0e52476b8866308c857c60331ae0 Author: Joachim Breitner Date: Fri Aug 4 15:34:11 2017 -0400 Prevent inlining of loopified programs Previously, a recursive function is not inlineable. After loopification, it turns into a non-recursive function, and suddenly it is. While this is in general desirable, it has many knock-on effects, which makes it hard to evaluate and debug loopification. Therefore, this commit (tries to) prevent this inlining. When this results in no unfixable regressions, then we can tackle the next step. >--------------------------------------------------------------- b726f715cfef0e52476b8866308c857c60331ae0 compiler/coreSyn/CoreOpt.hs | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/compiler/coreSyn/CoreOpt.hs b/compiler/coreSyn/CoreOpt.hs index 5949cf6..b62c025 100644 --- a/compiler/coreSyn/CoreOpt.hs +++ b/compiler/coreSyn/CoreOpt.hs @@ -672,7 +672,11 @@ loopificationJoinPointBinding_maybe bndr rhs localiseId $ bndr -- RULES etc stay with bindr' - bndr' = zapIdTailCallInfo bndr + -- Also, previously, the function was recursive, and hence not inlineable. + -- To tread with caution, let's keep it this way + bndr' = (`setIdUnfolding` noUnfolding) $ + zapIdTailCallInfo $ + bndr in Just (bndr', join_bndr, mkLams bndrs body) | otherwise From git at git.haskell.org Fri Aug 18 13:08:58 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 18 Aug 2017 13:08:58 +0000 (UTC) Subject: [commit: ghc] wip/T14068: Revert "Prevent inlining of loopified programs" (11d38a5) Message-ID: <20170818130858.5BD1D3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14068 Link : http://ghc.haskell.org/trac/ghc/changeset/11d38a58e974bd784007faf02aea334b7bd02a6d/ghc >--------------------------------------------------------------- commit 11d38a58e974bd784007faf02aea334b7bd02a6d Author: Joachim Breitner Date: Fri Aug 18 15:07:30 2017 +0200 Revert "Prevent inlining of loopified programs" This reverts commit b726f715cfef0e52476b8866308c857c60331ae0. Inline prevention did not work properly. (These two commits will not be present when the branch is merged and squashed, but as long as I work on this branch I’d like them to be around.) >--------------------------------------------------------------- 11d38a58e974bd784007faf02aea334b7bd02a6d compiler/coreSyn/CoreOpt.hs | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/compiler/coreSyn/CoreOpt.hs b/compiler/coreSyn/CoreOpt.hs index b62c025..5949cf6 100644 --- a/compiler/coreSyn/CoreOpt.hs +++ b/compiler/coreSyn/CoreOpt.hs @@ -672,11 +672,7 @@ loopificationJoinPointBinding_maybe bndr rhs localiseId $ bndr -- RULES etc stay with bindr' - -- Also, previously, the function was recursive, and hence not inlineable. - -- To tread with caution, let's keep it this way - bndr' = (`setIdUnfolding` noUnfolding) $ - zapIdTailCallInfo $ - bndr + bndr' = zapIdTailCallInfo bndr in Just (bndr', join_bndr, mkLams bndrs body) | otherwise From git at git.haskell.org Fri Aug 18 13:51:35 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 18 Aug 2017 13:51:35 +0000 (UTC) Subject: [commit: ghc] master: Comments only (4c6fcd7) Message-ID: <20170818135135.3418C3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4c6fcd7230e1d4d8e79c57823911a90d43ac7b32/ghc >--------------------------------------------------------------- commit 4c6fcd7230e1d4d8e79c57823911a90d43ac7b32 Author: Simon Peyton Jones Date: Fri Aug 18 09:02:13 2017 +0100 Comments only >--------------------------------------------------------------- 4c6fcd7230e1d4d8e79c57823911a90d43ac7b32 compiler/deSugar/DsBinds.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/compiler/deSugar/DsBinds.hs b/compiler/deSugar/DsBinds.hs index a3e5c15..c13b2ea 100644 --- a/compiler/deSugar/DsBinds.hs +++ b/compiler/deSugar/DsBinds.hs @@ -356,7 +356,8 @@ dsAbsBinds dflags tyvars dicts exports makeCorePair :: DynFlags -> Id -> Bool -> Arity -> CoreExpr -> (Id, CoreExpr) makeCorePair dflags gbl_id is_default_method dict_arity rhs - | is_default_method -- Default methods are *always* inlined + | is_default_method -- Default methods are *always* inlined + -- See Note [INLINE and default methods] in TcInstDcls = (gbl_id `setIdUnfolding` mkCompulsoryUnfolding rhs, rhs) | otherwise From git at git.haskell.org Fri Aug 18 13:51:38 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 18 Aug 2017 13:51:38 +0000 (UTC) Subject: [commit: ghc] master: Test Trac #14110 (61c4246) Message-ID: <20170818135138.8784E3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/61c42464d2f128403e2cd082b5c74f0dd7890452/ghc >--------------------------------------------------------------- commit 61c42464d2f128403e2cd082b5c74f0dd7890452 Author: Simon Peyton Jones Date: Fri Aug 18 14:50:57 2017 +0100 Test Trac #14110 >--------------------------------------------------------------- 61c42464d2f128403e2cd082b5c74f0dd7890452 testsuite/tests/polykinds/T14110.hs | 9 +++++++++ testsuite/tests/polykinds/T14110.stderr | 5 +++++ testsuite/tests/polykinds/all.T | 1 + 3 files changed, 15 insertions(+) diff --git a/testsuite/tests/polykinds/T14110.hs b/testsuite/tests/polykinds/T14110.hs new file mode 100644 index 0000000..d2e8e71 --- /dev/null +++ b/testsuite/tests/polykinds/T14110.hs @@ -0,0 +1,9 @@ +{-# Language TypeFamilies, ScopedTypeVariables, PolyKinds, DataKinds #-} + +import Data.Kind + +class R (c :: k -> Constraint) where + type R_ (c :: k -> Constraint) :: k -> Type + +instance R Eq where + type R_ Eq a = a -> a -> Bool diff --git a/testsuite/tests/polykinds/T14110.stderr b/testsuite/tests/polykinds/T14110.stderr new file mode 100644 index 0000000..aedfacb --- /dev/null +++ b/testsuite/tests/polykinds/T14110.stderr @@ -0,0 +1,5 @@ + +T14110.hs:9:8: error: + • Number of parameters must match family declaration; expected 1 + • In the type instance declaration for ‘R_’ + In the instance declaration for ‘R Eq’ diff --git a/testsuite/tests/polykinds/all.T b/testsuite/tests/polykinds/all.T index 900faca..ddee253 100644 --- a/testsuite/tests/polykinds/all.T +++ b/testsuite/tests/polykinds/all.T @@ -163,3 +163,4 @@ test('T13393', normal, compile_fail, ['']) test('T13555', normal, compile_fail, ['']) test('T13659', normal, compile_fail, ['']) test('T13625', normal, compile_fail, ['']) +test('T14110', normal, compile_fail, ['']) From git at git.haskell.org Fri Aug 18 13:51:46 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 18 Aug 2017 13:51:46 +0000 (UTC) Subject: [commit: ghc] master: Comments about GlobalRdrEnv shadowing (6257fb5) Message-ID: <20170818135146.B0DD73A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6257fb528c1c92fbe3bd66441bfba00f632d1b50/ghc >--------------------------------------------------------------- commit 6257fb528c1c92fbe3bd66441bfba00f632d1b50 Author: Simon Peyton Jones Date: Tue Aug 1 12:07:34 2017 +0100 Comments about GlobalRdrEnv shadowing Provoked by Trac #14052 >--------------------------------------------------------------- 6257fb528c1c92fbe3bd66441bfba00f632d1b50 compiler/basicTypes/RdrName.hs | 43 +++++++++++++++++++++++++++++++++++------- 1 file changed, 36 insertions(+), 7 deletions(-) diff --git a/compiler/basicTypes/RdrName.hs b/compiler/basicTypes/RdrName.hs index 9e59c97..f28ae01 100644 --- a/compiler/basicTypes/RdrName.hs +++ b/compiler/basicTypes/RdrName.hs @@ -999,15 +999,44 @@ shadowNames = foldl shadowName {- Note [GlobalRdrEnv shadowing] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Before adding new names to the GlobalRdrEnv we nuke some existing entries; -this is "shadowing". The actual work is done by RdrEnv.shadowNames. +this is "shadowing". The actual work is done by RdrEnv.shadowName. +Suppose + env' = shadowName env M.f + +Then: + * Looking up (Unqual f) in env' should succeed, returning M.f, + even if env contains existing unqualified bindings for f. + They are shadowed + + * Looking up (Qual M.f) in env' should succeed, returning M.f + + * Looking up (Qual X.f) in env', where X /= M, should be the same as + looking up (Qual X.f) in env. + That is, shadowName does /not/ delete earlier qualified bindings + There are two reasons for shadowing: * The GHCi REPL - Ids bought into scope on the command line (eg let x = True) have External Names, like Ghci4.x. We want a new binding for 'x' (say) - to override the existing binding for 'x'. - See Note [Interactively-bound Ids in GHCi] in HscTypes + to override the existing binding for 'x'. Example: + + ghci> :load M -- Brings `x` and `M.x` into scope + ghci> x + ghci> "Hello" + ghci> M.x + ghci> "hello" + ghci> let x = True -- Shadows `x` + ghci> x -- The locally bound `x` + -- NOT an ambiguous reference + ghci> True + ghci> M.x -- M.x is still in scope! + ghci> "Hello" + So when we add `x = True` we must not delete the `M.x` from the + `GlobalRdrEnv`; rather we just want to make it "qualified only"; + hence the `mk_fake-imp_spec` in `shadowName`. See also Note + [Interactively-bound Ids in GHCi] in HscTypes - Data types also have Extenal Names, like Ghci4.T; but we still want 'T' to mean the newly-declared 'T', not an old one. @@ -1017,10 +1046,10 @@ There are two reasons for shadowing: Consider a TH decl quote: module M where - f x = h [d| f = 3 |] - We must shadow the outer declaration of 'f', else we'll get a - complaint when extending the GlobalRdrEnv, saying that there are two - bindings for 'f'. There are several tricky points: + f x = h [d| f = ...f...M.f... |] + We must shadow the outer unqualified binding of 'f', else we'll get + a complaint when extending the GlobalRdrEnv, saying that there are + two bindings for 'f'. There are several tricky points: - This shadowing applies even if the binding for 'f' is in a where-clause, and hence is in the *local* RdrEnv not the *global* From git at git.haskell.org Fri Aug 18 13:51:44 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 18 Aug 2017 13:51:44 +0000 (UTC) Subject: [commit: ghc] master: Restrict Lint's complaints about recursive INLINEs somewhat (118efb0) Message-ID: <20170818135144.028703A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/118efb075367f4c8f686dfb34c0be8d464319c2f/ghc >--------------------------------------------------------------- commit 118efb075367f4c8f686dfb34c0be8d464319c2f Author: Simon Peyton Jones Date: Wed Aug 2 09:48:58 2017 +0100 Restrict Lint's complaints about recursive INLINEs somewhat This patch makes the Lint warning about recursive functions with an INLINE only apply if there is a stable unfolding. If not (e.g. some other pass took it out) we don't need to worry. Not a big deal. >--------------------------------------------------------------- 118efb075367f4c8f686dfb34c0be8d464319c2f compiler/coreSyn/CoreLint.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/compiler/coreSyn/CoreLint.hs b/compiler/coreSyn/CoreLint.hs index 390a317..e85cfe8 100644 --- a/compiler/coreSyn/CoreLint.hs +++ b/compiler/coreSyn/CoreLint.hs @@ -548,6 +548,7 @@ lintSingleBinding top_lvl_flag rec_flag (binder,rhs) (mkInvalidJoinPointMsg binder binder_ty) ; when (lf_check_inline_loop_breakers flags + && isStableUnfolding (realIdUnfolding binder) && isStrongLoopBreaker (idOccInfo binder) && isInlinePragma (idInlinePragma binder)) (addWarnL (text "INLINE binder is (non-rule) loop breaker:" <+> ppr binder)) From git at git.haskell.org Fri Aug 18 13:51:41 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 18 Aug 2017 13:51:41 +0000 (UTC) Subject: [commit: ghc] master: Tracing in OccAnal (commented out) (698adb5) Message-ID: <20170818135141.458F43A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/698adb512de7a3abf747a02ac9665849992e2e87/ghc >--------------------------------------------------------------- commit 698adb512de7a3abf747a02ac9665849992e2e87 Author: Simon Peyton Jones Date: Wed Aug 2 15:56:32 2017 +0100 Tracing in OccAnal (commented out) >--------------------------------------------------------------- 698adb512de7a3abf747a02ac9665849992e2e87 compiler/simplCore/OccurAnal.hs | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/compiler/simplCore/OccurAnal.hs b/compiler/simplCore/OccurAnal.hs index dbe1c48..1620c91 100644 --- a/compiler/simplCore/OccurAnal.hs +++ b/compiler/simplCore/OccurAnal.hs @@ -955,7 +955,8 @@ recording inlinings for any Ids which aren't marked as "no-inline" as it goes. -- Return the bindings sorted into a plausible order, and marked with loop breakers. loopBreakNodes depth bndr_set weak_fvs nodes binds - = go (stronglyConnCompFromEdgedVerticesUniqR nodes) binds + = -- pprTrace "loopBreakNodes" (ppr nodes) $ + go (stronglyConnCompFromEdgedVerticesUniqR nodes) binds where go [] binds = binds go (scc:sccs) binds = loop_break_scc scc (go sccs binds) @@ -972,8 +973,8 @@ reOrderNodes :: Int -> VarSet -> VarSet -> [LetrecNode] -> [Binding] -> [Binding reOrderNodes _ _ _ [] _ = panic "reOrderNodes" reOrderNodes _ _ _ [node] binds = mk_loop_breaker node : binds reOrderNodes depth bndr_set weak_fvs (node : nodes) binds - = -- pprTrace "reOrderNodes" (text "unchosen" <+> ppr unchosen $$ - -- text "chosen" <+> ppr chosen_nodes) $ + = -- pprTrace "reOrderNodes" (vcat [ text "unchosen" <+> ppr unchosen + -- , text "chosen" <+> ppr chosen_nodes ]) $ loopBreakNodes new_depth bndr_set weak_fvs unchosen $ (map mk_loop_breaker chosen_nodes ++ binds) where From git at git.haskell.org Fri Aug 18 19:47:47 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 18 Aug 2017 19:47:47 +0000 (UTC) Subject: [commit: ghc] wip/rae: Update Travis to bootstrap with 8.0.2 (d255a20) Message-ID: <20170818194747.F04A13A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/d255a201fda9495b21d448ead0066249f67b6bd5/ghc >--------------------------------------------------------------- commit d255a201fda9495b21d448ead0066249f67b6bd5 Author: Richard Eisenberg Date: Fri Aug 18 15:47:22 2017 -0400 Update Travis to bootstrap with 8.0.2 >--------------------------------------------------------------- d255a201fda9495b21d448ead0066249f67b6bd5 .travis.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.travis.yml b/.travis.yml index 218f5ba..8e314b6 100644 --- a/.travis.yml +++ b/.travis.yml @@ -18,14 +18,14 @@ addons: - ubuntu-toolchain-r-test packages: - cabal-install-1.18 - - ghc-7.10.3 + - ghc-8.0.2 - alex-3.1.3 - happy-1.19.4 - python3 #- llvm-3.7 before_install: - - export PATH=/opt/ghc/7.10.3/bin:/opt/cabal/1.18/bin:/opt/alex/3.1.3/bin:/opt/happy/1.19.4/bin:/usr/lib/llvm-3.7/bin:$PATH + - export PATH=/opt/ghc/8.0.2/bin:/opt/cabal/1.18/bin:/opt/alex/3.1.3/bin:/opt/happy/1.19.4/bin:/usr/lib/llvm-3.7/bin:$PATH # Be explicit about which protocol to use, such that we don't have to repeat the rewrite command for each. - git config remote.origin.url git://github.com/${TRAVIS_REPO_SLUG}.git From git at git.haskell.org Sat Aug 19 03:28:36 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 19 Aug 2017 03:28:36 +0000 (UTC) Subject: [commit: ghc] master: Add strict variant of iterate (8e5b6ec) Message-ID: <20170819032836.DE6B73A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8e5b6ec6566da57d15b0810a07902d9eac85cb79/ghc >--------------------------------------------------------------- commit 8e5b6ec6566da57d15b0810a07902d9eac85cb79 Author: Ben Gamari Date: Fri Aug 18 10:24:58 2017 -0400 Add strict variant of iterate This closes the nearly-eight-year-old #3474. >--------------------------------------------------------------- 8e5b6ec6566da57d15b0810a07902d9eac85cb79 libraries/base/Data/List.hs | 1 + libraries/base/Data/OldList.hs | 1 + libraries/base/GHC/List.hs | 25 ++++++++++++++++++++++++- libraries/base/changelog.md | 3 +++ 4 files changed, 29 insertions(+), 1 deletion(-) diff --git a/libraries/base/Data/List.hs b/libraries/base/Data/List.hs index 693c0dd..2ac04a9 100644 --- a/libraries/base/Data/List.hs +++ b/libraries/base/Data/List.hs @@ -76,6 +76,7 @@ module Data.List -- ** Infinite lists , iterate + , iterate' , repeat , replicate , cycle diff --git a/libraries/base/Data/OldList.hs b/libraries/base/Data/OldList.hs index d03c0bc..c4c38d4 100644 --- a/libraries/base/Data/OldList.hs +++ b/libraries/base/Data/OldList.hs @@ -77,6 +77,7 @@ module Data.OldList -- ** Infinite lists , iterate + , iterate' , repeat , replicate , cycle diff --git a/libraries/base/GHC/List.hs b/libraries/base/GHC/List.hs index 70bfbe4..ca95379 100644 --- a/libraries/base/GHC/List.hs +++ b/libraries/base/GHC/List.hs @@ -23,7 +23,7 @@ module GHC.List ( map, (++), filter, concat, head, last, tail, init, uncons, null, length, (!!), foldl, foldl', foldl1, foldl1', scanl, scanl1, scanl', foldr, foldr1, - scanr, scanr1, iterate, repeat, replicate, cycle, + scanr, scanr1, iterate, iterate', repeat, replicate, cycle, take, drop, sum, product, maximum, minimum, splitAt, takeWhile, dropWhile, span, break, reverse, and, or, any, all, elem, notElem, lookup, @@ -458,6 +458,29 @@ iterateFB c f x0 = go x0 #-} +-- | 'iterate\'' is the strict version of 'iterate'. +-- +-- It ensures that the result of each application of force to weak head normal +-- form before proceeding. +{-# NOINLINE [1] iterate' #-} +iterate' :: (a -> a) -> a -> [a] +iterate' f x = + let x' = f x + in x' `seq` (x : iterate' f x') + +{-# INLINE [0] iterate'FB #-} -- See Note [Inline FB functions] +iterate'FB :: (a -> b -> b) -> (a -> a) -> a -> b +iterate'FB c f x0 = go x0 + where go x = + let x' = f x + in x' `seq` (x `c` go x') + +{-# RULES +"iterate'" [~1] forall f x. iterate' f x = build (\c _n -> iterate'FB c f x) +"iterate'FB" [1] iterate'FB (:) = iterate' + #-} + + -- | 'repeat' @x@ is an infinite list, with @x@ the value of every element. repeat :: a -> [a] {-# INLINE [0] repeat #-} diff --git a/libraries/base/changelog.md b/libraries/base/changelog.md index ab304a3..a62b8339 100644 --- a/libraries/base/changelog.md +++ b/libraries/base/changelog.md @@ -16,6 +16,9 @@ * Add instances `Semigroup` and `Monoid` for `Control.Monad.ST` (#14107). + * Add `iterate'`, a strict version of `iterate`, to `Data.List` + and `Data.OldList` (#3474) + ## 4.10.0.0 *April 2017* * Bundled with GHC *TBA* From git at git.haskell.org Sat Aug 19 03:28:39 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 19 Aug 2017 03:28:39 +0000 (UTC) Subject: [commit: ghc] master: Doctests for Data.Tuple (f50e30e) Message-ID: <20170819032839.971693A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f50e30e0e34487ae8bf49653875ed7c8d0afa791/ghc >--------------------------------------------------------------- commit f50e30e0e34487ae8bf49653875ed7c8d0afa791 Author: David Luposchainsky Date: Fri Aug 11 10:37:55 2017 +0200 Doctests for Data.Tuple >--------------------------------------------------------------- f50e30e0e34487ae8bf49653875ed7c8d0afa791 libraries/base/Data/Tuple.hs | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) diff --git a/libraries/base/Data/Tuple.hs b/libraries/base/Data/Tuple.hs index 372e2b8..569dd14 100644 --- a/libraries/base/Data/Tuple.hs +++ b/libraries/base/Data/Tuple.hs @@ -39,13 +39,32 @@ snd :: (a,b) -> b snd (_,y) = y -- | 'curry' converts an uncurried function to a curried function. +-- +-- ==== __Examples__ +-- +-- >>> curry fst 1 2 +-- 1 curry :: ((a, b) -> c) -> a -> b -> c curry f x y = f (x, y) -- | 'uncurry' converts a curried function to a function on pairs. +-- +-- ==== __Examples__ +-- +-- >>> uncurry (+) (1,2) +-- 3 +-- +-- >>> uncurry ($) (show, 1) +-- "1" +-- +-- >>> map (uncurry max) [(1,2), (3,4), (6,8)] +-- [2,4,8] uncurry :: (a -> b -> c) -> ((a, b) -> c) uncurry f p = f (fst p) (snd p) -- | Swap the components of a pair. swap :: (a,b) -> (b,a) swap (a,b) = (b,a) + +-- $setup +-- >>> import Prelude hiding (curry, uncurry, fst, snd) From git at git.haskell.org Sat Aug 19 03:28:42 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 19 Aug 2017 03:28:42 +0000 (UTC) Subject: [commit: ghc] master: Enable -Wcpp-undef for GHC and runtime system (6267d8c) Message-ID: <20170819032842.540863A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6267d8c9e54663a23f0ac13556522a53580d0910/ghc >--------------------------------------------------------------- commit 6267d8c9e54663a23f0ac13556522a53580d0910 Author: Ben Gamari Date: Fri Aug 18 08:37:14 2017 -0400 Enable -Wcpp-undef for GHC and runtime system This gets us much of the benefit of enabling it globally, which avoiding (at least for now) the pain of making the core libraries build as well. See #13636. Test Plan: Validate Reviewers: erikd, austin Subscribers: rwbarton, thomie GHC Trac Issues: #13636 Differential Revision: https://phabricator.haskell.org/D3517 >--------------------------------------------------------------- 6267d8c9e54663a23f0ac13556522a53580d0910 mk/warnings.mk | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/mk/warnings.mk b/mk/warnings.mk index 16d13a2..85cb1a0 100644 --- a/mk/warnings.mk +++ b/mk/warnings.mk @@ -8,9 +8,14 @@ SRC_HC_OPTS += -Wall # isn't supported yet (https://ghc.haskell.org/trac/ghc/wiki/Design/Warnings). # # See Note [Stage number in build variables] in mk/config.mk.in. -SRC_HC_OPTS_STAGE1 += $(WERROR) #-Wcpp-undef -SRC_HC_OPTS_STAGE2 += $(WERROR) #-Wcpp-undef - +SRC_HC_OPTS_STAGE1 += $(WERROR) +SRC_HC_OPTS_STAGE2 += $(WERROR) + +# Enable -Wcpp-undef for GHC components only as we don't (currently) expect core +# libraries to build in this configuration (see #13636). +GhcRtsHcOpts += -Wcpp-undef +GhcStage1HcOpts += -Wcpp-undef +GhcStage2HcOpts += -Wcpp-undef ifneq "$(GccIsClang)" "YES" From git at git.haskell.org Sat Aug 19 03:28:46 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 19 Aug 2017 03:28:46 +0000 (UTC) Subject: [commit: ghc] master: users_guide: Convert mkUserGuidePart generation to a Sphinx extension (cf8ab1c) Message-ID: <20170819032846.3544B3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/cf8ab1ced6f15dad03dd7bcc454ef759cf4d3b3d/ghc >--------------------------------------------------------------- commit cf8ab1ced6f15dad03dd7bcc454ef759cf4d3b3d Author: Patrick Dougherty Date: Fri Aug 18 09:20:07 2017 -0400 users_guide: Convert mkUserGuidePart generation to a Sphinx extension This removes all dependencies the users guide had on `mkUserGuidePart`. The generation of the flag reference table and the various pieces of the man page is now entirely contained within the Spinx extension `flags.py`. You can see the man page generation on the orphan page https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/ghc.html The extension works by collecting all of the meta-data attached to the `ghc-flag` directives and then formatting and displaying it at `flag-print` directives. There is a single printing directive that can be customized with two options, what format to display (table, list, or block of flags) and an optional category to limit the output to (verbosity, warnings, codegen, etc.). New display formats can be added by creating a function `generate_flag_xxx` (where `xxx` is a description of the format) which takes a list of flags and a category and returns a new `xxx`. Then just add a reference in the dispatch table `handlers`. That display can now be run by passing `:type: xxx` to the `flag-print` directive. `flags.py` contains two maps of settings that can be adjusted. The first is a canonical list of flag categories, and the second sets default categories for files. The only functionality that Sphinx could not replace was the `what_glasgow_exts_does.gen.rst` file. `mkUserGuidePart` actually just reads the list of flags from `compiler/main/DynFlags.hs` which Sphinx cannot do. As the flag is deprecated, I added the list as a static file which can be updated manually. Additionally, this patch updates every single documented flag with the data from `mkUserGuidePart` to generate the reference table. Fixes #11654 and, incidentally, #12155. Reviewers: austin, bgamari Subscribers: rwbarton, thomie GHC Trac Issues: #11654, #12155 Differential Revision: https://phabricator.haskell.org/D3839 >--------------------------------------------------------------- cf8ab1ced6f15dad03dd7bcc454ef759cf4d3b3d .gitignore | 2 +- compiler/main/DynFlags.hs | 1 + docs/users_guide/conf.py | 15 +- docs/users_guide/debug-info.rst | 5 + docs/users_guide/debugging.rst | 232 ++++++++++- docs/users_guide/editing-guide.rst | 28 +- docs/users_guide/extending_ghc.rst | 20 +- docs/users_guide/ffi-chap.rst | 22 ++ docs/users_guide/flags.py | 400 +++++++++++++++++++ docs/users_guide/flags.rst | 269 +++++++++++-- docs/users_guide/ghc.mk | 6 +- docs/users_guide/ghc.rst | 312 ++++++++++++++- docs/users_guide/ghci.rst | 66 +++- docs/users_guide/glasgow_exts.rst | 578 +++++++++++++++++++++++++++- docs/users_guide/packages.rst | 57 ++- docs/users_guide/phases.rst | 229 +++++++++++ docs/users_guide/profiling.rst | 44 ++- docs/users_guide/safe_haskell.rst | 60 ++- docs/users_guide/separate_compilation.rst | 117 +++++- docs/users_guide/using-concurrent.rst | 4 + docs/users_guide/using-optimisation.rst | 285 +++++++++++++- docs/users_guide/using-warnings.rst | 432 +++++++++++++++++++-- docs/users_guide/using.rst | 159 +++++++- docs/users_guide/what_glasgow_exts_does.rst | 33 ++ 24 files changed, 3226 insertions(+), 150 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 cf8ab1ced6f15dad03dd7bcc454ef759cf4d3b3d From git at git.haskell.org Sat Aug 19 07:32:02 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 19 Aug 2017 07:32:02 +0000 (UTC) Subject: [commit: ghc] master: Correct incorrect free in PE linker (ee2e9ec) Message-ID: <20170819073202.8B90D3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ee2e9ece388e75ac433097ac726a555a07ae0830/ghc >--------------------------------------------------------------- commit ee2e9ece388e75ac433097ac726a555a07ae0830 Author: Tamar Christina Date: Sat Aug 19 08:31:34 2017 +0100 Correct incorrect free in PE linker Summary: The big-obj support (D3523) had introduced an early free on the info structure. Because the pointer is not NULL'd and the default of all the utility functions was to the standard object format, it all kept working. The one big-obj test that exists was subjected to a timing issue. usually the test ran quickly enough that the allocator hasn't had time to reclaim the memory yet, so it still passed. This corrects it. Also as it so happens, static LLVM libraries from mingw-w64 are compiled using big-obj. Test Plan: ./validate Reviewers: austin, bgamari, erikd, simonmar Reviewed By: bgamari Subscribers: rwbarton, thomie GHC Trac Issues: #13815, #13093 Differential Revision: https://phabricator.haskell.org/D3862 >--------------------------------------------------------------- ee2e9ece388e75ac433097ac726a555a07ae0830 rts/linker/PEi386.c | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/rts/linker/PEi386.c b/rts/linker/PEi386.c index 22258fe..42e7008 100644 --- a/rts/linker/PEi386.c +++ b/rts/linker/PEi386.c @@ -1421,6 +1421,7 @@ ocGetNames_PEi386 ( ObjectCode* oc ) addr = (char*)cstring_from_COFF_symbol_name( getSymShortName (info, symtab_i), strtab); + stgFree (info); IF_DEBUG(linker, debugBelch("addImportSymbol `%s' => `%s'\n", @@ -1471,8 +1472,6 @@ ocGetNames_PEi386 ( ObjectCode* oc ) i += getSymNumberOfAuxSymbols (info, symtab_i); } - stgFree (info); - /* Allocate BSS space */ SymbolAddr* bss = NULL; if (globalBssSize > 0) { @@ -1570,6 +1569,7 @@ ocGetNames_PEi386 ( ObjectCode* oc ) if (result != NULL || dllInstance == 0) { errorBelch("Could not load `%s'. Reason: %s\n", (char*)dllName, result); + stgFree (info); return false; } @@ -1599,8 +1599,10 @@ ocGetNames_PEi386 ( ObjectCode* oc ) sname[size-start]='\0'; stgFree(tmp); if (!ghciInsertSymbolTable(oc->fileName, symhash, (SymbolName*)sname, - addr, false, oc)) + addr, false, oc)) { + stgFree (info); return false; + } break; } @@ -1617,6 +1619,7 @@ ocGetNames_PEi386 ( ObjectCode* oc ) if (! ghciInsertSymbolTable(oc->fileName, symhash, (SymbolName*)sname, addr, isWeak, oc)) { + stgFree (info); return false; } } else { @@ -1650,6 +1653,7 @@ ocGetNames_PEi386 ( ObjectCode* oc ) i += getSymNumberOfAuxSymbols (info, symtab_i); } + stgFree (info); return true; } From git at git.haskell.org Sat Aug 19 11:04:09 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 19 Aug 2017 11:04:09 +0000 (UTC) Subject: [commit: ghc] branch 'wip/T14137' created Message-ID: <20170819110409.B34E63A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/T14137 Referencing: 62644b0071c3be0f295d7c1271d12cdc38ef25c9 From git at git.haskell.org Sat Aug 19 11:04:12 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 19 Aug 2017 11:04:12 +0000 (UTC) Subject: [commit: ghc] wip/T14137: Inline join points with a single occurrence even into joinrecs (62644b0) Message-ID: <20170819110412.7A8CA3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14137 Link : http://ghc.haskell.org/trac/ghc/changeset/62644b0071c3be0f295d7c1271d12cdc38ef25c9/ghc >--------------------------------------------------------------- commit 62644b0071c3be0f295d7c1271d12cdc38ef25c9 Author: Joachim Breitner Date: Sat Aug 19 13:02:43 2017 +0200 Inline join points with a single occurrence even into joinrecs as proposed by SPJ in https://ghc.haskell.org/trac/ghc/ticket/14137#comment:8. (explanatory Note pending) >--------------------------------------------------------------- 62644b0071c3be0f295d7c1271d12cdc38ef25c9 compiler/simplCore/SimplUtils.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/compiler/simplCore/SimplUtils.hs b/compiler/simplCore/SimplUtils.hs index b01955c..5977353 100644 --- a/compiler/simplCore/SimplUtils.hs +++ b/compiler/simplCore/SimplUtils.hs @@ -1068,7 +1068,8 @@ preInlineUnconditionally dflags env top_lvl bndr rhs | otherwise = case idOccInfo bndr of IAmDead -> True -- Happens in ((\x.1) v) occ at OneOcc { occ_one_br = True } - -> try_once (occ_in_lam occ) + | isJoinId bndr -> True + | otherwise -> try_once (occ_in_lam occ) (occ_int_cxt occ) _ -> False where From git at git.haskell.org Sat Aug 19 11:45:06 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 19 Aug 2017 11:45:06 +0000 (UTC) Subject: [commit: ghc] master: Revert "Add strict variant of iterate" (1cdceb9) Message-ID: <20170819114506.C88623A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1cdceb9fa3bc3ad01b2d840caad8e735513e14ed/ghc >--------------------------------------------------------------- commit 1cdceb9fa3bc3ad01b2d840caad8e735513e14ed Author: Ben Gamari Date: Sat Aug 19 07:44:13 2017 -0400 Revert "Add strict variant of iterate" This was not ready to commit. This reverts commit 8e5b6ec6566da57d15b0810a07902d9eac85cb79. >--------------------------------------------------------------- 1cdceb9fa3bc3ad01b2d840caad8e735513e14ed libraries/base/Data/List.hs | 1 - libraries/base/Data/OldList.hs | 1 - libraries/base/GHC/List.hs | 25 +------------------------ libraries/base/changelog.md | 3 --- 4 files changed, 1 insertion(+), 29 deletions(-) diff --git a/libraries/base/Data/List.hs b/libraries/base/Data/List.hs index 2ac04a9..693c0dd 100644 --- a/libraries/base/Data/List.hs +++ b/libraries/base/Data/List.hs @@ -76,7 +76,6 @@ module Data.List -- ** Infinite lists , iterate - , iterate' , repeat , replicate , cycle diff --git a/libraries/base/Data/OldList.hs b/libraries/base/Data/OldList.hs index c4c38d4..d03c0bc 100644 --- a/libraries/base/Data/OldList.hs +++ b/libraries/base/Data/OldList.hs @@ -77,7 +77,6 @@ module Data.OldList -- ** Infinite lists , iterate - , iterate' , repeat , replicate , cycle diff --git a/libraries/base/GHC/List.hs b/libraries/base/GHC/List.hs index ca95379..70bfbe4 100644 --- a/libraries/base/GHC/List.hs +++ b/libraries/base/GHC/List.hs @@ -23,7 +23,7 @@ module GHC.List ( map, (++), filter, concat, head, last, tail, init, uncons, null, length, (!!), foldl, foldl', foldl1, foldl1', scanl, scanl1, scanl', foldr, foldr1, - scanr, scanr1, iterate, iterate', repeat, replicate, cycle, + scanr, scanr1, iterate, repeat, replicate, cycle, take, drop, sum, product, maximum, minimum, splitAt, takeWhile, dropWhile, span, break, reverse, and, or, any, all, elem, notElem, lookup, @@ -458,29 +458,6 @@ iterateFB c f x0 = go x0 #-} --- | 'iterate\'' is the strict version of 'iterate'. --- --- It ensures that the result of each application of force to weak head normal --- form before proceeding. -{-# NOINLINE [1] iterate' #-} -iterate' :: (a -> a) -> a -> [a] -iterate' f x = - let x' = f x - in x' `seq` (x : iterate' f x') - -{-# INLINE [0] iterate'FB #-} -- See Note [Inline FB functions] -iterate'FB :: (a -> b -> b) -> (a -> a) -> a -> b -iterate'FB c f x0 = go x0 - where go x = - let x' = f x - in x' `seq` (x `c` go x') - -{-# RULES -"iterate'" [~1] forall f x. iterate' f x = build (\c _n -> iterate'FB c f x) -"iterate'FB" [1] iterate'FB (:) = iterate' - #-} - - -- | 'repeat' @x@ is an infinite list, with @x@ the value of every element. repeat :: a -> [a] {-# INLINE [0] repeat #-} diff --git a/libraries/base/changelog.md b/libraries/base/changelog.md index a62b8339..ab304a3 100644 --- a/libraries/base/changelog.md +++ b/libraries/base/changelog.md @@ -16,9 +16,6 @@ * Add instances `Semigroup` and `Monoid` for `Control.Monad.ST` (#14107). - * Add `iterate'`, a strict version of `iterate`, to `Data.List` - and `Data.OldList` (#3474) - ## 4.10.0.0 *April 2017* * Bundled with GHC *TBA* From git at git.haskell.org Sat Aug 19 13:34:56 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 19 Aug 2017 13:34:56 +0000 (UTC) Subject: [commit: ghc] branch 'wip/travis2' created Message-ID: <20170819133456.91F173A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/travis2 Referencing: c7fbfaeabf6bac487e174097d7f424cd1a89f38c From git at git.haskell.org Sat Aug 19 13:34:59 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 19 Aug 2017 13:34:59 +0000 (UTC) Subject: [commit: ghc] wip/travis2: Travis: Boot with ghc-8.2.1 (c7fbfae) Message-ID: <20170819133459.539913A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/travis2 Link : http://ghc.haskell.org/trac/ghc/changeset/c7fbfaeabf6bac487e174097d7f424cd1a89f38c/ghc >--------------------------------------------------------------- commit c7fbfaeabf6bac487e174097d7f424cd1a89f38c Author: Joachim Breitner Date: Sat Aug 19 15:33:52 2017 +0200 Travis: Boot with ghc-8.2.1 >--------------------------------------------------------------- c7fbfaeabf6bac487e174097d7f424cd1a89f38c .travis.yml | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/.travis.yml b/.travis.yml index 218f5ba..383ee30 100644 --- a/.travis.yml +++ b/.travis.yml @@ -17,15 +17,15 @@ addons: #- llvm-toolchain-precise-3.7 - ubuntu-toolchain-r-test packages: - - cabal-install-1.18 - - ghc-7.10.3 - - alex-3.1.3 - - happy-1.19.4 + - cabal-install-2.0 + - ghc-8.2.1 + - alex-3.1.7 + - happy-1.19.5 - python3 #- llvm-3.7 before_install: - - export PATH=/opt/ghc/7.10.3/bin:/opt/cabal/1.18/bin:/opt/alex/3.1.3/bin:/opt/happy/1.19.4/bin:/usr/lib/llvm-3.7/bin:$PATH + - export PATH=/opt/ghc/8.2.1/bin:/opt/cabal/1.24/bin:/opt/alex/3.1.7/bin:/opt/happy/1.19.5/bin:/usr/lib/llvm-3.7/bin:$PATH # Be explicit about which protocol to use, such that we don't have to repeat the rewrite command for each. - git config remote.origin.url git://github.com/${TRAVIS_REPO_SLUG}.git From git at git.haskell.org Mon Aug 21 03:46:50 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 21 Aug 2017 03:46:50 +0000 (UTC) Subject: [commit: ghc] wip/rae: Update Travis to bootstrap with 8.0.2 (2b8901b) Message-ID: <20170821034650.C1FA53A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/2b8901b180fce2ec371fdd16a350626391997a39/ghc >--------------------------------------------------------------- commit 2b8901b180fce2ec371fdd16a350626391997a39 Author: Richard Eisenberg Date: Fri Aug 18 15:47:22 2017 -0400 Update Travis to bootstrap with 8.0.2 >--------------------------------------------------------------- 2b8901b180fce2ec371fdd16a350626391997a39 .travis.yml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/.travis.yml b/.travis.yml index 218f5ba..7660bcc 100644 --- a/.travis.yml +++ b/.travis.yml @@ -17,15 +17,15 @@ addons: #- llvm-toolchain-precise-3.7 - ubuntu-toolchain-r-test packages: - - cabal-install-1.18 - - ghc-7.10.3 + - cabal-install-1.24 + - ghc-8.0.2 - alex-3.1.3 - happy-1.19.4 - python3 #- llvm-3.7 before_install: - - export PATH=/opt/ghc/7.10.3/bin:/opt/cabal/1.18/bin:/opt/alex/3.1.3/bin:/opt/happy/1.19.4/bin:/usr/lib/llvm-3.7/bin:$PATH + - export PATH=/opt/ghc/8.0.2/bin:/opt/cabal/1.24/bin:/opt/alex/3.1.3/bin:/opt/happy/1.19.4/bin:/usr/lib/llvm-3.7/bin:$PATH # Be explicit about which protocol to use, such that we don't have to repeat the rewrite command for each. - git config remote.origin.url git://github.com/${TRAVIS_REPO_SLUG}.git From git at git.haskell.org Mon Aug 21 16:24:13 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 21 Aug 2017 16:24:13 +0000 (UTC) Subject: [commit: ghc] master: Fix loading of dlls on 32bit windows (34bd43d) Message-ID: <20170821162413.6B5313A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/34bd43d9c24207a1897aaa4ee6cb70592a3f7acc/ghc >--------------------------------------------------------------- commit 34bd43d9c24207a1897aaa4ee6cb70592a3f7acc Author: Sergey Vinokurov Date: Mon Aug 21 00:40:08 2017 +0300 Fix loading of dlls on 32bit windows The point of fix is to handle case when loaded dll loads no other dlls, i.e. it's import table is empty. GHC Trac Issues: #14081 >--------------------------------------------------------------- 34bd43d9c24207a1897aaa4ee6cb70592a3f7acc rts/linker/PEi386.c | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/rts/linker/PEi386.c b/rts/linker/PEi386.c index 42e7008..011b0a8 100644 --- a/rts/linker/PEi386.c +++ b/rts/linker/PEi386.c @@ -240,6 +240,13 @@ static void addDLLHandle(pathchar* dll_name, HINSTANCE instance) { (PIMAGE_IMPORT_DESCRIPTOR)((BYTE *)instance + header-> OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_IMPORT].VirtualAddress); + bool importTableMissing = + header->OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_IMPORT].Size == 0; + + if (importTableMissing) { + return; + } + /* Ignore these compatibility shims. */ const pathchar* ms_dll = WSTR("api-ms-win-"); const int len = wcslen(ms_dll); From git at git.haskell.org Mon Aug 21 20:33:39 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 21 Aug 2017 20:33:39 +0000 (UTC) Subject: [commit: ghc] ghc-8.2: Fix a bug in -foptimal-applicative-do (94427b1) Message-ID: <20170821203339.CCC1B3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.2 Link : http://ghc.haskell.org/trac/ghc/changeset/94427b13de0214ad4d944bda575c33dc8aefdd1d/ghc >--------------------------------------------------------------- commit 94427b13de0214ad4d944bda575c33dc8aefdd1d Author: Simon Marlow Date: Mon Jun 12 17:00:39 2017 -0400 Fix a bug in -foptimal-applicative-do Test Plan: validate Reviewers: bgamari, niteria, austin, erikd Reviewed By: bgamari Subscribers: rwbarton, thomie Differential Revision: https://phabricator.haskell.org/D3640 (cherry picked from commit 7e0ef11324712b4ff3ac8f39259e5ecbd63c2356) >--------------------------------------------------------------- 94427b13de0214ad4d944bda575c33dc8aefdd1d compiler/rename/RnExpr.hs | 2 +- testsuite/tests/ado/ado-optimal.hs | 11 +++++++++++ testsuite/tests/ado/ado-optimal.stdout | 1 + 3 files changed, 13 insertions(+), 1 deletion(-) diff --git a/compiler/rename/RnExpr.hs b/compiler/rename/RnExpr.hs index 001bc46..ec3ad0b 100644 --- a/compiler/rename/RnExpr.hs +++ b/compiler/rename/RnExpr.hs @@ -1592,7 +1592,7 @@ mkStmtTreeOptimal stmts = (StmtTreeOne (stmt_arr ! hi), 1)) | left_cost < right_cost = ((left,left_cost), (StmtTreeOne (stmt_arr ! hi), 1)) - | otherwise -- left_cost > right_cost + | left_cost > right_cost = ((StmtTreeOne (stmt_arr ! lo), 1), (right,right_cost)) | otherwise = minimumBy (comparing cost) alternatives where diff --git a/testsuite/tests/ado/ado-optimal.hs b/testsuite/tests/ado/ado-optimal.hs index aab8d53..d67aa4f 100644 --- a/testsuite/tests/ado/ado-optimal.hs +++ b/testsuite/tests/ado/ado-optimal.hs @@ -18,8 +18,19 @@ test1 = do x5 <- const e (x1,x4) return (const () x5) +-- (a | c); (b | d); e +test2 :: M () +test2 = do + x1 <- a + x3 <- c + x2 <- const b x1 + x4 <- const d x3 + x5 <- const e (x1,x4) + return (const () x5) + main = mapM_ run [ test1 + , test2 ] -- Testing code, prints out the structure of a monad/applicative expression diff --git a/testsuite/tests/ado/ado-optimal.stdout b/testsuite/tests/ado/ado-optimal.stdout index 29f9856..1df5e57 100644 --- a/testsuite/tests/ado/ado-optimal.stdout +++ b/testsuite/tests/ado/ado-optimal.stdout @@ -1 +1,2 @@ ((a; b) | (c; d)); e +(a | c); ((b | d); e) From git at git.haskell.org Mon Aug 21 20:33:42 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 21 Aug 2017 20:33:42 +0000 (UTC) Subject: [commit: ghc] ghc-8.2: Fix #11400, #11560 by documenting an infelicity. (c722ff3) Message-ID: <20170821203342.8DB103A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.2 Link : http://ghc.haskell.org/trac/ghc/changeset/c722ff338b5356c8e13bc3344140a9eb296afbc3/ghc >--------------------------------------------------------------- commit c722ff338b5356c8e13bc3344140a9eb296afbc3 Author: Richard Eisenberg Date: Thu Jun 1 18:09:05 2017 -0400 Fix #11400, #11560 by documenting an infelicity. Really, the fix for both of these is #11307. (cherry picked from commit c9667d321c94ff0f67b73aa7bd560c38873f7df5) >--------------------------------------------------------------- c722ff338b5356c8e13bc3344140a9eb296afbc3 docs/users_guide/glasgow_exts.rst | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/docs/users_guide/glasgow_exts.rst b/docs/users_guide/glasgow_exts.rst index 3f039a2..9289637 100644 --- a/docs/users_guide/glasgow_exts.rst +++ b/docs/users_guide/glasgow_exts.rst @@ -8211,9 +8211,9 @@ enabled). The only way ``*`` is unordinary is in its parsing. In order to be backward compatible, ``*`` is parsed as if it were an alphanumeric idenfifier; note that we do not write ``Int :: (*)`` but just plain ``Int :: *``. Due to the -bizarreness with which ``*`` is parsed-and the fact that it is the only such -operator in GHC-there are some corner cases that are -not handled. We are aware of two: +bizarreness with which ``*`` is parsed--and the fact that it is the only such +operator in GHC--there are some corner cases that are +not handled. We are aware of three: - In a Haskell-98-style data constructor, you must put parentheses around ``*``, like this: :: @@ -8227,6 +8227,10 @@ not handled. We are aware of two: Note that the keyword ``type`` there is just to disambiguate the import from a term-level ``(*)``. (:ref:`explicit-namespaces`) +- In an instance declaration head (the part after the word ``instance``), you + must parenthesize ``*``. This applies to all manners of instances, including + the left-hand sides of individual equations of a closed type family. + The ``Data.Kind`` module also exports ``Type`` as a synonym for ``*``. Now that type synonyms work in kinds, it is conceivable that we will deprecate ``*`` when there is a good migration story for everyone to use ``Type``. From git at git.haskell.org Mon Aug 21 20:33:45 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 21 Aug 2017 20:33:45 +0000 (UTC) Subject: [commit: ghc] ghc-8.2: testsuite: Fix test output of determ021 (29ff609) Message-ID: <20170821203345.49FEB3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.2 Link : http://ghc.haskell.org/trac/ghc/changeset/29ff60957d1e4e1b21c492d1aaa3e0d278788c20/ghc >--------------------------------------------------------------- commit 29ff60957d1e4e1b21c492d1aaa3e0d278788c20 Author: Ben Gamari Date: Mon Aug 21 16:32:56 2017 -0400 testsuite: Fix test output of determ021 >--------------------------------------------------------------- 29ff60957d1e4e1b21c492d1aaa3e0d278788c20 testsuite/tests/determinism/determ021/determ021.stdout | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/testsuite/tests/determinism/determ021/determ021.stdout b/testsuite/tests/determinism/determ021/determ021.stdout index 8a14ba0..93cd3af 100644 --- a/testsuite/tests/determinism/determ021/determ021.stdout +++ b/testsuite/tests/determinism/determ021/determ021.stdout @@ -8,7 +8,7 @@ TYPE CONSTRUCTORS COERCION AXIOMS Dependent modules: [] Dependent packages: [base-4.10.0.0, ghc-prim-0.5.1.0, - integer-gmp-1.0.0.1] + integer-gmp-1.0.1.0] [1 of 1] Compiling A ( A.hs, A.o ) TYPE SIGNATURES test2 :: @@ -19,4 +19,4 @@ TYPE CONSTRUCTORS COERCION AXIOMS Dependent modules: [] Dependent packages: [base-4.10.0.0, ghc-prim-0.5.1.0, - integer-gmp-1.0.0.1] + integer-gmp-1.0.1.0] From git at git.haskell.org Mon Aug 21 23:56:34 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 21 Aug 2017 23:56:34 +0000 (UTC) Subject: [commit: ghc] wip/rae: Update Travis to bootstrap with 8.0.2 (781309a) Message-ID: <20170821235634.BC84A3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/781309a8db9bae7f8a10edba8ccfa9245f03fc16/ghc >--------------------------------------------------------------- commit 781309a8db9bae7f8a10edba8ccfa9245f03fc16 Author: Richard Eisenberg Date: Fri Aug 18 15:47:22 2017 -0400 Update Travis to bootstrap with 8.0.2 >--------------------------------------------------------------- 781309a8db9bae7f8a10edba8ccfa9245f03fc16 .travis.yml | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/.travis.yml b/.travis.yml index 218f5ba..79c5b66 100644 --- a/.travis.yml +++ b/.travis.yml @@ -17,15 +17,15 @@ addons: #- llvm-toolchain-precise-3.7 - ubuntu-toolchain-r-test packages: - - cabal-install-1.18 - - ghc-7.10.3 - - alex-3.1.3 + - cabal-install-1.24 + - ghc-8.0.2 + - alex-3.1.7 - happy-1.19.4 - python3 #- llvm-3.7 before_install: - - export PATH=/opt/ghc/7.10.3/bin:/opt/cabal/1.18/bin:/opt/alex/3.1.3/bin:/opt/happy/1.19.4/bin:/usr/lib/llvm-3.7/bin:$PATH + - export PATH=/opt/ghc/8.0.2/bin:/opt/cabal/1.24/bin:/opt/alex/3.1.7/bin:/opt/happy/1.19.4/bin:/usr/lib/llvm-3.7/bin:$PATH # Be explicit about which protocol to use, such that we don't have to repeat the rewrite command for each. - git config remote.origin.url git://github.com/${TRAVIS_REPO_SLUG}.git From git at git.haskell.org Tue Aug 22 09:31:46 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 22 Aug 2017 09:31:46 +0000 (UTC) Subject: [commit: nofib] master: Add to notes (fb74d3e) Message-ID: <20170822093146.0D9443A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/nofib On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/fb74d3e42d7bfddd9ba2819d11089837c161b956/nofib >--------------------------------------------------------------- commit fb74d3e42d7bfddd9ba2819d11089837c161b956 Author: Simon Peyton Jones Date: Fri Nov 22 18:02:17 2013 +0000 Add to notes >--------------------------------------------------------------- fb74d3e42d7bfddd9ba2819d11089837c161b956 Simon-nofib-notes | 3 +++ 1 file changed, 3 insertions(+) diff --git a/Simon-nofib-notes b/Simon-nofib-notes index 2fe8aca..1c7db12 100644 --- a/Simon-nofib-notes +++ b/Simon-nofib-notes @@ -126,6 +126,9 @@ Expert In spectral/expert/Search.ask there's a statically visible CSE. Catching this depends almost entirely on chance, which is a pity. +Reptile +~~~~~~~ +Performance dominated by (++) and Show.itos' Fish ~~~~ From git at git.haskell.org Tue Aug 22 09:31:50 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 22 Aug 2017 09:31:50 +0000 (UTC) Subject: [commit: nofib] master: Note on cacheprof (74a15a4) Message-ID: <20170822093150.1C6893A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/nofib On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/74a15a458c66adeb582eb0944833ebdb45e8e9a2/nofib >--------------------------------------------------------------- commit 74a15a458c66adeb582eb0944833ebdb45e8e9a2 Author: Simon Peyton Jones Date: Tue Aug 22 10:31:31 2017 +0100 Note on cacheprof >--------------------------------------------------------------- 74a15a458c66adeb582eb0944833ebdb45e8e9a2 Simon-nofib-notes | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/Simon-nofib-notes b/Simon-nofib-notes index d00a749..c47a42c 100644 --- a/Simon-nofib-notes +++ b/Simon-nofib-notes @@ -416,6 +416,11 @@ Same issue with GHC.IO.Encoding.UTF8 as treejoin Real suite --------------------------------------- +cacheprof +~~~~~~~~~ +Sucessive runs with the same data can yield different allocation +totals, for some reason. + gg ~~ Same issue with GHC.IO.Encoding.UTF8 as treejoin From git at git.haskell.org Tue Aug 22 09:31:48 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 22 Aug 2017 09:31:48 +0000 (UTC) Subject: [commit: nofib] master: More additions to Simon-nofib-notes (4e20c56) Message-ID: <20170822093148.134E93A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/nofib On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4e20c56ea50a6a9e0129baee2ba54f3e7f7f50ea/nofib >--------------------------------------------------------------- commit 4e20c56ea50a6a9e0129baee2ba54f3e7f7f50ea Author: Simon Peyton Jones Date: Mon Jul 21 16:49:33 2014 +0100 More additions to Simon-nofib-notes >--------------------------------------------------------------- 4e20c56ea50a6a9e0129baee2ba54f3e7f7f50ea Simon-nofib-notes | 80 +++++++++++++++++++++++++++++++++++++++++-------------- 1 file changed, 60 insertions(+), 20 deletions(-) diff --git a/Simon-nofib-notes b/Simon-nofib-notes index 1c7db12..d00a749 100644 --- a/Simon-nofib-notes +++ b/Simon-nofib-notes @@ -54,6 +54,14 @@ I found that there were some very bad loss-of-arity cases in PrelShow. Net result: imaginary/gen_regexps more than halves in allocation! +queens +~~~~~~ +If we do + a) some inlining before float-out + b) fold/build fusion before float-out +then queens get 40% more allocation. Presumably the fusion +prevents sharing. + x2n1 ~~~~ @@ -114,23 +122,36 @@ like this: Notice the 'let' which stops the lambda moving out. -Eliza +eliza ~~~~~ In June 2002, GHC 5.04 emitted four successive NOTE: Simplifier still going after 4 iterations; bailing out. messages. I suspect that the simplifer is looping somehow. +fibheaps +~~~~~~~~ +If you don't inline getChildren, allocation rises by 25% + +hartel/event +~~~~~~~~~~~~ +There's a functions called f_nand and f_d, which generates tons of +code if you inline them too vigorously. And this can happen because +of a massive result discount. + +Moreover if f_d gets inlined too much, you get lots of local lvl_xx +things which make some closures have lots of free variables, which pushes +up allocation. -Expert +expert ~~~~~~ In spectral/expert/Search.ask there's a statically visible CSE. Catching this depends almost entirely on chance, which is a pity. -Reptile +reptile ~~~~~~~ Performance dominated by (++) and Show.itos' -Fish +fish ~~~~ The performance of fish depends crucially on inlining scale_vec2. It turns out to be right on the edge of GHC's normal threshold size, so @@ -206,19 +227,38 @@ We would do better to inpline showsPrec9 but it looks too big. Before it was inlined regardless by the instance-decl stuff. So perf drops slightly. -Integer +integer ~~~~~~~ -A good benchmark for beating on big-integer arithmetic - -Knights +A good benchmark for beating on big-integer arithmetic. +In this function: + + integerbench :: (Integer -> Integer -> a) + -> Integer -> Integer -> Integer + -> Integer -> Integer -> Integer + -> IO () + integerbench op astart astep alim bstart bstep blim = do + seqlist ([ a `op` b + | a <- [ astart,astart+astep..alim ] + , b <- [ bstart,astart+bstep..blim ]]) + return () + +if you do a bit of inlining and rule firing before floating, we'll fuse +the comprehension with the [bstart, astart+bstep..blim], whereas if you +float first you'll share the [bstart...] list. The latter does 11% less +allocation, but more case analysis etc. + +knights ~~~~~~~ -In knights/KnightHeuristic, we don't find that possibleMoves is strict -(with important knock-on effects) unless we apply rules before floating -out the literal list [A,B,C...]. -Similarly, in f_se (F_Cmp ...) in listcompr (but a smaller effect) +* In knights/KnightHeuristic, we don't find that possibleMoves is strict + (with important knock-on effects) unless we apply rules before floating + out the literal list [A,B,C...]. + +* Similarly, in f_se (F_Cmp ...) in listcompr (but a smaller effect) +* If we don't inline $wmove, we get an allocation increase of 17% -Lambda + +lambda ~~~~~~ This program shows the cost of the non-eta-expanded lambdas that arise from a state monad. @@ -228,7 +268,7 @@ mandel2 check_perim's several calls to point_colour lead to opportunities for CSE which may be more or less well taken. -Mandel +mandel ~~~~~~ Relies heavily on having a specialised version of Complex.magnitude (:: Complex Double -> Double) available. @@ -239,7 +279,7 @@ this is because the pre-let-floating simplification did too little inlining; in particular, it did not inline windowToViewport -Multiplier +multiplier ~~~~~~~~~~ In spectral/multiplier, we have xor = lift21 forceBit f @@ -253,21 +293,21 @@ In spectral/multiplier, we have So allocation goes up. I don't see a way around this. -Parstof -~~~~~~~ +hartel/partsof +~~~~~~~~~~~~~~ spectral/hartel/parstof ends up saying case (unpackCString "x") of { c:cs -> ... } quite a bit. We should spot these and behave accordingly. -Power +power ~~~~~ With GHC 4.08, for some reason the arithmetic defaults to Double. The right thing is to default to Rational, which accounts for the big increase in runtime after 4.08 -Puzzle +puzzle ~~~~~~ The main function is 'transfer'. It has some complicated join points, and a big issue is the full laziness can float out many small MFEs that then @@ -296,7 +336,7 @@ Extra allocation is happening in 5.02 as well; perhaps for the same reasons. Th at least one instance of floating that prevents fusion; namely the enumerated lists in 'transfer'. -Sphere +sphere ~~~~~~ A key function is vecsub, which looks like this (after w/w) From git at git.haskell.org Tue Aug 22 14:56:25 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 22 Aug 2017 14:56:25 +0000 (UTC) Subject: [commit: ghc] master: Fix #14125 by normalizing data family instances more aggressively (6982ee9) Message-ID: <20170822145625.285173A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6982ee99fb97c252c3faf37faae34131fb66f67c/ghc >--------------------------------------------------------------- commit 6982ee99fb97c252c3faf37faae34131fb66f67c Author: Ryan Scott Date: Tue Aug 22 09:28:43 2017 -0400 Fix #14125 by normalizing data family instances more aggressively Summary: Commit 3540d1e1a23926ce0a8a6ae83a36f5f6b2497ccf inadvertently broke the ability for newtype instances to be used as marshallable types in FFI declarations. The reason is a bit silly: an extra check was added for type synonyms with no type families on the RHS in `normalise_tc_app`, but this check would only skip over type families, not //data// families, since the predicate being used was `not . isTypeFamilyCon`. The fix is simple: just use `not . isFamilyCon` instead so that data families are also skipped by this check. Test Plan: make test TEST=T14125 Reviewers: goldfire, simonpj, austin, bgamari Reviewed By: simonpj Subscribers: rwbarton, thomie GHC Trac Issues: #14125 Differential Revision: https://phabricator.haskell.org/D3865 >--------------------------------------------------------------- 6982ee99fb97c252c3faf37faae34131fb66f67c compiler/types/FamInstEnv.hs | 14 +++++++------- testsuite/tests/ffi/should_compile/T14125.hs | 17 +++++++++++++++++ testsuite/tests/ffi/should_compile/all.T | 1 + testsuite/tests/ghci/should_run/T14125a.script | 8 ++++++++ testsuite/tests/ghci/should_run/T14125a.stdout | 5 +++++ testsuite/tests/ghci/should_run/all.T | 1 + 6 files changed, 39 insertions(+), 7 deletions(-) diff --git a/compiler/types/FamInstEnv.hs b/compiler/types/FamInstEnv.hs index cec7b58..dbf090f 100644 --- a/compiler/types/FamInstEnv.hs +++ b/compiler/types/FamInstEnv.hs @@ -1288,13 +1288,7 @@ normalise_tc_app tc tys -- See Note [Normalisation and type synonyms] normalise_type (mkAppTys (substTy (mkTvSubstPrs tenv) rhs) tys') - | not (isTypeFamilyTyCon tc) - = -- A synonym with no type families in the RHS; or data type etc - -- Just normalise the arguments and rebuild - do { (args_co, ntys) <- normalise_tc_args tc tys - ; return (args_co, mkTyConApp tc ntys) } - - | otherwise + | isFamilyTyCon tc = -- A type-family application do { env <- getEnv ; role <- getRole @@ -1308,6 +1302,12 @@ normalise_tc_app tc tys -- we do not do anything return (args_co, mkTyConApp tc ntys) } + | otherwise + = -- A synonym with no type families in the RHS; or data type etc + -- Just normalise the arguments and rebuild + do { (args_co, ntys) <- normalise_tc_args tc tys + ; return (args_co, mkTyConApp tc ntys) } + --------------- -- | Normalise arguments to a tycon normaliseTcArgs :: FamInstEnvs -- ^ env't with family instances diff --git a/testsuite/tests/ffi/should_compile/T14125.hs b/testsuite/tests/ffi/should_compile/T14125.hs new file mode 100644 index 0000000..daf236d --- /dev/null +++ b/testsuite/tests/ffi/should_compile/T14125.hs @@ -0,0 +1,17 @@ +{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE TypeFamilies #-} +module T14125 where + +import Foreign.C.String +import Foreign.C.Types + +data UnixReturn + +data family IOErrno a +newtype instance IOErrno UnixReturn = UnixErrno CInt + +foreign import ccall unsafe "string.h" + strerror :: IOErrno UnixReturn -> IO CString + +foreign import ccall unsafe "HsBase.h __hscore_get_errno" + get_errno :: IO (IOErrno UnixReturn) diff --git a/testsuite/tests/ffi/should_compile/all.T b/testsuite/tests/ffi/should_compile/all.T index 18192d4..0f2f390 100644 --- a/testsuite/tests/ffi/should_compile/all.T +++ b/testsuite/tests/ffi/should_compile/all.T @@ -31,3 +31,4 @@ test('cc015', normal, compile, ['']) test('cc016', normal, compile, ['']) test('T10460', normal, compile, ['']) test('T11983', [omit_ways(['ghci'])], compile, ['T11983.c']) +test('T14125', normal, compile, ['']) diff --git a/testsuite/tests/ghci/should_run/T14125a.script b/testsuite/tests/ghci/should_run/T14125a.script new file mode 100644 index 0000000..1667349 --- /dev/null +++ b/testsuite/tests/ghci/should_run/T14125a.script @@ -0,0 +1,8 @@ +:set -XTypeFamilies +data family Foo a +data instance Foo Int = FooInt Int +:kind! Foo Int +let f (FooInt i) = i +:info f +:type +v f +:type f diff --git a/testsuite/tests/ghci/should_run/T14125a.stdout b/testsuite/tests/ghci/should_run/T14125a.stdout new file mode 100644 index 0000000..7b4e85e --- /dev/null +++ b/testsuite/tests/ghci/should_run/T14125a.stdout @@ -0,0 +1,5 @@ +Foo Int :: * += Foo Int +f :: Foo Int -> Int -- Defined at :5:5 +f :: Foo Int -> Int +f :: Foo Int -> Int diff --git a/testsuite/tests/ghci/should_run/all.T b/testsuite/tests/ghci/should_run/all.T index fe33685..da20149 100644 --- a/testsuite/tests/ghci/should_run/all.T +++ b/testsuite/tests/ghci/should_run/all.T @@ -28,3 +28,4 @@ test('T12128', just_ghci, ghci_script, ['T12128.script']) test('T12456', just_ghci, ghci_script, ['T12456.script']) test('T12549', just_ghci, ghci_script, ['T12549.script']) test('BinaryArray', normal, compile_and_run, ['']) +test('T14125a', just_ghci, ghci_script, ['T14125a.script']) From git at git.haskell.org Tue Aug 22 14:56:28 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 22 Aug 2017 14:56:28 +0000 (UTC) Subject: [commit: ghc] master: Fix #14114 by checking for duplicate vars on pattern synonym RHSes (a89bb80) Message-ID: <20170822145628.C80203A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a89bb806c58d3e601b37d6f2c4ebec6514fd2776/ghc >--------------------------------------------------------------- commit a89bb806c58d3e601b37d6f2c4ebec6514fd2776 Author: Ryan Scott Date: Tue Aug 22 09:28:49 2017 -0400 Fix #14114 by checking for duplicate vars on pattern synonym RHSes Summary: Because we weren't checking for duplicate variables on the right-hand sides of pattern synonyms, bogus definitions like this one passed the renamer: ```lang=haskell pattern Foo a <- (a,a) ``` Luckily, the fix is simple. Test Plan: make test TEST=T14114 Reviewers: mpickering, austin, bgamari, simonpj Reviewed By: simonpj Subscribers: simonpj, rwbarton, thomie GHC Trac Issues: #14114 Differential Revision: https://phabricator.haskell.org/D3866 >--------------------------------------------------------------- a89bb806c58d3e601b37d6f2c4ebec6514fd2776 compiler/rename/RnPat.hs | 15 ++++++++------- testsuite/tests/patsyn/should_fail/T14114.hs | 7 +++++++ testsuite/tests/patsyn/should_fail/T14114.stderr | 18 ++++++++++++++++++ testsuite/tests/patsyn/should_fail/all.T | 1 + 4 files changed, 34 insertions(+), 7 deletions(-) diff --git a/compiler/rename/RnPat.hs b/compiler/rename/RnPat.hs index 320e4f3..9b439a7 100644 --- a/compiler/rename/RnPat.hs +++ b/compiler/rename/RnPat.hs @@ -47,8 +47,8 @@ import RnEnv import RnFixity import RnUtils ( HsDocContext(..), newLocalBndrRn, bindLocalNames , warnUnusedMatches, newLocalBndrRn - , checkDupAndShadowedNames, checkTupSize - , unknownSubordinateErr ) + , checkDupNames, checkDupAndShadowedNames + , checkTupSize , unknownSubordinateErr ) import RnTypes import PrelNames import TyCon ( tyConName ) @@ -67,7 +67,7 @@ import TysWiredIn ( nilDataCon ) import DataCon import qualified GHC.LanguageExtensions as LangExt -import Control.Monad ( when, liftM, ap, unless ) +import Control.Monad ( when, liftM, ap ) import qualified Data.List.NonEmpty as NE import Data.Ratio @@ -321,10 +321,11 @@ rnPats ctxt pats thing_inside -- complain *twice* about duplicates e.g. f (x,x) = ... -- -- See note [Don't report shadowing for pattern synonyms] - ; unless (isPatSynCtxt ctxt) - (addErrCtxt doc_pat $ - checkDupAndShadowedNames envs_before $ - collectPatsBinders pats') + ; let bndrs = collectPatsBinders pats' + ; addErrCtxt doc_pat $ + if isPatSynCtxt ctxt + then checkDupNames bndrs + else checkDupAndShadowedNames envs_before bndrs ; thing_inside pats' } } where doc_pat = text "In" <+> pprMatchContext ctxt diff --git a/testsuite/tests/patsyn/should_fail/T14114.hs b/testsuite/tests/patsyn/should_fail/T14114.hs new file mode 100644 index 0000000..b1fb8e6 --- /dev/null +++ b/testsuite/tests/patsyn/should_fail/T14114.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE PatternSynonyms #-} +module T14114 where + +pattern Foo1 a <- (a,a) +pattern Foo2 a = (a,a) +pattern Foo3 a <- (a,a) where + Foo3 a = (a,a) diff --git a/testsuite/tests/patsyn/should_fail/T14114.stderr b/testsuite/tests/patsyn/should_fail/T14114.stderr new file mode 100644 index 0000000..a93b51e --- /dev/null +++ b/testsuite/tests/patsyn/should_fail/T14114.stderr @@ -0,0 +1,18 @@ + +T14114.hs:4:20: error: + • Conflicting definitions for ‘a’ + Bound at: T14114.hs:4:20 + T14114.hs:4:22 + • In a pattern synonym declaration + +T14114.hs:5:20: error: + • Conflicting definitions for ‘a’ + Bound at: T14114.hs:5:20 + T14114.hs:5:22 + • In a pattern synonym declaration + +T14114.hs:6:20: error: + • Conflicting definitions for ‘a’ + Bound at: T14114.hs:6:20 + T14114.hs:6:22 + • In a pattern synonym declaration diff --git a/testsuite/tests/patsyn/should_fail/all.T b/testsuite/tests/patsyn/should_fail/all.T index 86ec79a..92989cf 100644 --- a/testsuite/tests/patsyn/should_fail/all.T +++ b/testsuite/tests/patsyn/should_fail/all.T @@ -36,3 +36,4 @@ test('T12819', normal, compile_fail, ['']) test('UnliftedPSBind', normal, compile_fail, ['']) test('T13349', normal, compile_fail, ['']) test('T13470', normal, compile_fail, ['']) +test('T14114', normal, compile_fail, ['']) From git at git.haskell.org Tue Aug 22 14:56:32 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 22 Aug 2017 14:56:32 +0000 (UTC) Subject: [commit: ghc] master: Fix #13885 by freshening reified GADT constructors' universal tyvars (79b259a) Message-ID: <20170822145632.093AB3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/79b259ae6a0a0c17568d7d03d82e378ad4c4001a/ghc >--------------------------------------------------------------- commit 79b259ae6a0a0c17568d7d03d82e378ad4c4001a Author: Ryan Scott Date: Tue Aug 22 09:28:56 2017 -0400 Fix #13885 by freshening reified GADT constructors' universal tyvars Summary: When reifying GADTs with Template Haskell, the universally quantified type variables were being reused across both the data type head and the constructors' type signatures. This had the annoying effect of causing sets of differently scoped variables to have the same uniques. To avoid this, we now freshen the universal tyvars before reifying the constructors so as to ensure they have distinct uniques. Test Plan: make test TEST=T13885 Reviewers: goldfire, austin, bgamari, simonpj Reviewed By: simonpj Subscribers: rwbarton, thomie GHC Trac Issues: #13885 Differential Revision: https://phabricator.haskell.org/D3867 >--------------------------------------------------------------- 79b259ae6a0a0c17568d7d03d82e378ad4c4001a compiler/typecheck/TcSplice.hs | 77 ++++++++++++++++------ testsuite/tests/th/T13885.hs | 23 +++++++ .../tests/th/T13885.stdout | 0 testsuite/tests/th/all.T | 1 + 4 files changed, 82 insertions(+), 19 deletions(-) diff --git a/compiler/typecheck/TcSplice.hs b/compiler/typecheck/TcSplice.hs index 8b5ed7d..029ae28 100644 --- a/compiler/typecheck/TcSplice.hs +++ b/compiler/typecheck/TcSplice.hs @@ -1449,7 +1449,7 @@ reifyDataCon isGadtDataCon tys dc (ex_tvs, theta, arg_tys) = dataConInstSig dc tys -- used for GADTs data constructors - (g_univ_tvs, g_ex_tvs, g_eq_spec, g_theta, g_arg_tys, g_res_ty) + (g_univ_tvs, g_ex_tvs, g_eq_spec, g_theta', g_arg_tys', g_res_ty') = dataConFullSig dc (srcUnpks, srcStricts) = mapAndUnzip reifySourceBang (dataConSrcBangs dc) @@ -1459,7 +1459,14 @@ reifyDataCon isGadtDataCon tys dc -- Universal tvs present in eq_spec need to be filtered out, as -- they will not appear anywhere in the type. eq_spec_tvs = mkVarSet (map eqSpecTyVar g_eq_spec) - g_unsbst_univ_tvs = filterOut (`elemVarSet` eq_spec_tvs) g_univ_tvs + + ; (univ_subst, g_unsbst_univ_tvs) + -- See Note [Freshen reified GADT constructors' universal tyvars] + <- freshenTyVarBndrs $ + filterOut (`elemVarSet` eq_spec_tvs) g_univ_tvs + ; let g_theta = substTys univ_subst g_theta' + g_arg_tys = substTys univ_subst g_arg_tys' + g_res_ty = substTy univ_subst g_res_ty' ; r_arg_tys <- reifyTypes (if isGadtDataCon then g_arg_tys else arg_tys) @@ -1497,23 +1504,55 @@ reifyDataCon isGadtDataCon tys dc ; ASSERT( arg_tys `equalLength` dcdBangs ) ret_con } --- Note [Reifying GADT data constructors] --- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --- At this point in the compilation pipeline we have no way of telling whether a --- data type was declared as a H98 data type or as a GADT. We have to rely on --- heuristics here. We look at dcEqSpec field of all data constructors in a --- data type declaration. If at least one data constructor has non-empty --- dcEqSpec this means that the data type must have been declared as a GADT. --- Consider these declarations: --- --- data T a where --- MkT :: forall a. (a ~ Int) => T a --- --- data T a where --- MkT :: T Int --- --- First declaration will be reified as a GADT. Second declaration will be --- reified as a normal H98 data type declaration. +{- +Note [Reifying GADT data constructors] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +At this point in the compilation pipeline we have no way of telling whether a +data type was declared as a H98 data type or as a GADT. We have to rely on +heuristics here. We look at dcEqSpec field of all data constructors in a +data type declaration. If at least one data constructor has non-empty +dcEqSpec this means that the data type must have been declared as a GADT. +Consider these declarations: + + data T1 a where + MkT1 :: T1 Int + + data T2 a where + MkT2 :: forall a. (a ~ Int) => T2 a + +T1 will be reified as a GADT, as it has a non-empty EqSpec [(a, Int)] due to +MkT1's return type. T2 will be reified as a normal H98 data type declaration +since MkT2 uses an explicit type equality in its context instead of an implicit +equality in its return type, and therefore has an empty EqSpec. + +Note [Freshen reified GADT constructors' universal tyvars] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Suppose one were to reify this data type: + + data a :~: b = (a ~ b) => Refl + +This will be reified as if it were a GADT definiton, so the reified definition +will be closer to: + + data a :~: b where + Refl :: forall a b. (a ~ b) => a :~: b + +We ought to be careful here about the uniques we give to the occurrences of `a` +and `b` in this definition. That is because in the original DataCon, all uses +of `a` and `b` have the same unique, since `a` and `b` are both universally +quantified type variables--that is, they are used in both the (:~:) tycon as +well as in the constructor type signature. But when we turn the DataCon +definition into the reified one, the `a` and `b` in the constructor type +signature becomes differently scoped than the `a` and `b` in `data a :~: b`. + +While it wouldn't technically be *wrong* per se to re-use the same uniques for +`a` and `b` across these two different scopes, it's somewhat annoying for end +users of Template Haskell, since they wouldn't be able to rely on the +assumption that all TH names have globally distinct uniques (#13885). For this +reason, we freshen the universally quantified tyvars that go into the reified +GADT constructor type signature to give them distinct uniques from their +counterparts in the tycon. +-} ------------------------------ reifyClass :: Class -> TcM TH.Info diff --git a/testsuite/tests/th/T13885.hs b/testsuite/tests/th/T13885.hs new file mode 100644 index 0000000..0e29c88 --- /dev/null +++ b/testsuite/tests/th/T13885.hs @@ -0,0 +1,23 @@ +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +module Main where + +import Data.Function (on) +import Language.Haskell.TH.Syntax + +data a :~: b = a ~ b => Refl + +$(return []) + +main :: IO () +main = print + $(do TyConI (DataD _ _ tycon_tyvars _ + [ForallC con_tyvars _ _] _) <- reify ''(:~:) + + let tvbName :: TyVarBndr -> Name + tvbName (PlainTV n) = n + tvbName (KindedTV n _) = n + + lift $ and $ zipWith ((/=) `on` tvbName) tycon_tyvars con_tyvars) diff --git a/libraries/base/tests/IO/IOError002.stdout b/testsuite/tests/th/T13885.stdout similarity index 100% copy from libraries/base/tests/IO/IOError002.stdout copy to testsuite/tests/th/T13885.stdout diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T index 5d61fa4..1e737ac 100644 --- a/testsuite/tests/th/all.T +++ b/testsuite/tests/th/all.T @@ -391,6 +391,7 @@ test('T13781', normal, compile, ['-v0']) test('T13782', normal, compile, ['']) test('T13837', normal, compile_fail, ['-v0 -dsuppress-uniques']) test('T13856', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) +test('T13885', normal, compile_and_run, ['-v0']) test('T13887', normal, compile_and_run, ['-v0']) test('T13968', normal, compile_fail, ['-v0']) test('T14060', normal, compile_and_run, ['-v0']) From git at git.haskell.org Tue Aug 22 14:56:35 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 22 Aug 2017 14:56:35 +0000 (UTC) Subject: [commit: ghc] master: Revise function arity mismatch errors involving TypeApplications (8476097) Message-ID: <20170822145635.94C933A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8476097609a2044e965157380aeb5d4882a71248/ghc >--------------------------------------------------------------- commit 8476097609a2044e965157380aeb5d4882a71248 Author: Ryan Scott Date: Tue Aug 22 09:29:01 2017 -0400 Revise function arity mismatch errors involving TypeApplications Summary: Currently, whenever you apply a function to too many arguments and some of those arguments happen to be visible type applications, the error message that GHC gives is rather confusing. Consider the message you receive when typechecking `id @Int 1 2`: ``` The function `id` is applied to three arguments, but its type `Int -> Int` has only one ``` This is baffling, since the two lines treat the visible type argument `@Int` differently. The top line ("applied to three arguments") includes `@Int`, whereas the bottom line ("has only one") excludes `@Int` from consideration. There are multiple ways one could fix this, which I explain in an addendum to `Note [Herald for matchExpectedFunTys]`. The approach adopted here is to change the herald of this error message to include visible type arguments, and to avoid counting them in the "applied to n arguments" part of the error. The end result is that the new error message for `id @Int 1 2` is now: ``` The expression `id @Int` is applied to two arguments, but its type `Int -> Int` has only one ``` Test Plan: make test TEST=T13902 Reviewers: goldfire, austin, bgamari Reviewed By: goldfire Subscribers: rwbarton, thomie GHC Trac Issues: #13902 Differential Revision: https://phabricator.haskell.org/D3868 >--------------------------------------------------------------- 8476097609a2044e965157380aeb5d4882a71248 compiler/hsSyn/HsUtils.hs | 5 ++++- compiler/typecheck/TcExpr.hs | 23 ++++++++++++++++------ compiler/typecheck/TcUnify.hs | 17 ++++++++++++++++ testsuite/tests/typecheck/should_fail/T13902.hs | 8 ++++++++ .../tests/typecheck/should_fail/T13902.stderr | 8 ++++++++ testsuite/tests/typecheck/should_fail/all.T | 1 + 6 files changed, 55 insertions(+), 7 deletions(-) diff --git a/compiler/hsSyn/HsUtils.hs b/compiler/hsSyn/HsUtils.hs index 97ab76f..374fbe9 100644 --- a/compiler/hsSyn/HsUtils.hs +++ b/compiler/hsSyn/HsUtils.hs @@ -20,7 +20,7 @@ which deal with the instantiated versions are located elsewhere: module HsUtils( -- Terms - mkHsPar, mkHsApp, mkHsAppType, mkHsAppTypeOut, mkHsCaseAlt, + mkHsPar, mkHsApp, mkHsAppType, mkHsAppTypes, mkHsAppTypeOut, mkHsCaseAlt, mkSimpleMatch, unguardedGRHSs, unguardedRHS, mkMatchGroup, mkMatch, mkPrefixFunRhs, mkHsLam, mkHsIf, mkHsWrap, mkLHsWrap, mkHsWrapCo, mkHsWrapCoR, mkLHsWrapCo, @@ -178,6 +178,9 @@ mkHsApp e1 e2 = addCLoc e1 e2 (HsApp e1 e2) mkHsAppType :: LHsExpr name -> LHsWcType name -> LHsExpr name mkHsAppType e t = addCLoc e (hswc_body t) (HsAppType e t) +mkHsAppTypes :: LHsExpr name -> [LHsWcType name] -> LHsExpr name +mkHsAppTypes = foldl mkHsAppType + mkHsAppTypeOut :: LHsExpr GhcTc -> LHsWcType GhcRn -> LHsExpr GhcTc mkHsAppTypeOut e t = addCLoc e (hswc_body t) (HsAppTypeOut e t) diff --git a/compiler/typecheck/TcExpr.hs b/compiler/typecheck/TcExpr.hs index 195ba01..801e58a 100644 --- a/compiler/typecheck/TcExpr.hs +++ b/compiler/typecheck/TcExpr.hs @@ -1188,7 +1188,7 @@ tcApp m_herald orig_fun orig_args res_ty ; (wrap_fun, args1, actual_res_ty) <- tcArgs fun fun_sigma orig args - (m_herald `orElse` mk_app_msg fun) + (m_herald `orElse` mk_app_msg fun args) -- this is just like tcWrapResult, but the types don't line -- up to call that function @@ -1202,9 +1202,16 @@ tcApp m_herald orig_fun orig_args res_ty mk_hs_app f (Left a) = mkHsApp f a mk_hs_app f (Right a) = mkHsAppType f a -mk_app_msg :: LHsExpr GhcRn -> SDoc -mk_app_msg fun = sep [ text "The function" <+> quotes (ppr fun) - , text "is applied to"] +mk_app_msg :: LHsExpr GhcRn -> [LHsExprArgIn] -> SDoc +mk_app_msg fun args = sep [ text "The" <+> text what <+> quotes (ppr expr) + , text "is applied to"] + where + what | null type_app_args = "function" + | otherwise = "expression" + -- Include visible type arguments (but not other arguments) in the herald. + -- See Note [Herald for matchExpectedFunTys] in TcUnify. + expr = mkHsAppTypes fun type_app_args + type_app_args = rights args mk_op_msg :: LHsExpr GhcRn -> SDoc mk_op_msg op = text "The operator" <+> quotes (ppr op) <+> text "takes" @@ -1261,7 +1268,11 @@ tcArgs :: LHsExpr GhcRn -- ^ The function itself (for err msgs only) tcArgs fun orig_fun_ty fun_orig orig_args herald = go [] 1 orig_fun_ty orig_args where - orig_arity = length orig_args + -- Don't count visible type arguments when determining how many arguments + -- an expression is given in an arity mismatch error, since visible type + -- arguments reported as a part of the expression herald itself. + -- See Note [Herald for matchExpectedFunTys] in TcUnify. + orig_expr_args_arity = length $ lefts orig_args go _ _ fun_ty [] = return (idHsWrapper, [], fun_ty) @@ -1291,7 +1302,7 @@ tcArgs fun orig_fun_ty fun_orig orig_args herald go acc_args n fun_ty (Left arg : args) = do { (wrap, [arg_ty], res_ty) <- matchActualFunTysPart herald fun_orig (Just (unLoc fun)) 1 fun_ty - acc_args orig_arity + acc_args orig_expr_args_arity -- wrap :: fun_ty "->" arg_ty -> res_ty ; arg' <- tcArg fun arg arg_ty n ; (inner_wrap, args', inner_res_ty) diff --git a/compiler/typecheck/TcUnify.hs b/compiler/typecheck/TcUnify.hs index b792f95..5136649 100644 --- a/compiler/typecheck/TcUnify.hs +++ b/compiler/typecheck/TcUnify.hs @@ -98,6 +98,23 @@ This is used to construct a message of form The function 'f' is applied to two arguments but its type `Int -> Int' has only one +When visible type applications (e.g., `f @Int 1 2`, as in #13902) enter the +picture, we have a choice in deciding whether to count the type applications as +proper arguments: + + The function 'f' is applied to one visible type argument + and two value arguments + but its type `forall a. a -> a` has only one visible type argument + and one value argument + +Or whether to include the type applications as part of the herald itself: + + The expression 'f @Int' is applied to two arguments + but its type `Int -> Int` has only one + +The latter is easier to implement and is arguably easier to understand, so we +choose to implement that option. + Note [matchExpectedFunTys] ~~~~~~~~~~~~~~~~~~~~~~~~~~ matchExpectedFunTys checks that a sigma has the form diff --git a/testsuite/tests/typecheck/should_fail/T13902.hs b/testsuite/tests/typecheck/should_fail/T13902.hs new file mode 100644 index 0000000..73f34f2 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T13902.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE TypeApplications #-} +module T13902 where + +f :: a -> a +f x = x + +g :: Int +g = f @Int 42 5 diff --git a/testsuite/tests/typecheck/should_fail/T13902.stderr b/testsuite/tests/typecheck/should_fail/T13902.stderr new file mode 100644 index 0000000..c3d07ed --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T13902.stderr @@ -0,0 +1,8 @@ + +T13902.hs:8:5: error: + • Couldn't match expected type ‘Integer -> Int’ + with actual type ‘Int’ + • The expression ‘f @Int’ is applied to two arguments, + but its type ‘Int -> Int’ has only one + In the expression: f @Int 42 5 + In an equation for ‘g’: g = f @Int 42 5 diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T index 69e2e99..5fbbee0 100644 --- a/testsuite/tests/typecheck/should_fail/all.T +++ b/testsuite/tests/typecheck/should_fail/all.T @@ -451,6 +451,7 @@ test('T12373', normal, compile_fail, ['']) test('T13610', normal, compile_fail, ['']) test('T11672', normal, compile_fail, ['']) test('T13819', normal, compile_fail, ['']) +test('T13902', normal, compile_fail, ['']) test('T11963', normal, compile_fail, ['']) test('T14000', normal, compile_fail, ['']) test('T14055', normal, compile_fail, ['']) From git at git.haskell.org Tue Aug 22 14:56:38 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 22 Aug 2017 14:56:38 +0000 (UTC) Subject: [commit: ghc] master: Make the Read instance for Proxy (and friends) ignore precedence (8fd9599) Message-ID: <20170822145638.E3B353A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8fd959998e900dffdb7f752fcd42df7aaedeae6e/ghc >--------------------------------------------------------------- commit 8fd959998e900dffdb7f752fcd42df7aaedeae6e Author: Ryan Scott Date: Tue Aug 22 09:29:07 2017 -0400 Make the Read instance for Proxy (and friends) ignore precedence Summary: The `Read` instance for `Proxy`, as well as a handful of other data types in `base` which only have a single constructor, are doing something skeevy: they're requiring that they be surrounded by parentheses if the parsing precedence is sufficiently high. This means that `"Thing (Proxy)"` would parse, but not `"Thing Proxy"`. But the latter really ought to parse, since there's no need to surround a single constructor with parentheses. Indeed, that's the output of `show (Thing Proxy)`, so the current `Read` instance for `Proxy` violates `read . show = id`. The simple solution is to change `readParen (d > 10)` to `readParen False` in the `Read` instance for `Proxy`. But given that a derived `Read` instance would essentially accomplish the same thing, but with even fewer characters, I've opted to just replace the hand-rolled `Read` instance with a derived one. Test Plan: make test TEST=T12874 Reviewers: ekmett, austin, hvr, goldfire, bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie GHC Trac Issues: #12874 Differential Revision: https://phabricator.haskell.org/D3871 >--------------------------------------------------------------- 8fd959998e900dffdb7f752fcd42df7aaedeae6e libraries/base/Data/Proxy.hs | 8 +++----- libraries/base/Data/Type/Coercion.hs | 3 +-- libraries/base/Data/Type/Equality.hs | 6 ++---- libraries/base/GHC/Generics.hs | 5 ++--- libraries/base/changelog.md | 5 +++++ libraries/base/tests/T12874.hs | 9 +++++++++ libraries/base/tests/T12874.stdout | 1 + libraries/base/tests/all.T | 1 + 8 files changed, 24 insertions(+), 14 deletions(-) diff --git a/libraries/base/Data/Proxy.hs b/libraries/base/Data/Proxy.hs index 1ebf56c..2ebb4ab 100644 --- a/libraries/base/Data/Proxy.hs +++ b/libraries/base/Data/Proxy.hs @@ -53,7 +53,9 @@ import GHC.Arr -- -- >>> Proxy :: Proxy complicatedStructure -- Proxy -data Proxy t = Proxy deriving Bounded +data Proxy t = Proxy deriving ( Bounded + , Read -- ^ @since 4.7.0.0 + ) -- | A concrete, promotable proxy type, for use at the kind level -- There are no instances for this because it is intended at the kind level only @@ -76,10 +78,6 @@ instance Show (Proxy s) where showsPrec _ _ = showString "Proxy" -- | @since 4.7.0.0 -instance Read (Proxy s) where - readsPrec d = readParen (d > 10) (\r -> [(Proxy, s) | ("Proxy",s) <- lex r ]) - --- | @since 4.7.0.0 instance Enum (Proxy s) where succ _ = errorWithoutStackTrace "Proxy.succ" pred _ = errorWithoutStackTrace "Proxy.pred" diff --git a/libraries/base/Data/Type/Coercion.hs b/libraries/base/Data/Type/Coercion.hs index 2358115..2bfd9ae 100644 --- a/libraries/base/Data/Type/Coercion.hs +++ b/libraries/base/Data/Type/Coercion.hs @@ -81,8 +81,7 @@ deriving instance Show (Coercion a b) deriving instance Ord (Coercion a b) -- | @since 4.7.0.0 -instance Coercible a b => Read (Coercion a b) where - readsPrec d = readParen (d > 10) (\r -> [(Coercion, s) | ("Coercion",s) <- lex r ]) +deriving instance Coercible a b => Read (Coercion a b) -- | @since 4.7.0.0 instance Coercible a b => Enum (Coercion a b) where diff --git a/libraries/base/Data/Type/Equality.hs b/libraries/base/Data/Type/Equality.hs index 8cc34f6..09999b0 100644 --- a/libraries/base/Data/Type/Equality.hs +++ b/libraries/base/Data/Type/Equality.hs @@ -125,8 +125,7 @@ deriving instance Show (a :~: b) deriving instance Ord (a :~: b) -- | @since 4.7.0.0 -instance a ~ b => Read (a :~: b) where - readsPrec d = readParen (d > 10) (\r -> [(Refl, s) | ("Refl",s) <- lex r ]) +deriving instance a ~ b => Read (a :~: b) -- | @since 4.7.0.0 instance a ~ b => Enum (a :~: b) where @@ -153,8 +152,7 @@ deriving instance Show (a :~~: b) deriving instance Ord (a :~~: b) -- | @since 4.10.0.0 -instance a ~~ b => Read (a :~~: b) where - readsPrec d = readParen (d > 10) (\r -> [(HRefl, s) | ("HRefl",s) <- lex r ]) +deriving instance a ~~ b => Read (a :~~: b) -- | @since 4.10.0.0 instance a ~~ b => Enum (a :~~: b) where diff --git a/libraries/base/GHC/Generics.hs b/libraries/base/GHC/Generics.hs index 14184c2..d4e9583 100644 --- a/libraries/base/GHC/Generics.hs +++ b/libraries/base/GHC/Generics.hs @@ -742,7 +742,7 @@ import GHC.Base ( Alternative(..), Applicative(..), Functor(..) , Monad(..), MonadPlus(..), String, coerce ) import GHC.Classes ( Eq(..), Ord(..) ) import GHC.Enum ( Bounded, Enum ) -import GHC.Read ( Read(..), lex, readParen ) +import GHC.Read ( Read(..) ) import GHC.Show ( Show(..), showString ) -- Needed for metadata @@ -775,8 +775,7 @@ instance Ord (U1 p) where compare _ _ = EQ -- | @since 4.9.0.0 -instance Read (U1 p) where - readsPrec d = readParen (d > 10) (\r -> [(U1, s) | ("U1",s) <- lex r ]) +deriving instance Read (U1 p) -- | @since 4.9.0.0 instance Show (U1 p) where diff --git a/libraries/base/changelog.md b/libraries/base/changelog.md index ab304a3..cce9fba 100644 --- a/libraries/base/changelog.md +++ b/libraries/base/changelog.md @@ -16,6 +16,11 @@ * Add instances `Semigroup` and `Monoid` for `Control.Monad.ST` (#14107). + * The `Read` instances for `Proxy`, `Coercion`, `(:~:)`, `(:~~:)`, and `U1` + now ignore the parsing precedence. The effect of this is that `read` will + be able to successfully parse more strings containing `"Proxy"` _et al._ + without surrounding parentheses (e.g., `"Thing Proxy"`) (#12874). + ## 4.10.0.0 *April 2017* * Bundled with GHC *TBA* diff --git a/libraries/base/tests/T12874.hs b/libraries/base/tests/T12874.hs new file mode 100644 index 0000000..cba7173 --- /dev/null +++ b/libraries/base/tests/T12874.hs @@ -0,0 +1,9 @@ +module Main where + +import Data.Proxy + +main :: IO () +main = print (read "Thing Proxy" :: Thing (Proxy Int)) + +data Thing a = Thing a + deriving (Read,Show) diff --git a/libraries/base/tests/T12874.stdout b/libraries/base/tests/T12874.stdout new file mode 100644 index 0000000..8a89660 --- /dev/null +++ b/libraries/base/tests/T12874.stdout @@ -0,0 +1 @@ +Thing Proxy diff --git a/libraries/base/tests/all.T b/libraries/base/tests/all.T index d97d79a..970fb7e 100644 --- a/libraries/base/tests/all.T +++ b/libraries/base/tests/all.T @@ -205,6 +205,7 @@ test('T12494', normal, compile_and_run, ['']) test('T12852', when(opsys('mingw32'), skip), compile_and_run, ['']) test('lazySTexamples', normal, compile_and_run, ['']) test('T11760', normal, compile_and_run, ['-threaded -with-rtsopts=-N2']) +test('T12874', normal, compile_and_run, ['']) test('T13191', [ stats_num_field('bytes allocated', [ (wordsize(64), 185943272, 5) ]) From git at git.haskell.org Tue Aug 22 15:22:06 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 22 Aug 2017 15:22:06 +0000 (UTC) Subject: [commit: ghc] master: StgLint: Allow join point bindings of unlifted type (9afaebe) Message-ID: <20170822152206.6419E3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9afaebefe5e59c8e9632f381bee14aa84b44c955/ghc >--------------------------------------------------------------- commit 9afaebefe5e59c8e9632f381bee14aa84b44c955 Author: Ben Gamari Date: Tue Aug 22 08:44:47 2017 -0400 StgLint: Allow join point bindings of unlifted type As described in `Note [CoreSyn let/app invariant]` this is allowed. Fixes #14117. Test Plan: Build GHC with BuildFlavour=devel2 with -dstg-lint Reviewers: austin, simonpj Reviewed By: simonpj Subscribers: rwbarton, thomie GHC Trac Issues: #14117 Differential Revision: https://phabricator.haskell.org/D3857 >--------------------------------------------------------------- 9afaebefe5e59c8e9632f381bee14aa84b44c955 compiler/stgSyn/StgLint.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/compiler/stgSyn/StgLint.hs b/compiler/stgSyn/StgLint.hs index cbfd11b..ad7b142 100644 --- a/compiler/stgSyn/StgLint.hs +++ b/compiler/stgSyn/StgLint.hs @@ -11,7 +11,7 @@ module StgLint ( lintStgTopBindings ) where import StgSyn import Bag ( Bag, emptyBag, isEmptyBag, snocBag, bagToList ) -import Id ( Id, idType, isLocalId ) +import Id ( Id, idType, isLocalId, isJoinId ) import VarSet import DataCon import CoreSyn ( AltCon(..) ) @@ -108,7 +108,7 @@ lint_binds_help (binder, rhs) _maybe_rhs_ty <- lintStgRhs rhs -- Check binder doesn't have unlifted type - checkL (not (isUnliftedType binder_ty)) + checkL (isJoinId binder || not (isUnliftedType binder_ty)) (mkUnliftedTyMsg binder rhs) -- Check match to RHS type From git at git.haskell.org Tue Aug 22 15:22:12 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 22 Aug 2017 15:22:12 +0000 (UTC) Subject: [commit: ghc] master: Make law for Foldable.length explicit (cd5a970) Message-ID: <20170822152212.B5B423A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/cd5a9709a6e6647e0e7dc78f863820ca53bc99b0/ghc >--------------------------------------------------------------- commit cd5a9709a6e6647e0e7dc78f863820ca53bc99b0 Author: Alain O'Dea Date: Tue Aug 22 08:47:07 2017 -0400 Make law for Foldable.length explicit Test Plan: Documentation only. Not necessary. Reviewers: austin, hvr, bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie Differential Revision: https://phabricator.haskell.org/D3878 >--------------------------------------------------------------- cd5a9709a6e6647e0e7dc78f863820ca53bc99b0 libraries/base/Data/Foldable.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/libraries/base/Data/Foldable.hs b/libraries/base/Data/Foldable.hs index e33d45e..08ba9d4 100644 --- a/libraries/base/Data/Foldable.hs +++ b/libraries/base/Data/Foldable.hs @@ -99,6 +99,8 @@ infix 4 `elem`, `notElem` -- -- > fold = foldMap id -- +-- > length = getSum . foldMap (Sum . const 1) +-- -- @sum@, @product@, @maximum@, and @minimum@ should all be essentially -- equivalent to @foldMap@ forms, such as -- From git at git.haskell.org Tue Aug 22 15:22:15 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 22 Aug 2017 15:22:15 +0000 (UTC) Subject: [commit: ghc] master: fix typo (expreesions -> expressions) (090d896) Message-ID: <20170822152215.76D3C3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/090d8960b0fc9c50edc547a334a63d783224933f/ghc >--------------------------------------------------------------- commit 090d8960b0fc9c50edc547a334a63d783224933f Author: Chris Martin Date: Sat Aug 19 18:33:11 2017 -0400 fix typo (expreesions -> expressions) >--------------------------------------------------------------- 090d8960b0fc9c50edc547a334a63d783224933f ghc/GHCi/UI/Info.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ghc/GHCi/UI/Info.hs b/ghc/GHCi/UI/Info.hs index a114ebf..c0cb2d1 100644 --- a/ghc/GHCi/UI/Info.hs +++ b/ghc/GHCi/UI/Info.hs @@ -3,7 +3,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} --- | Get information on modules, expreesions, and identifiers +-- | Get information on modules, expressions, and identifiers module GHCi.UI.Info ( ModInfo(..) , SpanInfo(..) From git at git.haskell.org Tue Aug 22 15:22:18 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 22 Aug 2017 15:22:18 +0000 (UTC) Subject: [commit: ghc] master: Move validate cleaning from distclean to clean (afc2f79) Message-ID: <20170822152218.343003A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/afc2f7989ea973f201a28d95abb24b22269c5256/ghc >--------------------------------------------------------------- commit afc2f7989ea973f201a28d95abb24b22269c5256 Author: Douglas Wilson Date: Tue Aug 22 08:44:00 2017 -0400 Move validate cleaning from distclean to clean This bit me today: I was in validate mode without realising it and "make clean" didn't help. I don't see a reason for this to be in distclean, as it isn't generated by ./configure, which is the rule described in https://ghc.haskell.org/trac/ghc/wiki/Building/Using Test Plan: Is there a reason for this to be in distclean? Reviewers: austin, bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie Differential Revision: https://phabricator.haskell.org/D3814 >--------------------------------------------------------------- afc2f7989ea973f201a28d95abb24b22269c5256 ghc.mk | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/ghc.mk b/ghc.mk index 55cc119..4a2f703 100644 --- a/ghc.mk +++ b/ghc.mk @@ -1366,6 +1366,8 @@ clean_files : $(call removeTrees,inplace/bin) $(call removeTrees,inplace/lib) $(call removeTrees,libraries/bootstrapping.conf) +# Clean the files that ./validate creates. + $(call removeFiles,mk/are-validating.mk) .PHONY: clean_libraries clean_libraries: $(patsubst %,clean_libraries/%_dist-install,$(PACKAGES_STAGE1) $(PACKAGES_STAGE2)) @@ -1398,9 +1400,6 @@ clean_bindistprep: $(call removeTrees,bindistprep/) distclean : clean -# Clean the files that ./validate creates. - $(call removeFiles,mk/are-validating.mk) - # Clean the files that we ask ./configure to create. $(call removeFiles,mk/config.mk) $(call removeFiles,mk/install.mk) From git at git.haskell.org Tue Aug 22 15:22:20 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 22 Aug 2017 15:22:20 +0000 (UTC) Subject: [commit: ghc] master: Bump haddock submodule (20c7053) Message-ID: <20170822152220.E86913A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/20c7053d4b430308767d1243854d12163e08c4e8/ghc >--------------------------------------------------------------- commit 20c7053d4b430308767d1243854d12163e08c4e8 Author: Ben Gamari Date: Tue Aug 22 08:47:33 2017 -0400 Bump haddock submodule >--------------------------------------------------------------- 20c7053d4b430308767d1243854d12163e08c4e8 testsuite/tests/perf/haddock/all.T | 6 ++++-- utils/haddock | 2 +- 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/testsuite/tests/perf/haddock/all.T b/testsuite/tests/perf/haddock/all.T index 7aed869..e329d86 100644 --- a/testsuite/tests/perf/haddock/all.T +++ b/testsuite/tests/perf/haddock/all.T @@ -9,7 +9,7 @@ test('haddock.base', [(platform('x86_64-unknown-mingw32'), 24286343184, 5) # 2017-02-19 24286343184 (x64/Windows) - Generalize kind of (->) - ,(wordsize(64), 23677299848, 5) + ,(wordsize(64), 19694554424, 5) # 2012-08-14: 5920822352 (amd64/Linux) # 2012-09-20: 5829972376 (amd64/Linux) # 2012-10-08: 5902601224 (amd64/Linux) @@ -42,6 +42,7 @@ test('haddock.base', # 2017-06-05: 27868466432 (x86_64/Linux) - Desugar modules compiled with -fno-code # 2017-06-06: 25173968808 (x86_64/Linux) - Don't pass on -dcore-lint in Haddock.mk # 2017-07-12: 23677299848 (x86_64/Linux) - Use getNameToInstancesIndex + # 2017-08-22: 19694554424 (x86_64/Linux) - Various Haddock optimizations ,(platform('i386-unknown-mingw32'), 2885173512, 5) # 2013-02-10: 3358693084 (x86/Windows) @@ -68,7 +69,7 @@ test('haddock.Cabal', [extra_files(['../../../../libraries/Cabal/Cabal/dist-install/haddock.t']), unless(in_tree_compiler(), skip), req_haddock ,stats_num_field('bytes allocated', - [(wordsize(64), 18753963960 , 5) + [(wordsize(64), 15857428040, 5) # 2012-08-14: 3255435248 (amd64/Linux) # 2012-08-29: 3324606664 (amd64/Linux, new codegen) # 2012-10-08: 3373401360 (amd64/Linux) @@ -116,6 +117,7 @@ test('haddock.Cabal', # 2017-05-31: 18269309128 (amd64/Linux) - Faster checkFamInstConsistency # 2017-06-05: 22294859000 (amd64/Linux) - Desugar modules compiled with -fno-code # 2017-06-05: 18753963960 (amd64/Linux) - Don't pass on -dcore-lint in Haddock.mk + # 2017-08-22: 15857428040 (amd64/Linux) - Various Haddock optimizations ,(platform('i386-unknown-mingw32'), 3293415576, 5) # 2012-10-30: 1733638168 (x86/Windows) diff --git a/utils/haddock b/utils/haddock index c8a01b8..648410f 160000 --- a/utils/haddock +++ b/utils/haddock @@ -1 +1 @@ -Subproject commit c8a01b83be52e45d3890db173ffe7b09ccd4f351 +Subproject commit 648410f64b4a2423f2afe8afb6089b7749ebd4af From git at git.haskell.org Tue Aug 22 15:22:10 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 22 Aug 2017 15:22:10 +0000 (UTC) Subject: [commit: ghc] master: Fix incorrect retypecheck loop in -j (#14075) (4717ce8) Message-ID: <20170822152210.04C663A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4717ce8658f12f425aebd1fc7f7ad8fe04a81df5/ghc >--------------------------------------------------------------- commit 4717ce8658f12f425aebd1fc7f7ad8fe04a81df5 Author: Edward Z. Yang Date: Tue Aug 22 08:44:25 2017 -0400 Fix incorrect retypecheck loop in -j (#14075) The parallel codepath was incorrectly retypechecking the hs-boot ModIface prior to typechecking the hs file, which was inconsistent with the non-parallel case. The non-parallel case gets it right: you don't want to retypecheck the hs-boot file itself (forwarding its declarations to hs) because you need it to be consistently knot-tied with itself when you compare the interfaces. Signed-off-by: Edward Z. Yang Test Plan: validate Reviewers: bgamari, simonpj, austin Reviewed By: bgamari Subscribers: duog, rwbarton, thomie GHC Trac Issues: #14075 Differential Revision: https://phabricator.haskell.org/D3815 >--------------------------------------------------------------- 4717ce8658f12f425aebd1fc7f7ad8fe04a81df5 compiler/main/GhcMake.hs | 50 +++++++++++++++++++++- testsuite/tests/driver/T14075/F.hs | 1 + testsuite/tests/driver/T14075/F.hs-boot | 6 +++ .../tests/{cabal/pkg02 => driver/T14075}/Makefile | 2 + testsuite/tests/driver/T14075/O.hs | 3 ++ testsuite/tests/driver/T14075/T14075.stderr | 7 +++ testsuite/tests/driver/T14075/T14075.stdout | 3 ++ testsuite/tests/driver/T14075/V.hs | 3 ++ testsuite/tests/driver/T14075/V.hs-boot | 1 + testsuite/tests/driver/T14075/all.T | 4 ++ 10 files changed, 78 insertions(+), 2 deletions(-) diff --git a/compiler/main/GhcMake.hs b/compiler/main/GhcMake.hs index f4a9a31..724ced2 100644 --- a/compiler/main/GhcMake.hs +++ b/compiler/main/GhcMake.hs @@ -1172,7 +1172,13 @@ parUpsweep_one mod home_mod_map comp_graph_loops lcl_dflags mHscMessage cleanup Just (ms_mod lcl_mod, type_env_var) } lcl_hsc_env'' <- case finish_loop of Nothing -> return lcl_hsc_env' + -- In the non-parallel case, the retypecheck prior to + -- typechecking the loop closer includes all modules + -- EXCEPT the loop closer. However, our precomputed + -- SCCs include the loop closer, so we have to filter + -- it out. Just loop -> typecheckLoop lcl_dflags lcl_hsc_env' $ + filter (/= moduleName (fst this_build_mod)) $ map (moduleName . fst) loop -- Compile the module. @@ -1195,8 +1201,10 @@ parUpsweep_one mod home_mod_map comp_graph_loops lcl_dflags mHscMessage cleanup let hsc_env' = hsc_env { hsc_HPT = addToHpt (hsc_HPT hsc_env) this_mod mod_info } - -- If this module is a loop finisher, now is the time to - -- re-typecheck the loop. + -- We've finished typechecking the module, now we must + -- retypecheck the loop AGAIN to ensure unfoldings are + -- updated. This time, however, we include the loop + -- closer! hsc_env'' <- case finish_loop of Nothing -> return hsc_env' Just loop -> typecheckLoop lcl_dflags hsc_env' $ @@ -1672,6 +1680,42 @@ reTypecheckLoop hsc_env ms graph mss = mgModSummaries graph appearsAsBoot = (`elemModuleSet` mgBootModules graph) +-- | Given a non-boot ModSummary @ms@ of a module, for which there exists a +-- corresponding boot file in @graph@, return the set of modules which +-- transitively depend on this boot file. This function is slightly misnamed, +-- but its name "getModLoop" alludes to the fact that, when getModLoop is called +-- with a graph that does not contain @ms@ (non-parallel case) or is an +-- SCC with hs-boot nodes dropped (parallel-case), the modules which +-- depend on the hs-boot file are typically (but not always) the +-- modules participating in the recursive module loop. The returned +-- list includes the hs-boot file. +-- +-- Example: +-- let g represent the module graph: +-- C.hs +-- A.hs-boot imports C.hs +-- B.hs imports A.hs-boot +-- A.hs imports B.hs +-- genModLoop A.hs g == Just [A.hs-boot, B.hs, A.hs] +-- +-- It would also be permissible to omit A.hs from the graph, +-- in which case the result is [A.hs-boot, B.hs] +-- +-- Example: +-- A counter-example to the claim that modules returned +-- by this function participate in the loop occurs here: +-- +-- let g represent the module graph: +-- C.hs +-- A.hs-boot imports C.hs +-- B.hs imports A.hs-boot +-- A.hs imports B.hs +-- D.hs imports A.hs-boot +-- genModLoop A.hs g == Just [A.hs-boot, B.hs, A.hs, D.hs] +-- +-- Arguably, D.hs should import A.hs, not A.hs-boot, but +-- a dependency on the boot file is not illegal. +-- getModLoop :: ModSummary -> [ModSummary] @@ -1687,6 +1731,8 @@ getModLoop ms graph appearsAsBoot where this_mod = ms_mod ms +-- NB: sometimes mods has duplicates; this is harmless because +-- any duplicates get clobbered in addListToHpt and never get forced. typecheckLoop :: DynFlags -> HscEnv -> [ModuleName] -> IO HscEnv typecheckLoop dflags hsc_env mods = do debugTraceMsg dflags 2 $ diff --git a/testsuite/tests/driver/T14075/F.hs b/testsuite/tests/driver/T14075/F.hs new file mode 100644 index 0000000..3e32036 --- /dev/null +++ b/testsuite/tests/driver/T14075/F.hs @@ -0,0 +1 @@ +module F () where diff --git a/testsuite/tests/driver/T14075/F.hs-boot b/testsuite/tests/driver/T14075/F.hs-boot new file mode 100644 index 0000000..41008d5 --- /dev/null +++ b/testsuite/tests/driver/T14075/F.hs-boot @@ -0,0 +1,6 @@ +module F where + +import O (O) + +newtype F = F () +instance O F where diff --git a/testsuite/tests/cabal/pkg02/Makefile b/testsuite/tests/driver/T14075/Makefile similarity index 59% copy from testsuite/tests/cabal/pkg02/Makefile copy to testsuite/tests/driver/T14075/Makefile index 4a26853..505274a 100644 --- a/testsuite/tests/cabal/pkg02/Makefile +++ b/testsuite/tests/driver/T14075/Makefile @@ -2,3 +2,5 @@ TOP=../../.. include $(TOP)/mk/boilerplate.mk include $(TOP)/mk/test.mk +T14075: + ! '$(TEST_HC)' $(TEST_HC_OPTS) -j2 F O V diff --git a/testsuite/tests/driver/T14075/O.hs b/testsuite/tests/driver/T14075/O.hs new file mode 100644 index 0000000..2cbb8bb --- /dev/null +++ b/testsuite/tests/driver/T14075/O.hs @@ -0,0 +1,3 @@ +module O (O) where + +class O a where diff --git a/testsuite/tests/driver/T14075/T14075.stderr b/testsuite/tests/driver/T14075/T14075.stderr new file mode 100644 index 0000000..0493a96 --- /dev/null +++ b/testsuite/tests/driver/T14075/T14075.stderr @@ -0,0 +1,7 @@ + +F.hs:1:1: error: + instance O.O F.F -- Defined at F.hs-boot:6:10 + is defined in the hs-boot file, but not in the module itself + +F.hs-boot:5:1: error: + ‘F.F’ is exported by the hs-boot file, but not exported by the module diff --git a/testsuite/tests/driver/T14075/T14075.stdout b/testsuite/tests/driver/T14075/T14075.stdout new file mode 100644 index 0000000..18f17be --- /dev/null +++ b/testsuite/tests/driver/T14075/T14075.stdout @@ -0,0 +1,3 @@ +[1 of 4] Compiling O ( O.hs, O.o ) +[2 of 4] Compiling F[boot] ( F.hs-boot, F.o-boot ) +[3 of 4] Compiling F ( F.hs, F.o ) diff --git a/testsuite/tests/driver/T14075/V.hs b/testsuite/tests/driver/T14075/V.hs new file mode 100644 index 0000000..cf06b93 --- /dev/null +++ b/testsuite/tests/driver/T14075/V.hs @@ -0,0 +1,3 @@ +module V () where + +import {-# SOURCE #-} F () diff --git a/testsuite/tests/driver/T14075/V.hs-boot b/testsuite/tests/driver/T14075/V.hs-boot new file mode 100644 index 0000000..ec64e22 --- /dev/null +++ b/testsuite/tests/driver/T14075/V.hs-boot @@ -0,0 +1 @@ +module V where diff --git a/testsuite/tests/driver/T14075/all.T b/testsuite/tests/driver/T14075/all.T new file mode 100644 index 0000000..646976a --- /dev/null +++ b/testsuite/tests/driver/T14075/all.T @@ -0,0 +1,4 @@ +test('T14075', + [extra_files(['F.hs', 'F.hs-boot', 'O.hs', 'V.hs', 'V.hs-boot'])], + run_command, + ['$MAKE -s --no-print-directory T14075']) From git at git.haskell.org Tue Aug 22 15:22:23 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 22 Aug 2017 15:22:23 +0000 (UTC) Subject: [commit: ghc] master: Fixed a typo in template-haskell documentation (028645c) Message-ID: <20170822152223.A86A53A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/028645ce67003f954e71c5a624c158c184506639/ghc >--------------------------------------------------------------- commit 028645ce67003f954e71c5a624c158c184506639 Author: Benjamin Hodgson Date: Tue Aug 22 13:11:43 2017 +0100 Fixed a typo in template-haskell documentation The documentation for `Type`'s `ForallT` constructor had a typo (pun not intended). `ctxt` is separated from `type` in the surface syntax by a fat arrow (`=>`), not a thin arrow (`->`). >--------------------------------------------------------------- 028645ce67003f954e71c5a624c158c184506639 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 b8e1601..aacc8c3 100644 --- a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs +++ b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs @@ -1905,7 +1905,7 @@ data PatSynArgs | RecordPatSyn [Name] -- ^ @pattern P { {x,y,z} } = p@ deriving( Show, Eq, Ord, Data, Generic ) -data Type = ForallT [TyVarBndr] Cxt Type -- ^ @forall \. \ -> \@ +data Type = ForallT [TyVarBndr] Cxt Type -- ^ @forall \. \ => \@ | AppT Type Type -- ^ @T a b@ | SigT Type Kind -- ^ @t :: k@ | VarT Name -- ^ @a@ From git at git.haskell.org Tue Aug 22 18:39:02 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 22 Aug 2017 18:39:02 +0000 (UTC) Subject: [commit: ghc] wip/rae: Test #14038 in dependent/should_compile/T14038 (26f78d0) Message-ID: <20170822183902.AB3733A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/26f78d0ae911e0a5e5394a577fda22c8c2c26fdf/ghc >--------------------------------------------------------------- commit 26f78d0ae911e0a5e5394a577fda22c8c2c26fdf Author: Richard Eisenberg Date: Tue Aug 8 18:20:42 2017 -0400 Test #14038 in dependent/should_compile/T14038 >--------------------------------------------------------------- 26f78d0ae911e0a5e5394a577fda22c8c2c26fdf .../should_compile/T14038.hs} | 27 +++++++++++----------- testsuite/tests/dependent/should_compile/all.T | 1 + 2 files changed, 15 insertions(+), 13 deletions(-) diff --git a/testsuite/tests/indexed-types/should_fail/T13877.hs b/testsuite/tests/dependent/should_compile/T14038.hs similarity index 72% copy from testsuite/tests/indexed-types/should_fail/T13877.hs copy to testsuite/tests/dependent/should_compile/T14038.hs index ee5f16b..839220a 100644 --- a/testsuite/tests/indexed-types/should_fail/T13877.hs +++ b/testsuite/tests/dependent/should_compile/T14038.hs @@ -1,31 +1,32 @@ {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE Trustworthy #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeInType #-} {-# LANGUAGE TypeOperators #-} -module T13877 where +module T14038 where -import Data.Kind +import Data.Kind (Type) data family Sing (a :: k) data instance Sing (z :: [a]) where SNil :: Sing '[] SCons :: Sing x -> Sing xs -> Sing (x:xs) -data TyFun :: * -> * -> * -type a ~> b = TyFun a b -> * +data TyFun :: Type -> Type -> Type +type a ~> b = TyFun a b -> Type infixr 0 ~> type family Apply (f :: k1 ~> k2) (x :: k1) :: k2 type a @@ b = Apply a b infixl 9 @@ -data FunArrow = (:->) | (:~>) +data FunArrow = (:->) -- ^ '(->)' + | (:~>) -- ^ '(~>)' class FunType (arr :: FunArrow) where type Fun (k1 :: Type) arr (k2 :: Type) :: Type @@ -50,25 +51,25 @@ instance AppType (:~>) where infixr 0 -?> type (-?>) (k1 :: Type) (k2 :: Type) (arr :: FunArrow) = Fun k1 arr k2 -listElim :: forall (a :: Type) (p :: [a] -> Type) (l :: [a]). +elimList :: forall (a :: Type) (p :: [a] -> Type) (l :: [a]). Sing l -> p '[] -> (forall (x :: a) (xs :: [a]). Sing x -> Sing xs -> p xs -> p (x:xs)) -> p l -listElim = listElimPoly @(:->) @a @p @l +elimList = elimListPoly @(:->) -listElimTyFun :: forall (a :: Type) (p :: [a] ~> Type) (l :: [a]). +elimListTyFun :: forall (a :: Type) (p :: [a] ~> Type) (l :: [a]). Sing l -> p @@ '[] -> (forall (x :: a) (xs :: [a]). Sing x -> Sing xs -> p @@ xs -> p @@ (x:xs)) -> p @@ l -listElimTyFun = listElimPoly @(:->) @a @p @l +elimListTyFun = elimListPoly @(:~>) @_ @p -listElimPoly :: forall (arr :: FunArrow) (a :: Type) (p :: ([a] -?> Type) arr) (l :: [a]). +elimListPoly :: forall (arr :: FunArrow) (a :: Type) (p :: ([a] -?> Type) arr) (l :: [a]). FunApp arr => Sing l -> App [a] arr Type p '[] -> (forall (x :: a) (xs :: [a]). Sing x -> Sing xs -> App [a] arr Type p xs -> App [a] arr Type p (x:xs)) -> App [a] arr Type p l -listElimPoly SNil pNil _ = pNil -listElimPoly (SCons x (xs :: Sing xs)) pNil pCons = pCons x xs (listElimPoly @arr @a @p @xs xs pNil pCons) +elimListPoly SNil pNil _ = pNil +elimListPoly (SCons x (xs :: Sing xs)) pNil pCons = pCons x xs (elimListPoly @arr @a @p @xs xs pNil pCons) diff --git a/testsuite/tests/dependent/should_compile/all.T b/testsuite/tests/dependent/should_compile/all.T index b854f1d..a135892 100644 --- a/testsuite/tests/dependent/should_compile/all.T +++ b/testsuite/tests/dependent/should_compile/all.T @@ -25,3 +25,4 @@ test('T11966', normal, compile, ['']) test('T12442', normal, compile, ['']) test('T13538', normal, compile, ['']) test('T12176', normal, compile, ['']) +test('T14038', expect_broken(14038), compile, ['']) From git at git.haskell.org Tue Aug 22 18:39:06 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 22 Aug 2017 18:39:06 +0000 (UTC) Subject: [commit: ghc] wip/rae: Fix #13909 by tweaking an error message. (9d92d5f) Message-ID: <20170822183906.1AF9A3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/9d92d5fe733cf7a744cf42a70ebf9af5106a7e50/ghc >--------------------------------------------------------------- commit 9d92d5fe733cf7a744cf42a70ebf9af5106a7e50 Author: Richard Eisenberg Date: Tue Aug 15 19:07:59 2017 -0400 Fix #13909 by tweaking an error message. GHC was complaining about numbers of arguments when the real problem is impredicativity. test case: typecheck/should_fail/T13909 >--------------------------------------------------------------- 9d92d5fe733cf7a744cf42a70ebf9af5106a7e50 compiler/typecheck/TcErrors.hs | 7 ++++++- testsuite/tests/typecheck/should_fail/T13909.hs | 12 ++++++++++++ testsuite/tests/typecheck/should_fail/T13909.stderr | 5 +++++ testsuite/tests/typecheck/should_fail/all.T | 1 + 4 files changed, 24 insertions(+), 1 deletion(-) diff --git a/compiler/typecheck/TcErrors.hs b/compiler/typecheck/TcErrors.hs index 3aa5dd8..325c837 100644 --- a/compiler/typecheck/TcErrors.hs +++ b/compiler/typecheck/TcErrors.hs @@ -2015,8 +2015,11 @@ mkExpectedActualMsg ty1 ty2 (TypeEqOrigin { uo_actual = act | otherwise = text "kind" <+> quotes (ppr exp) num_args_msg = case level of - TypeLevel -> Nothing KindLevel + | not (isMetaTyVarTy exp) && not (isMetaTyVarTy act) + -- if one is a meta-tyvar, then it's possible that the user + -- has asked for something impredicative, and we couldn't unify. + -- Don't bother with counting arguments. -> let n_act = count_args act n_exp = count_args exp in case n_act - n_exp of @@ -2031,6 +2034,8 @@ mkExpectedActualMsg ty1 ty2 (TypeEqOrigin { uo_actual = act | otherwise = text "more arguments to" -- n > 1 _ -> Nothing + _ -> Nothing + maybe_num_args_msg = case num_args_msg of Nothing -> empty Just m -> m diff --git a/testsuite/tests/typecheck/should_fail/T13909.hs b/testsuite/tests/typecheck/should_fail/T13909.hs new file mode 100644 index 0000000..4f0cbdc --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T13909.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE TypeInType #-} +module T13909 where + +import Data.Kind + +data Hm (k :: Type) (a :: k) :: Type + +class HasName (a :: k) where + getName :: proxy a -> String + +instance HasName Hm where + getName _ = "Hm" diff --git a/testsuite/tests/typecheck/should_fail/T13909.stderr b/testsuite/tests/typecheck/should_fail/T13909.stderr new file mode 100644 index 0000000..599be5a --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T13909.stderr @@ -0,0 +1,5 @@ + +T13909.hs:11:18: error: + • Expected kind ‘k0’, but ‘Hm’ has kind ‘forall k -> k -> *’ + • In the first argument of ‘HasName’, namely ‘Hm’ + In the instance declaration for ‘HasName Hm’ diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T index 5fbbee0..d07cb11 100644 --- a/testsuite/tests/typecheck/should_fail/all.T +++ b/testsuite/tests/typecheck/should_fail/all.T @@ -455,3 +455,4 @@ test('T13902', normal, compile_fail, ['']) test('T11963', normal, compile_fail, ['']) test('T14000', normal, compile_fail, ['']) test('T14055', normal, compile_fail, ['']) +test('T13909', normal, compile_fail, ['']) From git at git.haskell.org Tue Aug 22 18:39:09 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 22 Aug 2017 18:39:09 +0000 (UTC) Subject: [commit: ghc] wip/rae: Test #12938 in indexed-types/should_compile/T12938 (159294f) Message-ID: <20170822183909.581763A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/159294f66d8a54747a8a0bd8e2cdfbc3b3f06592/ghc >--------------------------------------------------------------- commit 159294f66d8a54747a8a0bd8e2cdfbc3b3f06592 Author: Richard Eisenberg Date: Tue Aug 15 14:56:31 2017 -0400 Test #12938 in indexed-types/should_compile/T12938 >--------------------------------------------------------------- 159294f66d8a54747a8a0bd8e2cdfbc3b3f06592 testsuite/tests/indexed-types/should_compile/T12938.hs | 8 ++++++++ testsuite/tests/indexed-types/should_compile/all.T | 1 + 2 files changed, 9 insertions(+) diff --git a/testsuite/tests/indexed-types/should_compile/T12938.hs b/testsuite/tests/indexed-types/should_compile/T12938.hs new file mode 100644 index 0000000..1c8f47e --- /dev/null +++ b/testsuite/tests/indexed-types/should_compile/T12938.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE TypeInType, TypeFamilies #-} + +module Bug where + +import GHC.Exts + +class HasRep a where + type Rep a :: TYPE r diff --git a/testsuite/tests/indexed-types/should_compile/all.T b/testsuite/tests/indexed-types/should_compile/all.T index dc166dc..950bdba 100644 --- a/testsuite/tests/indexed-types/should_compile/all.T +++ b/testsuite/tests/indexed-types/should_compile/all.T @@ -267,3 +267,4 @@ test('T13662', normal, compile, ['']) test('T13705', normal, compile, ['']) test('T12369', normal, compile, ['']) test('T14045', normal, compile, ['']) +test('T12938', normal, compile, ['']) From git at git.haskell.org Tue Aug 22 18:39:16 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 22 Aug 2017 18:39:16 +0000 (UTC) Subject: [commit: ghc] wip/rae: Fix #13407 by suppressing invisibles better. (21b55c1) Message-ID: <20170822183916.1A5A33A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/21b55c174af9b759c7134a417d94af091551c6d1/ghc >--------------------------------------------------------------- commit 21b55c174af9b759c7134a417d94af091551c6d1 Author: Richard Eisenberg Date: Tue Aug 15 18:04:32 2017 -0400 Fix #13407 by suppressing invisibles better. Previously, the iface-invisible-suppresser assumed that all invisible things are up front. Not true! test case: ghci/scripts/T13407 >--------------------------------------------------------------- 21b55c174af9b759c7134a417d94af091551c6d1 compiler/iface/IfaceType.hs | 6 +++--- testsuite/tests/ghci/scripts/T13407.script | 4 ++++ testsuite/tests/ghci/scripts/T13407.stdout | 3 +++ testsuite/tests/ghci/scripts/all.T | 1 + 4 files changed, 11 insertions(+), 3 deletions(-) diff --git a/compiler/iface/IfaceType.hs b/compiler/iface/IfaceType.hs index b1ad780..c7405b3 100644 --- a/compiler/iface/IfaceType.hs +++ b/compiler/iface/IfaceType.hs @@ -321,9 +321,9 @@ suppressIfaceInvisibles dflags tys xs where suppress _ [] = [] suppress [] a = a - suppress (k:ks) a@(_:xs) - | isInvisibleTyConBinder k = suppress ks xs - | otherwise = a + suppress (k:ks) (x:xs) + | isInvisibleTyConBinder k = suppress ks xs + | otherwise = x : suppress ks xs stripIfaceInvisVars :: DynFlags -> [IfaceTyConBinder] -> [IfaceTyConBinder] stripIfaceInvisVars dflags tyvars diff --git a/testsuite/tests/ghci/scripts/T13407.script b/testsuite/tests/ghci/scripts/T13407.script new file mode 100644 index 0000000..f77fd42 --- /dev/null +++ b/testsuite/tests/ghci/scripts/T13407.script @@ -0,0 +1,4 @@ +:set -XTypeInType -XRankNTypes +import Data.Kind +data Foo :: (* -> *) -> (forall k. k -> *) +:info Foo diff --git a/testsuite/tests/ghci/scripts/T13407.stdout b/testsuite/tests/ghci/scripts/T13407.stdout new file mode 100644 index 0000000..7607413 --- /dev/null +++ b/testsuite/tests/ghci/scripts/T13407.stdout @@ -0,0 +1,3 @@ +type role Foo phantom phantom +data Foo (a :: * -> *) (c :: k) + -- Defined at :3:1 diff --git a/testsuite/tests/ghci/scripts/all.T b/testsuite/tests/ghci/scripts/all.T index 8872cc4..7d33758 100755 --- a/testsuite/tests/ghci/scripts/all.T +++ b/testsuite/tests/ghci/scripts/all.T @@ -256,3 +256,4 @@ test('T13466', normal, ghci_script, ['T13466.script']) test('GhciCurDir', normal, ghci_script, ['GhciCurDir.script']) test('T13591', expect_broken(13591), ghci_script, ['T13591.script']) test('T13699', normal, ghci_script, ['T13699.script']) +test('T13407', normal, ghci_script, ['T13407.script']) From git at git.haskell.org Tue Aug 22 18:39:12 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 22 Aug 2017 18:39:12 +0000 (UTC) Subject: [commit: ghc] wip/rae: Fix #13391 by checking for kind-GADTs (56b0c7b) Message-ID: <20170822183912.D68C13A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/56b0c7b1b5f929371c13f4f302bad1e2f8f652ba/ghc >--------------------------------------------------------------- commit 56b0c7b1b5f929371c13f4f302bad1e2f8f652ba Author: Richard Eisenberg Date: Tue Aug 15 17:22:50 2017 -0400 Fix #13391 by checking for kind-GADTs The check is a bit gnarly, but I couldn't think of a better way. See the new code in TcTyClsDecls. test case: polykinds/T13391 >--------------------------------------------------------------- 56b0c7b1b5f929371c13f4f302bad1e2f8f652ba compiler/basicTypes/DataCon.hs | 2 ++ compiler/typecheck/TcTyClsDecls.hs | 29 ++++++++++++++++++++++ libraries/base/Data/Type/Equality.hs | 3 +-- .../should_compile/Dep2.hs => polykinds/T13391.hs} | 6 ++--- testsuite/tests/polykinds/T13391.stderr | 7 ++++++ testsuite/tests/polykinds/all.T | 1 + 6 files changed, 43 insertions(+), 5 deletions(-) diff --git a/compiler/basicTypes/DataCon.hs b/compiler/basicTypes/DataCon.hs index fa8e0a8..06bb504 100644 --- a/compiler/basicTypes/DataCon.hs +++ b/compiler/basicTypes/DataCon.hs @@ -310,6 +310,8 @@ data DataCon -- Universally-quantified type vars [a,b,c] -- INVARIANT: length matches arity of the dcRepTyCon -- INVARIANT: result type of data con worker is exactly (T a b c) + -- COROLLARY: The dcUnivTyVars are always in one-to-one correspondence with + -- the tyConTyVars of the parent TyCon dcUnivTyVars :: [TyVarBinder], -- Existentially-quantified type vars [x,y] diff --git a/compiler/typecheck/TcTyClsDecls.hs b/compiler/typecheck/TcTyClsDecls.hs index 0974fe5..1409705 100644 --- a/compiler/typecheck/TcTyClsDecls.hs +++ b/compiler/typecheck/TcTyClsDecls.hs @@ -2492,6 +2492,26 @@ checkValidDataCon dflags existential_ok tc con ; checkTc (existential_ok || isVanillaDataCon con) (badExistential con) + ; typeintype <- xoptM LangExt.TypeInType + ; let invisible_gadt_eq_specs = filter is_invisible_eq_spec (dataConEqSpec con) + univ_tvs = dataConUnivTyVars con + tc_bndrs = tyConBinders tc + + -- find the index of the univ tv mentioned in the eq_spec + -- then, look that up in the TyConBinders to see if it's visible + -- Maybe there's a better way, but I don't see it. + -- See Note [Wrong visibility for GADTs], though. + is_invisible_eq_spec eq_spec + = let eq_tv = eqSpecTyVar eq_spec + tv_index = expectJust "checkValidDataCon" $ + elemIndex eq_tv univ_tvs + tc_bndr = tc_bndrs `getNth` tv_index + in + isInvisibleTyConBinder tc_bndr + + ; checkTc (typeintype || null invisible_gadt_eq_specs) + (badGADT con invisible_gadt_eq_specs) + -- Check that UNPACK pragmas and bangs work out -- E.g. reject data T = MkT {-# UNPACK #-} Int -- No "!" -- data T = MkT {-# UNPACK #-} !a -- Can't unpack @@ -3197,6 +3217,15 @@ badExistential con 2 (vcat [ ppr con <+> dcolon <+> ppr (dataConUserType con) , parens $ text "Use ExistentialQuantification or GADTs to allow this" ]) +badGADT :: DataCon -> [EqSpec] -> SDoc +badGADT con eq_specs + = hang (text "Data constructor" <+> quotes (ppr con) <+> + text "constrains the choice of kind parameter" <> plural eq_specs <> colon) + 2 (vcat (map ppr_eq_spec eq_specs)) $$ + text "Use TypeInType to allow this" + where + ppr_eq_spec eq_spec = ppr (eqSpecTyVar eq_spec) <+> char '~' <+> ppr (eqSpecType eq_spec) + badStupidTheta :: Name -> SDoc badStupidTheta tc_name = text "A data type declared in GADT style cannot have a context:" <+> quotes (ppr tc_name) diff --git a/libraries/base/Data/Type/Equality.hs b/libraries/base/Data/Type/Equality.hs index 09999b0..e34eb24 100644 --- a/libraries/base/Data/Type/Equality.hs +++ b/libraries/base/Data/Type/Equality.hs @@ -4,9 +4,8 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE PolyKinds #-} {-# LANGUAGE RankNTypes #-} -{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeInType #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE ExplicitNamespaces #-} diff --git a/testsuite/tests/dependent/should_compile/Dep2.hs b/testsuite/tests/polykinds/T13391.hs similarity index 50% copy from testsuite/tests/dependent/should_compile/Dep2.hs copy to testsuite/tests/polykinds/T13391.hs index 34be3cf..6de3c3a 100644 --- a/testsuite/tests/dependent/should_compile/Dep2.hs +++ b/testsuite/tests/polykinds/T13391.hs @@ -1,7 +1,7 @@ {-# LANGUAGE PolyKinds, GADTs #-} -module Dep2 where +module T13391 where data G (a :: k) where - G1 :: G Int - G2 :: G Maybe + GInt :: G Int + GMaybe :: G Maybe diff --git a/testsuite/tests/polykinds/T13391.stderr b/testsuite/tests/polykinds/T13391.stderr new file mode 100644 index 0000000..55fff35 --- /dev/null +++ b/testsuite/tests/polykinds/T13391.stderr @@ -0,0 +1,7 @@ + +T13391.hs:6:3: error: + • Data constructor ‘GInt’ constrains the choice of kind parameter: + k ~ * + Use TypeInType to allow this + • In the definition of data constructor ‘GInt’ + In the data type declaration for ‘G’ diff --git a/testsuite/tests/polykinds/all.T b/testsuite/tests/polykinds/all.T index ddee253..376b5a9 100644 --- a/testsuite/tests/polykinds/all.T +++ b/testsuite/tests/polykinds/all.T @@ -164,3 +164,4 @@ test('T13555', normal, compile_fail, ['']) test('T13659', normal, compile_fail, ['']) test('T13625', normal, compile_fail, ['']) test('T14110', normal, compile_fail, ['']) +test('T13391', normal, compile_fail, ['']) From git at git.haskell.org Tue Aug 22 18:39:19 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 22 Aug 2017 18:39:19 +0000 (UTC) Subject: [commit: ghc] wip/rae: Regression test for #12742 (0991b49) Message-ID: <20170822183919.6CA8C3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/0991b49b10a79cc9401390dcdfec03afc261d807/ghc >--------------------------------------------------------------- commit 0991b49b10a79cc9401390dcdfec03afc261d807 Author: Richard Eisenberg Date: Tue Aug 15 14:52:53 2017 -0400 Regression test for #12742 Location: dependent/should_compile/T12742 >--------------------------------------------------------------- 0991b49b10a79cc9401390dcdfec03afc261d807 testsuite/tests/dependent/should_compile/T12742.hs | 11 +++++++++++ testsuite/tests/dependent/should_compile/all.T | 1 + 2 files changed, 12 insertions(+) diff --git a/testsuite/tests/dependent/should_compile/T12742.hs b/testsuite/tests/dependent/should_compile/T12742.hs new file mode 100644 index 0000000..baa3e2c --- /dev/null +++ b/testsuite/tests/dependent/should_compile/T12742.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE TypeInType, RankNTypes, TypeFamilies #-} + +module T12742 where + +import Data.Kind + +type family F :: forall k2. (k1, k2) + +data T :: (forall k2. (Bool, k2)) -> Type + +type S = T F diff --git a/testsuite/tests/dependent/should_compile/all.T b/testsuite/tests/dependent/should_compile/all.T index a135892..774cdce 100644 --- a/testsuite/tests/dependent/should_compile/all.T +++ b/testsuite/tests/dependent/should_compile/all.T @@ -26,3 +26,4 @@ test('T12442', normal, compile, ['']) test('T13538', normal, compile, ['']) test('T12176', normal, compile, ['']) test('T14038', expect_broken(14038), compile, ['']) +test('T12742', normal, compile, ['']) From git at git.haskell.org Tue Aug 22 18:39:22 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 22 Aug 2017 18:39:22 +0000 (UTC) Subject: [commit: ghc] wip/rae: Make rejigConRes do kind substitutions (ee34d32) Message-ID: <20170822183922.834E03A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/ee34d32746af917b677c236c1d5e7856b75433c4/ghc >--------------------------------------------------------------- commit ee34d32746af917b677c236c1d5e7856b75433c4 Author: Richard Eisenberg Date: Wed Aug 16 10:43:41 2017 -0400 Make rejigConRes do kind substitutions This was a lurking bug discovered on the hunt for #13910, but it doesn't fix that bug. The old version of rejigConRes was just wrong, forgetting to propagate a kind-change. >--------------------------------------------------------------- ee34d32746af917b677c236c1d5e7856b75433c4 compiler/typecheck/TcTyClsDecls.hs | 3 +- compiler/types/Type.hs | 3 +- testsuite/tests/dependent/should_compile/T13910.hs | 147 +++++++++++++++++++++ testsuite/tests/dependent/should_compile/all.T | 1 + 4 files changed, 152 insertions(+), 2 deletions(-) diff --git a/compiler/typecheck/TcTyClsDecls.hs b/compiler/typecheck/TcTyClsDecls.hs index 1409705..76a7b67 100644 --- a/compiler/typecheck/TcTyClsDecls.hs +++ b/compiler/typecheck/TcTyClsDecls.hs @@ -2165,7 +2165,8 @@ mkGADTVars tmpl_tvs dc_tvs subst -- not a simple substitution. make an equality predicate _ -> choose (t_tv':univs) (mkEqSpec t_tv' r_ty : eqs) - t_sub r_sub t_tvs + (extendTvSubst t_sub t_tv (mkTyVarTy t_tv')) + r_sub t_tvs where t_tv' = updateTyVarKind (substTy t_sub) t_tv | otherwise diff --git a/compiler/types/Type.hs b/compiler/types/Type.hs index f43e0e0..49e12ba 100644 --- a/compiler/types/Type.hs +++ b/compiler/types/Type.hs @@ -1121,7 +1121,8 @@ repSplitTyConApp_maybe (FunTy arg res) = Just (funTyCon, [rep1, rep2, arg, res]) | otherwise = pprPanic "repSplitTyConApp_maybe" - (ppr arg $$ ppr res $$ ppr (typeKind res)) + (ppr arg <+> dcolon <+> ppr (typeKind arg) $$ + ppr res <+> dcolon <+> ppr (typeKind res)) repSplitTyConApp_maybe _ = Nothing -- | Attempts to tease a list type apart and gives the type of the elements if diff --git a/testsuite/tests/dependent/should_compile/T13910.hs b/testsuite/tests/dependent/should_compile/T13910.hs new file mode 100644 index 0000000..82d47e4 --- /dev/null +++ b/testsuite/tests/dependent/should_compile/T13910.hs @@ -0,0 +1,147 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE Trustworthy #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilyDependencies #-} +{-# LANGUAGE TypeInType #-} +{-# LANGUAGE TypeOperators #-} +module T13910 where + +import Data.Kind +import Data.Type.Equality + +data family Sing (a :: k) + +class SingKind k where + type Demote k = (r :: *) | r -> k + fromSing :: Sing (a :: k) -> Demote k + toSing :: Demote k -> SomeSing k + +data SomeSing k where + SomeSing :: Sing (a :: k) -> SomeSing k + +withSomeSing :: forall k r + . SingKind k + => Demote k + -> (forall (a :: k). Sing a -> r) + -> r +withSomeSing x f = + case toSing x of + SomeSing x' -> f x' + +data TyFun :: * -> * -> * +type a ~> b = TyFun a b -> * +infixr 0 ~> + +type family Apply (f :: k1 ~> k2) (x :: k1) :: k2 +type a @@ b = Apply a b +infixl 9 @@ + +data FunArrow = (:->) | (:~>) + +class FunType (arr :: FunArrow) where + type Fun (k1 :: Type) arr (k2 :: Type) :: Type + +class FunType arr => AppType (arr :: FunArrow) where + type App k1 arr k2 (f :: Fun k1 arr k2) (x :: k1) :: k2 + +type FunApp arr = (FunType arr, AppType arr) + +instance FunType (:->) where + type Fun k1 (:->) k2 = k1 -> k2 + +$(return []) -- This is only necessary for GHC 8.0 -- GHC 8.2 is smarter + +instance AppType (:->) where + type App k1 (:->) k2 (f :: k1 -> k2) x = f x + +instance FunType (:~>) where + type Fun k1 (:~>) k2 = k1 ~> k2 + +$(return []) + +instance AppType (:~>) where + type App k1 (:~>) k2 (f :: k1 ~> k2) x = f @@ x + +infixr 0 -?> +type (-?>) (k1 :: Type) (k2 :: Type) (arr :: FunArrow) = Fun k1 arr k2 + +data instance Sing (z :: a :~: b) where + SRefl :: Sing Refl + +instance SingKind (a :~: b) where + type Demote (a :~: b) = a :~: b + fromSing SRefl = Refl + toSing Refl = SomeSing SRefl + +(~>:~:) :: forall (k :: Type) (a :: k) (b :: k) (r :: a :~: b) (p :: forall (y :: k). a :~: y ~> Type). + Sing r + -> p @@ Refl + -> p @@ r +(~>:~:) SRefl pRefl = pRefl + +type WhyReplacePoly (arr :: FunArrow) (from :: t) (p :: (t -?> Type) arr) + (y :: t) (e :: from :~: y) = App t arr Type p y +data WhyReplacePolySym (arr :: FunArrow) (from :: t) (p :: (t -?> Type) arr) + :: forall (y :: t). from :~: y ~> Type +type instance Apply (WhyReplacePolySym arr from p :: from :~: y ~> Type) x + = WhyReplacePoly arr from p y x + +replace :: forall (t :: Type) (from :: t) (to :: t) (p :: t -> Type). + p from + -> from :~: to + -> p to +replace = replacePoly @(:->) + +replaceTyFun :: forall (t :: Type) (from :: t) (to :: t) (p :: t ~> Type). + p @@ from + -> from :~: to + -> p @@ to +replaceTyFun = replacePoly @(:~>) @_ @_ @_ @p + +replacePoly :: forall (arr :: FunArrow) (t :: Type) (from :: t) (to :: t) + (p :: (t -?> Type) arr). + FunApp arr + => App t arr Type p from + -> from :~: to + -> App t arr Type p to +replacePoly from eq = + withSomeSing eq $ \(singEq :: Sing r) -> + (~>:~:) @t @from @to @r @(WhyReplacePolySym arr from p) singEq from + +type WhyLeibnizPoly (arr :: FunArrow) (f :: (t -?> Type) arr) (a :: t) (z :: t) + = App t arr Type f a -> App t arr Type f z +data WhyLeibnizPolySym (arr :: FunArrow) (f :: (t -?> Type) arr) (a :: t) + :: t ~> Type +type instance Apply (WhyLeibnizPolySym arr f a) z = WhyLeibnizPoly arr f a z + +leibnizPoly :: forall (arr :: FunArrow) (t :: Type) (f :: (t -?> Type) arr) + (a :: t) (b :: t). + FunApp arr + => a :~: b + -> App t arr Type f a + -> App t arr Type f b +leibnizPoly = replaceTyFun @t @a @b @(WhyLeibnizPolySym arr f a) id + +leibniz :: forall (t :: Type) (f :: t -> Type) (a :: t) (b :: t). + a :~: b + -> f a + -> f b +leibniz = replaceTyFun @t @a @b @(WhyLeibnizPolySym (:->) f a) id +-- The line above is what you get if you inline the definition of leibnizPoly. +-- It causes a panic, however. +-- +-- An equivalent implementation is commented out below, which does *not* +-- cause GHC to panic. +-- +-- leibniz = leibnizPoly @(:->) + +leibnizTyFun :: forall (t :: Type) (f :: t ~> Type) (a :: t) (b :: t). + a :~: b + -> f @@ a + -> f @@ b +leibnizTyFun = leibnizPoly @(:~>) @_ @f diff --git a/testsuite/tests/dependent/should_compile/all.T b/testsuite/tests/dependent/should_compile/all.T index 774cdce..bb21df7 100644 --- a/testsuite/tests/dependent/should_compile/all.T +++ b/testsuite/tests/dependent/should_compile/all.T @@ -27,3 +27,4 @@ test('T13538', normal, compile, ['']) test('T12176', normal, compile, ['']) test('T14038', expect_broken(14038), compile, ['']) test('T12742', normal, compile, ['']) +test('T13910', expect_broken(13910), compile, ['']) From git at git.haskell.org Tue Aug 22 18:39:26 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 22 Aug 2017 18:39:26 +0000 (UTC) Subject: [commit: ghc] wip/rae: Fix #13929 by adding another levity polymorphism check (63b35af) Message-ID: <20170822183926.0D38F3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/63b35af16b1e8d216ec1ffc480c333829b015292/ghc >--------------------------------------------------------------- commit 63b35af16b1e8d216ec1ffc480c333829b015292 Author: Richard Eisenberg Date: Wed Aug 16 11:35:26 2017 -0400 Fix #13929 by adding another levity polymorphism check test case: typecheck/should_fail/T13929 >--------------------------------------------------------------- 63b35af16b1e8d216ec1ffc480c333829b015292 compiler/deSugar/DsExpr.hs | 9 +++--- testsuite/tests/typecheck/should_compile/all.T | 1 + testsuite/tests/typecheck/should_fail/T13929.hs | 32 ++++++++++++++++++++++ .../tests/typecheck/should_fail/T13929.stderr | 12 ++++++++ testsuite/tests/typecheck/should_fail/all.T | 1 + 5 files changed, 50 insertions(+), 5 deletions(-) diff --git a/compiler/deSugar/DsExpr.hs b/compiler/deSugar/DsExpr.hs index 048d558..853c42d 100644 --- a/compiler/deSugar/DsExpr.hs +++ b/compiler/deSugar/DsExpr.hs @@ -368,14 +368,13 @@ ds_expr _ (ExplicitTuple tup_args boxity) go (lam_vars, args) (L _ (Present expr)) -- Expressions that are present don't generate -- lambdas, just arguments. - = do { core_expr <- dsLExpr expr + = do { core_expr <- dsLExprNoLP expr ; return (lam_vars, core_expr : args) } - ; (lam_vars, args) <- foldM go ([], []) (reverse tup_args) + ; dsWhenNoErrs (foldM go ([], []) (reverse tup_args)) -- The reverse is because foldM goes left-to-right - - ; return $ mkCoreLams lam_vars $ - mkCoreTupBoxity boxity args } + (\(lam_vars, args) -> mkCoreLams lam_vars $ + mkCoreTupBoxity boxity args) } ds_expr _ (ExplicitSum alt arity expr types) = do { core_expr <- dsLExpr expr diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index f522b74..bb764db 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -571,3 +571,4 @@ test('T13881', normal, compile, ['']) test('T13915a', normal, multimod_compile, ['T13915a', '-v0']) test('T13915b', normal, compile, ['']) test('T13984', normal, compile, ['']) +test('T13643', normal, compile, ['']) diff --git a/testsuite/tests/typecheck/should_fail/T13929.hs b/testsuite/tests/typecheck/should_fail/T13929.hs new file mode 100644 index 0000000..f0a026d --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T13929.hs @@ -0,0 +1,32 @@ +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeInType #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DefaultSignatures #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE AllowAmbiguousTypes #-} + +module Main where + +import GHC.Exts +import Data.Kind +import GHC.Generics + +class GUnbox (f :: Type -> Type) (r :: RuntimeRep) where + type GUnboxed f r :: TYPE r + gunbox :: f p -> GUnboxed f r + +instance (GUnbox f rf, GUnbox g rg) => GUnbox (f :*: g) ('TupleRep '[rf, rg]) where + type GUnboxed (f :*: g) ('TupleRep '[rf, rg]) = (# GUnboxed f rf, GUnboxed g rg #) + -- if I remove implementation of `gunbox` it compiles successfully + gunbox (x :*: y) = (# gunbox x, gunbox y #) + +main :: IO () +main = pure () diff --git a/testsuite/tests/typecheck/should_fail/T13929.stderr b/testsuite/tests/typecheck/should_fail/T13929.stderr new file mode 100644 index 0000000..3ddf5b3 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T13929.stderr @@ -0,0 +1,12 @@ + +T13929.hs:29:27: error: + A levity-polymorphic type is not allowed here: + Type: GUnboxed f rf + Kind: TYPE rf + In the type of expression: gunbox x + +T13929.hs:29:37: error: + A levity-polymorphic type is not allowed here: + Type: GUnboxed g rg + Kind: TYPE rg + In the type of expression: gunbox y diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T index d07cb11..67cdc5f 100644 --- a/testsuite/tests/typecheck/should_fail/all.T +++ b/testsuite/tests/typecheck/should_fail/all.T @@ -456,3 +456,4 @@ test('T11963', normal, compile_fail, ['']) test('T14000', normal, compile_fail, ['']) test('T14055', normal, compile_fail, ['']) test('T13909', normal, compile_fail, ['']) +test('T13929', normal, compile_fail, ['']) From git at git.haskell.org Tue Aug 22 18:39:29 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 22 Aug 2017 18:39:29 +0000 (UTC) Subject: [commit: ghc] wip/rae: Test #13938, with expect_broken (8c3ba69) Message-ID: <20170822183929.191493A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/8c3ba698271d316c68a5f318a82cbd52cca783dd/ghc >--------------------------------------------------------------- commit 8c3ba698271d316c68a5f318a82cbd52cca783dd Author: Richard Eisenberg Date: Wed Aug 16 11:49:49 2017 -0400 Test #13938, with expect_broken test case: dependent/should_compile/T13938 >--------------------------------------------------------------- 8c3ba698271d316c68a5f318a82cbd52cca783dd testsuite/tests/dependent/should_compile/{T14038.hs => T13938.hs} | 7 ++++++- testsuite/tests/dependent/should_compile/all.T | 1 + 2 files changed, 7 insertions(+), 1 deletion(-) diff --git a/testsuite/tests/dependent/should_compile/T14038.hs b/testsuite/tests/dependent/should_compile/T13938.hs similarity index 94% copy from testsuite/tests/dependent/should_compile/T14038.hs copy to testsuite/tests/dependent/should_compile/T13938.hs index 839220a..3ba9e27 100644 --- a/testsuite/tests/dependent/should_compile/T14038.hs +++ b/testsuite/tests/dependent/should_compile/T13938.hs @@ -4,11 +4,12 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeInType #-} {-# LANGUAGE TypeOperators #-} -module T14038 where +module T13938 where import Data.Kind (Type) @@ -39,12 +40,16 @@ type FunApp arr = (FunType arr, AppType arr) instance FunType (:->) where type Fun k1 (:->) k2 = k1 -> k2 +$(return []) -- This is only necessary for GHC 8.0 -- GHC 8.2 is smarter + instance AppType (:->) where type App k1 (:->) k2 (f :: k1 -> k2) x = f x instance FunType (:~>) where type Fun k1 (:~>) k2 = k1 ~> k2 +$(return []) + instance AppType (:~>) where type App k1 (:~>) k2 (f :: k1 ~> k2) x = f @@ x diff --git a/testsuite/tests/dependent/should_compile/all.T b/testsuite/tests/dependent/should_compile/all.T index bb21df7..a120bec 100644 --- a/testsuite/tests/dependent/should_compile/all.T +++ b/testsuite/tests/dependent/should_compile/all.T @@ -28,3 +28,4 @@ test('T12176', normal, compile, ['']) test('T14038', expect_broken(14038), compile, ['']) test('T12742', normal, compile, ['']) test('T13910', expect_broken(13910), compile, ['']) +test('T13938', normal, compile, ['']) From git at git.haskell.org Tue Aug 22 18:39:31 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 22 Aug 2017 18:39:31 +0000 (UTC) Subject: [commit: ghc] wip/rae: Clarify 13963 (fbb9aa7) Message-ID: <20170822183931.DBC7E3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/fbb9aa7a5d08a6b65c5294247c7c69a8014cfaf8/ghc >--------------------------------------------------------------- commit fbb9aa7a5d08a6b65c5294247c7c69a8014cfaf8 Author: Richard Eisenberg Date: Fri Aug 18 15:56:55 2017 -0400 Clarify 13963 >--------------------------------------------------------------- fbb9aa7a5d08a6b65c5294247c7c69a8014cfaf8 compiler/typecheck/TcHsType.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/compiler/typecheck/TcHsType.hs b/compiler/typecheck/TcHsType.hs index 162c904..fd8592a 100644 --- a/compiler/typecheck/TcHsType.hs +++ b/compiler/typecheck/TcHsType.hs @@ -1791,6 +1791,8 @@ tcTyClTyVars tycon_name thing_inside -- type Syn k = forall (a :: k). Proxy a -- At first, it looks like k should be named -- after all, it appears on the RHS. -- However, the correct kind for Syn is (* -> *). + -- (Why? Because k is the kind of a type, so k's kind is *. And the RHS also has + -- kind *.) See also #13963. correct_binders :: [TyConBinder] -> Kind -> [TyConBinder] correct_binders binders kind = binders' From git at git.haskell.org Tue Aug 22 18:39:35 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 22 Aug 2017 18:39:35 +0000 (UTC) Subject: [commit: ghc] wip/rae: Fix #13963. (1cf8d52) Message-ID: <20170822183935.558B73A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/1cf8d52e3fa55dc9bf1606a9b69e8fb88dc124ed/ghc >--------------------------------------------------------------- commit 1cf8d52e3fa55dc9bf1606a9b69e8fb88dc124ed Author: Richard Eisenberg Date: Wed Aug 16 14:33:06 2017 -0400 Fix #13963. This commit fixes several things: 1. RuntimeRep arg suppression was overeager for *visibly*-quantified RuntimeReps, which should remain. 2. The choice of whether to used a Named TyConBinder or an anonymous was sometimes wrong. Now, we do an extra little pass right before constructing the tycon to fix these. 3. TyCons that normally cannot appear unsaturated can appear unsaturated in :kind. But this fact was not propagated into the type checker. It now is. >--------------------------------------------------------------- 1cf8d52e3fa55dc9bf1606a9b69e8fb88dc124ed compiler/iface/IfaceType.hs | 4 +- compiler/typecheck/TcHsType.hs | 61 ++++++++++++++++++++++++++---- compiler/typecheck/TcRnDriver.hs | 2 +- testsuite/tests/ghci/scripts/T13963.script | 9 +++++ testsuite/tests/ghci/scripts/T13963.stdout | 4 ++ testsuite/tests/ghci/scripts/all.T | 1 + 6 files changed, 71 insertions(+), 10 deletions(-) diff --git a/compiler/iface/IfaceType.hs b/compiler/iface/IfaceType.hs index c7405b3..684fc9c 100644 --- a/compiler/iface/IfaceType.hs +++ b/compiler/iface/IfaceType.hs @@ -677,11 +677,13 @@ defaultRuntimeRepVars = go emptyFsEnv go :: FastStringEnv () -> IfaceType -> IfaceType go subs (IfaceForAllTy bndr ty) | isRuntimeRep var_kind + , isInvisibleArgFlag (binderArgFlag bndr) -- don't default *visible* quantification + -- or we get the mess in #13963 = let subs' = extendFsEnv subs var () in go subs' ty | otherwise = IfaceForAllTy (TvBndr (var, go subs var_kind) (binderArgFlag bndr)) - (go subs ty) + (go subs ty) where var :: IfLclName (var, var_kind) = binderVar bndr diff --git a/compiler/typecheck/TcHsType.hs b/compiler/typecheck/TcHsType.hs index 6e2720b..162c904 100644 --- a/compiler/typecheck/TcHsType.hs +++ b/compiler/typecheck/TcHsType.hs @@ -30,7 +30,7 @@ module TcHsType ( kcHsTyVarBndrs, tcHsLiftedType, tcHsOpenType, tcHsLiftedTypeNC, tcHsOpenTypeNC, - tcLHsType, tcCheckLHsType, + tcLHsType, tcLHsTypeUnsaturated, tcCheckLHsType, tcHsContext, tcLHsPredType, tcInferApps, tcTyApps, solveEqualities, -- useful re-export @@ -86,7 +86,7 @@ import PrelNames hiding ( wildCardName ) import qualified GHC.LanguageExtensions as LangExt import Maybes -import Data.List ( partition, zipWith4 ) +import Data.List ( partition, zipWith4, mapAccumR ) import Control.Monad {- @@ -331,6 +331,13 @@ tcLHsType :: LHsType GhcRn -> TcM (TcType, TcKind) -- Called from outside: set the context tcLHsType ty = addTypeCtxt ty (tc_infer_lhs_type typeLevelMode ty) +-- Like tcLHsType, but use it in a context where type synonyms and type families +-- do not need to be saturated, like in a GHCi :kind call +tcLHsTypeUnsaturated :: LHsType GhcRn -> TcM (TcType, TcKind) +tcLHsTypeUnsaturated ty = addTypeCtxt ty (tc_infer_lhs_type mode ty) + where + mode = allowUnsaturated typeLevelMode + --------------------------- -- | Should we generalise the kind of this type signature? -- We *should* generalise if the type is closed @@ -390,15 +397,21 @@ concern things that the renamer can't handle. -- differentiates only between types and kinds, but this will likely -- grow, at least to include the distinction between patterns and -- not-patterns. -newtype TcTyMode - = TcTyMode { mode_level :: TypeOrKind -- True <=> type, False <=> kind +data TcTyMode + = TcTyMode { mode_level :: TypeOrKind + , mode_unsat :: Bool -- True <=> allow unsaturated type families } + -- The mode_unsat field is solely so that type families/synonyms can be unsaturated + -- in GHCi :kind calls typeLevelMode :: TcTyMode -typeLevelMode = TcTyMode { mode_level = TypeLevel } +typeLevelMode = TcTyMode { mode_level = TypeLevel, mode_unsat = False } kindLevelMode :: TcTyMode -kindLevelMode = TcTyMode { mode_level = KindLevel } +kindLevelMode = TcTyMode { mode_level = KindLevel, mode_unsat = False } + +allowUnsaturated :: TcTyMode -> TcTyMode +allowUnsaturated mode = mode { mode_unsat = True } -- switch to kind level kindLevel :: TcTyMode -> TcTyMode @@ -1036,7 +1049,8 @@ tcTyVar mode name -- Could be a tyvar, a tycon, or a datacon -> TcTyCon -- a non-loopy version of the tycon -> TcM (TcType, TcKind) handle_tyfams tc tc_tc - | mightBeUnsaturatedTyCon tc_tc + | mightBeUnsaturatedTyCon tc_tc || mode_unsat mode + -- This is where mode_unsat is used = do { traceTc "tcTyVar2a" (ppr tc_tc $$ ppr tc_kind) ; return (ty, tc_kind) } @@ -1758,8 +1772,8 @@ tcTyClTyVars tycon_name thing_inside ; let scoped_tvs = tcTyConScopedTyVars tycon -- these are all zonked: - binders = tyConBinders tycon res_kind = tyConResKind tycon + binders = correct_binders (tyConBinders tycon) res_kind -- See Note [Free-floating kind vars] ; zonked_scoped_tvs <- mapM zonkTcTyVarToTyVar scoped_tvs @@ -1771,6 +1785,37 @@ tcTyClTyVars tycon_name thing_inside -- are the ones mentioned in the source. ; tcExtendTyVarEnv scoped_tvs $ thing_inside binders res_kind } + where + -- Given some TyConBinders and a TyCon's result kind, make sure that the + -- correct any wrong Named/Anon choices. For example, consider + -- type Syn k = forall (a :: k). Proxy a + -- At first, it looks like k should be named -- after all, it appears on the RHS. + -- However, the correct kind for Syn is (* -> *). + correct_binders :: [TyConBinder] -> Kind -> [TyConBinder] + correct_binders binders kind + = binders' + where + (_, binders') = mapAccumR go (tyCoVarsOfType kind) binders + + go :: TyCoVarSet -> TyConBinder -> (TyCoVarSet, TyConBinder) + go fvs binder + | isNamedTyConBinder binder + , not (tv `elemVarSet` fvs) + = (new_fvs, mkAnonTyConBinder tv) + + | not (isNamedTyConBinder binder) + , tv `elemVarSet` fvs + = (new_fvs, mkNamedTyConBinder Required tv) + -- always Required, because it was anonymous (i.e. visible) previously + + | otherwise + = (new_fvs, binder) + + where + tv = binderVar binder + new_fvs = fvs `delVarSet` tv `unionVarSet` tyCoVarsOfType (tyVarKind tv) + + ----------------------------------- tcDataKindSig :: Bool -- ^ Do we require the result to be *? diff --git a/compiler/typecheck/TcRnDriver.hs b/compiler/typecheck/TcRnDriver.hs index 8189a78..7face41 100644 --- a/compiler/typecheck/TcRnDriver.hs +++ b/compiler/typecheck/TcRnDriver.hs @@ -2255,7 +2255,7 @@ tcRnType hsc_env normalise rdr_type ; traceTc "tcRnType" (vcat [ppr wcs, ppr rn_type]) ; (ty, kind) <- solveEqualities $ tcWildCardBinders wcs $ \ _ -> - tcLHsType rn_type + tcLHsTypeUnsaturated rn_type -- Do kind generalisation; see Note [Kind-generalise in tcRnType] ; kvs <- kindGeneralize kind diff --git a/testsuite/tests/ghci/scripts/T13963.script b/testsuite/tests/ghci/scripts/T13963.script new file mode 100644 index 0000000..630e5cd --- /dev/null +++ b/testsuite/tests/ghci/scripts/T13963.script @@ -0,0 +1,9 @@ +:set -XTypeInType -XRankNTypes +import GHC.Exts (TYPE, RuntimeRep(LiftedRep)) +type Pair (a :: TYPE rep) (b :: TYPE rep') rep'' = forall (r :: TYPE rep''). (a -> b -> r) +:kind Pair +:kind Pair Int +:kind Pair Int Float +:kind Pair Int Float LiftedRep + + diff --git a/testsuite/tests/ghci/scripts/T13963.stdout b/testsuite/tests/ghci/scripts/T13963.stdout new file mode 100644 index 0000000..9e31d8b --- /dev/null +++ b/testsuite/tests/ghci/scripts/T13963.stdout @@ -0,0 +1,4 @@ +Pair :: TYPE rep -> TYPE rep' -> RuntimeRep -> * +Pair Int :: * -> RuntimeRep -> * +Pair Int Float :: RuntimeRep -> * +Pair Int Float LiftedRep :: * diff --git a/testsuite/tests/ghci/scripts/all.T b/testsuite/tests/ghci/scripts/all.T index 7d33758..48dc864 100755 --- a/testsuite/tests/ghci/scripts/all.T +++ b/testsuite/tests/ghci/scripts/all.T @@ -257,3 +257,4 @@ test('GhciCurDir', normal, ghci_script, ['GhciCurDir.script']) test('T13591', expect_broken(13591), ghci_script, ['T13591.script']) test('T13699', normal, ghci_script, ['T13699.script']) test('T13407', normal, ghci_script, ['T13407.script']) +test('T13963', normal, ghci_script, ['T13963.script']) From git at git.haskell.org Tue Aug 22 18:39:38 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 22 Aug 2017 18:39:38 +0000 (UTC) Subject: [commit: ghc] wip/rae: Clarify comments about egregious error (7443211) Message-ID: <20170822183938.27A263A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/7443211093b312df186175b19b4737a75b1c46aa/ghc >--------------------------------------------------------------- commit 7443211093b312df186175b19b4737a75b1c46aa Author: Richard Eisenberg Date: Fri Aug 18 16:35:54 2017 -0400 Clarify comments about egregious error >--------------------------------------------------------------- 7443211093b312df186175b19b4737a75b1c46aa compiler/rename/RnTypes.hs | 27 +++++++++++++++++++++++++++ 1 file changed, 27 insertions(+) diff --git a/compiler/rename/RnTypes.hs b/compiler/rename/RnTypes.hs index df9ded2..2580702 100644 --- a/compiler/rename/RnTypes.hs +++ b/compiler/rename/RnTypes.hs @@ -1536,8 +1536,34 @@ In general we want to walk over a type, and find Hence we returns a pair (kind-vars, type vars) See also Note [HsBSig binder lists] in HsTypes + +Most clients of this code just want to know the kind/type vars, without +duplicates. The function rmDupsInRdrTyVars removes duplicates. That function +also makes sure that no variable is reported as both a kind var and +a type var, preferring kind vars. Why kind vars? Consider this: + + foo :: forall (a :: k). Proxy k -> Proxy a -> ... + +Should that be accepted? + +Normally, if a type signature has an explicit forall, it must list *all* +tyvars mentioned in the type. But there's an exception for tyvars mentioned in +a kind, as k is above. Note that k is also used "as a type variable", as the +argument to the first Proxy. So, do we consider k to be type-variable-like and +require it in the forall? Or do we consider k to be kind-variable-like and not +require it? + +It's not just in type signatures: kind variables are implicitly brought into +scope in a variety of places. Should vars used at both the type level and kind +level be treated this way? + +GHC indeed allows kind variables to be brought into scope implicitly even when +the kind variable is also used as a type variable. Thus, we must prefer to keep +a variable listed as a kind var in rmDupsInRdrTyVars. + -} +-- See Note [Kind and type-variable binders] data FreeKiTyVars = FKTV { fktv_kis :: [Located RdrName] , fktv_tys :: [Located RdrName] } @@ -1594,6 +1620,7 @@ extractHsTysRdrTyVarsDups tys = extract_ltys TypeLevel tys emptyFKTV -- | Removes multiple occurrences of the same name from FreeKiTyVars. +-- See also Note [Kind and type-variable binders] rmDupsInRdrTyVars :: FreeKiTyVars -> FreeKiTyVars rmDupsInRdrTyVars (FKTV kis tys) = FKTV kis' tys' From git at git.haskell.org Tue Aug 22 18:39:40 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 22 Aug 2017 18:39:40 +0000 (UTC) Subject: [commit: ghc] wip/rae: Update .travis.yml to bootstrap with GHC 8.0.2 (e6a2e07) Message-ID: <20170822183940.DEA433A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/e6a2e07d9a5be91f369df0d9b36b7e74ccb2d134/ghc >--------------------------------------------------------------- commit e6a2e07d9a5be91f369df0d9b36b7e74ccb2d134 Author: Richard Eisenberg Date: Tue Aug 22 14:36:30 2017 -0400 Update .travis.yml to bootstrap with GHC 8.0.2 >--------------------------------------------------------------- e6a2e07d9a5be91f369df0d9b36b7e74ccb2d134 .travis.yml | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/.travis.yml b/.travis.yml index 218f5ba..79c5b66 100644 --- a/.travis.yml +++ b/.travis.yml @@ -17,15 +17,15 @@ addons: #- llvm-toolchain-precise-3.7 - ubuntu-toolchain-r-test packages: - - cabal-install-1.18 - - ghc-7.10.3 - - alex-3.1.3 + - cabal-install-1.24 + - ghc-8.0.2 + - alex-3.1.7 - happy-1.19.4 - python3 #- llvm-3.7 before_install: - - export PATH=/opt/ghc/7.10.3/bin:/opt/cabal/1.18/bin:/opt/alex/3.1.3/bin:/opt/happy/1.19.4/bin:/usr/lib/llvm-3.7/bin:$PATH + - export PATH=/opt/ghc/8.0.2/bin:/opt/cabal/1.24/bin:/opt/alex/3.1.7/bin:/opt/happy/1.19.4/bin:/usr/lib/llvm-3.7/bin:$PATH # Be explicit about which protocol to use, such that we don't have to repeat the rewrite command for each. - git config remote.origin.url git://github.com/${TRAVIS_REPO_SLUG}.git From git at git.haskell.org Tue Aug 22 18:39:44 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 22 Aug 2017 18:39:44 +0000 (UTC) Subject: [commit: ghc] wip/rae: Fix egregious duplication of vars in RnTypes (288427c) Message-ID: <20170822183944.4B0033A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/rae Link : http://ghc.haskell.org/trac/ghc/changeset/288427cb70f8ca72a73a2de7fb6e6b22574558a8/ghc >--------------------------------------------------------------- commit 288427cb70f8ca72a73a2de7fb6e6b22574558a8 Author: Richard Eisenberg Date: Wed Aug 16 15:07:16 2017 -0400 Fix egregious duplication of vars in RnTypes RnTypes contains a fairly intricate algorith to extract the kind and type variables of an HsType. This algorithm carefully maintains the separation between type variables and kind variables so that the difference between -XPolyKinds and -XTypeInType can be respected. But it stupidly just concatenated the lists at the end. If a variable were used as both a type and a kind, the algorithm would produce *both*! This led to all kinds of problems, including #13988. test case: ghci/scripts/T13988 >--------------------------------------------------------------- 288427cb70f8ca72a73a2de7fb6e6b22574558a8 compiler/rename/RnTypes.hs | 11 ++++++----- testsuite/tests/ghci/scripts/T13988.hs | 8 ++++++++ testsuite/tests/ghci/scripts/T13988.script | 2 ++ testsuite/tests/ghci/scripts/T13988.stdout | 1 + testsuite/tests/ghci/scripts/all.T | 1 + 5 files changed, 18 insertions(+), 5 deletions(-) diff --git a/compiler/rename/RnTypes.hs b/compiler/rename/RnTypes.hs index cfe1517..df9ded2 100644 --- a/compiler/rename/RnTypes.hs +++ b/compiler/rename/RnTypes.hs @@ -1575,10 +1575,8 @@ extractHsTyRdrTyVars :: LHsType GhcPs -> RnM FreeKiTyVars -- occurrence is returned. -- See Note [Kind and type-variable binders] extractHsTyRdrTyVars ty - = do { FKTV kis tys <- extract_lty TypeLevel ty emptyFKTV - ; return (FKTV (nubL kis) - (nubL tys)) } - + = do { fvs <- extract_lty TypeLevel ty emptyFKTV + ; return (rmDupsInRdrTyVars fvs) } -- | Extracts free type and kind variables from types in a list. -- When the same name occurs multiple times in the types, only the first @@ -1598,7 +1596,10 @@ extractHsTysRdrTyVarsDups tys -- | Removes multiple occurrences of the same name from FreeKiTyVars. rmDupsInRdrTyVars :: FreeKiTyVars -> FreeKiTyVars rmDupsInRdrTyVars (FKTV kis tys) - = FKTV (nubL kis) (nubL tys) + = FKTV kis' tys' + where + kis' = nubL kis + tys' = nubL (filterOut (`elemRdr` kis') tys) extractRdrKindSigVars :: LFamilyResultSig GhcPs -> RnM [Located RdrName] extractRdrKindSigVars (L _ resultSig) diff --git a/testsuite/tests/ghci/scripts/T13988.hs b/testsuite/tests/ghci/scripts/T13988.hs new file mode 100644 index 0000000..54969ca --- /dev/null +++ b/testsuite/tests/ghci/scripts/T13988.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE TypeInType, GADTs #-} + +module T13988 where + +import Data.Kind + +data Foo (a :: k) where + MkFoo :: (k ~ Type) => Foo (a :: k) diff --git a/testsuite/tests/ghci/scripts/T13988.script b/testsuite/tests/ghci/scripts/T13988.script new file mode 100644 index 0000000..06aa686 --- /dev/null +++ b/testsuite/tests/ghci/scripts/T13988.script @@ -0,0 +1,2 @@ +:load T13988 +:type +v MkFoo diff --git a/testsuite/tests/ghci/scripts/T13988.stdout b/testsuite/tests/ghci/scripts/T13988.stdout new file mode 100644 index 0000000..a89ff33 --- /dev/null +++ b/testsuite/tests/ghci/scripts/T13988.stdout @@ -0,0 +1 @@ +MkFoo :: forall k (a :: k). (k ~ *) => Foo a diff --git a/testsuite/tests/ghci/scripts/all.T b/testsuite/tests/ghci/scripts/all.T index 48dc864..bbb9110 100755 --- a/testsuite/tests/ghci/scripts/all.T +++ b/testsuite/tests/ghci/scripts/all.T @@ -258,3 +258,4 @@ test('T13591', expect_broken(13591), ghci_script, ['T13591.script']) test('T13699', normal, ghci_script, ['T13699.script']) test('T13407', normal, ghci_script, ['T13407.script']) test('T13963', normal, ghci_script, ['T13963.script']) +test('T13988', normal, ghci_script, ['T13988.script']) From git at git.haskell.org Tue Aug 22 18:39:46 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 22 Aug 2017 18:39:46 +0000 (UTC) Subject: [commit: ghc] wip/rae's head updated: Update .travis.yml to bootstrap with GHC 8.0.2 (e6a2e07) Message-ID: <20170822183946.BDD993A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/rae' now includes: a8da0de Speed up compilation of profiling stubs b0ed07f Allow TcDerivInfer to compile with GHC 8.0.1 38260a9 Fix #13972 by producing tidier errors 039fa1b Suggest how to fix illegally nested foralls in GADT constructor type signatures c948b78 Fix #11785 by making reifyKind = reifyType af9f3fa Remove extra ` from "kind-indexed GADTs" doc 03327bf Handle ListPat in isStrictPattern 36d1b08 Doctest for Void.absurd 49ddea9 Sections with undefined operators have non-standard behavior 43b0c2c Insert missing blank line to fix Applicative doc 63397cb Add some Monoid doctests f762181 Mention the category laws explicitly a30187d Convert documentation examples to doctests for ReadP module bfa9048 Loads of doc(test)s 2c0ab47 Add missing initial version for extension doc. 0e1b6f8 Fix index entries in "separate compilation" section 3385669 user-guide: fix examples of ghci commands 69a0f01 rts: Enable USDT probes object on Linux 82ee71f user-guide: add `:type +d` and `:type +v` in release highlight dc42c0d Fix #13399 by documenting higher-rank kinds. 0385347 Remove unneeded reqlibs for mtl and parsec in the GHC testsuite c5605ae Make function intToSBigNat# preserve sign (fixes #14085) 0286214 testsuite: Add test for #13916 fee253f CSE.cseOneExpr: Set InScopeSet correctly 6257fb5 Comments about GlobalRdrEnv shadowing 118efb0 Restrict Lint's complaints about recursive INLINEs somewhat 698adb5 Tracing in OccAnal (commented out) 4c6fcd7 Comments only 61c4246 Test Trac #14110 f50e30e Doctests for Data.Tuple 6267d8c Enable -Wcpp-undef for GHC and runtime system cf8ab1c users_guide: Convert mkUserGuidePart generation to a Sphinx extension 8e5b6ec Add strict variant of iterate ee2e9ec Correct incorrect free in PE linker 1cdceb9 Revert "Add strict variant of iterate" 34bd43d Fix loading of dlls on 32bit windows 6982ee9 Fix #14125 by normalizing data family instances more aggressively a89bb80 Fix #14114 by checking for duplicate vars on pattern synonym RHSes 79b259a Fix #13885 by freshening reified GADT constructors' universal tyvars 8476097 Revise function arity mismatch errors involving TypeApplications 8fd9599 Make the Read instance for Proxy (and friends) ignore precedence afc2f79 Move validate cleaning from distclean to clean 4717ce8 Fix incorrect retypecheck loop in -j (#14075) 9afaebe StgLint: Allow join point bindings of unlifted type cd5a970 Make law for Foldable.length explicit 20c7053 Bump haddock submodule 090d896 fix typo (expreesions -> expressions) 028645c Fixed a typo in template-haskell documentation 26f78d0 Test #14038 in dependent/should_compile/T14038 0991b49 Regression test for #12742 159294f Test #12938 in indexed-types/should_compile/T12938 56b0c7b Fix #13391 by checking for kind-GADTs 21b55c1 Fix #13407 by suppressing invisibles better. 9d92d5f Fix #13909 by tweaking an error message. ee34d32 Make rejigConRes do kind substitutions 63b35af Fix #13929 by adding another levity polymorphism check 8c3ba69 Test #13938, with expect_broken 1cf8d52 Fix #13963. 288427c Fix egregious duplication of vars in RnTypes fbb9aa7 Clarify 13963 7443211 Clarify comments about egregious error e6a2e07 Update .travis.yml to bootstrap with GHC 8.0.2 From git at git.haskell.org Tue Aug 22 22:02:06 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 22 Aug 2017 22:02:06 +0000 (UTC) Subject: [commit: ghc] master: Add support for producing position-independent executables (3625728) Message-ID: <20170822220206.14D4F3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3625728a0e3a9b56c2b85ae7ea8bcabdd83ece6a/ghc >--------------------------------------------------------------- commit 3625728a0e3a9b56c2b85ae7ea8bcabdd83ece6a Author: Ben Gamari Date: Tue Aug 22 11:41:47 2017 -0400 Add support for producing position-independent executables Previously due to #12759 we disabled PIE support entirely. However, this breaks the user's ability to produce PIEs. Add an explicit flag, -fPIE, allowing the user to build PIEs. Test Plan: Validate Reviewers: rwbarton, austin, simonmar Subscribers: trommler, simonmar, trofi, jrtc27, thomie GHC Trac Issues: #12759, #13702 Differential Revision: https://phabricator.haskell.org/D3589 >--------------------------------------------------------------- 3625728a0e3a9b56c2b85ae7ea8bcabdd83ece6a compiler/cmm/CmmPipeline.hs | 2 +- compiler/codeGen/StgCmmCon.hs | 4 ++-- compiler/main/DriverPipeline.hs | 10 ++++----- compiler/main/DynFlags.hs | 39 ++++++++++++++++++++++++++++++++--- compiler/main/SysTools.hs | 15 +------------- compiler/nativeGen/AsmCodeGen.hs | 6 +++--- compiler/nativeGen/PIC.hs | 33 +++++++++++++++-------------- compiler/nativeGen/PPC/CodeGen.hs | 6 +++--- compiler/nativeGen/SPARC/CodeGen.hs | 2 +- compiler/nativeGen/X86/CodeGen.hs | 4 ++-- docs/users_guide/phases.rst | 24 +++++++++++++++++++++ docs/users_guide/shared_libs.rst | 4 ++++ testsuite/tests/dynlibs/Makefile | 6 ++++++ testsuite/tests/dynlibs/T13702.hs | 9 ++++++++ testsuite/tests/dynlibs/T13702.stdout | 2 ++ testsuite/tests/dynlibs/T13702a.hs | 12 +++++++++++ testsuite/tests/dynlibs/all.T | 4 ++++ 17 files changed, 131 insertions(+), 51 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 3625728a0e3a9b56c2b85ae7ea8bcabdd83ece6a From git at git.haskell.org Tue Aug 22 22:02:08 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 22 Aug 2017 22:02:08 +0000 (UTC) Subject: [commit: ghc] master: DynFlags: Add inverse of -dno-debug-output (dbaa9a2) Message-ID: <20170822220208.D305B3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/dbaa9a237b6d9771c0e9bde0e50fd2134c2f4dd0/ghc >--------------------------------------------------------------- commit dbaa9a237b6d9771c0e9bde0e50fd2134c2f4dd0 Author: Ben Gamari Date: Tue Aug 22 11:40:51 2017 -0400 DynFlags: Add inverse of -dno-debug-output Reviewers: austin Subscribers: rwbarton, thomie GHC Trac Issues: #14142 Differential Revision: https://phabricator.haskell.org/D3876 >--------------------------------------------------------------- dbaa9a237b6d9771c0e9bde0e50fd2134c2f4dd0 compiler/main/DynFlags.hs | 2 ++ docs/users_guide/debugging.rst | 1 + 2 files changed, 3 insertions(+) diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 4515380..590d834 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -3089,6 +3089,8 @@ dynamic_flags_deps = [ (noArg (flip dopt_set Opt_D_dump_json . setJsonLogAction ) ) , make_ord_flag defGhcFlag "dppr-debug" (setDumpFlag Opt_D_ppr_debug) + , make_ord_flag defGhcFlag "ddebug-output" + (noArg (flip dopt_unset Opt_D_no_debug_output)) , make_ord_flag defGhcFlag "dno-debug-output" (setDumpFlag Opt_D_no_debug_output) diff --git a/docs/users_guide/debugging.rst b/docs/users_guide/debugging.rst index fc18e55..b6b1a92 100644 --- a/docs/users_guide/debugging.rst +++ b/docs/users_guide/debugging.rst @@ -457,6 +457,7 @@ Formatting dumps .. ghc-flag:: -dno-debug-output :shortdesc: Suppress unsolicited debugging output :type: dynamic + :reverse: -ddebug-output :category: Suppress any unsolicited debugging output. When GHC has been built From git at git.haskell.org Tue Aug 22 22:02:11 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 22 Aug 2017 22:02:11 +0000 (UTC) Subject: [commit: ghc] master: users-guide: Better error messages on incomplete ghc-flag directives (7463a95) Message-ID: <20170822220211.9A5DC3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7463a95dbe53d789f8f245f26735a7ac74bb6e11/ghc >--------------------------------------------------------------- commit 7463a95dbe53d789f8f245f26735a7ac74bb6e11 Author: Ben Gamari Date: Tue Aug 22 11:51:54 2017 -0400 users-guide: Better error messages on incomplete ghc-flag directives >--------------------------------------------------------------- 7463a95dbe53d789f8f245f26735a7ac74bb6e11 docs/users_guide/flags.py | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/docs/users_guide/flags.py b/docs/users_guide/flags.py index 06223b5..5a1ff51 100644 --- a/docs/users_guide/flags.py +++ b/docs/users_guide/flags.py @@ -28,6 +28,7 @@ from docutils import nodes from docutils.parsers.rst import Directive, directives from sphinx import addnodes from sphinx.domains.std import GenericObject +from sphinx.errors import SphinxError ### Settings @@ -125,6 +126,12 @@ class Flag(GenericObject): if 'noindex' in self.options: return + # Validity checking + if 'shortdesc' not in self.options: + raise SphinxError('ghc-flag (%s) directive missing :shortdesc: key' % self.names) + if 'type' not in self.options: + raise SphinxError('ghc-flag (%s) directive missing :type: key' % self.names) + # Set the flag category (default: misc) self.category = 'misc' if not 'category' in self.options or self.options['category'] == '': From git at git.haskell.org Wed Aug 23 23:00:54 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 23 Aug 2017 23:00:54 +0000 (UTC) Subject: [commit: ghc] wip/kavon-nosplit-llvm: Some debug output while working on return types. (c9700eb) Message-ID: <20170823230054.D95473A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/kavon-nosplit-llvm Link : http://ghc.haskell.org/trac/ghc/changeset/c9700ebf8f4d5a4afd82eec961c0ad7a0a73cb4b/ghc >--------------------------------------------------------------- commit c9700ebf8f4d5a4afd82eec961c0ad7a0a73cb4b Author: Kavon Farvardin Date: Tue Aug 8 18:59:13 2017 -0500 Some debug output while working on return types. >--------------------------------------------------------------- c9700ebf8f4d5a4afd82eec961c0ad7a0a73cb4b compiler/codeGen/StgCmmBind.hs | 14 ++++++++++++-- 1 file changed, 12 insertions(+), 2 deletions(-) diff --git a/compiler/codeGen/StgCmmBind.hs b/compiler/codeGen/StgCmmBind.hs index 31775d6..3d88200 100644 --- a/compiler/codeGen/StgCmmBind.hs +++ b/compiler/codeGen/StgCmmBind.hs @@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE BangPatterns #-} ----------------------------------------------------------------------------- -- @@ -506,11 +507,17 @@ closureCodeBody top_lvl bndr cl_info cc args arity body fv_details -- Load free vars out of closure *after* -- heap check, to reduce live vars over check ; when node_points $ load_fvs node lf_info fv_bindings - ; void $ cgExpr body + ; retKind <- cgExpr body + ; let !x = trace (retK2s retKind) () + ; return () }}} } +retK2s :: ReturnKind -> String +retK2s AssignedDirectly = "AssignedDirectly" +retK2s (ReturnedTo _ _ _) = "ReturnedTo" + -- Note [NodeReg clobbered with loopification] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -- @@ -590,7 +597,10 @@ thunkCode cl_info fv_details _cc node arity body ; let lf_info = closureLFInfo cl_info ; fv_bindings <- mapM bind_fv fv_details ; load_fvs node lf_info fv_bindings - ; void $ cgExpr body }}} + ; retKind <- cgExpr body + ; let !x = trace (retK2s retKind) () + ; return () + }}} ------------------------------------------------------------------------ From git at git.haskell.org Wed Aug 23 23:00:57 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 23 Aug 2017 23:00:57 +0000 (UTC) Subject: [commit: ghc] wip/kavon-nosplit-llvm: trying to upgrade ReturnKind (1b5ad61) Message-ID: <20170823230057.946DF3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/kavon-nosplit-llvm Link : http://ghc.haskell.org/trac/ghc/changeset/1b5ad61f5394e54c476dfa57f0529ffdf84e24e1/ghc >--------------------------------------------------------------- commit 1b5ad61f5394e54c476dfa57f0529ffdf84e24e1 Author: Kavon Farvardin Date: Wed Aug 23 12:59:50 2017 -0500 trying to upgrade ReturnKind >--------------------------------------------------------------- 1b5ad61f5394e54c476dfa57f0529ffdf84e24e1 compiler/codeGen/StgCmmBind.hs | 5 +++- compiler/codeGen/StgCmmExpr.hs | 55 ++++++++++++++++++++++++--------------- compiler/codeGen/StgCmmForeign.hs | 2 +- compiler/codeGen/StgCmmLayout.hs | 4 +-- compiler/codeGen/StgCmmMonad.hs | 27 +++++++++++++++++-- 5 files changed, 66 insertions(+), 27 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 1b5ad61f5394e54c476dfa57f0529ffdf84e24e1 From git at git.haskell.org Wed Aug 23 23:01:03 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 23 Aug 2017 23:01:03 +0000 (UTC) Subject: [commit: ghc] wip/kavon-nosplit-llvm: sending up information only when we emit a return (bc8ac23) Message-ID: <20170823230103.2154E3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/kavon-nosplit-llvm Link : http://ghc.haskell.org/trac/ghc/changeset/bc8ac239167d21868a6f2c41bc4eb10ef5681e0d/ghc >--------------------------------------------------------------- commit bc8ac239167d21868a6f2c41bc4eb10ef5681e0d Author: Kavon Farvardin Date: Wed Aug 23 18:00:42 2017 -0500 sending up information only when we emit a return >--------------------------------------------------------------- bc8ac239167d21868a6f2c41bc4eb10ef5681e0d compiler/codeGen/StgCmmBind.hs | 5 +-- compiler/codeGen/StgCmmExpr.hs | 17 +++++----- compiler/codeGen/StgCmmForeign.hs | 2 +- compiler/codeGen/StgCmmLayout.hs | 4 +-- compiler/codeGen/StgCmmMonad.hs | 66 ++++++++++++++++++++++----------------- 5 files changed, 53 insertions(+), 41 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 bc8ac239167d21868a6f2c41bc4eb10ef5681e0d From git at git.haskell.org Wed Aug 23 23:01:00 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 23 Aug 2017 23:01:00 +0000 (UTC) Subject: [commit: ghc] wip/kavon-nosplit-llvm: can now compile with RK debugging output (94f2d93) Message-ID: <20170823230100.58BCB3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/kavon-nosplit-llvm Link : http://ghc.haskell.org/trac/ghc/changeset/94f2d93c6b7fe9f77d6cc20cfb0e71c190a40057/ghc >--------------------------------------------------------------- commit 94f2d93c6b7fe9f77d6cc20cfb0e71c190a40057 Author: Kavon Farvardin Date: Wed Aug 23 16:34:50 2017 -0500 can now compile with RK debugging output >--------------------------------------------------------------- 94f2d93c6b7fe9f77d6cc20cfb0e71c190a40057 compiler/codeGen/StgCmmBind.hs | 13 +++++++++---- compiler/codeGen/StgCmmExpr.hs | 2 +- compiler/codeGen/StgCmmMonad.hs | 36 +++++++++++++++++++++++++----------- 3 files changed, 35 insertions(+), 16 deletions(-) diff --git a/compiler/codeGen/StgCmmBind.hs b/compiler/codeGen/StgCmmBind.hs index 48308bc..31cfc2f 100644 --- a/compiler/codeGen/StgCmmBind.hs +++ b/compiler/codeGen/StgCmmBind.hs @@ -514,12 +514,17 @@ closureCodeBody top_lvl bndr cl_info cc args arity body fv_details } +-- start of temporary debugging utils -- + retK2s :: ReturnKind -> String -retK2s (AssignedDirectly tys) = "AssignedDirectly with types: " ++ tyStr - where - tyStr = concat [showSDocUnsafe (ppr t) ++ ", " | t <- tys] +retK2s (AssignedDirectly tys) = "AssignedDirectly with types: " ++ cmmTy2String tys +retK2s (ReturnedTo _ _ _) = panic "unexpected ReturnedTo from codegenning function body." + +cmmTy2String :: [CmmType] -> String +cmmTy2String tys = concat [showSDocUnsafe (ppr t) ++ ", " | t <- tys] + +-- end of temporary debugging utils -- -retK2s (ReturnedTo _ _ _) = "ReturnedTo" -- Note [NodeReg clobbered with loopification] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ diff --git a/compiler/codeGen/StgCmmExpr.hs b/compiler/codeGen/StgCmmExpr.hs index 924b0a7..c2898ba 100644 --- a/compiler/codeGen/StgCmmExpr.hs +++ b/compiler/codeGen/StgCmmExpr.hs @@ -703,7 +703,7 @@ cgAltRhss gc_plan bndr alts = do maybeAltHeapCheck :: (GcPlan,ReturnKind) -> FCode a -> FCode a maybeAltHeapCheck (NoGcInAlts,_) code = code -maybeAltHeapCheck (GcInAlts regs, AssignedDirectly []) code = +maybeAltHeapCheck (GcInAlts regs, AssignedDirectly _) code = altHeapCheck regs code maybeAltHeapCheck (GcInAlts regs, ReturnedTo lret off retRegs) code = altHeapCheckReturnsTo regs lret retRegs off code diff --git a/compiler/codeGen/StgCmmMonad.hs b/compiler/codeGen/StgCmmMonad.hs index 54161d6..b34c8d9 100644 --- a/compiler/codeGen/StgCmmMonad.hs +++ b/compiler/codeGen/StgCmmMonad.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE CPP, GADTs, UnboxedTuples #-} +{-# LANGUAGE CPP, GADTs, UnboxedTuples, BangPatterns #-} ----------------------------------------------------------------------------- -- @@ -248,21 +248,35 @@ combineReturnKinds rks = foldl combine bot rks bot = AssignedDirectly [] combine (AssignedDirectly a) (AssignedDirectly b) = - AssignedDirectly $ merge a b - combine _ _ = panic "combineReturnKinds: unexpected ReturnedTo" - -- ReturnedTo should not appear in a tail position. + AssignedDirectly $ tryMerge a b + combine (a @ (AssignedDirectly _)) (ReturnedTo _ _ _) = a + -- a branch that returns to some other block does not directly return + -- from this case, so we skip over it. + + combine _ _ = panic "combineReturnKinds: unexpected situation" + + tryMerge a b = res + where + !x = trace ("\ntrying to merge: \n\t[" ++ cmmTy2String a ++ "]\n\t[" ++ cmmTy2String b ++ "]\n") () + res = merge a b -- [] indicates either no information, or nothing is returned. - merge [] ty = ty - merge ty [] = ty + -- also, if two type lists do not match in length, we only check + -- up to the shortest list, and pick the longest since it has "more information". + -- I believe we need to do this because some branches may not explicitly assign anything + -- to be returned? - TODO(kavon) + merge ty1 ty2 - | ty1 `equals` ty2 = ty1 + | ty1 `equals` ty2 = if length ty1 >= length ty2 then ty1 else ty2 | otherwise = panic "combineReturnKinds: non-matching return kind!" - -- CmmType does not derive Eq - equals [] [] = True - equals (x:xs) (y:ys) = cmmEqType x y && equals xs ys - equals _ _ = False + equals [] _ = True + equals _ [] = True + equals (x:xs) (y:ys) = cmmEqType_ignoring_ptrhood x y && equals xs ys + -- equals _ _ = False + + cmmTy2String :: [CmmType] -> String + cmmTy2String tys = concat [showSDocUnsafe (ppr t) ++ ", " | t <- tys] -- Note [sharing continuations] From git at git.haskell.org Thu Aug 24 10:04:35 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 24 Aug 2017 10:04:35 +0000 (UTC) Subject: [commit: nofib] master: Catch a few typos (999a46a) Message-ID: <20170824100435.0D3283A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/nofib On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/999a46a1a73832795c532e142a3e37664417f35c/nofib >--------------------------------------------------------------- commit 999a46a1a73832795c532e142a3e37664417f35c Author: Gabor Greif Date: Wed Aug 23 12:03:17 2017 +0200 Catch a few typos >--------------------------------------------------------------- 999a46a1a73832795c532e142a3e37664417f35c Simon-nofib-notes | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Simon-nofib-notes b/Simon-nofib-notes index c47a42c..30c4e6f 100644 --- a/Simon-nofib-notes +++ b/Simon-nofib-notes @@ -126,7 +126,7 @@ eliza ~~~~~ In June 2002, GHC 5.04 emitted four successive NOTE: Simplifier still going after 4 iterations; bailing out. -messages. I suspect that the simplifer is looping somehow. +messages. I suspect that the simplifier is looping somehow. fibheaps ~~~~~~~~ @@ -389,7 +389,7 @@ Omitting the flag gives much better inlining for $wvecsub at least. Sphere also does 60,000 calls to hPutStr, so I/O plays a major role. Currently -this I/O does a *lot* of allocation, much of it since the adddition of thread-safety. +this I/O does a *lot* of allocation, much of it since the addition of thread-safety. treejoin From git at git.haskell.org Thu Aug 24 10:12:20 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 24 Aug 2017 10:12:20 +0000 (UTC) Subject: [commit: ghc] master: Typo fixed (74af2e7) Message-ID: <20170824101220.7F7663A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/74af2e72855b03f9f8f130c27f7cd525fbeeba9d/ghc >--------------------------------------------------------------- commit 74af2e72855b03f9f8f130c27f7cd525fbeeba9d Author: Gabor Greif Date: Thu Aug 24 12:07:36 2017 +0200 Typo fixed and update to the 'nofib' submodule >--------------------------------------------------------------- 74af2e72855b03f9f8f130c27f7cd525fbeeba9d compiler/nativeGen/SPARC/Ppr.hs | 2 +- nofib | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/compiler/nativeGen/SPARC/Ppr.hs b/compiler/nativeGen/SPARC/Ppr.hs index 88b04b9..054a0dc 100644 --- a/compiler/nativeGen/SPARC/Ppr.hs +++ b/compiler/nativeGen/SPARC/Ppr.hs @@ -402,7 +402,7 @@ pprInstr (LD format addr reg) pprReg reg ] --- 64 bit FP storees are expanded into individual instructions in CodeGen.Expand +-- 64 bit FP stores are expanded into individual instructions in CodeGen.Expand pprInstr (ST FF64 reg _) | RegReal (RealRegSingle{}) <- reg = panic "SPARC.Ppr: not emitting potentially misaligned ST FF64 instr" diff --git a/nofib b/nofib index 63ce82a..999a46a 160000 --- a/nofib +++ b/nofib @@ -1 +1 @@ -Subproject commit 63ce82acf38ef20d20fde6e80c5075c14fe8246c +Subproject commit 999a46a1a73832795c532e142a3e37664417f35c From git at git.haskell.org Thu Aug 24 12:50:42 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 24 Aug 2017 12:50:42 +0000 (UTC) Subject: [commit: ghc] branch 'wip/ghc-pkg-locking' created Message-ID: <20170824125042.72B163A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/ghc-pkg-locking Referencing: 0ef79d5be44f87aecb2f85192e21af927374b5b8 From git at git.haskell.org Thu Aug 24 12:50:45 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 24 Aug 2017 12:50:45 +0000 (UTC) Subject: [commit: ghc] wip/ghc-pkg-locking: base: Add support for file unlocking (61d541d) Message-ID: <20170824125045.326DA3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ghc-pkg-locking Link : http://ghc.haskell.org/trac/ghc/changeset/61d541dd9cac2357b090c7b3ce7b4ce24b8f6e5b/ghc >--------------------------------------------------------------- commit 61d541dd9cac2357b090c7b3ce7b4ce24b8f6e5b Author: Ben Gamari Date: Mon Aug 21 11:22:53 2017 -0400 base: Add support for file unlocking >--------------------------------------------------------------- 61d541dd9cac2357b090c7b3ce7b4ce24b8f6e5b libraries/base/GHC/IO/Handle/Lock.hsc | 30 ++++++++++++++++++++++++++++++ 1 file changed, 30 insertions(+) diff --git a/libraries/base/GHC/IO/Handle/Lock.hsc b/libraries/base/GHC/IO/Handle/Lock.hsc index ec62f86..daf407c 100644 --- a/libraries/base/GHC/IO/Handle/Lock.hsc +++ b/libraries/base/GHC/IO/Handle/Lock.hsc @@ -8,6 +8,7 @@ module GHC.IO.Handle.Lock ( , LockMode(..) , hLock , hTryLock + , hUnlock ) where #include "HsBaseConfig.h" @@ -97,6 +98,10 @@ hLock h mode = void $ lockImpl h "hLock" mode True hTryLock :: Handle -> LockMode -> IO Bool hTryLock h mode = lockImpl h "hTryLock" mode False +-- | Release a lock taken with 'hLock' or 'hTryLock'. +hUnlock :: Handle -> IO () +hUnlock = unlockImpl + ---------------------------------------- #if HAVE_FLOCK @@ -116,6 +121,11 @@ lockImpl h ctx mode block = do SharedLock -> #{const LOCK_SH} ExclusiveLock -> #{const LOCK_EX} +unlockImpl :: Handle -> IO () +unlockImpl h = do + FD{fdFD = fd} <- handleToFd h + throwErrnoIfMinus1_ "flock" $ c_flock fd #{const LOCK_UN} + foreign import ccall interruptible "flock" c_flock :: CInt -> CInt -> IO CInt @@ -146,6 +156,18 @@ lockImpl h ctx mode block = do SharedLock -> 0 ExclusiveLock -> #{const LOCKFILE_EXCLUSIVE_LOCK} +unlockImpl :: Handle -> IO () +unlockImpl h = do + FD{fdFD = fd} <- handleToFd h + wh <- throwErrnoIf (== iNVALID_HANDLE_VALUE) "hUnlock" $ c_get_osfhandle fd + allocaBytes sizeof_OVERLAPPED $ \ovrlpd -> do + fillBytes ovrlpd 0 sizeof_OVERLAPPED + c_UnlockFileEx wh 0 0xffffffff 0xffffffff ovrlpd >>= \case + True -> return () + False -> getLastError >>= failWith "hUnlock" + where + sizeof_OVERLAPPED = #{size OVERLAPPED} + -- https://msdn.microsoft.com/en-us/library/aa297958.aspx foreign import ccall unsafe "_get_osfhandle" c_get_osfhandle :: CInt -> IO HANDLE @@ -154,10 +176,18 @@ foreign import ccall unsafe "_get_osfhandle" foreign import WINDOWS_CCONV interruptible "LockFileEx" c_LockFileEx :: HANDLE -> DWORD -> DWORD -> DWORD -> DWORD -> Ptr () -> IO BOOL +-- https://msdn.microsoft.com/en-us/library/windows/desktop/aa365716.aspx +foreign import WINDOWS_CCONV interruptible "UnlockFileEx" + c_UnlockFileEx :: HANDLE -> DWORD -> DWORD -> DWORD -> Ptr () -> IO BOOL + #else -- | No-op implementation. lockImpl :: Handle -> String -> LockMode -> Bool -> IO Bool lockImpl _ _ _ _ = throwIO FileLockingNotSupported +-- | No-op implementation. +unlockImpl :: Handle -> IO () +unlockImpl _ = throwIO FileLockingNotSupported + #endif From git at git.haskell.org Thu Aug 24 12:50:47 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 24 Aug 2017 12:50:47 +0000 (UTC) Subject: [commit: ghc] wip/ghc-pkg-locking: PackageDb: Explicitly unlock package database before closing (0ef79d5) Message-ID: <20170824125047.E66D93A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ghc-pkg-locking Link : http://ghc.haskell.org/trac/ghc/changeset/0ef79d5be44f87aecb2f85192e21af927374b5b8/ghc >--------------------------------------------------------------- commit 0ef79d5be44f87aecb2f85192e21af927374b5b8 Author: Ben Gamari Date: Mon Aug 21 11:26:13 2017 -0400 PackageDb: Explicitly unlock package database before closing This is one possible cause of #13945. >--------------------------------------------------------------- 0ef79d5be44f87aecb2f85192e21af927374b5b8 libraries/ghc-boot/GHC/PackageDb.hs | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/libraries/ghc-boot/GHC/PackageDb.hs b/libraries/ghc-boot/GHC/PackageDb.hs index bf83d25..1dd0b1a 100644 --- a/libraries/ghc-boot/GHC/PackageDb.hs +++ b/libraries/ghc-boot/GHC/PackageDb.hs @@ -261,7 +261,11 @@ lockPackageDbWith mode file = do return $ PackageDbLock hnd lockPackageDb = lockPackageDbWith ExclusiveLock -unlockPackageDb (PackageDbLock hnd) = hClose hnd +unlockPackageDb (PackageDbLock hnd) = do +#if MIN_VERSION_base(4,11,0) + hUnlock hnd +#endif + hClose hnd -- MIN_VERSION_base(4,10,0) #else From git at git.haskell.org Thu Aug 24 13:40:02 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 24 Aug 2017 13:40:02 +0000 (UTC) Subject: [commit: ghc] master: Fix defer-out-of-scope-variables (a211dca) Message-ID: <20170824134002.A9D303A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a211dca8236fb8c7ec632278f761121beeac1438/ghc >--------------------------------------------------------------- commit a211dca8236fb8c7ec632278f761121beeac1438 Author: Simon Peyton Jones Date: Wed Aug 23 13:55:33 2017 +0100 Fix defer-out-of-scope-variables In the hacky code in TcUnify.buildImplication we'd failed to account for -fdefer-out-of-scope-variables. See the new function TcUnify.implicationNeeded. Fixes Trac #14149 >--------------------------------------------------------------- a211dca8236fb8c7ec632278f761121beeac1438 compiler/typecheck/TcUnify.hs | 51 ++++++++++++++-------- testsuite/tests/typecheck/should_compile/T14149.hs | 8 ++++ .../tests/typecheck/should_compile/T14149.stderr | 3 ++ testsuite/tests/typecheck/should_compile/all.T | 1 + 4 files changed, 46 insertions(+), 17 deletions(-) diff --git a/compiler/typecheck/TcUnify.hs b/compiler/typecheck/TcUnify.hs index 5136649..59f8869 100644 --- a/compiler/typecheck/TcUnify.hs +++ b/compiler/typecheck/TcUnify.hs @@ -1144,24 +1144,41 @@ buildImplication :: SkolemInfo -> TcM result -> TcM (Bag Implication, TcEvBinds, result) buildImplication skol_info skol_tvs given thing_inside - = do { tc_lvl <- getTcLevel - ; deferred_type_errors <- goptM Opt_DeferTypeErrors <||> - goptM Opt_DeferTypedHoles - ; if null skol_tvs && null given && (not deferred_type_errors || - not (isTopTcLevel tc_lvl)) - then do { res <- thing_inside - ; return (emptyBag, emptyTcEvBinds, res) } - -- Fast path. We check every function argument with - -- tcPolyExpr, which uses tcSkolemise and hence checkConstraints. - -- But with the solver producing unlifted equalities, we need - -- to have an EvBindsVar for them when they might be deferred to - -- runtime. Otherwise, they end up as top-level unlifted bindings, - -- which are verboten. See also Note [Deferred errors for coercion holes] - -- in TcErrors. + = do { implication_needed <- implicationNeeded skol_tvs given + + ; if implication_needed + then do { (tclvl, wanted, result) <- pushLevelAndCaptureConstraints thing_inside + ; (implics, ev_binds) <- buildImplicationFor tclvl skol_info skol_tvs given wanted + ; return (implics, ev_binds, result) } + + else -- Fast path. We check every function argument with + -- tcPolyExpr, which uses tcSkolemise and hence checkConstraints. + -- So tihs fast path is well-exercised + do { res <- thing_inside + ; return (emptyBag, emptyTcEvBinds, res) } } + +implicationNeeded :: [TcTyVar] -> [EvVar] -> TcM Bool +-- With the solver producing unlifted equalities, we need +-- to have an EvBindsVar for them when they might be deferred to +-- runtime. Otherwise, they end up as top-level unlifted bindings, +-- which are verboten. See also Note [Deferred errors for coercion holes] +-- in TcErrors. cf Trac #14149 for an exmample of what goes wrong. +implicationNeeded skol_tvs given + | null skol_tvs + , null given + = -- Empty skolems and givens + do { tc_lvl <- getTcLevel + ; if not (isTopTcLevel tc_lvl) -- No implication needed if we are + then return False -- already inside an implication else - do { (tclvl, wanted, result) <- pushLevelAndCaptureConstraints thing_inside - ; (implics, ev_binds) <- buildImplicationFor tclvl skol_info skol_tvs given wanted - ; return (implics, ev_binds, result) }} + do { dflags <- getDynFlags -- If any deferral can happen, + -- we must build an implication + ; return (gopt Opt_DeferTypeErrors dflags || + gopt Opt_DeferTypedHoles dflags || + gopt Opt_DeferOutOfScopeVariables dflags) } } + + | otherwise -- Non-empty skolems or givens + = return True -- Definitely need an implication buildImplicationFor :: TcLevel -> SkolemInfo -> [TcTyVar] -> [EvVar] -> WantedConstraints diff --git a/testsuite/tests/typecheck/should_compile/T14149.hs b/testsuite/tests/typecheck/should_compile/T14149.hs new file mode 100644 index 0000000..c23d415 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T14149.hs @@ -0,0 +1,8 @@ +{-# OPTIONS_GHC -fdefer-out-of-scope-variables #-} + +module Foo where + +import Data.Coerce + +f :: Bool +f = coerce (k :: Int) diff --git a/testsuite/tests/typecheck/should_compile/T14149.stderr b/testsuite/tests/typecheck/should_compile/T14149.stderr new file mode 100644 index 0000000..5e5306e --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T14149.stderr @@ -0,0 +1,3 @@ + +T14149.hs:8:13: warning: [-Wdeferred-out-of-scope-variables (in -Wdefault)] + Variable not in scope: k :: Int diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index f522b74..13a2719 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -571,3 +571,4 @@ test('T13881', normal, compile, ['']) test('T13915a', normal, multimod_compile, ['T13915a', '-v0']) test('T13915b', normal, compile, ['']) test('T13984', normal, compile, ['']) +test('T14149', normal, compile, ['']) From git at git.haskell.org Thu Aug 24 13:40:05 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 24 Aug 2017 13:40:05 +0000 (UTC) Subject: [commit: ghc] master: Remove typeKind from Type.hs-boot (aeb4bd9) Message-ID: <20170824134005.6F8BB3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/aeb4bd958439515e02e6f8f9bb22cf84f7cd7d75/ghc >--------------------------------------------------------------- commit aeb4bd958439515e02e6f8f9bb22cf84f7cd7d75 Author: Simon Peyton Jones Date: Wed Aug 23 13:58:51 2017 +0100 Remove typeKind from Type.hs-boot Simple refactoring, reducing unncessary module loops >--------------------------------------------------------------- aeb4bd958439515e02e6f8f9bb22cf84f7cd7d75 compiler/types/Kind.hs | 4 ++-- compiler/types/TyCoRep.hs | 16 +--------------- compiler/types/Type.hs | 13 +++++++++++++ compiler/types/Type.hs-boot | 3 +-- 4 files changed, 17 insertions(+), 19 deletions(-) diff --git a/compiler/types/Kind.hs b/compiler/types/Kind.hs index ae11c8a..0d619fc 100644 --- a/compiler/types/Kind.hs +++ b/compiler/types/Kind.hs @@ -3,7 +3,7 @@ {-# LANGUAGE CPP #-} module Kind ( -- * Main data type - Kind, typeKind, + Kind, -- ** Predicates on Kinds isLiftedTypeKind, isUnliftedTypeKind, @@ -20,7 +20,7 @@ module Kind ( #include "HsVersions.h" -import {-# SOURCE #-} Type ( typeKind, coreView, tcView +import {-# SOURCE #-} Type ( coreView, tcView , splitTyConApp_maybe ) import {-# SOURCE #-} DataCon ( DataCon ) diff --git a/compiler/types/TyCoRep.hs b/compiler/types/TyCoRep.hs index 8b8a960..0fbcc2c 100644 --- a/compiler/types/TyCoRep.hs +++ b/compiler/types/TyCoRep.hs @@ -40,7 +40,6 @@ module TyCoRep ( mkPiTy, mkPiTys, isLiftedTypeKind, isUnliftedTypeKind, isCoercionType, isRuntimeRepTy, isRuntimeRepVar, - isRuntimeRepKindedTy, dropRuntimeRepArgs, sameVis, -- * Functions over binders @@ -141,7 +140,7 @@ import {-# SOURCE #-} Type( isPredTy, isCoercionTy, mkAppTy, mkCastTy , tyCoVarsOfTypeWellScoped , tyCoVarsOfTypesWellScoped , toposortTyVars - , coreView, typeKind ) + , coreView ) -- Transitively pulls in a LOT of stuff, better to break the loop import {-# SOURCE #-} Coercion @@ -736,23 +735,10 @@ isRuntimeRepTy ty | Just ty' <- coreView ty = isRuntimeRepTy ty' isRuntimeRepTy (TyConApp tc []) = tc `hasKey` runtimeRepTyConKey isRuntimeRepTy _ = False --- | Is this a type of kind RuntimeRep? (e.g. LiftedRep) -isRuntimeRepKindedTy :: Type -> Bool -isRuntimeRepKindedTy = isRuntimeRepTy . typeKind - -- | Is a tyvar of type 'RuntimeRep'? isRuntimeRepVar :: TyVar -> Bool isRuntimeRepVar = isRuntimeRepTy . tyVarKind --- | Drops prefix of RuntimeRep constructors in 'TyConApp's. Useful for e.g. --- dropping 'LiftedRep arguments of unboxed tuple TyCon applications: --- --- dropRuntimeRepArgs [ 'LiftedRep, 'IntRep --- , String, Int# ] == [String, Int#] --- -dropRuntimeRepArgs :: [Type] -> [Type] -dropRuntimeRepArgs = dropWhile isRuntimeRepKindedTy - {- %************************************************************************ %* * diff --git a/compiler/types/Type.hs b/compiler/types/Type.hs index f43e0e0..df7333b 100644 --- a/compiler/types/Type.hs +++ b/compiler/types/Type.hs @@ -1956,6 +1956,19 @@ isUnliftedType ty = not (isLiftedType_maybe ty `orElse` pprPanic "isUnliftedType" (ppr ty <+> dcolon <+> ppr (typeKind ty))) +-- | Is this a type of kind RuntimeRep? (e.g. LiftedRep) +isRuntimeRepKindedTy :: Type -> Bool +isRuntimeRepKindedTy = isRuntimeRepTy . typeKind + +-- | Drops prefix of RuntimeRep constructors in 'TyConApp's. Useful for e.g. +-- dropping 'LiftedRep arguments of unboxed tuple TyCon applications: +-- +-- dropRuntimeRepArgs [ 'LiftedRep, 'IntRep +-- , String, Int# ] == [String, Int#] +-- +dropRuntimeRepArgs :: [Type] -> [Type] +dropRuntimeRepArgs = dropWhile isRuntimeRepKindedTy + -- | Extract the RuntimeRep classifier of a type. For instance, -- @getRuntimeRep_maybe Int = LiftedRep at . Returns 'Nothing' if this is not -- possible. diff --git a/compiler/types/Type.hs-boot b/compiler/types/Type.hs-boot index 002db72..375c31f 100644 --- a/compiler/types/Type.hs-boot +++ b/compiler/types/Type.hs-boot @@ -3,7 +3,7 @@ module Type where import TyCon import Var ( TyCoVar ) -import {-# SOURCE #-} TyCoRep( Type, Coercion, Kind ) +import {-# SOURCE #-} TyCoRep( Type, Coercion ) import Util isPredTy :: Type -> Bool @@ -13,7 +13,6 @@ mkAppTy :: Type -> Type -> Type mkCastTy :: Type -> Coercion -> Type piResultTy :: HasDebugCallStack => Type -> Type -> Type -typeKind :: Type -> Kind eqType :: Type -> Type -> Bool partitionInvisibles :: TyCon -> (a -> Type) -> [a] -> ([a], [a]) From git at git.haskell.org Thu Aug 24 13:40:08 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 24 Aug 2017 13:40:08 +0000 (UTC) Subject: [commit: ghc] master: Better pretty-printing for CHoleCan (11657c4) Message-ID: <20170824134008.39D233A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/11657c4bdda391d4f21289e3412589a3c520ca2a/ghc >--------------------------------------------------------------- commit 11657c4bdda391d4f21289e3412589a3c520ca2a Author: Simon Peyton Jones Date: Wed Aug 23 13:48:07 2017 +0100 Better pretty-printing for CHoleCan Debug-only; no change in mainstream behaviour >--------------------------------------------------------------- 11657c4bdda391d4f21289e3412589a3c520ca2a compiler/hsSyn/HsExpr.hs | 3 ++- compiler/typecheck/TcRnTypes.hs | 6 +++++- 2 files changed, 7 insertions(+), 2 deletions(-) diff --git a/compiler/hsSyn/HsExpr.hs b/compiler/hsSyn/HsExpr.hs index 1bde776..aaebce5 100644 --- a/compiler/hsSyn/HsExpr.hs +++ b/compiler/hsSyn/HsExpr.hs @@ -196,7 +196,8 @@ data UnboundVar deriving Data instance Outputable UnboundVar where - ppr = ppr . unboundVarOcc + ppr (OutOfScope occ _) = text "OutOfScope" <> parens (ppr occ) + ppr (TrueExprHole occ) = text "ExprHole" <> parens (ppr occ) unboundVarOcc :: UnboundVar -> OccName unboundVarOcc (OutOfScope occ _) = occ diff --git a/compiler/typecheck/TcRnTypes.hs b/compiler/typecheck/TcRnTypes.hs index 381710b..f735a93 100644 --- a/compiler/typecheck/TcRnTypes.hs +++ b/compiler/typecheck/TcRnTypes.hs @@ -1671,6 +1671,10 @@ data Hole = ExprHole UnboundVar | TypeHole OccName -- ^ A hole in a type (PartialTypeSignatures) +instance Outputable Hole where + ppr (ExprHole ub) = ppr ub + ppr (TypeHole occ) = text "TypeHole" <> parens (ppr occ) + holeOcc :: Hole -> OccName holeOcc (ExprHole uv) = unboundVarOcc uv holeOcc (TypeHole occ) = occ @@ -1784,7 +1788,7 @@ instance Outputable Ct where | pend_sc -> text "CDictCan(psc)" | otherwise -> text "CDictCan" CIrredEvCan {} -> text "CIrredEvCan" - CHoleCan { cc_hole = hole } -> text "CHoleCan:" <+> ppr (holeOcc hole) + CHoleCan { cc_hole = hole } -> text "CHoleCan:" <+> ppr hole {- ************************************************************************ From git at git.haskell.org Thu Aug 24 17:19:16 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 24 Aug 2017 17:19:16 +0000 (UTC) Subject: [commit: ghc] wip/T14137: No rhsCtxt for join points (17ff6ed) Message-ID: <20170824171916.5C3573A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14137 Link : http://ghc.haskell.org/trac/ghc/changeset/17ff6eda3501e74612185eff3df2c7e77a03683a/ghc >--------------------------------------------------------------- commit 17ff6eda3501e74612185eff3df2c7e77a03683a Author: Joachim Breitner Date: Thu Aug 24 19:15:55 2017 +0200 No rhsCtxt for join points as proposed by SPJ in #14137. I don’t have a test case yet, nor full understanding of what is happening, but let’s see what perf.haskell.org says. >--------------------------------------------------------------- 17ff6eda3501e74612185eff3df2c7e77a03683a compiler/simplCore/OccurAnal.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/compiler/simplCore/OccurAnal.hs b/compiler/simplCore/OccurAnal.hs index dbe1c48..b332a57 100644 --- a/compiler/simplCore/OccurAnal.hs +++ b/compiler/simplCore/OccurAnal.hs @@ -1555,6 +1555,7 @@ occAnalNonRecRhs env bndr bndrs body where -- See Note [Cascading inlines] env1 | certainly_inline = env + | Just _ <- willBeJoinId_maybe bndr = env | otherwise = rhsCtxt env -- See Note [Sources of one-shot information] From git at git.haskell.org Thu Aug 24 17:22:16 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 24 Aug 2017 17:22:16 +0000 (UTC) Subject: [commit: ghc] wip/T14137: Pass tagged binder to occAnalUnfolding (6be37ac) Message-ID: <20170824172216.16F913A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14137 Link : http://ghc.haskell.org/trac/ghc/changeset/6be37aca9db37c794afbe56c90221b055aa40cdd/ghc >--------------------------------------------------------------- commit 6be37aca9db37c794afbe56c90221b055aa40cdd Author: Joachim Breitner Date: Thu Aug 24 19:22:03 2017 +0200 Pass tagged binder to occAnalUnfolding >--------------------------------------------------------------- 6be37aca9db37c794afbe56c90221b055aa40cdd compiler/simplCore/OccurAnal.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/simplCore/OccurAnal.hs b/compiler/simplCore/OccurAnal.hs index b332a57..41a3c05 100644 --- a/compiler/simplCore/OccurAnal.hs +++ b/compiler/simplCore/OccurAnal.hs @@ -815,7 +815,7 @@ occAnalNonRecBind env lvl imp_rule_edges binder rhs body_usage -- Unfoldings -- See Note [Unfoldings and join points] - rhs_usage2 = case occAnalUnfolding env NonRecursive binder of + rhs_usage2 = case occAnalUnfolding env NonRecursive tagged_binder of Just unf_usage -> rhs_usage1 +++ unf_usage Nothing -> rhs_usage1 From git at git.haskell.org Thu Aug 24 20:48:23 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 24 Aug 2017 20:48:23 +0000 (UTC) Subject: [commit: ghc] wip/perf-testsuite: Change output of comparison tool to resemble nofib (9cd7e6b) Message-ID: <20170824204823.3817D3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/perf-testsuite Link : http://ghc.haskell.org/trac/ghc/changeset/9cd7e6bb8ef9541c4d2136b7ca6dd2330285fe2a/ghc >--------------------------------------------------------------- commit 9cd7e6bb8ef9541c4d2136b7ca6dd2330285fe2a Author: Jared Weakly Date: Thu Aug 10 01:02:21 2017 -0700 Change output of comparison tool to resemble nofib >--------------------------------------------------------------- 9cd7e6bb8ef9541c4d2136b7ca6dd2330285fe2a testsuite/driver/perf_notes.py | 148 ++++++++++++++++++++++++++++++++++++++++ testsuite/driver/runtests.py | 48 ++++++++++--- testsuite/driver/testglobals.py | 11 ++- testsuite/driver/testlib.py | 6 ++ testsuite/driver/testutil.py | 15 +++- testsuite/mk/test.mk | 12 ++++ 6 files changed, 227 insertions(+), 13 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 9cd7e6bb8ef9541c4d2136b7ca6dd2330285fe2a From git at git.haskell.org Thu Aug 24 20:48:28 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 24 Aug 2017 20:48:28 +0000 (UTC) Subject: [commit: ghc] wip/perf-testsuite: Tentatively setup test driver to rip out metrics from all.T files (ca19eaf) Message-ID: <20170824204828.B1BC23A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/perf-testsuite Link : http://ghc.haskell.org/trac/ghc/changeset/ca19eaf4f1c9c163e33217a815d00cbf9e0ea6c9/ghc >--------------------------------------------------------------- commit ca19eaf4f1c9c163e33217a815d00cbf9e0ea6c9 Author: Jared Weakly Date: Tue Aug 22 17:31:26 2017 -0700 Tentatively setup test driver to rip out metrics from all.T files >--------------------------------------------------------------- ca19eaf4f1c9c163e33217a815d00cbf9e0ea6c9 testsuite/driver/perf_notes.py | 131 ++++++++++++++++++++++++++++++++++++++--- testsuite/driver/testutil.py | 14 ----- 2 files changed, 124 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 ca19eaf4f1c9c163e33217a815d00cbf9e0ea6c9 From git at git.haskell.org Thu Aug 24 20:48:25 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 24 Aug 2017 20:48:25 +0000 (UTC) Subject: [commit: ghc] wip/perf-testsuite: Tentatively setup test driver to rip out metrics from all.T files (7a32062) Message-ID: <20170824204825.EDF503A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/perf-testsuite Link : http://ghc.haskell.org/trac/ghc/changeset/7a320620db37d0932abf71808813052a1d84a312/ghc >--------------------------------------------------------------- commit 7a320620db37d0932abf71808813052a1d84a312 Author: Jared Weakly Date: Wed Aug 16 16:09:24 2017 -0700 Tentatively setup test driver to rip out metrics from all.T files >--------------------------------------------------------------- 7a320620db37d0932abf71808813052a1d84a312 testsuite/driver/perf_notes.py | 129 +++++++++++++++++++++++++++++++++++++--- testsuite/driver/testglobals.py | 4 +- testsuite/driver/testlib.py | 104 +++++++++++++++++++++----------- testsuite/driver/testutil.py | 15 +---- 4 files changed, 194 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 7a320620db37d0932abf71808813052a1d84a312 From git at git.haskell.org Thu Aug 24 20:48:34 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 24 Aug 2017 20:48:34 +0000 (UTC) Subject: [commit: ghc] wip/perf-testsuite: Merge branch 'wip/perf-testsuite' into wip/test-testsuite (f4ec382) Message-ID: <20170824204834.45CD23A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/perf-testsuite Link : http://ghc.haskell.org/trac/ghc/changeset/f4ec382724070b0471dc10458ae2f551c2d17486/ghc >--------------------------------------------------------------- commit f4ec382724070b0471dc10458ae2f551c2d17486 Merge: b843dc4 312f4d8 Author: Jared Weakly Date: Thu Aug 24 13:49:14 2017 -0700 Merge branch 'wip/perf-testsuite' into wip/test-testsuite >--------------------------------------------------------------- f4ec382724070b0471dc10458ae2f551c2d17486 From git at git.haskell.org Thu Aug 24 20:48:31 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 24 Aug 2017 20:48:31 +0000 (UTC) Subject: [commit: ghc] wip/perf-testsuite: Merge commit 'ca19eaf4f1' into wip/test-testsuite (b843dc4) Message-ID: <20170824204831.7B8533A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/perf-testsuite Link : http://ghc.haskell.org/trac/ghc/changeset/b843dc40c9e6bf24b899f41af328e1a900c1eede/ghc >--------------------------------------------------------------- commit b843dc40c9e6bf24b899f41af328e1a900c1eede Merge: 7a32062 ca19eaf Author: Jared Weakly Date: Tue Aug 22 17:35:06 2017 -0700 Merge commit 'ca19eaf4f1' into wip/test-testsuite >--------------------------------------------------------------- b843dc40c9e6bf24b899f41af328e1a900c1eede testsuite/driver/perf_notes.py | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) From git at git.haskell.org Fri Aug 25 01:54:58 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 25 Aug 2017 01:54:58 +0000 (UTC) Subject: [commit: ghc] master: CNF: Implement compaction for small pointer arrays (5f3d2d3) Message-ID: <20170825015458.0B9303A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5f3d2d3be034e04ba872f2695ab6d7b75de66663/ghc >--------------------------------------------------------------- commit 5f3d2d3be034e04ba872f2695ab6d7b75de66663 Author: Ben Gamari Date: Thu Aug 24 21:55:27 2017 -0400 CNF: Implement compaction for small pointer arrays Test Plan: Validate Reviewers: austin, erikd, simonmar, dfeuer Reviewed By: dfeuer Subscribers: rwbarton, andrewthad, thomie, dfeuer GHC Trac Issues: #13860, #13857 Differential Revision: https://phabricator.haskell.org/D3888 >--------------------------------------------------------------- 5f3d2d3be034e04ba872f2695ab6d7b75de66663 libraries/ghc-compact/tests/all.T | 1 + .../ghc-compact/tests/compact_small_ptr_array.hs | 8 ++++++++ rts/Compact.cmm | 24 +++++++++++++++++++--- 3 files changed, 30 insertions(+), 3 deletions(-) diff --git a/libraries/ghc-compact/tests/all.T b/libraries/ghc-compact/tests/all.T index 753592e..0264bab 100644 --- a/libraries/ghc-compact/tests/all.T +++ b/libraries/ghc-compact/tests/all.T @@ -4,6 +4,7 @@ test('compact_simple', normal, compile_and_run, ['']) test('compact_loop', normal, compile_and_run, ['']) test('compact_append', normal, compile_and_run, ['']) test('compact_autoexpand', normal, compile_and_run, ['']) +test('compact_small_array', [reqlib('primitive')], compile_and_run, ['']) test('compact_simple_array', normal, compile_and_run, ['']) test('compact_huge_array', normal, compile_and_run, ['']) test('compact_serialize', normal, compile_and_run, ['']) diff --git a/libraries/ghc-compact/tests/compact_small_ptr_array.hs b/libraries/ghc-compact/tests/compact_small_ptr_array.hs new file mode 100644 index 0000000..8599c71 --- /dev/null +++ b/libraries/ghc-compact/tests/compact_small_ptr_array.hs @@ -0,0 +1,8 @@ +import GHC.Compact +import Data.Primitive.SmallArray + +main :: IO () +main = do + arr <- newSmallArray 5 (Just 'a') + arr' <- compact arr + print $ getCompact arr' diff --git a/rts/Compact.cmm b/rts/Compact.cmm index f20fdbf..72ad4dd 100644 --- a/rts/Compact.cmm +++ b/rts/Compact.cmm @@ -188,9 +188,27 @@ eval: case SMALL_MUT_ARR_PTRS_FROZEN0, SMALL_MUT_ARR_PTRS_FROZEN: { - // (P_ to) = allocateForCompact(cap, compact, size); - // use prim memcpy - ccall barf("stg_compactAddWorkerzh: TODO: SMALL_MUT_ARR_PTRS"); + + W_ i, size, ptrs; + size = SIZEOF_StgMutArrPtrs + WDS(StgMutArrPtrs_size(p)); + ptrs = StgMutArrPtrs_ptrs(p); + ALLOCATE(compact, BYTES_TO_WDS(size), p, to, tag); + P_[pp] = tag | to; + SET_HDR(to, StgHeader_info(p), StgHeader_ccs(p)); + StgMutArrPtrs_ptrs(to) = ptrs; + StgMutArrPtrs_size(to) = StgMutArrPtrs_size(p); + prim %memcpy(to, p, size, 1); + i = 0; + loop0: + if (i < ptrs) { + W_ q; + q = to + SIZEOF_StgSmallMutArrPtrs + WDS(i); + call stg_compactAddWorkerzh( + compact, P_[p + SIZEOF_StgSmallMutArrPtrs + WDS(i)], q); + i = i + 1; + goto loop0; + } + return(); } // Everything else we should copy and evaluate the components: From git at git.haskell.org Fri Aug 25 10:19:01 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 25 Aug 2017 10:19:01 +0000 (UTC) Subject: [commit: ghc] branch 'wip/T14137' deleted Message-ID: <20170825101901.311503A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Deleted branch: wip/T14137 From git at git.haskell.org Fri Aug 25 11:57:32 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 25 Aug 2017 11:57:32 +0000 (UTC) Subject: [commit: ghc] master: Restrict exprOkForSpeculation/case to unlifted types (a0b7b10) Message-ID: <20170825115732.2ECFA3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a0b7b100c649f01325bc6807e418b7563885120e/ghc >--------------------------------------------------------------- commit a0b7b100c649f01325bc6807e418b7563885120e Author: Simon Peyton Jones Date: Tue Aug 22 13:34:31 2017 +0100 Restrict exprOkForSpeculation/case to unlifted types Consider case x of y DEFAULT -> let v::Int# = case y of True -> e1 False -> e2 in ... Previously this would have been ok-for-speculation because y is evaluated. But the binder-swap done by SetLevels would transform the inner alternative to DEFAULT -> let v::Int# = case x of { ... } in ...) which does /not/ satisfy the let/app invariant, because x is not evaluated. I don't know why this has never bitten us before, but it began to bite when I did upcoming refactoring of the Simplifier. So this patch narrows exprOkForSpeculation to only work for /unlifted/ cases. To make this work I had to make exprOkForSpeculation non-polymorphic in the binder type, which has a little knock-on for is use in SetLevels. (It's annoying that we need to handle cases at all, but see Note [exprOkForSpeculation: case expressions]) >--------------------------------------------------------------- a0b7b100c649f01325bc6807e418b7563885120e compiler/coreSyn/CoreUtils.hs | 130 ++++++++++++++++++++++++++-------------- compiler/simplCore/SetLevels.hs | 5 +- 2 files changed, 88 insertions(+), 47 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 a0b7b100c649f01325bc6807e418b7563885120e From git at git.haskell.org Fri Aug 25 11:57:29 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 25 Aug 2017 11:57:29 +0000 (UTC) Subject: [commit: ghc] master: Bottoming expressions should not be expandable (407c11b) Message-ID: <20170825115729.66F153A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/407c11b880325f4f327982d4f6b9f9cba4564016/ghc >--------------------------------------------------------------- commit 407c11b880325f4f327982d4f6b9f9cba4564016 Author: Simon Peyton Jones Date: Fri Aug 25 09:00:31 2017 +0100 Bottoming expressions should not be expandable This patch changes isExpandableApp and isWorkFreeApp to respond False to bottoming applications. I found that if we had x = undefined then prepareRhs was ANF'ing it to d = x = undefined d which is stupid (no gain); and worse it made the simplifier iterate indefinitely. It showed up when I started marking 'x' as a bottoming Id more aggresssively than before; but it's been a lurking bug for ages. It was convenient to make isWorkFreeApp also return False for bottoming applications, and I see no reason not to do so. That leaves isCheapApp. It currently replies True to bottoming applications, but I don't see why that's good.. Something to try later. >--------------------------------------------------------------- 407c11b880325f4f327982d4f6b9f9cba4564016 compiler/coreSyn/CoreUtils.hs | 74 ++++++++++++++++++++++++++--------------- compiler/simplCore/OccurAnal.hs | 14 +++++--- 2 files changed, 56 insertions(+), 32 deletions(-) diff --git a/compiler/coreSyn/CoreUtils.hs b/compiler/coreSyn/CoreUtils.hs index e9dc8a9..1b92a7f 100644 --- a/compiler/coreSyn/CoreUtils.hs +++ b/compiler/coreSyn/CoreUtils.hs @@ -83,7 +83,7 @@ import DynFlags import FastString import Maybes import ListSetOps ( minusList ) -import BasicTypes ( Arity ) +import BasicTypes ( Arity, isConLike ) import Platform import Util import Pair @@ -1168,22 +1168,11 @@ type CheapAppFun = Id -> Arity -> Bool -- isCheapApp -- isExpandableApp - -- NB: isCheapApp and isExpandableApp are called from outside - -- this module, so don't be tempted to move the notRedex - -- stuff into the call site in exprIsCheapX, and remove it - -- from the CheapAppFun implementations - - -notRedex :: CheapAppFun -notRedex fn n_val_args - = n_val_args == 0 -- No value args - || n_val_args < idArity fn -- Partial application - || isBottomingId fn -- OK to duplicate calls to bottom; - -- it certainly doesn't need to be shared! - isWorkFreeApp :: CheapAppFun isWorkFreeApp fn n_val_args - | notRedex fn n_val_args + | n_val_args == 0 -- No value args + = True + | n_val_args < idArity fn -- Partial application = True | otherwise = case idDetails fn of @@ -1192,11 +1181,11 @@ isWorkFreeApp fn n_val_args isCheapApp :: CheapAppFun isCheapApp fn n_val_args - | notRedex fn n_val_args - = True + | isWorkFreeApp fn n_val_args = True + | isBottomingId fn = True -- See Note [isCheapApp: bottoming functions] | otherwise = case idDetails fn of - DataConWorkId {} -> True + DataConWorkId {} -> True -- Actually handled by isWorkFreeApp RecSelId {} -> n_val_args == 1 -- See Note [Record selection] ClassOpId {} -> n_val_args == 1 PrimOpId op -> primOpIsCheap op @@ -1208,21 +1197,24 @@ isCheapApp fn n_val_args isExpandableApp :: CheapAppFun isExpandableApp fn n_val_args - | notRedex fn n_val_args - = True - | isConLikeId fn - = True + | isWorkFreeApp fn n_val_args = True | otherwise = case idDetails fn of - DataConWorkId {} -> True + DataConWorkId {} -> True -- Actually handled by isWorkFreeApp RecSelId {} -> n_val_args == 1 -- See Note [Record selection] ClassOpId {} -> n_val_args == 1 PrimOpId {} -> False - _ -> all_pred_args n_val_args (idType fn) + _ | isBottomingId fn -> False + -- See Note [isExpandableApp: bottoming functions] + | isConLike (idRuleMatchInfo fn) -> True + | all_args_are_preds -> True + | otherwise -> False where - -- See if all the arguments are PredTys (implicit params or classes) - -- If so we'll regard it as expandable; see Note [Expandable overloadings] + -- See if all the arguments are PredTys (implicit params or classes) + -- If so we'll regard it as expandable; see Note [Expandable overloadings] + all_args_are_preds = all_pred_args n_val_args (idType fn) + all_pred_args n_val_args ty | n_val_args == 0 = True @@ -1235,7 +1227,35 @@ isExpandableApp fn n_val_args | otherwise = False -{- Note [Record selection] +{- Note [isCheapApp: bottoming functions] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +I'm not sure why we have a special case for bottoming +functions in isCheapApp. Maybe we don't need it. + +Note [isExpandableApp: bottoming functions] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +It's important that isExpandableApp does not respond True to bottoming +functions. Recall undefined :: HasCallStack => a +Suppose isExpandableApp responded True to (undefined d), and we had: + + x = undefined + +Then Simplify.prepareRhs would ANF the RHS: + + d = + x = undefined d + +This is already bad: we gain nothing from having x bound to (undefined +var), unlike the case for data constructors. Worse, we get the +simplifier loop described in OccurAnal Note [Cascading inlines]. +Suppose x occurs just once; OccurAnal.occAnalNonRecRhs decides x will +certainly_inline; so we end up inlining d right back into x; but in +the end x doesn't inline because it is bottom (preInlineUnconditionally); +so the process repeats.. We could elaborate the certainly_inline logic +some more, but it's better just to treat bottoming bindings as +non-expandable, because ANFing them is a bad idea in the first place. + +Note [Record selection] ~~~~~~~~~~~~~~~~~~~~~~~~~~ I'm experimenting with making record selection look cheap, so we will substitute it inside a diff --git a/compiler/simplCore/OccurAnal.hs b/compiler/simplCore/OccurAnal.hs index 1620c91..113f8bd 100644 --- a/compiler/simplCore/OccurAnal.hs +++ b/compiler/simplCore/OccurAnal.hs @@ -1564,8 +1564,8 @@ occAnalNonRecRhs env bndr bndrs body certainly_inline -- See Note [Cascading inlines] = case idOccInfo bndr of OneOcc { occ_in_lam = in_lam, occ_one_br = one_br } - -> not in_lam && one_br && active && not_stable - _ -> False + -> not in_lam && one_br && active && not_stable + _ -> False dmd = idDemandInfo bndr active = isAlwaysActive (idInlineActivation bndr) @@ -1654,15 +1654,19 @@ definitely inline the next time round, and so we analyse x3's rhs in an ordinary context, not rhsCtxt. Hence the "certainly_inline" stuff. Annoyingly, we have to approximate SimplUtils.preInlineUnconditionally. -If we say "yes" when preInlineUnconditionally says "no" the simplifier iterates -indefinitely: +If (a) the RHS is expandable (see isExpandableApp in occAnalApp), and + (b) certainly_inline says "yes" when preInlineUnconditionally says "no" +then the simplifier iterates indefinitely: x = f y - k = Just x + k = Just x -- We decide that k is 'certainly_inline' + v = ...k... -- but preInlineUnconditionally doesn't inline it inline ==> k = Just (f y) + v = ...k... float ==> x1 = f y k = Just x1 + v = ...k... This is worse than the slow cascade, so we only want to say "certainly_inline" if it really is certain. Look at the note with preInlineUnconditionally From git at git.haskell.org Fri Aug 25 11:57:35 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 25 Aug 2017 11:57:35 +0000 (UTC) Subject: [commit: ghc] master: Refactor the Mighty Simplifier (33452df) Message-ID: <20170825115735.65C263A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/33452dfc6cf891b59d63fa9fe138b18cbce4df81/ghc >--------------------------------------------------------------- commit 33452dfc6cf891b59d63fa9fe138b18cbce4df81 Author: Simon Peyton Jones Date: Fri Aug 25 09:22:03 2017 +0100 Refactor the Mighty Simplifier Triggered by #12150, and the knock-on effects of join points, I did a major refactoring of the Simplifier. This is a big patch that change a lot of Simplify.hs: I did a lot of other re-organisation. The main event ~~~~~~~~~~~~~~ Since the dawn of time we have had simplExpr :: SimplEnv -> InExpr -> SimplCont -> SimplM (SimplEnv, OutExpr) What's that SimplEnv in the result? When simplifying an expression the simplifier add floated let-bindings to the SimplEnv, extending the in-scope set appropriately, and hence needs to resturn the SimplEnv at the end. The mode, flags, substitution in the returned SimplEnv were all irrelevant: it was just the floating bindings. It's strange to accumulate part of the /result/ in the /environment/ argument! And indeed its leads to all manner of mysterious calls to zapFloats and transferring of floats from one SimplEnv to another. It got worse with join points, so I finally bit the bullet and refactored. Now we have simplExpr :: SimplEnv -> InExpr -> SimplCont -> SimplM (SimplFloats, OutExpr) -- See Note [The big picture] and the SimplEnv no longer has floats in it. The code is no shorter, but it /is/ easier to understand. Main changes * Remove seLetFloats field from SimplEnv * Define new data type SimplFloats, and functions over it * Change the types of simplExpr, simplBind, and their many variants, to follow the above plan Bottoming bindings ~~~~~~~~~~~~~~~~~~ I made one other significant change in SimplUtils (not just refactoring), related to Trac #12150 comment:16. Given x = where turns out to be a bottoming expression, propagate that information to x's IdInfo immediately. That's always good, because it makes x be inlined less (we don't inline bottoming things), and it allows (case x of ...) to drop the dead alterantives immediately. Moreover, we are doing the analysis anyway, in tryEtaExpandRhs, which calls CoreArity.findRhsArity, which already does simple bottom analysis. So we are generating the information; all we need do is to atach the bottoming info to the IdInfo. See Note [Bottoming bindings] Smaller refactoring ~~~~~~~~~~~~~~~~~~~ * Rename SimplifierMode to SimplMode * Put DynFlags as a new field in SimplMode, to make fewer monadic calls to getDynFlags. * Move the code in addPolyBind into abstractFloats * Move the "don't eta-expand join points" into tryEtaExpandRhs >--------------------------------------------------------------- 33452dfc6cf891b59d63fa9fe138b18cbce4df81 compiler/coreSyn/CoreArity.hs | 59 +- compiler/simplCore/CoreMonad.hs | 10 +- compiler/simplCore/SimplCore.hs | 9 +- compiler/simplCore/SimplEnv.hs | 316 ++-- compiler/simplCore/SimplUtils.hs | 203 ++- compiler/simplCore/Simplify.hs | 1719 +++++++++----------- testsuite/tests/perf/compiler/T12150.hs | 103 ++ testsuite/tests/perf/compiler/all.T | 10 + .../tests/simplCore/should_compile/T3234.stderr | 4 +- .../tests/simplCore/should_compile/rule2.stderr | 4 +- 10 files changed, 1273 insertions(+), 1164 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 33452dfc6cf891b59d63fa9fe138b18cbce4df81 From git at git.haskell.org Fri Aug 25 11:57:38 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 25 Aug 2017 11:57:38 +0000 (UTC) Subject: [commit: ghc] master: Don't do the RhsCtxt thing for join points (8649535) Message-ID: <20170825115738.E7B5E3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8649535c1c99b851ba3a9fd5a88ca0a3a28b2c18/ghc >--------------------------------------------------------------- commit 8649535c1c99b851ba3a9fd5a88ca0a3a28b2c18 Author: Simon Peyton Jones Date: Fri Aug 25 12:52:14 2017 +0100 Don't do the RhsCtxt thing for join points This minor change fixes Trac #14137. It is described in Note [Join point RHSs] in OccurAnal >--------------------------------------------------------------- 8649535c1c99b851ba3a9fd5a88ca0a3a28b2c18 compiler/simplCore/OccurAnal.hs | 24 +++++++-- testsuite/tests/simplCore/should_compile/T14137.hs | 15 ++++++ .../tests/simplCore/should_compile/T14137.stderr | 63 ++++++++++++++++++++++ testsuite/tests/simplCore/should_compile/all.T | 1 + 4 files changed, 99 insertions(+), 4 deletions(-) diff --git a/compiler/simplCore/OccurAnal.hs b/compiler/simplCore/OccurAnal.hs index 113f8bd..1ae5bbe 100644 --- a/compiler/simplCore/OccurAnal.hs +++ b/compiler/simplCore/OccurAnal.hs @@ -1554,19 +1554,24 @@ occAnalNonRecRhs :: OccEnv occAnalNonRecRhs env bndr bndrs body = occAnalLamOrRhs rhs_env bndrs body where - -- See Note [Cascading inlines] - env1 | certainly_inline = env + env1 | is_join_point = env -- See Note [Join point RHSs] + | certainly_inline = env -- See Note [Cascading inlines] | otherwise = rhsCtxt env -- See Note [Sources of one-shot information] rhs_env = env1 { occ_one_shots = argOneShots dmd } certainly_inline -- See Note [Cascading inlines] - = case idOccInfo bndr of + = case occ of OneOcc { occ_in_lam = in_lam, occ_one_br = one_br } -> not in_lam && one_br && active && not_stable _ -> False + is_join_point = isAlwaysTailCalled occ + -- Like (isJoinId bndr) but happens one step earlier + -- c.f. willBeJoinId_maybe + + occ = idOccInfo bndr dmd = idDemandInfo bndr active = isAlwaysActive (idInlineActivation bndr) not_stable = not (isStableUnfolding (idUnfolding bndr)) @@ -1627,7 +1632,18 @@ occAnalRules env mb_expected_join_arity rec_flag id = case mb_expected_join_arity of Just ar | args `lengthIs` ar -> uds _ -> markAllNonTailCalled uds -{- +{- Note [Join point RHSs] +~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider + x = e + join j = Just x + +We want to inline x into j right away, so we don't want to give +the join point a RhsCtxt (Trac #14137). It's not a huge deal, because +the FloatIn pass knows to float into join point RHSs; and the simplifier +does not float things out of join point RHSs. But it's a simple, cheap +thing to do. See Trac #14137. + Note [Cascading inlines] ~~~~~~~~~~~~~~~~~~~~~~~~ By default we use an rhsCtxt for the RHS of a binding. This tells the diff --git a/testsuite/tests/simplCore/should_compile/T14137.hs b/testsuite/tests/simplCore/should_compile/T14137.hs new file mode 100644 index 0000000..ef8c307 --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T14137.hs @@ -0,0 +1,15 @@ +module T14137 where + +-- The point of this test is that we should inline 'thunk' +-- into j's RHS, and we can do so quite agressively, even +-- when we aren't optimising. See the ticket. +-- +-- It's not a big deal, because in the end FloatIn +-- does the same job, only later + +f xs = let thunk = length xs + j = Just thunk + g 0 = j + g n = g (n-1) + in + g 7 diff --git a/testsuite/tests/simplCore/should_compile/T14137.stderr b/testsuite/tests/simplCore/should_compile/T14137.stderr new file mode 100644 index 0000000..602a740 --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T14137.stderr @@ -0,0 +1,63 @@ + +==================== Tidy Core ==================== +Result size of Tidy Core + = {terms: 45, types: 41, coercions: 0, joins: 2/2} + +-- RHS size: {terms: 30, types: 24, coercions: 0, joins: 2/2} +f :: forall (t :: * -> *) a. Foldable t => t a -> Maybe Int +[GblId, Arity=2] +f = \ (@ (t :: * -> *)) + (@ a) + ($dFoldable :: Foldable t) + (xs :: t a) -> + join { + j :: Maybe Int + [LclId[JoinId(0)], Unf=OtherCon []] + j = GHC.Base.Just @ Int (length @ t $dFoldable @ a xs) } in + joinrec { + g [Occ=LoopBreaker] :: Integer -> Maybe Int + [LclId[JoinId(1)], Arity=1, Unf=OtherCon []] + g (ds :: Integer) + = case == + @ Integer + integer-gmp-1.0.1.0:GHC.Integer.Type.$fEqInteger + ds + (fromInteger @ Integer GHC.Num.$fNumInteger 0) + of { + False -> + jump g + (- @ Integer + GHC.Num.$fNumInteger + ds + (fromInteger @ Integer GHC.Num.$fNumInteger 1)); + True -> jump j + }; } in + jump g 7 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule1 :: GHC.Prim.Addr# +[GblId, Caf=NoCafRefs] +$trModule1 = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule2 :: GHC.Types.TrName +[GblId, Caf=NoCafRefs] +$trModule2 = GHC.Types.TrNameS $trModule1 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule3 :: GHC.Prim.Addr# +[GblId, Caf=NoCafRefs] +$trModule3 = "T14137"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule4 :: GHC.Types.TrName +[GblId, Caf=NoCafRefs] +$trModule4 = GHC.Types.TrNameS $trModule3 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T14137.$trModule :: GHC.Types.Module +[GblId, Caf=NoCafRefs] +T14137.$trModule = GHC.Types.Module $trModule2 $trModule4 + + + diff --git a/testsuite/tests/simplCore/should_compile/all.T b/testsuite/tests/simplCore/should_compile/all.T index edc24bf..82a5124 100644 --- a/testsuite/tests/simplCore/should_compile/all.T +++ b/testsuite/tests/simplCore/should_compile/all.T @@ -269,3 +269,4 @@ test('T12600', ['$MAKE -s --no-print-directory T12600']) test('T13658', normal, compile, ['-dcore-lint']) test('T13708', normal, compile, ['']) +test('T14137', normal, compile, ['-dsuppress-uniques -ddump-simpl']) From git at git.haskell.org Fri Aug 25 12:09:18 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 25 Aug 2017 12:09:18 +0000 (UTC) Subject: [commit: ghc] master: Comments, plus adjust debug print of TcTyThing(ATyVar) (dd89a13) Message-ID: <20170825120918.2FB003A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/dd89a1387aef5280152c03cf7e2a98b8e73216f0/ghc >--------------------------------------------------------------- commit dd89a1387aef5280152c03cf7e2a98b8e73216f0 Author: Simon Peyton Jones Date: Wed Aug 2 15:52:49 2017 +0100 Comments, plus adjust debug print of TcTyThing(ATyVar) >--------------------------------------------------------------- dd89a1387aef5280152c03cf7e2a98b8e73216f0 compiler/hsSyn/HsDecls.hs | 2 +- compiler/hsSyn/HsTypes.hs | 7 ++----- compiler/typecheck/TcRnTypes.hs | 1 + 3 files changed, 4 insertions(+), 6 deletions(-) diff --git a/compiler/hsSyn/HsDecls.hs b/compiler/hsSyn/HsDecls.hs index 2163300..3053f3e 100644 --- a/compiler/hsSyn/HsDecls.hs +++ b/compiler/hsSyn/HsDecls.hs @@ -1330,7 +1330,7 @@ type patterns, i.e. fv(pat_tys). Note in particular '_' gets its own unique. In this context wildcards behave just like an ordinary type variable, only anonymous. -* The hsib_vars *including* type variables that are already in scope +* The hsib_vars *includes* type variables that are already in scope Eg class C s t where type F t p :: * diff --git a/compiler/hsSyn/HsTypes.hs b/compiler/hsSyn/HsTypes.hs index 77b1439..98fad24 100644 --- a/compiler/hsSyn/HsTypes.hs +++ b/compiler/hsSyn/HsTypes.hs @@ -280,12 +280,9 @@ isEmptyLHsQTvs _ = False ------------------------------------------------ -- HsImplicitBndrs --- Used to quantify the binders of a type in cases --- when a HsForAll isn't appropriate: +-- Used to quantify the implicit binders of a type +-- * Implicit binders of a type signature (LHsSigType/LHsSigWcType) -- * Patterns in a type/data family instance (HsTyPats) --- * Type of a rule binder (RuleBndr) --- * Pattern type signatures (SigPatIn) --- In the last of these, wildcards can happen, so we must accommodate them -- | Haskell Implicit Binders data HsImplicitBndrs pass thing -- See Note [HsType binders] diff --git a/compiler/typecheck/TcRnTypes.hs b/compiler/typecheck/TcRnTypes.hs index f735a93..c633d97 100644 --- a/compiler/typecheck/TcRnTypes.hs +++ b/compiler/typecheck/TcRnTypes.hs @@ -1094,6 +1094,7 @@ instance Outputable TcTyThing where -- Debugging only <> ppr (varType (tct_id elt)) <> comma <+> ppr (tct_info elt)) ppr (ATyVar n tv) = text "Type variable" <+> quotes (ppr n) <+> equals <+> ppr tv + <+> dcolon <+> ppr (varType tv) ppr (ATcTyCon tc) = text "ATcTyCon" <+> ppr tc <+> dcolon <+> ppr (tyConKind tc) ppr (APromotionErr err) = text "APromotionErr" <+> ppr err From git at git.haskell.org Fri Aug 25 19:11:33 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 25 Aug 2017 19:11:33 +0000 (UTC) Subject: [commit: ghc] ghc-8.2: Fix loading of dlls on 32bit windows (5a1ae9e) Message-ID: <20170825191133.C28963A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.2 Link : http://ghc.haskell.org/trac/ghc/changeset/5a1ae9e32535fe4a891a515d44dd13968161ff27/ghc >--------------------------------------------------------------- commit 5a1ae9e32535fe4a891a515d44dd13968161ff27 Author: Sergey Vinokurov Date: Mon Aug 21 00:40:08 2017 +0300 Fix loading of dlls on 32bit windows The point of fix is to handle case when loaded dll loads no other dlls, i.e. it's import table is empty. GHC Trac Issues: #14081 (cherry picked from commit 34bd43d9c24207a1897aaa4ee6cb70592a3f7acc) >--------------------------------------------------------------- 5a1ae9e32535fe4a891a515d44dd13968161ff27 rts/linker/PEi386.c | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/rts/linker/PEi386.c b/rts/linker/PEi386.c index c27dd31..bb10900 100644 --- a/rts/linker/PEi386.c +++ b/rts/linker/PEi386.c @@ -156,6 +156,13 @@ static void addDLLHandle(pathchar* dll_name, HINSTANCE instance) { (PIMAGE_IMPORT_DESCRIPTOR)((BYTE *)instance + header-> OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_IMPORT].VirtualAddress); + bool importTableMissing = + header->OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_IMPORT].Size == 0; + + if (importTableMissing) { + return; + } + /* Ignore these compatibility shims. */ const pathchar* ms_dll = WSTR("api-ms-win-"); const int len = wcslen(ms_dll); From git at git.haskell.org Fri Aug 25 19:11:37 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 25 Aug 2017 19:11:37 +0000 (UTC) Subject: [commit: ghc] ghc-8.2: CNF: Implement compaction for small pointer arrays (6712904) Message-ID: <20170825191137.045043A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.2 Link : http://ghc.haskell.org/trac/ghc/changeset/6712904886070df03887a47448100593c55fc1ff/ghc >--------------------------------------------------------------- commit 6712904886070df03887a47448100593c55fc1ff Author: Ben Gamari Date: Thu Aug 24 21:55:27 2017 -0400 CNF: Implement compaction for small pointer arrays Test Plan: Validate Reviewers: austin, erikd, simonmar, dfeuer Reviewed By: dfeuer Subscribers: rwbarton, andrewthad, thomie, dfeuer GHC Trac Issues: #13860, #13857 Differential Revision: https://phabricator.haskell.org/D3888 (cherry picked from commit 5f3d2d3be034e04ba872f2695ab6d7b75de66663) >--------------------------------------------------------------- 6712904886070df03887a47448100593c55fc1ff libraries/ghc-compact/tests/all.T | 1 + .../ghc-compact/tests/compact_small_ptr_array.hs | 8 ++++++++ rts/Compact.cmm | 24 +++++++++++++++++++--- 3 files changed, 30 insertions(+), 3 deletions(-) diff --git a/libraries/ghc-compact/tests/all.T b/libraries/ghc-compact/tests/all.T index 753592e..0264bab 100644 --- a/libraries/ghc-compact/tests/all.T +++ b/libraries/ghc-compact/tests/all.T @@ -4,6 +4,7 @@ test('compact_simple', normal, compile_and_run, ['']) test('compact_loop', normal, compile_and_run, ['']) test('compact_append', normal, compile_and_run, ['']) test('compact_autoexpand', normal, compile_and_run, ['']) +test('compact_small_array', [reqlib('primitive')], compile_and_run, ['']) test('compact_simple_array', normal, compile_and_run, ['']) test('compact_huge_array', normal, compile_and_run, ['']) test('compact_serialize', normal, compile_and_run, ['']) diff --git a/libraries/ghc-compact/tests/compact_small_ptr_array.hs b/libraries/ghc-compact/tests/compact_small_ptr_array.hs new file mode 100644 index 0000000..8599c71 --- /dev/null +++ b/libraries/ghc-compact/tests/compact_small_ptr_array.hs @@ -0,0 +1,8 @@ +import GHC.Compact +import Data.Primitive.SmallArray + +main :: IO () +main = do + arr <- newSmallArray 5 (Just 'a') + arr' <- compact arr + print $ getCompact arr' diff --git a/rts/Compact.cmm b/rts/Compact.cmm index 0b98f39..ded79f0 100644 --- a/rts/Compact.cmm +++ b/rts/Compact.cmm @@ -188,9 +188,27 @@ eval: case SMALL_MUT_ARR_PTRS_FROZEN0, SMALL_MUT_ARR_PTRS_FROZEN: { - // (P_ to) = allocateForCompact(cap, compact, size); - // use prim memcpy - ccall barf("stg_compactAddWorkerzh: TODO: SMALL_MUT_ARR_PTRS"); + + W_ i, size, ptrs; + size = SIZEOF_StgMutArrPtrs + WDS(StgMutArrPtrs_size(p)); + ptrs = StgMutArrPtrs_ptrs(p); + ALLOCATE(compact, BYTES_TO_WDS(size), p, to, tag); + P_[pp] = tag | to; + SET_HDR(to, StgHeader_info(p), StgHeader_ccs(p)); + StgMutArrPtrs_ptrs(to) = ptrs; + StgMutArrPtrs_size(to) = StgMutArrPtrs_size(p); + prim %memcpy(to, p, size, 1); + i = 0; + loop0: + if (i < ptrs) { + W_ q; + q = to + SIZEOF_StgSmallMutArrPtrs + WDS(i); + call stg_compactAddWorkerzh( + compact, P_[p + SIZEOF_StgSmallMutArrPtrs + WDS(i)], q); + i = i + 1; + goto loop0; + } + return(); } // Everything else we should copy and evaluate the components: From git at git.haskell.org Fri Aug 25 19:11:40 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 25 Aug 2017 19:11:40 +0000 (UTC) Subject: [commit: ghc] ghc-8.2: KnownUniques: Handle DataCon wrapper names (fe53505) Message-ID: <20170825191140.6B1783A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.2 Link : http://ghc.haskell.org/trac/ghc/changeset/fe5350561dccb1913c2bdde2cd76d5513350b2cf/ghc >--------------------------------------------------------------- commit fe5350561dccb1913c2bdde2cd76d5513350b2cf Author: Ben Gamari Date: Mon Jul 31 22:33:24 2017 -0400 KnownUniques: Handle DataCon wrapper names For some reason these weren't handled. I seem to remember thinking I had a reason for omitting them when writing the original patch, but I don't recall what that reason was at this point and clearly workers do show up in interface files. Test Plan: Validate against T14051 Reviewers: austin Subscribers: rwbarton, thomie, RyanGlScott GHC Trac Issues: #14051 Differential Revision: https://phabricator.haskell.org/D3805 (cherry picked from commit 5a7af95ad2ce38e4b80893d869948c630454683b) >--------------------------------------------------------------- fe5350561dccb1913c2bdde2cd76d5513350b2cf compiler/prelude/KnownUniques.hs | 9 ++++++--- testsuite/tests/unboxedsums/T14051.hs | 10 ++++++++++ testsuite/tests/unboxedsums/T14051a.hs | 6 ++++++ testsuite/tests/unboxedsums/all.T | 1 + 4 files changed, 23 insertions(+), 3 deletions(-) diff --git a/compiler/prelude/KnownUniques.hs b/compiler/prelude/KnownUniques.hs index 8f1b0b6..60fa0e2 100644 --- a/compiler/prelude/KnownUniques.hs +++ b/compiler/prelude/KnownUniques.hs @@ -79,7 +79,8 @@ knownUniqueName u = mkSumTyConUnique :: Arity -> Unique mkSumTyConUnique arity = - ASSERT(arity < 0xff) + ASSERT(arity < 0x3f) -- 0x3f since we only have 6 bits to encode the + -- alternative mkUnique 'z' (arity `shiftL` 8 .|. 0xfc) mkSumDataConUnique :: ConTagZ -> Arity -> Unique @@ -98,16 +99,18 @@ getUnboxedSumName n _ -> pprPanic "getUnboxedSumName: invalid tag" (ppr tag) | tag == 0x0 = dataConName $ sumDataCon (alt + 1) arity + | tag == 0x1 + = getName $ dataConWrapId $ sumDataCon (alt + 1) arity | tag == 0x2 = getRep $ promoteDataCon $ sumDataCon (alt + 1) arity | otherwise = pprPanic "getUnboxedSumName" (ppr n) where arity = n `shiftR` 8 - alt = (n .&. 0xff) `shiftR` 2 + alt = (n .&. 0xfc) `shiftR` 2 tag = 0x3 .&. n getRep tycon = - fromMaybe (pprPanic "getUnboxedSumName" (ppr tycon)) + fromMaybe (pprPanic "getUnboxedSumName(getRep)" (ppr tycon)) $ tyConRepName_maybe tycon -- Note [Uniques for tuple type and data constructors] diff --git a/testsuite/tests/unboxedsums/T14051.hs b/testsuite/tests/unboxedsums/T14051.hs new file mode 100644 index 0000000..96662a9 --- /dev/null +++ b/testsuite/tests/unboxedsums/T14051.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE UnboxedSums #-} + +module Main where + +import T14051a + +main :: IO () +main = print $ case func () of + (# True | #) -> 123 + _ -> 321 diff --git a/testsuite/tests/unboxedsums/T14051a.hs b/testsuite/tests/unboxedsums/T14051a.hs new file mode 100644 index 0000000..b88f70e --- /dev/null +++ b/testsuite/tests/unboxedsums/T14051a.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE UnboxedSums #-} + +module T14051a where + +func :: s -> (# Bool | Bool #) +func _ = (# True | #) diff --git a/testsuite/tests/unboxedsums/all.T b/testsuite/tests/unboxedsums/all.T index eea818b..45723cb 100644 --- a/testsuite/tests/unboxedsums/all.T +++ b/testsuite/tests/unboxedsums/all.T @@ -32,3 +32,4 @@ test('T12711', only_ways(['ghci']), ghci_script, ['T12711.script']) # ['$MAKE -s --no-print-directory sum_api_annots']) test('UbxSumLevPoly', normal, compile, ['']) +test('T14051', normal, multi_compile, ['T14051.hs', [('T14051a.hs', '')], '-O2 -v0']) From git at git.haskell.org Fri Aug 25 19:11:43 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 25 Aug 2017 19:11:43 +0000 (UTC) Subject: [commit: ghc] ghc-8.2: Fix incorrect retypecheck loop in -j (#14075) (122b014) Message-ID: <20170825191143.E5E4B3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.2 Link : http://ghc.haskell.org/trac/ghc/changeset/122b01410bd191f5c589d21cf6dc74a146f46538/ghc >--------------------------------------------------------------- commit 122b01410bd191f5c589d21cf6dc74a146f46538 Author: Edward Z. Yang Date: Tue Aug 22 08:44:25 2017 -0400 Fix incorrect retypecheck loop in -j (#14075) The parallel codepath was incorrectly retypechecking the hs-boot ModIface prior to typechecking the hs file, which was inconsistent with the non-parallel case. The non-parallel case gets it right: you don't want to retypecheck the hs-boot file itself (forwarding its declarations to hs) because you need it to be consistently knot-tied with itself when you compare the interfaces. Signed-off-by: Edward Z. Yang Test Plan: validate Reviewers: bgamari, simonpj, austin Reviewed By: bgamari Subscribers: duog, rwbarton, thomie GHC Trac Issues: #14075 Differential Revision: https://phabricator.haskell.org/D3815 (cherry picked from commit 4717ce8658f12f425aebd1fc7f7ad8fe04a81df5) >--------------------------------------------------------------- 122b01410bd191f5c589d21cf6dc74a146f46538 compiler/main/GhcMake.hs | 50 +++++++++++++++++++++- testsuite/tests/driver/T14075/F.hs | 1 + testsuite/tests/driver/T14075/F.hs-boot | 6 +++ .../tests/{cabal/pkg02 => driver/T14075}/Makefile | 2 + testsuite/tests/driver/T14075/O.hs | 3 ++ testsuite/tests/driver/T14075/T14075.stderr | 7 +++ testsuite/tests/driver/T14075/T14075.stdout | 3 ++ testsuite/tests/driver/T14075/V.hs | 3 ++ testsuite/tests/driver/T14075/V.hs-boot | 1 + testsuite/tests/driver/T14075/all.T | 4 ++ 10 files changed, 78 insertions(+), 2 deletions(-) diff --git a/compiler/main/GhcMake.hs b/compiler/main/GhcMake.hs index 1d9e9e2..866cc17 100644 --- a/compiler/main/GhcMake.hs +++ b/compiler/main/GhcMake.hs @@ -1141,7 +1141,13 @@ parUpsweep_one mod home_mod_map comp_graph_loops lcl_dflags mHscMessage cleanup Just (ms_mod lcl_mod, type_env_var) } lcl_hsc_env'' <- case finish_loop of Nothing -> return lcl_hsc_env' + -- In the non-parallel case, the retypecheck prior to + -- typechecking the loop closer includes all modules + -- EXCEPT the loop closer. However, our precomputed + -- SCCs include the loop closer, so we have to filter + -- it out. Just loop -> typecheckLoop lcl_dflags lcl_hsc_env' $ + filter (/= moduleName (fst this_build_mod)) $ map (moduleName . fst) loop -- Compile the module. @@ -1164,8 +1170,10 @@ parUpsweep_one mod home_mod_map comp_graph_loops lcl_dflags mHscMessage cleanup let hsc_env' = hsc_env { hsc_HPT = addToHpt (hsc_HPT hsc_env) this_mod mod_info } - -- If this module is a loop finisher, now is the time to - -- re-typecheck the loop. + -- We've finished typechecking the module, now we must + -- retypecheck the loop AGAIN to ensure unfoldings are + -- updated. This time, however, we include the loop + -- closer! hsc_env'' <- case finish_loop of Nothing -> return hsc_env' Just loop -> typecheckLoop lcl_dflags hsc_env' $ @@ -1563,6 +1571,42 @@ reTypecheckLoop hsc_env ms graph | otherwise = return hsc_env +-- | Given a non-boot ModSummary @ms@ of a module, for which there exists a +-- corresponding boot file in @graph@, return the set of modules which +-- transitively depend on this boot file. This function is slightly misnamed, +-- but its name "getModLoop" alludes to the fact that, when getModLoop is called +-- with a graph that does not contain @ms@ (non-parallel case) or is an +-- SCC with hs-boot nodes dropped (parallel-case), the modules which +-- depend on the hs-boot file are typically (but not always) the +-- modules participating in the recursive module loop. The returned +-- list includes the hs-boot file. +-- +-- Example: +-- let g represent the module graph: +-- C.hs +-- A.hs-boot imports C.hs +-- B.hs imports A.hs-boot +-- A.hs imports B.hs +-- genModLoop A.hs g == Just [A.hs-boot, B.hs, A.hs] +-- +-- It would also be permissible to omit A.hs from the graph, +-- in which case the result is [A.hs-boot, B.hs] +-- +-- Example: +-- A counter-example to the claim that modules returned +-- by this function participate in the loop occurs here: +-- +-- let g represent the module graph: +-- C.hs +-- A.hs-boot imports C.hs +-- B.hs imports A.hs-boot +-- A.hs imports B.hs +-- D.hs imports A.hs-boot +-- genModLoop A.hs g == Just [A.hs-boot, B.hs, A.hs, D.hs] +-- +-- Arguably, D.hs should import A.hs, not A.hs-boot, but +-- a dependency on the boot file is not illegal. +-- getModLoop :: ModSummary -> ModuleGraph -> Maybe [ModSummary] getModLoop ms graph | not (isBootSummary ms) @@ -1574,6 +1618,8 @@ getModLoop ms graph where this_mod = ms_mod ms +-- NB: sometimes mods has duplicates; this is harmless because +-- any duplicates get clobbered in addListToHpt and never get forced. typecheckLoop :: DynFlags -> HscEnv -> [ModuleName] -> IO HscEnv typecheckLoop dflags hsc_env mods = do debugTraceMsg dflags 2 $ diff --git a/testsuite/tests/driver/T14075/F.hs b/testsuite/tests/driver/T14075/F.hs new file mode 100644 index 0000000..3e32036 --- /dev/null +++ b/testsuite/tests/driver/T14075/F.hs @@ -0,0 +1 @@ +module F () where diff --git a/testsuite/tests/driver/T14075/F.hs-boot b/testsuite/tests/driver/T14075/F.hs-boot new file mode 100644 index 0000000..41008d5 --- /dev/null +++ b/testsuite/tests/driver/T14075/F.hs-boot @@ -0,0 +1,6 @@ +module F where + +import O (O) + +newtype F = F () +instance O F where diff --git a/testsuite/tests/cabal/pkg02/Makefile b/testsuite/tests/driver/T14075/Makefile similarity index 59% copy from testsuite/tests/cabal/pkg02/Makefile copy to testsuite/tests/driver/T14075/Makefile index 4a26853..505274a 100644 --- a/testsuite/tests/cabal/pkg02/Makefile +++ b/testsuite/tests/driver/T14075/Makefile @@ -2,3 +2,5 @@ TOP=../../.. include $(TOP)/mk/boilerplate.mk include $(TOP)/mk/test.mk +T14075: + ! '$(TEST_HC)' $(TEST_HC_OPTS) -j2 F O V diff --git a/testsuite/tests/driver/T14075/O.hs b/testsuite/tests/driver/T14075/O.hs new file mode 100644 index 0000000..2cbb8bb --- /dev/null +++ b/testsuite/tests/driver/T14075/O.hs @@ -0,0 +1,3 @@ +module O (O) where + +class O a where diff --git a/testsuite/tests/driver/T14075/T14075.stderr b/testsuite/tests/driver/T14075/T14075.stderr new file mode 100644 index 0000000..ab3c85c --- /dev/null +++ b/testsuite/tests/driver/T14075/T14075.stderr @@ -0,0 +1,7 @@ + +F.hs-boot:5:1: error: + ‘F.F’ is exported by the hs-boot file, but not exported by the module + +F.hs:1:1: error: + instance O.O F.F -- Defined at F.hs-boot:6:10 + is defined in the hs-boot file, but not in the module itself diff --git a/testsuite/tests/driver/T14075/T14075.stdout b/testsuite/tests/driver/T14075/T14075.stdout new file mode 100644 index 0000000..18f17be --- /dev/null +++ b/testsuite/tests/driver/T14075/T14075.stdout @@ -0,0 +1,3 @@ +[1 of 4] Compiling O ( O.hs, O.o ) +[2 of 4] Compiling F[boot] ( F.hs-boot, F.o-boot ) +[3 of 4] Compiling F ( F.hs, F.o ) diff --git a/testsuite/tests/driver/T14075/V.hs b/testsuite/tests/driver/T14075/V.hs new file mode 100644 index 0000000..cf06b93 --- /dev/null +++ b/testsuite/tests/driver/T14075/V.hs @@ -0,0 +1,3 @@ +module V () where + +import {-# SOURCE #-} F () diff --git a/testsuite/tests/driver/T14075/V.hs-boot b/testsuite/tests/driver/T14075/V.hs-boot new file mode 100644 index 0000000..ec64e22 --- /dev/null +++ b/testsuite/tests/driver/T14075/V.hs-boot @@ -0,0 +1 @@ +module V where diff --git a/testsuite/tests/driver/T14075/all.T b/testsuite/tests/driver/T14075/all.T new file mode 100644 index 0000000..646976a --- /dev/null +++ b/testsuite/tests/driver/T14075/all.T @@ -0,0 +1,4 @@ +test('T14075', + [extra_files(['F.hs', 'F.hs-boot', 'O.hs', 'V.hs', 'V.hs-boot'])], + run_command, + ['$MAKE -s --no-print-directory T14075']) From git at git.haskell.org Fri Aug 25 19:11:47 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 25 Aug 2017 19:11:47 +0000 (UTC) Subject: [commit: ghc] ghc-8.2: Fix #14125 by normalizing data family instances more aggressively (c541129) Message-ID: <20170825191147.8E8553A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.2 Link : http://ghc.haskell.org/trac/ghc/changeset/c541129ccc78967a15c67e416bb5f5d5b7499b68/ghc >--------------------------------------------------------------- commit c541129ccc78967a15c67e416bb5f5d5b7499b68 Author: Ryan Scott Date: Tue Aug 22 09:28:43 2017 -0400 Fix #14125 by normalizing data family instances more aggressively Summary: Commit 3540d1e1a23926ce0a8a6ae83a36f5f6b2497ccf inadvertently broke the ability for newtype instances to be used as marshallable types in FFI declarations. The reason is a bit silly: an extra check was added for type synonyms with no type families on the RHS in `normalise_tc_app`, but this check would only skip over type families, not //data// families, since the predicate being used was `not . isTypeFamilyCon`. The fix is simple: just use `not . isFamilyCon` instead so that data families are also skipped by this check. Test Plan: make test TEST=T14125 Reviewers: goldfire, simonpj, austin, bgamari Reviewed By: simonpj Subscribers: rwbarton, thomie GHC Trac Issues: #14125 Differential Revision: https://phabricator.haskell.org/D3865 (cherry picked from commit 6982ee99fb97c252c3faf37faae34131fb66f67c) >--------------------------------------------------------------- c541129ccc78967a15c67e416bb5f5d5b7499b68 compiler/types/FamInstEnv.hs | 14 +++++++------- testsuite/tests/ffi/should_compile/T14125.hs | 17 +++++++++++++++++ testsuite/tests/ffi/should_compile/all.T | 1 + testsuite/tests/ghci/should_run/T14125a.script | 8 ++++++++ testsuite/tests/ghci/should_run/T14125a.stdout | 5 +++++ testsuite/tests/ghci/should_run/all.T | 1 + 6 files changed, 39 insertions(+), 7 deletions(-) diff --git a/compiler/types/FamInstEnv.hs b/compiler/types/FamInstEnv.hs index 89f4214..3182475 100644 --- a/compiler/types/FamInstEnv.hs +++ b/compiler/types/FamInstEnv.hs @@ -1356,13 +1356,7 @@ normalise_tc_app tc tys -- See Note [Normalisation and type synonyms] normalise_type (mkAppTys (substTy (mkTvSubstPrs tenv) rhs) tys') - | not (isTypeFamilyTyCon tc) - = -- A synonym with no type families in the RHS; or data type etc - -- Just normalise the arguments and rebuild - do { (args_co, ntys) <- normalise_tc_args tc tys - ; return (args_co, mkTyConApp tc ntys) } - - | otherwise + | isFamilyTyCon tc = -- A type-family application do { env <- getEnv ; role <- getRole @@ -1376,6 +1370,12 @@ normalise_tc_app tc tys -- we do not do anything return (args_co, mkTyConApp tc ntys) } + | otherwise + = -- A synonym with no type families in the RHS; or data type etc + -- Just normalise the arguments and rebuild + do { (args_co, ntys) <- normalise_tc_args tc tys + ; return (args_co, mkTyConApp tc ntys) } + --------------- -- | Normalise arguments to a tycon normaliseTcArgs :: FamInstEnvs -- ^ env't with family instances diff --git a/testsuite/tests/ffi/should_compile/T14125.hs b/testsuite/tests/ffi/should_compile/T14125.hs new file mode 100644 index 0000000..daf236d --- /dev/null +++ b/testsuite/tests/ffi/should_compile/T14125.hs @@ -0,0 +1,17 @@ +{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE TypeFamilies #-} +module T14125 where + +import Foreign.C.String +import Foreign.C.Types + +data UnixReturn + +data family IOErrno a +newtype instance IOErrno UnixReturn = UnixErrno CInt + +foreign import ccall unsafe "string.h" + strerror :: IOErrno UnixReturn -> IO CString + +foreign import ccall unsafe "HsBase.h __hscore_get_errno" + get_errno :: IO (IOErrno UnixReturn) diff --git a/testsuite/tests/ffi/should_compile/all.T b/testsuite/tests/ffi/should_compile/all.T index 18192d4..0f2f390 100644 --- a/testsuite/tests/ffi/should_compile/all.T +++ b/testsuite/tests/ffi/should_compile/all.T @@ -31,3 +31,4 @@ test('cc015', normal, compile, ['']) test('cc016', normal, compile, ['']) test('T10460', normal, compile, ['']) test('T11983', [omit_ways(['ghci'])], compile, ['T11983.c']) +test('T14125', normal, compile, ['']) diff --git a/testsuite/tests/ghci/should_run/T14125a.script b/testsuite/tests/ghci/should_run/T14125a.script new file mode 100644 index 0000000..1667349 --- /dev/null +++ b/testsuite/tests/ghci/should_run/T14125a.script @@ -0,0 +1,8 @@ +:set -XTypeFamilies +data family Foo a +data instance Foo Int = FooInt Int +:kind! Foo Int +let f (FooInt i) = i +:info f +:type +v f +:type f diff --git a/testsuite/tests/ghci/should_run/T14125a.stdout b/testsuite/tests/ghci/should_run/T14125a.stdout new file mode 100644 index 0000000..7b4e85e --- /dev/null +++ b/testsuite/tests/ghci/should_run/T14125a.stdout @@ -0,0 +1,5 @@ +Foo Int :: * += Foo Int +f :: Foo Int -> Int -- Defined at :5:5 +f :: Foo Int -> Int +f :: Foo Int -> Int diff --git a/testsuite/tests/ghci/should_run/all.T b/testsuite/tests/ghci/should_run/all.T index 3dc05ce..f7ec59e 100644 --- a/testsuite/tests/ghci/should_run/all.T +++ b/testsuite/tests/ghci/should_run/all.T @@ -27,3 +27,4 @@ test('T11825', just_ghci, ghci_script, ['T11825.script']) test('T12128', just_ghci, ghci_script, ['T12128.script']) test('T12456', just_ghci, ghci_script, ['T12456.script']) test('T12549', just_ghci, ghci_script, ['T12549.script']) +test('T14125a', just_ghci, ghci_script, ['T14125a.script']) From git at git.haskell.org Fri Aug 25 19:11:50 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 25 Aug 2017 19:11:50 +0000 (UTC) Subject: [commit: ghc] ghc-8.2: Fix #13947 by checking for unbounded names more (45588a0) Message-ID: <20170825191150.B3C3A3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.2 Link : http://ghc.haskell.org/trac/ghc/changeset/45588a00c06d5ee5a0fe24974f586340ab03d2de/ghc >--------------------------------------------------------------- commit 45588a00c06d5ee5a0fe24974f586340ab03d2de Author: Ryan Scott Date: Tue Jul 11 13:59:29 2017 -0400 Fix #13947 by checking for unbounded names more Commit 2484d4dae65c81f218dcfe494b963b2630bb8fa6 accidentally dropped a call to `isUnboundName` in an important location. This re-adds it. Fixes #13947. Test Plan: make test TEST=T13947 Reviewers: adamgundry, austin, bgamari Reviewed By: adamgundry Subscribers: rwbarton, thomie GHC Trac Issues: #13947 Differential Revision: https://phabricator.haskell.org/D3718 (cherry picked from commit 85ac65c5f0b057f1b07ed7bf9a8d9aeae4ce1390) >--------------------------------------------------------------- 45588a00c06d5ee5a0fe24974f586340ab03d2de compiler/rename/RnTypes.hs | 5 +++-- testsuite/tests/rename/should_fail/T13947.hs | 5 +++++ testsuite/tests/rename/should_fail/T13947.stderr | 3 +++ testsuite/tests/rename/should_fail/all.T | 1 + 4 files changed, 12 insertions(+), 2 deletions(-) diff --git a/compiler/rename/RnTypes.hs b/compiler/rename/RnTypes.hs index f829c4f..58d7c9f 100644 --- a/compiler/rename/RnTypes.hs +++ b/compiler/rename/RnTypes.hs @@ -1421,8 +1421,9 @@ sectionPrecErr op@(n1,_) arg_op@(n2,_) section nest 4 (text "in the section:" <+> quotes (ppr section))] is_unbound :: OpName -> Bool -is_unbound UnboundOp{} = True -is_unbound _ = False +is_unbound (NormalOp n) = isUnboundName n +is_unbound UnboundOp{} = True +is_unbound _ = False ppr_opfix :: (OpName, Fixity) -> SDoc ppr_opfix (op, fixity) = pp_op <+> brackets (ppr fixity) diff --git a/testsuite/tests/rename/should_fail/T13947.hs b/testsuite/tests/rename/should_fail/T13947.hs new file mode 100644 index 0000000..bc435e7 --- /dev/null +++ b/testsuite/tests/rename/should_fail/T13947.hs @@ -0,0 +1,5 @@ +{-# LANGUAGE TypeOperators #-} +module T13947 where + +f :: () -> Int :~: Int +f = undefined diff --git a/testsuite/tests/rename/should_fail/T13947.stderr b/testsuite/tests/rename/should_fail/T13947.stderr new file mode 100644 index 0000000..8a636a2 --- /dev/null +++ b/testsuite/tests/rename/should_fail/T13947.stderr @@ -0,0 +1,3 @@ + +T13947.hs:4:12: error: + Not in scope: type constructor or class ‘:~:’ diff --git a/testsuite/tests/rename/should_fail/all.T b/testsuite/tests/rename/should_fail/all.T index 9acd5b8..37d42d7 100644 --- a/testsuite/tests/rename/should_fail/all.T +++ b/testsuite/tests/rename/should_fail/all.T @@ -126,3 +126,4 @@ test('T12686', normal, compile_fail, ['']) test('T11592', normal, compile_fail, ['']) test('T12879', normal, compile_fail, ['']) test('T13568', normal, multimod_compile_fail, ['T13568','-v0']) +test('T13947', normal, compile_fail, ['']) From git at git.haskell.org Fri Aug 25 19:11:53 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 25 Aug 2017 19:11:53 +0000 (UTC) Subject: [commit: ghc] ghc-8.2: Fix #11963 by checking for more mixed type/kinds (18dee89) Message-ID: <20170825191153.E6E103A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.2 Link : http://ghc.haskell.org/trac/ghc/changeset/18dee8912f6afdcf13073d3d95d85513c14180e3/ghc >--------------------------------------------------------------- commit 18dee8912f6afdcf13073d3d95d85513c14180e3 Author: Richard Eisenberg Date: Tue Jul 18 15:49:38 2017 -0400 Fix #11963 by checking for more mixed type/kinds This is a straightforward fix -- there were just some omitted checks. test case: typecheck/should_fail/T11963 (cherry picked from commit 10d13b62c7ba8c44000a0d25afd66788de8040c4) >--------------------------------------------------------------- 18dee8912f6afdcf13073d3d95d85513c14180e3 compiler/rename/RnTypes.hs | 25 +++++++++++++++---- testsuite/tests/typecheck/should_fail/T11963.hs | 29 ++++++++++++++++++++++ .../tests/typecheck/should_fail/T11963.stderr | 20 +++++++++++++++ testsuite/tests/typecheck/should_fail/all.T | 1 + 4 files changed, 70 insertions(+), 5 deletions(-) diff --git a/compiler/rename/RnTypes.hs b/compiler/rename/RnTypes.hs index 0bf48ee..f829c4f 100644 --- a/compiler/rename/RnTypes.hs +++ b/compiler/rename/RnTypes.hs @@ -1706,11 +1706,25 @@ extract_hs_tv_bndrs tvs = do { FKTV bndr_kvs _ <- foldrM extract_lkind emptyFKTV [k | L _ (KindedTyVar _ k) <- tvs] - ; let locals = map hsLTyVarName tvs + ; let locals = map hsLTyVarLocName tvs + + -- These checks are all tested in typecheck/should_fail/T11963 + ; check_for_mixed_vars bndr_kvs acc_tvs + ; check_for_mixed_vars bndr_kvs body_tvs + ; check_for_mixed_vars body_tvs acc_kvs + ; check_for_mixed_vars body_kvs acc_tvs + ; check_for_mixed_vars locals body_kvs + ; return $ - FKTV (filterOut ((`elem` locals) . unLoc) (bndr_kvs ++ body_kvs) + FKTV (filterOut (`elemRdr` locals) (bndr_kvs ++ body_kvs) ++ acc_kvs) - (filterOut ((`elem` locals) . unLoc) body_tvs ++ acc_tvs) } + (filterOut (`elemRdr` locals) body_tvs ++ acc_tvs) } + where + check_for_mixed_vars :: [Located RdrName] -> [Located RdrName] -> RnM () + check_for_mixed_vars tvs1 tvs2 = mapM_ check tvs1 + where + check tv1 = when (isRdrTyVar (unLoc tv1) && (tv1 `elemRdr` tvs2)) $ + mixedVarsErr tv1 extract_tv :: TypeOrKind -> Located RdrName -> FreeKiTyVars -> RnM FreeKiTyVars extract_tv t_or_k ltv@(L _ tv) acc @@ -1725,8 +1739,6 @@ extract_tv t_or_k ltv@(L _ tv) acc mixedVarsErr ltv ; return (FKTV (ltv : kvs) tvs) } | otherwise = return acc - where - elemRdr x = any (eqLocated x) mixedVarsErr :: Located RdrName -> RnM () mixedVarsErr (L loc tv) @@ -1739,3 +1751,6 @@ mixedVarsErr (L loc tv) -- just used in this module; seemed convenient here nubL :: Eq a => [Located a] -> [Located a] nubL = nubBy eqLocated + +elemRdr :: Located RdrName -> [Located RdrName] -> Bool +elemRdr x = any (eqLocated x) diff --git a/testsuite/tests/typecheck/should_fail/T11963.hs b/testsuite/tests/typecheck/should_fail/T11963.hs new file mode 100644 index 0000000..c4f78ae --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T11963.hs @@ -0,0 +1,29 @@ +{-# LANGUAGE GADTs, PolyKinds, RankNTypes #-} + +module T11963 where + +-- this module should be rejected without TypeInType + +import Data.Proxy + +-- see code in RnTypes.extract_hs_tv_bndrs which checks for these bad cases + + -- bndr_kvs vs body_tvs +data Typ k t where + Typ :: (forall (a :: k -> *). a t -> a t) -> Typ k t + + -- bndr_kvs vs acc_tvs +foo :: (forall (t :: k). Proxy t) -> Proxy k +foo _ = undefined + + -- locals vs body_kvs +bar :: forall k. forall (t :: k). Proxy t +bar = undefined + + -- body_kvs vs acc_tvs +quux :: (forall t. Proxy (t :: k)) -> Proxy k +quux _ = undefined + + -- body_tvs vs acc_kvs +blargh :: (forall a. a -> Proxy k) -> Proxy (t :: k) +blargh _ = undefined diff --git a/testsuite/tests/typecheck/should_fail/T11963.stderr b/testsuite/tests/typecheck/should_fail/T11963.stderr new file mode 100644 index 0000000..74c3ab0 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T11963.stderr @@ -0,0 +1,20 @@ + +T11963.hs:13:26: error: + Variable ‘k’ used as both a kind and a type + Did you intend to use TypeInType? + +T11963.hs:16:22: error: + Variable ‘k’ used as both a kind and a type + Did you intend to use TypeInType? + +T11963.hs:20:15: error: + Variable ‘k’ used as both a kind and a type + Did you intend to use TypeInType? + +T11963.hs:24:32: error: + Variable ‘k’ used as both a kind and a type + Did you intend to use TypeInType? + +T11963.hs:28:33: error: + Variable ‘k’ used as both a kind and a type + Did you intend to use TypeInType? diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T index 6519122..c5a986d 100644 --- a/testsuite/tests/typecheck/should_fail/all.T +++ b/testsuite/tests/typecheck/should_fail/all.T @@ -434,3 +434,4 @@ test('T12709', normal, compile_fail, ['']) test('T13446', normal, compile_fail, ['']) test('T13320', normal, compile_fail, ['']) test('T13677', normal, compile_fail, ['']) +test('T11963', normal, compile_fail, ['']) From git at git.haskell.org Fri Aug 25 19:11:56 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 25 Aug 2017 19:11:56 +0000 (UTC) Subject: [commit: ghc] ghc-8.2: Ensure that we always link against libm (71797e5) Message-ID: <20170825191156.A679A3A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.2 Link : http://ghc.haskell.org/trac/ghc/changeset/71797e5ec7376247dd1c85e442d0529d88eb4286/ghc >--------------------------------------------------------------- commit 71797e5ec7376247dd1c85e442d0529d88eb4286 Author: Ben Gamari Date: Fri Jul 28 13:41:04 2017 -0400 Ensure that we always link against libm ld.gold is particularly picky that we declare all of our link dependencies on Nix. See #14022. Test Plan: Validate on Nix Reviewers: austin Subscribers: hvr, rwbarton, thomie GHC Trac Issues: #14022 Differential Revision: https://phabricator.haskell.org/D3787 (cherry picked from commit 0e3c10160472df082fd3decd98c2489a2f8e68bd) >--------------------------------------------------------------- 71797e5ec7376247dd1c85e442d0529d88eb4286 compiler/main/DriverPipeline.hs | 1 + compiler/main/SysTools.hs | 14 ++++++++++++++ 2 files changed, 15 insertions(+) diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs index df1ffd5..5accdcb 100644 --- a/compiler/main/DriverPipeline.hs +++ b/compiler/main/DriverPipeline.hs @@ -1919,6 +1919,7 @@ linkBinary' staticLink dflags o_files dep_packages = do ++ [ SysTools.Option "-o" , SysTools.FileOption "" output_fn ] + ++ libmLinkOpts ++ map SysTools.Option ( [] diff --git a/compiler/main/SysTools.hs b/compiler/main/SysTools.hs index fd3faf1..5601e2a 100644 --- a/compiler/main/SysTools.hs +++ b/compiler/main/SysTools.hs @@ -45,6 +45,9 @@ module SysTools ( Option(..), + -- platform-specifics + libmLinkOpts, + -- frameworks getPkgFrameworkOpts, getFrameworkOpts @@ -1736,6 +1739,7 @@ linkDynLib dflags0 o_files dep_packages runLink dflags ( map Option verbFlags + ++ libmLinkOpts ++ [ Option "-o" , FileOption "" output_fn ] @@ -1755,6 +1759,16 @@ linkDynLib dflags0 o_files dep_packages ++ map Option pkg_link_opts ) +-- | Some platforms require that we explicitly link against @libm@ if any +-- math-y things are used (which we assume to include all programs). See #14022. +libmLinkOpts :: [Option] +libmLinkOpts = +#if defined(HAVE_LIBM) + [Option "-lm"] +#else + [] +#endif + getPkgFrameworkOpts :: DynFlags -> Platform -> [InstalledUnitId] -> IO [String] getPkgFrameworkOpts dflags platform dep_packages | platformUsesFrameworks platform = do From git at git.haskell.org Fri Aug 25 19:11:59 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 25 Aug 2017 19:11:59 +0000 (UTC) Subject: [commit: ghc] ghc-8.2: Fix string escaping in JSON (1778256) Message-ID: <20170825191159.602E43A585@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.2 Link : http://ghc.haskell.org/trac/ghc/changeset/177825687916e8295d9bc0c1f694cecf76fd3d81/ghc >--------------------------------------------------------------- commit 177825687916e8295d9bc0c1f694cecf76fd3d81 Author: Dmitry Malikov Date: Sat Aug 5 16:28:40 2017 +0200 Fix string escaping in JSON It seems to that double quotes is not escaped well at the moment. We'd noticed this with @alexbiehl during the work on https://github.com/haskell/haddock/pull/645 (cherry picked from commit e8fe12f83b17dc39d9272d44c4168946fa54e7a0) >--------------------------------------------------------------- 177825687916e8295d9bc0c1f694cecf76fd3d81 compiler/utils/Json.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/utils/Json.hs b/compiler/utils/Json.hs index 1318ce2..ffbff50 100644 --- a/compiler/utils/Json.hs +++ b/compiler/utils/Json.hs @@ -39,7 +39,7 @@ escapeJsonString = concatMap escapeChar escapeChar '\n' = "\\n" escapeChar '\r' = "\\r" escapeChar '\t' = "\\t" - escapeChar '"' = "\"" + escapeChar '"' = "\\\"" escapeChar '\\' = "\\\\" escapeChar c | isControl c || fromEnum c >= 0x7f = uni_esc c escapeChar c = [c] From git at git.haskell.org Fri Aug 25 19:58:42 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 25 Aug 2017 19:58:42 +0000 (UTC) Subject: [commit: ghc] ghc-8.2: Do not discard insolubles in implications (a0558a5) Message-ID: <20170825195842.2C4FC3A584@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.2 Link : http://ghc.haskell.org/trac/ghc/changeset/a0558a5af9bdba208b629d04d729849166f565fd/ghc >--------------------------------------------------------------- commit a0558a5af9bdba208b629d04d729849166f565fd Author: Simon Peyton Jones Date: Thu Jul 27 14:52:38 2017 +0100 Do not discard insolubles in implications Trac #14000 showed up two errors * In TcRnTypes.dropInsolubles we dropped all implications, which might contain the very insolubles we wanted to keep. This was an outright error, and is why the out-of-scope error was actually lost altogether in Trac #14000 * In TcSimplify.simplifyInfer, if there are definite (insoluble) errors, it's better to suppress the following ambiguity test, because the type may be bogus anyway. See TcSimplify Note [Quantification with errors]. This fix seems a bit clunky, but it'll do for now. (cherry picked from commit 452755de717fad5d8fbfc6330cb42a3335c8912d) >--------------------------------------------------------------- a0558a5af9bdba208b629d04d729849166f565fd compiler/typecheck/TcBinds.hs | 22 ++-- compiler/typecheck/TcExpr.hs | 2 +- compiler/typecheck/TcPatSyn.hs | 4 +- compiler/typecheck/TcRnDriver.hs | 6 +- compiler/typecheck/TcRnTypes.hs | 8 +- compiler/typecheck/TcSimplify.hs | 124 ++++++++++++++------- testsuite/tests/parser/should_fail/T7848.hs | 2 +- testsuite/tests/parser/should_fail/T7848.stderr | 13 +-- testsuite/tests/th/T5358.stderr | 20 ++++ testsuite/tests/typecheck/should_fail/T14000.hs | 8 ++ .../tests/typecheck/should_fail/T14000.stderr | 2 + testsuite/tests/typecheck/should_fail/T8142.stderr | 26 +++-- testsuite/tests/typecheck/should_fail/all.T | 1 + 13 files changed, 161 insertions(+), 77 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 a0558a5af9bdba208b629d04d729849166f565fd From git at git.haskell.org Fri Aug 25 21:56:34 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 25 Aug 2017 21:56:34 +0000 (UTC) Subject: [commit: ghc] master: rts: Fix warnings on aarch64 and clean up style (f135fb2) Message-ID: <20170825215634.94BA63A584@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f135fb2ae31462d7451e304bbc06cfbb6c2566ea/ghc >--------------------------------------------------------------- commit f135fb2ae31462d7451e304bbc06cfbb6c2566ea Author: Ben Gamari Date: Thu Aug 24 12:48:19 2017 -0400 rts: Fix warnings on aarch64 and clean up style Reviewers: austin, erikd, simonmar Subscribers: rwbarton, thomie Differential Revision: https://phabricator.haskell.org/D3877 >--------------------------------------------------------------- f135fb2ae31462d7451e304bbc06cfbb6c2566ea rts/linker/Elf.c | 45 +++++++++++++++++++++++---------------------- 1 file changed, 23 insertions(+), 22 deletions(-) diff --git a/rts/linker/Elf.c b/rts/linker/Elf.c index e81b97a..4e881b0 100644 --- a/rts/linker/Elf.c +++ b/rts/linker/Elf.c @@ -1708,15 +1708,13 @@ do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC, int ocResolve_ELF ( ObjectCode* oc ) { - int ok; - Elf_Word i; char* ehdrC = (char*)(oc->image); Elf_Ehdr* ehdr = (Elf_Ehdr*) ehdrC; Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff); const Elf_Word shnum = elf_shnum(ehdr); #if defined(SHN_XINDEX) - Elf_Word* shndxTable = get_shndx_table(ehdr); + Elf_Word* shndxTable = get_shndx_table(ehdr); #endif /* resolve section symbols @@ -1749,9 +1747,9 @@ ocResolve_ELF ( ObjectCode* oc ) Elf_Word secno = symbol->elf_sym->st_shndx; #if defined(SHN_XINDEX) if (secno == SHN_XINDEX) { - ASSERT(shndxTable); - secno = shndxTable[i]; - } + ASSERT(shndxTable); + secno = shndxTable[i]; + } #endif ASSERT(symbol->elf_sym->st_name == 0); ASSERT(symbol->elf_sym->st_value == 0); @@ -1763,6 +1761,9 @@ ocResolve_ELF ( ObjectCode* oc ) #if defined(NEED_GOT) if(fillGot( oc )) return 0; + /* silence warnings */ + (void) shnum; + (void) shdr; #endif /* NEED_GOT */ #if defined(aarch64_HOST_ARCH) @@ -1770,27 +1771,27 @@ ocResolve_ELF ( ObjectCode* oc ) if(relocateObjectCode( oc )) return 0; #else - /* Process the relocation sections. */ - for (i = 0; i < shnum; i++) { - if (shdr[i].sh_type == SHT_REL) { - ok = do_Elf_Rel_relocations ( oc, ehdrC, shdr, i ); - if (!ok) - return ok; - } - else - if (shdr[i].sh_type == SHT_RELA) { - ok = do_Elf_Rela_relocations ( oc, ehdrC, shdr, i ); - if (!ok) - return ok; - } - } + /* Process the relocation sections. */ + for (Elf_Word i = 0; i < shnum; i++) { + if (shdr[i].sh_type == SHT_REL) { + bool ok = do_Elf_Rel_relocations ( oc, ehdrC, shdr, i ); + if (!ok) + return ok; + } + else + if (shdr[i].sh_type == SHT_RELA) { + bool ok = do_Elf_Rela_relocations ( oc, ehdrC, shdr, i ); + if (!ok) + return ok; + } + } #endif #if defined(powerpc_HOST_ARCH) - ocFlushInstructionCache( oc ); + ocFlushInstructionCache( oc ); #endif - return 1; + return 1; } int ocRunInit_ELF( ObjectCode *oc ) From git at git.haskell.org Fri Aug 25 21:56:37 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 25 Aug 2017 21:56:37 +0000 (UTC) Subject: [commit: ghc] master: rts: Fix references to Note [BFD import library] (80ccea8) Message-ID: <20170825215637.4CC773A584@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/80ccea855569e1e296829989f892f4a01c8543c5/ghc >--------------------------------------------------------------- commit 80ccea855569e1e296829989f892f4a01c8543c5 Author: Ben Gamari Date: Thu Aug 24 12:48:31 2017 -0400 rts: Fix references to Note [BFD import library] Reviewers: austin, erikd, simonmar Subscribers: rwbarton, thomie Differential Revision: https://phabricator.haskell.org/D3884 >--------------------------------------------------------------- 80ccea855569e1e296829989f892f4a01c8543c5 rts/LinkerInternals.h | 2 +- rts/RtsSymbolInfo.h | 2 +- rts/linker/PEi386.c | 1 + 3 files changed, 3 insertions(+), 2 deletions(-) diff --git a/rts/LinkerInternals.h b/rts/LinkerInternals.h index 05fa770..2e84917 100644 --- a/rts/LinkerInternals.h +++ b/rts/LinkerInternals.h @@ -32,7 +32,7 @@ typedef enum { /* Indication of section kinds for loaded objects. Needed by the GC for deciding whether or not a pointer on the stack is a code pointer. - See Note [BFD import libraries]. + See Note [BFD import library]. */ typedef enum { /* Section is code or readonly. e.g. .text or .r(o)data. */ diff --git a/rts/RtsSymbolInfo.h b/rts/RtsSymbolInfo.h index 9873ff3..08f14a5 100644 --- a/rts/RtsSymbolInfo.h +++ b/rts/RtsSymbolInfo.h @@ -11,7 +11,7 @@ #include "LinkerInternals.h" #include -/* See Note [BFD Import libraries]. */ +/* See Note [BFD Import library]. */ typedef enum _SymbolKind { KIND_NORMAL = 0x01, KIND_WEAK = 0x02, diff --git a/rts/linker/PEi386.c b/rts/linker/PEi386.c index 011b0a8..37d58af 100644 --- a/rts/linker/PEi386.c +++ b/rts/linker/PEi386.c @@ -58,6 +58,7 @@ tools. See note below. Note [BFD import library] + ~~~~~~~~~~~~~~~~~~~~~~~~~ On Windows, compilers don't link directly to dynamic libraries. The reason for this is that the exports are not always by symbol, the From git at git.haskell.org Fri Aug 25 21:56:31 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 25 Aug 2017 21:56:31 +0000 (UTC) Subject: [commit: ghc] master: Add strict variant of iterate (a67b66e) Message-ID: <20170825215631.D682D3A584@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a67b66e663d159c219750a5044ccf553c4b21bdb/ghc >--------------------------------------------------------------- commit a67b66e663d159c219750a5044ccf553c4b21bdb Author: Ben Gamari Date: Thu Aug 24 11:47:40 2017 -0400 Add strict variant of iterate Summary: This closes the nearly-eight-year-old #3474. Test Plan: Validate Reviewers: RyanGlScott, austin, hvr Subscribers: rwbarton, thomie GHC Trac Issues: #3474 Differential Revision: https://phabricator.haskell.org/D3870 >--------------------------------------------------------------- a67b66e663d159c219750a5044ccf553c4b21bdb libraries/base/Data/List.hs | 1 + libraries/base/Data/OldList.hs | 1 + libraries/base/GHC/List.hs | 30 ++++++++++++++++++++++++++++-- libraries/base/changelog.md | 3 +++ libraries/base/tests/T3474.hs | 5 +++++ libraries/base/tests/T3474.stdout | 1 + libraries/base/tests/all.T | 4 ++++ 7 files changed, 43 insertions(+), 2 deletions(-) diff --git a/libraries/base/Data/List.hs b/libraries/base/Data/List.hs index 693c0dd..2ac04a9 100644 --- a/libraries/base/Data/List.hs +++ b/libraries/base/Data/List.hs @@ -76,6 +76,7 @@ module Data.List -- ** Infinite lists , iterate + , iterate' , repeat , replicate , cycle diff --git a/libraries/base/Data/OldList.hs b/libraries/base/Data/OldList.hs index d03c0bc..c4c38d4 100644 --- a/libraries/base/Data/OldList.hs +++ b/libraries/base/Data/OldList.hs @@ -77,6 +77,7 @@ module Data.OldList -- ** Infinite lists , iterate + , iterate' , repeat , replicate , cycle diff --git a/libraries/base/GHC/List.hs b/libraries/base/GHC/List.hs index 70bfbe4..37bba9a 100644 --- a/libraries/base/GHC/List.hs +++ b/libraries/base/GHC/List.hs @@ -23,7 +23,7 @@ module GHC.List ( map, (++), filter, concat, head, last, tail, init, uncons, null, length, (!!), foldl, foldl', foldl1, foldl1', scanl, scanl1, scanl', foldr, foldr1, - scanr, scanr1, iterate, repeat, replicate, cycle, + scanr, scanr1, iterate, iterate', repeat, replicate, cycle, take, drop, sum, product, maximum, minimum, splitAt, takeWhile, dropWhile, span, break, reverse, and, or, any, all, elem, notElem, lookup, @@ -442,7 +442,10 @@ minimum xs = foldl1 min xs -- of @f@ to @x@: -- -- > iterate f x == [x, f x, f (f x), ...] - +-- +-- Note that 'iterate' is lazy, potentially leading to thunk build-up if +-- the consumer doesn't force each iterate. See 'iterate\'' for a strict +-- variant of this function. {-# NOINLINE [1] iterate #-} iterate :: (a -> a) -> a -> [a] iterate f x = x : iterate f (f x) @@ -458,6 +461,29 @@ iterateFB c f x0 = go x0 #-} +-- | 'iterate\'' is the strict version of 'iterate'. +-- +-- It ensures that the result of each application of force to weak head normal +-- form before proceeding. +{-# NOINLINE [1] iterate' #-} +iterate' :: (a -> a) -> a -> [a] +iterate' f x = + let x' = f x + in x' `seq` (x : iterate' f x') + +{-# INLINE [0] iterate'FB #-} -- See Note [Inline FB functions] +iterate'FB :: (a -> b -> b) -> (a -> a) -> a -> b +iterate'FB c f x0 = go x0 + where go x = + let x' = f x + in x' `seq` (x `c` go x') + +{-# RULES +"iterate'" [~1] forall f x. iterate' f x = build (\c _n -> iterate'FB c f x) +"iterate'FB" [1] iterate'FB (:) = iterate' + #-} + + -- | 'repeat' @x@ is an infinite list, with @x@ the value of every element. repeat :: a -> [a] {-# INLINE [0] repeat #-} diff --git a/libraries/base/changelog.md b/libraries/base/changelog.md index cce9fba..a8915cb 100644 --- a/libraries/base/changelog.md +++ b/libraries/base/changelog.md @@ -21,6 +21,9 @@ be able to successfully parse more strings containing `"Proxy"` _et al._ without surrounding parentheses (e.g., `"Thing Proxy"`) (#12874). + * Add `iterate'`, a strict version of `iterate`, to `Data.List` + and `Data.OldList` (#3474) + ## 4.10.0.0 *April 2017* * Bundled with GHC *TBA* diff --git a/libraries/base/tests/T3474.hs b/libraries/base/tests/T3474.hs new file mode 100644 index 0000000..dbd5901 --- /dev/null +++ b/libraries/base/tests/T3474.hs @@ -0,0 +1,5 @@ +import Data.List + +-- this should evaluate in constant space +main :: IO () +main = print $ iterate' (+1) 1 !! 100000000 diff --git a/libraries/base/tests/T3474.stdout b/libraries/base/tests/T3474.stdout new file mode 100644 index 0000000..2e8da1a --- /dev/null +++ b/libraries/base/tests/T3474.stdout @@ -0,0 +1 @@ +100000001 \ No newline at end of file diff --git a/libraries/base/tests/all.T b/libraries/base/tests/all.T index 970fb7e..9055bd5 100644 --- a/libraries/base/tests/all.T +++ b/libraries/base/tests/all.T @@ -217,3 +217,7 @@ test('T13191', test('T13525', when(opsys('mingw32'), skip), compile_and_run, ['']) test('T13097', normal, compile_and_run, ['']) test('functorOperators', normal, compile_and_run, ['']) +test('T3474', + [stats_num_field('max_bytes_used', [ (wordsize(64), 44504, 5) ]), + only_ways(['normal'])], + compile_and_run, ['-O']) From git at git.haskell.org Fri Aug 25 21:56:40 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 25 Aug 2017 21:56:40 +0000 (UTC) Subject: [commit: ghc] master: Rip out mkUserGuidePart (8f19c65) Message-ID: <20170825215640.289A23A584@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8f19c65c66e38709a8acba8f86015053d2c04126/ghc >--------------------------------------------------------------- commit 8f19c65c66e38709a8acba8f86015053d2c04126 Author: Ben Gamari Date: Thu Aug 24 12:49:06 2017 -0400 Rip out mkUserGuidePart Reviewers: austin, hvr Subscribers: rwbarton, thomie, erikd Differential Revision: https://phabricator.haskell.org/D3886 >--------------------------------------------------------------- 8f19c65c66e38709a8acba8f86015053d2c04126 compiler/main/DynFlags.hs | 16 +- configure.ac | 2 +- docs/users_guide/Makefile | 3 - docs/users_guide/editing-guide.rst | 11 - ghc.mk | 18 +- utils/mkUserGuidePart/DList.hs | 13 - utils/mkUserGuidePart/Main.hs | 110 --- utils/mkUserGuidePart/Makefile | 15 - utils/mkUserGuidePart/Options.hs | 66 -- utils/mkUserGuidePart/Options/CodeGen.hs | 52 -- utils/mkUserGuidePart/Options/CompilerDebugging.hs | 287 -------- utils/mkUserGuidePart/Options/Cpp.hs | 25 - utils/mkUserGuidePart/Options/FindingImports.hs | 15 - utils/mkUserGuidePart/Options/Interactive.hs | 65 -- utils/mkUserGuidePart/Options/InterfaceFiles.hs | 23 - .../Options/KeepingIntermediates.hs | 36 - utils/mkUserGuidePart/Options/Language.hs | 775 --------------------- utils/mkUserGuidePart/Options/Linking.hs | 149 ---- utils/mkUserGuidePart/Options/Misc.hs | 40 -- utils/mkUserGuidePart/Options/Modes.hs | 69 -- .../mkUserGuidePart/Options/OptimizationLevels.hs | 29 - utils/mkUserGuidePart/Options/Optimizations.hs | 379 ---------- utils/mkUserGuidePart/Options/Packages.hs | 75 -- utils/mkUserGuidePart/Options/PhasePrograms.hs | 58 -- utils/mkUserGuidePart/Options/PhaseSpecific.hs | 47 -- utils/mkUserGuidePart/Options/Phases.hs | 33 - utils/mkUserGuidePart/Options/PlatformSpecific.hs | 15 - utils/mkUserGuidePart/Options/Plugin.hs | 17 - utils/mkUserGuidePart/Options/Profiling.hs | 44 -- utils/mkUserGuidePart/Options/ProgramCoverage.hs | 18 - .../Options/RecompilationChecking.hs | 15 - utils/mkUserGuidePart/Options/RedirectingOutput.hs | 59 -- utils/mkUserGuidePart/Options/TemporaryFiles.hs | 11 - utils/mkUserGuidePart/Options/Verbosity.hs | 88 --- utils/mkUserGuidePart/Options/Warnings.hs | 477 ------------- utils/mkUserGuidePart/Table.hs | 75 -- utils/mkUserGuidePart/Types.hs | 18 - utils/mkUserGuidePart/ghc.mk | 93 --- utils/mkUserGuidePart/mkUserGuidePart.cabal.in | 55 -- 39 files changed, 7 insertions(+), 3389 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 8f19c65c66e38709a8acba8f86015053d2c04126 From git at git.haskell.org Fri Aug 25 21:56:42 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 25 Aug 2017 21:56:42 +0000 (UTC) Subject: [commit: ghc] master: rts: Fix ASSERTs with space before opening paren (76e59a2) Message-ID: <20170825215642.D7A393A584@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/76e59a270118080d61e0c272011d318c68790951/ghc >--------------------------------------------------------------- commit 76e59a270118080d61e0c272011d318c68790951 Author: Ben Gamari Date: Thu Aug 24 12:48:54 2017 -0400 rts: Fix ASSERTs with space before opening paren Reviewers: austin, erikd, simonmar Subscribers: rwbarton, thomie Differential Revision: https://phabricator.haskell.org/D3885 >--------------------------------------------------------------- 76e59a270118080d61e0c272011d318c68790951 rts/linker/PEi386.c | 26 +++++++++++++------------- 1 file changed, 13 insertions(+), 13 deletions(-) diff --git a/rts/linker/PEi386.c b/rts/linker/PEi386.c index 37d58af..4378a0a 100644 --- a/rts/linker/PEi386.c +++ b/rts/linker/PEi386.c @@ -403,7 +403,7 @@ COFF_HEADER_INFO* getHeaderInfo ( ObjectCode* oc ) __attribute__ ((always_inline)) inline size_t getSymbolSize ( COFF_HEADER_INFO *info ) { - ASSERT (info); + ASSERT(info); switch (info->type) { case COFF_ANON_BIG_OBJ: @@ -416,8 +416,8 @@ size_t getSymbolSize ( COFF_HEADER_INFO *info ) __attribute__ ((always_inline)) inline int32_t getSymSectionNumber ( COFF_HEADER_INFO *info, COFF_symbol* sym ) { - ASSERT (info); - ASSERT (sym); + ASSERT(info); + ASSERT(sym); switch (info->type) { case COFF_ANON_BIG_OBJ: @@ -430,8 +430,8 @@ int32_t getSymSectionNumber ( COFF_HEADER_INFO *info, COFF_symbol* sym ) __attribute__ ((always_inline)) inline uint32_t getSymValue ( COFF_HEADER_INFO *info, COFF_symbol* sym ) { - ASSERT (info); - ASSERT (sym); + ASSERT(info); + ASSERT(sym); switch (info->type) { case COFF_ANON_BIG_OBJ: @@ -444,8 +444,8 @@ uint32_t getSymValue ( COFF_HEADER_INFO *info, COFF_symbol* sym ) __attribute__ ((always_inline)) inline uint8_t getSymStorageClass ( COFF_HEADER_INFO *info, COFF_symbol* sym ) { - ASSERT (info); - ASSERT (sym); + ASSERT(info); + ASSERT(sym); switch (info->type) { case COFF_ANON_BIG_OBJ: @@ -458,8 +458,8 @@ uint8_t getSymStorageClass ( COFF_HEADER_INFO *info, COFF_symbol* sym ) __attribute__ ((always_inline)) inline uint8_t getSymNumberOfAuxSymbols ( COFF_HEADER_INFO *info, COFF_symbol* sym ) { - ASSERT (info); - ASSERT (sym); + ASSERT(info); + ASSERT(sym); switch (info->type) { case COFF_ANON_BIG_OBJ: @@ -472,8 +472,8 @@ uint8_t getSymNumberOfAuxSymbols ( COFF_HEADER_INFO *info, COFF_symbol* sym ) __attribute__ ((always_inline)) inline uint16_t getSymType ( COFF_HEADER_INFO *info, COFF_symbol* sym ) { - ASSERT (info); - ASSERT (sym); + ASSERT(info); + ASSERT(sym); switch (info->type) { case COFF_ANON_BIG_OBJ: @@ -486,8 +486,8 @@ uint16_t getSymType ( COFF_HEADER_INFO *info, COFF_symbol* sym ) __attribute__ ((always_inline)) inline uint8_t* getSymShortName ( COFF_HEADER_INFO *info, COFF_symbol* sym ) { - ASSERT (info); - ASSERT (sym); + ASSERT(info); + ASSERT(sym); switch (info->type) { case COFF_ANON_BIG_OBJ: From git at git.haskell.org Sat Aug 26 03:38:20 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 26 Aug 2017 03:38:20 +0000 (UTC) Subject: [commit: ghc] master: Fix two typos in the ImpredicativeTypes user guide (83484a6) Message-ID: <20170826033820.2398A3A584@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/83484a6850ae30fb26c405e015a8bda1e65d56d7/ghc >--------------------------------------------------------------- commit 83484a6850ae30fb26c405e015a8bda1e65d56d7 Author: Benjamin Hodgson Date: Fri Aug 25 16:22:09 2017 +0100 Fix two typos in the ImpredicativeTypes user guide >--------------------------------------------------------------- 83484a6850ae30fb26c405e015a8bda1e65d56d7 docs/users_guide/glasgow_exts.rst | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/docs/users_guide/glasgow_exts.rst b/docs/users_guide/glasgow_exts.rst index 3083d43..672670e 100644 --- a/docs/users_guide/glasgow_exts.rst +++ b/docs/users_guide/glasgow_exts.rst @@ -10596,13 +10596,13 @@ consistently, or working the same in subsequent releases. See :ghc-wiki:`this wiki page ` for more details. If you want impredicative polymorphism, the main workaround is to use a -newtype wrapper. The ``id runST`` example can be written using theis +newtype wrapper. The ``id runST`` example can be written using this workaround like this: :: runST :: (forall s. ST s a) -> a id :: forall b. b -> b - nwetype Wrap a = Wrap { unWrap :: (forall s. ST s a) -> a } + newtype Wrap a = Wrap { unWrap :: (forall s. ST s a) -> a } foo :: (forall s. ST s a) -> a foo = unWrap (id (Wrap runST)) From git at git.haskell.org Sat Aug 26 23:14:59 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 26 Aug 2017 23:14:59 +0000 (UTC) Subject: [commit: ghc] wip/perf-testsuite: Fix importing issue in testsuite driver (b9e3527) Message-ID: <20170826231459.C9F343A584@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/perf-testsuite Link : http://ghc.haskell.org/trac/ghc/changeset/b9e3527744ff5783d6978683f763013ac5c7297f/ghc >--------------------------------------------------------------- commit b9e3527744ff5783d6978683f763013ac5c7297f Author: Jared Weakly Date: Thu Aug 24 14:24:36 2017 -0700 Fix importing issue in testsuite driver >--------------------------------------------------------------- b9e3527744ff5783d6978683f763013ac5c7297f testsuite/driver/perf_notes.py | 221 +++++++++++++++++++---------------------- testsuite/driver/testutil.py | 22 +++- 2 files changed, 125 insertions(+), 118 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 b9e3527744ff5783d6978683f763013ac5c7297f From git at git.haskell.org Sat Aug 26 23:15:02 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 26 Aug 2017 23:15:02 +0000 (UTC) Subject: [commit: ghc] wip/perf-testsuite: Setup initial support new configure function to replace num_stats_field (3c06620) Message-ID: <20170826231502.923FD3A584@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/perf-testsuite Link : http://ghc.haskell.org/trac/ghc/changeset/3c066207a06d6dd5c8cad2adb39b03eaafe29365/ghc >--------------------------------------------------------------- commit 3c066207a06d6dd5c8cad2adb39b03eaafe29365 Author: Jared Weakly Date: Sat Aug 26 16:16:40 2017 -0700 Setup initial support new configure function to replace num_stats_field >--------------------------------------------------------------- 3c066207a06d6dd5c8cad2adb39b03eaafe29365 testsuite/driver/perf_notes.py | 90 ++++++++++++++-------- testsuite/driver/testglobals.py | 4 +- testsuite/driver/testlib.py | 162 ++++++++++++---------------------------- 3 files changed, 109 insertions(+), 147 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 3c066207a06d6dd5c8cad2adb39b03eaafe29365 From git at git.haskell.org Sat Aug 26 23:21:34 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 26 Aug 2017 23:21:34 +0000 (UTC) Subject: [commit: ghc] wip/kavon-nosplit-llvm: storing retTy in cg state monad (305cec6) Message-ID: <20170826232134.34F233A584@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/kavon-nosplit-llvm Link : http://ghc.haskell.org/trac/ghc/changeset/305cec6fc8fd85c99abd25dc58d12eb76a617e28/ghc >--------------------------------------------------------------- commit 305cec6fc8fd85c99abd25dc58d12eb76a617e28 Author: Kavon Farvardin Date: Thu Aug 24 16:29:50 2017 -0500 storing retTy in cg state monad >--------------------------------------------------------------- 305cec6fc8fd85c99abd25dc58d12eb76a617e28 compiler/cmm/Cmm.hs | 4 +++- compiler/codeGen/StgCmmBind.hs | 11 +++++++++-- compiler/codeGen/StgCmmMonad.hs | 19 ++++++++++++++++++- 3 files changed, 30 insertions(+), 4 deletions(-) diff --git a/compiler/cmm/Cmm.hs b/compiler/cmm/Cmm.hs index b77688c..0ec516c 100644 --- a/compiler/cmm/Cmm.hs +++ b/compiler/cmm/Cmm.hs @@ -6,7 +6,7 @@ module Cmm ( CmmProgram, CmmGroup, GenCmmGroup, CmmDecl, GenCmmDecl(..), CmmGraph, GenCmmGraph(..), - CmmBlock, + CmmBlock, CmmRetTy, RawCmmDecl, RawCmmGroup, Section(..), SectionType(..), CmmStatics(..), CmmStatic(..), isSecConstant, @@ -59,6 +59,8 @@ type GenCmmGroup d h g = [GenCmmDecl d h g] type CmmGroup = GenCmmGroup CmmStatics CmmTopInfo CmmGraph type RawCmmGroup = GenCmmGroup CmmStatics (LabelMap CmmStatics) CmmGraph +type CmmRetTy = Maybe [CmmType] + ----------------------------------------------------------------------------- -- CmmDecl, GenCmmDecl ----------------------------------------------------------------------------- diff --git a/compiler/codeGen/StgCmmBind.hs b/compiler/codeGen/StgCmmBind.hs index 9875b8d..dfdac74 100644 --- a/compiler/codeGen/StgCmmBind.hs +++ b/compiler/codeGen/StgCmmBind.hs @@ -508,12 +508,18 @@ closureCodeBody top_lvl bndr cl_info cc args arity body fv_details -- heap check, to reduce live vars over check ; when node_points $ load_fvs node lf_info fv_bindings ; retKind <- cgExpr body - ; let !x = trace (retK2s retKind) () + ; saveRetKind retKind + -- ; let !x = trace (retK2s retKind) () ; return () }}} } +saveRetKind :: ReturnKind -> FCode () +saveRetKind (Returning tys) = updateRetTy $ Just tys +saveRetKind AssignedDirectly = updateRetTy Nothing +saveRetKind (ReturnedTo _ _ _) = panic "saveRetKind" + -- start of temporary debugging utils -- retK2s :: ReturnKind -> String @@ -607,7 +613,8 @@ thunkCode cl_info fv_details _cc node arity body ; fv_bindings <- mapM bind_fv fv_details ; load_fvs node lf_info fv_bindings ; retKind <- cgExpr body - ; let !x = trace (retK2s retKind) () + ; saveRetKind retKind + -- ; let !x = trace (retK2s retKind) () ; return () }}} diff --git a/compiler/codeGen/StgCmmMonad.hs b/compiler/codeGen/StgCmmMonad.hs index 05be4fd..d950d48 100644 --- a/compiler/codeGen/StgCmmMonad.hs +++ b/compiler/codeGen/StgCmmMonad.hs @@ -36,6 +36,7 @@ module StgCmmMonad ( Sequel(..), ReturnKind(..), withSequel, getSequel, combineReturnKinds, + updateRetTy, getRetTy, setTickyCtrLabel, getTickyCtrLabel, tickScope, getTickScope, @@ -265,7 +266,7 @@ data ReturnKind combineReturnKinds :: [ReturnKind] -> ReturnKind combineReturnKinds rks = foldl combine AssignedDirectly rks where - combine (Returning a) (Returning b) = Returning $ tryCheck a b + combine (Returning a) (Returning b) = Returning $ check a b combine _ (Returning b) = Returning b combine acc _ = acc @@ -382,6 +383,8 @@ data CgState = MkCgState { cgs_stmts :: CmmAGraph, -- Current procedure + cgs_ret_ty :: CmmRetTy, -- Current procedure's return type. + cgs_tops :: OrdList CmmDecl, -- Other procedures and data blocks in this compilation unit -- Both are ordered only so that we can @@ -438,6 +441,7 @@ Hp register. (Changing virtHp doesn't matter.) initCgState :: UniqSupply -> CgState initCgState uniqs = MkCgState { cgs_stmts = mkNop + , cgs_ret_ty = Nothing , cgs_tops = nilOL , cgs_binds = emptyVarEnv , cgs_hp_usg = initHpUsage @@ -519,6 +523,18 @@ setBinds new_binds = do state <- getState setState $ state {cgs_binds = new_binds} +getRetTy :: FCode CmmRetTy +getRetTy = do + state <- getState + return $ cgs_ret_ty state + +updateRetTy :: CmmRetTy -> FCode () +updateRetTy new_ty = do + state <- getState + case cgs_ret_ty state of + Nothing -> setState $ state {cgs_ret_ty = new_ty} + Just _ -> panic "updateRetTy: already have retTy info" + withState :: FCode a -> CgState -> FCode (a,CgState) withState (FCode fcode) newstate = FCode $ \info_down state -> case fcode info_down newstate of @@ -848,6 +864,7 @@ emitProc_ :: Maybe CmmInfoTable -> CLabel -> [GlobalReg] -> CmmAGraphScoped emitProc_ mb_info lbl live blocks offset do_layout = do { dflags <- getDynFlags ; l <- newBlockId + ; retTy <- getRetTy ; let blks = labelAGraph l blocks From git at git.haskell.org Sat Aug 26 23:21:36 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 26 Aug 2017 23:21:36 +0000 (UTC) Subject: [commit: ghc] wip/kavon-nosplit-llvm: carry return type info from STG.codeGen to codeOutput (48cb5e1) Message-ID: <20170826232136.EDA9D3A584@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/kavon-nosplit-llvm Link : http://ghc.haskell.org/trac/ghc/changeset/48cb5e125c466881dc15970a2ed4d2b0e5556c9f/ghc >--------------------------------------------------------------- commit 48cb5e125c466881dc15970a2ed4d2b0e5556c9f Author: Kavon Farvardin Date: Sat Aug 26 18:20:51 2017 -0500 carry return type info from STG.codeGen to codeOutput >--------------------------------------------------------------- 48cb5e125c466881dc15970a2ed4d2b0e5556c9f compiler/cmm/Cmm.hs | 38 +++++++++++++++++++++++++++++++++++--- compiler/cmm/CmmBuildInfoTables.hs | 34 +++++++++++++++++----------------- compiler/cmm/CmmContFlowOpt.hs | 10 +++++----- compiler/cmm/CmmInfo.hs | 26 +++++++++++++------------- compiler/cmm/CmmLayoutStack.hs | 6 +++--- compiler/cmm/CmmParse.y | 4 +++- compiler/cmm/CmmPipeline.hs | 12 ++++++------ compiler/codeGen/StgCmm.hs | 9 +++++---- compiler/codeGen/StgCmmMonad.hs | 11 +++++------ compiler/main/CodeOutput.hs | 9 ++++++--- compiler/main/HscMain.hs | 4 ++-- 11 files changed, 100 insertions(+), 63 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 48cb5e125c466881dc15970a2ed4d2b0e5556c9f From git at git.haskell.org Sun Aug 27 18:31:46 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 27 Aug 2017 18:31:46 +0000 (UTC) Subject: [commit: ghc] branch 'wip/T14152' created Message-ID: <20170827183146.AD0723A584@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/T14152 Referencing: 60e0558fa08e56eb8c783eb0e512ceebe27e1f48 From git at git.haskell.org Sun Aug 27 18:31:49 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 27 Aug 2017 18:31:49 +0000 (UTC) Subject: [commit: ghc] wip/T14152: Implement exitify (unused for now) #14152 (fc56305) Message-ID: <20170827183149.6BC473A584@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14152 Link : http://ghc.haskell.org/trac/ghc/changeset/fc563059b338d18059db4b4b28bf2d12b44a39a0/ghc >--------------------------------------------------------------- commit fc563059b338d18059db4b4b28bf2d12b44a39a0 Author: Joachim Breitner Date: Sat Aug 26 14:35:50 2017 +0200 Implement exitify (unused for now) #14152 >--------------------------------------------------------------- fc563059b338d18059db4b4b28bf2d12b44a39a0 compiler/simplCore/Simplify.hs | 89 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 89 insertions(+) diff --git a/compiler/simplCore/Simplify.hs b/compiler/simplCore/Simplify.hs index 6ccd1f2..ce25b58 100644 --- a/compiler/simplCore/Simplify.hs +++ b/compiler/simplCore/Simplify.hs @@ -53,6 +53,10 @@ import Pair import Util import ErrUtils import Module ( moduleName, pprModuleName ) +import State +import Unique +import VarSet +import CoreFVs {- The guts of the simplifier is in this module, but the driver loop for @@ -1682,6 +1686,91 @@ maybeLoopify (Rec [(bndr, rhs)]) } maybeLoopify _ = Nothing +-- TODO: Move to a more appropriate module +-- +-- | Given a recursive group of a joinrec), identifies “exit paths” and binds them as +-- join-points outside the joinrec. +exitify :: [Unique] -> [(InId,InExpr)] -> (InExpr -> InExpr) +exitify exitUniques pairs = + ASSERT (all (isJoinId . fst) pairs) + \body -> mkExitLets exits (mkLetRec pairs' body) + where + mkExitLets ((exitId, exitRhs):exits') = mkLetNonRec exitId exitRhs . mkExitLets exits' + mkExitLets [] = id + + (exits,pairs') = (`evalState` (exitUniques, [])) $ do + pairs' <- forM pairs $ \(x,rhs) -> do + -- go past the lambdas + let (args, body) = collectNBinders (idJoinArity x) rhs + body' <- go args body + let rhs' = mkLams args body' + return (x, rhs') + exits <- gets snd + return (exits, pairs') + + recursive_calls = mkVarSet $ map fst pairs + + -- main working function. Goes through the RHS (tail-call positions only), + -- checks if there are no more recursive calls, if so, abstracts over + -- variables bound on the way and lifts it out as a join point. + -- + -- Uses a state monad to track of the fresh uniques for the new join points, + -- and the floated binds + go :: [Var] -- ^ variables to abstract over + -> InExpr -- ^ current expression in tail position + -> State ([Unique], [(InId, InExpr)]) InExpr + + go captured e + -- Do not touch an expression that is already a join call with no free variables + -- in the arguments + | (Var f, args) <- collectArgs e + , isJoinId f + , isEmptyVarSet (exprsFreeVars args `minusVarSet` mkVarSet captured) + = return e + + -- Do not touch a boring expression + | is_exit, not is_interesting = return e + + -- We have something to float out! + | is_exit = do + -- create an id for the exit path + u <- getUnique + let res_ty = exprType e + args = filter (`elemVarSet` fvs) captured + args_tys = map idType args + ty = mkFunTys args_tys res_ty + v = mkSysLocal (fsLit "exit") u ty `asJoinId` length args + rhs = mkLams args e + e' = mkVarApps (Var v) args + addExit v rhs + return e' + where + -- An exit expression has no recursive calls + is_exit = disjointVarSet fvs recursive_calls + -- An interesting exit expression has free variables from + -- outside the recursive group + is_interesting = not (isEmptyVarSet (fvs `minusVarSet` mkVarSet captured)) + fvs = exprFreeVars e + + + go captured (Case scrut bndr ty alts) = do + alts' <- mapM (goAlt (bndr:captured)) alts + return $ Case scrut bndr ty alts' + go _ e = return e + + goAlt captured (dc, pats, rhs) = do + rhs' <- go (pats ++ captured) rhs + return (dc, pats, rhs') + + getUnique = do + (u:us, fs) <- get + put (us, fs) + return u + + addExit v rhs = do + (us, fs) <- get + put (us, (v,rhs):fs) + {- ************************************************************************ * * From git at git.haskell.org Sun Aug 27 18:31:52 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 27 Aug 2017 18:31:52 +0000 (UTC) Subject: [commit: ghc] wip/T14152: Call exitify from loopification (60e0558) Message-ID: <20170827183152.2221E3A584@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14152 Link : http://ghc.haskell.org/trac/ghc/changeset/60e0558fa08e56eb8c783eb0e512ceebe27e1f48/ghc >--------------------------------------------------------------- commit 60e0558fa08e56eb8c783eb0e512ceebe27e1f48 Author: Joachim Breitner Date: Sat Aug 26 14:36:17 2017 +0200 Call exitify from loopification which is not pretty, as we now need to feed uniques to exitify, and it is not satisfactory, as we want to do this also to recursive joinpoints that do not arise via loopification. >--------------------------------------------------------------- 60e0558fa08e56eb8c783eb0e512ceebe27e1f48 compiler/simplCore/Simplify.hs | 43 +++++++++++++++++++++++++----------------- 1 file changed, 26 insertions(+), 17 deletions(-) diff --git a/compiler/simplCore/Simplify.hs b/compiler/simplCore/Simplify.hs index ce25b58..7d83be6 100644 --- a/compiler/simplCore/Simplify.hs +++ b/compiler/simplCore/Simplify.hs @@ -267,16 +267,20 @@ simplTopBinds env0 binds0 -- simpl_binds :: SimplEnv -> [InBind] -> SimplM SimplEnv simpl_binds env [] = return env - simpl_binds env (bind:binds) = do { env' <- simpl_bind env bind + simpl_binds env (bind:binds) = do { env' <- simpl_bind1 env bind ; simpl_binds env' binds } - simpl_bind env bind | Just bind' <- maybeLoopify bind - = simpl_bind env bind' - simpl_bind env (Rec pairs) = simplRecBind env TopLevel Nothing pairs - simpl_bind env (NonRec b r) = do { (env', b') <- addBndrRules env b (lookupRecBndr env b) - ; simplRecOrTopPair env' TopLevel - NonRecursive Nothing - b b' r } + simpl_bind1 env bind = do + us <- getUniquesM + case maybeLoopify us bind of + Just bind' -> simpl_bind1 env bind' + Nothing -> simpl_bind2 env bind + + simpl_bind2 env (Rec pairs) = simplRecBind env TopLevel Nothing pairs + simpl_bind2 env (NonRec b r) = do { (env', b') <- addBndrRules env b (lookupRecBndr env b) + ; simplRecOrTopPair env' TopLevel + NonRecursive Nothing + b b' r } {- ************************************************************************ @@ -1133,14 +1137,19 @@ simplExprF1 env (Case scrut bndr _ alts) cont env'' = env `addLetFloats` env' ; rebuildCase env'' scrut'' bndr alts cont } -simplExprF1 env (Let bind body) cont - | Just bind' <- maybeLoopify bind - = simplExprF1 env (Let bind' body) cont +simplExprF1 env (Let bind body) cont = do + us <- getUniquesM + case maybeLoopify us bind of + Just bind' -> simplExprF1 env (Let bind' body) cont + Nothing -> simplExprF1Let env bind body cont -simplExprF1 env (Let (Rec pairs) body) cont +-- This is an ugly indirection to make a decision based on maybeLoopify, which +-- needs the monadic getUniquesM. Should be cleaned up before merging. +simplExprF1Let :: SimplEnv -> Bind InId -> InExpr -> SimplCont -> SimplM (SimplEnv, OutExpr) +simplExprF1Let env (Rec pairs) body cont = simplRecE env pairs body cont -simplExprF1 env (Let (NonRec bndr rhs) body) cont +simplExprF1Let env (NonRec bndr rhs) body cont | Type ty <- rhs -- First deal with type lets (let a = Type ty in e) = ASSERT( isTyVar bndr ) do { ty' <- simplType env ty @@ -1670,8 +1679,8 @@ simplRecE env pairs body cont -- Is this a tail-recursive function that we want to loopify? Then -- lets loopify it and simplify that -maybeLoopify :: InBind -> Maybe InBind -maybeLoopify (Rec [(bndr, rhs)]) +maybeLoopify :: [Unique] -> InBind -> Maybe InBind +maybeLoopify exitUniques (Rec [(bndr, rhs)]) | Just (bndr', join_bndr, join_rhs) <- loopificationJoinPointBinding_maybe bndr rhs = do { let Just arity = isJoinId_maybe join_bndr ; let (join_params, _join_body) = collectNBinders arity join_rhs @@ -1680,11 +1689,11 @@ maybeLoopify (Rec [(bndr, rhs)]) | var <- join_params ] -- Some might be marked as dead (in the RHS), but there are not dead here ; let rhs' = mkLams join_params' $ - mkLetRec [(join_bndr,join_rhs)] $ + exitify exitUniques [(join_bndr,join_rhs)] $ mkVarApps (Var join_bndr) join_params' ; Just (NonRec bndr' rhs') } -maybeLoopify _ = Nothing +maybeLoopify _ _ = Nothing -- TODO: Move to a more appropriate module -- From git at git.haskell.org Mon Aug 28 02:35:28 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 28 Aug 2017 02:35:28 +0000 (UTC) Subject: [commit: ghc] wip/kavon-nosplit-llvm: fixed an issue with float reg return conv (90d2b8e) Message-ID: <20170828023528.A6CF93A584@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/kavon-nosplit-llvm Link : http://ghc.haskell.org/trac/ghc/changeset/90d2b8e3dfb8563c19abb1ffc6750bdb21bd7617/ghc >--------------------------------------------------------------- commit 90d2b8e3dfb8563c19abb1ffc6750bdb21bd7617 Author: Kavon Farvardin Date: Sun Aug 27 17:12:57 2017 -0500 fixed an issue with float reg return conv >--------------------------------------------------------------- 90d2b8e3dfb8563c19abb1ffc6750bdb21bd7617 compiler/codeGen/CgUtils.hs | 3 +- compiler/llvmGen/LlvmCodeGen.hs | 23 ++++++----- compiler/llvmGen/LlvmCodeGen/Base.hs | 73 ++++++++++++++++++++------------- compiler/llvmGen/LlvmCodeGen/CodeGen.hs | 54 +++++++++++------------- compiler/llvmGen/LlvmCodeGen/Ppr.hs | 4 +- compiler/main/CodeOutput.hs | 4 +- 6 files changed, 86 insertions(+), 75 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 90d2b8e3dfb8563c19abb1ffc6750bdb21bd7617 From git at git.haskell.org Mon Aug 28 18:33:58 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 28 Aug 2017 18:33:58 +0000 (UTC) Subject: [commit: ghc] master: Adjust test suite stats (a055f24) Message-ID: <20170828183358.6DC243A584@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a055f240aeda538c656a59e810870e6a2ccc2db7/ghc >--------------------------------------------------------------- commit a055f240aeda538c656a59e810870e6a2ccc2db7 Author: David Feuer Date: Mon Aug 28 14:35:19 2017 -0400 Adjust test suite stats T1969 and T12150 were failing (stat too high) >--------------------------------------------------------------- a055f240aeda538c656a59e810870e6a2ccc2db7 testsuite/tests/perf/compiler/all.T | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T index 1da2883..cf49981 100644 --- a/testsuite/tests/perf/compiler/all.T +++ b/testsuite/tests/perf/compiler/all.T @@ -72,7 +72,7 @@ test('T1969', # 2017-03-24 9261052 (x86/Linux, 64-bit machine) # 2017-04-06 9418680 (x86/Linux, 64-bit machine) - (wordsize(64), 16679176, 15)]), + (wordsize(64), 19199872, 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. @@ -87,6 +87,7 @@ test('T1969', # 2017-02-01 19924328 (amd64/Linux) Join points (#12988) # 2017-02-14 16393848 Early inline patch # 2017-03-31 16679176 Fix memory leak in simplifier + # 2017-08-25 19199872 Refactor the Mighty Simplifier compiler_stats_num_field('bytes allocated', [(platform('i386-unknown-mingw32'), 301784492, 5), @@ -1110,7 +1111,8 @@ test('T12150', [ only_ways(['optasm']), compiler_stats_num_field('bytes allocated', [(wordsize(64), 70773000, 5) - # initial: 70773000 + # initial: 70773000 + # 2017-08-25: 74358208 Refactor the Mighty Simplifier ]), ], compile, From git at git.haskell.org Mon Aug 28 19:31:59 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 28 Aug 2017 19:31:59 +0000 (UTC) Subject: [commit: ghc] master: Actually bump T12150 (682e8e6) Message-ID: <20170828193159.8DB393A584@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/682e8e6e01cd9c96378692656649094ad44c35a7/ghc >--------------------------------------------------------------- commit 682e8e6e01cd9c96378692656649094ad44c35a7 Author: David Feuer Date: Mon Aug 28 15:33:53 2017 -0400 Actually bump T12150 >--------------------------------------------------------------- 682e8e6e01cd9c96378692656649094ad44c35a7 testsuite/tests/perf/compiler/all.T | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T index cf49981..7609dd7 100644 --- a/testsuite/tests/perf/compiler/all.T +++ b/testsuite/tests/perf/compiler/all.T @@ -1110,7 +1110,7 @@ test('T12707', test('T12150', [ only_ways(['optasm']), compiler_stats_num_field('bytes allocated', - [(wordsize(64), 70773000, 5) + [(wordsize(64), 74358208, 5) # initial: 70773000 # 2017-08-25: 74358208 Refactor the Mighty Simplifier ]), From git at git.haskell.org Tue Aug 29 03:31:16 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 29 Aug 2017 03:31:16 +0000 (UTC) Subject: [commit: ghc] master: Make parsed AST dump output lazily (29da01e) Message-ID: <20170829033116.163B73A584@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/29da01e0a023eea4bbbfd69dd5d854db721233e6/ghc >--------------------------------------------------------------- commit 29da01e0a023eea4bbbfd69dd5d854db721233e6 Author: David Feuer Date: Mon Aug 28 23:28:08 2017 -0400 Make parsed AST dump output lazily Previously, `showAstData` produced a `String`. That `String` would then be converted to a `Doc` using `text` to implement `-ddump-parsed-ast`. But rendering `text` calculates the length of the `String` before doing anything else. Since the AST can be very large, this was bad: the whole dump string (potentially hundreds of millions of `Char`s) was accumulated in memory. Now, `showAstData` produces a `Doc` directly, which seems to work a lot better. As an extra bonus, the code is simpler and cleaner. The formatting has changed a bit, as the previous ad hoc approach didn't really match the pretty printer too well. If someone cares enough to request adjustments, we can surely make them. Reviewers: austin, bgamari, mpickering, alanz Reviewed By: bgamari Subscribers: mpickering, rwbarton, thomie GHC Trac Issues: #14161 Differential Revision: https://phabricator.haskell.org/D3894 >--------------------------------------------------------------- 29da01e0a023eea4bbbfd69dd5d854db721233e6 compiler/hsSyn/HsDumpAst.hs | 160 +++--- compiler/main/HscMain.hs | 4 +- compiler/typecheck/TcRnDriver.hs | 4 +- .../parser/should_compile/DumpParsedAst.stderr | 137 ++--- .../parser/should_compile/DumpRenamedAst.stderr | 189 +++---- .../should_compile/DumpTypecheckedAst.stderr | 550 +++++++++++---------- utils/check-ppr/Main.hs | 7 +- 7 files changed, 540 insertions(+), 511 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 29da01e0a023eea4bbbfd69dd5d854db721233e6 From git at git.haskell.org Tue Aug 29 08:37:30 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 29 Aug 2017 08:37:30 +0000 (UTC) Subject: [commit: ghc] master: Better debug-printing for Outputable TyConBinder (8834d48) Message-ID: <20170829083730.1A4FC3A584@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8834d482614b3c4b9dd57202134a518b1771ed99/ghc >--------------------------------------------------------------- commit 8834d482614b3c4b9dd57202134a518b1771ed99 Author: Simon Peyton Jones Date: Mon Aug 28 13:27:14 2017 +0100 Better debug-printing for Outputable TyConBinder Anon and Required were printed the same :-(. This is only for debug printing, so I switched to a slightly more verbose and explicit format >--------------------------------------------------------------- 8834d482614b3c4b9dd57202134a518b1771ed99 compiler/types/TyCon.hs | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/compiler/types/TyCon.hs b/compiler/types/TyCon.hs index 63e199c..6a4ff72 100644 --- a/compiler/types/TyCon.hs +++ b/compiler/types/TyCon.hs @@ -385,6 +385,7 @@ See also: -} type TyConBinder = TyVarBndr TyVar TyConBndrVis + -- See also Note [TyBinder] in TyCoRep data TyConBndrVis = NamedTCB ArgFlag @@ -547,10 +548,10 @@ They fit together like so: -} instance Outputable tv => Outputable (TyVarBndr tv TyConBndrVis) where - ppr (TvBndr v AnonTCB) = ppr v - ppr (TvBndr v (NamedTCB Required)) = ppr v - ppr (TvBndr v (NamedTCB Specified)) = char '@' <> ppr v - ppr (TvBndr v (NamedTCB Inferred)) = braces (ppr v) + ppr (TvBndr v AnonTCB) = text "anon" <+> parens (ppr v) + ppr (TvBndr v (NamedTCB Required)) = text "req" <+> parens (ppr v) + ppr (TvBndr v (NamedTCB Specified)) = text "spec" <+> parens (ppr v) + ppr (TvBndr v (NamedTCB Inferred)) = text "inf" <+> parens (ppr v) instance Binary TyConBndrVis where put_ bh AnonTCB = putByte bh 0 From git at git.haskell.org Tue Aug 29 08:37:38 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 29 Aug 2017 08:37:38 +0000 (UTC) Subject: [commit: ghc] master: Add TcRnMonad.unlessXOptM (6f050d9) Message-ID: <20170829083738.4F6233A584@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6f050d9caa2db8330f73f5ebeee986371e5aa56d/ghc >--------------------------------------------------------------- commit 6f050d9caa2db8330f73f5ebeee986371e5aa56d Author: Simon Peyton Jones Date: Mon Aug 28 13:37:56 2017 +0100 Add TcRnMonad.unlessXOptM This usefully joins whenXOptM; there are probably lots of places we should use it! This patch does not use new new function at all; but it's preparing for an upcoming patch when I do use it. >--------------------------------------------------------------- 6f050d9caa2db8330f73f5ebeee986371e5aa56d compiler/typecheck/TcRnMonad.hs | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/compiler/typecheck/TcRnMonad.hs b/compiler/typecheck/TcRnMonad.hs index a6a995d..b9638ed 100644 --- a/compiler/typecheck/TcRnMonad.hs +++ b/compiler/typecheck/TcRnMonad.hs @@ -19,7 +19,8 @@ module TcRnMonad( getEnvs, setEnvs, xoptM, doptM, goptM, woptM, setXOptM, unsetXOptM, unsetGOptM, unsetWOptM, - whenDOptM, whenGOptM, whenWOptM, whenXOptM, + whenDOptM, whenGOptM, whenWOptM, + whenXOptM, unlessXOptM, getGhcMode, withDoDynamicToo, getEpsVar, @@ -499,6 +500,10 @@ whenXOptM :: LangExt.Extension -> TcRnIf gbl lcl () -> TcRnIf gbl lcl () whenXOptM flag thing_inside = do b <- xoptM flag when b thing_inside +unlessXOptM :: LangExt.Extension -> TcRnIf gbl lcl () -> TcRnIf gbl lcl () +unlessXOptM flag thing_inside = do b <- xoptM flag + unless b thing_inside + getGhcMode :: TcRnIf gbl lcl GhcMode getGhcMode = do { env <- getTopEnv; return (ghcMode (hsc_dflags env)) } From git at git.haskell.org Tue Aug 29 08:37:35 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 29 Aug 2017 08:37:35 +0000 (UTC) Subject: [commit: ghc] master: A bit more -ddump-tc tracing (547e4c0) Message-ID: <20170829083735.86D7B3A584@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/547e4c03809e082a34d9fd844c59e4844cd323ad/ghc >--------------------------------------------------------------- commit 547e4c03809e082a34d9fd844c59e4844cd323ad Author: Simon Peyton Jones Date: Mon Aug 28 13:37:30 2017 +0100 A bit more -ddump-tc tracing >--------------------------------------------------------------- 547e4c03809e082a34d9fd844c59e4844cd323ad compiler/typecheck/TcHsType.hs | 9 +++++++++ compiler/typecheck/TcTyClsDecls.hs | 18 ++++++++++-------- 2 files changed, 19 insertions(+), 8 deletions(-) diff --git a/compiler/typecheck/TcHsType.hs b/compiler/typecheck/TcHsType.hs index 04e2381..034c391 100644 --- a/compiler/typecheck/TcHsType.hs +++ b/compiler/typecheck/TcHsType.hs @@ -1408,6 +1408,12 @@ kcHsTyVarBndrs name flav cusk all_kind_vars -- in scope from an enclosing class, but -- re-adding tvs to the env't doesn't cause -- harm + + ; traceTc "kcHsTyVarBndrs: cusk" $ + vcat [ ppr name, ppr kv_ns, ppr hs_tvs, ppr dep_names + , ppr tc_binders, ppr (mkTyConKind tc_binders res_kind) + , ppr qkvs, ppr meta_tvs, ppr good_tvs, ppr final_binders ] + ; return (tycon, stuff) }} | otherwise @@ -1421,6 +1427,8 @@ kcHsTyVarBndrs name flav cusk all_kind_vars -- must remain lined up with the binders tycon = mkTcTyCon name binders res_kind (scoped_kvs ++ binderVars binders) flav + + ; traceTc "kcHsTyVarBndrs: not-cusk" (ppr name <+> ppr binders) ; return (tycon, stuff) } where open_fam = tcFlavourIsOpen flav @@ -1793,6 +1801,7 @@ tcTyClTyVars tycon_name thing_inside -- Add the *unzonked* tyvars to the env't, because those -- are the ones mentioned in the source. + ; traceTc "tcTyClTyVars" (ppr tycon_name <+> ppr binders) ; tcExtendTyVarEnv scoped_tvs $ thing_inside binders res_kind } diff --git a/compiler/typecheck/TcTyClsDecls.hs b/compiler/typecheck/TcTyClsDecls.hs index 0974fe5..a152942 100644 --- a/compiler/typecheck/TcTyClsDecls.hs +++ b/compiler/typecheck/TcTyClsDecls.hs @@ -381,7 +381,8 @@ kcTyClGroup decls -- Make sure kc_kind' has the final, zonked kind variables ; traceTc "Generalise kind" $ - vcat [ ppr name, ppr kc_binders, ppr kvs, ppr all_binders, ppr kc_res_kind + vcat [ ppr name, ppr kc_binders, ppr (mkTyConKind kc_binders kc_res_kind) + , ppr kvs, ppr all_binders, ppr kc_res_kind , ppr all_binders', ppr kc_res_kind' , ppr kc_tyvars, ppr (tcTyConScopedTyVars tc)] @@ -1630,18 +1631,18 @@ tcConDecl rep_tycon tmpl_bndrs res_tmpl , con_qvars = hs_qvars, con_cxt = hs_ctxt , con_details = hs_details }) = addErrCtxt (dataConCtxtName [name]) $ - do { traceTc "tcConDecl 1" (ppr name) - - -- Get hold of the existential type variables - -- e.g. data T a = forall (b::k) f. MkT a (f b) - -- Here tmpl_bndrs = {a} - -- hs_kvs = {k} - -- hs_tvs = {f,b} + do { -- Get hold of the existential type variables + -- e.g. data T a = forall (b::k) f. MkT a (f b) + -- Here tmpl_bndrs = {a} + -- hs_kvs = {k} + -- hs_tvs = {f,b} ; let (hs_kvs, hs_tvs) = case hs_qvars of Nothing -> ([], []) Just (HsQTvs { hsq_implicit = kvs, hsq_explicit = tvs }) -> (kvs, tvs) + ; traceTc "tcConDecl 1" (vcat [ ppr name, ppr hs_kvs, ppr hs_tvs ]) + ; (imp_tvs, (exp_tvs, ctxt, arg_tys, field_lbls, stricts)) <- solveEqualities $ tcImplicitTKBndrs hs_kvs $ @@ -2423,6 +2424,7 @@ checkValidTyConTyVars tc = text "NB: Implicitly declared kind variables are put first." | otherwise = empty + ; traceTc "checkValidTyConTyVars" (ppr tc <+> ppr tvs) ; checkValidTelescope (pprTyVars vis_tvs) stripped_tvs extra `and_if_that_doesn't_error` -- This triggers on test case dependent/should_fail/InferDependency From git at git.haskell.org Tue Aug 29 08:37:32 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 29 Aug 2017 08:37:32 +0000 (UTC) Subject: [commit: ghc] master: Comments only (6e0e0b0) Message-ID: <20170829083732.CB70F3A584@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6e0e0b0e2758910113ce98358b53ea5e9c58651f/ghc >--------------------------------------------------------------- commit 6e0e0b0e2758910113ce98358b53ea5e9c58651f Author: Simon Peyton Jones Date: Mon Aug 28 13:26:07 2017 +0100 Comments only Better comment on con_qvars in ConDecl >--------------------------------------------------------------- 6e0e0b0e2758910113ce98358b53ea5e9c58651f compiler/hsSyn/HsDecls.hs | 6 ++--- compiler/hsSyn/HsTypes.hs | 13 ++++++---- compiler/typecheck/TcHsType.hs | 54 ++++++++++++++++++++++++++++++------------ 3 files changed, 51 insertions(+), 22 deletions(-) diff --git a/compiler/hsSyn/HsDecls.hs b/compiler/hsSyn/HsDecls.hs index 3053f3e..5a6d3dd 100644 --- a/compiler/hsSyn/HsDecls.hs +++ b/compiler/hsSyn/HsDecls.hs @@ -1155,9 +1155,9 @@ data ConDecl pass , con_qvars :: Maybe (LHsQTyVars pass) -- User-written forall (if any), and its implicit -- kind variables - -- Non-Nothing needs -XExistentialQuantification - -- e.g. data T a = forall b. MkT b (b->a) - -- con_qvars = {b} + -- Non-Nothing means an explicit user-written forall + -- e.g. data T a = forall b. MkT b (b->a) + -- con_qvars = {b} , con_cxt :: Maybe (LHsContext pass) -- ^ User-written context (if any) diff --git a/compiler/hsSyn/HsTypes.hs b/compiler/hsSyn/HsTypes.hs index 98fad24..0e4338b 100644 --- a/compiler/hsSyn/HsTypes.hs +++ b/compiler/hsSyn/HsTypes.hs @@ -254,11 +254,16 @@ type LHsTyVarBndr pass = Located (HsTyVarBndr pass) -- | Located Haskell Quantified Type Variables data LHsQTyVars pass -- See Note [HsType binders] = HsQTvs { hsq_implicit :: PostRn pass [Name] - -- implicit (dependent) variables - , hsq_explicit :: [LHsTyVarBndr pass] -- explicit variables - -- See Note [HsForAllTy tyvar binders] + -- Implicit (dependent) variables + + , hsq_explicit :: [LHsTyVarBndr pass] + -- Explicit variables, written by the user + -- See Note [HsForAllTy tyvar binders] + , hsq_dependent :: PostRn pass NameSet - -- which explicit vars are dependent + -- Which members of hsq_explicit are dependent; that is, + -- mentioned in the kind of a later hsq_explicit, + -- or mentioned in a kind in the scope of this HsQTvs -- See Note [Dependent LHsQTyVars] in TcHsType } diff --git a/compiler/typecheck/TcHsType.hs b/compiler/typecheck/TcHsType.hs index 6e2720b..04e2381 100644 --- a/compiler/typecheck/TcHsType.hs +++ b/compiler/typecheck/TcHsType.hs @@ -1290,14 +1290,38 @@ Note [Dependent LHsQTyVars] We track (in the renamer) which explicitly bound variables in a LHsQTyVars are manifestly dependent; only precisely these variables may be used within the LHsQTyVars. We must do this so that kcHsTyVarBndrs -can produce the right TyConBinders, and tell Anon vs. Named. Earlier, -I thought it would work simply to do a free-variable check during -kcHsTyVarBndrs, but this is bogus, because there may be unsolved -equalities about. And we don't want to eagerly solve the equalities, -because we may get further information after kcHsTyVarBndrs is called. -(Recall that kcHsTyVarBndrs is usually called from getInitialKind. -The only other case is in kcConDecl.) This is what implements the rule -that all variables intended to be dependent must be manifestly so. +can produce the right TyConBinders, and tell Anon vs. Required. + +Example data T k1 (a:k1) (b:k2) c + = MkT (Proxy a) (Proxy b) (Proxy c) + +Here + (a:k1),(b:k2),(c:k3) + are Anon (explicitly specified as a binder, not used + in the kind of any other binder + k1 is Required (explicitly specifed as a binder, but used + in the kind of another binder i.e. dependently) + k2 is Specified (not explicitly bound, but used in the kind + of another binder) + k3 in Inferred (not lexically in scope at all, but inferred + by kind inference) +and + T :: forall {k3} k1. forall k3 -> k1 -> k2 -> k3 -> * + +See Note [TyVarBndrs, TyVarBinders, TyConBinders, and visiblity] +in TyCoRep. + +kcHsTyVarBndrs uses the hsq_dependent field to decide whether +k1, a, b, c should be Required or Anon. + +Earlier, thought it would work simply to do a free-variable check +during kcHsTyVarBndrs, but this is bogus, because there may be +unsolved equalities about. And we don't want to eagerly solve the +equalities, because we may get further information after +kcHsTyVarBndrs is called. (Recall that kcHsTyVarBndrs is usually +called from getInitialKind. The only other case is in kcConDecl.) +This is what implements the rule that all variables intended to be +dependent must be manifestly so. Sidenote: It's quite possible that later, we'll consider (t -> s) as a degenerate case of some (pi (x :: t) -> s) and then this will @@ -1682,16 +1706,16 @@ Consider data T = MkT (forall (a :: k). Proxy a) -- from test ghci/scripts/T7873 -This is not an existential datatype, but a higher-rank one. Note that -the forall to the right of MkT. Also consider +This is not an existential datatype, but a higher-rank one (the forall +to the right of MkT). Also consider data S a = MkS (Proxy (a :: k)) -According to the rules around implicitly-bound kind variables, those -k's scope over the whole declarations. The renamer grabs it and adds it -to the hsq_implicits field of the HsQTyVars of the tycon. So it must -be in scope during type-checking, but we want to reject T while accepting -S. +According to the rules around implicitly-bound kind variables, in both +cases those k's scope over the whole declaration. The renamer grabs +it and adds it to the hsq_implicits field of the HsQTyVars of the +tycon. So it must be in scope during type-checking, but we want to +reject T while accepting S. Why reject T? Because the kind variable isn't fixed by anything. For a variable like k to be implicit, it needs to be mentioned in the kind From git at git.haskell.org Tue Aug 29 08:37:42 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 29 Aug 2017 08:37:42 +0000 (UTC) Subject: [commit: ghc] master: Refactor bindHsQTyVars and friends (0257dac) Message-ID: <20170829083742.28EFA3A584@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/0257dacf228024d0cc6ba247c707130637a25580/ghc >--------------------------------------------------------------- commit 0257dacf228024d0cc6ba247c707130637a25580 Author: Simon Peyton Jones Date: Mon Aug 28 14:20:02 2017 +0100 Refactor bindHsQTyVars and friends This work was triggered by Trac #13738, which revealed to me that the code RnTypes.bindHsQTyVars and bindLHsTyVarBndrs was a huge tangled mess -- and outright wrong on occasion as the ticket showed. The big problem was that bindLHsTyVarBndrs (which is invoked at every HsForAll, including nested higher rank ones) was attempting to bind implicit kind variables, which it has absolutely no busineess doing. Imlicit kind quantification is done at the outside only, in fact precisely where we have HsImplicitBndrs or LHsQTyVars (which also has implicit binders). Achieving this move was surprisingly hard, because more and more barnacles had accreted aroud the original mistake. It's much much better now. Summary of changes. Almost all the action is in RnTypes. * Implicit kind variables are bound only by - By bindHsQTyVars, which deals with LHsQTyVars - By rnImplicitBndrs, which deals with HsImplicitBndrs * bindLHsTyVarBndrs, and bindLHsTyVarBndr are radically simplified. They simply does far less, and have lots their forest of incomprehensible accumulating parameters. (To be fair, some of the code in bindLHsTyVarBndrs just moved to bindHsQTyVars, but in much more perspicuous form.) * The code that checks if a variable appears in both a kind and a type (triggering RnTypes.mixedVarsErr) was bizarre. E.g. we had this in RnTypes.extract_hs_tv_bndrs ; check_for_mixed_vars bndr_kvs acc_tvs ; check_for_mixed_vars bndr_kvs body_tvs ; check_for_mixed_vars body_tvs acc_kvs ; check_for_mixed_vars body_kvs acc_tvs ; check_for_mixed_vars locals body_kvs I cleaned all this up; now we check for mixed use at binding sites only. * Checks for "Variable used as a kind before being bound", like data T (a :: k) k = rhs now just show up straightforwardly as "k is not in scope". See Note [Kind variable ordering] * There are some knock-on simplifications in RnSource. >--------------------------------------------------------------- 0257dacf228024d0cc6ba247c707130637a25580 compiler/rename/RnSource.hs | 86 ++-- compiler/rename/RnTypes.hs | 440 +++++++++------------ testsuite/tests/ghci/scripts/T7873.stderr | 10 +- .../indexed-types/should_fail/SimpleFail6.stderr | 4 +- testsuite/tests/polykinds/BadKindVar.hs | 9 + testsuite/tests/polykinds/BadKindVar.stderr | 4 + testsuite/tests/polykinds/T13738.hs | 14 + testsuite/tests/polykinds/T13738.stderr | 4 + testsuite/tests/polykinds/T7404.stderr | 5 +- testsuite/tests/polykinds/all.T | 2 + testsuite/tests/rename/should_fail/T11592.stderr | 21 +- .../tests/typecheck/should_fail/T11963.stderr | 4 +- 12 files changed, 278 insertions(+), 325 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 0257dacf228024d0cc6ba247c707130637a25580 From git at git.haskell.org Tue Aug 29 08:37:44 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 29 Aug 2017 08:37:44 +0000 (UTC) Subject: [commit: ghc] master: Small refactoring of meta-tyvar cloning (86e6a5f) Message-ID: <20170829083744.DA64D3A584@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/86e6a5f232c6ac4a1cf54130a9987b2b89ace786/ghc >--------------------------------------------------------------- commit 86e6a5f232c6ac4a1cf54130a9987b2b89ace786 Author: Simon Peyton Jones Date: Mon Aug 28 17:18:26 2017 +0100 Small refactoring of meta-tyvar cloning No change in behaviour. >--------------------------------------------------------------- 86e6a5f232c6ac4a1cf54130a9987b2b89ace786 compiler/basicTypes/Name.hs | 2 +- compiler/typecheck/TcMType.hs | 63 ++++++++++++++++++++++++------------------- 2 files changed, 36 insertions(+), 29 deletions(-) diff --git a/compiler/basicTypes/Name.hs b/compiler/basicTypes/Name.hs index 45275e3..d9326f1 100644 --- a/compiler/basicTypes/Name.hs +++ b/compiler/basicTypes/Name.hs @@ -383,7 +383,7 @@ mkSystemVarName :: Unique -> FastString -> Name mkSystemVarName uniq fs = mkSystemName uniq (mkVarOccFS fs) mkSysTvName :: Unique -> FastString -> Name -mkSysTvName uniq fs = mkSystemName uniq (mkOccNameFS tvName fs) +mkSysTvName uniq fs = mkSystemName uniq (mkTyVarOccFS fs) -- | Make a name for a foreign call mkFCallName :: Unique -> String -> Name diff --git a/compiler/typecheck/TcMType.hs b/compiler/typecheck/TcMType.hs index 19b0381..ed7835c 100644 --- a/compiler/typecheck/TcMType.hs +++ b/compiler/typecheck/TcMType.hs @@ -580,12 +580,6 @@ instead of the buggous ************************************************************************ -} -mkMetaTyVarName :: Unique -> FastString -> Name --- Makes a /System/ Name, which is eagerly eliminated by --- the unifier; see TcUnify.nicer_to_update_tv1, and --- TcCanonical.canEqTyVarTyVar (nicer_to_update_tv2) -mkMetaTyVarName uniq str = mkSysTvName uniq str - newSigTyVar :: Name -> Kind -> TcM TcTyVar newSigTyVar name kind = do { details <- newMetaDetails SigTv @@ -763,6 +757,12 @@ coercion variables, except for the special case of the promoted Eq#. But, that can't ever appear in user code, so we're safe! -} +mkMetaTyVarName :: Unique -> FastString -> Name +-- Makes a /System/ Name, which is eagerly eliminated by +-- the unifier; see TcUnify.nicer_to_update_tv1, and +-- TcCanonical.canEqTyVarTyVar (nicer_to_update_tv2) +mkMetaTyVarName uniq str = mkSystemName uniq (mkTyVarOccFS str) + newAnonMetaTyVar :: MetaInfo -> Kind -> TcM TcTyVar -- Make a new meta tyvar out of thin air newAnonMetaTyVar meta_info kind @@ -776,6 +776,21 @@ newAnonMetaTyVar meta_info kind ; details <- newMetaDetails meta_info ; return (mkTcTyVar name kind details) } +cloneAnonMetaTyVar :: MetaInfo -> TyVar -> TcKind -> TcM TcTyVar +-- Same as newAnonMetaTyVar, but use a supplied TyVar as the source of the print-name +cloneAnonMetaTyVar info tv kind + = do { uniq <- newUnique + ; details <- newMetaDetails info + ; let name = mkSystemName uniq (getOccName tv) + -- See Note [Name of an instantiated type variable] + ; return (mkTcTyVar name kind details) } + +{- Note [Name of an instantiated type variable] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +At the moment we give a unification variable a System Name, which +influences the way it is tidied; see TypeRep.tidyTyVarBndr. +-} + newFlexiTyVar :: Kind -> TcM TcTyVar newFlexiTyVar kind = newAnonMetaTyVar TauTv kind @@ -832,23 +847,20 @@ newWildCardX subst tv new_meta_tv_x :: MetaInfo -> TCvSubst -> TyVar -> TcM (TCvSubst, TcTyVar) new_meta_tv_x info subst tv - = do { uniq <- newUnique - ; details <- newMetaDetails info - ; let name = mkSystemName uniq (getOccName tv) - -- See Note [Name of an instantiated type variable] - kind = substTyUnchecked subst (tyVarKind tv) - -- NOTE: Trac #12549 is fixed so we could use - -- substTy here, but the tc_infer_args problem - -- is not yet fixed so leaving as unchecked for now. - -- OLD NOTE: - -- Unchecked because we call newMetaTyVarX from - -- tcInstBinder, which is called from tc_infer_args - -- which does not yet take enough trouble to ensure - -- the in-scope set is right; e.g. Trac #12785 trips - -- if we use substTy here - new_tv = mkTcTyVar name kind details - subst1 = extendTvSubstWithClone subst tv new_tv + = do { new_tv <- cloneAnonMetaTyVar info tv substd_kind + ; let subst1 = extendTvSubstWithClone subst tv new_tv ; return (subst1, new_tv) } + where + substd_kind = substTyUnchecked subst (tyVarKind tv) + -- NOTE: Trac #12549 is fixed so we could use + -- substTy here, but the tc_infer_args problem + -- is not yet fixed so leaving as unchecked for now. + -- OLD NOTE: + -- Unchecked because we call newMetaTyVarX from + -- tcInstBinder, which is called from tc_infer_args + -- which does not yet take enough trouble to ensure + -- the in-scope set is right; e.g. Trac #12785 trips + -- if we use substTy here newMetaTyVarTyAtLevel :: TcLevel -> TcKind -> TcM TcType newMetaTyVarTyAtLevel tc_lvl kind @@ -860,12 +872,7 @@ newMetaTyVarTyAtLevel tc_lvl kind , mtv_tclvl = tc_lvl } ; return (mkTyVarTy (mkTcTyVar name kind details)) } -{- Note [Name of an instantiated type variable] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -At the moment we give a unification variable a System Name, which -influences the way it is tidied; see TypeRep.tidyTyVarBndr. - -************************************************************************ +{- ********************************************************************* * * Quantification * * From git at git.haskell.org Tue Aug 29 08:37:48 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 29 Aug 2017 08:37:48 +0000 (UTC) Subject: [commit: ghc] master: Use a well-kinded substitution to instantiate (4455c86) Message-ID: <20170829083748.2C1C73A584@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4455c86d1635bfb846e750b21dda36dcee028b5e/ghc >--------------------------------------------------------------- commit 4455c86d1635bfb846e750b21dda36dcee028b5e Author: Simon Peyton Jones Date: Mon Aug 28 17:21:14 2017 +0100 Use a well-kinded substitution to instantiate In tcDataConPat we were creating an ill-kinded substitution -- or at least one that is well kinded only after you have solved other equalities. THat led to a crash, because the instantiated data con type was ill-kinded. This patch guarantees that the instantiating substitution is well-kinded. Fixed Trac #14154 >--------------------------------------------------------------- 4455c86d1635bfb846e750b21dda36dcee028b5e compiler/typecheck/Inst.hs | 28 +++++++++++++++++++++- compiler/typecheck/TcPat.hs | 9 +++++-- testsuite/tests/typecheck/should_compile/T14154.hs | 16 +++++++++++++ testsuite/tests/typecheck/should_compile/all.T | 1 + 4 files changed, 51 insertions(+), 3 deletions(-) diff --git a/compiler/typecheck/Inst.hs b/compiler/typecheck/Inst.hs index 34e6e71..bb2b90c 100644 --- a/compiler/typecheck/Inst.hs +++ b/compiler/typecheck/Inst.hs @@ -12,7 +12,7 @@ The @Inst@ type: dictionaries or method instances module Inst ( deeplySkolemise, topInstantiate, topInstantiateInferred, deeplyInstantiate, - instCall, instDFunType, instStupidTheta, + instCall, instDFunType, instStupidTheta, instTyVarsWith, newWanted, newWanteds, tcInstBinders, tcInstBinder, @@ -279,6 +279,32 @@ deeply_instantiate orig subst ty , text "subst:" <+> ppr subst ]) ; return (idHsWrapper, ty') } + +instTyVarsWith :: CtOrigin -> [TyVar] -> [TcType] -> TcM TCvSubst +-- Use this when you want to instantiate (forall a b c. ty) with +-- types [ta, tb, tc], but when the kinds of 'a' and 'ta' might +-- not yet match (perhaps because there are unsolved constraints; Trac #14154) +-- If they don't match, emit a kind-equality to promise that they will +-- eventually do so, and thus make a kind-homongeneous substitution. +instTyVarsWith orig tvs tys + = go empty_subst tvs tys + where + empty_subst = mkEmptyTCvSubst (mkInScopeSet (tyCoVarsOfTypes tys)) + + go subst [] [] + = return subst + go subst (tv:tvs) (ty:tys) + | tv_kind `tcEqType` ty_kind + = go (extendTCvSubst subst tv ty) tvs tys + | otherwise + = do { co <- emitWantedEq orig KindLevel Nominal ty_kind tv_kind + ; go (extendTCvSubst subst tv (ty `mkCastTy` co)) tvs tys } + where + tv_kind = substTy subst (tyVarKind tv) + ty_kind = typeKind ty + + go _ _ _ = pprPanic "instTysWith" (ppr tvs $$ ppr tys) + {- ************************************************************************ * * diff --git a/compiler/typecheck/TcPat.hs b/compiler/typecheck/TcPat.hs index 18b148d..6be2a4e 100644 --- a/compiler/typecheck/TcPat.hs +++ b/compiler/typecheck/TcPat.hs @@ -736,8 +736,13 @@ tcDataConPat penv (L con_span con_name) data_con pat_ty arg_pats thing_inside ; let all_arg_tys = eqSpecPreds eq_spec ++ theta ++ arg_tys ; checkExistentials ex_tvs all_arg_tys penv - ; (tenv, ex_tvs') <- tcInstSuperSkolTyVarsX - (zipTvSubst univ_tvs ctxt_res_tys) ex_tvs + + ; tenv <- instTyVarsWith PatOrigin univ_tvs ctxt_res_tys + -- NB: Do not use zipTvSubst! See Trac #14154 + -- We want to create a well-kinded substitution, so + -- that the instantiated type is well-kinded + + ; (tenv, ex_tvs') <- tcInstSuperSkolTyVarsX tenv ex_tvs -- Get location from monad, not from ex_tvs ; let -- pat_ty' = mkTyConApp tycon ctxt_res_tys diff --git a/testsuite/tests/typecheck/should_compile/T14154.hs b/testsuite/tests/typecheck/should_compile/T14154.hs new file mode 100644 index 0000000..e29ee85 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T14154.hs @@ -0,0 +1,16 @@ +{-# Language RankNTypes, DerivingStrategies, TypeApplications, + ScopedTypeVariables, GADTs, PolyKinds #-} + +module T14154 where + +newtype Ran g h a + = MkRan (forall b. (a -> g b) -> h b) + +newtype Swap p f g a where + MkSwap :: p g f a -> Swap p f g a + +ireturn :: forall m i a. a -> m i i a +ireturn = undefined + +xs = case ireturn @(Swap Ran) 'a' of + MkSwap (MkRan f) -> f print diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index 13a2719..b929195 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -572,3 +572,4 @@ test('T13915a', normal, multimod_compile, ['T13915a', '-v0']) test('T13915b', normal, compile, ['']) test('T13984', normal, compile, ['']) test('T14149', normal, compile, ['']) +test('T14154', normal, compile, ['']) From git at git.haskell.org Tue Aug 29 08:37:50 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 29 Aug 2017 08:37:50 +0000 (UTC) Subject: [commit: ghc] master: Improve kind-application-error message (8eead4d) Message-ID: <20170829083750.DB9223A584@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8eead4de7c820e602193d6d16acd00faeffa035c/ghc >--------------------------------------------------------------- commit 8eead4de7c820e602193d6d16acd00faeffa035c Author: Simon Peyton Jones Date: Mon Aug 28 17:23:35 2017 +0100 Improve kind-application-error message >--------------------------------------------------------------- 8eead4de7c820e602193d6d16acd00faeffa035c compiler/coreSyn/CoreLint.hs | 25 +++++++++++++++---------- 1 file changed, 15 insertions(+), 10 deletions(-) diff --git a/compiler/coreSyn/CoreLint.hs b/compiler/coreSyn/CoreLint.hs index e85cfe8..7878e62 100644 --- a/compiler/coreSyn/CoreLint.hs +++ b/compiler/coreSyn/CoreLint.hs @@ -1391,23 +1391,28 @@ lint_app doc kfn kas -- Note [The substitution invariant] in TyCoRep ; foldlM (go_app in_scope) kfn kas } where - fail_msg = vcat [ hang (text "Kind application error in") 2 doc - , nest 2 (text "Function kind =" <+> ppr kfn) - , nest 2 (text "Arg kinds =" <+> ppr kas) ] + fail_msg extra = vcat [ hang (text "Kind application error in") 2 doc + , nest 2 (text "Function kind =" <+> ppr kfn) + , nest 2 (text "Arg kinds =" <+> ppr kas) + , extra ] - go_app in_scope kfn ka + go_app in_scope kfn tka | Just kfn' <- coreView kfn - = go_app in_scope kfn' ka + = go_app in_scope kfn' tka - go_app _ (FunTy kfa kfb) (_,ka) - = do { unless (ka `eqType` kfa) (addErrL fail_msg) + go_app _ (FunTy kfa kfb) tka@(_,ka) + = do { unless (ka `eqType` kfa) $ + addErrL (fail_msg (text "Fun:" <+> (ppr kfa $$ ppr tka))) ; return kfb } - go_app in_scope (ForAllTy (TvBndr kv _vis) kfn) (ta,ka) - = do { unless (ka `eqType` tyVarKind kv) (addErrL fail_msg) + go_app in_scope (ForAllTy (TvBndr kv _vis) kfn) tka@(ta,ka) + = do { let kv_kind = tyVarKind kv + ; unless (ka `eqType` kv_kind) $ + addErrL (fail_msg (text "Forall:" <+> (ppr kv $$ ppr kv_kind $$ ppr tka))) ; return (substTyWithInScope in_scope [kv] [ta] kfn) } - go_app _ _ _ = failWithL fail_msg + go_app _ kfn ka + = failWithL (fail_msg (text "Not a fun:" <+> (ppr kfn $$ ppr ka))) {- ********************************************************************* * * From git at git.haskell.org Tue Aug 29 08:37:53 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 29 Aug 2017 08:37:53 +0000 (UTC) Subject: [commit: ghc] master: Small refactor of getRuntimeRep (a6c448b) Message-ID: <20170829083753.A8B713A584@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a6c448b403dbe8720178ca82100f34baedb1f47e/ghc >--------------------------------------------------------------- commit a6c448b403dbe8720178ca82100f34baedb1f47e Author: Simon Peyton Jones Date: Mon Aug 28 17:33:59 2017 +0100 Small refactor of getRuntimeRep Instead of using a string argument, use HasDebugCallStack. (Oddly, some functions were using both!) Plus, use getRuntimeRep rather than getRuntimeRep_maybe when if the caller panics on Nothing. Less code, and a better debug stack. >--------------------------------------------------------------- a6c448b403dbe8720178ca82100f34baedb1f47e compiler/coreSyn/MkCore.hs | 4 +- compiler/deSugar/DsBinds.hs | 6 +-- compiler/deSugar/DsExpr.hs | 2 +- compiler/deSugar/DsUtils.hs | 4 +- compiler/iface/TcIface.hs | 2 +- compiler/prelude/TysWiredIn.hs | 4 +- compiler/typecheck/TcExpr.hs | 2 +- compiler/typecheck/TcHsType.hs | 4 +- compiler/typecheck/TcInstDcls.hs | 3 +- compiler/typecheck/TcRnDriver.hs | 2 +- compiler/types/Type.hs | 80 +++++++++++++++++-------------------- compiler/vectorise/Vectorise/Exp.hs | 3 +- 12 files changed, 55 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 a6c448b403dbe8720178ca82100f34baedb1f47e From git at git.haskell.org Tue Aug 29 08:37:56 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 29 Aug 2017 08:37:56 +0000 (UTC) Subject: [commit: ghc] master: Add HasDebugStack for typeKind (aed7d43) Message-ID: <20170829083756.647493A584@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/aed7d431a58bc82eae7635aed8697a71267a9076/ghc >--------------------------------------------------------------- commit aed7d431a58bc82eae7635aed8697a71267a9076 Author: Simon Peyton Jones Date: Mon Aug 28 17:35:33 2017 +0100 Add HasDebugStack for typeKind typeKind can fail, and it's called all over the place, so it's helpful to know where >--------------------------------------------------------------- aed7d431a58bc82eae7635aed8697a71267a9076 compiler/types/Type.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/types/Type.hs b/compiler/types/Type.hs index 664f001..1e0c612 100644 --- a/compiler/types/Type.hs +++ b/compiler/types/Type.hs @@ -2306,7 +2306,7 @@ nonDetCmpTc tc1 tc2 ************************************************************************ -} -typeKind :: Type -> Kind +typeKind :: HasDebugCallStack => Type -> Kind typeKind (TyConApp tc tys) = piResultTys (tyConKind tc) tys typeKind (AppTy fun arg) = piResultTy (typeKind fun) arg typeKind (LitTy l) = typeLiteralKind l From git at git.haskell.org Tue Aug 29 15:12:10 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 29 Aug 2017 15:12:10 +0000 (UTC) Subject: [commit: ghc] wip/perf-testsuite: Clean up refactoring of stats_num_field (145be8a) Message-ID: <20170829151210.D05273A5C1@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/perf-testsuite Link : http://ghc.haskell.org/trac/ghc/changeset/145be8abedd67faaba0a1de4fc1a5cb0874d2655/ghc >--------------------------------------------------------------- commit 145be8abedd67faaba0a1de4fc1a5cb0874d2655 Author: Jared Weakly Date: Sun Aug 27 11:53:40 2017 -0700 Clean up refactoring of stats_num_field >--------------------------------------------------------------- 145be8abedd67faaba0a1de4fc1a5cb0874d2655 testsuite/driver/perf_notes.py | 68 ++++++++++++++++--------------------- testsuite/driver/runtests.py | 1 - testsuite/driver/testglobals.py | 5 ++- testsuite/driver/testlib.py | 74 ++++++++--------------------------------- 4 files changed, 47 insertions(+), 101 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 145be8abedd67faaba0a1de4fc1a5cb0874d2655 From git at git.haskell.org Tue Aug 29 15:12:13 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 29 Aug 2017 15:12:13 +0000 (UTC) Subject: [commit: ghc] wip/perf-testsuite: Change the all.T files to new format (fd72d30) Message-ID: <20170829151213.B77F23A5C1@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/perf-testsuite Link : http://ghc.haskell.org/trac/ghc/changeset/fd72d30dc9b881b57adbad963556f1bb49a7e5a3/ghc >--------------------------------------------------------------- commit fd72d30dc9b881b57adbad963556f1bb49a7e5a3 Author: Jared Weakly Date: Sun Aug 27 18:08:29 2017 -0700 Change the all.T files to new format >--------------------------------------------------------------- fd72d30dc9b881b57adbad963556f1bb49a7e5a3 libraries/base/tests/all.T | 16 +- testsuite/driver/perf_notes.py | 1 + testsuite/driver/runtests.py | 2 +- testsuite/driver/testlib.py | 11 +- testsuite/tests/callarity/perf/all.T | 11 +- testsuite/tests/deriving/perf/all.T | 10 +- testsuite/tests/perf/compiler/all.T | 941 ++----------------------- testsuite/tests/perf/haddock/all.T | 160 +---- testsuite/tests/perf/join_points/all.T | 15 +- testsuite/tests/perf/should_run/all.T | 325 ++------- testsuite/tests/perf/space_leaks/all.T | 74 +- testsuite/tests/primops/should_run/all.T | 6 +- testsuite/tests/simplCore/should_compile/all.T | 3 +- testsuite/tests/simplStg/should_run/all.T | 4 +- 14 files changed, 129 insertions(+), 1450 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 fd72d30dc9b881b57adbad963556f1bb49a7e5a3 From git at git.haskell.org Tue Aug 29 15:12:19 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 29 Aug 2017 15:12:19 +0000 (UTC) Subject: [commit: ghc] wip/perf-testsuite: Change stuff in testlib.py (563825e) Message-ID: <20170829151219.766753A5C1@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/perf-testsuite Link : http://ghc.haskell.org/trac/ghc/changeset/563825e5151167f3e1c4350ad30bbb9773fb11d9/ghc >--------------------------------------------------------------- commit 563825e5151167f3e1c4350ad30bbb9773fb11d9 Author: Jared Weakly Date: Mon Aug 28 17:26:30 2017 -0700 Change stuff in testlib.py >--------------------------------------------------------------- 563825e5151167f3e1c4350ad30bbb9773fb11d9 testsuite/driver/testlib.py | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/testsuite/driver/testlib.py b/testsuite/driver/testlib.py index d57dbf9..042e330 100644 --- a/testsuite/driver/testlib.py +++ b/testsuite/driver/testlib.py @@ -1040,6 +1040,11 @@ def multimod_compile_and_run( name, way, top_mod, extra_hc_opts ): def multi_compile_and_run( name, way, top_mod, extra_mods, extra_hc_opts ): return compile_and_run__( name, way, top_mod, extra_mods, extra_hc_opts) +def stats( name, way, stats_file ): + """This function is used by some performance tests""" + opts = getTestOpts() + return checkStats(name, way, stats_file, opts.stats_range_fields) + # ----------------------------------------------------------------------------- # Check -t stats info From git at git.haskell.org Tue Aug 29 15:12:16 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 29 Aug 2017 15:12:16 +0000 (UTC) Subject: [commit: ghc] wip/perf-testsuite: Correct error causing incorrect differentiation between compiler and regular performance tests (8dc8fa1) Message-ID: <20170829151216.966F63A5C1@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/perf-testsuite Link : http://ghc.haskell.org/trac/ghc/changeset/8dc8fa16031230a267cf3eca2d235b9475c9f31c/ghc >--------------------------------------------------------------- commit 8dc8fa16031230a267cf3eca2d235b9475c9f31c Author: Jared Weakly Date: Mon Aug 28 11:36:39 2017 -0700 Correct error causing incorrect differentiation between compiler and regular performance tests >--------------------------------------------------------------- 8dc8fa16031230a267cf3eca2d235b9475c9f31c testsuite/driver/perf_notes.py | 16 +++++++++++++--- testsuite/driver/testlib.py | 23 +++++++++++------------ 2 files changed, 24 insertions(+), 15 deletions(-) diff --git a/testsuite/driver/perf_notes.py b/testsuite/driver/perf_notes.py index a2bc8dd..d0b229e 100644 --- a/testsuite/driver/perf_notes.py +++ b/testsuite/driver/perf_notes.py @@ -154,13 +154,24 @@ def _comparison(name, opts, metric, deviation, is_compiler_test): if tests == [] or test == []: # There are no prior metrics for this test. - opts.stats_range_fields[metric] = (0,0) + if isinstance(metric, str): + if metric == 'all': + for field in testing_metrics: + opts.stats_range_fields[field] = (0,0) + else: + opts.stats_range_fields[metric] = (0,0) + if isinstance(metric, list): + for field in metric: + opts.stats_range_fields[field] = (0,0) + return + if is_compiler_test: + opts.is_compiler_test = True + # Compiler performance numbers change when debugging is on, making the results # useless and confusing. Therefore, skip if debugging is on. if config.compiler_debugged and is_compiler_test: - opts.is_compiler_test = True opts.skip = 1 # 'all' is a shorthand to test for bytes allocated, peak megabytes allocated, and max bytes used. @@ -193,7 +204,6 @@ def evaluate_metric(opts, test, field, deviation, contents, way): test_env = config.test_env config.accumulate_metrics.append('\t'.join([test_env, test, way, field, str(val)])) - print("WTF 01") if expected == 0: return my_passed('no prior metrics for this test') diff --git a/testsuite/driver/testlib.py b/testsuite/driver/testlib.py index b32cbf5..d57dbf9 100644 --- a/testsuite/driver/testlib.py +++ b/testsuite/driver/testlib.py @@ -1109,11 +1109,7 @@ def simple_build(name, way, extra_hc_opts, should_fail, top_mod, link, addsuf, b else: to_do = '-c' # just compile - print("SANITY CHECK") - print(name) - print(opts.is_compiler_test) stats_file = name + '.comp.stats' - print(stats_file) if opts.is_compiler_test: extra_hc_opts += ' +RTS -V0 -t' + stats_file + ' --machine-readable -RTS' if backpack: @@ -1147,13 +1143,13 @@ def simple_build(name, way, extra_hc_opts, should_fail, top_mod, link, addsuf, b # ToDo: if the sub-shell was killed by ^C, then exit - statsResult = checkStats(name, way, stats_file, opts.stats_range_fields) - print(stats_file) - print(opts.stats_range_fields) - print(statsResult) + if opts.is_compiler_test: + statsResult = checkStats(name, way, stats_file, opts.stats_range_fields) + else: + statsResult = passed() - if badResult(statsResult): - return statsResult + # if badResult(statsResult): + # return statsResult if should_fail: if exit_code == 0: @@ -1162,7 +1158,7 @@ def simple_build(name, way, extra_hc_opts, should_fail, top_mod, link, addsuf, b if exit_code != 0: return failBecause('exit code non-0') - return passed() + return statsResult # ----------------------------------------------------------------------------- # Run a program and check its output @@ -1229,7 +1225,10 @@ def simple_run(name, way, prog, extra_run_opts): if check_prof and not check_prof_ok(name, way): return failBecause('bad profile') - return checkStats(name, way, stats_file, opts.stats_range_fields) + if not opts.is_compiler_test: + return checkStats(name, way, stats_file, opts.stats_range_fields) + else: + return passed() def rts_flags(way): args = config.way_rts_flags.get(way, []) From git at git.haskell.org Tue Aug 29 15:12:22 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 29 Aug 2017 15:12:22 +0000 (UTC) Subject: [commit: ghc] wip/perf-testsuite: Add name format verification to comparison function and fix boolean conditional in some test functions (2445d20) Message-ID: <20170829151222.54B153A5C1@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/perf-testsuite Link : http://ghc.haskell.org/trac/ghc/changeset/2445d20906b43a468999a117b8a4b5ebf9eacf58/ghc >--------------------------------------------------------------- commit 2445d20906b43a468999a117b8a4b5ebf9eacf58 Author: Jared Weakly Date: Tue Aug 29 08:13:53 2017 -0700 Add name format verification to comparison function and fix boolean conditional in some test functions >--------------------------------------------------------------- 2445d20906b43a468999a117b8a4b5ebf9eacf58 testsuite/driver/perf_notes.py | 10 ++++++++-- testsuite/driver/testlib.py | 2 +- 2 files changed, 9 insertions(+), 3 deletions(-) diff --git a/testsuite/driver/perf_notes.py b/testsuite/driver/perf_notes.py index d0b229e..97e6d1c 100644 --- a/testsuite/driver/perf_notes.py +++ b/testsuite/driver/perf_notes.py @@ -102,6 +102,8 @@ def main(): testing_metrics = ['bytes allocated', 'peak_megabytes_allocated', 'max_bytes_used'] +# These my_ functions are duplicates of functions in testlib.py that I can't import here. +# and are mostly a consequence of some semi-ugly refactoring. def my_passed(reason=''): return {'passFail': 'pass', 'reason' : reason} @@ -121,9 +123,9 @@ def test_cmp(full_name, field, val, expected, dev=20): if val < lowerBound: result = my_failBecause('value is too low:\n(If this is \ because you have improved GHC, please\nupdate the test so that GHC \ - doesn\'t regress again)') + doesn\'t regress again)','stat') if val > upperBound: - result = my_failBecause('value is too high:\nstat is not good enough') + result = my_failBecause('value is too high:\nstat is not good enough','stat') if val < lowerBound or val > upperBound or config.verbose >= 4: length = max(len(str(x)) for x in [expected, lowerBound, upperBound, val]) @@ -147,6 +149,10 @@ def comparison(metric='all', deviation=20, compiler=False): return lambda name, opts, m=metric, d=deviation, c=compiler: _comparison(name, opts, m, d, c) def _comparison(name, opts, metric, deviation, is_compiler_test): + if not re.match('^[0-9]*[a-zA-Z][a-zA-Z0-9._-]*$', name): + # my_framework_fail(name, 'bad_name', 'This test has an invalid name') + my_failBecause('This test has an invalid name.') + tests = parse_git_notes('perf','HEAD^') # Might have multiple metrics being measured for a single test. diff --git a/testsuite/driver/testlib.py b/testsuite/driver/testlib.py index 042e330..7cb3269 100644 --- a/testsuite/driver/testlib.py +++ b/testsuite/driver/testlib.py @@ -1192,7 +1192,7 @@ def simple_run(name, way, prog, extra_run_opts): my_rts_flags = rts_flags(way) stats_file = name + '.stats' - if not opts.is_compiler_test: + if isStatsTest() and not opts.is_compiler_test: stats_args = ' +RTS -V0 -t' + stats_file + ' --machine-readable -RTS' else: stats_args = '' From git at git.haskell.org Tue Aug 29 17:03:34 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 29 Aug 2017 17:03:34 +0000 (UTC) Subject: [commit: ghc] wip/T14152: Do not assign an unfolding to exit join points (a1bd762) Message-ID: <20170829170334.DB3DE3A5C1@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14152 Link : http://ghc.haskell.org/trac/ghc/changeset/a1bd7624ff7012d39dd1decd9f68fb81cebbd966/ghc >--------------------------------------------------------------- commit a1bd7624ff7012d39dd1decd9f68fb81cebbd966 Author: Joachim Breitner Date: Tue Aug 29 18:01:06 2017 +0100 Do not assign an unfolding to exit join points to prevent them from being inlied. >--------------------------------------------------------------- a1bd7624ff7012d39dd1decd9f68fb81cebbd966 compiler/simplCore/Simplify.hs | 27 +++++++++++++++++++-------- 1 file changed, 19 insertions(+), 8 deletions(-) diff --git a/compiler/simplCore/Simplify.hs b/compiler/simplCore/Simplify.hs index 7d83be6..e0cfc00 100644 --- a/compiler/simplCore/Simplify.hs +++ b/compiler/simplCore/Simplify.hs @@ -42,7 +42,7 @@ import CoreOpt ( pushCoTyArg, pushCoValArg import Rules ( mkRuleInfo, lookupRule, getRules ) --import TysPrim ( intPrimTy ) -- temporalily commented out. See #8326 import BasicTypes ( TopLevelFlag(..), isNotTopLevel, isTopLevel, - RecFlag(..) ) + RecFlag(..), isOneOcc ) import MonadUtils ( foldlM, mapAccumLM, liftIO ) import Maybes ( isJust, fromJust, orElse, catMaybes ) --import Unique ( hasKey ) -- temporalily commented out. See #8326 @@ -1744,14 +1744,16 @@ exitify exitUniques pairs = | is_exit = do -- create an id for the exit path u <- getUnique - let res_ty = exprType e - args = filter (`elemVarSet` fvs) captured - args_tys = map idType args - ty = mkFunTys args_tys res_ty - v = mkSysLocal (fsLit "exit") u ty `asJoinId` length args + let args = filter (`elemVarSet` fvs) captured rhs = mkLams args e - e' = mkVarApps (Var v) args - addExit v rhs + ty = exprType rhs + join_arity = length args + v = mkSysLocal (fsLit "exit") u ty `asJoinId` join_arity + --v' = v `setIdUnfolding` mkCoreUnfolding InlineRhs False rhs UnfNever + v' = v `setIdOccInfo` exit_occ_info + + e' = mkVarApps (Var v') args + addExit v' rhs return e' where -- An exit expression has no recursive calls @@ -1761,6 +1763,10 @@ exitify exitUniques pairs = is_interesting = not (isEmptyVarSet (fvs `minusVarSet` mkVarSet captured)) fvs = exprFreeVars e + exit_occ_info = OneOcc { occ_in_lam = True + , occ_one_br = True + , occ_int_cxt = False + , occ_tail = AlwaysTailCalled join_arity } go captured (Case scrut bndr ty alts) = do alts' <- mapM (goAlt (bndr:captured)) alts @@ -3477,6 +3483,11 @@ simplLetUnfolding :: SimplEnv-> TopLevelFlag simplLetUnfolding env top_lvl cont_mb id new_rhs unf | isStableUnfolding unf = simplUnfolding env top_lvl cont_mb id unf + -- A join point that occurs under a lambda: This means that + -- this join point is called from a recursive group, and we do not + -- want to inine them! + | isJoinId id, isOneOcc (idOccInfo id), occ_in_lam (idOccInfo id) + = return unf | otherwise = is_bottoming `seq` -- See Note [Force bottoming field] do { dflags <- getDynFlags From git at git.haskell.org Tue Aug 29 17:04:47 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 29 Aug 2017 17:04:47 +0000 (UTC) Subject: [commit: ghc] wip/T14152: Do not assign an unfolding to exit join points (d55e22f) Message-ID: <20170829170447.296ED3A5C1@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14152 Link : http://ghc.haskell.org/trac/ghc/changeset/d55e22f4349830c184251b5d625f447d582aef29/ghc >--------------------------------------------------------------- commit d55e22f4349830c184251b5d625f447d582aef29 Author: Joachim Breitner Date: Tue Aug 29 18:01:06 2017 +0100 Do not assign an unfolding to exit join points to prevent them from being inlied. >--------------------------------------------------------------- d55e22f4349830c184251b5d625f447d582aef29 compiler/simplCore/Simplify.hs | 28 ++++++++++++++++++++-------- 1 file changed, 20 insertions(+), 8 deletions(-) diff --git a/compiler/simplCore/Simplify.hs b/compiler/simplCore/Simplify.hs index 7d83be6..25244a0 100644 --- a/compiler/simplCore/Simplify.hs +++ b/compiler/simplCore/Simplify.hs @@ -42,7 +42,7 @@ import CoreOpt ( pushCoTyArg, pushCoValArg import Rules ( mkRuleInfo, lookupRule, getRules ) --import TysPrim ( intPrimTy ) -- temporalily commented out. See #8326 import BasicTypes ( TopLevelFlag(..), isNotTopLevel, isTopLevel, - RecFlag(..) ) + RecFlag(..), isOneOcc ) import MonadUtils ( foldlM, mapAccumLM, liftIO ) import Maybes ( isJust, fromJust, orElse, catMaybes ) --import Unique ( hasKey ) -- temporalily commented out. See #8326 @@ -1744,14 +1744,16 @@ exitify exitUniques pairs = | is_exit = do -- create an id for the exit path u <- getUnique - let res_ty = exprType e - args = filter (`elemVarSet` fvs) captured - args_tys = map idType args - ty = mkFunTys args_tys res_ty - v = mkSysLocal (fsLit "exit") u ty `asJoinId` length args + let args = filter (`elemVarSet` fvs) captured rhs = mkLams args e - e' = mkVarApps (Var v) args - addExit v rhs + ty = exprType rhs + join_arity = length args + v = mkSysLocal (fsLit "exit") u ty `asJoinId` join_arity + --v' = v `setIdUnfolding` mkCoreUnfolding InlineRhs False rhs UnfNever + v' = v `setIdOccInfo` exit_occ_info join_arity + + e' = mkVarApps (Var v') args + addExit v' rhs return e' where -- An exit expression has no recursive calls @@ -1761,6 +1763,11 @@ exitify exitUniques pairs = is_interesting = not (isEmptyVarSet (fvs `minusVarSet` mkVarSet captured)) fvs = exprFreeVars e + exit_occ_info join_arity = + OneOcc { occ_in_lam = True + , occ_one_br = True + , occ_int_cxt = False + , occ_tail = AlwaysTailCalled join_arity } go captured (Case scrut bndr ty alts) = do alts' <- mapM (goAlt (bndr:captured)) alts @@ -3477,6 +3484,11 @@ simplLetUnfolding :: SimplEnv-> TopLevelFlag simplLetUnfolding env top_lvl cont_mb id new_rhs unf | isStableUnfolding unf = simplUnfolding env top_lvl cont_mb id unf + -- A join point that occurs under a lambda: This means that + -- this join point is called from a recursive group, and we do not + -- want to inine them! + | isJoinId id, isOneOcc (idOccInfo id), occ_in_lam (idOccInfo id) + = return unf | otherwise = is_bottoming `seq` -- See Note [Force bottoming field] do { dflags <- getDynFlags From git at git.haskell.org Tue Aug 29 17:40:52 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 29 Aug 2017 17:40:52 +0000 (UTC) Subject: [commit: ghc] wip/T14152: Create isExitJoinId :: Var -> Bool (fa21c52) Message-ID: <20170829174052.44FEE3A5C1@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14152 Link : http://ghc.haskell.org/trac/ghc/changeset/fa21c524f4e068fc730b2931309fa772864f8b2a/ghc >--------------------------------------------------------------- commit fa21c524f4e068fc730b2931309fa772864f8b2a Author: Joachim Breitner Date: Tue Aug 29 18:39:36 2017 +0100 Create isExitJoinId :: Var -> Bool it uses the occInfo, so is only valid as long as that information is kept around (in the simplifier: InId, but not OutId). >--------------------------------------------------------------- fa21c524f4e068fc730b2931309fa772864f8b2a compiler/basicTypes/Id.hs | 5 ++++- compiler/simplCore/SimplUtils.hs | 2 +- compiler/simplCore/Simplify.hs | 11 ++++------- 3 files changed, 9 insertions(+), 9 deletions(-) diff --git a/compiler/basicTypes/Id.hs b/compiler/basicTypes/Id.hs index aab5569..53fcae0 100644 --- a/compiler/basicTypes/Id.hs +++ b/compiler/basicTypes/Id.hs @@ -74,7 +74,7 @@ module Id ( DictId, isDictId, isEvVar, -- ** Join variables - JoinId, isJoinId, isJoinId_maybe, idJoinArity, + JoinId, isJoinId, isJoinId_maybe, idJoinArity, isExitJoinId, asJoinId, asJoinId_maybe, zapJoinId, -- ** Inline pragma stuff @@ -495,6 +495,9 @@ isJoinId_maybe id _ -> Nothing | otherwise = Nothing +isExitJoinId :: Var -> Bool +isExitJoinId id = isJoinId id && isOneOcc (idOccInfo id) && occ_in_lam (idOccInfo id) + idDataCon :: Id -> DataCon -- ^ Get from either the worker or the wrapper 'Id' to the 'DataCon'. Currently used only in the desugarer. -- diff --git a/compiler/simplCore/SimplUtils.hs b/compiler/simplCore/SimplUtils.hs index f7be9df..bdbd6a1 100644 --- a/compiler/simplCore/SimplUtils.hs +++ b/compiler/simplCore/SimplUtils.hs @@ -1065,7 +1065,7 @@ preInlineUnconditionally dflags env top_lvl bndr rhs | isTopLevel top_lvl && isBottomingId bndr = False -- Note [Top-level bottoming Ids] | not (gopt Opt_SimplPreInlining dflags) = False | isCoVar bndr = False -- Note [Do not inline CoVars unconditionally] - | isJoinId bndr, isOneOcc (idOccInfo bndr), occ_in_lam (idOccInfo bndr) = False + | isExitJoinId bndr = False | otherwise = case idOccInfo bndr of IAmDead -> True -- Happens in ((\x.1) v) occ at OneOcc { occ_one_br = True } diff --git a/compiler/simplCore/Simplify.hs b/compiler/simplCore/Simplify.hs index 25244a0..edeada8 100644 --- a/compiler/simplCore/Simplify.hs +++ b/compiler/simplCore/Simplify.hs @@ -42,7 +42,7 @@ import CoreOpt ( pushCoTyArg, pushCoValArg import Rules ( mkRuleInfo, lookupRule, getRules ) --import TysPrim ( intPrimTy ) -- temporalily commented out. See #8326 import BasicTypes ( TopLevelFlag(..), isNotTopLevel, isTopLevel, - RecFlag(..), isOneOcc ) + RecFlag(..) ) import MonadUtils ( foldlM, mapAccumLM, liftIO ) import Maybes ( isJust, fromJust, orElse, catMaybes ) --import Unique ( hasKey ) -- temporalily commented out. See #8326 @@ -451,8 +451,8 @@ simplJoinBind :: SimplEnv -> InExpr -> SimplEnv -- The RHS and its environment -> SimplM SimplEnv simplJoinBind env is_rec cont bndr bndr1 rhs rhs_se - = -- pprTrace "simplLazyBind" ((ppr bndr <+> ppr bndr1) $$ - -- ppr rhs $$ ppr (seIdSubst rhs_se)) $ + = -- pprTrace "simplJoinBind" ((ppr bndr <+> ppr bndr1) $$ + -- ppr rhs $$ ppr (seIdSubst rhs_se)) $ do { let rhs_env = rhs_se `setInScopeAndZapFloats` env ; rhs' <- simplJoinRhs rhs_env bndr rhs cont ; completeBind env NotTopLevel is_rec (Just cont) bndr bndr1 rhs' } @@ -3484,10 +3484,7 @@ simplLetUnfolding :: SimplEnv-> TopLevelFlag simplLetUnfolding env top_lvl cont_mb id new_rhs unf | isStableUnfolding unf = simplUnfolding env top_lvl cont_mb id unf - -- A join point that occurs under a lambda: This means that - -- this join point is called from a recursive group, and we do not - -- want to inine them! - | isJoinId id, isOneOcc (idOccInfo id), occ_in_lam (idOccInfo id) + | isExitJoinId id -- Do not inline exit join points = return unf | otherwise = is_bottoming `seq` -- See Note [Force bottoming field] From git at git.haskell.org Tue Aug 29 17:40:49 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 29 Aug 2017 17:40:49 +0000 (UTC) Subject: [commit: ghc] wip/T14152: Do not preInlineUnconditionally exit join points (7ecbc76) Message-ID: <20170829174049.8BC533A5C1@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14152 Link : http://ghc.haskell.org/trac/ghc/changeset/7ecbc76ff6be76b192195956169a1a7c04455dac/ghc >--------------------------------------------------------------- commit 7ecbc76ff6be76b192195956169a1a7c04455dac Author: Joachim Breitner Date: Tue Aug 29 18:12:57 2017 +0100 Do not preInlineUnconditionally exit join points >--------------------------------------------------------------- 7ecbc76ff6be76b192195956169a1a7c04455dac compiler/simplCore/SimplUtils.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/compiler/simplCore/SimplUtils.hs b/compiler/simplCore/SimplUtils.hs index b01955c..f7be9df 100644 --- a/compiler/simplCore/SimplUtils.hs +++ b/compiler/simplCore/SimplUtils.hs @@ -1065,6 +1065,7 @@ preInlineUnconditionally dflags env top_lvl bndr rhs | isTopLevel top_lvl && isBottomingId bndr = False -- Note [Top-level bottoming Ids] | not (gopt Opt_SimplPreInlining dflags) = False | isCoVar bndr = False -- Note [Do not inline CoVars unconditionally] + | isJoinId bndr, isOneOcc (idOccInfo bndr), occ_in_lam (idOccInfo bndr) = False | otherwise = case idOccInfo bndr of IAmDead -> True -- Happens in ((\x.1) v) occ at OneOcc { occ_one_br = True } From git at git.haskell.org Tue Aug 29 18:01:24 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 29 Aug 2017 18:01:24 +0000 (UTC) Subject: [commit: ghc] master: desugar: Ensure that a module's dep_orphs doesn't contain itself (db3a8e1) Message-ID: <20170829180124.3705C3A5C1@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/db3a8e168ad81f54ec58eebc4c75a0eaad889daf/ghc >--------------------------------------------------------------- commit db3a8e168ad81f54ec58eebc4c75a0eaad889daf Author: Ben Gamari Date: Sat Aug 26 16:17:18 2017 -0400 desugar: Ensure that a module's dep_orphs doesn't contain itself Consider that we have two modules, A and B, both with hs-boot files, * A.hs contains a SOURCE import of B * B.hs-boot contains a SOURCE import of A * A.hs-boot declares an orphan instance * A.hs defines the orphan instance In this case, B's dep_orphs will contain A due to its SOURCE import of A. Consequently, A will contain itself in its imp_orphs due to its import of B. This fact would end up being recorded in A's interface file. This would then break the invariant asserted by calculateAvails that a module does not itself in its dep_orphs. This was the cause of #14128. The solution is to remove self-references from imp_orphs when constructing dep_orphs; we already did a similar thing for dep_mods. I believe we should do the same for dep_finsts, although I'm treating this as a separate bug. Reviewers: austin Subscribers: rwbarton, thomie Differential Revision: https://phabricator.haskell.org/D3892 >--------------------------------------------------------------- db3a8e168ad81f54ec58eebc4c75a0eaad889daf compiler/deSugar/DsUsage.hs | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/compiler/deSugar/DsUsage.hs b/compiler/deSugar/DsUsage.hs index 8158a8e..3f302fa 100644 --- a/compiler/deSugar/DsUsage.hs +++ b/compiler/deSugar/DsUsage.hs @@ -38,7 +38,7 @@ mkDependencies -- Template Haskell used? th_used <- readIORef th_var let dep_mods = modDepsElts (delFromUFM (imp_dep_mods imports) - (moduleName mod)) + (moduleName mod)) -- M.hi-boot can be in the imp_dep_mods, but we must remove -- it before recording the modules on which this one depends! -- (We want to retain M.hi-boot in imp_dep_mods so that @@ -46,6 +46,10 @@ mkDependencies -- on M.hi-boot, and hence that we should do the hi-boot consistency -- check.) + dep_orphs = filter (/= mod) (imp_orphs imports) + -- We must also remove self-references from imp_orphs. See + -- #14128. + pkgs | th_used = Set.insert (toInstalledUnitId thUnitId) (imp_dep_pkgs imports) | otherwise = imp_dep_pkgs imports @@ -57,7 +61,7 @@ mkDependencies return Deps { dep_mods = dep_mods, dep_pkgs = dep_pkgs', - dep_orphs = sortBy stableModuleCmp (imp_orphs imports), + dep_orphs = dep_orphs, dep_finsts = sortBy stableModuleCmp (imp_finsts imports) } -- sort to get into canonical order -- NB. remember to use lexicographic ordering From git at git.haskell.org Tue Aug 29 18:01:27 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 29 Aug 2017 18:01:27 +0000 (UTC) Subject: [commit: ghc] master: testsuite: Add test for #14128 (248ad30) Message-ID: <20170829180127.C092E3A5C1@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/248ad30385acc0f81f1959b6345a7388be76dc85/ghc >--------------------------------------------------------------- commit 248ad30385acc0f81f1959b6345a7388be76dc85 Author: Ben Gamari Date: Sat Aug 26 16:16:47 2017 -0400 testsuite: Add test for #14128 Reviewers: austin, goldfire Subscribers: rwbarton, thomie GHC Trac Issues: #14128 Differential Revision: https://phabricator.haskell.org/D3890 >--------------------------------------------------------------- 248ad30385acc0f81f1959b6345a7388be76dc85 testsuite/tests/typecheck/should_compile/T14128.hs | 7 +++++++ testsuite/tests/typecheck/should_compile/T14128.hs-boot | 5 +++++ testsuite/tests/typecheck/should_compile/T14128Main.hs | 10 ++++++++++ testsuite/tests/typecheck/should_compile/T14128Type.hs | 3 +++ testsuite/tests/typecheck/should_compile/T14128a.hs | 1 + testsuite/tests/typecheck/should_compile/T14128a.hs-boot | 3 +++ testsuite/tests/typecheck/should_compile/all.T | 1 + 7 files changed, 30 insertions(+) diff --git a/testsuite/tests/typecheck/should_compile/T14128.hs b/testsuite/tests/typecheck/should_compile/T14128.hs new file mode 100644 index 0000000..a1159c6 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T14128.hs @@ -0,0 +1,7 @@ +module T14128 where + +import T14128Type +import {-# SOURCE #-} T14128a + +instance Show AType where + show AType = "hello" diff --git a/testsuite/tests/typecheck/should_compile/T14128.hs-boot b/testsuite/tests/typecheck/should_compile/T14128.hs-boot new file mode 100644 index 0000000..27ef36a --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T14128.hs-boot @@ -0,0 +1,5 @@ +module T14128 where + +import T14128Type + +instance Show AType diff --git a/testsuite/tests/typecheck/should_compile/T14128Main.hs b/testsuite/tests/typecheck/should_compile/T14128Main.hs new file mode 100644 index 0000000..9407606 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T14128Main.hs @@ -0,0 +1,10 @@ +module T14128Main where + +import T14128 + +-- Overview: +-- * T14128Main is imports T14128 +-- * T14128Type defines datatype MyType +-- * T14128 has a boot file and defines a orphan Show instance; it SOURCE +-- imports T14128 +-- * T14128a has a boot file which SOURCE imports T14128 diff --git a/testsuite/tests/typecheck/should_compile/T14128Type.hs b/testsuite/tests/typecheck/should_compile/T14128Type.hs new file mode 100644 index 0000000..f64ec48 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T14128Type.hs @@ -0,0 +1,3 @@ +module T14128Type where + +data AType = AType diff --git a/testsuite/tests/typecheck/should_compile/T14128a.hs b/testsuite/tests/typecheck/should_compile/T14128a.hs new file mode 100644 index 0000000..a93b2fe --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T14128a.hs @@ -0,0 +1 @@ +module T14128a where diff --git a/testsuite/tests/typecheck/should_compile/T14128a.hs-boot b/testsuite/tests/typecheck/should_compile/T14128a.hs-boot new file mode 100644 index 0000000..e38681a --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T14128a.hs-boot @@ -0,0 +1,3 @@ +module T14128a where + +import {-# SOURCE #-} T14128 diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index b929195..fde7bae 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -571,5 +571,6 @@ test('T13881', normal, compile, ['']) test('T13915a', normal, multimod_compile, ['T13915a', '-v0']) test('T13915b', normal, compile, ['']) test('T13984', normal, compile, ['']) +test('T14128', normal, multimod_compile, ['T14128Main', '-v0']) test('T14149', normal, compile, ['']) test('T14154', normal, compile, ['']) From git at git.haskell.org Tue Aug 29 18:01:30 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 29 Aug 2017 18:01:30 +0000 (UTC) Subject: [commit: ghc] master: Remove dll-split. (5266ab9) Message-ID: <20170829180130.975CD3A5C1@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5266ab9059dffa741b172636f50f1fbfd491dbb4/ghc >--------------------------------------------------------------- commit 5266ab9059dffa741b172636f50f1fbfd491dbb4 Author: Tamar Christina Date: Mon Aug 28 12:29:48 2017 -0400 Remove dll-split. This patch removes dll-split from the code base, the reason is dll-split no longer makes any sense. It was designed to split a dll in two, but we now already have many more symbols than would fit inside two dlls. So we need a third one. This means there's no point in having to maintain this list as it'll never work anyway and the solution isn't scalable. Test Plan: ./validate Reviewers: austin, bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie, #ghc_windows_task_force GHC Trac Issues: #5987 Differential Revision: https://phabricator.haskell.org/D3882 >--------------------------------------------------------------- 5266ab9059dffa741b172636f50f1fbfd491dbb4 compiler/ghc.mk | 148 ---------------------------------------- compiler/main/DynFlags.hs | 34 +-------- compiler/main/Hooks.hs | 2 - compiler/main/Packages.hs | 24 ++++--- ghc.mk | 1 - rules/build-package-data.mk | 2 +- rules/build-package-way.mk | 43 +----------- rules/distdir-way-opts.mk | 8 --- utils/dll-split/Main.hs | 82 ---------------------- utils/dll-split/dll-split.cabal | 28 -------- utils/dll-split/ghc.mk | 23 ------- utils/ghc-cabal/Main.hs | 39 ++--------- 12 files changed, 27 insertions(+), 407 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 5266ab9059dffa741b172636f50f1fbfd491dbb4 From git at git.haskell.org Tue Aug 29 18:01:33 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 29 Aug 2017 18:01:33 +0000 (UTC) Subject: [commit: ghc] master: Refactor type family instance abstract syntax declarations (895a765) Message-ID: <20170829180133.6B4123A5C1@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/895a7650a038131f3043f882c558c627abe9a61e/ghc >--------------------------------------------------------------- commit 895a7650a038131f3043f882c558c627abe9a61e Author: Ryan Scott Date: Tue Aug 29 12:38:54 2017 -0400 Refactor type family instance abstract syntax declarations This implements @simonpj's suggested refactoring of the abstract syntax for type/data family instances (from https://ghc.haskell.org/trac/ghc/ticket/14131#comment:9). This combines the previously separate `TyFamEqn` and `DataFamInstDecl` types into a single `FamEqn` datatype. This also factors the `HsImplicitBndrs` out of `HsTyPats` in favor of putting them just outside of `FamEqn` (as opposed to before, where all of the implicit binders were embedded inside of `TyFamEqn`/`DataFamInstDecl`). Finally, along the way I noticed that `dfid_fvs` and `tfid_fvs` were completely unused, so I removed them. Aside from some changes in parser test output, there is no change in behavior. Requires a Haddock submodule commit from my fork (at https://github.com/RyanGlScott/haddock/commit/815d2deb9c0222c916becccf84 64b740c26255fd) Test Plan: ./validate Reviewers: simonpj, austin, goldfire, bgamari, alanz Reviewed By: bgamari Subscribers: mpickering, goldfire, rwbarton, thomie, simonpj GHC Trac Issues: #14131 Differential Revision: https://phabricator.haskell.org/D3881 >--------------------------------------------------------------- 895a7650a038131f3043f882c558c627abe9a61e compiler/deSugar/DsMeta.hs | 24 ++-- compiler/hsSyn/Convert.hs | 34 ++--- compiler/hsSyn/HsDecls.hs | 145 ++++++++++++--------- compiler/hsSyn/HsUtils.hs | 3 +- compiler/parser/Parser.y | 16 ++- compiler/parser/RdrHsSyn.hs | 40 +++--- compiler/rename/RnNames.hs | 9 +- compiler/rename/RnSource.hs | 89 ++++++------- compiler/typecheck/TcEnv.hs | 3 +- compiler/typecheck/TcInstDcls.hs | 30 +++-- compiler/typecheck/TcTyClsDecls.hs | 74 ++++++----- .../parser/should_compile/DumpParsedAst.stderr | 116 ++++++++--------- .../parser/should_compile/DumpRenamedAst.stderr | 82 ++++++------ utils/haddock | 2 +- 14 files changed, 349 insertions(+), 318 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 895a7650a038131f3043f882c558c627abe9a61e From git at git.haskell.org Tue Aug 29 19:03:02 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 29 Aug 2017 19:03:02 +0000 (UTC) Subject: [commit: ghc] ghc-8.2: Use a well-kinded substitution to instantiate (d913594) Message-ID: <20170829190302.E69D73A5C1@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.2 Link : http://ghc.haskell.org/trac/ghc/changeset/d913594f1bc471ab5ac4299e12c59efb91b60d84/ghc >--------------------------------------------------------------- commit d913594f1bc471ab5ac4299e12c59efb91b60d84 Author: Simon Peyton Jones Date: Mon Aug 28 17:21:14 2017 +0100 Use a well-kinded substitution to instantiate In tcDataConPat we were creating an ill-kinded substitution -- or at least one that is well kinded only after you have solved other equalities. THat led to a crash, because the instantiated data con type was ill-kinded. This patch guarantees that the instantiating substitution is well-kinded. Fixed Trac #14154 (cherry picked from commit 4455c86d1635bfb846e750b21dda36dcee028b5e) >--------------------------------------------------------------- d913594f1bc471ab5ac4299e12c59efb91b60d84 compiler/typecheck/Inst.hs | 28 +++++++++++++++++++++- compiler/typecheck/TcPat.hs | 9 +++++-- testsuite/tests/typecheck/should_compile/T14154.hs | 16 +++++++++++++ testsuite/tests/typecheck/should_compile/all.T | 1 + 4 files changed, 51 insertions(+), 3 deletions(-) diff --git a/compiler/typecheck/Inst.hs b/compiler/typecheck/Inst.hs index eff8c5f..b6aa29f 100644 --- a/compiler/typecheck/Inst.hs +++ b/compiler/typecheck/Inst.hs @@ -11,7 +11,7 @@ The @Inst@ type: dictionaries or method instances module Inst ( deeplySkolemise, topInstantiate, topInstantiateInferred, deeplyInstantiate, - instCall, instDFunType, instStupidTheta, + instCall, instDFunType, instStupidTheta, instTyVarsWith, newWanted, newWanteds, tcInstBinders, tcInstBindersX, tcInstBinderX, @@ -278,6 +278,32 @@ deeply_instantiate orig subst ty , text "subst:" <+> ppr subst ]) ; return (idHsWrapper, ty') } + +instTyVarsWith :: CtOrigin -> [TyVar] -> [TcType] -> TcM TCvSubst +-- Use this when you want to instantiate (forall a b c. ty) with +-- types [ta, tb, tc], but when the kinds of 'a' and 'ta' might +-- not yet match (perhaps because there are unsolved constraints; Trac #14154) +-- If they don't match, emit a kind-equality to promise that they will +-- eventually do so, and thus make a kind-homongeneous substitution. +instTyVarsWith orig tvs tys + = go empty_subst tvs tys + where + empty_subst = mkEmptyTCvSubst (mkInScopeSet (tyCoVarsOfTypes tys)) + + go subst [] [] + = return subst + go subst (tv:tvs) (ty:tys) + | tv_kind `tcEqType` ty_kind + = go (extendTCvSubst subst tv ty) tvs tys + | otherwise + = do { co <- emitWantedEq orig KindLevel Nominal ty_kind tv_kind + ; go (extendTCvSubst subst tv (ty `mkCastTy` co)) tvs tys } + where + tv_kind = substTy subst (tyVarKind tv) + ty_kind = typeKind ty + + go _ _ _ = pprPanic "instTysWith" (ppr tvs $$ ppr tys) + {- ************************************************************************ * * diff --git a/compiler/typecheck/TcPat.hs b/compiler/typecheck/TcPat.hs index 51682c4..0292f9b 100644 --- a/compiler/typecheck/TcPat.hs +++ b/compiler/typecheck/TcPat.hs @@ -735,8 +735,13 @@ tcDataConPat penv (L con_span con_name) data_con pat_ty arg_pats thing_inside ; let all_arg_tys = eqSpecPreds eq_spec ++ theta ++ arg_tys ; checkExistentials ex_tvs all_arg_tys penv - ; (tenv, ex_tvs') <- tcInstSuperSkolTyVarsX - (zipTvSubst univ_tvs ctxt_res_tys) ex_tvs + + ; tenv <- instTyVarsWith PatOrigin univ_tvs ctxt_res_tys + -- NB: Do not use zipTvSubst! See Trac #14154 + -- We want to create a well-kinded substitution, so + -- that the instantiated type is well-kinded + + ; (tenv, ex_tvs') <- tcInstSuperSkolTyVarsX tenv ex_tvs -- Get location from monad, not from ex_tvs ; let -- pat_ty' = mkTyConApp tycon ctxt_res_tys diff --git a/testsuite/tests/typecheck/should_compile/T14154.hs b/testsuite/tests/typecheck/should_compile/T14154.hs new file mode 100644 index 0000000..e29ee85 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T14154.hs @@ -0,0 +1,16 @@ +{-# Language RankNTypes, DerivingStrategies, TypeApplications, + ScopedTypeVariables, GADTs, PolyKinds #-} + +module T14154 where + +newtype Ran g h a + = MkRan (forall b. (a -> g b) -> h b) + +newtype Swap p f g a where + MkSwap :: p g f a -> Swap p f g a + +ireturn :: forall m i a. a -> m i i a +ireturn = undefined + +xs = case ireturn @(Swap Ran) 'a' of + MkSwap (MkRan f) -> f print diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index badb814..044f2eb 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -561,3 +561,4 @@ test('T13881', normal, compile, ['']) test('T13915a', normal, multimod_compile, ['T13915a', '-v0']) test('T13915b', normal, compile, ['']) test('T13984', normal, compile, ['']) +test('T14154', normal, compile, ['']) From git at git.haskell.org Tue Aug 29 19:03:05 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 29 Aug 2017 19:03:05 +0000 (UTC) Subject: [commit: ghc] ghc-8.2: Small refactor of getRuntimeRep (cbf4723) Message-ID: <20170829190305.CE0D83A5C1@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.2 Link : http://ghc.haskell.org/trac/ghc/changeset/cbf472384b5b583c24d1a1a32f3fa58d4f1501b1/ghc >--------------------------------------------------------------- commit cbf472384b5b583c24d1a1a32f3fa58d4f1501b1 Author: Simon Peyton Jones Date: Mon Aug 28 17:33:59 2017 +0100 Small refactor of getRuntimeRep Instead of using a string argument, use HasDebugCallStack. (Oddly, some functions were using both!) Plus, use getRuntimeRep rather than getRuntimeRep_maybe when if the caller panics on Nothing. Less code, and a better debug stack. (cherry picked from commit a6c448b403dbe8720178ca82100f34baedb1f47e) >--------------------------------------------------------------- cbf472384b5b583c24d1a1a32f3fa58d4f1501b1 compiler/coreSyn/MkCore.hs | 4 +- compiler/deSugar/DsBinds.hs | 6 +-- compiler/deSugar/DsExpr.hs | 2 +- compiler/deSugar/DsUtils.hs | 4 +- compiler/iface/TcIface.hs | 2 +- compiler/prelude/TysWiredIn.hs | 4 +- compiler/typecheck/TcExpr.hs | 2 +- compiler/typecheck/TcHsType.hs | 4 +- compiler/typecheck/TcInstDcls.hs | 3 +- compiler/typecheck/TcRnDriver.hs | 2 +- compiler/types/Type.hs | 80 +++++++++++++++++-------------------- compiler/vectorise/Vectorise/Exp.hs | 3 +- 12 files changed, 55 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 cbf472384b5b583c24d1a1a32f3fa58d4f1501b1 From git at git.haskell.org Tue Aug 29 22:00:03 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 29 Aug 2017 22:00:03 +0000 (UTC) Subject: [commit: ghc] master: Fix decomposition error on Windows (3c6b2fc) Message-ID: <20170829220003.CEBCA3A5C1@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3c6b2fc3b5ca11a5410405664e4640767ef941dd/ghc >--------------------------------------------------------------- commit 3c6b2fc3b5ca11a5410405664e4640767ef941dd Author: Tamar Christina Date: Tue Aug 29 22:59:38 2017 +0100 Fix decomposition error on Windows Summary: Fix the path decomposition error that occurs when the Symlink resolver fails. `Win32.try` throws an exception, so catch it and assume the path isn't a symlink to use the old behavior. Test Plan: ./validate Reviewers: austin, bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie GHC Trac Issues: #14159 Differential Revision: https://phabricator.haskell.org/D3891 >--------------------------------------------------------------- 3c6b2fc3b5ca11a5410405664e4640767ef941dd compiler/main/SysTools.hs | 13 +++++++++++-- 1 file changed, 11 insertions(+), 2 deletions(-) diff --git a/compiler/main/SysTools.hs b/compiler/main/SysTools.hs index 57d77a3..b48bbf4 100644 --- a/compiler/main/SysTools.hs +++ b/compiler/main/SysTools.hs @@ -1340,9 +1340,18 @@ getFinalPath name = do (fILE_ATTRIBUTE_NORMAL .|. fILE_FLAG_BACKUP_SEMANTICS) Nothing let fnPtr = makeGetFinalPathNameByHandle $ castPtrToFunPtr addr - path <- Win32.try "GetFinalPathName" + -- First try to resolve the path to get the actual path + -- of any symlinks or other file system redirections that + -- may be in place. However this function can fail, and in + -- the event it does fail, we need to try using the + -- original path and see if we can decompose that. + -- If the call fails Win32.try will raise an exception + -- that needs to be caught. See #14159 + path <- (Win32.try "GetFinalPathName" (\buf len -> fnPtr handle buf len 0) 512 - `finally` closeHandle handle + `finally` closeHandle handle) + `catch` + (\(_ :: IOException) -> return name) return $ Just path type GetFinalPath = HANDLE -> LPTSTR -> DWORD -> DWORD -> IO DWORD From git at git.haskell.org Tue Aug 29 22:09:35 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 29 Aug 2017 22:09:35 +0000 (UTC) Subject: [commit: ghc] master: Add gen-dll as replacement for dll-split (5f6a820) Message-ID: <20170829220935.9FD8B3A5C1@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5f6a82040694f7c8c2b394c1b418c0167b963e0b/ghc >--------------------------------------------------------------- commit 5f6a82040694f7c8c2b394c1b418c0167b963e0b Author: Tamar Christina Date: Tue Aug 29 23:09:09 2017 +0100 Add gen-dll as replacement for dll-split Summary: This tool can be used to generate dll's for any list of object files given to it. It will then repartition them automatically to fit within a dll and generates as many dll's as needed to do this. Cyclic dependencies between these generated dlls are handle automatically so there is no need to tell it how to partition. It is also a lot more general than `dll-split` as it is able to split any package not just `libGHC`. It also uses a trick using GNU style import libraries to hide the splitting from the rest of the pipeline. Which means come linking time you don't need to know which dll contains what symbol or how many split dlls were created. The import libraries are by default created with libtool. However since libtool is BFD based it is very slow. So if present and detected by configure the `genlib` tool from the msys2 project is used. This makes a difference of about ~45 minutes when compiling. To install `genlib` run `pacman -Sy mingw-w64-$(uname -m)-tools-git`. More detailed explaination of the process can be found here https://ghc.haskell.org/trac/ghc/wiki/WindowsDynamicLinking Test Plan: ./validate Reviewers: austin, hvr, bgamari, erikd, simonmar Reviewed By: bgamari Subscribers: snowleopard, rwbarton, thomie, erikd, #ghc_windows_task_force GHC Trac Issues: #5987 Differential Revision: https://phabricator.haskell.org/D3883 >--------------------------------------------------------------- 5f6a82040694f7c8c2b394c1b418c0167b963e0b .gitignore | 1 + aclocal.m4 | 3 + configure.ac | 47 ++- docs/users_guide/8.4.1-notes.rst | 10 + ghc.mk | 7 + rts/ghc.mk | 24 +- rules/build-package-way.mk | 31 +- utils/gen-dll/Main.hs | 510 ++++++++++++++++++++++++++++++++ {driver/ghci => utils/gen-dll}/Makefile | 2 +- utils/gen-dll/gen-dll.cabal.in | 37 +++ {driver/split => utils/gen-dll}/ghc.mk | 13 +- 11 files changed, 642 insertions(+), 43 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 5f6a82040694f7c8c2b394c1b418c0167b963e0b From git at git.haskell.org Tue Aug 29 23:10:49 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 29 Aug 2017 23:10:49 +0000 (UTC) Subject: [commit: ghc] master: ghc-pkg: Try opening lockfiles in read-write mode first (f86de44) Message-ID: <20170829231049.3E1EE3A5C1@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f86de44dac0a6ca40c5fcd65f3a1944c45fa6011/ghc >--------------------------------------------------------------- commit f86de44dac0a6ca40c5fcd65f3a1944c45fa6011 Author: Ben Gamari Date: Tue Aug 29 14:26:55 2017 -0400 ghc-pkg: Try opening lockfiles in read-write mode first As pointed out in #13945, some filesystems only allow allow exclusive locks if the fd being locked was opened for write access. This causes ghc-pkg to fail as it first attempts to open and exclusively lock its lockfile in read-only mode to accomodate package databases for which we lack write permissions (e.g. global package databases). Instead, we now try read-write mode first, falling back to read-only mode if this fails. Reviewers: austin Subscribers: rwbarton, thomie GHC Trac Issues: #13945 Differential Revision: https://phabricator.haskell.org/D3897 >--------------------------------------------------------------- f86de44dac0a6ca40c5fcd65f3a1944c45fa6011 libraries/ghc-boot/GHC/PackageDb.hs | 22 ++++++++++++++-------- 1 file changed, 14 insertions(+), 8 deletions(-) diff --git a/libraries/ghc-boot/GHC/PackageDb.hs b/libraries/ghc-boot/GHC/PackageDb.hs index bf83d25..9ce07e7 100644 --- a/libraries/ghc-boot/GHC/PackageDb.hs +++ b/libraries/ghc-boot/GHC/PackageDb.hs @@ -239,15 +239,21 @@ lockPackageDbWith mode file = do -- DB for reading then we will require that the installer/packaging has -- included the lock file. -- - -- Thus the logic here is to first try opening in read-only mode (to handle - -- global read-only DBs) and if the file does not exist then try opening in - -- read/write mode to create the lock file. If either succeed then lock the - -- file. IO exceptions (other than the first open attempt failing due to the - -- file not existing) simply propagate. + -- Thus the logic here is to first try opening in read-write mode + -- and if that fails we try read-only (to handle global read-only DBs). + -- If either succeed then lock the file. IO exceptions (other than the first + -- open attempt failing due to the file not existing) simply propagate. + -- + -- Note that there is a complexity here which was discovered in #13945: some + -- filesystems (e.g. NFS) will only allow exclusive locking if the fd was + -- opened for write access. We would previously try opening the lockfile for + -- read-only access first, however this failed when run on such filesystems. + -- Consequently, we now try read-write access first, falling back to read-only + -- if are denied permission (e.g. in the case of a global database). catchJust - (\e -> if isDoesNotExistError e then Just () else Nothing) - (lockFileOpenIn ReadMode) - (const $ lockFileOpenIn ReadWriteMode) + (\e -> if isPermissionError e then Just () else Nothing) + (lockFileOpenIn ReadWriteMode) + (const $ lockFileOpenIn ReadMode) where lock = file <.> "lock" From git at git.haskell.org Tue Aug 29 23:10:52 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 29 Aug 2017 23:10:52 +0000 (UTC) Subject: [commit: ghc] master: PackageDb: Explicitly unlock package database before closing (779b9e6) Message-ID: <20170829231052.032DB3A5C1@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/779b9e6965416ee08af6eb15354cf09e9f40e0d9/ghc >--------------------------------------------------------------- commit 779b9e6965416ee08af6eb15354cf09e9f40e0d9 Author: Ben Gamari Date: Tue Aug 29 14:45:28 2017 -0400 PackageDb: Explicitly unlock package database before closing Reviewers: austin Subscribers: rwbarton, thomie GHC Trac Issues: #13945 Differential Revision: https://phabricator.haskell.org/D3874 >--------------------------------------------------------------- 779b9e6965416ee08af6eb15354cf09e9f40e0d9 libraries/ghc-boot/GHC/PackageDb.hs | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/libraries/ghc-boot/GHC/PackageDb.hs b/libraries/ghc-boot/GHC/PackageDb.hs index 9ce07e7..a59c46e 100644 --- a/libraries/ghc-boot/GHC/PackageDb.hs +++ b/libraries/ghc-boot/GHC/PackageDb.hs @@ -267,7 +267,11 @@ lockPackageDbWith mode file = do return $ PackageDbLock hnd lockPackageDb = lockPackageDbWith ExclusiveLock -unlockPackageDb (PackageDbLock hnd) = hClose hnd +unlockPackageDb (PackageDbLock hnd) = do +#if MIN_VERSION_base(4,11,0) + hUnlock hnd +#endif + hClose hnd -- MIN_VERSION_base(4,10,0) #else From git at git.haskell.org Tue Aug 29 23:10:54 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 29 Aug 2017 23:10:54 +0000 (UTC) Subject: [commit: ghc] master: StgLint: Show type of out-of-scope binders (651b4dc) Message-ID: <20170829231054.BA83D3A5C1@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/651b4dc790d931789eb41dd0e8f281de4061824b/ghc >--------------------------------------------------------------- commit 651b4dc790d931789eb41dd0e8f281de4061824b Author: Ben Gamari Date: Tue Aug 29 14:38:24 2017 -0400 StgLint: Show type of out-of-scope binders Reviewers: austin Subscribers: rwbarton, thomie Differential Revision: https://phabricator.haskell.org/D3887 >--------------------------------------------------------------- 651b4dc790d931789eb41dd0e8f281de4061824b compiler/stgSyn/StgLint.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/compiler/stgSyn/StgLint.hs b/compiler/stgSyn/StgLint.hs index ad7b142..baceca2 100644 --- a/compiler/stgSyn/StgLint.hs +++ b/compiler/stgSyn/StgLint.hs @@ -459,7 +459,8 @@ stgEqType orig_ty1 orig_ty2 checkInScope :: Id -> LintM () checkInScope id = LintM $ \loc scope errs -> if isLocalId id && not (id `elemVarSet` scope) then - ((), addErr errs (hsep [ppr id, text "is out of scope"]) loc) + ((), addErr errs (hsep [ppr id, dcolon, ppr (idType id), + text "is out of scope"]) loc) else ((), errs) From git at git.haskell.org Tue Aug 29 23:10:57 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 29 Aug 2017 23:10:57 +0000 (UTC) Subject: [commit: ghc] master: base: Add support for file unlocking (a27bb1b) Message-ID: <20170829231057.7B9B53A5C1@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a27bb1bd6206bdd5e6004ec1f7e95144a0fcc4d4/ghc >--------------------------------------------------------------- commit a27bb1bd6206bdd5e6004ec1f7e95144a0fcc4d4 Author: Ben Gamari Date: Tue Aug 29 14:45:08 2017 -0400 base: Add support for file unlocking Reviewers: austin, hvr Subscribers: rwbarton, thomie Differential Revision: https://phabricator.haskell.org/D3875 >--------------------------------------------------------------- a27bb1bd6206bdd5e6004ec1f7e95144a0fcc4d4 libraries/base/GHC/IO/Handle/Lock.hsc | 30 ++++++++++++++++++++++++++++++ 1 file changed, 30 insertions(+) diff --git a/libraries/base/GHC/IO/Handle/Lock.hsc b/libraries/base/GHC/IO/Handle/Lock.hsc index ec62f86..daf407c 100644 --- a/libraries/base/GHC/IO/Handle/Lock.hsc +++ b/libraries/base/GHC/IO/Handle/Lock.hsc @@ -8,6 +8,7 @@ module GHC.IO.Handle.Lock ( , LockMode(..) , hLock , hTryLock + , hUnlock ) where #include "HsBaseConfig.h" @@ -97,6 +98,10 @@ hLock h mode = void $ lockImpl h "hLock" mode True hTryLock :: Handle -> LockMode -> IO Bool hTryLock h mode = lockImpl h "hTryLock" mode False +-- | Release a lock taken with 'hLock' or 'hTryLock'. +hUnlock :: Handle -> IO () +hUnlock = unlockImpl + ---------------------------------------- #if HAVE_FLOCK @@ -116,6 +121,11 @@ lockImpl h ctx mode block = do SharedLock -> #{const LOCK_SH} ExclusiveLock -> #{const LOCK_EX} +unlockImpl :: Handle -> IO () +unlockImpl h = do + FD{fdFD = fd} <- handleToFd h + throwErrnoIfMinus1_ "flock" $ c_flock fd #{const LOCK_UN} + foreign import ccall interruptible "flock" c_flock :: CInt -> CInt -> IO CInt @@ -146,6 +156,18 @@ lockImpl h ctx mode block = do SharedLock -> 0 ExclusiveLock -> #{const LOCKFILE_EXCLUSIVE_LOCK} +unlockImpl :: Handle -> IO () +unlockImpl h = do + FD{fdFD = fd} <- handleToFd h + wh <- throwErrnoIf (== iNVALID_HANDLE_VALUE) "hUnlock" $ c_get_osfhandle fd + allocaBytes sizeof_OVERLAPPED $ \ovrlpd -> do + fillBytes ovrlpd 0 sizeof_OVERLAPPED + c_UnlockFileEx wh 0 0xffffffff 0xffffffff ovrlpd >>= \case + True -> return () + False -> getLastError >>= failWith "hUnlock" + where + sizeof_OVERLAPPED = #{size OVERLAPPED} + -- https://msdn.microsoft.com/en-us/library/aa297958.aspx foreign import ccall unsafe "_get_osfhandle" c_get_osfhandle :: CInt -> IO HANDLE @@ -154,10 +176,18 @@ foreign import ccall unsafe "_get_osfhandle" foreign import WINDOWS_CCONV interruptible "LockFileEx" c_LockFileEx :: HANDLE -> DWORD -> DWORD -> DWORD -> DWORD -> Ptr () -> IO BOOL +-- https://msdn.microsoft.com/en-us/library/windows/desktop/aa365716.aspx +foreign import WINDOWS_CCONV interruptible "UnlockFileEx" + c_UnlockFileEx :: HANDLE -> DWORD -> DWORD -> DWORD -> Ptr () -> IO BOOL + #else -- | No-op implementation. lockImpl :: Handle -> String -> LockMode -> Bool -> IO Bool lockImpl _ _ _ _ = throwIO FileLockingNotSupported +-- | No-op implementation. +unlockImpl :: Handle -> IO () +unlockImpl _ = throwIO FileLockingNotSupported + #endif From git at git.haskell.org Tue Aug 29 23:11:00 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 29 Aug 2017 23:11:00 +0000 (UTC) Subject: [commit: ghc] master: nativeGen: Don't index into linked lists (9d57d8c) Message-ID: <20170829231100.3793E3A5C1@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9d57d8c192cd455aa68a7a0c019df97f68ae015f/ghc >--------------------------------------------------------------- commit 9d57d8c192cd455aa68a7a0c019df97f68ae015f Author: Ben Gamari Date: Tue Aug 29 14:51:52 2017 -0400 nativeGen: Don't index into linked lists There were a couple places where we indexed into linked lists of register names. Replace these with arrays. Reviewers: austin Subscribers: rwbarton, thomie Differential Revision: https://phabricator.haskell.org/D3893 >--------------------------------------------------------------- 9d57d8c192cd455aa68a7a0c019df97f68ae015f compiler/nativeGen/RegAlloc/Graph/ArchX86.hs | 25 +++++++++++++++++++------ compiler/nativeGen/X86/Regs.hs | 10 ++++++---- 2 files changed, 25 insertions(+), 10 deletions(-) diff --git a/compiler/nativeGen/RegAlloc/Graph/ArchX86.hs b/compiler/nativeGen/RegAlloc/Graph/ArchX86.hs index 4398990..9873118 100644 --- a/compiler/nativeGen/RegAlloc/Graph/ArchX86.hs +++ b/compiler/nativeGen/RegAlloc/Graph/ArchX86.hs @@ -14,9 +14,12 @@ module RegAlloc.Graph.ArchX86 ( worst, squeese, ) where + import RegAlloc.Graph.ArchBase (Reg(..), RegSub(..), RegClass(..)) import UniqSet +import qualified Data.Array as A + -- | Determine the class of a register classOfReg :: Reg -> RegClass @@ -57,18 +60,28 @@ regName :: Reg -> Maybe String regName reg = case reg of Reg ClassG32 i - | i <= 7-> Just $ [ "eax", "ebx", "ecx", "edx" - , "ebp", "esi", "edi", "esp" ] !! i + | i <= 7 -> + let names = A.listArray (0,8) + [ "eax", "ebx", "ecx", "edx" + , "ebp", "esi", "edi", "esp" ] + in Just $ names A.! i RegSub SubL16 (Reg ClassG32 i) - | i <= 7 -> Just $ [ "ax", "bx", "cx", "dx" - , "bp", "si", "di", "sp"] !! i + | i <= 7 -> + let names = A.listArray (0,8) + [ "ax", "bx", "cx", "dx" + , "bp", "si", "di", "sp"] + in Just $ names A.! i RegSub SubL8 (Reg ClassG32 i) - | i <= 3 -> Just $ [ "al", "bl", "cl", "dl"] !! i + | i <= 3 -> + let names = A.listArray (0,4) [ "al", "bl", "cl", "dl"] + in Just $ names A.! i RegSub SubL8H (Reg ClassG32 i) - | i <= 3 -> Just $ [ "ah", "bh", "ch", "dh"] !! i + | i <= 3 -> + let names = A.listArray (0,4) [ "ah", "bh", "ch", "dh"] + in Just $ names A.! i _ -> Nothing diff --git a/compiler/nativeGen/X86/Regs.hs b/compiler/nativeGen/X86/Regs.hs index 4cb82ea..8bb36ad 100644 --- a/compiler/nativeGen/X86/Regs.hs +++ b/compiler/nativeGen/X86/Regs.hs @@ -58,6 +58,8 @@ import DynFlags import Outputable import Platform +import qualified Data.Array as A + -- | regSqueeze_class reg -- Calculuate the maximum number of register colors that could be -- denied to a node of this class due to having this reg @@ -267,13 +269,13 @@ showReg platform n | n >= firstxmm = "%xmm" ++ show (n-firstxmm) | n >= firstfake = "%fake" ++ show (n-firstfake) | n >= 8 = "%r" ++ show n - | otherwise = regNames platform !! n + | otherwise = regNames platform A.! n -regNames :: Platform -> [String] +regNames :: Platform -> A.Array Int String regNames platform = if target32Bit platform - then ["%eax", "%ebx", "%ecx", "%edx", "%esi", "%edi", "%ebp", "%esp"] - else ["%rax", "%rbx", "%rcx", "%rdx", "%rsi", "%rdi", "%rbp", "%rsp"] + then A.listArray (0,8) ["%eax", "%ebx", "%ecx", "%edx", "%esi", "%edi", "%ebp", "%esp"] + else A.listArray (0,8) ["%rax", "%rbx", "%rcx", "%rdx", "%rsi", "%rdi", "%rbp", "%rsp"] From git at git.haskell.org Tue Aug 29 23:11:02 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 29 Aug 2017 23:11:02 +0000 (UTC) Subject: [commit: ghc] master: StgLint: Enforce MultiValAlt liveness invariant only after unariser (a36b34c) Message-ID: <20170829231102.EA27D3A5C1@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a36b34c4821653e3db3ff24b903265a7750a3397/ghc >--------------------------------------------------------------- commit a36b34c4821653e3db3ff24b903265a7750a3397 Author: Ben Gamari Date: Tue Aug 29 14:53:12 2017 -0400 StgLint: Enforce MultiValAlt liveness invariant only after unariser The unariser ensures that we never use case binders that are void, unboxed sums, or unboxed tuples. However, previously StgLint was enforcing this invariant even before the unariser was running, giving rise to spurious lint failures. Fix this. Following CoreLint, we introduce a LintFlags environment to the linter monad, allowing for additional flags to be easily accomodated in the future. See #14118. Test Plan: Build GHC with -dstg-lint Reviewers: simonpj, austin Subscribers: rwbarton, thomie GHC Trac Issues: #14118 Differential Revision: https://phabricator.haskell.org/D3889 >--------------------------------------------------------------- a36b34c4821653e3db3ff24b903265a7750a3397 compiler/simplStg/SimplStg.hs | 11 ++++---- compiler/stgSyn/StgLint.hs | 60 +++++++++++++++++++++++++++---------------- 2 files changed, 44 insertions(+), 27 deletions(-) diff --git a/compiler/simplStg/SimplStg.hs b/compiler/simplStg/SimplStg.hs index 4943f52..6c8b005 100644 --- a/compiler/simplStg/SimplStg.hs +++ b/compiler/simplStg/SimplStg.hs @@ -51,7 +51,8 @@ stg2stg dflags module_name binds ; dumpIfSet_dyn dflags Opt_D_dump_stg "Pre unarise:" (pprStgTopBindings processed_binds) - ; let un_binds = unarise us1 processed_binds + ; let un_binds = stg_linter True "Unarise" + $ unarise us1 processed_binds ; dumpIfSet_dyn dflags Opt_D_dump_stg "STG syntax:" (pprStgTopBindings un_binds) @@ -60,9 +61,9 @@ stg2stg dflags module_name binds } where - stg_linter = if gopt Opt_DoStgLinting dflags - then lintStgTopBindings - else ( \ _whodunnit binds -> binds ) + stg_linter unarised + | gopt Opt_DoStgLinting dflags = lintStgTopBindings unarised + | otherwise = \ _whodunnit binds -> binds ------------------------------------------- do_stg_pass (binds, us, ccs) to_do @@ -91,7 +92,7 @@ stg2stg dflags module_name binds = do -- report verbosely, if required dumpIfSet_dyn dflags Opt_D_verbose_stg2stg what (vcat (map ppr binds2)) - let linted_binds = stg_linter what binds2 + let linted_binds = stg_linter False what binds2 return (linted_binds, us2, ccs) -- return: processed binds -- UniqueSupply for the next guy to use diff --git a/compiler/stgSyn/StgLint.hs b/compiler/stgSyn/StgLint.hs index baceca2..ac25ab5 100644 --- a/compiler/stgSyn/StgLint.hs +++ b/compiler/stgSyn/StgLint.hs @@ -56,11 +56,12 @@ generation. Solution: don't use it! (KSW 2000-05). @lintStgTopBindings@ is the top-level interface function. -} -lintStgTopBindings :: String -> [StgTopBinding] -> [StgTopBinding] +lintStgTopBindings :: Bool -- ^ have we run Unarise yet? + -> String -> [StgTopBinding] -> [StgTopBinding] -lintStgTopBindings whodunnit binds +lintStgTopBindings unarised whodunnit binds = {-# SCC "StgLint" #-} - case (initL (lint_binds binds)) of + case (initL unarised (lint_binds binds)) of Nothing -> binds Just msg -> pprPanic "" (vcat [ text "*** Stg Lint ErrMsgs: in" <+> @@ -196,11 +197,16 @@ lintStgExpr (StgTick _ expr) = lintStgExpr expr lintStgExpr (StgCase scrut bndr alts_type alts) = runMaybeT $ do _ <- MaybeT $ lintStgExpr scrut + lf <- liftMaybeT getLintFlags in_scope <- MaybeT $ liftM Just $ case alts_type of AlgAlt tc -> check_bndr (tyConPrimRep tc) >> return True PrimAlt rep -> check_bndr [rep] >> return True - MultiValAlt _ -> return False -- Binder is always dead in this case + -- Case binders of unboxed tuple or unboxed sum type always dead + -- after the unariser has run. See Note [Post-unarisation invariants]. + MultiValAlt _ + | lf_unarised lf -> return False + | otherwise -> return True PolyAlt -> return True MaybeT $ addInScopeVars [bndr | in_scope] $ @@ -275,12 +281,17 @@ lintAlt scrut_ty (DataAlt con, args, rhs) = do -} newtype LintM a = LintM - { unLintM :: [LintLocInfo] -- Locations + { unLintM :: LintFlags + -> [LintLocInfo] -- Locations -> IdSet -- Local vars in scope -> Bag MsgDoc -- Error messages so far -> (a, Bag MsgDoc) -- Result and error messages (if any) } +data LintFlags = LintFlags { lf_unarised :: !Bool + -- ^ have we run the unariser yet? + } + data LintLocInfo = RhsOf Id -- The variable bound | LambdaBodyOf [Id] -- The lambda-binder @@ -303,20 +314,22 @@ pp_binders bs pp_binder b = hsep [ppr b, dcolon, ppr (idType b)] -initL :: LintM a -> Maybe MsgDoc -initL (LintM m) - = case (m [] emptyVarSet emptyBag) of { (_, errs) -> +initL :: Bool -> LintM a -> Maybe MsgDoc +initL unarised (LintM m) + = case (m lf [] emptyVarSet emptyBag) of { (_, errs) -> if isEmptyBag errs then Nothing else Just (vcat (punctuate blankLine (bagToList errs))) } + where + lf = LintFlags unarised instance Functor LintM where fmap = liftM instance Applicative LintM where - pure a = LintM $ \_loc _scope errs -> (a, errs) + pure a = LintM $ \_lf _loc _scope errs -> (a, errs) (<*>) = ap (*>) = thenL_ @@ -325,21 +338,21 @@ instance Monad LintM where (>>) = (*>) thenL :: LintM a -> (a -> LintM b) -> LintM b -thenL m k = LintM $ \loc scope errs - -> case unLintM m loc scope errs of - (r, errs') -> unLintM (k r) loc scope errs' +thenL m k = LintM $ \lf loc scope errs + -> case unLintM m lf loc scope errs of + (r, errs') -> unLintM (k r) lf loc scope errs' thenL_ :: LintM a -> LintM b -> LintM b -thenL_ m k = LintM $ \loc scope errs - -> case unLintM m loc scope errs of - (_, errs') -> unLintM k loc scope errs' +thenL_ m k = LintM $ \lf loc scope errs + -> case unLintM m lf loc scope errs of + (_, errs') -> unLintM k lf loc scope errs' checkL :: Bool -> MsgDoc -> LintM () checkL True _ = return () checkL False msg = addErrL msg addErrL :: MsgDoc -> LintM () -addErrL msg = LintM $ \loc _scope errs -> ((), addErr errs msg loc) +addErrL msg = LintM $ \_lf loc _scope errs -> ((), addErr errs msg loc) addErr :: Bag MsgDoc -> MsgDoc -> [LintLocInfo] -> Bag MsgDoc addErr errs_so_far msg locs @@ -350,14 +363,17 @@ addErr errs_so_far msg locs mk_msg [] = msg addLoc :: LintLocInfo -> LintM a -> LintM a -addLoc extra_loc m = LintM $ \loc scope errs - -> unLintM m (extra_loc:loc) scope errs +addLoc extra_loc m = LintM $ \lf loc scope errs + -> unLintM m lf (extra_loc:loc) scope errs addInScopeVars :: [Id] -> LintM a -> LintM a -addInScopeVars ids m = LintM $ \loc scope errs +addInScopeVars ids m = LintM $ \lf loc scope errs -> let new_set = mkVarSet ids - in unLintM m loc (scope `unionVarSet` new_set) errs + in unLintM m lf loc (scope `unionVarSet` new_set) errs + +getLintFlags :: LintM LintFlags +getLintFlags = LintM $ \lf _loc _scope errs -> (lf, errs) {- Checking function applications: we only check that the type has the @@ -457,7 +473,7 @@ stgEqType orig_ty1 orig_ty2 -- Type variables in particular checkInScope :: Id -> LintM () -checkInScope id = LintM $ \loc scope errs +checkInScope id = LintM $ \_lf loc scope errs -> if isLocalId id && not (id `elemVarSet` scope) then ((), addErr errs (hsep [ppr id, dcolon, ppr (idType id), text "is out of scope"]) loc) @@ -465,7 +481,7 @@ checkInScope id = LintM $ \loc scope errs ((), errs) checkTys :: Type -> Type -> MsgDoc -> LintM () -checkTys ty1 ty2 msg = LintM $ \loc _scope errs +checkTys ty1 ty2 msg = LintM $ \_lf loc _scope errs -> if (ty1 `stgEqType` ty2) then ((), errs) else ((), addErr errs msg loc) From git at git.haskell.org Tue Aug 29 23:11:05 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 29 Aug 2017 23:11:05 +0000 (UTC) Subject: [commit: ghc] master: StgLint: Give up on trying to compare types (f17f106) Message-ID: <20170829231105.A43D73A5C1@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f17f1063a29452843195c59e6cca2191b9d46c7f/ghc >--------------------------------------------------------------- commit f17f1063a29452843195c59e6cca2191b9d46c7f Author: Ben Gamari Date: Tue Aug 29 14:53:35 2017 -0400 StgLint: Give up on trying to compare types We used to try a crude comparison of the type themselves, but this is essentially impossible in STG as we have discarded. both casts and type applications, so types might look different but be the same. Now we simply compare their runtime representations. See #14120. Reviewers: austin Subscribers: rwbarton, thomie GHC Trac Issues: #14120 Differential Revision: https://phabricator.haskell.org/D3879 >--------------------------------------------------------------- f17f1063a29452843195c59e6cca2191b9d46c7f compiler/stgSyn/StgLint.hs | 52 +++++++--------------------------------------- 1 file changed, 8 insertions(+), 44 deletions(-) diff --git a/compiler/stgSyn/StgLint.hs b/compiler/stgSyn/StgLint.hs index ac25ab5..5140a47 100644 --- a/compiler/stgSyn/StgLint.hs +++ b/compiler/stgSyn/StgLint.hs @@ -425,52 +425,16 @@ checkFunApp fun_ty arg_tys msg | otherwise = (Nothing, Nothing) +-- | "Compare" types. We used to try a crude comparison of the type themselves, +-- but this is essentially impossible in STG as we have discarded. both casts +-- and type applications, so types might look different but be the same. Now we +-- simply compare their runtime representations. See #14120. stgEqType :: Type -> Type -> Bool --- Compare types, but crudely because we have discarded --- both casts and type applications, so types might look --- different but be the same. So reply "True" if in doubt. --- "False" means that the types are definitely different. --- --- Fundamentally this is a losing battle because of unsafeCoerce - -stgEqType orig_ty1 orig_ty2 - = gos orig_ty1 orig_ty2 +stgEqType ty1 ty2 + = reps1 == reps2 where - gos :: Type -> Type -> Bool - gos ty1 ty2 - -- These have no prim rep - | isRuntimeRepKindedTy ty1 && isRuntimeRepKindedTy ty2 - = True - - -- We have a unary type - | [_] <- reps1, [_] <- reps2 - = go ty1 ty2 - - -- In the case of a tuple just compare prim reps - | otherwise - = reps1 == reps2 - where - reps1 = typePrimRep ty1 - reps2 = typePrimRep ty2 - - go :: UnaryType -> UnaryType -> Bool - go ty1 ty2 - | Just (tc1, tc_args1) <- splitTyConApp_maybe ty1 - , Just (tc2, tc_args2) <- splitTyConApp_maybe ty2 - , let res = if tc1 == tc2 - then equalLength tc_args1 tc_args2 - && and (zipWith gos tc_args1 tc_args2) - else -- TyCons don't match; but don't bleat if either is a - -- family TyCon because a coercion might have made it - -- equal to something else - (isFamilyTyCon tc1 || isFamilyTyCon tc2) - = if res then True - else - pprTrace "stgEqType: unequal" (vcat [ppr ty1, ppr ty2]) - False - - | otherwise = True -- Conservatively say "fine". - -- Type variables in particular + reps1 = typePrimRep ty1 + reps2 = typePrimRep ty2 checkInScope :: Id -> LintM () checkInScope id = LintM $ \_lf loc scope errs From git at git.haskell.org Tue Aug 29 23:11:08 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 29 Aug 2017 23:11:08 +0000 (UTC) Subject: [commit: ghc] master: HsExpr: Fix typo (1561525) Message-ID: <20170829231108.650833A5C1@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/156152548fb7a05317a7b97c45dd0437b57a26b3/ghc >--------------------------------------------------------------- commit 156152548fb7a05317a7b97c45dd0437b57a26b3 Author: James Michael DuPont Date: Tue Aug 29 07:00:29 2017 -0400 HsExpr: Fix typo >--------------------------------------------------------------- 156152548fb7a05317a7b97c45dd0437b57a26b3 compiler/hsSyn/HsExpr.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/hsSyn/HsExpr.hs b/compiler/hsSyn/HsExpr.hs index aaebce5..03df7cc 100644 --- a/compiler/hsSyn/HsExpr.hs +++ b/compiler/hsSyn/HsExpr.hs @@ -741,7 +741,7 @@ HsPar (and ParPat in patterns, HsParTy in types) is used as follows https://phabricator.haskell.org/rGHC499e43824bda967546ebf95ee33ec1f84a114a7c * ParPat and HsParTy are pretty printed as '( .. )' regardless of whether or - not they are strictly necssary. This should be addressed when #13238 is + not they are strictly necessary. This should be addressed when #13238 is completed, to be treated the same as HsPar. From git at git.haskell.org Tue Aug 29 23:19:20 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 29 Aug 2017 23:19:20 +0000 (UTC) Subject: [commit: ghc] master: Add a Note describing #14128 (6f1ccaa) Message-ID: <20170829231920.6EAAD3A5C1@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6f1ccaa50f905bdc586a7a92ab7e38e30c1e7ff5/ghc >--------------------------------------------------------------- commit 6f1ccaa50f905bdc586a7a92ab7e38e30c1e7ff5 Author: Ben Gamari Date: Tue Aug 29 19:14:22 2017 -0400 Add a Note describing #14128 I prematurely committed the D3892 before adding a Note. Fix this. >--------------------------------------------------------------- 6f1ccaa50f905bdc586a7a92ab7e38e30c1e7ff5 compiler/deSugar/DsUsage.hs | 21 ++++++++++++++++++++- 1 file changed, 20 insertions(+), 1 deletion(-) diff --git a/compiler/deSugar/DsUsage.hs b/compiler/deSugar/DsUsage.hs index 3f302fa..6219804 100644 --- a/compiler/deSugar/DsUsage.hs +++ b/compiler/deSugar/DsUsage.hs @@ -26,6 +26,25 @@ import Data.Map (Map) import qualified Data.Map as Map import qualified Data.Set as Set +{- Note [Module self-dependency] + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +RnNames.calculateAvails asserts the invariant that a module must not occur in +its own dep_orphs or dep_finsts. However, if we aren't careful this can occur +in the presence of hs-boot files: Consider that we have two modules, A and B, +both with hs-boot files, + + A.hs contains a SOURCE import of B B.hs-boot contains a SOURCE import of A + A.hs-boot declares an orphan instance A.hs defines the orphan instance + +In this case, B's dep_orphs will contain A due to its SOURCE import of A. +Consequently, A will contain itself in its imp_orphs due to its import of B. +This fact would end up being recorded in A's interface file. This would then +break the invariant asserted by calculateAvails that a module does not itself in +its dep_orphs. This was the cause of Trac #14128. + +-} + -- | Extract information from the rename and typecheck phases to produce -- a dependencies information for the module being compiled. mkDependencies :: TcGblEnv -> IO Dependencies @@ -48,7 +67,7 @@ mkDependencies dep_orphs = filter (/= mod) (imp_orphs imports) -- We must also remove self-references from imp_orphs. See - -- #14128. + -- Note [Module self-dependency] pkgs | th_used = Set.insert (toInstalledUnitId thUnitId) (imp_dep_pkgs imports) | otherwise = imp_dep_pkgs imports From git at git.haskell.org Wed Aug 30 16:26:10 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 30 Aug 2017 16:26:10 +0000 (UTC) Subject: [commit: ghc] master: Add some traceRn and (Outputable StmtTree) (567dca6) Message-ID: <20170830162610.086273A5C1@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/567dca6ee1e32afdc5409e2e9d91d9e5c14a65c5/ghc >--------------------------------------------------------------- commit 567dca6ee1e32afdc5409e2e9d91d9e5c14a65c5 Author: Simon Peyton Jones Date: Tue Aug 29 11:22:30 2017 +0100 Add some traceRn and (Outputable StmtTree) I added these when investigating Trac #14163, but they'll be useful anyway. >--------------------------------------------------------------- 567dca6ee1e32afdc5409e2e9d91d9e5c14a65c5 compiler/rename/RnExpr.hs | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/compiler/rename/RnExpr.hs b/compiler/rename/RnExpr.hs index 3e5c88f..477a448 100644 --- a/compiler/rename/RnExpr.hs +++ b/compiler/rename/RnExpr.hs @@ -720,7 +720,8 @@ postProcessStmtsForApplicativeDo ctxt stmts ; let is_do_expr | DoExpr <- ctxt = True | otherwise = False ; if ado_is_on && is_do_expr - then rearrangeForApplicativeDo ctxt stmts + then do { traceRn "ppsfa" (ppr stmts) + ; rearrangeForApplicativeDo ctxt stmts } else noPostProcessStmts ctxt stmts } -- | strip the FreeVars annotations from statements @@ -1513,6 +1514,7 @@ rearrangeForApplicativeDo ctxt stmts0 = do optimal_ado <- goptM Opt_OptimalApplicativeDo let stmt_tree | optimal_ado = mkStmtTreeOptimal stmts | otherwise = mkStmtTreeHeuristic stmts + traceRn "rearrangeForADo" (ppr stmt_tree) return_name <- lookupSyntaxName' returnMName pure_name <- lookupSyntaxName' pureAName let monad_names = MonadNames { return_name = return_name @@ -1530,6 +1532,13 @@ data StmtTree a | StmtTreeBind (StmtTree a) (StmtTree a) | StmtTreeApplicative [StmtTree a] +instance Outputable a => Outputable (StmtTree a) where + ppr (StmtTreeOne x) = parens (text "StmtTreeOne" <+> ppr x) + ppr (StmtTreeBind x y) = parens (hang (text "StmtTreeBind") + 2 (sep [ppr x, ppr y])) + ppr (StmtTreeApplicative xs) = parens (hang (text "StmtTreeApplicative") + 2 (vcat (map ppr xs))) + flattenStmtTree :: StmtTree a -> [a] flattenStmtTree t = go t [] where From git at git.haskell.org Wed Aug 30 16:26:12 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 30 Aug 2017 16:26:12 +0000 (UTC) Subject: [commit: ghc] master: Define and use HsArg (fca1962) Message-ID: <20170830162612.C27213A5C1@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/fca196280d38d07a697fbccdd8527821206b33eb/ghc >--------------------------------------------------------------- commit fca196280d38d07a697fbccdd8527821206b33eb Author: Simon Peyton Jones Date: Wed Aug 30 09:25:45 2017 +0100 Define and use HsArg All this Left/Right business was making my head spin, so I defined data HsArg tm ty = HsValArg tm -- Argument is an ordinary expression (f arg) | HsTypeArg ty -- Argument is a visible type application (f @ty) and used it. This is just simple refactor; no change in behaviour. >--------------------------------------------------------------- fca196280d38d07a697fbccdd8527821206b33eb compiler/typecheck/TcExpr.hs | 71 ++++++++++++++++++++++++-------------------- 1 file changed, 38 insertions(+), 33 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc fca196280d38d07a697fbccdd8527821206b33eb From git at git.haskell.org Wed Aug 30 16:26:15 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 30 Aug 2017 16:26:15 +0000 (UTC) Subject: [commit: ghc] master: Add comments to RnTypes (628b666) Message-ID: <20170830162615.88D303A5C1@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/628b666972b1b1fcb459977977a5ff578c292e91/ghc >--------------------------------------------------------------- commit 628b666972b1b1fcb459977977a5ff578c292e91 Author: Simon Peyton Jones Date: Wed Aug 30 09:21:40 2017 +0100 Add comments to RnTypes These comments clarify the details of: commit 0257dacf228024d0cc6ba247c707130637a25580 Author: Simon Peyton Jones Date: Mon Aug 28 14:20:02 2017 +0100 Refactor bindHsQTyVars and friends >--------------------------------------------------------------- 628b666972b1b1fcb459977977a5ff578c292e91 compiler/rename/RnTypes.hs | 153 +++++++++++++++++++++++++++++++++++---------- 1 file changed, 119 insertions(+), 34 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 628b666972b1b1fcb459977977a5ff578c292e91 From git at git.haskell.org Thu Aug 31 07:17:21 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 31 Aug 2017 07:17:21 +0000 (UTC) Subject: [commit: ghc] master: Add debugPprType (805b29b) Message-ID: <20170831071721.D61BE3A5C1@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/805b29bb873c792ca5bcbd5540026848f9f11a8d/ghc >--------------------------------------------------------------- commit 805b29bb873c792ca5bcbd5540026848f9f11a8d Author: Simon Peyton Jones Date: Wed Aug 30 08:57:40 2017 +0100 Add debugPprType We pretty-print a type by converting it to an IfaceType and pretty-printing that. But (a) that's a bit indirect, and (b) delibrately loses information about (e.g.) the kind on the /occurrences/ of a type variable So this patch implements debugPprType, which pretty prints the type directly, with no fancy formatting. It's just used for debugging. I took the opportunity to refactor the debug-pretty-printing machinery a little. In particular, define these functions and use them: ifPprDeubug :: SDoc -> SDOc -> SDoc -- Says what to do with and without -dppr-debug whenPprDebug :: SDoc -> SDoc -- Says what to do with -dppr-debug; without is empty getPprDebug :: (Bool -> SDoc) -> SDoc getPprDebug used to be called sdocPprDebugWith whenPprDebug used to be called ifPprDebug So a lot of files get touched in a very mechanical way >--------------------------------------------------------------- 805b29bb873c792ca5bcbd5540026848f9f11a8d compiler/basicTypes/BasicTypes.hs | 5 ++-- compiler/basicTypes/RdrName.hs | 5 ++-- compiler/basicTypes/SrcLoc.hs | 2 +- compiler/coreSyn/CoreLint.hs | 7 ++--- compiler/coreSyn/PprCore.hs | 4 +-- compiler/deSugar/Desugar.hs | 4 +-- compiler/ghci/RtClosureInspect.hs | 26 ++++++++-------- compiler/hsSyn/HsBinds.hs | 6 ++-- compiler/hsSyn/HsExpr.hs | 20 ++++++------- compiler/hsSyn/HsLit.hs | 2 +- compiler/hsSyn/HsPat.hs | 2 +- compiler/hsSyn/HsTypes.hs | 5 ++-- compiler/iface/IfaceSyn.hs | 2 +- compiler/iface/IfaceType.hs | 2 +- compiler/iface/LoadIface.hs | 2 +- compiler/nativeGen/Dwarf/Types.hs | 2 +- compiler/nativeGen/X86/Ppr.hs | 2 +- compiler/prelude/ForeignCall.hs | 2 +- compiler/profiling/CostCentre.hs | 4 +-- compiler/simplCore/CoreMonad.hs | 2 +- compiler/simplCore/SimplUtils.hs | 2 +- compiler/specialise/Rules.hs | 13 ++++---- compiler/specialise/Specialise.hs | 2 +- compiler/stgSyn/StgSyn.hs | 12 ++++---- compiler/typecheck/TcRnDriver.hs | 6 ++-- compiler/typecheck/TcRnTypes.hs | 4 +-- compiler/typecheck/TcSMonad.hs | 6 ++-- compiler/typecheck/TcTyClsDecls.hs | 8 ++--- compiler/types/FamInstEnv.hs | 2 +- compiler/types/InstEnv.hs | 2 +- compiler/types/TyCoRep.hs | 61 +++++++++++++++++++++++++++++++++++++- compiler/utils/Outputable.hs | 28 +++++++++-------- 32 files changed, 154 insertions(+), 98 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 805b29bb873c792ca5bcbd5540026848f9f11a8d From git at git.haskell.org Thu Aug 31 07:17:27 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 31 Aug 2017 07:17:27 +0000 (UTC) Subject: [commit: ghc] master: Small changes to ddump-tc tracing (3790ea9) Message-ID: <20170831071727.D0BC83A5C1@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3790ea906da400cd7ff6dbc0ec061bd99afaf84a/ghc >--------------------------------------------------------------- commit 3790ea906da400cd7ff6dbc0ec061bd99afaf84a Author: Simon Peyton Jones Date: Wed Aug 30 16:16:36 2017 +0100 Small changes to ddump-tc tracing >--------------------------------------------------------------- 3790ea906da400cd7ff6dbc0ec061bd99afaf84a compiler/typecheck/Inst.hs | 9 +++++---- compiler/typecheck/TcTyClsDecls.hs | 2 +- compiler/typecheck/TcUnify.hs | 7 +++++-- compiler/types/Type.hs | 2 +- 4 files changed, 12 insertions(+), 8 deletions(-) diff --git a/compiler/typecheck/Inst.hs b/compiler/typecheck/Inst.hs index bb2b90c..69f0005 100644 --- a/compiler/typecheck/Inst.hs +++ b/compiler/typecheck/Inst.hs @@ -48,7 +48,7 @@ import CoreSyn ( isOrphan ) import FunDeps import TcMType import Type -import TyCoRep ( TyBinder(..) ) +import TyCoRep import TcType import HscTypes import Class( Class ) @@ -196,15 +196,16 @@ top_instantiate inst_all orig ty ; let inst_theta' = substTheta subst inst_theta sigma' = substTy subst (mkForAllTys leave_bndrs $ mkFunTys leave_theta rho) + inst_tv_tys' = mkTyVarTys inst_tvs' - ; wrap1 <- instCall orig (mkTyVarTys inst_tvs') inst_theta' + ; wrap1 <- instCall orig inst_tv_tys' inst_theta' ; traceTc "Instantiating" (vcat [ text "all tyvars?" <+> ppr inst_all , text "origin" <+> pprCtOrigin orig - , text "type" <+> ppr ty + , text "type" <+> debugPprType ty , text "theta" <+> ppr theta , text "leave_bndrs" <+> ppr leave_bndrs - , text "with" <+> ppr inst_tvs' + , text "with" <+> vcat (map debugPprType inst_tv_tys') , text "theta:" <+> ppr inst_theta' ]) ; (wrap2, rho2) <- diff --git a/compiler/typecheck/TcTyClsDecls.hs b/compiler/typecheck/TcTyClsDecls.hs index 01baa6f..f445d83 100644 --- a/compiler/typecheck/TcTyClsDecls.hs +++ b/compiler/typecheck/TcTyClsDecls.hs @@ -2506,7 +2506,7 @@ checkValidDataCon dflags existential_ok tc con -- data T = MkT {-# UNPACK #-} !a -- Can't unpack ; zipWith3M_ check_bang (dataConSrcBangs con) (dataConImplBangs con) [1..] - ; traceTc "Done validity of data con" (ppr con <+> ppr (dataConRepType con)) + ; traceTc "Done validity of data con" (ppr con <+> debugPprType (dataConRepType con)) } where ctxt = ConArgCtxt (dataConName con) diff --git a/compiler/typecheck/TcUnify.hs b/compiler/typecheck/TcUnify.hs index 59f8869..56cc95d 100644 --- a/compiler/typecheck/TcUnify.hs +++ b/compiler/typecheck/TcUnify.hs @@ -1280,8 +1280,11 @@ uType_defer t_or_k origin ty1 ty2 ; whenDOptM Opt_D_dump_tc_trace $ do { ctxt <- getErrCtxt ; doc <- mkErrInfo emptyTidyEnv ctxt - ; traceTc "utype_defer" (vcat [ppr co, ppr ty1, - ppr ty2, pprCtOrigin origin, doc]) + ; traceTc "utype_defer" (vcat [ debugPprType ty1 + , debugPprType ty2 + , pprCtOrigin origin + , doc]) + ; traceTc "utype_defer2" (ppr co) } ; return co } diff --git a/compiler/types/Type.hs b/compiler/types/Type.hs index 1e0c612..b0f1fac 100644 --- a/compiler/types/Type.hs +++ b/compiler/types/Type.hs @@ -687,7 +687,7 @@ splitAppTy_maybe ty | Just ty' <- coreView ty splitAppTy_maybe ty = repSplitAppTy_maybe ty ------------- -repSplitAppTy_maybe :: Type -> Maybe (Type,Type) +repSplitAppTy_maybe :: HasDebugCallStack => Type -> Maybe (Type,Type) -- ^ Does the AppTy split as in 'splitAppTy_maybe', but assumes that -- any Core view stuff is already done repSplitAppTy_maybe (FunTy ty1 ty2) From git at git.haskell.org Thu Aug 31 07:17:25 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 31 Aug 2017 07:17:25 +0000 (UTC) Subject: [commit: ghc] master: Really fix Trac #14158 (2c133b6) Message-ID: <20170831071725.1E3083A5C1@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2c133b67df374c73bc8069cefd7d57e1d2a14fc3/ghc >--------------------------------------------------------------- commit 2c133b67df374c73bc8069cefd7d57e1d2a14fc3 Author: Simon Peyton Jones Date: Wed Aug 30 16:19:37 2017 +0100 Really fix Trac #14158 I dug more into how #14158 started working. I temporarily reverted the patch that "fixed" it, namely commit a6c448b403dbe8720178ca82100f34baedb1f47e Author: Simon Peyton Jones Date: Mon Aug 28 17:33:59 2017 +0100 Small refactor of getRuntimeRep Sure enough, there was a real bug, described in the new TcExpr Note [Visible type application zonk] In general, syntactic substituion should be kind-preserving! Maybe we should check that invariant... >--------------------------------------------------------------- 2c133b67df374c73bc8069cefd7d57e1d2a14fc3 compiler/typecheck/TcExpr.hs | 44 +++++++++++++++++++++- testsuite/tests/typecheck/should_compile/T14158.hs | 7 ++++ testsuite/tests/typecheck/should_compile/all.T | 1 + 3 files changed, 50 insertions(+), 2 deletions(-) diff --git a/compiler/typecheck/TcExpr.hs b/compiler/typecheck/TcExpr.hs index ec03f37..0ff7d1e 100644 --- a/compiler/typecheck/TcExpr.hs +++ b/compiler/typecheck/TcExpr.hs @@ -65,7 +65,7 @@ import PrelNames import DynFlags import SrcLoc import Util -import VarEnv ( emptyTidyEnv ) +import VarEnv ( emptyTidyEnv, mkInScopeSet ) import ListSetOps import Maybes import Outputable @@ -1294,7 +1294,18 @@ tcArgs fun orig_fun_ty fun_orig orig_args herald , ppr inner_ty, pprTyVar tv , ppr vis ]) ) ; ty_arg <- tcHsTypeApp hs_ty_arg kind - ; let insted_ty = substTyWithUnchecked [tv] [ty_arg] inner_ty + + ; inner_ty <- zonkTcType inner_ty + -- See Note [Visible type application zonk] + + ; let in_scope = mkInScopeSet (tyCoVarsOfTypes [upsilon_ty, ty_arg]) + insted_ty = substTyWithInScope in_scope [tv] [ty_arg] inner_ty + -- NB: tv and ty_arg have the same kind, so this + -- substitution is kind-respecting + ; traceTc "VTA" (vcat [ppr tv, debugPprType kind + , debugPprType ty_arg + , debugPprType (typeKind ty_arg) + , debugPprType insted_ty ]) ; (inner_wrap, args', res_ty) <- go acc_args (n+1) insted_ty args -- inner_wrap :: insted_ty "->" (map typeOf args') -> res_ty @@ -1326,6 +1337,35 @@ tcArgs fun orig_fun_ty fun_orig orig_args herald text "Cannot apply expression of type" <+> quotes (ppr ty) $$ text "to a visible type argument" <+> quotes (ppr arg) } +{- Note [Visible type application zonk] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +* Substitutions should be kind-preserving, so we need kind(tv) = kind(ty_arg). + +* tcHsTypeApp only guarantees that + - ty_arg is zonked + - kind(zonk(tv)) = kind(ty_arg) + (checkExpectedKind zonks as it goes). + +So we must zonk inner_ty as well, to guarantee consistency between zonk(tv) +and inner_ty. Otherwise we can build an ill-kinded type. An example was +Trac #14158, where we had: + id :: forall k. forall (cat :: k -> k -> *). forall (a :: k). cat a a +and we had the visible type application + id @(->) + +* We instantiated k := kappa, yielding + forall (cat :: kappa -> kappa -> *). forall (a :: kappa). cat a a +* Then we called tcHsTypeApp (->) with expected kind (kappa -> kappa -> *). +* That instantiated (->) as ((->) q1 q1), and unified kappa := q1, + Here q1 :: RuntimeRep +* Now we substitute + cat :-> (->) q1 q1 :: TYPE q1 -> TYPE q1 -> * + but we must first zonk the inner_ty to get + forall (a :: TYPE q1). cat a a + so that the result of substitution is well-kinded + Failing to do so led to Trac #14158. +-} + ---------------- tcArg :: LHsExpr GhcRn -- The function (for error messages) -> LHsExpr GhcRn -- Actual arguments diff --git a/testsuite/tests/typecheck/should_compile/T14158.hs b/testsuite/tests/typecheck/should_compile/T14158.hs new file mode 100644 index 0000000..88bb82e --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T14158.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE TypeApplications #-} + +module T14158 where + +import qualified Control.Category as Cat + +foo = (Cat.id @(->) >>=) diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index fde7bae..bcd6a43 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -574,3 +574,4 @@ test('T13984', normal, compile, ['']) test('T14128', normal, multimod_compile, ['T14128Main', '-v0']) test('T14149', normal, compile, ['']) test('T14154', normal, compile, ['']) +test('T14158', normal, compile, ['']) From git at git.haskell.org Thu Aug 31 07:45:51 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 31 Aug 2017 07:45:51 +0000 (UTC) Subject: [commit: ghc] master: Add missing Semigroup instances to compiler (c0feee9) Message-ID: <20170831074551.356B83A5C1@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c0feee90118333dac817cfad6f2dedc0a886d1bd/ghc >--------------------------------------------------------------- commit c0feee90118333dac817cfad6f2dedc0a886d1bd Author: Herbert Valerio Riedel Date: Wed Aug 30 01:29:55 2017 +0200 Add missing Semigroup instances to compiler This is a pre-requisite for implementing the Semigroup/Monoid proposal. The instances have been introduced in a way to minimise warnings. >--------------------------------------------------------------- c0feee90118333dac817cfad6f2dedc0a886d1bd compiler/deSugar/Check.hs | 45 +++++++++++++++++++++++++++++--------------- compiler/iface/IfaceType.hs | 10 +++++++--- compiler/main/Packages.hs | 29 +++++++++++++--------------- compiler/rename/RnEnv.hs | 26 ++++++++++++++----------- compiler/typecheck/TcType.hs | 11 +++++++---- compiler/utils/FastString.hs | 6 +++++- compiler/utils/Pair.hs | 8 ++++++-- compiler/utils/PprColour.hs | 6 +++++- compiler/utils/UniqDFM.hs | 6 +++++- compiler/utils/UniqFM.hs | 7 +++---- 10 files changed, 96 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 c0feee90118333dac817cfad6f2dedc0a886d1bd From git at git.haskell.org Thu Aug 31 14:23:52 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 31 Aug 2017 14:23:52 +0000 (UTC) Subject: [commit: ghc] wip/T14152: Implement a dedicated exitfication pass #14152 (afa5aa4) Message-ID: <20170831142352.908613A5C1@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14152 Link : http://ghc.haskell.org/trac/ghc/changeset/afa5aa436962ffcffd2e1c6a2674c08e4ae496b9/ghc >--------------------------------------------------------------- commit afa5aa436962ffcffd2e1c6a2674c08e4ae496b9 Author: Joachim Breitner Date: Sat Aug 26 14:35:50 2017 +0200 Implement a dedicated exitfication pass #14152 >--------------------------------------------------------------- afa5aa436962ffcffd2e1c6a2674c08e4ae496b9 compiler/basicTypes/Id.hs | 5 +- compiler/basicTypes/Unique.hs | 4 + compiler/coreSyn/CoreLint.hs | 1 + compiler/ghc.cabal.in | 1 + compiler/main/DynFlags.hs | 3 + compiler/simplCore/CoreMonad.hs | 2 + compiler/simplCore/Exitify.hs | 159 +++++++++++++++++++++++++++++++++++++++ compiler/simplCore/SimplCore.hs | 6 ++ compiler/simplCore/SimplUtils.hs | 1 + compiler/simplCore/Simplify.hs | 7 +- 10 files changed, 186 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 afa5aa436962ffcffd2e1c6a2674c08e4ae496b9 From git at git.haskell.org Thu Aug 31 14:23:55 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 31 Aug 2017 14:23:55 +0000 (UTC) Subject: [commit: ghc] wip/T14152's head updated: Implement a dedicated exitfication pass #14152 (afa5aa4) Message-ID: <20170831142355.151EB3A5C1@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/T14152' now includes: c13720c Drop GHC 7.10 compatibility 36fe21a Enable building Cabal with parsec 9df71bf Bump unix submodule 8ef8520 Add .gitmodules entries for text, parsec, mtl submodules d74983e Get the roles right for newtype instances f68a00c Remove unneeded uses of ImplicitParams 884bd21 Add the bootstrapping/ dir to .gitignore 394c391 Add MonadIO Q - by requiring MonadIO => Quasi a81b5b0 Remove the deprecated Typeable{1..7} type synonyms a267580 Don't warn when empty casing on Type 6ea13e9 Add forgotten > in Control.Applicative e8fe12f Fix string escaping in JSON 2f29f19 Convert examples to doctests, and add a handful of new ones 14457cf Fix EmptyCase documentation a4f347c Split out inferConstraintsDataConArgs from inferConstraints 3f05e5f Don't suppress unimplemented type family warnings with DeriveAnyClass 7d69978 Use NonEmpty lists to represent lists of duplicate elements 4f1f986 Change isClosedAlgType to be TYPE-aware, and rename it to pmIsClosedType 0bb1e84 Expand type synonyms during role inference c6462ab Add test for #14101 7c37ffe Point to FunDeps documentation on Haskell wiki ad7b945 Fix #14060 by more conservatively annotating TH-reified types 0a891c8 Properly handle dlerror() message on FreeBSD when linking linker scripts ddb870b Don't drop GHCi-defined functions with -fobject-code enabled ed7a830 Use a ReaderT in TcDeriv to avoid some tedious plumbing 21bd9b2 Recognize FreeBSD compiler as Clang. a520adc Bump mtl, parsec, text submodules 441c52d Add Semigroup/Monoid instances to ST monad b0285d1 Bump nofib submodule e054c5f Bump mtl, parsec, text submodules 6e9c8eb Bump mtl, parsec, text submodules (again) a8da0de Speed up compilation of profiling stubs b0ed07f Allow TcDerivInfer to compile with GHC 8.0.1 38260a9 Fix #13972 by producing tidier errors 039fa1b Suggest how to fix illegally nested foralls in GADT constructor type signatures c948b78 Fix #11785 by making reifyKind = reifyType af9f3fa Remove extra ` from "kind-indexed GADTs" doc 03327bf Handle ListPat in isStrictPattern 36d1b08 Doctest for Void.absurd 49ddea9 Sections with undefined operators have non-standard behavior 43b0c2c Insert missing blank line to fix Applicative doc 63397cb Add some Monoid doctests f762181 Mention the category laws explicitly a30187d Convert documentation examples to doctests for ReadP module bfa9048 Loads of doc(test)s 2c0ab47 Add missing initial version for extension doc. 0e1b6f8 Fix index entries in "separate compilation" section 3385669 user-guide: fix examples of ghci commands 69a0f01 rts: Enable USDT probes object on Linux 82ee71f user-guide: add `:type +d` and `:type +v` in release highlight dc42c0d Fix #13399 by documenting higher-rank kinds. 0385347 Remove unneeded reqlibs for mtl and parsec in the GHC testsuite c5605ae Make function intToSBigNat# preserve sign (fixes #14085) 0286214 testsuite: Add test for #13916 fee253f CSE.cseOneExpr: Set InScopeSet correctly afa5aa4 Implement a dedicated exitfication pass #14152 From git at git.haskell.org Thu Aug 31 15:35:09 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 31 Aug 2017 15:35:09 +0000 (UTC) Subject: [commit: ghc] ghc-8.2: Fix decomposition error on Windows (625bea0) Message-ID: <20170831153509.616543A5C1@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.2 Link : http://ghc.haskell.org/trac/ghc/changeset/625bea009ed72b8a1ce981acd031799d32e4a944/ghc >--------------------------------------------------------------- commit 625bea009ed72b8a1ce981acd031799d32e4a944 Author: Tamar Christina Date: Tue Aug 29 22:59:38 2017 +0100 Fix decomposition error on Windows Summary: Fix the path decomposition error that occurs when the Symlink resolver fails. `Win32.try` throws an exception, so catch it and assume the path isn't a symlink to use the old behavior. Test Plan: ./validate Reviewers: austin, bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie GHC Trac Issues: #14159 Differential Revision: https://phabricator.haskell.org/D3891 (cherry picked from commit 3c6b2fc3b5ca11a5410405664e4640767ef941dd) >--------------------------------------------------------------- 625bea009ed72b8a1ce981acd031799d32e4a944 compiler/main/SysTools.hs | 13 +++++++++++-- 1 file changed, 11 insertions(+), 2 deletions(-) diff --git a/compiler/main/SysTools.hs b/compiler/main/SysTools.hs index 5601e2a..eaeb856 100644 --- a/compiler/main/SysTools.hs +++ b/compiler/main/SysTools.hs @@ -1529,9 +1529,18 @@ getFinalPath name = do (fILE_ATTRIBUTE_NORMAL .|. fILE_FLAG_BACKUP_SEMANTICS) Nothing let fnPtr = makeGetFinalPathNameByHandle $ castPtrToFunPtr addr - path <- Win32.try "GetFinalPathName" + -- First try to resolve the path to get the actual path + -- of any symlinks or other file system redirections that + -- may be in place. However this function can fail, and in + -- the event it does fail, we need to try using the + -- original path and see if we can decompose that. + -- If the call fails Win32.try will raise an exception + -- that needs to be caught. See #14159 + path <- (Win32.try "GetFinalPathName" (\buf len -> fnPtr handle buf len 0) 512 - `finally` closeHandle handle + `finally` closeHandle handle) + `catch` + (\(_ :: IOException) -> return name) return $ Just path type GetFinalPath = HANDLE -> LPTSTR -> DWORD -> DWORD -> IO DWORD From git at git.haskell.org Thu Aug 31 18:18:26 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 31 Aug 2017 18:18:26 +0000 (UTC) Subject: [commit: ghc] master: Add missing Semigroup instances in utils/{hpc, runghc} (b2c2e3e) Message-ID: <20170831181826.1089D3A5C1@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b2c2e3e818b8aa69af711cefa7efeadedc3f2e4e/ghc >--------------------------------------------------------------- commit b2c2e3e818b8aa69af711cefa7efeadedc3f2e4e Author: Herbert Valerio Riedel Date: Thu Aug 31 09:49:20 2017 +0200 Add missing Semigroup instances in utils/{hpc,runghc} This is a follow-up to c0feee90118333dac817cfad6f2dedc0a886d1bd >--------------------------------------------------------------- b2c2e3e818b8aa69af711cefa7efeadedc3f2e4e utils/hpc/HpcMarkup.hs | 9 +++++---- utils/runghc/Main.hs | 16 ++++++++++------ 2 files changed, 15 insertions(+), 10 deletions(-) diff --git a/utils/hpc/HpcMarkup.hs b/utils/hpc/HpcMarkup.hs index ca30471..a9b5ce1 100644 --- a/utils/hpc/HpcMarkup.hs +++ b/utils/hpc/HpcMarkup.hs @@ -17,6 +17,7 @@ import System.FilePath import System.IO (localeEncoding) import Data.List import Data.Maybe(fromJust) +import Data.Semigroup as Semi import Data.Array import Control.Monad import qualified Data.Set as Set @@ -467,6 +468,9 @@ showSummary ticked total = percent :: (Integral a) => a -> a -> Maybe a percent ticked total = if total == 0 then Nothing else Just (ticked * 100 `div` total) +instance Semi.Semigroup ModuleSummary where + (ModuleSummary eTik1 eTot1 tTik1 tTot1 aTik1 aTot1) <> (ModuleSummary eTik2 eTot2 tTik2 tTot2 aTik2 aTot2) + = ModuleSummary (eTik1 + eTik2) (eTot1 + eTot2) (tTik1 + tTik2) (tTot1 + tTot2) (aTik1 + aTik2) (aTot1 + aTot2) instance Monoid ModuleSummary where mempty = ModuleSummary @@ -477,10 +481,7 @@ instance Monoid ModuleSummary where , altTicked = 0 , altTotal = 0 } - mappend (ModuleSummary eTik1 eTot1 tTik1 tTot1 aTik1 aTot1) - (ModuleSummary eTik2 eTot2 tTik2 tTot2 aTik2 aTot2) - = ModuleSummary (eTik1 + eTik2) (eTot1 + eTot2) (tTik1 + tTik2) (tTot1 + tTot2) (aTik1 + aTik2) (aTot1 + aTot2) - + mappend = (<>) ------------------------------------------------------------------------------ diff --git a/utils/runghc/Main.hs b/utils/runghc/Main.hs index b5d4a4a..dec53ee 100644 --- a/utils/runghc/Main.hs +++ b/utils/runghc/Main.hs @@ -19,6 +19,7 @@ module Main (main) where import Control.Exception +import Data.Semigroup as Semi import System.Directory import System.Environment import System.Exit @@ -77,14 +78,17 @@ data RunGhcFlags = RunGhcFlags (Maybe FilePath) -- GHC location | Help -- Print help text | ShowVersion -- Print version info +instance Semi.Semigroup RunGhcFlags where + Help <> _ = Help + _ <> Help = Help + ShowVersion <> _ = ShowVersion + _ <> ShowVersion = ShowVersion + RunGhcFlags _ <> right@(RunGhcFlags (Just _)) = right + left@(RunGhcFlags _) <> RunGhcFlags Nothing = left + instance Monoid RunGhcFlags where mempty = RunGhcFlags Nothing - Help `mappend` _ = Help - _ `mappend` Help = Help - ShowVersion `mappend` _ = ShowVersion - _ `mappend` ShowVersion = ShowVersion - RunGhcFlags _ `mappend` right@(RunGhcFlags (Just _)) = right - left@(RunGhcFlags _) `mappend` RunGhcFlags Nothing = left + mappend = (<>) parseRunGhcFlags :: [String] -> (RunGhcFlags, [String]) parseRunGhcFlags = f mempty From git at git.haskell.org Thu Aug 31 21:27:38 2017 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 31 Aug 2017 21:27:38 +0000 (UTC) Subject: [commit: ghc] wip/T14152: Exitify: Keep track of an InScopeSet (103e621) Message-ID: <20170831212738.7692A3A5C1@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T14152 Link : http://ghc.haskell.org/trac/ghc/changeset/103e6217d58eae1922171ad606fa13b1777bd6a1/ghc >--------------------------------------------------------------- commit 103e6217d58eae1922171ad606fa13b1777bd6a1 Author: Joachim Breitner Date: Thu Aug 31 22:26:51 2017 +0100 Exitify: Keep track of an InScopeSet more reliable than avoiding freeVars >--------------------------------------------------------------- 103e6217d58eae1922171ad606fa13b1777bd6a1 compiler/simplCore/Exitify.hs | 69 ++++++++++++++++++++++++------------------- 1 file changed, 38 insertions(+), 31 deletions(-) diff --git a/compiler/simplCore/Exitify.hs b/compiler/simplCore/Exitify.hs index d86b02d..cc4172d 100644 --- a/compiler/simplCore/Exitify.hs +++ b/compiler/simplCore/Exitify.hs @@ -25,36 +25,45 @@ import Control.Monad exitifyProgram :: CoreProgram -> CoreProgram exitifyProgram binds = map goTopLvl binds where - goTopLvl (NonRec v e) = NonRec v (go e) - goTopLvl (Rec pairs) = Rec (map (second go) pairs) - - go e@(Var{}) = e - go e@(Lit {}) = e - go e@(Type {}) = e - go e@(Coercion {}) = e - - go (Lam v e') = Lam v (go e') - go (App e1 e2) = App (go e1) (go e2) - go (Case scrut bndr ty alts) = Case (go scrut) bndr ty (map goAlt alts) - go (Cast e' c) = Cast (go e') c - go (Tick t e') = Tick t (go e') - go (Let bind body) = goBind bind (go body) - - goAlt :: CoreAlt -> CoreAlt - goAlt (dc, pats, rhs) = (dc, pats, go rhs) - - goBind :: CoreBind -> (CoreExpr -> CoreExpr) - goBind (NonRec v rhs) = Let (NonRec v (go rhs)) - goBind (Rec pairs) - | is_join_rec = exitify pairs' + goTopLvl (NonRec v e) = NonRec v (go in_scope_toplvl e) + goTopLvl (Rec pairs) = Rec (map (second (go in_scope_toplvl)) pairs) + + in_scope_toplvl = emptyInScopeSet `extendInScopeSetList` bindersOfBinds binds + + go :: InScopeSet -> CoreExpr -> CoreExpr + go _ e@(Var{}) = e + go _ e@(Lit {}) = e + go _ e@(Type {}) = e + go _ e@(Coercion {}) = e + + go in_scope (Lam v e') = Lam v (go in_scope' e') + where in_scope' = in_scope `extendInScopeSet` v + go in_scope (App e1 e2) = App (go in_scope e1) (go in_scope e2) + go in_scope (Case scrut bndr ty alts) + = Case (go in_scope scrut) bndr ty (map (goAlt in_scope') alts) + where in_scope' = in_scope `extendInScopeSet` bndr + go in_scope (Cast e' c) = Cast (go in_scope e') c + go in_scope (Tick t e') = Tick t (go in_scope e') + go in_scope (Let bind body) = goBind in_scope bind (go in_scope' body) + where in_scope' = in_scope `extendInScopeSetList` bindersOf bind + + goAlt :: InScopeSet -> CoreAlt -> CoreAlt + goAlt in_scope (dc, pats, rhs) = (dc, pats, go in_scope' rhs) + where in_scope' = in_scope `extendInScopeSetList` pats + + goBind :: InScopeSet -> CoreBind -> (CoreExpr -> CoreExpr) + goBind in_scope (NonRec v rhs) = Let (NonRec v (go in_scope rhs)) + goBind in_scope (Rec pairs) + | is_join_rec = exitify in_scope' pairs' | otherwise = Let (Rec pairs') - where pairs' = map (second go) pairs + where pairs' = map (second (go in_scope')) pairs is_join_rec = any (isJoinId . fst) pairs + in_scope' = in_scope `extendInScopeSetList` bindersOf (Rec pairs) -- | Given a recursive group of a joinrec, identifies “exit paths” and binds them as -- join-points outside the joinrec. -exitify :: [(Var,CoreExpr)] -> (CoreExpr -> CoreExpr) -exitify pairs = +exitify :: InScopeSet -> [(Var,CoreExpr)] -> (CoreExpr -> CoreExpr) +exitify in_scope pairs = ASSERT (all (isJoinId . fst) pairs) \body ->mkExitLets exits (mkLetRec pairs' body) where @@ -65,8 +74,6 @@ exitify pairs = -- annotate the AST with them ann_pairs = map (second freeVars) pairs - -- What is in scope on the top level? - joinrec_fv = unionVarSets $ map (dVarSetToVarSet . freeVarsOf . snd) ann_pairs -- Which are the recursive calls? recursive_calls = mkVarSet $ map fst pairs @@ -137,10 +144,10 @@ exitify pairs = -- * any exit join points created so far. mkExitJoinId ty join_arity captured = do fs <- get - let avoid = joinrec_fv `unionVarSet` mkVarSet captured - `unionVarSet` mkVarSet (map fst fs) - `extendVarSet` exit_id_tmpl -- just cosmetics - return (uniqAway (mkInScopeSet avoid) exit_id_tmpl) + let avoid = in_scope `extendInScopeSetList` captured + `extendInScopeSetList` (map fst fs) + `extendInScopeSet` exit_id_tmpl -- just cosmetics + return (uniqAway avoid exit_id_tmpl) where exit_id_tmpl = mkSysLocal (fsLit "exit") initExitJoinUnique ty `asJoinId` join_arity